diff options
| -rw-r--r-- | ChangeLog | 147 | ||||
| -rw-r--r-- | doc/user/package.skb | 51 | ||||
| -rw-r--r-- | doc/user/src/html-navtabs.skb | 118 | ||||
| -rw-r--r-- | src/guile/skribilo/lib.scm | 41 | ||||
| -rw-r--r-- | src/guile/skribilo/package/Makefile.am | 3 | ||||
| -rw-r--r-- | src/guile/skribilo/package/html-navtabs.scm | 359 | ||||
| -rw-r--r-- | src/guile/skribilo/reader/outline.scm | 20 | ||||
| -rw-r--r-- | src/guile/skribilo/sui.scm | 2 |
8 files changed, 713 insertions, 28 deletions
@@ -2,6 +2,153 @@ # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2 # +2007-08-20 16:29:46 GMT Ludovic Court`es <ludovic.courtes@laas.fr> patch-145 + + Summary: + Fixed `find-up'. + Revision: + skribilo--devo--1.2--patch-145 + + * src/guile/skribilo/ast.scm (find-up): Don't cons OBJ when it doesn't + match PRED. + + modified files: + ChangeLog src/guile/skribilo/ast.scm + src/guile/skribilo/package/base.scm + + new patches: + lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-86 + + +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) |