summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/user/user.skb6
-rw-r--r--skr/html.skr132
-rw-r--r--src/bigloo/color.scm4
-rw-r--r--tools/skribebibtex/bigloo/skribebibtex.scm2
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))
generated by cgit v1.2.3 (git 2.45.2) at 2024-11-01 07:23:48 +0000