From 6ec84d65e48bf0e6f7b682afdfed9f081d8baea7 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Wed, 6 Jun 2007 09:25:35 +0000 Subject: More package cleanups. Various additional package cleanups, thanks to Guile-Lint. git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-61 --- src/guile/skribilo/package/acmproc.scm | 5 +- src/guile/skribilo/package/base.scm | 167 ++++++++++++++--------------- src/guile/skribilo/package/diff.scm | 10 +- src/guile/skribilo/package/eq.scm | 10 +- src/guile/skribilo/package/letter.scm | 9 +- src/guile/skribilo/package/pie.scm | 23 ++-- src/guile/skribilo/package/scribe.scm | 96 ++++++++--------- src/guile/skribilo/package/sigplan.scm | 5 +- src/guile/skribilo/package/slide.scm | 14 +-- src/guile/skribilo/package/web-article.scm | 67 +++++++----- src/guile/skribilo/package/web-book.scm | 14 ++- 11 files changed, 220 insertions(+), 200 deletions(-) diff --git a/src/guile/skribilo/package/acmproc.scm b/src/guile/skribilo/package/acmproc.scm index 5ca1288..4a3c4a2 100644 --- a/src/guile/skribilo/package/acmproc.scm +++ b/src/guile/skribilo/package/acmproc.scm @@ -35,7 +35,7 @@ :use-module (ice-9 optargs) :use-module (srfi srfi-13) - :export (abstract references)) + :export (abstract references acm-copyright)) (fluid-set! current-reader %skribilo-module-reader) @@ -170,7 +170,8 @@ ;*---------------------------------------------------------------------*/ ;* acm-copyright ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-copyright :rest opt :key conference location year crdata) +(define* (acm-copyright :key conference location year crdata + :rest opt) (let* ((le (find-engine 'latex)) (cop (format #f "\\conferenceinfo{~a,} {~a} \\CopyrightYear{~a} diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm index 3aae9bf..a32f3f4 100644 --- a/src/guile/skribilo/package/base.scm +++ b/src/guile/skribilo/package/base.scm @@ -21,7 +21,6 @@ (define-module (skribilo package base) :use-syntax (skribilo lib) - :use-syntax (skribilo reader) :use-syntax (skribilo utils syntax) :use-syntax (ice-9 optargs) @@ -40,10 +39,11 @@ :autoload (skribilo source) (language? source-read-lines source-fontify) :autoload (skribilo prog) (make-prog-body resolve-line) :autoload (skribilo index) (make-index-table default-index) + :autoload (skribilo sui) (load-sui sui-ref->url) :replace (symbol)) -(fluid-set! current-reader (make-reader 'skribe)) +(fluid-set! current-reader %skribilo-module-reader) ;;; Author: Manuel Serrano ;;; Commentary: @@ -61,7 +61,7 @@ ;*---------------------------------------------------------------------*/ ;* include ... */ ;*---------------------------------------------------------------------*/ -(define-markup (include file) +(define-public (include file) (if (not (string? file)) (skribe-error 'include "Illegal file (string expected)" file) (include-document file))) @@ -69,9 +69,9 @@ ;*---------------------------------------------------------------------*/ ;* document ... */ ;*---------------------------------------------------------------------*/ -(define-markup (document #!rest +(define-markup (document :rest opts - #!key + :key (ident #f) (class "document") (title #f) (html-title #f) (author #f) (ending #f) (keywords '()) (env '())) @@ -108,9 +108,9 @@ ;*---------------------------------------------------------------------*/ ;* author ... */ ;*---------------------------------------------------------------------*/ -(define-markup (author #!rest +(define-markup (author :rest opts - #!key + :key (ident #f) (class "author") name (title #f) @@ -137,9 +137,9 @@ ;*---------------------------------------------------------------------*/ ;* toc ... */ ;*---------------------------------------------------------------------*/ -(define-markup (toc #!rest +(define-markup (toc :rest opts - #!key + :key (ident #f) (class "toc") (chapter #t) (section #t) (subsection #f) (subsubsection #f)) @@ -181,9 +181,9 @@ ;* writer: */ ;* html: @ref ../../skr/html.skr:chapter@ */ ;*---------------------------------------------------------------------*/ -(define-markup (chapter #!rest +(define-markup (chapter :rest opts - #!key + :key (ident #f) (class "chapter") title (html-title #f) (file #f) (toc #t) (number #t)) (new container @@ -222,9 +222,9 @@ ;* writer: */ ;* html: @ref ../../skr/html.skr:sectionr@ */ ;*---------------------------------------------------------------------*/ -(define-markup (section #!rest +(define-markup (section :rest opts - #!key + :key (ident #f) (class "section") title (file #f) (toc #t) (number #t)) (new container @@ -250,9 +250,9 @@ ;* writer: */ ;* html: @ref ../../skr/html.skr:subsectionr@ */ ;*---------------------------------------------------------------------*/ -(define-markup (subsection #!rest +(define-markup (subsection :rest opts - #!key + :key (ident #f) (class "subsection") title (file #f) (toc #t) (number #t)) (new container @@ -275,9 +275,9 @@ ;* writer: */ ;* html: @ref ../../skr/html.skr:subsubsectionr@ */ ;*---------------------------------------------------------------------*/ -(define-markup (subsubsection #!rest +(define-markup (subsubsection :rest opts - #!key + :key (ident #f) (class "subsubsection") title (file #f) (toc #f) (number #t)) (new container @@ -300,7 +300,7 @@ ;*---------------------------------------------------------------------*/ ;* ~ (unbreakable space) ... */ ;*---------------------------------------------------------------------*/ -(define-markup (~ #!rest opts #!key (class #f)) +(define-markup (~ :rest opts :key (class #f)) (new markup (markup '~) (ident (symbol->string (gensym "~"))) @@ -318,8 +318,8 @@ ;*---------------------------------------------------------------------*/ ;* footnote ... */ ;*---------------------------------------------------------------------*/ -(define-markup (footnote #!rest opts - #!key (ident #f) (class "footnote") (label #t)) +(define-markup (footnote :rest opts + :key (ident #f) (class "footnote") (label #t)) ;; The `:label' option used to be called `:number'. (new container (markup 'footnote) @@ -342,7 +342,7 @@ ;*---------------------------------------------------------------------*/ ;* linebreak ... */ ;*---------------------------------------------------------------------*/ -(define-markup (linebreak #!rest opts #!key (ident #f) (class #f)) +(define-markup (linebreak :rest opts :key (ident #f) (class #f)) (let ((ln (new markup (ident (or ident (symbol->string (gensym "linebreak")))) (class class) @@ -362,9 +362,9 @@ ;*---------------------------------------------------------------------*/ ;* hrule ... */ ;*---------------------------------------------------------------------*/ -(define-markup (hrule #!rest +(define-markup (hrule :rest opts - #!key + :key (ident #f) (class #f) (width 100.) (height 1)) (new markup @@ -381,9 +381,9 @@ ;*---------------------------------------------------------------------*/ ;* color ... */ ;*---------------------------------------------------------------------*/ -(define-markup (color #!rest +(define-markup (color :rest opts - #!key + :key (ident #f) (class "color") (bg #f) (fg #f) (width #f) (margin #f)) (new container @@ -400,9 +400,9 @@ ;*---------------------------------------------------------------------*/ ;* frame ... */ ;*---------------------------------------------------------------------*/ -(define-markup (frame #!rest +(define-markup (frame :rest opts - #!key + :key (ident #f) (class "frame") (width #f) (margin 2) (border 1)) (new container @@ -422,9 +422,9 @@ ;*---------------------------------------------------------------------*/ ;* font ... */ ;*---------------------------------------------------------------------*/ -(define-markup (font #!rest +(define-markup (font :rest opts - #!key + :key (ident #f) (class #f) (size #f) (face #f)) (new container @@ -439,9 +439,9 @@ ;*---------------------------------------------------------------------*/ ;* flush ... */ ;*---------------------------------------------------------------------*/ -(define-markup (flush #!rest +(define-markup (flush :rest opts - #!key + :key (ident #f) (class #f) side) (case side @@ -475,9 +475,9 @@ ;* writer: */ ;* html: @ref ../../skr/html.skr:prog@ */ ;*---------------------------------------------------------------------*/ -(define-markup (prog #!rest +(define-markup (prog :rest opts - #!key + :key (ident #f) (class "prog") (line 1) (linedigit #f) (mark ";!")) (if (not (or (string? mark) (eq? mark #f))) @@ -499,9 +499,9 @@ ;* writer: */ ;* html: @ref ../../skr/html.skr:source@ */ ;*---------------------------------------------------------------------*/ -(define-markup (source #!rest +(define-markup (source :rest opts - #!key + :key language (file #f) (start #f) (stop #f) (definition #f) (tab 8)) @@ -555,7 +555,7 @@ ;* doc: */ ;* @ref ../../doc/user/prgm.skb:language@ */ ;*---------------------------------------------------------------------*/ -(define-markup (language #!key name (fontifier #f) (extractor #f)) +(define-markup (language :key name (fontifier #f) (extractor #f)) (if (not (string? name)) (skribe-type-error 'language "illegal name" name "string") (new language @@ -571,9 +571,9 @@ ;* writer: */ ;* html: @ref ../../skr/html.skr:figure@ */ ;*---------------------------------------------------------------------*/ -(define-markup (figure #!rest +(define-markup (figure :rest opts - #!key + :key (ident #f) (class "figure") (legend #f) (number #t) (multicolumns #f)) (new container @@ -633,7 +633,7 @@ ;*---------------------------------------------------------------------*/ ;* itemize ... */ ;*---------------------------------------------------------------------*/ -(define-markup (itemize #!rest opts #!key (ident #f) (class "itemize") symbol) +(define-markup (itemize :rest opts :key (ident #f) (class "itemize") symbol) (new container (markup 'itemize) (ident (or ident (symbol->string (gensym "itemize")))) @@ -646,7 +646,7 @@ ;*---------------------------------------------------------------------*/ ;* enumerate ... */ ;*---------------------------------------------------------------------*/ -(define-markup (enumerate #!rest opts #!key (ident #f) (class "enumerate") symbol) +(define-markup (enumerate :rest opts :key (ident #f) (class "enumerate") symbol) (new container (markup 'enumerate) (ident (or ident (symbol->string (gensym "enumerate")))) @@ -659,7 +659,7 @@ ;*---------------------------------------------------------------------*/ ;* description ... */ ;*---------------------------------------------------------------------*/ -(define-markup (description #!rest opts #!key (ident #f) (class "description") symbol) +(define-markup (description :rest opts :key (ident #f) (class "description") symbol) (new container (markup 'description) (ident (or ident (symbol->string (gensym "description")))) @@ -672,7 +672,7 @@ ;*---------------------------------------------------------------------*/ ;* item ... */ ;*---------------------------------------------------------------------*/ -(define-markup (item #!rest opts #!key (ident #f) (class #f) key) +(define-markup (item :rest opts :key (ident #f) (class #f) key) (if (and key (not (or (string? key) (number? key) (markup? key) @@ -690,9 +690,9 @@ ;*---------------------------------------------------------------------*/ ;* table */ ;*---------------------------------------------------------------------*/ -(define-markup (table #!rest +(define-markup (table :rest opts - #!key + :key (ident #f) (class #f) (border #f) (width #f) (frame 'none) (rules 'none) @@ -745,7 +745,7 @@ ;*---------------------------------------------------------------------*/ ;* tr ... */ ;*---------------------------------------------------------------------*/ -(define-markup (tr #!rest opts #!key (ident #f) (class #f) (bg #f)) +(define-markup (tr :rest opts :key (ident #f) (class #f) (bg #f)) (new container (markup 'tr) (ident (or ident (symbol->string (gensym "tr")))) @@ -760,9 +760,9 @@ ;* tc... */ ;*---------------------------------------------------------------------*/ (define-markup (tc m - #!rest + :rest opts - #!key + :key (ident #f) (class #f) (width #f) (align 'center) (valign #f) (colspan 1) (rowspan 1) (bg #f)) @@ -807,9 +807,9 @@ ;*---------------------------------------------------------------------*/ ;* th ... */ ;*---------------------------------------------------------------------*/ -(define-markup (th #!rest +(define-markup (th :rest opts - #!key + :key (ident #f) (class #f) (width #f) (align 'center) (valign #f) (colspan 1) (rowspan 1) (bg #f)) @@ -818,9 +818,9 @@ ;*---------------------------------------------------------------------*/ ;* td ... */ ;*---------------------------------------------------------------------*/ -(define-markup (td #!rest +(define-markup (td :rest opts - #!key + :key (ident #f) (class #f) (width #f) (align 'center) (valign #f) (colspan 1) (rowspan 1) (bg #f)) @@ -835,9 +835,9 @@ ;* html: @ref ../../skr/html.skr:image@ */ ;* latex: @ref ../../skr/latex.skr:image@ */ ;*---------------------------------------------------------------------*/ -(define-markup (image #!rest +(define-markup (image :rest opts - #!key + :key (ident #f) (class #f) file (url #f) (width #f) (height #f) (zoom #f)) (cond @@ -882,7 +882,7 @@ ;*---------------------------------------------------------------------*/ ;* char ... */ ;*---------------------------------------------------------------------*/ -(define-markup (char char) +(define-public (char char) (cond ((char? char) (string char)) @@ -914,7 +914,7 @@ ;*---------------------------------------------------------------------*/ ;* ! ... */ ;*---------------------------------------------------------------------*/ -(define-markup (! format #!rest node) +(define-markup (! format :rest node) (if (not (string? format)) (skribe-type-error '! "Illegal format:" format "string") (new command @@ -925,8 +925,8 @@ ;*---------------------------------------------------------------------*/ ;* processor ... */ ;*---------------------------------------------------------------------*/ -(define-markup (processor #!rest opts - #!key (combinator #f) (engine #f) (procedure #f)) +(define-markup (processor :rest opts + :key (combinator #f) (engine #f) (procedure #f)) (cond ((and combinator (not (procedure? combinator))) (skribe-error 'processor "Combinator not a procedure" combinator)) @@ -959,8 +959,8 @@ ;*---------------------------------------------------------------------*/ ;* handle ... */ ;*---------------------------------------------------------------------*/ -(define-markup (handle #!rest opts - #!key (ident #f) (class "handle") value section) +(define-markup (handle :rest opts + :key (ident #f) (class "handle") value section) (let ((body (the-body opts))) (cond (section @@ -989,7 +989,7 @@ ;* writer: */ ;* html: @ref ../../skr/html.skr:mailto@ */ ;*---------------------------------------------------------------------*/ -(define-markup (mailto #!rest opts #!key (ident #f) (class "mailto") text) +(define-markup (mailto :rest opts :key (ident #f) (class "mailto") text) (new markup (markup 'mailto) (ident (or ident (symbol->string (gensym "ident")))) @@ -1012,7 +1012,7 @@ ;* writer: */ ;* html: @ref ../../skr/html.skr:mark@ */ ;*---------------------------------------------------------------------*/ -(define-markup (mark #!rest opts #!key (ident #f) (class "mark") (text #f)) +(define-markup (mark :rest opts :key (ident #f) (class "mark") (text #f)) (let ((bd (the-body opts))) (cond ((and (pair? bd) (not (null? (cdr bd)))) @@ -1044,9 +1044,9 @@ ;* html: @ref ../../skr/html.skr:ref@ */ ;* latex: @ref ../../skr/latex.skr:ref@ */ ;*---------------------------------------------------------------------*/ -(define-markup (ref #!rest +(define-markup (ref :rest opts - #!key + :key (class #f) (ident #f) (text #f) @@ -1245,22 +1245,21 @@ ;*---------------------------------------------------------------------*/ ;* numref ... */ ;*---------------------------------------------------------------------*/ -(define-markup (numref #!rest opts - #!key (ident #f) (text "") (page #f) +(define-markup (numref :rest opts + :key (ident #f) (text "") (page #f) (separator ".") (class #f)) ;; Produce a numbered reference to `ident'. (new unresolved (loc &invocation-location) (proc (lambda (n e env) - (let* ((parent (ast-parent n)) - (doc (ast-document n)) + (let* ((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': ") + "can't find `ident': " ident) (new markup (markup 'unref) @@ -1300,8 +1299,8 @@ ;* doc: */ ;* @ref ../../doc/user/bib.skb:bibliography@ */ ;*---------------------------------------------------------------------*/ -(define-markup (bibliography #!rest files - #!key +(define-markup (bibliography :rest files + :key (command #f) (bib-table (*bib-table*))) (for-each (lambda (f) (cond @@ -1321,8 +1320,8 @@ ;* writer: */ ;* base: @ref ../../skr/base.skr:the-bibliography@ */ ;*---------------------------------------------------------------------*/ -(define-markup (the-bibliography #!rest opts - #!key +(define-markup (the-bibliography :rest opts + :key pred (bib-table (*bib-table*)) (sort bib-sort/authors) @@ -1338,7 +1337,7 @@ (else (skribe-error 'the-bibliography - "invalid label type" lables))))) + "invalid label type" labels))))) (new unresolved (loc &invocation-location) (proc (lambda (n e env) @@ -1356,7 +1355,7 @@ ;* doc: */ ;* @ref ../../doc/user/index.skb:make-index@ */ ;*---------------------------------------------------------------------*/ -(define-markup (make-index ident) +(define-public (make-index ident) (make-index-table ident)) ;*---------------------------------------------------------------------*/ @@ -1365,9 +1364,9 @@ ;* doc: */ ;* @ref ../../doc/user/index.skb:index@ */ ;*---------------------------------------------------------------------*/ -(define-markup (index #!rest +(define-markup (index :rest opts - #!key + :key (ident #f) (class "index") (note #f) (index #f) (shape #f) (url #f)) @@ -1376,7 +1375,7 @@ ((string? entry-name) entry-name) ((and (pair? entry-name) (every string? entry-name)) - (apply string-append entry-name)) + (string-concatenate entry-name)) (else (skribe-error 'index @@ -1420,9 +1419,9 @@ ;* base: @ref ../../skr/base.skr:the-index@ */ ;* html: @ref ../../skr/html.skr:the-index-header@ */ ;*---------------------------------------------------------------------*/ -(define-markup (the-index #!rest +(define-markup (the-index :rest opts - #!key + :key (ident #f) (class "the-index") (split #f) @@ -1458,7 +1457,7 @@ ;*---------------------------------------------------------------------*/ ;* p ... */ ;*---------------------------------------------------------------------*/ -(define-markup (p #!rest opt #!key ident (class #f)) +(define-markup (p :rest opt :key ident (class #f)) (paragraph :ident ident :class class :loc &invocation-location (the-body opt))) @@ -1482,7 +1481,7 @@ ;* produces: */ ;* i) toto, ii) tutu, iii) titi. */ ;*---------------------------------------------------------------------*/ -(define-markup (counter #!rest opts #!key (numbering 'roman)) +(define-markup (counter :rest opts :key (numbering 'roman)) (define items (if (eq? (car opts) :numbering) (cddr opts) opts)) (define vroman #(- "i" "ii" "iii" "iv" "v" "vi" "vii" "viii" "ix" "x")) (define (the-roman-number num) @@ -1492,9 +1491,9 @@ "too many items for roman numbering" (length items)))) (define (the-arabic-number num) - (list (list "(" (it (integer->string num)) ") "))) + (list (list "(" (it (number->string num)) ") "))) (define (the-alpha-number num) - (list (list "(" (it (+ (integer->char #\a) num -1)) ") "))) + (list (list "(" (it (+ (char->integer #\a) num -1)) ") "))) (let ((the-number (case numbering ((roman) the-roman-number) ((arabic) the-arabic-number) @@ -1514,7 +1513,7 @@ ;*---------------------------------------------------------------------*/ ;* q */ ;*---------------------------------------------------------------------*/ -(define-markup (q #!rest opt) +(define-markup (q :rest opt) (new markup (markup 'q) (loc &invocation-location) diff --git a/src/guile/skribilo/package/diff.scm b/src/guile/skribilo/package/diff.scm index 58887ff..fe509b7 100644 --- a/src/guile/skribilo/package/diff.scm +++ b/src/guile/skribilo/package/diff.scm @@ -37,7 +37,6 @@ :autoload (skribilo biblio) (*bib-table* make-bib-table) :use-module (skribilo package base) :use-module (skribilo utils syntax) - :autoload (skribilo utils keywords) (the-options the-body) :export (make-diff-document make-diff-document-from-files)) @@ -137,8 +136,7 @@ (if (null? result) `((unchanged ,start ,end)) (let ((prev-unchanged? (eq? (caar result) 'unchanged)) - (prev-start (cadr (car result))) - (prev-end (caddr (car result)))) + (prev-start (cadr (car result)))) (if prev-unchanged? (cons `(unchanged ,prev-start ,end) (cdr result)) @@ -385,16 +383,16 @@ ;; are highlighted. (let ((ast1 (parameterize ((*bib-table* (make-bib-table 'doc-1))) + (skribe-message "diff: loading first document~%") (evaluate-ast-from-port (open-input-file old-file) :reader reader :module (make-run-time-module)))) - (~~ (skribe-message "diff: first document loaded~%")) (ast2 (parameterize ((*bib-table* (make-bib-table 'doc-2))) + (skribe-message "diff: loading second document~%") (evaluate-ast-from-port (open-input-file new-file) :reader reader - :module (make-run-time-module)))) - (%% (skribe-message "diff: second document loaded~%"))) + :module (make-run-time-module))))) (resolve! ast1 engine env) (resolve! ast2 engine env) diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm index ec6bbc7..9b03aef 100644 --- a/src/guile/skribilo/package/eq.scm +++ b/src/guile/skribilo/package/eq.scm @@ -25,7 +25,6 @@ :use-module (skribilo engine) :use-module (skribilo lib) :use-module (skribilo utils syntax) - :use-module (skribilo module) :use-module (skribilo utils keywords) ;; `the-options', etc. :autoload (skribilo package base) (it symbol sub sup) :autoload (skribilo engine lout) (lout-illustration) @@ -253,6 +252,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., ;; If no `:div-style' is specified here, obey the top-level one. (new markup (markup 'eq:/) + (loc &invocation-location) (ident (or ident (symbol->string (gensym "eq:/")))) (class #f) (options `((:div-style ,div-style) @@ -263,6 +263,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., ;; If no `:mul-style' is specified here, obey the top-level one. (new markup (markup 'eq:*) + (loc &invocation-location) (ident (or ident (symbol->string (gensym "eq:*")))) (class #f) (options `((:mul-style ,mul-style) @@ -288,6 +289,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (from #f) (to #f)) (new markup (markup 'eq:sum) + (loc &invocation-location) (ident (or ident (symbol->string (gensym "eq:sum")))) (options (the-options opts)) (body (the-body opts)))) @@ -296,6 +298,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (from #f) (to #f)) (new markup (markup 'eq:product) + (loc &invocation-location) (ident (or ident (symbol->string (gensym "eq:product")))) (options (the-options opts)) (body (the-body opts)))) @@ -304,6 +307,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (sub #f) (sup #f)) (new markup (markup 'eq:script) + (loc &invocation-location) (ident (or ident (symbol->string (gensym "eq:script")))) (options (the-options opts)) (body (the-body opts)))) @@ -317,6 +321,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., ;; non-list arguments but the last one has to be a list. (new markup (markup 'eq:apply) + (loc &invocation-location) (ident (or ident (symbol->string (gensym "eq:apply")))) (options (the-options opts)) (body (let loop ((body (the-body opts)) @@ -336,6 +341,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (define-markup (eq:limit var lim :rest body :key (ident #f)) (new markup (markup 'eq:limit) + (loc &invocation-location) (ident (or ident (symbol->string (gensym "eq:limit")))) (options `((:var ,var) (:limit ,lim) ,@(the-options body :ident))) @@ -344,6 +350,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (define-markup (eq:combinations x y :rest opts :key (ident #f)) (new markup (markup 'eq:combinations) + (loc &invocation-location) (ident (or ident (symbol->string (gensym "eq:combinations")))) (options `((:of ,x) (:among ,y) ,@(the-options opts :ident))) @@ -352,6 +359,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (define-markup (eq:set :rest opts :key (ident #f)) (new markup (markup 'eq:set) + (loc &invocation-location) (ident (or ident (symbol->string (gensym "eq:set")))) (options '()) (body (the-body opts)))) diff --git a/src/guile/skribilo/package/letter.scm b/src/guile/skribilo/package/letter.scm index 9036bd3..6f5c248 100644 --- a/src/guile/skribilo/package/letter.scm +++ b/src/guile/skribilo/package/letter.scm @@ -26,7 +26,7 @@ :use-module (skribilo lib) :autoload (skribilo output) (output) :autoload (skribilo utils keywords) (the-body the-options) - :use-module (skribilo package base) + :use-module ((skribilo package base) :renamer (symbol-prefix-proc 'skr:)) :use-module (srfi srfi-1) :use-module (skribilo utils syntax) @@ -38,8 +38,6 @@ ;*---------------------------------------------------------------------*/ ;* document */ ;*---------------------------------------------------------------------*/ -(define %letter-document document) - (define-markup (document :rest opt :key (ident #f) (class "letter") where date author @@ -52,7 +50,7 @@ (:date ,date) (:author ,author)))) ubody))) - (apply %letter-document + (apply skr:document :author #f :title #f (append (concatenate (the-options opt :where :date :author :title)) @@ -77,7 +75,8 @@ (ne (copy-engine 'author e))) ;; author (markup-writer 'author ne - :options '(:name :title :affiliation :email :url :address :phone :photo :align :header) + :options '(:name :title :affiliation :email :url + :address :phone :photo :align :header) :action (lambda (n e) (let ((name (markup-option n :name)) (title (markup-option n :title)) diff --git a/src/guile/skribilo/package/pie.scm b/src/guile/skribilo/package/pie.scm index 232ef9c..0292ccf 100644 --- a/src/guile/skribilo/package/pie.scm +++ b/src/guile/skribilo/package/pie.scm @@ -27,10 +27,9 @@ :use-module (skribilo utils syntax) :use-module (skribilo utils keywords) ;; `the-options', etc. :use-module (skribilo utils strings) ;; `make-string-replace' - :use-module (skribilo module) :autoload (skribilo color) (skribe-color->rgb) :autoload (skribilo package base) (bold) - :autoload (skribilo engine lout) (lout-illustration) + :autoload (srfi srfi-13) (string-concatenate) :autoload (ice-9 popen) (open-output-pipe) :use-module (ice-9 optargs) :export (%ploticus-program %ploticus-debug? @@ -125,7 +124,7 @@ the string \"hello\". Implement `sliceweight' markups too." (number->string (percentage-round value))) (pie-remove-markup (markup-body node))) (if (list? node) - (apply string-append (map pie-remove-markup node)) + (string-concatenate (map pie-remove-markup node)) node))) (define strip-newlines (make-string-replace '((#\newline " ")))) @@ -174,14 +173,16 @@ the string \"hello\". Implement `sliceweight' markups too." (string-append (color-spec->ploticus c) " "))) (markup-body pie))) - (total-weight (or (if (number? (markup-option pie - :total)) - (markup-option pie :total) - #f) - (apply + weights))) + (total-weight + (let ((w (or (if (number? (markup-option pie + :total)) + (markup-option pie :total) + #f) + (apply + weights)))) - ;; Attach useful information to the pie and its slices - (-/- (markup-option-add! pie '&total-weight total-weight)) + ;; Attach useful information to the pie and its slices + (markup-option-add! pie '&total-weight w) + w)) ;; One slice label per line -- so we need to remove ;; newlines from labels. @@ -215,7 +216,7 @@ the string \"hello\". Implement `sliceweight' markups too." (* max-radius max-radius)) . ,(* max-radius max-radius)))) - (apply string-append + (string-concatenate (append (list "#proc getdata\n" "data: ") (map (lambda (weight) (string-append (number->string weight) diff --git a/src/guile/skribilo/package/scribe.scm b/src/guile/skribilo/package/scribe.scm index 388ef56..5ab3069 100644 --- a/src/guile/skribilo/package/scribe.scm +++ b/src/guile/skribilo/package/scribe.scm @@ -21,11 +21,10 @@ (define-module (skribilo package scribe) :use-module (skribilo engine) - :autoload (skribilo package base) (chapter font flush - toc the-bibliography) :autoload (skribilo utils keywords) (the-options the-body) :autoload (skribilo evaluator) (load-document) :use-module (skribilo biblio) + :use-module ((skribilo package base) :renamer (symbol-prefix-proc 'skr:)) :use-module (skribilo lib) :use-module (skribilo utils syntax) @@ -35,13 +34,13 @@ :use-module (srfi srfi-13) :export (style chapter table-of-contents frame copyright sect euro - tab space print-bibliography linebreak ref make-index - print-index scribe-format? scribe-url prgm - *scribe-tex-predocument* latex-prelude html-prelude + tab space print-bibliography linebreak ref make-index + index print-index scribe-format? scribe-url prgm + *scribe-tex-predocument* latex-prelude html-prelude - *scribe-background* *scribe-foreground* *scribe-tbackground* - *scribe-tforeground* *scribe-title-font* *scribe-author-font* - *scribe-chapter-numbering* *scribe-footer* *scribe-prgm-color*)) + *scribe-background* *scribe-foreground* *scribe-tbackground* + *scribe-tforeground* *scribe-title-font* *scribe-author-font* + *scribe-chapter-numbering* *scribe-footer* *scribe-prgm-color*)) (fluid-set! current-reader %skribilo-module-reader) @@ -71,10 +70,8 @@ ;*---------------------------------------------------------------------*/ ;* chapter ... */ ;*---------------------------------------------------------------------*/ -(define skribe-chapter chapter) - (define-markup (chapter :rest opt :key title subtitle split number toc file) - (apply skribe-chapter + (apply skr:chapter :title (or title subtitle) :number number :toc toc @@ -85,16 +82,14 @@ ;* table-of-contents ... */ ;*---------------------------------------------------------------------*/ (define* (table-of-contents :key chapter section subsection - :rest opts) - (apply toc opts)) + :rest opts) + (apply skr:toc opts)) ;*---------------------------------------------------------------------*/ ;* frame ... */ ;*---------------------------------------------------------------------*/ -(define skribe-frame frame) - (define-markup (frame :rest opt :key width margin) - (apply skribe-frame + (apply skr:frame :width (if (real? width) (* 100 width) width) :margin margin (the-body opt))) @@ -121,61 +116,54 @@ ;* tab ... */ ;*---------------------------------------------------------------------*/ (define (tab) - (char #\tab)) + (skr:char #\tab)) ;*---------------------------------------------------------------------*/ ;* space ... */ ;*---------------------------------------------------------------------*/ (define (space) - (char #\space)) + (skr:char #\space)) ;*---------------------------------------------------------------------*/ ;* print-bibliography ... */ ;*---------------------------------------------------------------------*/ -(define-markup (print-bibliography :rest opts +(define-markup (print-bibliography :rest opts :key all (sort bib-sort/authors)) - (the-bibliography all sort)) + (skr:the-bibliography all sort)) ;*---------------------------------------------------------------------*/ ;* linebreak ... */ ;*---------------------------------------------------------------------*/ -(define skribe-linebreak linebreak) - (define (linebreak . lnum) (cond ((null? lnum) - (skribe-linebreak)) + (skr:linebreak)) ((string? (car lnum)) - (skribe-linebreak (string->number (car lnum)))) + (skr:linebreak (string->number (car lnum)))) (else - (skribe-linebreak (car lnum))))) + (skr:linebreak (car lnum))))) ;*---------------------------------------------------------------------*/ ;* ref ... */ ;*---------------------------------------------------------------------*/ -(define skribe-ref ref) - (define* (ref :key scribe url id page figure mark - chapter section subsection subsubsection subsubsubsection - bib bib+ number - :rest opts) + chapter section subsection subsubsection subsubsubsection + bib bib+ number + :rest opts) (let ((bd (the-body opts)) (args (concatenate (the-options opts :id)))) (if id (set! args (cons* :mark id args))) (if (pair? bd) (set! args (cons* :text bd args))) - (apply skribe-ref args))) + (apply skr:ref args))) ;*---------------------------------------------------------------------*/ ;* indexes ... */ ;*---------------------------------------------------------------------*/ (define *scribe-indexes* - (list (cons "theindex" (make-index "theindex")))) - -(define skribe-index index) -(define skribe-make-index make-index) + (list (cons "theindex" (skr:make-index "theindex")))) (define (make-index index) - (let ((i (skribe-make-index index))) + (let ((i (skr:make-index index))) (set! *scribe-indexes* (cons (cons index i) *scribe-indexes*)) i)) @@ -186,12 +174,12 @@ (if (pair? i) (cdr i) (make-index index)))))) - (apply skribe-index :note note :index i :shape shape (the-body opts)))) + (apply skr:index :note note :index i :shape shape (the-body opts)))) (define* (print-index :key split (char-offset 0) (header-limit 100) - :rest opts) - (apply the-index - :split split + :rest opts) + (apply skr:the-index + :split split :char-offset char-offset :header-limit header-limit (map (lambda (i) @@ -200,7 +188,7 @@ (cdr c) (skribe-error 'the-index "Unknown index" i)))) (the-body opts)))) - + ;*---------------------------------------------------------------------*/ ;* format? */ ;*---------------------------------------------------------------------*/ @@ -227,26 +215,26 @@ ;*---------------------------------------------------------------------*/ ;* prgm ... */ ;*---------------------------------------------------------------------*/ -(define-markup (prgm :rest opts - :key lnum lnumwidth language bg frame (width 1.) - colors (monospace #t)) +(define (prgm :key lnum lnumwidth language bg frame (width 1.) + colors (monospace #t) + :rest opts) (let* ((w (cond ((real? width) (* width 100.)) ((number? width) width) (else 100.))) - (body (if language - (source :language language (the-body opts)) + (body (if language + (skr:source :language language (the-body opts)) (the-body opts))) (body (if monospace - (prog :line lnum body) + (skr:prog :line lnum body) body)) (body (if bg - (color :width 100. :bg bg body) - body))) - (skribe-frame :width w - :border (if frame 1 #f) + (skr:color :width 100. :bg bg body) body))) - + (skr:frame :width w + :border (if frame 1 #f) + body))) + ;*---------------------------------------------------------------------*/ ;* latex configuration */ ;*---------------------------------------------------------------------*/ @@ -260,7 +248,7 @@ (begin (if *scribe-tex-predocument* (engine-custom-set! e 'predocument *scribe-tex-predocument*))))) - + ;*---------------------------------------------------------------------*/ ;* html-prelude ... */ ;*---------------------------------------------------------------------*/ @@ -268,7 +256,7 @@ (if (engine-format? "html" e) (begin #f))) - + ;*---------------------------------------------------------------------*/ ;* prelude */ ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/package/sigplan.scm b/src/guile/skribilo/package/sigplan.scm index e1db670..5be8ac5 100644 --- a/src/guile/skribilo/package/sigplan.scm +++ b/src/guile/skribilo/package/sigplan.scm @@ -33,7 +33,7 @@ :use-module (skribilo utils syntax) :use-module (ice-9 optargs) - :export (abstract references)) + :export (abstract references acm-copyright)) (fluid-set! current-reader %skribilo-module-reader) @@ -172,7 +172,8 @@ ;*---------------------------------------------------------------------*/ ;* acm-copyright ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-copyright :rest opt :key conference location year crdata) +(define* (acm-copyright :key conference location year crdata + :rest opt) (let* ((le (find-engine 'latex)) (cop (format #f "\\conferenceinfo{~a,} {~a} \\CopyrightYear{~a} diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm index dd6519d..0a3d773 100644 --- a/src/guile/skribilo/package/slide.scm +++ b/src/guile/skribilo/package/slide.scm @@ -21,19 +21,19 @@ (define-module (skribilo package slide) - :use-module (skribilo reader) :use-module (skribilo utils syntax) :use-module (skribilo lib) :use-module (skribilo ast) :use-module (skribilo engine) :use-module (skribilo evaluator) ;; `*load-options*' - :use-module (skribilo package base) + :autoload (skribilo color) (skribe-use-color!) :autoload (skribilo utils keywords) (the-options the-body) :use-module (srfi srfi-1) - :use-module (ice-9 optargs)) + :use-module (ice-9 optargs) + :use-module (ice-9 match)) (fluid-set! current-reader %skribilo-module-reader) @@ -92,7 +92,7 @@ ;*---------------------------------------------------------------------*/ ;* ref ... */ ;*---------------------------------------------------------------------*/ -(define %slide-old-ref ref) +; (define %slide-old-ref ref) ;; Extend the definition of `ref'. ;; FIXME: This technique breaks `ref' for some reason. @@ -144,7 +144,7 @@ ;*---------------------------------------------------------------------*/ ;* slide-pause ... */ ;*---------------------------------------------------------------------*/ -(define-markup (slide-pause) +(define-markup (slide-pause :rest ignored) (new markup (loc &invocation-location) (markup 'slide-pause))) @@ -220,8 +220,8 @@ :key ident class color (scolor "#000000")) (let ((body (the-body opt))) (for-each (lambda (lbl) - (match-case lbl - ((?id ?col) + (match lbl + ((id col) (skribe-use-color! col)))) body) (new markup diff --git a/src/guile/skribilo/package/web-article.scm b/src/guile/skribilo/package/web-article.scm index 6d1b7a5..31a88fa 100644 --- a/src/guile/skribilo/package/web-article.scm +++ b/src/guile/skribilo/package/web-article.scm @@ -1,6 +1,7 @@ -;;; web-article.scm -- A Skribe style for producing web articles +;;; web-article.scm -- A style to produce web articles. ;;; ;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -18,12 +19,28 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package web-article)) +(define-module (skribilo package web-article) + :use-module (skribilo utils syntax) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo writer) + :use-module (skribilo package base) + + :autoload (skribilo output) (output) + :autoload (skribilo evaluator) (evaluate-document) + :autoload (skribilo engine html) (html-width html-title-authors) + :autoload (skribilo utils strings) (string-canonicalize) + + :use-module (srfi srfi-1)) + +(fluid-set! current-reader %skribilo-module-reader) + + ;*---------------------------------------------------------------------*/ ;* &web-article-load-options ... */ ;*---------------------------------------------------------------------*/ -(define &web-article-load-options (skribe-load-options)) +(define &web-article-load-options (*load-options*)) ;*---------------------------------------------------------------------*/ ;* web-article-body-width ... */ @@ -41,23 +58,23 @@ (tbg (engine-custom e 'title-background)) (tfg (engine-custom e 'title-foreground)) (tfont (engine-custom e 'title-font))) - (printf "
\n" + (format #t "
\n" (html-width (web-article-body-width e))) (if (string? tbg) - (printf "
" tbg) + (format #t "" tbg) (display "")) (if (string? tfg) - (printf "" tfg)) + (format #t "" tfg)) (if title (begin (display "
") (if (string? tfont) (begin - (printf "" tfont) + (format #t "" tfont) (output title e) (display "")) (begin - (printf "

") + (display "

") (output title e) (display "

"))) (display "
\n"))) @@ -76,12 +93,12 @@ (authors (markup-option n 'author)) (id (markup-ident n))) ;; the title - (printf "
\n" + (format #t "
\n" (string-canonicalize id)) (output title e) (display "
\n") ;; the authors - (printf "
\n" + (format #t "
\n" (string-canonicalize id)) (for-each (lambda (a) (output a e)) (cond @@ -103,26 +120,24 @@ (email (markup-option n :email)) (url (markup-option n :url)) (address (markup-option n :address)) - (phone (markup-option n :phone)) - (nfn (engine-custom e 'author-font)) - (align (markup-option n :align))) + (phone (markup-option n :phone))) (when name - (printf "" + (format #t "" (string-canonicalize (markup-ident n))) (output name e) (display "\n")) (when title - (printf "" + (format #t "" (string-canonicalize (markup-ident n))) (output title e) (display "\n")) (when affiliation - (printf "" + (format #t "" (string-canonicalize (markup-ident n))) (output affiliation e) (display "\n")) (when (pair? address) - (printf "" + (format #t "" (string-canonicalize (markup-ident n))) (for-each (lambda (a) (output a e) @@ -130,17 +145,17 @@ address) (display "\n")) (when phone - (printf "" + (format #t "" (string-canonicalize (markup-ident n))) (output phone e) (display "\n")) (when email - (printf "" + (format #t "" (string-canonicalize (markup-ident n))) (output email e) (display "\n")) (when url - (printf "" + (format #t "" (string-canonicalize (markup-ident n))) (output url e) (display "\n")))) @@ -164,7 +179,7 @@ (markup-writer 'section e1 :options 'all :action (lambda (n e2) (output n e sec))) - (skribe-eval + (evaluate-document (center (color :width (web-article-body-width e) :margin 5 :bg bg n)) e1)))) @@ -180,7 +195,7 @@ :options 'all :action (lambda (n e2) (invoke (writer-action ft) n e))) - (skribe-eval + (evaluate-document (center (color :width (web-article-body-width e) :margin 5 :bg bg :fg fg n)) e1)))))) @@ -194,7 +209,7 @@ ;; &html-document-title (markup-writer '&html-document-title he :before (lambda (n e) - (printf "
\n" + (format #t "
\n" (string-canonicalize (markup-ident n)))) :action web-article-css-document-title :after "
\n") @@ -202,7 +217,7 @@ (markup-writer 'author he :options '(:name :title :affiliation :email :url :address :phone :photo :align) :before (lambda (n e) - (printf "\n" + (format #t "\n" (string-canonicalize (markup-ident n)))) :action web-article-css-author :after "" + (format #t "
" (string-canonicalize (markup-ident n)))) :action (lambda (n e) (output n e sec)) :after "
\n") @@ -218,7 +233,7 @@ (markup-writer '&html-footnotes he :options 'all :before (lambda (n e) - (printf "
" + (format #t "
" (string-canonicalize (markup-ident n)))) :action (lambda (n e) (output n e ft)) diff --git a/src/guile/skribilo/package/web-book.scm b/src/guile/skribilo/package/web-book.scm index 49197f1..624a8d2 100644 --- a/src/guile/skribilo/package/web-book.scm +++ b/src/guile/skribilo/package/web-book.scm @@ -1,6 +1,7 @@ -;;; web-book.scm -- The Skribe web book style. +;;; web-book.scm -- The web book style. ;;; ;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -18,8 +19,17 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package web-book)) +(define-module (skribilo package web-book) + :use-module (skribilo utils syntax) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo package base)) + +(fluid-set! current-reader %skribilo-module-reader) + + + ;*---------------------------------------------------------------------*/ ;* html customization */ ;*---------------------------------------------------------------------*/ -- cgit v1.2.3