Various bugfixes; new `file-name-proc' custom for the HTML engine.

* tools/skribebibtex/bigloo/skribebibtex.scm (skribebibtex):  Don't enclose
  `ident' in double quotes.

* doc/user/user.skb:  Made "Introduction" a chapter rather than a section;
  likewise for its subsections.

* skr/html.skr (itemize):  Produce an anchor if `ident' is not false.
  (enumerate):  Likewise.
  (html-file-default):  New procedure.
  (file-name-proc):  New custom.

* src/bigloo/color.scm (*color-parser*):  Fixed the "black" and "white"
  colors (were inverted).

git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-1

4 files changed, 82 insertions, 62 deletions

diff --git a/doc/user/user.skb b/doc/user/user.skb
index 07a6e03..3710be9 100644
--- a/doc/user/user.skb
+++ b/doc/user/user.skb
@@ -59,7 +59,7 @@ This is the documentation for Skribe version
    (linebreak 1)
 
 ;;; Introduction
-(section :title "Introduction" :number #f :toc #f [
+(chapter :title "Introduction" :number #f :toc #f [
 Skribe is a programming language designed for implementing electronic
 documents. It is mainly designed for the writing of technical documents
 such as the documentation of computer programs. With Skribe these
@@ -68,13 +68,13 @@ instance, a Skribe document can be ,(emph "compiled") to an HTML file
 that suits Web browser, it can be compiled to a TeX file in order to
 produce a high-quality printed document, and so on.]
    
-   (subsection :title "Who may use Skribe?" :number #f [
+   (section :title "Who may use Skribe?" :number #f [
 Everyone needing to design web pages, info documents, man pages or
 Postscript files can use Skribe. In particular, there is ,(bold "no need")
 for programming skills in order to use Skribe. Skribe can be used as
 any text description languages such as TeX, LaTeX or HTML.])
    
-   (subsection :title "Why using Skribe?" :number #f [
+   (section :title "Why using Skribe?" :number #f [
 There are three main reasons for using Skribe:]
       
       (itemize
diff --git a/skr/html.skr b/skr/html.skr
index ebac5f2..79186ca 100644
--- a/skr/html.skr
+++ b/skr/html.skr
@@ -17,6 +17,62 @@
 ;*=====================================================================*/
 
 ;*---------------------------------------------------------------------*/
+;*    html-file-default ...                                            */
+;*---------------------------------------------------------------------*/
+(define html-file-default
+   ;; Default implementation of the `file-name-proc' custom.
+   (let ((table '())
+        (filename (gensym)))
+      (define (get-file-name base suf)
+        (let* ((c (assoc base table))
+               (n (if (pair? c)
+                      (let ((n (+ 1 (cdr c))))
+                         (set-cdr! c n)
+                         n)
+                      (begin
+                         (set! table (cons (cons base 1) table))
+                         1))))
+           (format "~a-~a.~a" base n suf)))
+      (lambda (node e)
+        (let ((f (markup-option node filename))
+              (file (markup-option node :file)))
+           (cond
+              ((string? f)
+               f)
+              ((string? file)
+               file)
+              ((or file 
+                   (and (is-markup? node 'chapter)
+                        (engine-custom e 'chapter-file))
+                   (and (is-markup? node 'section)
+                        (engine-custom e 'section-file))
+                   (and (is-markup? node 'subsection)
+                        (engine-custom e 'subsection-file))
+                   (and (is-markup? node 'subsubsection)
+                        (engine-custom e 'subsubsection-file)))
+               (let* ((b (or (and (string? *skribe-dest*)
+                                  (prefix *skribe-dest*))
+                             ""))
+                      (s (or (and (string? *skribe-dest*)
+                                  (suffix *skribe-dest*))
+                             "html"))
+                      (nm (get-file-name b s)))
+                  (markup-option-add! node filename nm)
+                  nm))
+              ((document? node)
+               *skribe-dest*)
+              (else
+               (let ((p (ast-parent node)))
+                  (if (container? p)
+                      (let ((file (html-file p e)))
+                         (if (string? file)
+                             (begin
+                                (markup-option-add! node filename file)
+                                file)
+                             #f))
+                      #f))))))))
+
+;*---------------------------------------------------------------------*/
 ;*    html-engine ...                                                  */
 ;*---------------------------------------------------------------------*/
 (define html-engine
@@ -73,6 +129,8 @@
 		   (title-background "#8381de")
 		   (title-foreground #f)
 		   (file-title-separator " -- ")
+		   ;; html file naming
+		   (file-name-proc ,html-file-default)
 		   ;; index configuration
 		   (index-header-font-size +2.)
 		   ;; chapter configuration
@@ -346,6 +404,13 @@
 			 ("parallel" "||")))))
 
 ;*---------------------------------------------------------------------*/
+;*    html-file ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (html-file n e)
+  (let ((proc (or (engine-custom e 'file-name-proc) html-file-default)))
+    (proc n e)))
+
+;*---------------------------------------------------------------------*/
 ;*    html-title-engine ...                                            */
 ;*---------------------------------------------------------------------*/
 (define html-title-engine
@@ -365,60 +430,6 @@
 		(markup-option n :title)
 		(html-browser-title (ast-parent n))))))
 
-;*---------------------------------------------------------------------*/
-;*    html-file ...                                                    */
-;*---------------------------------------------------------------------*/
-(define html-file
-   (let ((table '())
-	 (filename (gensym)))
-      (define (get-file-name base suf)
-	 (let* ((c (assoc base table))
-		(n (if (pair? c)
-		       (let ((n (+ 1 (cdr c))))
-			  (set-cdr! c n)
-			  n)
-		       (begin
-			  (set! table (cons (cons base 1) table))
-			  1))))
-	    (format "~a-~a.~a" base n suf)))
-      (lambda (node e)
-	 (let ((f (markup-option node filename))
-	       (file (markup-option node :file)))
-	    (cond
-	       ((string? f)
-		f)
-	       ((string? file)
-		file)
-	       ((or file 
-		    (and (is-markup? node 'chapter)
-			 (engine-custom e 'chapter-file))
-		    (and (is-markup? node 'section)
-			 (engine-custom e 'section-file))
-		    (and (is-markup? node 'subsection)
-			 (engine-custom e 'subsection-file))
-		    (and (is-markup? node 'subsubsection)
-			 (engine-custom e 'subsubsection-file)))
-		(let* ((b (or (and (string? *skribe-dest*)
-				   (prefix *skribe-dest*))
-			      ""))
-		       (s (or (and (string? *skribe-dest*)
-				   (suffix *skribe-dest*))
-			      "html"))
-		       (nm (get-file-name b s)))
-		   (markup-option-add! node filename nm)
-		   nm))
-	       ((document? node)
-		*skribe-dest*)
-	       (else
-		(let ((p (ast-parent node)))
-		   (if (container? p)
-		       (let ((file (html-file p e)))
-			  (if (string? file)
-			      (begin
-				 (markup-option-add! node filename file)
-				 file)
-			      #f))
-		       #f))))))))
 
 ;*---------------------------------------------------------------------*/
 ;*    html-container-number ...                                        */
@@ -1556,11 +1567,16 @@ Last update ,(it (date)).]))] e))))
    :before (html-markup-class "ul")
    :action (lambda (n e)
 	      (for-each (lambda (item)
+			  (let ((ident (and (markup? item)
+					    (markup-ident item))))
 			   (display "<li")
 			   (html-class item)
 			   (display ">")
+			    (if ident  ;; produce an anchor
+				(printf "\n<a name=\"~a\"></a>\n"
+					(string-canonicalize ident)))
 			   (output item e)
-			   (display "</li>\n"))
+			    (display "</li>\n")))
 			(markup-body n)))
    :after "</ul>")
 
@@ -1572,11 +1588,15 @@ Last update ,(it (date)).]))] e))))
    :before (html-markup-class "ol")
    :action (lambda (n e)
 	      (for-each (lambda (item)
+			  (let ((ident (and (markup? item)
+					    (markup-ident item))))
 			   (display "<li")
 			   (html-class item)
 			   (display ">")
+			    (if ident  ;; produce an anchor
+				(printf "\n<a name=\"~a\"></a>\n" ident))
 			   (output item e)
-			   (display "</li>\n"))
+			    (display "</li>\n")))
 			(markup-body n)))
    :after "</ol>")
 
diff --git a/src/bigloo/color.scm b/src/bigloo/color.scm
index e40638b..e481d65 100644
--- a/src/bigloo/color.scm
+++ b/src/bigloo/color.scm
@@ -657,9 +657,9 @@
 	     ((string-ci=? name "none")
 	      (values 0 0 0))
 	     ((string-ci=? name "black")
-	      (values #xff #xff #xff))
-	     ((string-ci=? name "white")
 	      (values 0 0 0))
+	     ((string-ci=? name "white")
+	      (values #xff #xff #xff))
 	     (else
 	      (rgb-grep name)))))
       
diff --git a/tools/skribebibtex/bigloo/skribebibtex.scm b/tools/skribebibtex/bigloo/skribebibtex.scm
index b581537..25f3e16 100644
--- a/tools/skribebibtex/bigloo/skribebibtex.scm
+++ b/tools/skribebibtex/bigloo/skribebibtex.scm
@@ -33,7 +33,7 @@
 		      ((?kind ?ident . ?fields)
 		       (display* "("
 				 (string-downcase (symbol->string kind))
-				 " \"" ident "\"")
+				 ident)
 		       (for-each (lambda (f)
 				    (display* "\n   (" (car f) " ")
 				    (write (cdr f))