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 --- doc/user/user.skb | 6 +- skr/html.skr | 132 +++++++++++++++++------------ src/bigloo/color.scm | 4 +- tools/skribebibtex/bigloo/skribebibtex.scm | 2 +- 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 @@ -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 "") 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)) -- cgit v1.2.3