From 9457610daa0ad13623c95d7ac5a6e54d188aa4e6 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Tue, 5 Jun 2007 17:03:28 +0000 Subject: Started cleaning up packages using Guile-Lint. Most of the changes involve: * using a native module rather than `define-skribe-module'. * using `:'-style keywords instead of DSSSL keywords so that Guile-Lint can handle them. * fixing unbound variables and the likes. git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-57 --- src/guile/skribilo/engine/latex.scm | 2 +- src/guile/skribilo/package/acmproc.scm | 43 +++++++++--- src/guile/skribilo/package/eq/lout.scm | 4 +- src/guile/skribilo/package/french.scm | 4 +- src/guile/skribilo/package/jfp.scm | 107 +++++++++++++---------------- src/guile/skribilo/package/letter.scm | 37 ++++++---- src/guile/skribilo/package/lncs.scm | 37 +++++----- src/guile/skribilo/package/pie/lout.scm | 6 +- src/guile/skribilo/package/scribe.scm | 86 +++++++++++++++++------ src/guile/skribilo/package/sigplan.scm | 61 +++++++++++----- src/guile/skribilo/package/skribe.scm | 8 ++- src/guile/skribilo/package/slide.scm | 28 ++++---- src/guile/skribilo/package/slide/base.scm | 3 +- src/guile/skribilo/package/slide/html.scm | 3 +- src/guile/skribilo/package/slide/latex.scm | 106 ++++++++++++++++------------ src/guile/skribilo/package/slide/lout.scm | 8 +-- 16 files changed, 328 insertions(+), 215 deletions(-) (limited to 'src') diff --git a/src/guile/skribilo/engine/latex.scm b/src/guile/skribilo/engine/latex.scm index 2d5e4b6..e69769b 100644 --- a/src/guile/skribilo/engine/latex.scm +++ b/src/guile/skribilo/engine/latex.scm @@ -442,7 +442,7 @@ ;*---------------------------------------------------------------------*/ ;* skribe-get-latex-color ... */ ;*---------------------------------------------------------------------*/ -(define (skribe-get-latex-color spec) +(define-public (skribe-get-latex-color spec) (let ((c (and (hashtable? *skribe-latex-color-table*) (hashtable-get *skribe-latex-color-table* spec)))) (if (not (string? c)) diff --git a/src/guile/skribilo/package/acmproc.scm b/src/guile/skribilo/package/acmproc.scm index 61eafd5..5ca1288 100644 --- a/src/guile/skribilo/package/acmproc.scm +++ b/src/guile/skribilo/package/acmproc.scm @@ -1,6 +1,7 @@ ;;; acmproc.scm -- The Skribe style for ACMPROC articles. ;;; ;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -18,6 +19,28 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. +(define-module (skribilo package acmproc) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo writer) + :autoload (skribilo output) (output) + :autoload (skribilo package base) (chapter font flush + toc the-bibliography) + :autoload (skribilo utils keywords) (the-options the-body) + :autoload (skribilo evaluator) (evaluate-document) + + :use-module (skribilo lib) + :use-module (skribilo utils syntax) + + :use-module (ice-9 optargs) + :use-module (srfi srfi-13) + + :export (abstract references)) + +(fluid-set! current-reader %skribilo-module-reader) + + + ;*---------------------------------------------------------------------*/ ;* LaTeX global customizations */ ;*---------------------------------------------------------------------*/ @@ -29,7 +52,7 @@ (markup-writer '&latex-author le :before (lambda (n e) (let ((body (markup-body n))) - (printf "\\numberofauthors{~a}\n\\author{\n" + (format #f "\\numberofauthors{~a}\n\\author{\n" (if (pair? body) (length body) 1)))) :action (lambda (n e) (let ((body (markup-body n))) @@ -90,7 +113,7 @@ "#cccccc")) (exp (p (center (color :bg bg :width 90. (markup-body n)))))) - (skribe-eval exp e)))) + (evaluate-document exp e)))) ;; ACM category, terms, and keywords (markup-writer '&acm-category :action #f) (markup-writer '&acm-terms :action #f) @@ -100,11 +123,12 @@ ;*---------------------------------------------------------------------*/ ;* abstract ... */ ;*---------------------------------------------------------------------*/ -(define-markup (abstract #!rest opt #!key (class "abstract") postscript) +(define-markup (abstract :rest opt :key (class "abstract") postscript) (if (engine-format? "latex") (section :number #f :title "ABSTRACT" (p (the-body opt))) (let ((a (new markup (markup '&html-acmproc-abstract) + (loc &invocation-location) (body (the-body opt))))) (list (if postscript (section :number #f :toc #f :title "Postscript download" @@ -116,36 +140,39 @@ ;*---------------------------------------------------------------------*/ ;* acm-category ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-category #!rest opt #!key index section subsection) +(define-markup (acm-category :rest opt :key index section subsection) (new markup (markup '&acm-category) + (loc &invocation-location) (options (the-options opt)) (body (the-body opt)))) ;*---------------------------------------------------------------------*/ ;* acm-terms ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-terms #!rest opt) +(define-markup (acm-terms :rest opt) (new markup (markup '&acm-terms) + (loc &invocation-location) (options (the-options opt)) (body (the-body opt)))) ;*---------------------------------------------------------------------*/ ;* acm-keywords ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-keywords #!rest opt) +(define-markup (acm-keywords :rest opt) (new markup (markup '&acm-keywords) + (loc &invocation-location) (options (the-options opt)) (body (the-body opt)))) ;*---------------------------------------------------------------------*/ ;* acm-copyright ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-copyright #!rest opt #!key conference location year crdata) +(define-markup (acm-copyright :rest opt :key conference location year crdata) (let* ((le (find-engine 'latex)) - (cop (format "\\conferenceinfo{~a,} {~a} + (cop (format #f "\\conferenceinfo{~a,} {~a} \\CopyrightYear{~a} \\crdata{~a}\n" conference location year crdata)) (old (engine-custom le 'predocument))) diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm index bb243f6..9b27a7e 100644 --- a/src/guile/skribilo/package/eq/lout.scm +++ b/src/guile/skribilo/package/eq/lout.scm @@ -26,9 +26,7 @@ :use-module (skribilo engine) :use-module (skribilo lib) :use-module (skribilo utils syntax) - :use-module (skribilo utils keywords) ;; `the-options', etc. - :use-module (srfi srfi-1) - :use-module (ice-9 optargs)) + :use-module (srfi srfi-1)) (fluid-set! current-reader %skribilo-module-reader) diff --git a/src/guile/skribilo/package/french.scm b/src/guile/skribilo/package/french.scm index a23d1da..e7281d7 100644 --- a/src/guile/skribilo/package/french.scm +++ b/src/guile/skribilo/package/french.scm @@ -1,6 +1,7 @@ ;;; french.scm -- French Skribe style ;;; ;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -18,7 +19,8 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package french)) +(define-module (skribilo package french) + :use-module (skribilo engine)) ;*---------------------------------------------------------------------*/ ;* LaTeX configuration */ diff --git a/src/guile/skribilo/package/jfp.scm b/src/guile/skribilo/package/jfp.scm index 913b3e3..7360140 100644 --- a/src/guile/skribilo/package/jfp.scm +++ b/src/guile/skribilo/package/jfp.scm @@ -1,6 +1,7 @@ ;;; jfp.scm -- The Skribe style for JFP articles. ;;; ;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -18,7 +19,39 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package jfp)) +(define-module (skribilo package jfp) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo writer) + :autoload (skribilo output) (output) + :autoload (skribilo evaluator) (evaluate-document) + :autoload (skribilo lib) (skribe-error) + :autoload (skribilo biblio template) (output-bib-entry-template) + :autoload (skribilo utils keywords) (the-body) + :use-module (skribilo package base) + :use-module (srfi srfi-1) + + :use-module (skribilo utils syntax) + :use-module (ice-9 optargs) + :autoload (ice-9 regex) (regexp-substitute/global) + + :export (abstract references)) + +;;; Author: Manuel Serrano, Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; Tools for the Journal of Functional Programming (JFP). +;;; +;;; Code: + +(fluid-set! current-reader %skribilo-module-reader) + +(define every? every) + +(define (pregexp-replace* regexp str1 str2) + (regexp-substitute/global #f regexp str1 + 'pre str2 'post)) ;*---------------------------------------------------------------------*/ ;* LaTeX global customizations */ @@ -192,62 +225,8 @@ ;; %bib-entry-body (markup-writer '&bib-entry-body le :action (lambda (n e) - (define (output-fields descr) - (display "\\item[") - (let loop ((descr descr) - (pending #f) - (armed #f) - (first #t)) - (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 - #f) - (let ((o2 (caddr (car descr)))) - (loop (cons o2 (cdr descr)) - pending - armed - #f)))) - (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 #f)) - (loop (cdr descr) pending armed #f))))) - ((symbol? (car descr)) - (let ((o (markup-option n (car descr)))) - (if o - (begin - (if (and armed pending) - (output pending e)) - (output o e) - (if first - (display "]")) - (loop (cdr descr) #f #t #f)) - (loop (cdr descr) pending armed #f)))) - ((null? (cdr descr)) - (output (car descr) e)) - ((string? (car descr)) - (loop (cdr descr) - (if pending pending (car descr)) - armed - #f)) - (else - (skribe-error 'output-bib-fields - "Illegal description" - (car descr)))))) - (output-fields + (output-bib-entry-template n e + (case (markup-option n 'kind) ((techreport) `(author (" (" year ")") " " (or title url) ". " @@ -297,15 +276,21 @@ (center (color :bg bg :width 90. (it (markup-body n)))) (it (markup-body n)))))) - (skribe-eval exp e))))) - + (evaluate-document exp e))))) + + +;;; +;;; Markup. +;;; + ;*---------------------------------------------------------------------*/ ;* abstract ... */ ;*---------------------------------------------------------------------*/ -(define-markup (abstract #!rest opt #!key postscript) +(define-markup (abstract :rest opt :key postscript) (if (engine-format? "latex") (new markup (markup 'jfp-abstract) + (loc &invocation-location) (body (p (the-body opt)))) (let ((a (new markup (markup '&html-jfp-abstract) @@ -326,3 +311,5 @@ :number (not (engine-format? "latex")) (font :size -1 (the-bibliography))))) + +;;; jfp.scm ends here diff --git a/src/guile/skribilo/package/letter.scm b/src/guile/skribilo/package/letter.scm index 91d45be..9036bd3 100644 --- a/src/guile/skribilo/package/letter.scm +++ b/src/guile/skribilo/package/letter.scm @@ -1,6 +1,7 @@ ;;; letter.scm -- Skribe style for letters ;;; ;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -18,29 +19,43 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package letter)) +(define-module (skribilo package letter) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo writer) + :use-module (skribilo lib) + :autoload (skribilo output) (output) + :autoload (skribilo utils keywords) (the-body the-options) + :use-module (skribilo package base) + :use-module (srfi srfi-1) + :use-module (skribilo utils syntax) + :use-module (ice-9 optargs)) + +(fluid-set! current-reader %skribilo-module-reader) + + ;*---------------------------------------------------------------------*/ ;* document */ ;*---------------------------------------------------------------------*/ (define %letter-document document) -(define-markup (document #!rest opt - #!key (ident #f) (class "letter") +(define-markup (document :rest opt + :key (ident #f) (class "letter") where date author &skribe-eval-location) (let* ((ubody (the-body opt)) (body (list (new markup (markup '&letter-where) - (loc &skribe-eval-location) + (loc &invocation-location) (options `((:where ,where) (:date ,date) (:author ,author)))) ubody))) (apply %letter-document - :author #f :title #f - (append (apply append - (the-options opt :where :date :author :title)) + :author #f :title #f + (append (concatenate + (the-options opt :where :date :author :title)) body)))) ;*---------------------------------------------------------------------*/ @@ -94,11 +109,11 @@ ;; url (if url (row url))))) ;; emit the author - (if a + (if a (output a ne) (output hd e)))) :after "\\end{raggedright}\n\\vspace{1cm}\n\n")) - + ;*---------------------------------------------------------------------*/ ;* HTML configuration */ ;*---------------------------------------------------------------------*/ @@ -149,9 +164,7 @@ ;; url (if url (row url))))) ;; emit the author - (if a + (if a (output a ne) (output hd e)))) :after "\n
\n\n")) - - diff --git a/src/guile/skribilo/package/lncs.scm b/src/guile/skribilo/package/lncs.scm index e0c935b..39c4cc4 100644 --- a/src/guile/skribilo/package/lncs.scm +++ b/src/guile/skribilo/package/lncs.scm @@ -36,6 +36,7 @@ :use-module (skribilo utils syntax) :use-module (ice-9 optargs) + :use-module (srfi srfi-1) :use-module (srfi srfi-13) :export (abstract references)) @@ -95,28 +96,29 @@ (cdr n)) (display "}\n")) (let ((body (markup-body n))) + (define (institute=? n1 n2) + (let ((aff1 (markup-option n1 :affiliation)) + (add1 (markup-option n1 :address)) + (aff2 (markup-option n2 :affiliation)) + (add2 (markup-option n2 :address))) + (and (equal? aff1 aff2) (equal? add1 add2)))) + (define (search-institute n i j) + (cond + ((null? i) + #f) + ((institute=? n (car i)) + j) + (else + (search-institute n (cdr i) (- j 1))))) + (cond ((is-markup? body 'author) (markup-option-add! n 'inst 1) (&latex-author-1 body) (&latex-inst-n (list body))) ((and (list? body) - (every? (lambda (b) (is-markup? b 'author)) - body)) - (define (institute=? n1 n2) - (let ((aff1 (markup-option n1 :affiliation)) - (add1 (markup-option n1 :address)) - (aff2 (markup-option n2 :affiliation)) - (add2 (markup-option n2 :address))) - (and (equal? aff1 aff2) (equal? add1 add2)))) - (define (search-institute n i j) - (cond - ((null? i) - #f) - ((institute=? n (car i)) - j) - (else - (search-institute n (cdr i) (- j 1))))) + (every (lambda (b) (is-markup? b 'author)) + body)) (if (null? (cdr body)) (begin (markup-option-add! (car body) 'inst 1) @@ -155,7 +157,7 @@ (inst (markup-option n 'inst))) (if name (output name e)) (if title (output title e)) - (if inst (printf "\\inst{~a}\n" inst))))))) + (if inst (format #t "\\inst{~a}\n" inst))))))) ;*---------------------------------------------------------------------*/ ;* HTML global customizations */ @@ -178,6 +180,7 @@ (new markup (markup 'lncs-abstract) (options (the-options opt)) + (loc &invocation-location) (body (the-body opt))) (let ((a (new markup (markup '&html-lncs-abstract) diff --git a/src/guile/skribilo/package/pie/lout.scm b/src/guile/skribilo/package/pie/lout.scm index 61dbcb7..eb73729 100644 --- a/src/guile/skribilo/package/pie/lout.scm +++ b/src/guile/skribilo/package/pie/lout.scm @@ -1,6 +1,6 @@ ;;; lout.scm -- Lout implementation of the `pie' package. ;;; -;;; Copyright 2005, 2006 Ludovic Courtès +;;; Copyright 2005, 2006, 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -26,9 +26,7 @@ :use-module (skribilo engine) :use-module (skribilo lib) :use-module (skribilo utils syntax) - :use-module (skribilo utils keywords) ;; `the-options', etc. - :autoload (skribilo engine lout) (lout-color-specification) - :use-module (ice-9 optargs)) + :autoload (skribilo engine lout) (lout-color-specification)) (fluid-set! current-reader %skribilo-module-reader) diff --git a/src/guile/skribilo/package/scribe.scm b/src/guile/skribilo/package/scribe.scm index 902cdb5..388ef56 100644 --- a/src/guile/skribilo/package/scribe.scm +++ b/src/guile/skribilo/package/scribe.scm @@ -1,6 +1,7 @@ ;;; scribe.scm -- Scribe Compatibility kit ;;; ;;; 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,42 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package scribe)) +(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 lib) + :use-module (skribilo utils syntax) + + :use-module (ice-9 optargs) + :use-module (srfi srfi-1) + :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 + + *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) + +;;; Author: Manuel Serrano, Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; Compatibility layer for Scribe, Skribe's predecessor. See +;;; http://www-sop.inria.fr/mimosa/fp/Scribe/ for details. +;;; +;;; Code: + + ;*---------------------------------------------------------------------*/ ;* style ... */ ;*---------------------------------------------------------------------*/ @@ -30,7 +65,7 @@ style) ((symbol? style) (string-append (symbol->string style) ".scr"))))) - (skribe-load name :engine *skribe-engine*))) + (load-document name))) (for-each load-style styles)) ;*---------------------------------------------------------------------*/ @@ -38,7 +73,7 @@ ;*---------------------------------------------------------------------*/ (define skribe-chapter chapter) -(define-markup (chapter #!rest opt #!key title subtitle split number toc file) +(define-markup (chapter :rest opt :key title subtitle split number toc file) (apply skribe-chapter :title (or title subtitle) :number number @@ -49,7 +84,8 @@ ;*---------------------------------------------------------------------*/ ;* table-of-contents ... */ ;*---------------------------------------------------------------------*/ -(define-markup (table-of-contents #!rest opts #!key chapter section subsection) +(define* (table-of-contents :key chapter section subsection + :rest opts) (apply toc opts)) ;*---------------------------------------------------------------------*/ @@ -57,7 +93,7 @@ ;*---------------------------------------------------------------------*/ (define skribe-frame frame) -(define-markup (frame #!rest opt #!key width margin) +(define-markup (frame :rest opt :key width margin) (apply skribe-frame :width (if (real? width) (* 100 width) width) :margin margin @@ -96,8 +132,8 @@ ;*---------------------------------------------------------------------*/ ;* print-bibliography ... */ ;*---------------------------------------------------------------------*/ -(define-markup (print-bibliography #!rest opts - #!key all (sort bib-sort/authors)) +(define-markup (print-bibliography :rest opts + :key all (sort bib-sort/authors)) (the-bibliography all sort)) ;*---------------------------------------------------------------------*/ @@ -105,7 +141,7 @@ ;*---------------------------------------------------------------------*/ (define skribe-linebreak linebreak) -(define-markup (linebreak . lnum) +(define (linebreak . lnum) (cond ((null? lnum) (skribe-linebreak)) @@ -119,12 +155,12 @@ ;*---------------------------------------------------------------------*/ (define skribe-ref ref) -(define-markup (ref #!rest opts - #!key scribe url id page figure mark - chapter section subsection subsubsection subsubsection - bib bib+ number) +(define* (ref :key scribe url id page figure mark + chapter section subsection subsubsection subsubsubsection + bib bib+ number + :rest opts) (let ((bd (the-body opts)) - (args (apply append (the-options opts :id)))) + (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))) @@ -138,12 +174,12 @@ (define skribe-index index) (define skribe-make-index make-index) -(define-markup (make-index index) +(define (make-index index) (let ((i (skribe-make-index index))) (set! *scribe-indexes* (cons (cons index i) *scribe-indexes*)) i)) -(define-markup (index #!rest opts #!key note index shape) +(define* (index :key note index shape :rest opts) (let ((i (if (not index) "theindex" (let ((i (assoc index *scribe-indexes*))) @@ -152,8 +188,8 @@ (make-index index)))))) (apply skribe-index :note note :index i :shape shape (the-body opts)))) -(define-markup (print-index #!rest opts - #!key split (char-offset 0) (header-limit 100)) +(define* (print-index :key split (char-offset 0) (header-limit 100) + :rest opts) (apply the-index :split split :char-offset char-offset @@ -173,7 +209,7 @@ ;*---------------------------------------------------------------------*/ ;* scribe-url ... */ ;*---------------------------------------------------------------------*/ -(define (scribe-url) (skribe-url)) +(define (scribe-url) "http://www.nongnu.org/skribilo/") ;*---------------------------------------------------------------------*/ ;* Various configurations */ @@ -191,8 +227,8 @@ ;*---------------------------------------------------------------------*/ ;* prgm ... */ ;*---------------------------------------------------------------------*/ -(define-markup (prgm #!rest opts - #!key lnum lnumwidth language bg frame (width 1.) +(define-markup (prgm :rest opts + :key lnum lnumwidth language bg frame (width 1.) colors (monospace #t)) (let* ((w (cond ((real? width) (* width 100.)) @@ -236,5 +272,11 @@ ;*---------------------------------------------------------------------*/ ;* prelude */ ;*---------------------------------------------------------------------*/ -(let ((p (user-prelude))) - (user-prelude-set! (lambda (e) (p e) (latex-prelude e)))) +;; FIXME: I (Ludovic) guess `user-prelude' was supposed to be defined by user +;; documents. The issue is that the document's name space is not reachable +;; from here. +; (let ((p (user-prelude))) +; (user-prelude-set! (lambda (e) (p e) (latex-prelude e)))) + + +;;; scribe.scm ends here diff --git a/src/guile/skribilo/package/sigplan.scm b/src/guile/skribilo/package/sigplan.scm index 28d4e83..e1db670 100644 --- a/src/guile/skribilo/package/sigplan.scm +++ b/src/guile/skribilo/package/sigplan.scm @@ -1,6 +1,7 @@ ;;; sigplan.scm -- The Skribe style for ACMPROC articles. ;;; ;;; 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,25 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package sigplan)) +(define-module (skribilo package sigplan) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo writer) + :autoload (skribilo output) (output) + :autoload (skribilo evaluator) (evaluate-document) + :autoload (skribilo lib) (skribe-error) + :autoload (skribilo utils keywords) (the-body) + :use-module (skribilo package base) + :use-module (srfi srfi-1) + :use-module (skribilo utils syntax) + :use-module (ice-9 optargs) + + :export (abstract references)) + +(fluid-set! current-reader %skribilo-module-reader) + + ;*---------------------------------------------------------------------*/ ;* LaTeX global customizations */ ;*---------------------------------------------------------------------*/ @@ -31,8 +49,8 @@ (markup-writer '&latex-author le :before (lambda (n e) (let ((body (markup-body n))) - (printf "\\authorinfo{\n" - (if (pair? body) (length body) 1)))) + (display "\\authorinfo{\n") + (display (if (pair? body) (length body) 1)))) :action (lambda (n e) (let ((body (markup-body n))) (for-each (lambda (a) @@ -43,8 +61,8 @@ ;; author (let ((old-author (markup-writer-get 'author le))) (markup-writer 'author le - :options (writer-options old-author) - :action (writer-action old-author))) + :options (writer-options old-author) + :action (writer-action old-author))) ;; ACM category, terms, and keywords (markup-writer '&acm-category le :options '(:index :section :subsection) @@ -86,27 +104,33 @@ (markup-writer '&html-acmproc-abstract he :action (lambda (n e) (let* ((ebg (engine-custom e 'abstract-background)) - (bg (or (and (string? ebg) + (bg (or (and (string? ebg) (> (string-length ebg) 0)) ebg "#cccccc")) - (exp (p (center (color :bg bg :width 90. + (exp (p (center (color :bg bg :width 90. (markup-body n)))))) - (skribe-eval exp e)))) + (evaluate-document exp e)))) ;; ACM category, terms, and keywords (markup-writer '&acm-category :action #f) (markup-writer '&acm-terms :action #f) (markup-writer '&acm-keywords :action #f) (markup-writer '&acm-copyright :action #f)) - + + +;;; +;;; Markup. +;;; + ;*---------------------------------------------------------------------*/ ;* abstract ... */ ;*---------------------------------------------------------------------*/ -(define-markup (abstract #!rest opt #!key postscript) +(define-markup (abstract :rest opt :key postscript) (if (engine-format? "latex") (section :number #f :title "ABSTRACT" (p (the-body opt))) (let ((a (new markup (markup '&html-acmproc-abstract) + (loc &invocation-location) (body (the-body opt))))) (list (if postscript (section :number #f :toc #f :title "Postscript download" @@ -118,43 +142,46 @@ ;*---------------------------------------------------------------------*/ ;* acm-category ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-category #!rest opt #!key index section subsection) +(define-markup (acm-category :rest opt :key index section subsection) (new markup (markup '&acm-category) + (loc &invocation-location) (options (the-options opt)) (body (the-body opt)))) ;*---------------------------------------------------------------------*/ ;* acm-terms ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-terms #!rest opt) +(define-markup (acm-terms :rest opt) (new markup (markup '&acm-terms) + (loc &invocation-location) (options (the-options opt)) (body (the-body opt)))) ;*---------------------------------------------------------------------*/ ;* acm-keywords ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-keywords #!rest opt) +(define-markup (acm-keywords :rest opt) (new markup (markup '&acm-keywords) + (loc &invocation-location) (options (the-options opt)) (body (the-body opt)))) ;*---------------------------------------------------------------------*/ ;* acm-copyright ... */ ;*---------------------------------------------------------------------*/ -(define-markup (acm-copyright #!rest opt #!key conference location year crdata) +(define-markup (acm-copyright :rest opt :key conference location year crdata) (let* ((le (find-engine 'latex)) - (cop (format "\\conferenceinfo{~a,} {~a} + (cop (format #f "\\conferenceinfo{~a,} {~a} \\CopyrightYear{~a} \\crdata{~a}\n" conference location year crdata)) (old (engine-custom le 'predocument))) (if (string? old) (engine-custom-set! le 'predocument (string-append cop old)) (engine-custom-set! le 'predocument cop)))) - + ;*---------------------------------------------------------------------*/ ;* references ... */ ;*---------------------------------------------------------------------*/ @@ -163,4 +190,4 @@ (if (engine-format? "latex") (font :size -1 (flush :side 'left (the-bibliography))) (section :title "References" - (font :size -1 (the-bibliography)))))) + (font :size -1 (the-bibliography)))))) diff --git a/src/guile/skribilo/package/skribe.scm b/src/guile/skribilo/package/skribe.scm index 86969aa..4968653 100644 --- a/src/guile/skribilo/package/skribe.scm +++ b/src/guile/skribilo/package/skribe.scm @@ -18,10 +18,12 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. +;;; FIXME: This must be moved to the base package! + ;*---------------------------------------------------------------------*/ ;* p ... */ ;*---------------------------------------------------------------------*/ -(define-markup (p #!rest opt #!key ident (class #f) &skribe-eval-location) +(define-markup (p :rest opt :key ident (class #f) &skribe-eval-location) (paragraph :ident ident :class class :loc &skribe-eval-location (the-body opt))) @@ -45,7 +47,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) @@ -77,7 +79,7 @@ ;*---------------------------------------------------------------------*/ ;* q */ ;*---------------------------------------------------------------------*/ -(define-markup (q #!rest opt) +(define-markup (q :rest opt) (new markup (markup 'q) (options (the-options opt)) diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm index cb5edda..dd6519d 100644 --- a/src/guile/skribilo/package/slide.scm +++ b/src/guile/skribilo/package/slide.scm @@ -35,7 +35,7 @@ :use-module (srfi srfi-1) :use-module (ice-9 optargs)) -(fluid-set! current-reader (make-reader 'skribe)) +(fluid-set! current-reader %skribilo-module-reader) @@ -54,8 +54,8 @@ ;*---------------------------------------------------------------------*/ ;* slide ... */ ;*---------------------------------------------------------------------*/ -(define-markup (slide #!rest opt - #!key +(define-markup (slide :rest opt + :key (ident #f) (class #f) (toc #t) title (number #t) @@ -152,7 +152,7 @@ ;*---------------------------------------------------------------------*/ ;* slide-vspace ... */ ;*---------------------------------------------------------------------*/ -(define-markup (slide-vspace #!rest opt #!key (unit 'cm)) +(define-markup (slide-vspace :rest opt :key (unit 'cm)) (new markup (markup 'slide-vspace) (loc &invocation-location) @@ -162,8 +162,8 @@ ;*---------------------------------------------------------------------*/ ;* slide-embed ... */ ;*---------------------------------------------------------------------*/ -(define-markup (slide-embed #!rest opt - #!key +(define-markup (slide-embed :rest opt + :key command (arguments '()) (geometry-opt "-geometry") @@ -187,7 +187,7 @@ ;*---------------------------------------------------------------------*/ ;* slide-record ... */ ;*---------------------------------------------------------------------*/ -(define-markup (slide-record #!rest opt #!key ident class tag (play #t)) +(define-markup (slide-record :rest opt :key ident class tag (play #t)) (if (not tag) (skribe-error 'slide-record "Tag missing" tag) (new markup @@ -201,7 +201,7 @@ ;*---------------------------------------------------------------------*/ ;* slide-play ... */ ;*---------------------------------------------------------------------*/ -(define-markup (slide-play #!rest opt #!key ident class tag color) +(define-markup (slide-play :rest opt :key ident class tag color) (if (not tag) (skribe-error 'slide-play "Tag missing" tag) (new markup @@ -216,8 +216,8 @@ ;*---------------------------------------------------------------------*/ ;* slide-play* ... */ ;*---------------------------------------------------------------------*/ -(define-markup (slide-play* #!rest opt - #!key ident class color (scolor "#000000")) +(define-markup (slide-play* :rest opt + :key ident class color (scolor "#000000")) (let ((body (the-body opt))) (for-each (lambda (lbl) (match-case lbl @@ -248,8 +248,8 @@ ;*---------------------------------------------------------------------*/ ;* slide-topic ... */ ;*---------------------------------------------------------------------*/ -(define-markup (slide-topic #!rest opt - #!key title (outline? #t) +(define-markup (slide-topic :rest opt + :key title (outline? #t) (ident #f) (class #f)) (new container (markup 'slide-topic) @@ -264,8 +264,8 @@ ;*---------------------------------------------------------------------*/ ;* slide-subtopic ... */ ;*---------------------------------------------------------------------*/ -(define-markup (slide-subtopic #!rest opt - #!key title (outline? #f) +(define-markup (slide-subtopic :rest opt + :key title (outline? #f) (ident #f) (class #f)) (new container (markup 'slide-subtopic) diff --git a/src/guile/skribilo/package/slide/base.scm b/src/guile/skribilo/package/slide/base.scm index 1eeb25f..2532221 100644 --- a/src/guile/skribilo/package/slide/base.scm +++ b/src/guile/skribilo/package/slide/base.scm @@ -123,8 +123,7 @@ ;; Produce an entry for `topic'. Colorize it based on the fact ;; that the current topic is `current-topic' (it may need to be ;; hightlighted). - (let ((title (markup-option topic :title)) - (current? (eq? topic current-topic))) + (let ((current? (eq? topic current-topic))) (color :fg (if current? "#000000" "#666666") (apply (if current? bold (lambda (x) x)) (list (markup-option topic :title)))))) diff --git a/src/guile/skribilo/package/slide/html.scm b/src/guile/skribilo/package/slide/html.scm index 024e1fd..e8da8fb 100644 --- a/src/guile/skribilo/package/slide/html.scm +++ b/src/guile/skribilo/package/slide/html.scm @@ -30,7 +30,7 @@ :autoload (skribilo engine html) (html-width html-title-authors) :use-module (skribilo package slide) - :use-module ((skribilo package base) :select (ref))) + :use-module (skribilo package base)) (fluid-set! current-reader %skribilo-module-reader) @@ -145,7 +145,6 @@ :options '(:title :outline? :class :ident) :action (lambda (n e) (let ((title (markup-option n :title)) - (body (markup-body n)) (class (markup-class n))) ;; top-level class (if class (format #t "\n
" class)) diff --git a/src/guile/skribilo/package/slide/latex.scm b/src/guile/skribilo/package/slide/latex.scm index e187d3c..f80aaee 100644 --- a/src/guile/skribilo/package/slide/latex.scm +++ b/src/guile/skribilo/package/slide/latex.scm @@ -1,6 +1,7 @@ ;;; latex.scm -- LaTeX implementation of the `slide' package. ;;; ;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -18,13 +19,33 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo package slide latex) - :use-module (skribilo package slide)) +(define-module (skribilo package slide latex) + :use-module (skribilo package slide) + :use-module (skribilo utils syntax) + :use-module (skribilo engine) + :use-module (skribilo writer) + :autoload (skribilo output) (output) + :use-module (skribilo ast) + :use-module (skribilo lib) + :autoload (skribilo evaluator) (evaluate-document) + :autoload (skribilo engine latex) (skribe-get-latex-color) -(define-public %slide-latex-mode 'seminar) + :autoload (ice-9 regex) (string-match) + :use-module (ice-9 match) + :use-module (srfi srfi-11) + :use-module (srfi srfi-13) + :use-module (srfi srfi-39) -(define-public (%slide-latex-initialize!) + :export (%slide-latex-mode %slide-latex-initialize! *slide-advi-scale*)) + + +(fluid-set! current-reader %skribilo-module-reader) + + +(define %slide-latex-mode 'seminar) + +(define (%slide-latex-initialize!) (skribe-message "LaTeX slides setup...\n") (case %slide-latex-mode ((seminar) @@ -36,7 +57,12 @@ (else (skribe-error 'slide "Illegal latex mode" %slide-latex-mode)))) +(define string->integer string->number) +(define *slide-advi-scale* + (make-parameter 1.0)) + + ;*---------------------------------------------------------------------*/ ;* &slide-seminar-predocument ... */ ;*---------------------------------------------------------------------*/ @@ -92,7 +118,7 @@ :action (lambda (n e) (display "\n\\vspace{") (output (markup-body n) e) - (printf " ~a}\n\n" (markup-option n :unit)))) + (format #t " ~a}\n\n" (markup-option n :unit)))) ;; slide-slide (markup-writer 'slide le :options '(:title :number :transition :vfill :toc :vspace :image) @@ -136,14 +162,13 @@ ;*---------------------------------------------------------------------*/ (define (%slide-seminar-setup!) (skribe-message "Seminar slides setup...\n") - (let ((le (find-engine 'latex)) - (be (find-engine 'base))) + (let ((le (find-engine 'latex))) ;; latex configuration (define (seminar-slide n e) (let ((nb (markup-option n :number)) (t (markup-option n :title))) (display "\\begin{slide}\n") - (if nb (printf "~a/~a -- " nb (slide-number))) + (if nb (format #t "~a/~a -- " nb (slide-number))) (output t e) (display "\\hrule\n")) (output (markup-body n) e) @@ -168,36 +193,29 @@ ;*---------------------------------------------------------------------*/ (define (%slide-advi-setup!) (skribe-message "Generating `Advi Seminar' slides...\n") - (let ((le (find-engine 'latex)) - (be (find-engine 'base))) + (let ((le (find-engine 'latex))) (define (advi-geometry geo) - (let ((r (pregexp-match "([0-9]+)x([0-9]+)" geo))) + (let ((r (string-match "([0-9]+)x([0-9]+)" geo))) (if (pair? r) (let* ((w (cadr r)) - (w' (string->integer w)) - (w'' (number->string (/ w' *skribe-slide-advi-scale*))) - (h (caddr r)) - (h' (string->integer h)) - (h'' (number->string (/ h' *skribe-slide-advi-scale*)))) + (h (caddr r))) (values "" (string-append w "x" h "+!x+!y"))) - (let ((r (pregexp-match "([0-9]+)x([0-9]+)[+](-?[0-9]+)[+](-?[0-9]+)" geo))) + (let ((r (string-match "([0-9]+)x([0-9]+)[+](-?[0-9]+)[+](-?[0-9]+)" geo))) (if (pair? r) (let ((w (number->string (/ (string->integer (cadr r)) - *skribe-slide-advi-scale*))) + (*slide-advi-scale*)))) (h (number->string (/ (string->integer (caddr r)) - *skribe-slide-advi-scale*))) - (x (cadddr r)) - (y (car (cddddr r)))) + (*slide-advi-scale*))))) (values (string-append "width=" w "cm,height=" h "cm") "!g")) (values "" geo)))))) (define (advi-transition trans) (cond ((string? trans) - (printf "\\advitransition{~s}" trans)) + (format #t "\\advitransition{~s}" trans)) ((and (symbol? trans) (memq trans '(wipe block slide))) - (printf "\\advitransition{~s}" trans)) + (format #t "\\advitransition{~s}" trans)) (else #f))) ;; latex configuration @@ -208,7 +226,7 @@ (lt (markup-option n :transition)) (gt (engine-custom e 'transition))) (if (and i (engine-custom e 'advi)) - (printf "\\advibg[global]{image=~a}\n" + (format #t "\\advibg[global]{image=~a}\n" (if (and (pair? i) (null? (cdr i)) (string? (car i))) @@ -216,7 +234,7 @@ i))) (display "\\begin{slide}\n") (advi-transition (or lt gt)) - (if n (printf "~a/~a -- " n (slide-number))) + (if n (format #t "~a/~a -- " n (slide-number))) (output t e) (display "\\hrule\n")) (output (markup-body n) e) @@ -226,7 +244,7 @@ (define (advi-record n e) (display "\\advirecord") (when (markup-option n :play) (display "[play]")) - (printf "{~a}{" (markup-option n :tag)) + (format #t "{~a}{" (markup-option n :tag)) (output (markup-body n) e) (display "}")) ;; advi play @@ -237,7 +255,7 @@ (display "[") (display (skribe-get-latex-color c)) (display "]"))) - (printf "{~a}" (markup-option n :tag))) + (format #t "{~a}" (markup-option n :tag))) ;; advi play* (define (advi-play* n e) (let ((c (skribe-get-latex-color (markup-option n :color))) @@ -247,21 +265,21 @@ (when last (display "\\adviplay[") (display d) - (printf "]{~a}" last)) + (format #t "]{~a}" last)) (when (pair? lbls) (let ((lbl (car lbls))) - (match-case lbl - ((?id ?col) + (match lbl + ((id col) (display "\\adviplay[") (display (skribe-get-latex-color col)) - (printf "]{" ~a "}" id) - (skribe-eval (slide-pause) e) + (display (string-append "]{" id "}")) + (evaluate-document (slide-pause) e) (loop (cdr lbls) id)) (else (display "\\adviplay[") (display c) - (printf "]{~a}" lbl) - (skribe-eval (slide-pause) e) + (format #t "]{~a}" lbl) + (evaluate-document (slide-pause) e) (loop (cdr lbls) lbl)))))))) (engine-custom-set! le 'documentclass "\\documentclass{seminar}\n") @@ -295,8 +313,8 @@ geometry-opt " " geometry)) (rgeometry - (multiple-value-bind (aopt dopt) - (advi-geometry rgeometry) + (let-values (((aopt dopt) + (advi-geometry rgeometry))) (set! a (string-append a "," aopt)) (string-append cmd " " geometry-opt " " @@ -306,7 +324,7 @@ (c (if (and transient transient-opt) (string-append c " " transient-opt " !p") c))) - (printf "\\adviembed[~a]{~a}\n" a c))))) + (format #t "\\adviembed[~a]{~a}\n" a c))))) (set! &latex-record advi-record) (set! &latex-play advi-play) (set! &latex-play* advi-play*))) @@ -317,31 +335,29 @@ (define (%slide-prosper-setup!) (skribe-message "Generating `Prosper' slides...\n") (let ((le (find-engine 'latex)) - (be (find-engine 'base)) (overlay-count 0)) ;; transitions (define (prosper-transition trans) (cond ((string? trans) - (printf "[~s]" trans)) + (format #t "[~s]" trans)) ((eq? trans 'slide) - (printf "[Blinds]")) + (display "[Blinds]")) ((and (symbol? trans) (memq trans '(split blinds box wipe dissolve glitter))) - (printf "[~s]" + (format #t "[~s]" (string-upcase (symbol->string trans)))) (else #f))) ;; latex configuration (define (prosper-slide n e) - (let* ((i (markup-option n :image)) - (t (markup-option n :title)) + (let* ((t (markup-option n :title)) (lt (markup-option n :transition)) (gt (engine-custom e 'transition)) (pa (search-down (lambda (x) (is-markup? x 'slide-pause)) n)) (lpa (length pa))) (set! overlay-count 1) - (if (>= lpa 1) (printf "\\overlays{~a}{%\n" (+ 1 lpa))) + (if (>= lpa 1) (format #t "\\overlays{~a}{%\n" (+ 1 lpa))) (display "\\begin{slide}") (prosper-transition (or lt gt)) (display "{") @@ -368,7 +384,7 @@ (set! &latex-pause (lambda (n e) (set! overlay-count (+ 1 overlay-count)) - (printf "\\FromSlide{~s}%\n" overlay-count))))) + (format #t "\\FromSlide{~s}%\n" overlay-count))))) ;*---------------------------------------------------------------------*/ ;* Setup ... */ diff --git a/src/guile/skribilo/package/slide/lout.scm b/src/guile/skribilo/package/slide/lout.scm index f3c9a61..c6e7f07 100644 --- a/src/guile/skribilo/package/slide/lout.scm +++ b/src/guile/skribilo/package/slide/lout.scm @@ -26,6 +26,7 @@ :use-module (skribilo writer) :autoload (skribilo output) (output) :use-module (skribilo ast) + :autoload (skribilo lib) (skribe-error) :use-module (srfi srfi-13) ;; `string-join' @@ -110,17 +111,16 @@ (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))) + (geometry-opt (markup-option n :geometry-opt))) (format #t "~%\"~a\" @SkribiloEmbed { " (string-append command " " (if (and geometry-opt geometry) (string-append geometry-opt " " geometry " ") "") - (string-join args " "))) + (string-join args))) (output alt e) - (format #t " }\n")))) + (display " }\n")))) (markup-writer 'slide-pause le ;; FIXME: Use a `pdfmark' custom action and a PDF transition action. -- cgit v1.2.3