diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/guile/skribilo/ast.scm | 22 | ||||
| -rw-r--r-- | src/guile/skribilo/biblio.scm | 103 | ||||
| -rw-r--r-- | src/guile/skribilo/biblio/Makefile.am | 2 | ||||
| -rw-r--r-- | src/guile/skribilo/biblio/template.scm | 195 | ||||
| -rw-r--r-- | src/guile/skribilo/color.scm | 3 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/base.scm | 128 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/latex.scm | 11 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/lout.scm | 170 | ||||
| -rw-r--r-- | src/guile/skribilo/package/base.scm | 51 | ||||
| -rw-r--r-- | src/guile/skribilo/package/eq.scm | 188 | ||||
| -rw-r--r-- | src/guile/skribilo/package/eq/lout.scm | 179 | ||||
| -rw-r--r-- | src/guile/skribilo/package/slide.scm | 13 | ||||
| -rw-r--r-- | src/guile/skribilo/package/slide/base.scm | 2 | ||||
| -rw-r--r-- | src/guile/skribilo/package/slide/html.scm | 127 | ||||
| -rw-r--r-- | src/guile/skribilo/package/slide/lout.scm | 57 | ||||
| -rw-r--r-- | src/guile/skribilo/prog.scm | 10 | ||||
| -rw-r--r-- | src/guile/skribilo/reader/outline.scm | 54 | ||||
| -rw-r--r-- | src/guile/skribilo/utils/compat.scm | 13 |
18 files changed, 936 insertions, 392 deletions
diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm index 542f629..55f37bf 100644 --- a/src/guile/skribilo/ast.scm +++ b/src/guile/skribilo/ast.scm @@ -30,6 +30,9 @@ :autoload (skribilo location) (location?) :autoload (srfi srfi-1) (fold) + + :use-module (ice-9 optargs) + :export (<ast> ast? ast-loc ast-loc-set! ast-parent ast->string ast->file-location ast-resolved? @@ -62,6 +65,9 @@ find-up find1-up ast-document ast-chapter ast-section + ;; numbering + markup-number-string + ;; error conditions &ast-error &ast-orphan-error &ast-cycle-error &markup-unknown-option-error &markup-already-bound-error @@ -596,6 +602,22 @@ (define (ast-section m) (find1-up (lambda (n) (is-markup? n 'section)) m)) + +;;; +;;; Section numbering. +;;; + +(define* (markup-number-string markup :optional (sep ".")) + ;; Return a structure number string such as "1.2". + (let loop ((markup markup)) + (if (document? markup) + "" + (let ((parent-num (loop (ast-parent markup))) + (num (markup-option markup :number))) + (string-append parent-num + (if (string=? "" parent-num) "" sep) + (if (number? num) (number->string num) "")))))) + ;;; arch-tag: e2489bd6-1b6d-4b03-bdfb-83cffd2f7ce7 diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm index 1fb4b78..55f2ea9 100644 --- a/src/guile/skribilo/biblio.scm +++ b/src/guile/skribilo/biblio.scm @@ -1,5 +1,6 @@ ;;; biblio.scm -- Bibliography functions. ;;; +;;; Copyright 2001, 2002, 2003, 2004 Manuel Serrano ;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> ;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; @@ -24,9 +25,10 @@ :use-module (skribilo utils strings) :use-module (skribilo utils syntax) ;; `when', `unless' + :use-module (srfi srfi-1) :autoload (srfi srfi-34) (raise) :use-module (srfi srfi-35) - :use-module (srfi srfi-1) + :use-module (srfi srfi-39) :autoload (skribilo condition) (&file-search-error) :autoload (skribilo reader) (%default-reader) @@ -36,9 +38,9 @@ :use-module (ice-9 optargs) :use-module (oop goops) - :export (bib-table? make-bib-table default-bib-table + :export (bib-table? make-bib-table *bib-table* bib-add! bib-duplicate bib-for-each bib-map - skribe-open-bib-file parse-bib + open-bib-file parse-bib bib-load! resolve-bib resolve-the-bib make-bib-entry @@ -52,27 +54,15 @@ ;;; Provides the bibliography data type and basic bibliography handling, ;;; including simple procedures to sort bibliography entries. ;;; -;;; FIXME: This module need cleanup! -;;; ;;; Code: (fluid-set! current-reader %skribilo-module-reader) - -;; FIXME: Should be a fluid? -(define *bib-table* #f) - -;; Forward declarations -(define skribe-open-bib-file #f) -(define parse-bib #f) - -;;; ====================================================================== ;;; -;;; Utilities +;;; Accessors. ;;; -;;; ====================================================================== (define (make-bib-table ident) (make-hash-table)) @@ -80,10 +70,9 @@ (define (bib-table? obj) (hash-table? obj)) -(define (default-bib-table) - (unless *bib-table* - (set! *bib-table* (make-bib-table "default-bib-table"))) - *bib-table*) +;; The current bib table. +(define *bib-table* + (make-parameter (make-bib-table "default-bib-table"))) (define (%bib-error who entry) (let ((msg "bibliography syntax error on entry")) @@ -91,22 +80,34 @@ (skribe-line-error (%epair-file entry) (%epair-line entry) who msg entry) (skribe-error who msg entry)))) -(define* (bib-for-each proc :optional (table (default-bib-table))) +(define (bib-add! table . entries) + (if (not (bib-table? table)) + (skribe-error 'bib-add! "Illegal bibliography table" table) + (for-each (lambda (entry) + (cond + ((and (list? entry) (> (length entry) 2)) + (let* ((kind (car entry)) + (key (format #f "~A" (cadr entry))) + (fields (cddr entry)) + (old (hash-ref table key))) + (if old + (bib-duplicate key #f old) + (hash-set! table key + (make-bib-entry kind key fields #f))))) + (else + (%bib-error 'bib-add! entry)))) + entries))) + +(define* (bib-for-each proc :optional (table (*bib-table*))) (hash-for-each (lambda (ident entry) (proc ident entry)) table)) -(define* (bib-map proc :optional (table (default-bib-table))) +(define* (bib-map proc :optional (table (*bib-table*))) (hash-map->list (lambda (ident entry) (proc ident entry)) table)) - -;;; ====================================================================== -;;; -;;; BIB-DUPLICATE -;;; -;;; ====================================================================== (define (bib-duplicate ident from old) (let ((ofrom (markup-option old 'from))) (skribe-warning 2 @@ -120,11 +121,11 @@ " ignoring redefinition.")))) -;;; ====================================================================== + ;;; -;;; PARSE-BIB +;;; Parsing. ;;; -;;; ====================================================================== + (define (parse-bib table port) (let ((read %default-reader)) ;; FIXME: We should use a fluid (if (not (bib-table? table)) @@ -146,43 +147,15 @@ (else (%bib-error 'bib-parse entry))))))))) - -;;; ====================================================================== -;;; -;;; BIB-ADD! -;;; -;;; ====================================================================== -(define (bib-add! table . entries) - (if (not (bib-table? table)) - (skribe-error 'bib-add! "Illegal bibliography table" table) - (for-each (lambda (entry) - (cond - ((and (list? entry) (> (length entry) 2)) - (let* ((kind (car entry)) - (key (format #f "~A" (cadr entry))) - (fields (cddr entry)) - (old (hash-ref table key))) - (if old - (bib-duplicate key #f old) - (hash-set! table key - (make-bib-entry kind key fields #f))))) - (else - (%bib-error 'bib-add! entry)))) - entries))) - - -;;; ====================================================================== -;;; -;;; SKRIBE-OPEN-BIB-FILE -;;; -;;; ====================================================================== -;; FIXME: Factoriser -(define (skribe-open-bib-file file command) +(define* (open-bib-file file :optional (command #f)) (let ((path (search-path (*bib-path*) file))) (if (string? path) (begin (when (> (*verbose*) 0) - (format (current-error-port) " [loading bibliography: ~S]\n" path)) + (format (current-error-port) + " [loading bibliography: ~S]\n" path)) + ;; FIXME: The following `open-input-file' won't work with actual + ;; commands. We need to use `(ice-9 popen)'. (open-input-file (if (string? command) (string-append "| " (format #f command path)) @@ -209,7 +182,7 @@ (if (not (bib-table? table)) (skribe-error 'bib-load "Illegal bibliography table" table) ;; read the file - (let ((p (skribe-open-bib-file filename command))) + (let ((p (open-bib-file filename command))) (if (not (input-port? p)) (skribe-error 'bib-load "Can't open data base" filename) (unwind-protect diff --git a/src/guile/skribilo/biblio/Makefile.am b/src/guile/skribilo/biblio/Makefile.am index 9442562..ee81406 100644 --- a/src/guile/skribilo/biblio/Makefile.am +++ b/src/guile/skribilo/biblio/Makefile.am @@ -1,4 +1,4 @@ guilemoduledir = $(GUILE_SITE)/skribilo/biblio -dist_guilemodule_DATA = bibtex.scm author.scm abbrev.scm +dist_guilemodule_DATA = bibtex.scm author.scm abbrev.scm template.scm ## arch-tag: aeffaead-c3f0-47f3-a0b3-bb3e22da2657 diff --git a/src/guile/skribilo/biblio/template.scm b/src/guile/skribilo/biblio/template.scm new file mode 100644 index 0000000..5a82e26 --- /dev/null +++ b/src/guile/skribilo/biblio/template.scm @@ -0,0 +1,195 @@ +;;; template.scm -- Template system for bibliography entries. +;;; +;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2006 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; +;;; +;;; 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 biblio template) + :use-module (skribilo ast) + :autoload (skribilo lib) (skribe-error) + :autoload (skribilo output) (output) + + :use-module (ice-9 optargs) + + :use-module (skribilo utils syntax) + + :export (output-bib-entry-template + make-bib-entry-template/default + make-bib-entry-template/skribe)) + +(fluid-set! current-reader %skribilo-module-reader) + +;;; Author: Manuel Serrano, Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module provides a helper procedure to output bibliography entries +;;; according to a given template, as well as ready-to-use templates. A +;;; template only contains part of the style information for a bibliography +;;; entry. Specific style information can be added by modifying the markup +;;; writers for `&bib-entry-author', `&bib-entry-title', etc. (see `(skribilo +;;; package base)' for details). +;;; +;;; Code: + + +;;; +;;; Outputting a bibliography entry template for a specific entry. +;;; + +(define* (output-bib-entry-template bib engine template + :optional (get-field markup-option)) + ;; Output the fields of BIB (a bibliography entry) for ENGINE according to + ;; TEMPLATE. Example of templates are found below (e.g., + ;; `make-bib-entry-template/default'). + (let loop ((template template) + (pending #f) + (armed #f)) + (cond + ((null? template) + 'done) + ((pair? (car template)) + (if (eq? (caar template) 'or) + (let ((o1 (cadr (car template)))) + (if (get-field bib o1) + (loop (cons o1 (cdr template)) + pending + #t) + (let ((o2 (caddr (car template)))) + (loop (cons o2 (cdr template)) + pending + armed)))) + (let ((o (get-field bib (cadr (car template))))) + (if o + (begin + (if (and pending armed) + (output pending engine)) + (output (caar template) engine) + (output o engine) + (if (pair? (cddr (car template))) + (output (caddr (car template)) engine)) + (loop (cdr template) #f #t)) + (loop (cdr template) pending armed))))) + ((symbol? (car template)) + (let ((o (get-field bib (car template)))) + (if o + (begin + (if (and armed pending) + (output pending engine)) + (output o engine) + (loop (cdr template) #f #t)) + (loop (cdr template) pending armed)))) + ((null? (cdr template)) + (output (car template) engine)) + ((string? (car template)) + (loop (cdr template) + (if pending pending (car template)) + armed)) + (else + (skribe-error 'output-bib-fields + "Illegal templateiption" + (car template)))))) + + +;;; +;;; Example bibliography entry templates. +;;; + +(define (make-bib-entry-template/default kind) + ;; The default bibliography entry template. + (case kind + ((techreport) + `(author ". " (or title url documenturl) ". " + number ", " institution ", " + address ", " month " " year ", " + ("pp. " pages) ".")) + ((article) + `(author ". " (or title url documenturl) ". " + "In " journal ", " volume + ("(" number ")") ", " + address ", " month " " year ", " + ("pp. " pages) ".")) + ((inproceedings) + `(author ". " (or title url documenturl) ". " + "In " booktitle ", " + (series ", ") + ("(" number ")") + ("pp. " pages ", ") + ("" publisher ", ") + ;; FIXME: Addr., month. + year ".")) + ((book) ;; FIXME: Title should be in italics + '(author ". " (or title url documenturl) ". " + publisher ", " address + ", " month " " year ", " + ("pp. " pages) ".")) + ((phdthesis) + '(author ". " (or title url documenturl) + ". " type ", " + school ", " address + ", " month " " year".")) + ((misc) + '(author ". " (or title url documenturl) ". " + publisher ", " address + ", " month " " year + (", " url) ".")) + (else + '(author ". " (or title url documenturl) ". " + publisher ", " address + ", " month " " year ", " + ("pp. " pages) ".")))) + +(define (make-bib-entry-template/skribe kind) + ;; The awful template found by default in Skribe. + (case kind + ((techreport) + `(author " -- " (or title url documenturl) " -- " + number ", " institution ", " + address ", " month ", " year ", " + ("pp. " pages) ".")) + ((article) + `(author " -- " (or title url documenturl) " -- " + journal ", " volume "" ("(" number ")") ", " + address ", " month ", " year ", " + ("pp. " pages) ".")) + ((inproceedings) + `(author " -- " (or title url documenturl) " -- " + booktitle ", " series ", " ("(" number ")") ", " + address ", " month ", " year ", " + ("pp. " pages) ".")) + ((book) + '(author " -- " (or title url documenturl) " -- " + publisher ", " address + ", " month ", " year ", " ("pp. " pages) ".")) + ((phdthesis) + '(author " -- " (or title url documenturl) " -- " type ", " + school ", " address + ", " month ", " year".")) + ((misc) + '(author " -- " (or title url documenturl) " -- " + publisher ", " address + ", " month ", " year".")) + (else + '(author " -- " (or title url documenturl) " -- " + publisher ", " address + ", " month ", " year ", " ("pp. " pages) ".")))) + + +;;; arch-tag: 5931579f-b606-442d-9a45-6047c94da5a2 + +;;; template.scm ends here diff --git a/src/guile/skribilo/color.scm b/src/guile/skribilo/color.scm index 8b6205f..6b3aa7b 100644 --- a/src/guile/skribilo/color.scm +++ b/src/guile/skribilo/color.scm @@ -571,7 +571,8 @@ ("darkcyan" . "0 139 139") ("darkmagenta" . "139 0 139") ("darkred" . "139 0 0") - ("lightgreen" . "144 238 144"))) + ("lightgreen" . "144 238 144") + ("lightred" . "255 127 127"))) (define (%convert-color str) diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm index 2a7a0d4..9c1fdd2 100644 --- a/src/guile/skribilo/engine/base.scm +++ b/src/guile/skribilo/engine/base.scm @@ -27,7 +27,8 @@ :use-module (skribilo evaluator) :autoload (skribilo package base) (color) :autoload (skribilo utils keywords) (list-split) - + :autoload (skribilo biblio template) (make-bib-entry-template/default + output-bib-entry-template) ;; syntactic sugar :use-module (skribilo reader) :use-module (skribilo utils syntax)) @@ -236,91 +237,31 @@ :after "]") ;*---------------------------------------------------------------------*/ +;* &bib-entry-author ... */ +;*---------------------------------------------------------------------*/ +; (markup-writer '&bib-entry-author +; :action (lambda (n e) +; (let ((names (markup-body n))) +; (skribe-eval +; (sc (abbreviate-first-names names)) e)))) + +;*---------------------------------------------------------------------*/ +;* &bib-entry-url ... */ +;*---------------------------------------------------------------------*/ +(markup-writer '&bib-entry-url + :action (lambda (n e) + (let ((url (markup-body n))) + (evaluate-document + (ref :text (it url) :url url) e)))) + +;*---------------------------------------------------------------------*/ ;* &bib-entry-body ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-body :action (lambda (n e) - (define (output-fields descr) - (let loop ((descr descr) - (pending #f) - (armed #f)) - (cond - ((null? descr) - 'done) - ((pair? (car descr)) - (if (eq? (caar descr) 'or) - (let ((o1 (cadr (car descr)))) - (if (markup-option n o1) - (loop (cons o1 (cdr descr)) - pending - #t) - (let ((o2 (caddr (car descr)))) - (loop (cons o2 (cdr descr)) - pending - armed)))) - (let ((o (markup-option n (cadr (car descr))))) - (if o - (begin - (if (and pending armed) - (output pending e)) - (output (caar descr) e) - (output o e) - (if (pair? (cddr (car descr))) - (output (caddr (car descr)) e)) - (loop (cdr descr) #f #t)) - (loop (cdr descr) pending armed))))) - ((symbol? (car descr)) - (let ((o (markup-option n (car descr)))) - (if o - (begin - (if (and armed pending) - (output pending e)) - (output o e) - (loop (cdr descr) #f #t)) - (loop (cdr descr) pending armed)))) - ((null? (cdr descr)) - (output (car descr) e)) - ((string? (car descr)) - (loop (cdr descr) - (if pending pending (car descr)) - armed)) - (else - (skribe-error 'output-bib-fields - "Illegal description" - (car descr)))))) - (output-fields - (case (markup-option n 'kind) - ((techreport) - `(author " -- " (or title url documenturl) " -- " - number ", " institution ", " - address ", " month ", " year ", " - ("pp. " pages) ".")) - ((article) - `(author " -- " (or title url documenturl) " -- " - journal ", " volume "" ("(" number ")") ", " - address ", " month ", " year ", " - ("pp. " pages) ".")) - ((inproceedings) - `(author " -- " (or title url documenturl) " -- " - booktitle ", " series ", " ("(" number ")") ", " - address ", " month ", " year ", " - ("pp. " pages) ".")) - ((book) - '(author " -- " (or title url documenturl) " -- " - publisher ", " address - ", " month ", " year ", " ("pp. " pages) ".")) - ((phdthesis) - '(author " -- " (or title url documenturl) " -- " type ", " - school ", " address - ", " month ", " year".")) - ((misc) - '(author " -- " (or title url documenturl) " -- " - publisher ", " address - ", " month ", " year".")) - (else - '(author " -- " (or title url documenturl) " -- " - publisher ", " address - ", " month ", " year ", " ("pp. " pages) ".")))))) + (let* ((kind (markup-option n 'kind)) + (template (make-bib-entry-template/default kind))) + (output-bib-entry-template n e template)))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-ident ... */ @@ -337,6 +278,21 @@ (evaluate-document (bold (markup-body n)) e))) ;*---------------------------------------------------------------------*/ +;* &bib-entry-booktitle ... */ +;*---------------------------------------------------------------------*/ +(markup-writer '&bib-entry-booktitle + :action (lambda (n e) + (let ((title (markup-body n))) + (evaluate-document (it title) e)))) + +;*---------------------------------------------------------------------*/ +;* &bib-entry-journal ... */ +;*---------------------------------------------------------------------*/ +(markup-writer '&bib-entry-journal + :action (lambda (n e) + (evaluate-document (it (markup-body n)) e))) + +;*---------------------------------------------------------------------*/ ;* &bib-entry-publisher ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-publisher @@ -477,8 +433,12 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&prog-line :before (lambda (n e) - (let ((n (markup-ident n))) - (if n (evaluate-document (it (list n) ": ") e)))) + (let ((num (markup-option n :number))) + (if (number? num) + (evaluate-document + (it (string-append (string-pad (number->string num) 3) + ": ")) + e)))) :after "\n") ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/engine/latex.scm b/src/guile/skribilo/engine/latex.scm index 8d5b88f..21ff6c5 100644 --- a/src/guile/skribilo/engine/latex.scm +++ b/src/guile/skribilo/engine/latex.scm @@ -18,7 +18,8 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo engine latex)) +(define-skribe-module (skribilo engine latex) + :use-module (srfi srfi-13)) ;*---------------------------------------------------------------------*/ ;* latex-verbatim-encoding ... */ @@ -997,8 +998,12 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&prog-line :before (lambda (n e) - (let ((n (markup-ident n))) - (if n (skribe-eval (it (list n) ": ") e)))) + (let ((num (markup-option n :number))) + (if (number? num) + (skribe-eval + (it (string-append (string-pad (number->string num) 3) + ": ")) + e)))) :after "\\\\\n") ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm index 893ab2e..43aa356 100644 --- a/src/guile/skribilo/engine/lout.scm +++ b/src/guile/skribilo/engine/lout.scm @@ -24,6 +24,8 @@ (define-skribe-module (skribilo engine lout) + :use-module (srfi srfi-13) + :use-module (srfi srfi-14) :autoload (ice-9 popen) (open-output-pipe) :autoload (ice-9 rdelim) (read-line)) @@ -378,9 +380,9 @@ (let ((leader (engine-custom engine 'toc-leader)) (leader-space (engine-custom engine 'toc-leader-space))) (apply string-append - `("# @SkribeMark implements Skribe's marks " + `("# @SkribiloMark implements Skribe's marks " "(i.e. cross-references)\n" - "def @SkribeMark\n" + "def @SkribiloMark\n" " right @Tag\n" "{\n" " @PageMark @Tag\n" @@ -389,7 +391,29 @@ "# @SkribiloLeaders is used in `toc'\n" "# (this is mostly copied from the expert's guide)\n" "def @SkribiloLeaders { " - ,leader " |" ,leader-space " @SkribiloLeaders }\n\n")))) + ,leader " |" ,leader-space " @SkribiloLeaders }\n\n" + + "# Embedding an application in PDF (``Launch'' actions)\n" + "# (tested with XPdf 3.1 and Evince 0.4.0)\n" + "def @SkribiloEmbed\n" + " left command\n" + " import @PSLengths\n" + " named borderwidth { 1p }\n" + " right body\n" + "{\n" + " {\n" + " \"[ /Rect [0 0 xsize ysize]\"\n" + " \" /Color [0 0 1]\"\n" + " \" /Border [ 0 0 \" borderwidth \" ]\"\n" + " \" /Action /Launch\"\n" + " \" /File (\" command \")\"\n" + " \" /Subtype /Link\"\n" + " \"/ANN\"\n" + " \"pdfmark\"\n" + " }\n" + " @Graphic body\n" + "}\n\n")))) + (define (lout-make-doc-cover-sheet doc engine) ;; Create a cover sheet for node `doc' which is a doc-style Lout document. @@ -410,18 +434,22 @@ (output title engine) (display "The Lout Document")) (display " }\n") - (display "//1.7fx\n") - (if date-line - (begin - (display "@Center { ") - (output date-line engine) - (display " }\n//1.4fx\n"))) + (display "//2.0fx\n") (if author (begin (display "@Center { ") (output author engine) (display " }\n") - (display "//4fx\n"))) + (display "//4.6fx\n"))) + (if date-line + (begin + (display "@Center { ") + (output (if (eq? #t date-line) + (strftime "%e %B %Y" (localtime (current-time))) + date-line) + engine) + (display " }\n//1.7fx\n"))) + (display "//0.5fx\n") (if multi-column? (display "\n} # @FullWidth\n")))) @@ -444,13 +472,14 @@ (let ((split (let loop ((where 10)) (if (= 0 where) 10 - (if (char=? (string-ref text - (- where 1)) - #\space) + (if (char-set-contains? + char-set:whitespace + (string-ref text (- where 1))) (loop (- where 1)) where))))) `(,(ref :url url :text (substring text 0 split)) - ,(substring text split len))) + ,(!lout (lout-make-url-breakable + (substring text split len))))) (list markup)))) ((markup? text) @@ -475,7 +504,7 @@ (if num (begin (if (is-markup? node 'chapter) (display "@B { ")) - (printf "~a. |2s " (lout-structure-number-string node)) + (printf "~a. |2s " (markup-number-string node)) (output title engine) (if (is-markup? node 'chapter) (display " }"))) (if (is-markup? node 'chapter) @@ -498,7 +527,7 @@ (define (lout-pdf-bookmark-title node engine) ;; Default implementation of the `pdf-bookmark-title-proc' custom that ;; returns a title (a string) for the PDF bookmark of `node'. - (let ((number (lout-structure-number-string node))) + (let ((number (markup-number-string node))) (string-append (if (string=? number "") "" (string-append number ". ")) (ast->string (markup-option node :title))))) @@ -558,7 +587,7 @@ ;; also honor this custom for `doc' documents. (cover-sheet? #t) - ;; For reports, the date line. + ;; For reports and slides, the date line. (date-line #t) ;; For reports, an abstract. @@ -604,7 +633,7 @@ (use-skribe-footnote-numbers? #t) ;; A procedure that is passed the engine - ;; and produces Lout definitions. + ;; and returns Lout definitions (a string). (inline-definitions-proc ,lout-definitions) ;; A procedure that takes a URL `ref' markup and @@ -635,6 +664,10 @@ ;; `lout-illustration' on other back-ends. (lout-program-name "lout") + ;; Additional arguments that should be passed to + ;; Lout, e.g., `("-I foo" "-I bar")'. + (lout-program-arguments ()) + ;; Title and author information in the PDF ;; document information. If `#t', the ;; document's `:title' and `:author' are used. @@ -1012,7 +1045,7 @@ (display "@SysInclude { tbl }\n")) ;; Write additional Lout definitions - (display (lout-definitions e)) + (display ((engine-custom e 'inline-definitions-proc) e)) (case doc-type ((report) (display "@Report\n")) @@ -1051,23 +1084,25 @@ (output institution e) (printf " }\n")))))))) + (if (memq doc-type '(report slides)) + (let ((date-line (engine-custom e 'date-line))) + (display " @DateLine { ") + (if (or (string? date-line) (ast? date-line)) + (output date-line e) + (display (if date-line "Yes" "No"))) + (display " }\n"))) + ;; Lout reports make it possible to choose whether to prepend ;; a cover sheet (books and docs don't). Same for a date ;; line. (if (eq? doc-type 'report) (let ((cover-sheet? (engine-custom e 'cover-sheet?)) - (date-line (engine-custom e 'date-line)) (abstract (engine-custom e 'abstract)) (abstract-title (engine-custom e 'abstract-title))) (display (string-append " @CoverSheet { " (if cover-sheet? "Yes" "No") " }\n")) - (display " @DateLine { ") - (if (string? date-line) - (output date-line e) - (display (if date-line "Yes" "No"))) - (display " }\n") (if abstract (begin @@ -1288,17 +1323,11 @@ doc-type))))) (define-public (lout-structure-number-string markup) - ;; Return a structure number string such as "1.2". - ;; FIXME: External code has started to rely on this. This should be - ;; generalized and moved elsewhere. - (let loop ((struct markup)) - (if (document? struct) - "" - (let ((parent-num (loop (ast-parent struct))) - (num (markup-option struct :number))) - (string-append parent-num - (if (string=? "" parent-num) "" ".") - (if (number? num) (number->string num) "")))))) + ;; FIXME: External code has started to rely on this before this was moved + ;; to the `ast' module as `markup-number-string'. Thus, we'll have to keep it + ;; here for some time. + (markup-number-string markup ".")) + ;*---------------------------------------------------------------------*/ ;* lout-block-before ... */ @@ -1317,7 +1346,7 @@ ;; Lout markup) (display "\n//1.8vx\n@B { ") (output title e) - (display " }\n@SkribeMark { ") + (display " }\n@SkribiloMark { ") (display (lout-tagify ident)) (display " }\n//0.8vx\n\n")) (begin @@ -1327,7 +1356,7 @@ (if (number? number) (printf " @BypassNumber { ~a }\n" - (lout-structure-number-string n)) + (markup-number-string n)) (if (not number) ;; this trick hides the section number (printf " @BypassNumber { } # unnumbered\n"))) @@ -1646,8 +1675,12 @@ ;; Program lines appear within a `lines @Break' block. (markup-writer '&prog-line :before (lambda (n e) - (let ((n (markup-ident n))) - (if n (skribe-eval (it (list n) ": ") e)))) + (let ((num (markup-option n :number))) + (if (number? num) + (skribe-eval + (it (string-append (string-pad (number->string num) 3) + ": ")) + e)))) :after "\n") ;*---------------------------------------------------------------------*/ @@ -2380,7 +2413,7 @@ :action (lambda (n e) (if (markup-ident n) (begin - (display "{ @SkribeMark { ") + (display "{ @SkribiloMark { ") (display (lout-tagify (markup-ident n))) (display " } }")) (skribe-error 'lout "mark: Node has no identifier" n)))) @@ -2462,6 +2495,7 @@ ((is-markup? x 'bib-entry) x) ((is-markup? x 'bib-ref) (handle-ast (markup-body x))) + ((is-markup? x 'unref) #f) (else (skribe-error 'lout @@ -2469,9 +2503,14 @@ x))))) (help-proc (lambda (proc) (lambda (e1 e2) - (proc (canonicalize-entry e1) - (canonicalize-entry e2))))) + (let ((e1 (canonicalize-entry e1)) + (e2 (canonicalize-entry e2))) + ;; don't pass `unref's to PROC + (if (and e1 e2) + (proc e1 e2) + #f))))) (sort-proc (engine-custom e 'bib-refs-sort-proc))) + (let loop ((rs (if sort-proc (sort entries (help-proc sort-proc)) entries))) @@ -2491,6 +2530,19 @@ :after "]") ;*---------------------------------------------------------------------*/ +;* lout-make-url-breakable ... */ +;*---------------------------------------------------------------------*/ +(define-public lout-make-url-breakable + ;; Make the given string (which is assumed to be a URL) breakable. + (make-string-replace `((#\/ "\"/\"&0ik{}") + (#\. ".&0ik{}") + (#\- "-&0ik{}") + (#\_ "_&0ik{}") + (#\@ "\"@\"&0ik{}") + ,@lout-verbatim-encoding + (#\newline " ")))) + +;*---------------------------------------------------------------------*/ ;* url-ref ... */ ;*---------------------------------------------------------------------*/ (markup-writer 'url-ref @@ -2503,19 +2555,9 @@ (markup-option n '&transformed)) (begin (printf "{ \"~a\" @ExternalLink { " url) - (if text ;; FIXME: Should be (not (string-index text #\space)) - (output text e) - (let ((filter-url (make-string-replace - `((#\/ "\"/\"&-") - (#\. ".&-") - (#\- "&-") - (#\_ "_&-") - ,@lout-verbatim-encoding - (#\newline ""))))) - ;; Filter the URL in a way to give Lout hints on - ;; where hyphenation should take place. - (fprint (current-error-port) "Here!!!" filter-url) - (display (filter-url url) e))) + (if text + (output text e) + (display (lout-make-url-breakable url) e)) (printf " } }")) (begin (markup-option-add! n '&transformed #t) @@ -2602,7 +2644,7 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-title :action (lambda (n e) - (let* ((t (bold (markup-body n))) + (let* ((t (markup-body n)) (en (handle-ast (ast-parent n))) (url (markup-option en 'url)) (ht (if url (ref :url (markup-body url) :text t) t))) @@ -2624,7 +2666,7 @@ :action (lambda (n e) (let* ((en (handle-ast (ast-parent n))) (url (markup-option en 'url)) - (t (bold (markup-body url)))) + (t (it (markup-body url)))) (skribe-eval (ref :url (markup-body url) :text t) e)))) ;*---------------------------------------------------------------------*/ @@ -2848,11 +2890,13 @@ (gensym 'lout-illustration))) ".eps")) (port (open-output-pipe - (string-append (or (engine-custom lout - 'lout-program-name) - "lout") - " -o " output - " -EPS")))) + (apply string-append + (or (engine-custom lout 'lout-program-name) + "lout") + " -o " output + " -EPS " + (engine-custom lout + 'lout-program-arguments))))) ;; send the illustration to Lout's standard input (display (illustration-header) port) diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm index 3145695..b904ed8 100644 --- a/src/guile/skribilo/package/base.scm +++ b/src/guile/skribilo/package/base.scm @@ -33,7 +33,7 @@ :autoload (skribilo engine) (engine? engine-class?) ;; optional ``sub-packages'' - :autoload (skribilo biblio) (default-bib-table resolve-bib + :autoload (skribilo biblio) (*bib-table* resolve-bib bib-load! bib-add!) :autoload (skribilo color) (skribe-use-color!) :autoload (skribilo source) (language? source-read-lines source-fontify) @@ -1017,7 +1017,7 @@ (subsection #f) (subsubsection #f) (bib #f) - (bib-table (default-bib-table)) + (bib-table (*bib-table*)) (url #f) (figure #f) (mark #f) @@ -1189,6 +1189,49 @@ (line (line-ref line)) (else (skribe-error 'ref "illegal reference" opts))))) + +;*---------------------------------------------------------------------*/ +;* numref ... */ +;*---------------------------------------------------------------------*/ +(define-markup (numref #!rest opts + #!key (ident #f) (text "") (page #f) + (separator ".") (class #f)) + ;; Produce a numbered reference to `ident'. + (new unresolved + (proc (lambda (n e env) + (let* ((parent (ast-parent n)) + (doc (ast-document n)) + (target (document-lookup-node doc ident)) + (number (and target + (markup-option target :number)))) + (cond + ((not target) + (skribe-warning/ast 1 n 'numref + (format #f "can't find `ident': ") + ident) + (new markup + (markup 'unref) + (ident (symbol->string (gensym "unref"))) + (class class) + (required-options '(:text)) + (options `((kind numref) + ,@(the-options opts :ident :class))) + (body (list ident ": " (ast->file-location n))))) + ((unresolved? number) + ;; Loop until `number' is resolved. + n) + (else + (let ((xref + (ref :text + (list (if text text "") " " + (if (number? number) + (markup-number-string target + separator) + "")) + :page page + :handle (handle target)))) + (resolve! xref e env))))))))) + ;*---------------------------------------------------------------------*/ ;* resolve ... */ ;*---------------------------------------------------------------------*/ @@ -1204,7 +1247,7 @@ ;*---------------------------------------------------------------------*/ (define-markup (bibliography #!rest files #!key - (command #f) (bib-table (default-bib-table))) + (command #f) (bib-table (*bib-table*))) (for-each (lambda (f) (cond ((string? f) @@ -1226,7 +1269,7 @@ (define-markup (the-bibliography #!rest opts #!key pred - (bib-table (default-bib-table)) + (bib-table (*bib-table*)) (sort bib-sort/authors) (count 'partial)) (if (not (memq count '(partial full))) diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm index e09dec6..821840f 100644 --- a/src/guile/skribilo/package/eq.scm +++ b/src/guile/skribilo/package/eq.scm @@ -19,7 +19,7 @@ ;;; USA. (define-module (skribilo package eq) - :autoload (skribilo ast) (markup?) + :autoload (skribilo ast) (markup? find-up) :autoload (skribilo output) (output) :use-module (skribilo writer) :use-module (skribilo engine) @@ -29,6 +29,8 @@ :use-module (skribilo utils keywords) ;; `the-options', etc. :autoload (skribilo package base) (it symbol sub sup) :autoload (skribilo engine lout) (lout-illustration) + + :use-module (srfi srfi-39) :use-module (ice-9 optargs)) ;;; Author: Ludovic Courtès @@ -52,9 +54,14 @@ ;;; Utilities. ;;; +(define-public *embedded-renderer* + ;; Tells whether an engine is invoked as an embedded renderer or as the + ;; native engine. + (make-parameter #f)) + (define %operators '(/ * + - = != ~= < > <= >= sqrt expt sum product script - in notin apply)) + in notin apply limit combinations)) (define %symbols ;; A set of symbols that are automatically recognized within an `eq' quoted @@ -110,24 +117,45 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (string-length str)))) #f)) +(define-public (inline-equation? m) + "Return @code{#t} if @var{m} is an equation that is to be displayed inline." + (and (is-markup? m 'eq) + (let ((i (markup-option m :inline?))) + (case i + ((auto) + (not (find-up (lambda (n) + (is-markup? n 'eq-display)) + m))) + ((#t) #t) + (else #f))))) + ;;; ;;; Operator precedence. ;;; (define %operator-precedence - ;; FIXME: This needs to be augmented. - '((+ . 1) - (- . 1) - (* . 2) - (/ . 2) - (sum . 3) + ;; Taken from http://en.wikipedia.org/wiki/Order_of_operations . + '((expt . 2) + (sqrt . 2) + + (* . 3) + (/ . 3) (product . 3) - (= . 0) - (< . 0) - (> . 0) - (<= . 0) - (>= . 0))) + + (+ . 4) + (- . 4) + (sum . 4) + + (< . 6) + (> . 6) + (<= . 6) + (>= . 6) + + (= . 7) + (!= . 7) + (~= . 7))) + (define-public (operator-precedence op) (let ((p (assq op %operator-precedence))) @@ -169,12 +197,27 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., ;;; Markup. ;;; -(define-markup (eq :rest opts :key (ident #f) (inline? #f) - (renderer #f) (class "eq")) - (new markup +(define-markup (eq-display :rest opts :key (ident #f) (class "eq-display")) + (new container + (markup 'eq-display) + (ident (or ident (symbol->string (gensym "eq-display")))) + (class class) + (options (the-options opts :ident :class)) + (body (the-body opts)))) + +(define-markup (eq :rest opts :key (ident #f) (class "eq") + (inline? 'auto) (align-with #f) + (renderer #f) (div-style 'over) + (mul-style 'space)) + (new container (markup 'eq) (ident (or ident (symbol->string (gensym "eq")))) - (options (the-options opts)) + (class class) + (options `((:div-style ,div-style) (:align-with ,align-with) + (:mul-style ,mul-style) + ,@(the-options opts + :ident :class + :div-style :mul-style :align-with))) (body (let loop ((body (the-body opts)) (result '())) (if (null? body) @@ -187,8 +230,27 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., ;; passed )))))) -(define-simple-markup eq:/) -(define-simple-markup eq:*) + +(define-markup (eq:/ :rest opts :key (ident #f) (div-style #f)) + ;; If no `:div-style' is specified here, obey the top-level one. + (new markup + (markup 'eq:/) + (ident (or ident (symbol->string (gensym "eq:/")))) + (class #f) + (options `((:div-style ,div-style) + ,@(the-options opts :ident :div-style))) + (body (the-body opts)))) + +(define-markup (eq:* :rest opts :key (ident #f) (mul-style #f)) + ;; If no `:mul-style' is specified here, obey the top-level one. + (new markup + (markup 'eq:*) + (ident (or ident (symbol->string (gensym "eq:*")))) + (class #f) + (options `((:mul-style ,mul-style) + ,@(the-options opts :ident :mul-style))) + (body (the-body opts)))) + (define-simple-markup eq:+) (define-simple-markup eq:-) @@ -252,12 +314,37 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (loop (cdr body) (cons first result))))))))) +(define-markup (eq:limit var lim :rest body :key (ident #f)) + (new markup + (markup 'eq:limit) + (ident (or ident (symbol->string (gensym "eq:limit")))) + (options `((:var ,var) (:limit ,lim) + ,@(the-options body :ident))) + (body (the-body body)))) + +(define-markup (eq:combinations x y :rest opts :key (ident #f)) + (new markup + (markup 'eq:combinations) + (ident (or ident (symbol->string (gensym "eq:combinations")))) + (options `((:of ,x) (:among ,y) + ,@(the-options opts :ident))) + (body (the-body opts)))) + ;;; ;;; Text-based rendering. ;;; +(markup-writer 'eq-display (lookup-engine-class 'base) + :action (lambda (node engine) + (for-each (lambda (node) + (let ((eq? (is-markup? node 'eq))) + (if eq? (output (linebreak) engine)) + (output node engine) + (if eq? (output (linebreak) engine)))) + (markup-body node)))) + (markup-writer 'eq (lookup-engine-class 'base) :action (lambda (node engine) ;; The `:renderer' option should be a symbol (naming an engine @@ -269,22 +356,23 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (cond ((not renderer) ;; default: use the current engine (output (it (markup-body node)) engine)) ((symbol? renderer) - (case renderer - ;; FIXME: We should have an `embed' slot for each - ;; engine class similar to `lout-illustration'. - ((lout) - (let ((lout-code - (with-output-to-string - (lambda () - (output node - (make-engine - (lookup-engine-class 'lout))))))) - (output (lout-illustration - :ident (markup-ident node) - lout-code) - engine))) - (else - (skribe-error 'eq "invalid renderer" renderer)))) + (parameterize ((*embedded-renderer* #t)) + (case renderer + ;; FIXME: We should have an `embed' slot for each + ;; engine class similar to `lout-illustration'. + ((lout) + (let ((lout-code + (with-output-to-string + (lambda () + (output node + (make-engine + (lookup-engine-class 'lout))))))) + (output (lout-illustration + :ident (markup-ident node) + lout-code) + engine))) + (else + (skribe-error 'eq "invalid renderer" renderer))))) ;; FIXME: `engine?' and `engine-class?' (else (skribe-error 'eq "`:renderer' -- wrong argument type" @@ -303,10 +391,10 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (nested-eq? (equation-markup? o)) (need-paren? (and nested-eq? -; (< (operator-precedence -; (equation-markup-name->operator -; (markup-markup o))) -; ,precedence) + (>= (operator-precedence + (equation-markup-name->operator + (markup-markup o))) + ,precedence) ) )) @@ -424,6 +512,28 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (output (sup sup*) engine) (output (sub sub*) engine)))) +(markup-writer 'eq:limit (lookup-engine-class 'base) + :action (lambda (node engine) + (let ((body (markup-body node)) + (var (markup-option node :var)) + (limit (markup-option node :limit))) + (display "lim (") + (output var engine) + (output (symbol "->") engine) + (output limit engine) + (display ", ") + (output body engine) + (display ")")))) + +(markup-writer 'eq:combinations (lookup-engine-class 'base) + :action (lambda (node engine) + (let ((of (markup-option node :of)) + (among (markup-option node :among))) + (display "combinations(") + (output of engine) + (display ", ") + (output among engine) + (display ")")))) diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm index c38e74c..cc305f1 100644 --- a/src/guile/skribilo/package/eq/lout.scm +++ b/src/guile/skribilo/package/eq/lout.scm @@ -50,12 +50,20 @@ ;;; Simple markup writers. ;;; +(markup-writer 'eq-display (lookup-engine-class 'lout) + :before "\n@BeginAlignedDisplays\n" + :after "\n@EndAlignedDisplays\n") (markup-writer 'eq (lookup-engine-class 'lout) - :options '(:inline?) - :before "{ " + :options '(:inline? :align-with :div-style :mul-style) + :before (lambda (node engine) + (let* ((parent (ast-parent node)) + (displayed? (is-markup? parent 'eq-display))) + (format #t "~a{ " + (if (and displayed? (not (*embedded-renderer*))) + "\n@IAD " "")))) :action (lambda (node engine) - (display (if (markup-option node :inline?) + (display (if (inline-equation? node) "@E { " "@Eq { ")) (let ((eq (markup-body node))) @@ -64,6 +72,29 @@ :after " } }") +;; Scaled parenthesis. We could use `pmatrix' here but it precludes +;; line-breaking within equations. +(define %left-paren "{ Base @Font @VScale \"(\" }") +(define %right-paren "{ Base @Font @VScale \")\" }") + +(define (div-style->lout style) + (case style + ((over) "over") + ((fraction) "frac") + ((div) "div") + ((slash) "slash") + (else + (error "unsupported div style" style)))) + +(define (mul-style->lout style) + (case style + ((space) "") + ((cross) "times") + ((asterisk) "*") + ((dot) "cdot") + (else + (error "unsupported mul style" style)))) + (define-macro (simple-lout-markup-writer sym . args) (let* ((lout-name (if (null? args) @@ -74,45 +105,54 @@ (cadr args))) (precedence (operator-precedence sym)) - ;; Note: We could use `pmatrix' here but it precludes line-breaking - ;; within equations. - (open-par `(if need-paren? "{ @VScale ( }" "")) - (close-par `(if need-paren? "{ @VScale ) }" ""))) + (open-par (if parentheses? + `(if need-paren? %left-paren "") + "")) + (close-par (if parentheses? + `(if need-paren? %right-paren "") + ""))) `(markup-writer ',(symbol-append 'eq: sym) - (lookup-engine-class 'lout) - :action (lambda (node engine) - (let loop ((operands (markup-body node))) - (if (null? operands) - #t - (let* ((op (car operands)) - (eq-op? (equation-markup? op)) - (need-paren? - (and eq-op? - (< (operator-precedence - (equation-markup-name->operator - (markup-markup op))) - ,precedence))) - (column (port-column - (current-output-port)))) - - ;; Work around Lout's limitations... - (if (> column 1000) (display "\n")) - - (display (string-append " { " - ,(if parentheses? - open-par - ""))) - (output op engine) - (display (string-append ,(if parentheses? - close-par - "") - " }")) - (if (pair? (cdr operands)) - (display ,(string-append " " - lout-name - " "))) - (loop (cdr operands))))))))) + (lookup-engine-class 'lout) + :action (lambda (node engine) + (let* ((lout-name ,(if (string? lout-name) + lout-name + `(,lout-name node + engine))) + (eq (ast-parent node)) + (eq-parent (ast-parent eq))) + + (let loop ((operands (markup-body node)) + (first? #t)) + (if (null? operands) + #t + (let* ((align? + (and first? + (is-markup? eq-parent 'eq-display) + (eq? ',sym + (markup-option eq :align-with)))) + (op (car operands)) + (eq-op? (equation-markup? op)) + (need-paren? + (and eq-op? + (>= (operator-precedence + (equation-markup-name->operator + (markup-markup op))) + ,precedence))) + (column (port-column (current-output-port)))) + + ;; Work around Lout's limitations... + (if (> column 1000) (display "\n")) + + (display (string-append " { " ,open-par)) + (output op engine) + (display (string-append ,close-par " }")) + (if (pair? (cdr operands)) + (display (string-append " " + (if align? "^" "") + lout-name + " "))) + (loop (cdr operands) #f))))))))) ;; `+' and `*' have higher precedence than `-', `/', `=', etc., so their @@ -121,9 +161,26 @@ (simple-lout-markup-writer +) -(simple-lout-markup-writer * "times") (simple-lout-markup-writer - "-") -(simple-lout-markup-writer / "over" #f) + +(simple-lout-markup-writer * + (lambda (n e) + ;; Obey either the per-node `:mul-style' or the + ;; top-level one. + (mul-style->lout + (or (markup-option n :mul-style) + (let ((eq (ast-parent n))) + (markup-option eq :mul-style)))))) + +(simple-lout-markup-writer / + (lambda (n e) + ;; Obey either the per-node `:div-style' or the + ;; top-level one. + (div-style->lout + (or (markup-option n :div-style) + (let ((eq (ast-parent n))) + (markup-option eq :div-style))))) + #f) (simple-lout-markup-writer =) (simple-lout-markup-writer <) (simple-lout-markup-writer >) @@ -139,9 +196,9 @@ (second (cadr body)) (parentheses? (equation-markup? first))) (display " { { ") - (if parentheses? (display "(")) + (if parentheses? (display %left-paren)) (output first engine) - (if parentheses? (display ")")) + (if parentheses? (display %right-paren)) (display ,(string-append " } " lout-name " { ")) (output second engine) (display " } } ")) @@ -149,15 +206,15 @@ "wrong number of arguments" body)))))) -(binary-lout-markup-writer expt "sup") -(binary-lout-markup-writer in "element") +(binary-lout-markup-writer expt "sup") +(binary-lout-markup-writer in "element") (binary-lout-markup-writer notin "notelement") (markup-writer 'eq:apply (lookup-engine-class 'lout) :action (lambda (node engine) (let ((func (car (markup-body node)))) (output func engine) - (display "(") + (display %left-paren) (let loop ((operands (cdr (markup-body node)))) (if (null? operands) #t @@ -166,8 +223,32 @@ (if (not (null? (cdr operands))) (display ", ")) (loop (cdr operands))))) - (display ")")))) + (display %right-paren)))) + +(markup-writer 'eq:limit (lookup-engine-class 'lout) + :action (lambda (node engine) + (let ((body (markup-body node)) + (var (markup-option node :var)) + (limit (markup-option node :limit))) + (display "{ lim from { ") + (output var engine) + (display " --> ") + (output limit engine) + (display (string-append " } } @VContract { " %left-paren)) + (output body engine) + (display (string-append %right-paren " } "))))) + +(markup-writer 'eq:combinations (lookup-engine-class 'lout) + :action (lambda (node engine) + (let ((of (markup-option node :of)) + (among (markup-option node :among))) + (display " ` { matrix atleft { lpar } atright { rpar } { ") + (display "row col { ") + (output of engine) + (display " } row col { ") + (output among engine) + (display " } } } `\n")))) ;;; @@ -207,7 +288,7 @@ (display " } "))) (if sub (begin - (display " on { ") + (display (if sup " on { " " sub { ")) (output sub engine) (display " } "))) (display " } ")))) diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm index 68d2ba6..fbdf912 100644 --- a/src/guile/skribilo/package/slide.scm +++ b/src/guile/skribilo/package/slide.scm @@ -162,6 +162,7 @@ (define-markup (slide-embed #!rest opt #!key command + (arguments '()) (geometry-opt "-geometry") (geometry #f) (rgeometry #f) (transient #f) (transient-opt #f) @@ -243,12 +244,14 @@ ;*---------------------------------------------------------------------*/ (define-markup (slide-topic #!rest opt #!key title (outline? #t) - (ident #f) (class "slide-topic")) + (ident #f) (class #f)) (new container (markup 'slide-topic) (required-options '(:title :outline?)) (ident (or ident (symbol->string (gensym "slide-topic")))) - (options (the-options opt)) + (class class) + (options `((:outline? ,outline?) + ,@(the-options opt :outline? :class))) (body (the-body opt)))) ;*---------------------------------------------------------------------*/ @@ -256,12 +259,14 @@ ;*---------------------------------------------------------------------*/ (define-markup (slide-subtopic #!rest opt #!key title (outline? #f) - (ident #f) (class "slide-subtopic")) + (ident #f) (class #f)) (new container (markup 'slide-subtopic) (required-options '(:title :outline?)) (ident (or ident (symbol->string (gensym "slide-subtopic")))) - (options (the-options opt)) + (class class) + (options `((:outline? ,outline?) + ,@(the-options opt :outline? :class))) (body (the-body opt)))) diff --git a/src/guile/skribilo/package/slide/base.scm b/src/guile/skribilo/package/slide/base.scm index 1d8d84c..0686a7c 100644 --- a/src/guile/skribilo/package/slide/base.scm +++ b/src/guile/skribilo/package/slide/base.scm @@ -155,7 +155,7 @@ (is-markup? n 'slide-topic)) topic)))) (output (slide :title %slide-outline-title :toc #f - :class (markup-option topic :class) + :class (markup-class topic) ;; The mark below is needed for cross-referencing by PDF ;; bookmarks. (if (markup-ident topic) (mark (markup-ident topic)) "") diff --git a/src/guile/skribilo/package/slide/html.scm b/src/guile/skribilo/package/slide/html.scm index d47ef82..9a5148d 100644 --- a/src/guile/skribilo/package/slide/html.scm +++ b/src/guile/skribilo/package/slide/html.scm @@ -18,43 +18,75 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package slide html) - :use-module (skribilo package slide)) +(define-module (skribilo package slide html) + :use-module (skribilo utils syntax) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo writer) + :autoload (skribilo resolve) (resolve!) + :autoload (skribilo output) (output) + :autoload (skribilo evaluator) (evaluate-document) + :autoload (skribilo engine html) (html-width html-title-authors) + :use-module (skribilo package slide) + :use-module ((skribilo package base) :select (ref))) + + +(fluid-set! current-reader %skribilo-module-reader) + + + (define-public (%slide-html-initialize!) - (let ((he (find-engine 'html))) - (skribe-message "HTML slides setup...\n") + (let ((he (lookup-engine-class 'html))) + (display "HTML slides setup...\n" (current-error-port)) + ;; &html-page-title (markup-writer '&html-document-title he ;;:predicate (lambda (n e) %slide-initialized) :action html-slide-title) + ;; slide (markup-writer 'slide he :options '(:title :number :transition :toc :bg) :before (lambda (n e) - (printf "<a name=\"~a\">" (markup-ident n)) - (display "<br>\n")) + (display "<br>\n") + (format #t "<a name=\"~a\">" (markup-ident n))) :action (lambda (n e) (let ((nb (markup-option n :number)) - (t (markup-option n :title))) - (skribe-eval - (center - (color :width (slide-body-width e) - :bg (or (markup-option n :bg) "#ffffff") - (table :width 100. - (tr (th :align 'left - (list - (if nb - (format #f "~a / ~a -- " nb - (slide-number))) - t))) - (tr (td (hrule))) - (tr (td :width 100. :align 'left - (markup-body n)))) - (linebreak))) - e))) + (t (markup-option n :title)) + (class (markup-class n))) + (if class + (let ((title-class (string-append class "-title"))) + ;; When a class is specified, let the user play + ;; with CSS. + (format #t "\n<div class=\"~a\">" class) + (format #t "<div class=\"~a\">" title-class) + (format #t "~a / ~a -- " nb (slide-number)) + (output t e) + (display "</div>\n") + (output (markup-body n) e) + (display "\n</div>\n")) + ;; When no class is specified, do HTML tricks. + (evaluate-document + (center + (color :width (slide-body-width e) + :bg (or (markup-option n :bg) "#ffffff") + (table :width 100. + (tr (th :align 'left + (list + (if nb + (format #f "~a / ~a -- " + nb + (slide-number))) + t))) + (tr (td (hrule))) + (tr (td :width 100. :align 'left + (markup-body n)))) + (linebreak))) + e)))) :after "<br>") + ;; slide-vspace (markup-writer 'slide-vspace he :action (lambda (n e) (display "<br>"))))) @@ -76,23 +108,23 @@ (tbg (engine-custom e 'title-background)) (tfg (engine-custom e 'title-foreground)) (tfont (engine-custom e 'title-font))) - (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>" + (format #t "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribilo-title\"><tbody>\n<tr>" (html-width (slide-body-width e))) (if (string? tbg) - (printf "<td bgcolor=\"~a\">" tbg) + (format #t "<td bgcolor=\"~a\">" tbg) (display "<td>")) (if (string? tfg) - (printf "<font color=\"~a\">" tfg)) + (format #t "<font color=\"~a\">" tfg)) (if title (begin (display "<center>") (if (string? tfont) (begin - (printf "<font ~a><strong>" tfont) + (format #t "<font ~a><strong>" tfont) (output title e) (display "</strong></font>")) (begin - (printf "<div class=\"skribetitle\"><strong><big><big><big>") + (display "<div class=\"skribilo-title\"><strong><big><big><big>") (output title e) (display "</big></big></big></strong</div>"))) (display "</center>\n"))) @@ -109,26 +141,47 @@ ;;; Slide topics/subtopics. ;;; -(markup-writer 'slide-topic (find-engine 'html) +(markup-writer 'slide-topic (lookup-engine-class 'html) :options '(:title :outline? :class :ident) :action (lambda (n e) (let ((title (markup-option n :title)) - (body (markup-body n))) - (display "\n<h2 class=\"slide-topic:title\">") + (body (markup-body n)) + (class (markup-class n))) + ;; top-level class + (if class (format #t "\n<div class=\"~a\">" class)) + + ;; the title + (if class + (format #t "\n<div class=\"~a-title\">" class) + (display "\n<h2 class=\"slide-topic:title\">")) (if (markup-ident n) - (printf "<a name=\"~a\"></a>" (markup-ident n))) + (format #t "<a name=\"~a\"></a>" (markup-ident n))) (output title e) - (display "</h2> <br>\n") - (display "\n<div class=\"slide-topic:slide-list\">") + (if class + (display "</div>\n") + (display "</h2> <br>\n")) + + ;; pointers to the slides + (if class + (format #t "\n<div class=\"~a-slide-list\">" + class) + (display "\n<div class=\"slide-topic:slide-list\">")) (for-each (lambda (s) - (output (markup-option s :title) e) - (display " -- ")) + (let* ((title (markup-option s :title)) + (ident (markup-ident s)) + (sref (ref :text title :ident ident)) + (sref* (resolve! sref e `((parent ,n))))) + (output sref* e) + (display " -- "))) (filter (lambda (n) (or (is-markup? n 'slide-subtopic) (is-markup? n 'slide))) (markup-body n))) (display "\n</div> <!-- slide-topic:slide-list -->") - (display "\n<hr><br>\n") + + (if class + (display "\n</div> <!-- slide-topic -->\n") + (display "\n<hr><br>\n")) ;; the slides (output (markup-body n) e)))) diff --git a/src/guile/skribilo/package/slide/lout.scm b/src/guile/skribilo/package/slide/lout.scm index d53cff1..6597442 100644 --- a/src/guile/skribilo/package/slide/lout.scm +++ b/src/guile/skribilo/package/slide/lout.scm @@ -18,9 +18,17 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package slide lout) +(define-module (skribilo package slide lout) :use-module (skribilo utils syntax) + :autoload (skribilo utils strings) (make-string-replace) + :use-module (skribilo engine) + :use-module (skribilo writer) + :autoload (skribilo output) (output) + :use-module (skribilo ast) + + :use-module (srfi srfi-13) ;; `string-join' + ;; XXX: If changing the following `autoload' to `use-module' doesn't work, ;; then you need to fix your Guile. See this thread about ;; `make-autoload-interface': @@ -34,13 +42,14 @@ (fluid-set! current-reader %skribilo-module-reader) + ;;; TODO: ;;; ;;; Make some more PS/PDF trickery. (format (current-error-port) "Lout slides setup...~%") -(let ((le (find-engine 'lout))) +(let ((le (lookup-engine-class 'lout))) ;; FIXME: Automatically switching to `slides' is problematic, e.g., for the ;; user manual which embeds slides. @@ -83,7 +92,7 @@ (and (pair? (markup-body n)) (number? (car (markup-body n))))) :action (lambda (n e) - (printf "\n//~a~a # slide-vspace\n" + (format #t "\n//~a~a # slide-vspace\n" (car (markup-body n)) (case (markup-option n :unit) ((cm) "c") @@ -94,6 +103,25 @@ "Unknown vspace unit" (markup-option n :unit))))))) + (markup-writer 'slide-embed le + :options '(:command :arguments :alt :geometry :geometry-opt) + :action (lambda (n e) + (let ((command (markup-option n :command)) + (args (markup-option n :arguments)) + (alt (markup-option n :alt)) + (geometry (markup-option n :geometry)) + (geometry-opt (markup-option n :geometry-opt)) + (filter (make-string-replace lout-verbatim-encoding))) + (format #t "~%\"~a\" @SkribiloEmbed { " + (string-append command " " + (if (and geometry-opt geometry) + (string-append geometry-opt " " + geometry " ") + "") + (string-join args " "))) + (output alt e) + (format #t " }\n")))) + (markup-writer 'slide-pause le ;; FIXME: Use a `pdfmark' custom action and a PDF transition action. ;; << /Type /Action @@ -109,26 +137,7 @@ ;; For movies, see ;; http://www.tug.org/tex-archive/macros/latex/contrib/movie15/movie15.sty . - (markup-writer 'slide-embed le - :options '(:alt :geometry :rgeometry :geometry-opt :command) - ;; FIXME: `pdfmark'. - ;; << /Type /Action /S /Launch - :action (lambda (n e) - (let ((command (markup-option n :command)) - (filter (make-string-replace lout-verbatim-encoding)) - (pdfmark "[ /Rect [ 0 ysize xsize 0 ] -/Name /Comment -/Contents (This is an embedded application) -/ANN pdfmark - -[ /Type /Action -/S /Launch -/F (~a) -/OBJ pdfmark")) - (display (string-append - "4c @Wide 3c @High " - (lout-embedded-postscript-code - (filter (format #f pdfmark command))))))))) + ) @@ -136,7 +145,7 @@ ;;; Customs for a nice handling of topics/subtopics. ;;; -(let ((lout (find-engine 'lout))) +(let ((lout (lookup-engine-class 'lout))) (if lout (begin (engine-custom-set! lout 'pdf-bookmark-node-pred diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm index 266d607..2f531cd 100644 --- a/src/guile/skribilo/prog.scm +++ b/src/guile/skribilo/prog.scm @@ -24,8 +24,13 @@ :autoload (ice-9 receive) (receive) :use-module (skribilo lib) ;; `new' :autoload (skribilo ast) (node? node-body) + :use-module (skribilo utils syntax) + :export (make-prog-body resolve-line)) +(fluid-set! current-reader %skribilo-module-reader) + + ;;; ====================================================================== ;;; ;;; COMPATIBILITY @@ -211,8 +216,9 @@ (extract-mark (car lines) mark regexp) (let* ((line-ident (symbol->string (gensym "&prog-line"))) (n (new markup - (markup '&prog-line) - (ident line-ident) + (markup '&prog-line) + (ident line-ident) + (options `((:number ,lnum))) (body (if m (make-line-mark m line-ident l) l))))) (loop (cdr lines) (+ lnum 1) diff --git a/src/guile/skribilo/reader/outline.scm b/src/guile/skribilo/reader/outline.scm index 09792f5..7411892 100644 --- a/src/guile/skribilo/reader/outline.scm +++ b/src/guile/skribilo/reader/outline.scm @@ -22,7 +22,10 @@ :use-module (skribilo utils syntax) :use-module (skribilo reader) :use-module (ice-9 optargs) + :use-module (srfi srfi-11) + :use-module (srfi srfi-13) + :use-module (srfi srfi-14) :autoload (ice-9 rdelim) (read-line) :autoload (ice-9 regex) (make-regexp) @@ -380,12 +383,19 @@ to @var{node-type}." (define modeline-rx (make-regexp "^[[:space:]]*-\\*- [a-zA-Z-]+ -\\*-[[:space:]]*$")) (define title-rx (make-regexp "^[Tt]itle: (.+)$" regexp/extended)) - (define author-rx (make-regexp "^[Aa]uthor: (.+)$" regexp/extended)) + (define author-rx (make-regexp "^[Aa]uthors?: (.+)$" regexp/extended)) + (define keywords-rx + (make-regexp "^[Kk]ey ?[wW]ords?: (.+)$" regexp/extended)) + + (define (extract-keywords str) + (map string-trim-both + (string-tokenize str (char-set-complement (char-set #\,))))) (let ((doc-proc (make-document-processor %node-processors %line-processor))) (let loop ((title #f) (author #f) + (keywords '()) (line (read-line port))) (if (eof-object? line) @@ -394,20 +404,34 @@ to @var{node-type}." line) (if (or (empty-line? line) (regexp-exec modeline-rx line)) - (loop title author (read-line port)) - (let ((title-match (regexp-exec title-rx line))) - (if title-match - (loop (match:substring title-match 1) - author (read-line port)) - (let ((author-match (regexp-exec author-rx line))) - (if author-match - (loop title (match:substring author-match 1) - (read-line port)) - - ;; Let's go. - `(document :title ,title - :author (author :name ,author) - ,@(doc-proc line port))))))))))) + (loop title author keywords (read-line port)) + (cond ((regexp-exec title-rx line) + => + (lambda (title-match) + (loop (match:substring title-match 1) + author keywords (read-line port)))) + + ((regexp-exec author-rx line) + => + (lambda (author-match) + (loop title (match:substring author-match 1) + keywords (read-line port)))) + + ((regexp-exec keywords-rx line) + => + (lambda (kw-match) + (loop title author + (append keywords + (extract-keywords + (match:substring kw-match 1))) + (read-line port)))) + + (else + ;; Let's go. + `(document :title ,title + :author (author :name ,author) + :keywords ',keywords + ,@(doc-proc line port))))))))) (define* (make-outline-reader :optional (version "0.1")) diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index 5074bd7..1142142 100644 --- a/src/guile/skribilo/utils/compat.scm +++ b/src/guile/skribilo/utils/compat.scm @@ -37,6 +37,7 @@ :autoload (skribilo output) (*document-being-output*) :use-module ((skribilo engine) :renamer (symbol-prefix-proc 'orig:)) :use-module ((skribilo writer) :renamer (symbol-prefix-proc 'orig:)) + :autoload (skribilo biblio) (*bib-table* open-bib-file) :use-module (skribilo debug) :re-export (file-size) ;; re-exported from `(skribilo utils files)' @@ -357,6 +358,18 @@ ;;; +;;; Bibliography. +;;; + +(define-public (default-bib-table) + (*bib-table*)) + +(define-public (skribe-open-bib-file file command) + (open-bib-file file command)) + + + +;;; ;;; Debugging facilities. ;;; |