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(-)

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