context: Don't rely on `skribe-get-used-colors' and similar.

* src/guile/skribilo/color.scm (document-used-colors): New.

* src/guile/skribilo/engine/context.scm (*skribe-context-color-table*):
  Remove.
  (%doc-table, document-color-table, use-color!, declare-used-colors,
  use-standard-colors!, get-color): New.
  (skribe-declare-used-colors, skribe-declare-standard-colors,
  skribe-get-color): Remove.
  (document, color, tr): Update to use the above new functions.

2 files changed, 77 insertions, 33 deletions

diff --git a/src/guile/skribilo/color.scm b/src/guile/skribilo/color.scm
index 6b3aa7b..b8f6eac 100644
--- a/src/guile/skribilo/color.scm
+++ b/src/guile/skribilo/color.scm
@@ -1,7 +1,7 @@
 ;;; color.scm -- Color management.
 ;;;
+;;; Copyright 2006, 2007  Ludovic Courtès  <ludo@gnu.org>
 ;;; Copyright 2003, 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;; Copyright 2006  Ludovic Courtès  <ludovic.courtes@laas.fr>
 ;;;
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
@@ -21,9 +21,16 @@
 
 
 (define-module (skribilo color)
-  :autoload (srfi srfi-60) (bitwise-and arithmetic-shift)
-  :export (skribe-color->rgb skribe-get-used-colors skribe-use-color!))
+  :use-module  (skribilo utils syntax)
+  :autoload    (skribilo ast) (search-down)
+  :autoload    (srfi srfi-1)  (append-map)
+  :autoload    (srfi srfi-60) (bitwise-and arithmetic-shift)
+  :export (skribe-color->rgb skribe-get-used-colors skribe-use-color!
+           document-used-colors))
 
+(fluid-set! current-reader %skribilo-module-reader)
+
+
 ;; FIXME: This module should be generalized and the `skribe-' procedures
 ;; moved to `compat.scm'.
 
@@ -620,3 +627,25 @@
 (define (skribe-use-color! color)
   (set! *used-colors* (cons color *used-colors*))
   color)
