Merge from skribilo@sv.gnu.org--2006

Patches applied:

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2  (patch 118-121)
 * skribilo@sv.gnu.org--2006/skribilo--devo--1.2  (patch 134-137)

   - Renamed the `coloring' module tree to `source' for consistency.
   - Fixed the `sui' module.
   - Moved SUI stuff from `html.scm' to `sui.scm'.
   - Linted documentation modules.

git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-84

3 files changed, 67 insertions, 54 deletions

diff --git a/doc/modules/skribilo/documentation/api.scm b/doc/modules/skribilo/documentation/api.scm
index 052b5fa..429dcf6 100644
--- a/doc/modules/skribilo/documentation/api.scm
+++ b/doc/modules/skribilo/documentation/api.scm
@@ -1,7 +1,7 @@
 ;;; api.scm  --  The style for documenting Scheme APIs.
 ;;;
 ;;; Copyright 2003, 2004  Manuel Serrano
-;;; 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
@@ -26,7 +26,6 @@
   :use-module (skribilo ast)
   :use-module (skribilo output)
   :use-module (skribilo lib) ;; `define-markup'
-  :use-module (skribilo utils keywords)
   :use-module (skribilo utils compat)
   :use-module (skribilo utils syntax) ;; `%skribilo-module-reader'
 
@@ -38,7 +37,7 @@
   :use-module (ice-9 match)
   :use-module (ice-9 optargs))
 
