From 2fadd039d81bab15cec87529a5b160d2f1df1e0e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Thu, 29 Nov 2007 17:31:02 +0100
Subject: 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.
---
src/guile/skribilo/color.scm | 35 ++++++++++++++--
src/guile/skribilo/engine/context.scm | 75 +++++++++++++++++++++--------------
2 files changed, 77 insertions(+), 33 deletions(-)
(limited to 'src')
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")
--
cgit v1.2.3