aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog129
-rw-r--r--doc/user/package.skb51
-rw-r--r--doc/user/src/html-navtabs.skb118
-rw-r--r--src/guile/skribilo/lib.scm41
-rw-r--r--src/guile/skribilo/package/Makefile.am3
-rw-r--r--src/guile/skribilo/package/html-navtabs.scm359
-rw-r--r--src/guile/skribilo/reader/outline.scm20
-rw-r--r--src/guile/skribilo/sui.scm2
8 files changed, 695 insertions, 28 deletions
diff --git a/ChangeLog b/ChangeLog
index 34dd0c5..b0d53de 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,135 @@
# arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2
#
+2007-08-20 16:28:40 GMT Ludovic Court`es <ludovic.courtes@laas.fr> patch-144
+
+ Summary:
+ lout engine: Always use `@BypassNumber'.
+ Revision:
+ skribilo--devo--1.2--patch-144
+
+ * src/guile/skribilo/engine/lout.scm (lout-block-before): Always use
+ `@BypassNumber'.
+
+ modified files:
+ ChangeLog src/guile/skribilo/engine/lout.scm
+
+ new patches:
+ lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-83
+ lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-84
+ lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-85
+
+
+2007-07-29 10:30:53 GMT Ludovic Courtes <ludo@gnu.org> patch-143
+
+ Summary:
+ Documented `html-navtabs'.
+ Revision:
+ skribilo--devo--1.2--patch-143
+
+ * doc/user/package.skb (HTML Navigation Tabs): New subsection. Borrowed
+ from Manuel Serrano's doc for `html-navtabs'.
+
+ new files:
+ doc/user/src/.arch-ids/html-navtabs.skb.id
+ doc/user/src/html-navtabs.skb
+
+ modified files:
+ ChangeLog doc/user/package.skb
+
+ new patches:
+ lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-127
+
+
+2007-07-29 10:30:23 GMT Ludovic Courtes <ludo@gnu.org> patch-142
+
+ Summary:
+ Allow arbitrary keyword arguments in `define-markup'.
+ Revision:
+ skribilo--devo--1.2--patch-142
+
+ * src/guile/skribilo/lib.scm (define-markup)[fix-rest-arg]: Add
+ `:allow-other-keys' so that package like `html-navtabs' can require
+ extra keyword arguments.
+
+ modified files:
+ ChangeLog src/guile/skribilo/lib.scm
+
+ new patches:
+ lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-126
+
+
+2007-07-29 10:29:53 GMT Ludovic Courtes <ludo@gnu.org> patch-141
+
+ Summary:
+ html-navtabs: Permit disabling of CSS output.
+ Revision:
+ skribilo--devo--1.2--patch-141
+
+ * src/guile/skribilo/package/html-navtabs.scm (&html-header-style):
+ Check whether `html-navtabs-produce-css?' is set.
+
+ modified files:
+ ChangeLog src/guile/skribilo/package/html-navtabs.scm
+
+ new patches:
+ lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-125
+
+
+2007-07-29 10:29:16 GMT Ludovic Courtes <ludo@gnu.org> patch-140
+
+ Summary:
+ Added `html-navtabs' by Manuel Serrano.
+ Revision:
+ skribilo--devo--1.2--patch-140
+
+ * src/guile/skribilo/package/Makefile.am (dist_guilemodule_DATA): Added
+ `html-navtabs.scm'.
+
+ new files:
+ src/guile/skribilo/package/html-navtabs.scm
+
+ modified files:
+ ChangeLog src/guile/skribilo/package/Makefile.am
+
+ new patches:
+ lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-124
+
+
+2007-07-26 15:28:37 GMT Ludovic Courtes <ludo@gnu.org> patch-139
+
+ Summary:
+ `outline' reader: Fixed `append-trees'.
+ Revision:
+ skribilo--devo--1.2--patch-139
+
+ * src/guile/skribilo/reader/outline.scm (append-trees): Make sure only
+ symbols can appear as the head of the resulting list.
+
+ modified files:
+ ChangeLog src/guile/skribilo/reader/outline.scm
+
+ new patches:
+ lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-123
+
+
+2007-07-18 06:50:29 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-138
+
+ Summary:
+ sui: Small autoload fix.
+ Revision:
+ skribilo--devo--1.2--patch-138
+
+ * src/guile/skribilo/sui.scm: Autoload `parameters' on
+ `*destination-file*'.
+
+ modified files:
+ ChangeLog src/guile/skribilo/sui.scm
+
+ new patches:
+ lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-122
+
+
2007-07-04 20:36:43 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-137
Summary:
diff --git a/doc/user/package.skb b/doc/user/package.skb
index 997e263..dba26b3 100644
--- a/doc/user/package.skb
+++ b/doc/user/package.skb
@@ -1,7 +1,7 @@
;;; package.skb -- Packages
;;;
-;;; Copyright 2004, 2005 Manuel Serrano
-;;; Copyright 2007 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2001, 2004, 2005 Manuel Serrano
+;;; Copyright 2007 Ludovic Courtès <ludo@gnu.org>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -155,7 +155,52 @@ The ,(param :css) is a shorthand for ,(param :style). For instance:])
(index :index *package-index* "web-book.skr" :note "package")
(p [
A convenient mode for rendering books (i.e., documents made of
-chapters and sections) in HTML.]))))
+chapters and sections) in HTML.]))
+
+ (subsection :title [HTML Navigation Tabs]
+
+ (p [The ,(tt [html-navtabs]) package enables quick navigation
+inside HTML documents by means of tabs. The produced HTML code uses CSS
+declarations. The ,(tt [html-navtabs]) package does not introduce any
+new markups. It is configured via additional ,(ref :text [engine
+customs.] :chapter "Engines")])
+
+ (subsubsection :title [HTML Engine Customization]
+
+ (p [,(tt [html-navtabs]) is to be used in conjunction with the
+,(ref :text (code "html-engine") :mark "html-engine")
+engine. Specifically, it adds the following new customization to this
+engine:])
+
+ (doc-engine 'html
+ `((html-navtabs [The tabs.])
+ (html-navtabs-padding [Padding above tabs.])
+ (html-navtabs-bar-background [Bar background color.]))
+ :def `(make-engine 'html
+ :custom '((html-navtabs ,(it [Containers whose
+ option ,(param :file) is ,(code "#t")]))
+ (html-navtabs-padding 20.)
+ (html-navtabs-bar-background
+ ,(engine-custom (find-engine 'html)
+ 'left-margin-background))))))
+
+ (subsubsection :title [Additional Container Options]
+
+ (p [,(tt [html-navtabs]) introduces two new ,(ref :text
+"containers" :section "Sectioning") (i.e., a ,(ref :text (code
+"document") :mark "document") ,(ref :text (code "chapter") :mark
+"chapter") ,(ref :text (code "section") :mark "subsection"), ...)
+attributes: ,(param :html-tabs-bar) and ,(param :no-tabs). The
+attribute ,(param :html-tabs-bar) may contain any Skribe expression. It
+controls the content of the navtabs sub-bar (i.e., a small line above
+the tabs). The attribute ,(param :no-tabs) disable tabs for this
+container.]))
+
+ (subsubsection :title [Example]
+
+ (p [Below is a full example using ,(tt [html-navtabs]).])
+
+ (prgm :file "src/html-navtabs.skb")))))
;*---------------------------------------------------------------------*/
;* Emacs indentation */
diff --git a/doc/user/src/html-navtabs.skb b/doc/user/src/html-navtabs.skb
new file mode 100644
index 0000000..27701d4
--- /dev/null
+++ b/doc/user/src/html-navtabs.skb
@@ -0,0 +1,118 @@
+;*---------------------------------------------------------------------*/
+;* Skribilo's `html-navtabs' package */
+;*---------------------------------------------------------------------*/
+(use-modules (skribilo package html-navtabs)
+ (srfi srfi-1))
+
+;*---------------------------------------------------------------------*/
+;* HTML customization */
+;*---------------------------------------------------------------------*/
+(let* ((he (find-engine 'html))
+ (oldh (markup-writer-get '&html-chapter-header he))
+ (colors (circular-list "#ffb643" "#de8bff")))
+ ;; re-bindings
+ (markup-writer '&html-chapter-header he
+ :options 'all
+ :predicate (lambda (n e)
+ (is-markup? (ast-parent n) 'chapter))
+ :action (lambda (n e)
+ (engine-custom-set! e 'left-margin-background (car colors))
+ (set! colors (cdr colors))
+ (output n e oldh))))
+
+;*---------------------------------------------------------------------*/
+;* menu ... */
+;*---------------------------------------------------------------------*/
+(define-markup (menu e #!rest opt #!key title)
+ (table :width 95. :border 1 :cellpadding 0 :cellspacing 0
+ :class "menu"
+ (tr :bg (engine-custom e 'title-background)
+ (th (color :fg (engine-custom e 'background) (bold title))))
+ (tr :bg (engine-custom e 'background)
+ (td (the-body opt)))))
+
+;*---------------------------------------------------------------------*/
+;* linux */
+;*---------------------------------------------------------------------*/
+(define (linux n e)
+ (menu e
+ :title "Linux"
+ (apply table :width 100. :border 0 :class "linux"
+ (tr (td :align 'left :valign 'top (bold "Linux")))
+ (map (lambda (l)
+ (tr (td :align 'left :valign 'top l)))
+ (list (ref :url "http://www.kernel.org/"
+ :text "Linux kernel")
+ (ref :url "http://www.gentoo.org/"
+ :text "Gentoo")
+ (ref :url "http://www.debian.org/"
+ :text "Debian")
+ (ref :url "http://www.redhat.org/"
+ :text "Red Hat")
+ (ref :url "http://www.mandrake.org/"
+ :text "Mandrake"))))))
+
+;*---------------------------------------------------------------------*/
+;* HTML customizations */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+ (engine-custom-set! he 'favicon "icons/serrano.gif")
+ (engine-custom-set! he 'left-margin-size 25.)
+ (engine-custom-set! he 'left-margin
+ (lambda (n e)
+ (list (center (linux n e)))))
+ (engine-custom-set! he 'javascript #t)
+ (engine-custom-set! he 'head "div.skribetitle {
+ padding-top: 40;
+ }
+ div.skribetitle td {
+ font-size: xx-large;
+ font-weight: bold;
+ font-style: oblique;
+ }
+ body {
+ border: 1px;
+ border-color: black;
+ border-style: inset;
+ margin: 0;
+ padding: 0;
+ }
+ div.navtabs-bar form {
+ border: 0 0 0 0;
+ padding: 2px 2px 2px 2px;
+ margin: 2px 2px 2px 2px;
+ clear: none;
+ display: inline;
+ }
+ div.navtabs-bar select {
+ margin: 2px 2px 2px 2px;
+ font-family: Arial,Helvetica,sans-serif;
+ font-size: small;
+ }
+"))
+
+;*---------------------------------------------------------------------*/
+;* The title */
+;*---------------------------------------------------------------------*/
+(define title
+ (table :width 100. :cellpadding 10.
+ (tr (td :align 'center (image :file "linux.png"))
+ (td :align 'left [Skribilo ,(tt [html-navtabs]) Sample]))))
+
+;*---------------------------------------------------------------------*/
+;* The document */
+;*---------------------------------------------------------------------*/
+(document :title title :html-title "html-navtabs"
+ :html-tabs-bar
+ (table (tr (td :align 'right "a two-lines table"))
+ (tr (td :align 'right "yep")))
+
+ (section :title "Foo" :number #f (p [The in-line foo section]))
+
+ (chapter :title "Bar" :file #t
+ :html-tabs-bar [This is the bar chapter]
+ (p [Yehhh.]))
+ (chapter :title "Gee" :file #t
+ :html-tabs-bar [This is the gee chapter]
+ (p ":-)")))
+
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
index 3be013a..8c4c382 100644
--- a/src/guile/skribilo/lib.scm
+++ b/src/guile/skribilo/lib.scm
@@ -1,7 +1,7 @@
;;; lib.scm -- Utilities.
;;;
;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;; Copyright 2005, 2007 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2005, 2007 Ludovic Courtès <ludo@gnu.org>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -73,29 +73,38 @@
(define-macro (define-markup bindings . body)
;; This is just an `(ice-9 optargs)' kind of `lambda*', with DSSSL
;; keyword-style conversion enabled. However, using `(ice-9 optargs)', the
- ;; `#:rest' argument can only appear last, which is not what Skribe/DSSSL
- ;; expect, hence `fix-rest-arg'.
+ ;; `:rest' argument can only appear last, which is not what Skribe/DSSSL
+ ;; expect, hence `fix-rest-arg'. In addition, all keyword arguments are
+ ;; allowed (hence `:allow-other-keys'); they are then checked by `verify'.
(define (fix-rest-arg args)
- (let loop ((args args)
- (result '())
- (rest-arg #f))
+ (let loop ((args args)
+ (result '())
+ (rest-arg '())
+ (has-keywords? #f))
(cond ((null? args)
- (if rest-arg
- (append (reverse result) rest-arg)
- (reverse result)))
+ (let ((result (if has-keywords?
+ (cons :allow-other-keys result)
+ result)))
+ (append! (reverse! result) rest-arg)))
((list? args)
- (let ((is-rest-arg? (eq? (car args) #:rest)))
- (loop (if is-rest-arg? (cddr args) (cdr args))
- (if is-rest-arg? result (cons (car args) result))
- (if is-rest-arg?
- (list (car args) (cadr args))
- rest-arg))))
+ (let ((is-rest-arg? (eq? (car args) :rest))
+ (is-keyword? (eq? (car args) :key)))
+ (if is-rest-arg?
+ (loop (cddr args)
+ result
+ (list (car args) (cadr args))
+ (or has-keywords? is-keyword?))
+ (loop (cdr args)
+ (cons (car args) result)
+ rest-arg
+ (or has-keywords? is-keyword?)))))
((pair? args)
(loop '()
(cons (car args) result)
- (list #:rest (cdr args)))))))
+ (list #:rest (cdr args))
+ has-keywords?)))))
(let ((name (car bindings))
(opts (cdr bindings)))
diff --git a/src/guile/skribilo/package/Makefile.am b/src/guile/skribilo/package/Makefile.am
index 2d26fce..62a8c1c 100644
--- a/src/guile/skribilo/package/Makefile.am
+++ b/src/guile/skribilo/package/Makefile.am
@@ -2,7 +2,8 @@ guilemoduledir = $(GUILE_SITE)/skribilo/package
dist_guilemodule_DATA = acmproc.scm french.scm jfp.scm letter.scm \
lncs.scm scribe.scm sigplan.scm \
slide.scm web-article.scm web-book.scm \
- eq.scm pie.scm base.scm diff.scm
+ eq.scm pie.scm base.scm diff.scm \
+ html-navtabs.scm
SUBDIRS = slide eq pie
diff --git a/src/guile/skribilo/package/html-navtabs.scm b/src/guile/skribilo/package/html-navtabs.scm
new file mode 100644
index 0000000..d50f456
--- /dev/null
+++ b/src/guile/skribilo/package/html-navtabs.scm
@@ -0,0 +1,359 @@
+;;; html-navtabs.scm -- Producing HTML navigation tabs.
+;;;
+;;; Copyright 2004 Manuel Serrano
+;;; Copyright 2007 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo package html-navtabs)
+ :use-module (skribilo lib)
+ :use-module (skribilo ast)
+ :use-module (skribilo engine)
+ :use-module (skribilo writer)
+ :autoload (skribilo output) (output)
+ :autoload (skribilo package base) (handle)
+ :autoload (skribilo engine html) (html-width html-class html-file)
+ :autoload (skribilo parameters) (*destination-file*)
+ :use-module (skribilo utils strings)
+ :use-module (skribilo utils syntax))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+(define (unspecified? obj)
+ ;; Return true if OBJ is "unspecified" (see, e.g., `engine-custom').
+ (eq? obj 'unspecified))
+
+;*---------------------------------------------------------------------*/
+;* &html-navtabs-css-title ... */
+;*---------------------------------------------------------------------*/
+(define (&html-navtabs-css-title n e)
+ (display " div.navtabs-title {
+ padding: 0 0 0 0;
+ margin: 0 0 0 0;
+ border: 0 0 0 0;
+ text-align: left;
+")
+ (let ((bg (engine-custom e 'title-background)))
+ (unless (unspecified? bg)
+ (display " background: ")
+ (output bg e)
+ (display ";\n")))
+ (display " }\n"))
+
+;*---------------------------------------------------------------------*/
+;* &html-navtabs-css-tabs ... */
+;*---------------------------------------------------------------------*/
+(define (&html-navtabs-css-tabs n e)
+ (display " div.navtabs-tabs {
+ clear: left;
+ margin: 0 0 0 0;
+ border: 0 0 0 0;
+ text-align: left;
+")
+ (let ((pd (engine-custom e 'html-navtabs-padding))
+ (ls (engine-custom e 'left-margin-size)))
+ (display " padding: 0 0 0 ")
+ (if (and (unspecified? pd) (unspecified? ls))
+ (display "20%;\n")
+ (begin
+ (output (if (unspecified? pd)
+ (html-width ls)
+ (html-width pd))
+ e)
+ (display ";\n"))))
+ (let ((bg (engine-custom e 'title-background)))
+ (unless (unspecified? bg)
+ (display " background: ")
+ (output bg e)
+ (display ";\n")))
+ (display " }\n"))
+
+;*---------------------------------------------------------------------*/
+;* &html-navtabs-css-bar ... */
+;*---------------------------------------------------------------------*/
+(define (&html-navtabs-css-bar n e)
+ (display " div.navtabs-bar {
+ margin: 0 0 0 0;
+ border: 0 0 0 0;
+ text-align: left;
+ border-top-color: black;
+ border-top-style: solid;
+ border-top-width: 1px;
+")
+ (let ((pd (engine-custom e 'html-navtabs-padding))
+ (ls (engine-custom e 'left-margin-size)))
+ (display " padding: 0 0 0 ")
+ (if (and (unspecified? pd) (unspecified? ls))
+ (display "20%;\n")
+ (begin
+ (output (if (unspecified? pd)
+ (html-width ls)
+ (html-width pd))
+ e)
+ (display ";\n"))))
+ (let ((bg1 (engine-custom e 'html-navtabs-bar-background))
+ (bg2 (engine-custom e 'left-margin-background)))
+ (unless (and (unspecified? bg1) (unspecified? bg2))
+ (display " background: ")
+ (output (if (unspecified? bg1) bg2 bg1) e)
+ (display ";\n")))
+ (display " }\n"))
+
+;*---------------------------------------------------------------------*/
+;* &html-navtabs-css-active ... */
+;*---------------------------------------------------------------------*/
+(define (&html-navtabs-css-active n e)
+ (display " div.navtabs-tabs a.active {
+ color: black;
+ border-width: 1px;
+ border-color: black;
+ border-style: solid;
+ padding: 2px 10px 0px 10px;
+ margin: 0 1px 0 0;
+ text-decoration: none;
+")
+ (let ((bg (engine-custom e 'left-margin-background)))
+ (unless (unspecified? bg)
+ (display " background: ")
+ (output bg e)
+ (display ";\n")
+ (display " border-bottom-color: ")
+ (output bg e)
+ (display ";\n")))
+ (display " }\n"))
+
+;*---------------------------------------------------------------------*/
+;* &html-navtabs-css-active ... */
+;*---------------------------------------------------------------------*/
+(define (&html-navtabs-css-inactive n e)
+ (display " div.navtabs-tabs a.inactive {
+ background: white;
+ color: black;
+ border-width: 1px;
+ border-color: black;
+ border-style: solid;
+ padding: 2px 10px 0px 10px;
+ margin: 0 1px 0 0;
+ text-decoration: none;
+ }
+ div.navtabs-tabs a.inactive:hover {
+ color: ")
+ (let ((bg (engine-custom e 'title-background)))
+ (if (not (unspecified? bg))
+ (output bg e)
+ (display "#ff0000")))
+ (display "
+ }
+"))
+
+;*---------------------------------------------------------------------*/
+;* &html-navtabs-css-margins ... */
+;*---------------------------------------------------------------------*/
+(define (&html-navtabs-css-margins n e)
+ ;; FIXME: This is both outdated and questionable.
+ (display " td div.skribe-left-margin {
+ border-width: 0 1px 0 0;
+ border-right-style: solid;
+ border-right-color: black;
+ margin: 0;
+ height: 100%;
+ }
+ table.skribe-margins td.skribe-left-margin {
+ border-bottom-width:1px;
+ border-bottom-style: solid;
+ border-bottom-color: black;
+ }
+ table.skribe-margins td div.skribe-body {
+ border-width: 1px 0 0 0;
+ border-style: solid;
+ border-color: black;
+ margin: 0;
+ height: 100%;
+ }
+ td div.skribe-right-margin {
+ border-width: 0 0 0 1px;
+ border-left-style: solid;
+ border-left-color: black;
+ margin: 0;
+ height: 100%;
+ }
+ table.skribe-margins td.skribe-right-margin {
+ border-bottom-width: 1px;
+ border-bottom-style: solid;
+ border-bottom-color: black;
+ }
+"))
+
+;*---------------------------------------------------------------------*/
+;* &html-navtabs-default-tabs ... */
+;*---------------------------------------------------------------------*/
+(define (&html-navtabs-default-tabs n e)
+ (let* ((main (ast-document n))
+ (children (container-search-down
+ (lambda (c)
+ (and (container? c)
+ (not (markup-option c :no-tabs))
+ (markup-option c :file)))
+ main)))
+ (cons (handle main) (map handle children))))
+
+;*---------------------------------------------------------------------*/
+;* &html-navtabs-old-generic-title ... */
+;*---------------------------------------------------------------------*/
+(define &html-navtabs-old-generic-title #f)
+
+;*---------------------------------------------------------------------*/
+;* &html-navtabs-generic-title ... */
+;*---------------------------------------------------------------------*/
+(define (&html-navtabs-generic-title n e)
+ (display "<div class=\"navtabs-title\">\n")
+ (let ((nn (if (document? n)
+ n
+ (new markup
+ (markup (markup-markup n))
+ (options (markup-options n))
+ (body (markup-option (ast-document n) :title))))))
+ (output nn e &html-navtabs-old-generic-title))
+ (display "</div>\n")
+ (display "<div class=\"navtabs-tabs\">\n")
+ (let* ((et (engine-custom e 'html-navtabs))
+ (tabs (if (procedure? et)
+ (et n e)
+ (&html-navtabs-default-tabs n e))))
+ (for-each (lambda (t)
+ (if (handle? t)
+ (output (new markup
+ (markup '&html-tabs-tab)
+ (parent (ast-parent n))
+ (body t))
+ e)
+ (skribe-type-error 'tr "Illegal tabs, " t "handle")))
+ tabs))
+ (display "</div>\n")
+ (output (new markup
+ (markup '&html-tabs-bar)
+ (body (markup-option (ast-parent n) :html-tabs-bar) e))
+ e))
+
+
+;*---------------------------------------------------------------------*/
+;* HTML customization */
+;*---------------------------------------------------------------------*/
+(when-engine-is-loaded 'html
+ (lambda ()
+ (let* ((he (find-engine 'html))
+ (oldd (markup-writer-get 'document he))
+ (oldh (markup-writer-get '&html-header-style he)))
+ (set! &html-navtabs-old-generic-title
+ (markup-writer-get '&html-document-title he))
+ ;; re-bindings
+ (markup-writer 'chapter he
+ :options '(:html-tabs-bar :title :number :file :toc :html-title :env)
+ :predicate (lambda (n e)
+ (or (markup-option n :file)
+ (engine-custom e 'chapter-file)))
+ :action (lambda (n e)
+ (output n e oldd)))
+ (markup-writer 'section he
+ :options '(:html-tabs-bar :title :number :file :toc :html-title :env)
+ :predicate (lambda (n e)
+ (or (markup-option n :file)
+ (engine-custom e 'section-file)))
+ :action (lambda (n e)
+ (output n e oldd)))
+ (markup-writer 'subsection he
+ :options '(:html-tabs-bar :title :number :file :toc :html-title :env)
+ :predicate (lambda (n e)
+ (or (markup-option n :file)
+ (engine-custom e 'subsection-file)))
+ :action (lambda (n e)
+ (output n e oldd)))
+ (markup-writer 'subsubsection he
+ :options '(:html-tabs-bar :title :number :file :toc :html-title :env)
+ :predicate (lambda (n e)
+ (or (markup-option n :file)
+ (engine-custom e 'subsubsection-file)))
+ :action (lambda (n e)
+ (output n e oldd)))
+ (markup-writer '&html-header-style he
+ :options 'all
+ :before (writer-before oldh)
+ :action (lambda (n e)
+ ((writer-action oldh) n e)
+ (let ((css? (engine-custom e 'html-navtabs-produce-css?)))
+ (if (or css? (unspecified? css?))
+ (for-each (lambda (m)
+ (output (new markup
+ (markup m)
+ (parent n))
+ e))
+ '(&html-navtabs-css-title
+ &html-navtabs-css-tabs
+ &html-navtabs-css-bar
+ &html-navtabs-css-active
+ &html-navtabs-css-inactive
+ &html-navtabs-css-margins)))))
+ :after (writer-after oldh))
+ (markup-writer '&html-document-title he :action &html-navtabs-generic-title)
+ (markup-writer '&html-chapter-title he :action &html-navtabs-generic-title)
+ (markup-writer '&html-section-title he :action &html-navtabs-generic-title)
+ (markup-writer '&html-subsection-title he :action &html-navtabs-generic-title)
+ (markup-writer '&html-subsubsection-title he :action &html-navtabs-generic-title)
+ ;; html-divs
+ (markup-writer '&html-navtabs-css-title :action &html-navtabs-css-title)
+ (markup-writer '&html-navtabs-css-tabs :action &html-navtabs-css-tabs)
+ (markup-writer '&html-navtabs-css-bar :action &html-navtabs-css-bar)
+ (markup-writer '&html-navtabs-css-active :action &html-navtabs-css-active)
+ (markup-writer '&html-navtabs-css-inactive :action &html-navtabs-css-inactive)
+ ;;(markup-writer '&html-navtabs-css-margins :action &html-navtabs-css-margins)
+ ;; html-tabs
+ (markup-writer 'html-tabs he
+ :options '(:unresolved :width handles)
+ :before "<div class=\"navtabs-tabs\">\n"
+ :after "</div>\n")
+ ;; &html-tabs-bar
+ (markup-writer '&html-tabs-bar he
+ :options '()
+ :before "<div class=\"navtabs-bar\">\n"
+ :after "</div>\n")
+ ;; &html-tabs-handle
+ (markup-writer '&html-tabs-tab he
+ :before (lambda (n e)
+ (let* ((c (handle-ast (markup-body n)))
+ (id (markup-ident c))
+ (f (html-file c e))
+ (l (let loop ((l (ast-parent n)))
+ (if (markup-option l :no-tabs)
+ (loop (ast-parent l))
+ l))))
+ (format #t "<a href=\"~a#~a\" class=\"~a\""
+ (strip-ref-base (or f (*destination-file*) ""))
+ (string-canonicalize id)
+ (if (eq? c l) "active" "inactive"))
+ (html-class n)
+ (display ">")))
+ :action (lambda (n e)
+ (let ((p (handle-ast (markup-body n))))
+ (if (document? p)
+ (let ((ht (markup-option p :html-title)))
+ (output (if ht ht (markup-option p :title)) e))
+ (output (markup-option p :title) e))))
+ :after "</a>\n"))))
+
+
+;;; arch-tag: 9538d2a2-14c9-4fa7-9320-7380404ad243
diff --git a/src/guile/skribilo/reader/outline.scm b/src/guile/skribilo/reader/outline.scm
index 7411892..1e64d01 100644
--- a/src/guile/skribilo/reader/outline.scm
+++ b/src/guile/skribilo/reader/outline.scm
@@ -83,15 +83,21 @@ equal to @var{name}, a markup name."
(let loop ((trees trees)
(result '()))
(if (null? trees)
- result
+ (let ((result (reverse! result)))
+ (cond ((and (pair? result)
+ (not (symbol? (car result))))
+ ;; Make sure only symbols end up in the head.
+ (cons 'list result))
+ (else
+ result)))
(let ((tree (car trees)))
(loop (cdr trees)
- (append result
- (if (list? tree)
- (cond ((null? tree) '())
- ((symbol? (car tree)) (list tree))
- (else tree))
- (list tree))))))))
+ (append (if (list? tree)
+ (cond ((null? tree) '())
+ ((symbol? (car tree)) (list tree))
+ (else tree))
+ (list tree))
+ result))))))
(define (null-string? s)
(and (string? s) (string=? s "")))
diff --git a/src/guile/skribilo/sui.scm b/src/guile/skribilo/sui.scm
index 6535c66..8dc1a9e 100644
--- a/src/guile/skribilo/sui.scm
+++ b/src/guile/skribilo/sui.scm
@@ -22,7 +22,7 @@
(define-module (skribilo sui)
:use-module (skribilo lib)
:use-module (skribilo ast)
- :autoload (skribilo parameters) (*verbose*)
+ :autoload (skribilo parameters) (*verbose* *destination-file*)
:autoload (skribilo reader) (make-reader)
:autoload (skribilo engine) (find-engine)
:autoload (skribilo evaluator) (evaluate-document)
generated by cgit v1.2.3 (git 2.45.2) at 2024-12-24 02:53:09 +0000