-(fluid-set! current-reader (make-reader 'skribe))
+(fluid-set! current-reader %skribilo-module-reader)
 
 
 ;*---------------------------------------------------------------------*/
@@ -156,7 +155,7 @@
 	   o
 	   #f))
       ((exp ___)
-       (let loop ((exp exp))
+       (let ((exp exp))
 	 (cond ((null? exp)
 		#f)
 	       ((pair? exp)
@@ -180,9 +179,6 @@
       (else
        '()))))
 
-(define (sym/kw? x)
-  (or (symbol? x) (keyword? x)))
-
 ;*---------------------------------------------------------------------*/
 ;*    define-markup-formals ...                                        */
 ;*    -------------------------------------------------------------    */
@@ -222,7 +218,7 @@
       ((_ (args ___) _ ___)
        (if (not (list? args))
 	   '()
-	   (let ((keys (memq #!key args)))
+	   (let ((keys (memq :key args)))
 	      (if (pair? keys)
 		  (cdr keys) ;; FIXME: do we need to filter ((key val)...)?
 		  '()))))
@@ -248,7 +244,7 @@
 	   (let ((l (last-pair args)))
 	      (if (symbol? (cdr l))
 		  (cdr l)
-		  (let ((rest (memq #!rest args)))
+		  (let ((rest (memq :rest args)))
 		     (if (pair? rest)
 			 (if (or (not (pair? (cdr rest)))
 				 (not (symbol? (cadr rest))))
@@ -321,7 +317,7 @@
 	  (tr (td :align 'left exp))))
       (else 
        (match exp
-	  ((quote (and ?sym (? symbol?)))
+	  ((and sym (? symbol?))
 	   (string-append "'" (symbol->string sym)))
 	  (else
 	   (with-output-to-string (lambda () (write exp))))))))
@@ -359,9 +355,9 @@
 ;*    doc-markup ...                                                   */
 ;*---------------------------------------------------------------------*/
 (define-markup (doc-markup id args
-			   #!rest
+			   :rest
 			   opts
-			   #!key
+			   :key
 			   (ident #f)
 			   (writer-id #f)
 			   (common-args '((:ident "The node identifier.")
@@ -443,10 +439,10 @@
 	      (doptions (filter (lambda (x) 
 				   (and (keyword? (car x))
 					;; useful for STklos only
-					(not (eq? (car x) #!rest))))
+					(not (eq? (car x) :rest))))
 				args))
 	      (drest (filter (lambda (x) 
-				(eq? #!rest (car x))) 
+				(eq? :rest (car x))) 
 			     args))
 	      (dargs (and (pair? drest) (cadr (car drest))))
 	      (p+ (cons (doc-markup-proto id options fformals dargs)
@@ -492,7 +488,8 @@
 				   (ref :mark s :text (code s))
 				   " ")))
 			    see-also)))
-		(table :border (if (engine-format? "latex") 1 0)
+		(table :&location &invocation-location
+                   :border (if (engine-format? "latex") 1 0)
 		   :width (if (engine-format? "latex") #f *prgm-width*)
 		   `(,(tr :class 'api-table-prototype
 			 (th :colspan 3 :align 'left :width *prgm-width*
@@ -546,7 +543,7 @@
 			       (let ((s (symbol->string x)))
 				  (list 
 				   (ref :mark s :page #t 
-				      :text [,(code s), p.])
+				      :text (list (code s) ", p."))
 				   " ")))
 			    see-also)))
 		(list (center 
@@ -591,9 +588,9 @@
 ;*    doc-engine ...                                                   */
 ;*---------------------------------------------------------------------*/
 (define-markup (doc-engine id args
-			   #!rest 
+			   :rest 
 			   opts
-			   #!key 
+			   :key 
 			   (idx *custom-index*)
 			   source
 			   (skribe-source? #t)
@@ -613,7 +610,8 @@
 	      #f)
 	     (else
 	      (center
-		 (apply table 
+		 (apply table
+                        :&location &invocation-location
 			:width *prgm-width*
 			(tr :class 'api-table-header
 			   (th :align 'left :width 20. "custom")
diff --git a/doc/modules/skribilo/documentation/extension.scm b/doc/modules/skribilo/documentation/extension.scm
index e012cb2..7efee6f 100644
--- a/doc/modules/skribilo/documentation/extension.scm
+++ b/doc/modules/skribilo/documentation/extension.scm
@@ -1,6 +1,7 @@
-;;; extension.scm  --  The Skribe package for documenting extensions
+;;; extension.scm  --  The Skribilo package for documenting extensions.
 ;;;
 ;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2007  Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
@@ -19,17 +20,35 @@
 ;;; USA.
 
 (define-module (skribilo documentation extension)
-  :use-module (skribilo reader)
-  :use-module (skribilo utils compat))
+  :use-module (skribilo sui)
+  :use-module (skribilo config)
+  :use-module (skribilo parameters)
 
-(fluid-set! current-reader (make-reader 'skribe))
+  :use-module (skribilo lib)
+  :use-module (skribilo ast)
+  :use-module (skribilo engine)
+  :use-module (skribilo writer)
+  :use-module (skribilo output)
+  :use-module (skribilo evaluator)
+
+  :use-module (skribilo package base)
+  :use-module (skribilo engine html)
+
+  :use-module (skribilo utils files)
+  :use-module (skribilo utils compat)
+  :use-module (skribilo utils syntax)
+  :use-module (skribilo utils keywords)
+
+  :use-module (ice-9 optargs))
+
+(fluid-set! current-reader %skribilo-module-reader)
 
 
 ;*---------------------------------------------------------------------*/
 ;*    extension                                                        */
 ;*---------------------------------------------------------------------*/
-(define-markup (extension #!rest opt 
-			  #!key (ident (symbol->string (gensym 'extension)))
+(define-markup (extension :rest opt 
+			  :key (ident (symbol->string (gensym 'extension)))
 			  (class "extension")
 			  title html-title ending author description 
 			  (env '()))
@@ -37,6 +56,7 @@
       (markup 'extension)
       (ident ident)
       (class class)
+      (loc &invocation-location)
       (options (the-options opt))
       (body (the-body opt))
       (env (append env
@@ -45,7 +65,7 @@
 			 (list 'section-counter 0) (list 'section-env '())
 			 (list 'footnote-counter 0) (list 'footnote-env '())
 			 (list 'figure-counter 0) (list 'figure-env '()))))))
-		  
+
 ;*---------------------------------------------------------------------*/
 ;*    html engine                                                      */
 ;*---------------------------------------------------------------------*/
@@ -56,24 +76,24 @@
 		     (and (pair? m) (car m)))))
 	    (if (not i)
 		(table :width 100. :border 0 :cellspacing 0 :cellpadding 0
-		   (tr (td :align 'left :valign 'top (bold "Skribe: "))
+		   (tr (td :align 'left :valign 'top (bold "Skribilo: "))
 		      (td :align 'right :valign 'top
-			 (ref :url *skribe-dir-doc-url* 
+			 (ref :url (skribilo-doc-directory)
 			    :text "Directory")))
 		   (tr (td)
 		      (td :align 'right :valign 'top
-			 (ref :url *skribe-user-doc-url* 
+			 (ref :url (skribilo-doc-directory)
 			    :text "User Manual"))))
 		(table :width 100. :border 0 :cellspacing 0 :cellpadding 0
 		   (tr (td :align 'left :valign 'top (bold "index:"))
 		      (td :align 'right (ref :handle (handle i))))
 		   (tr (td :align 'left :valign 'top (bold "Skribe: "))
 		      (td :align 'right :valign 'top
-			 (ref :url *skribe-dir-doc-url* 
+			 (ref :url (skribilo-doc-directory)
 			    :text "Directory")))
 		   (tr (td)
 		      (td :align 'right :valign 'top
-			 (ref :url *skribe-user-doc-url* 
+			 (ref :url (skribilo-doc-directory)
 			    :text "User Manual"))))))))
    (default-engine-set! he))
 
@@ -83,14 +103,14 @@
 (define (extension-sui n e)
    (define (sui)
       (display "(sui \"")
-      (skribe-eval (markup-option n :title) html-title-engine)
+      (evaluate-document (markup-option n :title) html-title-engine)
       (display "\"\n")
       (printf "  :file ~s\n" (sui-referenced-file n e))
       (printf "  :description ~s\n" (markup-option n :description))
       (sui-marks n e)
       (display "  )\n"))
-   (if (string? *skribe-dest*)
-       (let ((f (format "~a.sui" (prefix *skribe-dest*))))
+   (if (string? (*destination-file*))
+       (let ((f (string-append (file-prefix (*destination-file*)) ".sui")))
 	  (with-output-to-file f sui))
        (sui)))
 
@@ -99,8 +119,9 @@
 ;*---------------------------------------------------------------------*/
 (markup-writer 'extension
    :options '(:title :html-title :ending :author :description)
-   :action (lambda (n e)
-	      (output n e (markup-writer-get 'document he)))
+   :action (let ((he (find-engine 'html)))
+             (lambda (n e)
+               (output n e (markup-writer-get 'document he))))
    :after (lambda (n e)
 	     (if (engine-custom e 'emit-sui)
 		 (extension-sui n e))))
diff --git a/doc/modules/skribilo/documentation/manual.scm b/doc/modules/skribilo/documentation/manual.scm
index ca4eafb..6978afd 100644
--- a/doc/modules/skribilo/documentation/manual.scm
+++ b/doc/modules/skribilo/documentation/manual.scm
@@ -1,6 +1,7 @@
-;;; manual.scm  --  Skribe manuals and documentation pages style
+;;; manual.scm  --  Skribilo manuals and documentation style.
 ;;;
 ;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2007  Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
@@ -19,7 +20,6 @@
 ;;; USA.
 
 (define-module (skribilo documentation manual)
-  :use-module (skribilo reader)
   :use-module (skribilo engine)
   :use-module (skribilo writer)
   :use-module (skribilo ast)
@@ -28,17 +28,16 @@
   :use-module (skribilo output)
   :use-module (skribilo utils keywords)
   :use-module (skribilo utils compat)
-  :use-module (skribilo utils syntax) ;; `when'
+  :use-module (skribilo utils syntax)
 
   :use-module (skribilo documentation env)
   :use-module (skribilo package base)
-  :use-module (skribilo prog)
-  :use-module (skribilo coloring lisp)
-  :use-module (skribilo coloring xml)
+  :use-module (skribilo source lisp)
+  :use-module (skribilo source xml)
 
   :use-module (ice-9 optargs))
 
-(fluid-set! current-reader (make-reader 'skribe))
+(fluid-set! current-reader %skribilo-module-reader)
 
 
 ;*---------------------------------------------------------------------*/
@@ -121,7 +120,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    prgm ...                                                         */
 ;*---------------------------------------------------------------------*/
-(define-markup (prgm #!rest opts #!key (language skribe) (line #f) (file #f) (definition #f))
+(define-markup (prgm :rest opts :key (language skribe) (line #f) (file #f) (definition #f))
    (let* ((c (cond
 		((eq? language skribe) *prgm-skribe-color*)
 		((eq? language xml) *prgm-xml-color*)
@@ -145,7 +144,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    disp ...                                                         */
 ;*---------------------------------------------------------------------*/
-(define-markup (disp #!rest opts #!key (verb #f) (line #f) (bg *disp-color*))
+(define-markup (disp :rest opts :key (verb #f) (line #f) (bg *disp-color*))
    (if (engine-format? "latex")
        (if verb 
 	   (pre (the-body opts))
@@ -188,7 +187,7 @@
 ;*---------------------------------------------------------------------*/
 ;*    example ...                                                      */
 ;*---------------------------------------------------------------------*/
-(define-markup (example #!rest opts #!key legend class)
+(define-markup (example :rest opts :key legend class)
    (new container
       (markup 'example)
       (ident (symbol->string (gensym 'example)))
@@ -233,8 +232,7 @@
 			(list l)
 			(list (tr (td :colspan 2)) l))))
 	      (define (make-primary-entry n p)
-		 (let* ((note (markup-option n :note))
-			(b (markup-body n)))
+		 (let ((b (markup-body n)))
 		    (when p 
 		       (markup-option-add! b :text 
 					   (list (markup-option b :text) 
@@ -290,18 +288,14 @@
 		     (nc (markup-option n :column))
 		     (pref (eq? (engine-custom e 'index-page-ref) #t))
 		     (loc (ast-loc n))
-		     ;; FIXME: Since we don't support
-		     ;; `:&skribe-eval-location', we could set up a
-		     ;; `parameterize' thing around `skribe-eval' to provide
-		     ;; it with the right location information.
 		     (t (cond
 			   ((null? ie)
 			    "")
 			   ((or (not (integer? nc)) (= nc 1))
-			    (table :width 100. ;;:&skribe-eval-location loc
+			    (table :width 100. :&location loc
 			       (make-column ie pref)))
 			   (else
-			    (table :width 100. ;;:&skribe-eval-location loc
+			    (table :width 100. :&location loc
 			       (make-sub-tables ie nc pref))))))
 		 (output (skribe-eval t e) e))))