From d75461bc06e1cba0f29990a2604a4a86cd1c0679 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Wed, 15 Jun 2005 13:33:39 +0000 Subject: 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 --- skr/html.skr | 132 ++++++++++++++++++++++++++++++++++------------------------- 1 file changed, 76 insertions(+), 56 deletions(-) (limited to 'skr') diff --git a/skr/html.skr b/skr/html.skr index ebac5f2..79186ca 100644 --- a/skr/html.skr +++ b/skr/html.skr @@ -16,6 +16,62 @@ ;* @ref ../../doc/user/htmle.skb:ref@ */ ;*=====================================================================*/ +;*---------------------------------------------------------------------*/ +;* 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 ... */ ;*---------------------------------------------------------------------*/ @@ -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 @@ -345,6 +403,13 @@ ("rhd" ">") ("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 ... */ ;*---------------------------------------------------------------------*/ @@ -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 "") + (if ident ;; produce an anchor + (printf "\n\n" + (string-canonicalize ident))) (output item e) - (display "\n")) + (display "\n"))) (markup-body n))) :after "") @@ -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 "") + (if ident ;; produce an anchor + (printf "\n\n" ident)) (output item e) - (display "\n")) + (display "\n"))) (markup-body n))) :after "") -- cgit v1.2.3