From e6bda4dce5fa0fdc935484e2a2540953f43b5a2d Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 6 Jun 2007 13:06:45 +0000
Subject: Cleaned up the core modules.
git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-65
---
src/guile/skribilo/ast.scm | 12 ++++++------
src/guile/skribilo/biblio.scm | 24 ++++++++++++++++--------
src/guile/skribilo/debug.scm | 3 +--
src/guile/skribilo/evaluator.scm | 5 +----
src/guile/skribilo/index.scm | 1 -
src/guile/skribilo/lib.scm | 15 ++++++---------
src/guile/skribilo/location.scm | 3 ++-
src/guile/skribilo/module.scm | 5 +----
src/guile/skribilo/prog.scm | 16 ++++------------
src/guile/skribilo/reader.scm | 2 +-
src/guile/skribilo/resolve.scm | 11 ++++-------
src/guile/skribilo/source.scm | 7 ++++---
src/guile/skribilo/utils/compat.scm | 3 +--
src/guile/skribilo/verify.scm | 6 ++----
src/guile/skribilo/writer.scm | 7 ++-----
15 files changed, 51 insertions(+), 69 deletions(-)
(limited to 'src')
diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm
index e60957c..5484815 100644
--- a/src/guile/skribilo/ast.scm
+++ b/src/guile/skribilo/ast.scm
@@ -29,7 +29,7 @@
:use-module (skribilo utils syntax)
:autoload (skribilo location) (location?)
- :autoload (srfi srfi-1) (fold)
+ :autoload (srfi srfi-1) (fold concatenate)
:use-module (ice-9 optargs)
@@ -47,7 +47,7 @@
markup-markup markup-body markup-body-set!
markup-ident markup-class
markup-option markup-option-set!
- markup-option-add! markup-output
+ markup-option-add!
markup-parent markup-document markup-chapter
<container> container? container-options
@@ -55,7 +55,7 @@
container-env-get
<document> document? document-ident document-body
- document-options document-end
+ document-options document-env
document-lookup-node document-bind-node!
document-bind-nodes!
@@ -510,7 +510,7 @@
(let loop ((obj (markup-body obj)))
(cond
((pair? obj)
- (apply append (map (lambda (o) (loop o)) obj)))
+ (concatenate (map (lambda (o) (loop o)) obj)))
((container? obj)
(let ((rest (loop (markup-body obj))))
(if (pred obj)
@@ -525,7 +525,7 @@
(let loop ((obj (markup-body obj)))
(cond
((pair? obj)
- (apply append (map (lambda (o) (loop o)) obj)))
+ (concatenate (map (lambda (o) (loop o)) obj)))
((markup? obj)
(let ((rest (loop (markup-body obj))))
(if (pred obj)
@@ -540,7 +540,7 @@
(let loop ((obj obj))
(cond
((pair? obj)
- (apply append (map (lambda (o) (loop o)) obj)))
+ (concatenate (map (lambda (o) (loop o)) obj)))
((markup? obj)
(if (pred obj)
(list (cons obj (loop (markup-body obj))))
diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm
index 0c2cfa7..64eaea4 100644
--- a/src/guile/skribilo/biblio.scm
+++ b/src/guile/skribilo/biblio.scm
@@ -22,7 +22,6 @@
(define-module (skribilo biblio)
- :use-module (skribilo utils strings)
:use-module (skribilo utils syntax) ;; `when', `unless'
:use-module (srfi srfi-1)
@@ -54,10 +53,13 @@
;; error conditions
&biblio-error &biblio-entry-error &biblio-template-error
+ &biblio-parse-error
biblio-error? biblio-entry-error? biblio-template-error?
+ biblio-parse-error?
biblio-entry-error:entry
biblio-template-error:expression
- biblio-template-error:template))
+ biblio-template-error:template
+ biblio-parse-error:sexp))
;;; Author: Erick Gallesio, Manuel Serrano, Ludovic Court�s
;;;
@@ -88,6 +90,10 @@
(expression biblio-template-error:expression)
(template biblio-template-error:template))
+(define-condition-type &biblio-parse-error &biblio-error
+ biblio-parse-error?
+ (sexp biblio-parse-error:sexp))
+
(define (handle-biblio-error c)
;; Issue a user-friendly error message for error condition C.
@@ -108,6 +114,10 @@
(_ "invalid bibliography entry template: `~a', in `~a'~%")
(biblio-template-error:expression c)
(biblio-template-error:template c)))
+ ((biblio-parse-error? c)
+ (format (current-error-port)
+ (_ "invalid bibliography entry s-exp: `~a'~%")
+ (biblio-parse-error:sexp c)))
(else
(format (current-error-port)
(_ "undefined bibliography error: ~a~%")
@@ -197,7 +207,7 @@
(fields (cddr entry))
(old (hash-ref table key)))
(if old
- (bib-duplicate ident from old)
+ (bib-duplicate key from old)
(hash-set! table key
(make-bib-entry kind key fields from)))
(Loop (read port))))
@@ -290,7 +300,8 @@
(car f))
:parent h
:body (cadr f)))
- (bib-parse-error f)))
+ (raise (condition (&biblio-parse-error
+ (sexp f))))))
fields)
m))
@@ -351,10 +362,7 @@
(let ((body (markup-body m)))
(if (not (string? body))
13
- (let* ((s (if (> (string-length body) 3)
- (substring body 0 3)
- body))
- (sy (string->symbol (string-downcase body)))
+ (let* ((sy (string->symbol (string-downcase body)))
(c (assq sy '((jan . 1)
(feb . 2)
(mar . 3)
diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm
index f7709a0..3b62b6f 100644
--- a/src/guile/skribilo/debug.scm
+++ b/src/guile/skribilo/debug.scm
@@ -21,9 +21,8 @@
(define-module (skribilo debug)
:use-module (skribilo utils syntax)
- :use-module (srfi srfi-17)
:use-module (srfi srfi-39)
- :export-syntax (debug-item with-debug))
+ :export-syntax (debug-item debug-bold with-debug))
(fluid-set! current-reader %skribilo-module-reader)
diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index 3e984fc..8b26a89 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -25,8 +25,6 @@
evaluate-document evaluate-document-from-port
load-document include-document *load-options*)
:autoload (skribilo parameters) (*verbose* *document-path*)
- :autoload (skribilo location) (<location>)
- :autoload (skribilo ast) (ast? markup?)
:autoload (skribilo engine) (*current-engine*
engine? find-engine engine-ident)
:autoload (skribilo reader) (*document-reader*)
@@ -44,7 +42,6 @@
(skribilo lib)
(ice-9 optargs)
- (oop goops)
(srfi srfi-1)
(srfi srfi-13)
(srfi srfi-34)
@@ -160,7 +157,7 @@
(path (append (cond
((not path) (*document-path*))
((string? path) (list path))
- ((not (and (list? path) (every? string? path)))
+ ((not (and (list? path) (every string? path)))
(raise (condition (&invalid-argument-error
(proc-name 'load-document)
(argument path)))))
diff --git a/src/guile/skribilo/index.scm b/src/guile/skribilo/index.scm
index 33f8d15..c6ee2d1 100644
--- a/src/guile/skribilo/index.scm
+++ b/src/guile/skribilo/index.scm
@@ -23,7 +23,6 @@
:use-syntax (skribilo utils syntax)
:use-syntax (skribilo lib)
- :use-module (skribilo lib)
:use-module (skribilo ast)
:use-module (srfi srfi-39)
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
index 18a60a3..3be013a 100644
--- a/src/guile/skribilo/lib.scm
+++ b/src/guile/skribilo/lib.scm
@@ -34,19 +34,16 @@
;; Re-exported because used in `define-markup'.
:re-export (invocation-location)
- :use-module (skribilo config)
:use-module (skribilo ast)
;; useful for `new' to work well with <language>
:autoload (skribilo source) (<language>)
- :use-module (skribilo reader)
:use-module (skribilo parameters)
:use-module (skribilo location)
:use-module (srfi srfi-1)
- :use-module (oop goops)
- :use-module (ice-9 optargs))
+ :use-module (oop goops))
(fluid-set! current-reader %skribilo-module-reader)
@@ -66,9 +63,9 @@
`(let ((make ,make)
(,class-name ,actual-class))
(make ,class-name
- ,@(apply append (map (lambda (x)
- `(,(symbol->keyword (car x)) ,(cadr x)))
- parameters))))))
+ ,@(concatenate (map (lambda (x)
+ `(,(symbol->keyword (car x)) ,(cadr x)))
+ parameters))))))
;;;
;;; DEFINE-MARKUP
@@ -190,7 +187,7 @@
;;; SKRIBE-TYPE-ERROR
;;;
(define (skribe-type-error proc msg obj etype)
- (skribe-error proc (format "~a ~s (~a expected)" msg obj etype) #f))
+ (skribe-error proc (format #f "~a ~s (~a expected)" msg obj etype) #f))
;;;
@@ -200,7 +197,7 @@
(let ((port (current-error-port)))
(when (and file line col)
(format port "~a:~a:~a: " file line col))
- (format port "warning: ")
+ (display "warning: " port)
(for-each (lambda (x) (format port "~a " x)) lst)
(newline port)))
diff --git a/src/guile/skribilo/location.scm b/src/guile/skribilo/location.scm
index e6bf54f..47f72b7 100644
--- a/src/guile/skribilo/location.scm
+++ b/src/guile/skribilo/location.scm
@@ -22,6 +22,7 @@
(define-module (skribilo location)
:use-module (oop goops)
:use-module ((skribilo utils syntax) :select (%skribilo-module-reader))
+ :autoload (srfi srfi-13) (string-prefix?)
:export (<location> location? ast-location
location-file location-line location-column
invocation-location))
@@ -57,7 +58,7 @@
(pwd (getcwd))
(len (string-length pwd))
(lenf (string-length fname))
- (file (if (and (substring=? pwd fname len)
+ (file (if (and (string-prefix? pwd fname len)
(> lenf len))
(substring fname len (+ 1 (string-length fname)))
fname)))
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index ac8eee0..ccded17 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -1,6 +1,6 @@
;;; module.scm -- Integration of Skribe code as Guile modules.
;;;
-;;; Copyright 2005, 2006 Ludovic Court�s <ludovic.courtes@laas.fr>
+;;; Copyright 2005, 2006, 2007 Ludovic Court�s <ludovic.courtes@laas.fr>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -19,10 +19,7 @@
;;; USA.
(define-module (skribilo module)
- :autoload (skribilo reader) (make-reader)
- :use-module (skribilo debug)
:use-module (srfi srfi-1)
- :use-module (ice-9 optargs)
:use-module (srfi srfi-39)
:use-module (skribilo utils syntax)
:export (make-run-time-module *skribilo-user-module*))
diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm
index 2f531cd..0113db6 100644
--- a/src/guile/skribilo/prog.scm
+++ b/src/guile/skribilo/prog.scm
@@ -23,8 +23,9 @@
:use-module (ice-9 regex)
:autoload (ice-9 receive) (receive)
:use-module (skribilo lib) ;; `new'
- :autoload (skribilo ast) (node? node-body)
+ :use-module (skribilo ast)
:use-module (skribilo utils syntax)
+ :autoload (skribilo package base) (mark)
:export (make-prog-body resolve-line))
@@ -43,8 +44,7 @@
(define pregexp-quote regexp-quote)
-(define (node-body-set! b v)
- (slot-set! b 'body v))
+(define node-body-set! markup-body-set!)
;;;
;;; FIXME: Tout le module peut se factoriser
@@ -186,13 +186,6 @@
;* make-prog-body ... */
;*---------------------------------------------------------------------*/
(define (make-prog-body src lnum-init ldigit mark)
- (define (int->str i rl)
- (let* ((s (number->string i))
- (l (string-length s)))
- (if (= l rl)
- s
- (string-append (make-string (- rl l) #\space) s))))
-
(let* ((regexp (and mark
(format #f "~a[-a-zA-Z_][-0-9a-zA-Z_]+"
(pregexp-quote mark))))
@@ -205,8 +198,7 @@
(s (number->string (+ (if (integer? ldigit)
(max lnum (expt 10 (- ldigit 1)))
lnum)
- (length lines))))
- (cs (string-length s)))
+ (length lines)))))
(let loop ((lines lines)
(lnum lnum)
(res '()))
diff --git a/src/guile/skribilo/reader.scm b/src/guile/skribilo/reader.scm
index 871d92c..d9abd1f 100644
--- a/src/guile/skribilo/reader.scm
+++ b/src/guile/skribilo/reader.scm
@@ -30,7 +30,7 @@
&reader-search-error reader-search-error?
reader-search-error:reader)
- :export-syntax (define-reader define-public-reader))
+ :export-syntax (define-reader define-public-reader reader?))
;;; Author: Ludovic Court�s
;;;
diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm
index 94ab360..4a83703 100644
--- a/src/guile/skribilo/resolve.scm
+++ b/src/guile/skribilo/resolve.scm
@@ -31,8 +31,8 @@
:use-module (srfi srfi-34)
:use-module (srfi srfi-35)
- :export (resolve! resolve-search-parent resolve-children resolve-children*
- find1 resolve-counter resolve-parent resolve-ident
+ :export (resolve! resolve-search-parent
+ resolve-counter resolve-parent resolve-ident
*document-being-resolved*))
(fluid-set! current-reader %skribilo-module-reader)
@@ -239,7 +239,7 @@
(debug-item "searching=" pred)
(let ((p (resolve-parent n e)))
(debug-item "parent=" p " "
- (if (is-a? p 'markup) (slot-ref p 'markup) "???"))
+ (if (is-a? p <markup>) (slot-ref p 'markup) "???"))
(cond
((pred p) p)
((is-a? p <unresolved>) p)
@@ -262,10 +262,7 @@
(list (list (symbol-append cnt '-counter) 0)
(list (symbol-append cnt '-env) '())))
(resolve-counter n e cnt val)))
- (let* ((num (cadr c))
- (nval (if (integer? val)
- val
- (+ 1 num))))
+ (let* ((num (cadr c)))
(let ((c2 (assq (symbol-append cnt '-env) e)))
(set-car! (cdr c2) (cons (resolve-parent n e) (cadr c2))))
(cond
diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm
index a61de4f..3513e98 100644
--- a/src/guile/skribilo/source.scm
+++ b/src/guile/skribilo/source.scm
@@ -22,11 +22,12 @@
(define-module (skribilo source)
:export (<language> language? language-extractor language-fontifier
+ language-name
source-read-lines source-read-definition source-fontify)
:use-module (srfi srfi-35)
:autoload (srfi srfi-34) (raise)
- :autoload (srfi srfi-13) (string-prefix-length)
+ :autoload (srfi srfi-13) (string-prefix-length string-concatenate)
:autoload (skribilo condition) (&file-search-error &file-open-error)
:use-module (skribilo utils syntax)
@@ -44,7 +45,7 @@
;;;
(define-class <language> ()
- (name :init-keyword :name :init-value #f :getter langage-name)
+ (name :init-keyword :name :init-value #f :getter language-name)
(fontifier :init-keyword :fontifier :init-value #f
:getter language-fontifier)
(extractor :init-keyword :extractor :init-value #f
@@ -78,7 +79,7 @@
(and (integer? stop) (> l stop))
(and (string? stop)
(= (string-prefix-length stop s) stopl)))
- (apply string-append (reverse! r)))
+ (string-concatenate (reverse! r)))
(armedp
(loop (+ l 1)
#t
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index 3f13c42..6ba066b 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -24,7 +24,7 @@
:use-module (skribilo utils files)
:use-module (skribilo parameters)
:use-module (skribilo evaluator)
- :use-module (skribilo location)
+ :use-module (skribilo lib)
:use-module (srfi srfi-1)
:autoload (srfi srfi-13) (string-rindex)
:use-module (srfi srfi-34)
@@ -32,7 +32,6 @@
:autoload (skribilo ast) (ast? document? document-lookup-node)
:autoload (skribilo condition) (file-search-error? &file-search-error)
:autoload (skribilo reader) (make-reader)
- :autoload (skribilo lib) (type-name)
:autoload (skribilo resolve) (*document-being-resolved*)
:autoload (skribilo output) (*document-being-output*)
:autoload (skribilo biblio) (*bib-table* open-bib-file)
diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm
index 052b5cc..3d37817 100644
--- a/src/guile/skribilo/verify.scm
+++ b/src/guile/skribilo/verify.scm
@@ -42,7 +42,6 @@
;;;
(define (check-required-options markup writer engine)
(let ((required-options (slot-ref markup 'required-options))
- (ident (slot-ref writer 'ident))
(options (slot-ref writer 'options))
(verified? (slot-ref writer 'verified?)))
(or verified?
@@ -150,11 +149,10 @@
;; verify the engine customs
(for-each (lambda (c)
- (let ((i (car c))
- (a (cadr c)))
+ (let ((a (cadr c)))
(set-car! (cdr c) (verify a e))))
(slot-ref e 'customs))
node)
-;;; verify.scm ends here
\ No newline at end of file
+;;; verify.scm ends here
diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm
index b16819d..9c00f82 100644
--- a/src/guile/skribilo/writer.scm
+++ b/src/guile/skribilo/writer.scm
@@ -20,7 +20,7 @@
;;; USA.
(define-module (skribilo writer)
- :export (<writer> writer? write-object writer-options writer-ident
+ :export (<writer> writer? writer-options writer-ident
writer-before writer-action writer-after writer-class
invoke markup-writer markup-writer-get markup-writer-get*
@@ -89,11 +89,9 @@
(define (make-writer-predicate markup predicate class)
- (define (%always-true n e) #t)
-
(let* ((t2 (if class
(lambda (n e)
- (and (equal? (markup-class n) class)))
+ (equal? (markup-class n) class))
#f)))
(if predicate
(cond
@@ -230,7 +228,6 @@
(skribe-error 'markup-writer "illegal engine" e))
(else
(let* ((writers (slot-ref e 'writers))
- (markup-writers (hashq-ref writers markup '()))
(delegate (slot-ref e 'delegate)))
(append (matching-writers writers)
--
cgit v1.2.3