+
+;;;
+;;; DOCUMENT-USED-COLORS
+;;;
+(define (document-used-colors doc)
+  ;; Return the list of colors used by DOC, a document.
+  (define colored-nodes
+    (search-down (lambda (n)
+                   ;; The only standard markups known to deal with colors.
+                   (or (is-markup? n 'color)
+                       (is-markup? n 'tr)))
+                 doc))
+
+  (append-map (lambda (n)
+                (let ((fg (markup-option n :fg))
+                      (bg (markup-option n :bg)))
+                  (cond ((and bg fg) (list bg fg))
+                        (fg          (list fg))
+                        (bg          (list bg))
+                        (else        '()))))
+              colored-nodes))
+
diff --git a/src/guile/skribilo/engine/context.scm b/src/guile/skribilo/engine/context.scm
index 98069a3..4a47b3a 100644
--- a/src/guile/skribilo/engine/context.scm
+++ b/src/guile/skribilo/engine/context.scm
@@ -1,7 +1,7 @@
 ;;; context.scm  --  ConTeXt engine.
 ;;;
-;;; Copyright 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
 ;;; Copyright 2007  Ludovic Courtès <ludo@chbouib.org>
+;;; Copyright 2004  Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
 ;;;
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
@@ -30,9 +30,9 @@
   :use-module (skribilo package base)
   :autoload   (skribilo utils images)  (convert-image)
   :autoload   (skribilo evaluator)     (evaluate-document)
-  :autoload   (skribilo output)        (output)
+  :autoload   (skribilo output)        (output *document-being-output*)
   :autoload   (skribilo color)         (skribe-color->rgb
-                                        skribe-get-used-colors
+                                        document-used-colors
                                         skribe-use-color!)
   :autoload   (skribilo config)        (skribilo-release)
   :use-module (ice-9 optargs)
@@ -354,8 +354,6 @@
 ;;; ======================================================================
 ;;;	Color Management ...
 ;;; ======================================================================
-(define *skribe-context-color-table* (make-hash-table))
-
 (define (skribe-color->context-color spec)
   (receive (r g b)
      (skribe-color->rgb spec)
@@ -365,35 +363,51 @@
 	       (number->string (/ g ff))
 	       (number->string (/ b ff))))))
 
+(define %doc-table
+  ;; Associate documents with a hash table of used colors.
+  (make-weak-key-hash-table))
+
+(define (document-color-table doc)
+  ;; Return the color table associated with DOC.
+  (or (hashq-ref %doc-table doc)
+      (let ((table (make-hash-table)))
+        (hashq-set! %doc-table doc table)
+        table)))
 
-(define (skribe-declare-used-colors)
+(define (use-color! doc spec)
+  ;; Mark SPEC (a color) as used by DOC.
+  (let ((name (symbol->string (gensym "col"))))
+    (hash-set! (document-color-table doc) spec name)))
+
+(define (declare-used-colors doc)
+  ;; Output a `\definecolor' for each color in DOC's color table.
   (display "\n%%Colors\n")
-  (for-each (lambda (spec)
-	      (let ((c (hash-ref *skribe-context-color-table* spec)))
-		(unless (string? c)
-		  ;; Color was never used before
-		  (let ((name (symbol->string (gensym "col"))))
-		    (hash-set! *skribe-context-color-table* spec name)
-		    (format #t "\\definecolor[~A][~A]\n"
-			    name
-			    (skribe-color->context-color spec))))))
-	    (skribe-get-used-colors))
+  (hash-for-each (lambda (spec name)
+                   (format #t "\\definecolor[~A][~A]\n"
+                           name
+                           (skribe-color->context-color spec)))
+                 (document-color-table doc))
   (newline))
 
-(define (skribe-declare-standard-colors engine)
+(define (use-standard-colors! doc engine)
   (for-each (lambda (x)
-	      (skribe-use-color! (engine-custom engine x)))
+	      (use-color! doc (engine-custom engine x)))
 	    '(source-comment-color source-define-color source-module-color
-	      source-markup-color  source-thread-color source-string-color
-	      source-bracket-color source-type-color)))
-
-(define (skribe-get-color spec)
-  (let ((c (and (hash-table? *skribe-context-color-table*)
-		(hash-ref *skribe-context-color-table* spec))))
+              source-markup-color  source-thread-color source-string-color
+              source-bracket-color source-type-color))
+  (for-each (lambda (c)
+              (use-color! doc c))
+            (document-used-colors doc)))
+
+(define (get-color doc spec)
+  ;; Return the name of color SPEC in DOC.
+  (let* ((table (document-color-table (or doc (*document-being-output*))))
+         (c     (hash-ref table spec)))
     (if (not (string? c))
 	(skribe-error 'context "Can't find color" spec)
 	c)))
 
+
 ;;; ======================================================================
 ;;;	context-engine ...
 ;;; ======================================================================
@@ -432,8 +446,8 @@
 	     (let ((s (engine-custom e 'user-style)))
 	       (when s (format #t "\\input ~a\n" s)))
 	     ;; Output used colors
-	     (skribe-declare-standard-colors e)
-	     (skribe-declare-used-colors)
+	     (use-standard-colors! n e)
+	     (declare-used-colors n)
 
 	     (display "\\starttext\n\\StartTitlePage\n")
 	     ;; title
@@ -606,16 +620,17 @@
 		       (format #t ",offset=~A" (context-width m)))
 		     (when bg
 		       (format #t ",background=color,backgroundcolor=~A"
-			       (skribe-get-color bg)))
+			       (get-color (ast-document n) bg)))
 		     (when fg
 		       (format #t ",foregroundcolor=~A"
-			       (skribe-get-color fg)))
+			       (get-color (ast-document n) fg)))
 		     (when c
 		       (display ",framecorner=round"))
 		     (display "]\n"))
 		   ;; Probably just a foreground was specified
 		   (when fg
-		     (format #t "\\startcolor[~A] " (skribe-get-color fg))))))
+		     (format #t "\\startcolor[~A] "
+                             (get-color (ast-document n) fg))))))
    :after (lambda (n e)
 	    (let ((bg (markup-option n :bg))
 		   (fg (markup-option n :fg))
@@ -881,7 +896,7 @@
 	     (let ((bg (markup-option n :bg)))
 	       (when bg
 		 (format #t "[background=color,backgroundcolor=~A]"
-			 (skribe-get-color bg)))))
+			 (get-color (ast-document n) bg)))))
    :after  "\\eTR\n")