From 4b640e644739172f565b444d9d75967f9bf697f8 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Tue, 14 Feb 2006 13:53:32 +0000
Subject: More Skribe compatibility fixes (more exported bindings).
* src/guile/skribilo/color.scm: Use SRFI-60.
(skribe-color->rgb): Use `bitwise-and' and `arithmetic-shift'.
* src/guile/skribilo/engine/html.scm (html-markup-class): Made public.
* src/guile/skribilo/module.scm (%skribilo-user-autoloads): Added
`!lout', `!latex', `LaTeX', `TeX', `html-markup-class', `html-class',
`html-width' as autoload triggers.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-42
---
src/guile/skribilo/color.scm | 64 +++++++++++++++++++-------------------
src/guile/skribilo/engine/html.scm | 2 +-
src/guile/skribilo/module.scm | 6 +++-
3 files changed, 38 insertions(+), 34 deletions(-)
(limited to 'src')
diff --git a/src/guile/skribilo/color.scm b/src/guile/skribilo/color.scm
index 1e762e6..d2ba1d4 100644
--- a/src/guile/skribilo/color.scm
+++ b/src/guile/skribilo/color.scm
@@ -1,32 +1,33 @@
-;;;;
-;;;; color.scm -- Skribe Color Management
-;;;;
-;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-;;;; USA.
-;;;;
-;;;; Author: Erick Gallesio [eg@essi.fr]
-;;;; Creation date: 25-Oct-2003 00:10 (eg)
-;;;; Last file update: 12-Feb-2004 18:24 (eg)
-;;;;
+;;; color.scm -- Color management.
+;;;
+;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
(define-module (skribilo color)
- :export (skribe-color->rgb skribe-get-used-colors skribe-use-color!))
+ :autoload (srfi srfi-60) (bitwise-and arithmetic-shift)
+ :export (skribe-color->rgb skribe-get-used-colors skribe-use-color!))
+
+;; FIXME: This module should be generalized and the `skribe-' procedures
+;; moved to `compat.scm'.
+;; FIXME: Use a fluid? Or remove it?
(define *used-colors* '())
(define *skribe-rgb-alist* '(
@@ -571,7 +572,7 @@
("darkmagenta" . "139 0 139")
("darkred" . "139 0 0")
("lightgreen" . "144 238 144")))
-
+
(define (%convert-color str)
(let ((col (assoc str *skribe-rgb-alist*)))
@@ -590,7 +591,7 @@
(values (string->number (substring str 1 5) 16)
(string->number (substring str 5 9) 16)
(string->number (substring str 9 13) 16)))
- (else
+ (else
(values 0 0 0)))))
;;;
@@ -600,9 +601,9 @@
(cond
((string? spec) (%convert-color spec))
((integer? spec)
- (values (bit-and #xff (bit-shift spec -16))
- (bit-and #xff (bit-shift spec -8))
- (bit-and #xff spec)))
+ (values (bitwise-and #xff (arithmetic-shift spec -16))
+ (bitwise-and #xff (arithmetic-shift spec -8))
+ (bitwise-and #xff spec)))
(else
(values 0 0 0))))
@@ -618,4 +619,3 @@
(define (skribe-use-color! color)
(set! *used-colors* (cons color *used-colors*))
color)
-
diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
index 1ad86e9..4ba058a 100644
--- a/src/guile/skribilo/engine/html.scm
+++ b/src/guile/skribilo/engine/html.scm
@@ -554,7 +554,7 @@
;*---------------------------------------------------------------------*/
;* html-markup-class ... */
;*---------------------------------------------------------------------*/
-(define (html-markup-class m)
+(define-public (html-markup-class m)
(lambda (n e)
(printf "<~a" m)
(html-class n)
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index 3ec0e7f..84cd078 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -63,10 +63,14 @@
(define %skribilo-user-autoloads
;; List of auxiliary modules that may be lazily autoloaded.
- '(((skribilo engine lout) . (lout-illustration
+ '(((skribilo engine lout) . (!lout
+ lout-illustration
;; FIXME: The following should eventually be
;; removed from here.
lout-structure-number-string))
+ ((skribilo engine latex) . (!latex LaTeX TeX))
+ ((skribilo engine html) . (html-markup-class html-class
+ html-width))
((skribilo source) . (source-read-lines source-fontify
language? language-extractor
language-fontifier source-fontify))
--
cgit v1.2.3
From 8f5bd5e1126f1866921eb247ef55ed5b32c966f9 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Tue, 14 Feb 2006 14:26:42 +0000
Subject: Implemented `lout-illustration' for non-Lout engines.
* src/guile/skribilo/engine/lout.scm (lout-illustration): Implemented for
Guile and non-Lout engines.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-43
---
src/guile/skribilo/engine/lout.scm | 72 ++++++++++++++++++--------------------
1 file changed, 35 insertions(+), 37 deletions(-)
(limited to 'src')
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index c2339ca..de6fb3e 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -1,6 +1,6 @@
;;; lout.scm -- A Lout engine.
;;;
-;;; Copyright 2004, 2005 Ludovic Court�s <ludovic.courtes@laas.fr>
+;;; Copyright 2004, 2005, 2006 Ludovic Court�s <ludovic.courtes@laas.fr>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -24,6 +24,7 @@
(define-skribe-module (skribilo engine lout)
+ :autoload (ice-9 popen) (open-output-pipe)
:autoload (ice-9 rdelim) (read-line))
@@ -2780,6 +2781,8 @@
;* Illustrations */
;*---------------------------------------------------------------------*/
(define-public (lout-illustration . args)
+ ;; FIXME: This should be a markup.
+
;; Introduce a Lout illustration (such as a diagram) whose code is either
;; the body of `lout-illustration' or the contents of `file'. For engines
;; other than Lout, an EPS file is produced and then converted if needed.
@@ -2833,46 +2836,41 @@
(file-contents file))))
(if (engine-format? "lout")
(! contents) ;; simply inline the illustration
- (cond-expand
- (bigloo
- (let* ((lout (find-engine 'lout))
- (output (string-append (or ident
- (symbol->string
- (gensym 'lout-illustration)))
- ".eps"))
- (proc (run-process (or (engine-custom lout
- 'lout-program-name)
- "lout")
- "-o" output
- "-EPS"
- input: pipe:))
- (port (process-input-port proc)))
-
- ;; send the illustration to Lout's standard input
- (display (illustration-header) port)
- (display contents port)
- (display (illustration-ending) port)
- (close-output-port port)
-
- (process-wait proc)
- (if (not (= 0 (process-exit-status proc)))
+ (let* ((lout (find-engine 'lout))
+ (output (string-append (or ident
+ (symbol->string
+ (gensym 'lout-illustration)))
+ ".eps"))
+ (port (open-output-pipe
+ (string-append (or (engine-custom lout
+ 'lout-program-name)
+ "lout")
+ " -o " output
+ " -EPS"))))
+
+ ;; send the illustration to Lout's standard input
+ (display (illustration-header) port)
+ (display contents port)
+ (display (illustration-ending) port)
+
+ (let ((exit-val (status:exit-val (close-pipe port))))
+ (if (not (eqv? 0 exit-val))
(skribe-error 'lout-illustration
- "lout exited with error code"
- (process-exit-status proc)))
- (if (not (file-exists? output))
- (skribe-error 'lout-illustration "file not created"
- output))
- (if (= 0 (file-size output))
+ "lout exited with error code" exit-val)))
+
+ (if (not (file-exists? output))
+ (skribe-error 'lout-illustration "file not created"
+ output))
+
+ (let ((file-info (false-if-exception (stat output))))
+ (if (or (not file-info)
+ (= 0 (stat:size file-info)))
(skribe-error 'lout-illustration
- "empty output file" output))
+ "empty output file" output)))
- ;; the image
- (image :file output alt)))
+ ;; the image (FIXME: Should set its location)
+ (image :file output alt))))))
- (else ;; Unfortunately, chances are low that STklos has the same
- ;; process API as the one Bigloo has.
- (skribe-error 'lout
- "lout-illustration: Not implemented" file)))))))
;*---------------------------------------------------------------------*/
--
cgit v1.2.3
From c7f820101026526e4d0d72ba4999a1b0fa9ebbb8 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Tue, 14 Feb 2006 14:34:50 +0000
Subject: Created the `(skribilo utils files)' module.
* src/guile/skribilo/package/slide.scm: Fixed calls to `format'.
* src/guile/skribilo/runtime.scm: Use `(skribilo utils files)'. Use
`file-suffix' and `file-prefix' instead of `suffix' and `prefix'.
Removed local definition of `suffix'.
* src/guile/skribilo/utils/compat.scm: Use `(skribilo utils files)'.
Moved `file-suffix' and `file-prefix' there.
* src/guile/skribilo/utils/files.scm: New.
* src/guile/skribilo/utils/Makefile.am (dist_guilemodule_DATA): Added
`files.scm'.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-44
---
src/guile/skribilo/package/slide.scm | 4 +--
src/guile/skribilo/runtime.scm | 17 ++++-------
src/guile/skribilo/utils/Makefile.am | 2 +-
src/guile/skribilo/utils/compat.scm | 15 ++--------
src/guile/skribilo/utils/files.scm | 55 ++++++++++++++++++++++++++++++++++++
5 files changed, 66 insertions(+), 27 deletions(-)
create mode 100644 src/guile/skribilo/utils/files.scm
(limited to 'src')
diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm
index ddbbd1d..5b39239 100644
--- a/src/guile/skribilo/package/slide.scm
+++ b/src/guile/skribilo/package/slide.scm
@@ -366,7 +366,7 @@
(tr (th :align 'left
(list
(if nb
- (format "~a / ~a -- " nb
+ (format #f "~a / ~a -- " nb
(slide-number)))
t)))
(tr (td (hrule)))
@@ -662,7 +662,7 @@
(let* ((cap (engine-custom le 'slide-caption))
(o (engine-custom le 'predocument))
(n (if (string? cap)
- (format "~a\\slideCaption{~a}\n"
+ (format #f "~a\\slideCaption{~a}\n"
&slide-prosper-predocument
cap)
&slide-prosper-predocument)))
diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm
index e302ee9..bd8497f 100644
--- a/src/guile/skribilo/runtime.scm
+++ b/src/guile/skribilo/runtime.scm
@@ -1,8 +1,7 @@
-;;;
;;; runtime.scm -- Skribilo runtime system
;;;
-;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;; Copyright � 2005 Ludovic Court�s <ludovic.courtes@laas.fr>
+;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; Copyright 2005, 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
@@ -35,15 +34,11 @@
:use-module (skribilo lib)
:use-module (srfi srfi-13)
:use-module (srfi srfi-35)
+ :autoload (skribilo utils files) (file-prefix file-suffix)
:autoload (skribilo condition) (&file-search-error)
:autoload (srfi srfi-34) (raise))
-(define (suffix path)
- (let ((dot (string-rindex path #\.)))
- (if (not dot)
- path
- (substring path (+ dot 1) (string-length path)))))
;;; ======================================================================
;;;
@@ -108,8 +103,8 @@
;;;
;;; ======================================================================
(define (builtin-convert-image from fmt dir)
- (let* ((s (suffix from))
- (f (string-append (prefix (basename from)) "." fmt))
+ (let* ((s (file-suffix from))
+ (f (string-append (file-prefix (basename from)) "." fmt))
(to (string-append dir "/" f))) ;; FIXME:
(cond
((string=? s fmt)
@@ -133,7 +128,7 @@
(if (not path)
(raise (condition (&file-search-error (file-name file)
(path (*image-path*)))))
- (let ((suf (suffix file)))
+ (let ((suf (file-suffix file)))
(if (member suf formats)
(let* ((dir (if (string? (*destination-file*))
(dirname (*destination-file*))
diff --git a/src/guile/skribilo/utils/Makefile.am b/src/guile/skribilo/utils/Makefile.am
index 6a82ac7..5044c1b 100644
--- a/src/guile/skribilo/utils/Makefile.am
+++ b/src/guile/skribilo/utils/Makefile.am
@@ -1,4 +1,4 @@
guilemoduledir = $(GUILE_SITE)/skribilo/utils
-dist_guilemodule_DATA = syntax.scm compat.scm
+dist_guilemodule_DATA = syntax.scm compat.scm files.scm
## arch-tag: 3a18b64b-1da2-417b-8338-2c534bca277f
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index a7ce781..3fce068 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -21,6 +21,7 @@
(define-module (skribilo utils compat)
:use-module (skribilo utils syntax)
+ :use-module (skribilo utils files)
:use-module (skribilo parameters)
:use-module (skribilo evaluator)
:use-module (srfi srfi-1)
@@ -30,6 +31,7 @@
:use-module (ice-9 optargs)
:autoload (skribilo ast) (ast?)
:autoload (skribilo condition) (file-search-error? &file-search-error)
+ :re-export (file-size)
:replace (gensym))
;;; Author: Ludovic Court�s
@@ -197,19 +199,6 @@
(for-each display args)
(display "\n")))))
-(define-public (file-prefix fn)
- (if fn
- (let ((dot (string-rindex fn #\.)))
- (if dot (substring fn 0 dot) fn))
- "./SKRIBILO-OUTPUT"))
-
-(define-public (file-suffix fn)
- (if fn
- (let ((dot (string-rindex fn #\.)))
- (if dot
- (substring fn (+ dot 1) (string-length fn))
- ""))
- #f))
(define-public prefix file-prefix)
diff --git a/src/guile/skribilo/utils/files.scm b/src/guile/skribilo/utils/files.scm
new file mode 100644
index 0000000..7eb1cf2
--- /dev/null
+++ b/src/guile/skribilo/utils/files.scm
@@ -0,0 +1,55 @@
+;;; files.scm -- File-related utilities.
+;;;
+;;; 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-module (skribilo utils files)
+ :export (file-prefix file-suffix file-size))
+
+;;; Author: Ludovic Court�s
+;;;
+;;; Commentary:
+;;;
+;;; This module defines filesystem-related utility functions.
+;;;
+;;; Code:
+
+(define (file-size file)
+ (let ((file-info (false-if-exception (stat file))))
+ (if file-info
+ (stat:size file-info)
+ #f)))
+
+(define (file-prefix fn)
+ (if fn
+ (let ((dot (string-rindex fn #\.)))
+ (if dot (substring fn 0 dot) fn))
+ "./SKRIBILO-OUTPUT"))
+
+(define (file-suffix fn)
+ (if fn
+ (let ((dot (string-rindex fn #\.)))
+ (if dot
+ (substring fn (+ dot 1) (string-length fn))
+ ""))
+ #f))
+
+
+;;; arch-tag: b63d2a9f-a254-4e2d-8d85-df773bbc4a9b
+
+;;; files.scm ends here
--
cgit v1.2.3
From bb63cc24d8ea38bc645c38cb7c44edf33b220bee Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 15 Feb 2006 08:46:55 +0000
Subject: Skribe reader: consider square brackets as delimiters.
* src/guile/skribilo/reader/skribe.scm (%make-skribe-reader): Use the
`r6rs-keyword-*' and `r6rs-number' token readers so that square
brackets are rightfully considered as delimiters.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-45
---
src/guile/skribilo/reader/skribe.scm | 21 +++++++--------------
1 file changed, 7 insertions(+), 14 deletions(-)
(limited to 'src')
diff --git a/src/guile/skribilo/reader/skribe.scm b/src/guile/skribilo/reader/skribe.scm
index f24c2f7..f92f13b 100644
--- a/src/guile/skribilo/reader/skribe.scm
+++ b/src/guile/skribilo/reader/skribe.scm
@@ -65,25 +65,18 @@ the Skribe syntax."
(let ((colon-keywords ;; keywords � la `:key' fashion
(r:make-token-reader #\:
(r:token-reader-procedure
- (r:standard-token-reader 'keyword))))
- (square-bracket-free-symbol-misc-chars
- (let* ((tr (r:standard-token-reader 'guile-symbol-misc-chars))
- (tr-spec (r:token-reader-specification tr))
- (tr-proc (r:token-reader-procedure tr)))
- (r:make-token-reader (filter (lambda (chr)
- (not (or (eq? chr #\[)
- (eq? chr #\]))))
- tr-spec)
- tr-proc))))
+ (r:standard-token-reader 'keyword)))))
+ ;; Note: we use the `r6rs-symbol-*' and `r6rs-number' token readers since
+ ;; they consider square brackets as delimiters.
(r:make-reader (cons* (r:make-token-reader #\# &sharp-reader)
colon-keywords
- square-bracket-free-symbol-misc-chars
(map r:standard-token-reader
`(whitespace
- sexp string guile-number
- guile-symbol-lower-case
- guile-symbol-upper-case
+ sexp string r6rs-number
+ r6rs-symbol-lower-case
+ r6rs-symbol-upper-case
+ r6rs-symbol-misc-chars
quote-quasiquote-unquote
semicolon-comment
skribe-exp)))
--
cgit v1.2.3
From 01b7cf6d02d0bf7243012193c63e64407117bbfa Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Thu, 16 Feb 2006 17:26:32 +0000
Subject: `skribilo': do not catch all exceptions, let a stack trace be output
intead.
* src/skribilo.in: Do not try to catch any exception. Thanks to Neil's
`catch' patch, a backtrace now gets nicely printed.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-46
---
src/skribilo.in | 19 +++++++++++--------
1 file changed, 11 insertions(+), 8 deletions(-)
(limited to 'src')
diff --git a/src/skribilo.in b/src/skribilo.in
index 952784a..7d3a78d 100755
--- a/src/skribilo.in
+++ b/src/skribilo.in
@@ -1,6 +1,6 @@
#!/bin/sh
-# Copyright 2005,2006 Ludovic Court�s <ludovic.courtes@laas.fr>
+# Copyright 2005, 2006 Ludovic Court�s <ludovic.courtes@laas.fr>
#
#
# This program is free software; you can redistribute it and/or modify
@@ -20,15 +20,18 @@
# The `skribilo' executable.
+# Note: In Guile 1.8+ (or 1.9), when Guile is run in batch mode with
+# `--debug', it produces a clean stack trace when an exception is
+# raised and uncaught. On earlier versions, it behaves as if
+# `--debug' had not been passed, not displaying a stack trace. See
+# http://lists.gnu.org/archive/html/guile-devel/2006-01/msg00022.html
+# for details.
+
main='(module-ref (resolve-module '\''(skribilo)) '\'main')'
exec ${GUILE-@GUILE@} --debug \
-c "
(use-modules (skribilo condition))
-(catch #t (lambda ()
- (call-with-skribilo-error-catch
- (lambda ()
- (apply $main (cdr (command-line))))))
- (lambda (key . args)
- (format (current-error-port) \"exception \`~a' raised~%\" key)
- (exit 1)))" "$@"
+(call-with-skribilo-error-catch
+ (lambda ()
+ (apply $main (cdr (command-line)))))" "$@"
--
cgit v1.2.3
From 11105691c17ed25fa743680cdbae1c9ff3b8cd78 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Thu, 16 Feb 2006 17:30:33 +0000
Subject: Added the equation formatting package (unfinished, undocumented).
* src/guile/skribilo/package/eq.scm: New. Taken from
`lcourtes@laas.fr--2004-libre/skribe-eq--main--0.1--patch-2' and
significantly improved.
* src/guile/skribilo/package/Makefile.am (dist_guilemodule_DATA): Added
`eq.scm'.
* NEWS: Mention this new package.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-47
---
NEWS | 2 +
src/guile/skribilo/package/Makefile.am | 4 +-
src/guile/skribilo/package/eq.scm | 276 +++++++++++++++++++++++++++++++++
3 files changed, 281 insertions(+), 1 deletion(-)
create mode 100644 src/guile/skribilo/package/eq.scm
(limited to 'src')
diff --git a/NEWS b/NEWS
index 7257a87..e9b5c33 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,8 @@ New in Skribilo 1.2 (compared to Skribe 1.2d)
* New engine: Lout (see http://lout.sf.net/).
+ * New package `eq' for equation formatting.
+
* New markups: `~', `numref', `!lout', `lout-illustration'.
* Extended markups: `footnote' now takes a `:label' option.
diff --git a/src/guile/skribilo/package/Makefile.am b/src/guile/skribilo/package/Makefile.am
index 6e047d3..781b1aa 100644
--- a/src/guile/skribilo/package/Makefile.am
+++ b/src/guile/skribilo/package/Makefile.am
@@ -1,4 +1,6 @@
guilemoduledir = $(GUILE_SITE)/skribilo/package
dist_guilemodule_DATA = acmproc.scm french.scm jfp.scm letter.scm \
lncs.scm scribe.scm sigplan.scm skribe.scm \
- slide.scm web-article.scm web-book.scm
+ slide.scm web-article.scm web-book.scm \
+ eq.scm
+
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
new file mode 100644
index 0000000..1ac8d35
--- /dev/null
+++ b/src/guile/skribilo/package/eq.scm
@@ -0,0 +1,276 @@
+;;; eq.scm -- An equation formatting package.
+;;;
+;;; Copyright 2005, 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-module (skribilo package eq)
+ :autoload (skribilo ast) (markup?)
+ :autoload (skribilo output) (output)
+ :use-module (skribilo writer)
+ :use-module (skribilo engine)
+ :use-module (skribilo lib)
+ :use-module (skribilo utils syntax)
+ :use-module (skribilo module)
+ :use-module (skribilo skribe utils) ;; `the-options', etc.
+ :use-module (ice-9 optargs))
+
+;;; Author: Ludovic Court�s
+;;;
+;;; Commentary:
+;;;
+;;; This package defines a set of markups for formatting equations. The user
+;;; may either use the standard Scheme prefix notation to represent
+;;; equations, or directly use the specific markups (which looks more
+;;; verbose).
+;;;
+;;; FIXME: This is incomplete.
+;;;
+;;; Code:
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+;;;
+;;; Utilities.
+;;;
+
+(define %operators
+ '(/ * + - = != ~= < > <= >= sqrt expt sum product))
+
+(define %rebindings
+ (map (lambda (sym)
+ (list sym (symbol-append 'eq: sym)))
+ %operators))
+
+
+(define (eq:symbols->strings equation)
+ "Turn symbols located in non-@code{car} positions into strings."
+ (cond ((list? equation)
+ (if (or (null? equation) (null? (cdr equation)))
+ equation
+ (cons (car equation) ;; XXX: not tail-recursive
+ (map eq:symbols->strings (cdr equation)))))
+ ((symbol? equation)
+ (symbol->string equation))
+ (else equation)))
+
+(define-public (eq-evaluate equation)
+ "Evaluate @var{equation}, an sexp (list) representing an equation, e.g.
+@code{'(+ a (/ b 3))}."
+ (eval `(let ,%rebindings ,(eq:symbols->strings equation))
+ (current-module)))
+
+
+;;;
+;;; Markup.
+;;;
+
+(define-markup (eq :rest opts :key (ident #f) (class "eq"))
+ (new markup
+ (markup 'eq)
+ (ident (or ident (symbol->string (gensym "eq"))))
+ (options (the-options opts))
+ (body (let loop ((body (the-body opts))
+ (result '()))
+ (if (null? body)
+ result
+ (loop (cdr body)
+ (if (markup? (car body))
+ (car body) ;; the `eq:*' markups were used
+ ;; directly
+ (eq-evaluate (car body))) ;; a quoted list was
+ ;; passed
+ ))))))
+
+(define-simple-markup eq:/)
+(define-simple-markup eq:*)
+(define-simple-markup eq:+)
+(define-simple-markup eq:-)
+
+(define-simple-markup eq:=)
+(define-simple-markup eq:!=)
+(define-simple-markup eq:~=)
+(define-simple-markup eq:<)
+(define-simple-markup eq:>)
+(define-simple-markup eq:>=)
+(define-simple-markup eq:<=)
+
+(define-simple-markup eq:sqrt)
+(define-simple-markup eq:expt)
+
+(define-markup (eq:sum :rest opts :key (ident #f) (class "eq:sum")
+ (from #f) (to #f))
+ (new markup
+ (markup 'eq:sum)
+ (ident (or ident (symbol->string (gensym "eq:sum"))))
+ (options (the-options opts))
+ (body (the-body opts))))
+
+(define-markup (eq:product :rest opts :key (ident #f) (class "eq:product")
+ (from #f) (to #f))
+ (new markup
+ (markup 'eq:product)
+ (ident (or ident (symbol->string (gensym "eq:product"))))
+ (options (the-options opts))
+ (body (the-body opts))))
+
+
+
+;;;
+;;; Lout implementation
+;;;
+
+(let ((lout (find-engine 'lout)))
+ (if (not lout)
+ (skribe-error 'eq "Lout engine not found" lout)
+ (let ((includes (engine-custom lout 'includes)))
+ ;; Append the `eq' include file
+ (engine-custom-set! lout 'includes
+ (string-append includes "\n"
+ "@SysInclude { eq }\n")))))
+
+;; FIXME: Reimplement the `symbol' writer so that `@Sym' is not used within
+;; equations (e.g. output `alpha' instead of `{ @Sym alpha }').
+
+(markup-writer 'eq (find-engine 'lout)
+ :before "\n@Eq { "
+ :action (lambda (node engine)
+ (let ((eq (markup-body node)))
+ ;(fprint (current-error-port) "eq=" eq)
+ (output eq engine)))
+ :after " }\n")
+
+
+;;
+;; `+' and `-' have lower precedence than `*', `/', `=', etc., so their
+;; operands do not need to be enclosed in braces.
+;;
+
+(markup-writer 'eq:+ (find-engine 'lout)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (begin
+ ;; no braces
+ (output (car operands) engine)
+ (if (pair? (cdr operands))
+ (display " + "))
+ (loop (cdr operands)))))))
+
+(markup-writer 'eq:- (find-engine 'lout)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (begin
+ ;; no braces
+ (output (car operands) engine)
+ (if (pair? (cdr operands))
+ (display " - "))
+ (loop (cdr operands)))))))
+
+(define-macro (simple-lout-markup-writer sym . lout-name)
+ `(markup-writer ',(symbol-append 'eq: sym)
+ (find-engine 'lout)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (begin
+ (display " { ")
+ (output (car operands) engine)
+ (display " }")
+ (if (pair? (cdr operands))
+ (display ,(string-append " "
+ (if (null? lout-name)
+ (symbol->string sym)
+ (car lout-name))
+ " ")))
+ (loop (cdr operands))))))))
+
+(simple-lout-markup-writer * "times")
+(simple-lout-markup-writer / "over")
+(simple-lout-markup-writer =)
+(simple-lout-markup-writer <)
+(simple-lout-markup-writer >)
+(simple-lout-markup-writer <=)
+(simple-lout-markup-writer >=)
+
+(markup-writer 'eq:expt (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((body (markup-body node)))
+ (if (= (length body) 2)
+ (begin
+ (display " { { ")
+ (output (car body) engine)
+ (display " } sup { ")
+ (output (cadr body) engine)
+ (display " } } "))
+ (skribe-error 'eq:expt "wrong number of arguments"
+ body)))))
+
+
+;;;
+;;; Sums, products, integrals, etc.
+;;;
+
+(define-macro (range-lout-markup-writer sym lout-name)
+ `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((from (markup-option node :from))
+ (to (markup-option node :to))
+ (body (markup-body node)))
+ (display ,(string-append " { big " lout-name
+ " from { "))
+ (output from engine)
+ (display " } to { ")
+ (output to engine)
+ (display " } { ")
+ (output body engine)
+ (display " } ")))))
+
+(range-lout-markup-writer sum "sum")
+(range-lout-markup-writer product "prod")
+
+
+
+;;;
+;;; Text-only implementation.
+;;;
+
+(markup-writer 'eq (find-engine 'base)
+ :action (lambda (node engine)
+ (output (apply it (markup-body node)) engine)))
+
+(markup-writer 'eq:/ (find-engine 'base)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (begin
+ (display " ")
+ (output (car operands) engine)
+ (display " ")
+ (if (pair? (cdr operands))
+ (display " / "))
+ (loop (cdr operands)))))))
+
+;;; arch-tag: 58764650-2684-47a6-8cc7-6288f2b474da
+
+;;; eq.scm ends here
--
cgit v1.2.3
From 60531ac43e86c0cfdc6163eed3aeb656aaa56720 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Fri, 17 Feb 2006 13:21:55 +0000
Subject: `eq' package: added the `script' markup.
* src/guile/skribilo/package/eq.scm (%operators): Added `script'.
(eq:script): New.
(eq:expt): Fixed wrong braces.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-48
---
src/guile/skribilo/package/eq.scm | 40 ++++++++++++++++++++++++++++++++++-----
1 file changed, 35 insertions(+), 5 deletions(-)
(limited to 'src')
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 1ac8d35..9be8f61 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -50,7 +50,7 @@
;;;
(define %operators
- '(/ * + - = != ~= < > <= >= sqrt expt sum product))
+ '(/ * + - = != ~= < > <= >= sqrt expt sum product script))
(define %rebindings
(map (lambda (sym)
@@ -129,6 +129,14 @@
(options (the-options opts))
(body (the-body opts))))
+(define-markup (eq:script :rest opts :key (ident #f) (class "eq:script")
+ (sub #f) (sup #f))
+ (new markup
+ (markup 'eq:script)
+ (ident (or ident (symbol->string (gensym "eq:script"))))
+ (options (the-options opts))
+ (body (the-body opts))))
+
;;;
@@ -216,11 +224,14 @@
:action (lambda (node engine)
(let ((body (markup-body node)))
(if (= (length body) 2)
- (begin
+ (let ((base (car body))
+ (expt (cadr body)))
(display " { { ")
- (output (car body) engine)
+ (if (markup? base) (display "("))
+ (output base engine)
+ (if (markup? base) (display ")"))
(display " } sup { ")
- (output (cadr body) engine)
+ (output expt engine)
(display " } } "))
(skribe-error 'eq:expt "wrong number of arguments"
body)))))
@@ -243,11 +254,30 @@
(output to engine)
(display " } { ")
(output body engine)
- (display " } ")))))
+ (display " } } ")))))
(range-lout-markup-writer sum "sum")
(range-lout-markup-writer product "prod")
+(markup-writer 'eq:script (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((body (markup-body node))
+ (sup (markup-option node :sup))
+ (sub (markup-option node :sub)))
+ (display " { { ")
+ (output body engine)
+ (display " } ")
+ (if sup
+ (begin
+ (display (if sub " supp { " " sup { "))
+ (output sup engine)
+ (display " } ")))
+ (if sub
+ (begin
+ (display " on { ")
+ (output sub engine)
+ (display " } ")))
+ (display " } "))))
;;;
--
cgit v1.2.3
From 36155810dc2785ad00490e41521d289ff3ef4868 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Fri, 17 Feb 2006 13:51:35 +0000
Subject: Implemented `when-engine-is-loaded'.
* src/guile/skribilo/engine.scm (engine-id->module-name): New.
(engine-loaded?): New.
(%engine-load-hook): New.
(when-engine-is-loaded): New.
(lookup-engine): Run the engine-load hook when available and consume
it.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-49
---
src/guile/skribilo/engine.scm | 44 +++++++++++++++++++++++++++++++++++++++----
1 file changed, 40 insertions(+), 4 deletions(-)
(limited to 'src')
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
index d747ea0..83528a9 100644
--- a/src/guile/skribilo/engine.scm
+++ b/src/guile/skribilo/engine.scm
@@ -41,7 +41,9 @@
engine-custom engine-custom-set!
engine-format? engine-add-writer!
processor-get-engine
- push-default-engine pop-default-engine))
+ push-default-engine pop-default-engine
+
+ engine-loaded? when-engine-is-loaded))
(fluid-set! current-reader %skribilo-module-reader)
@@ -180,10 +182,35 @@
new))
+
;;;
-;;; FIND-ENGINE
+;;; Engine loading.
;;;
+;; Each engine is to be stored in its own module with the `(skribilo engine)'
+;; hierarchy. The `engine-id->module-name' procedure returns this module
+;; name based on the engine name.
+
+(define (engine-id->module-name id)
+ `(skribilo engine ,id))
+
+(define (engine-loaded? id)
+ (nested-ref the-root-module (engine-id->module-name id)))
+
+;; A mapping of engine names to hooks.
+(define %engine-load-hook (make-hash-table))
+
+(define (when-engine-is-loaded id thunk)
+ "Run @var{thunk} only when engine with identifier @var{id} is loaded."
+ (if (engine-loaded? id)
+ (thunk)
+ (let ((hook (or (hashq-ref %engine-load-hook id)
+ (let ((hook (make-hook)))
+ (hashq-set! %engine-load-hook id hook)
+ hook))))
+ (add-hook! hook thunk))))
+
+
(define* (lookup-engine id :key (version 'unspecified))
"Look for an engine named @var{name} (a symbol) in the @code{(skribilo
engine)} module hierarchy. If no such engine was found, an error is raised,
@@ -192,15 +219,24 @@ otherwise the requested engine is returned."
(debug-item "id=" id " version=" version)
(let* ((engine (symbol-append id '-engine))
- (m (resolve-module `(skribilo engine ,id))))
+ (m (resolve-module (engine-id->module-name id)))
+ (hook (hashq-ref %engine-load-hook id)))
(if (module-bound? m engine)
- (module-ref m engine)
+ (let ((e (module-ref m engine)))
+ (if (and e hook)
+ (begin
+ ;; consume the hook
+ (run-hook hook)
+ (hashq-remove! %engine-load-hook id)))
+ e)
(error "no such engine" id)))))
(define* (find-engine id :key (version 'unspecified))
(false-if-exception (apply lookup-engine (list id version))))
+
+
;;;
;;; Engine methods.
--
cgit v1.2.3
From b5e6483d3823d197e5c20d574487db5e916a8555 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Fri, 17 Feb 2006 17:14:05 +0000
Subject: Fixes for `when-engine-is-loaded'.
* src/guile/skribilo/engine.scm (consume-load-hook!): New.
(when-engine-is-loaded): Call `consume-load-hook!' when
`engine-loaded?' returns true.
(lookup-engine): Use `consume-load-hook!'.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-50
---
src/guile/skribilo/engine.scm | 28 +++++++++++++++++++---------
1 file changed, 19 insertions(+), 9 deletions(-)
(limited to 'src')
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
index 83528a9..5800486 100644
--- a/src/guile/skribilo/engine.scm
+++ b/src/guile/skribilo/engine.scm
@@ -195,15 +195,30 @@
`(skribilo engine ,id))
(define (engine-loaded? id)
- (nested-ref the-root-module (engine-id->module-name id)))
+ "Check whether engine @var{id} is already loaded."
+ ;; Trick taken from `resolve-module' in `boot-9.scm'.
+ (nested-ref the-root-module
+ `(%app modules ,@(engine-id->module-name id))))
;; A mapping of engine names to hooks.
(define %engine-load-hook (make-hash-table))
+(define (consume-load-hook! id)
+ (with-debug 5 'consume-load-hook!
+ (let ((hook (hashq-ref %engine-load-hook id)))
+ (if hook
+ (begin
+ (debug-item "running hook " hook " for engine " id)
+ (hashq-remove! %engine-load-hook id)
+ (run-hook hook))))))
+
(define (when-engine-is-loaded id thunk)
"Run @var{thunk} only when engine with identifier @var{id} is loaded."
(if (engine-loaded? id)
- (thunk)
+ (begin
+ ;; Maybe the engine had already been loaded via `use-modules'.
+ (consume-load-hook! id)
+ (thunk))
(let ((hook (or (hashq-ref %engine-load-hook id)
(let ((hook (make-hook)))
(hashq-set! %engine-load-hook id hook)
@@ -219,15 +234,10 @@ otherwise the requested engine is returned."
(debug-item "id=" id " version=" version)
(let* ((engine (symbol-append id '-engine))
- (m (resolve-module (engine-id->module-name id)))
- (hook (hashq-ref %engine-load-hook id)))
+ (m (resolve-module (engine-id->module-name id))))
(if (module-bound? m engine)
(let ((e (module-ref m engine)))
- (if (and e hook)
- (begin
- ;; consume the hook
- (run-hook hook)
- (hashq-remove! %engine-load-hook id)))
+ (if e (consume-load-hook! id))
e)
(error "no such engine" id)))))
--
cgit v1.2.3
From 02d1bf3d462a8356ec62a1c3aa07cb72cd58ea2b Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Fri, 17 Feb 2006 17:24:51 +0000
Subject: `slide' and `eq': moved engine-specific code in separate modules.
* src/guile/skribilo/package/slide.scm: Moved engine-specific code to
`slide/ENGINE.scm'.
* src/guile/skribilo/package/eq.scm: Likewise.
* configure.ac: Produce the new Makefiles.
* src/guile/skribilo/engine/lout.scm: Export more stuff.
Moved the slide-related things out of here.
* src/guile/skribilo/utils/compat.scm (skribe-load): Removed `call/cc'
(not needed).
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-51
---
configure.ac | 2 +
src/guile/skribilo/engine/lout.scm | 105 +-----
src/guile/skribilo/package/Makefile.am | 1 +
src/guile/skribilo/package/eq.scm | 152 +--------
src/guile/skribilo/package/eq/Makefile.am | 4 +
src/guile/skribilo/package/eq/lout.scm | 184 ++++++++++
src/guile/skribilo/package/slide.scm | 494 +++------------------------
src/guile/skribilo/package/slide/Makefile.am | 4 +
src/guile/skribilo/package/slide/html.scm | 106 ++++++
src/guile/skribilo/package/slide/latex.scm | 385 +++++++++++++++++++++
src/guile/skribilo/package/slide/lout.scm | 131 +++++++
src/guile/skribilo/utils/compat.scm | 46 ++-
12 files changed, 897 insertions(+), 717 deletions(-)
create mode 100644 src/guile/skribilo/package/eq/Makefile.am
create mode 100644 src/guile/skribilo/package/eq/lout.scm
create mode 100644 src/guile/skribilo/package/slide/Makefile.am
create mode 100644 src/guile/skribilo/package/slide/html.scm
create mode 100644 src/guile/skribilo/package/slide/latex.scm
create mode 100644 src/guile/skribilo/package/slide/lout.scm
(limited to 'src')
diff --git a/configure.ac b/configure.ac
index 17f914d..90ae155 100644
--- a/configure.ac
+++ b/configure.ac
@@ -35,6 +35,8 @@ AC_OUTPUT([Makefile
src/guile/skribilo/engine/Makefile
src/guile/skribilo/reader/Makefile
src/guile/skribilo/package/Makefile
+ src/guile/skribilo/package/slide/Makefile
+ src/guile/skribilo/package/eq/Makefile
src/guile/skribilo/skribe/Makefile
src/guile/skribilo/coloring/Makefile
doc/Makefile
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index de6fb3e..17eb237 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -28,10 +28,11 @@
:autoload (ice-9 rdelim) (read-line))
+
;*---------------------------------------------------------------------*/
;* lout-verbatim-encoding ... */
;*---------------------------------------------------------------------*/
-(define lout-verbatim-encoding
+(define-public lout-verbatim-encoding
'((#\/ "\"/\"")
(#\\ "\"\\\\\"")
(#\| "\"|\"")
@@ -48,7 +49,7 @@
;*---------------------------------------------------------------------*/
;* lout-encoding ... */
;*---------------------------------------------------------------------*/
-(define lout-encoding
+(define-public lout-encoding
`(,@lout-verbatim-encoding
(#\� "{ @Char ccedilla }")
(#\� "{ @Char Ccdeilla }")
@@ -349,7 +350,7 @@
(current-error-port))))
#t))
-(define (lout-tagify ident)
+(define-public (lout-tagify ident)
;; Return an "clean" identifier (a string) based on `ident' (a string),
;; suitable for Lout as an `@Tag' value.
(let ((tag-encoding '((#\, "-")
@@ -776,7 +777,7 @@
`(,node ,engine ,@children)))))
nodes))))
-(define (lout-embedded-postscript-code postscript)
+(define-public (lout-embedded-postscript-code postscript)
;; Return a string embedding PostScript code `postscript' into Lout code.
(string-append "\n"
"{ @BackEnd @Case {\n"
@@ -785,7 +786,7 @@
" }\n"
"} } @Graphic { }\n"))
-(define (lout-pdf-docinfo doc engine)
+(define-public (lout-pdf-docinfo doc engine)
;; Produce PostScript code that will produce PDF document information once
;; converted to PDF.
(let* ((filter-string (make-string-replace `(,@lout-verbatim-encoding
@@ -845,7 +846,7 @@
extra-fields)))
"\"/\"DOCINFO pdfmark\n")))
-(define (lout-output-pdf-meta-info doc engine)
+(define-public (lout-output-pdf-meta-info doc engine)
;; Produce PDF bookmarks (aka. "outline") for document `doc', as well as
;; document meta-information (or "docinfo"). This function makes sure that
;; both are only produced once, and only if the relevant customs ask for
@@ -2872,98 +2873,6 @@
(image :file output alt))))))
-
-;*---------------------------------------------------------------------*/
-;* Slides */
-;* */
-;* At some point, we might want to move this to `slide.scm'. */
-;*---------------------------------------------------------------------*/
-
-(use-modules (skribilo package slide))
-
-(markup-writer 'slide
- :options '(:title :number :toc :ident) ;; '(:bg :vspace :image)
-
- :validate (lambda (n e)
- (eq? (engine-custom e 'document-type) 'slides))
-
- :before (lambda (n e)
- (display "\n@Overhead\n")
- (display " @Title { ")
- (output (markup-option n :title) e)
- (display " }\n")
- (if (markup-ident n)
- (begin
- (display " @Tag { ")
- (display (lout-tagify (markup-ident n)))
- (display " }\n")))
- (if (markup-option n :number)
- (begin
- (display " @BypassNumber { ")
- (output (markup-option n :number) e)
- (display " }\n")))
- (display "@Begin\n")
-
- ;; `doc' documents produce their PDF outline right after
- ;; `@Text @Begin'; other types of documents must produce it
- ;; as part of their first chapter.
- (lout-output-pdf-meta-info (ast-document n) e))
-
- :after "@End @Overhead\n")
-
-(markup-writer 'slide-vspace
- :options '(:unit)
- :validate (lambda (n e)
- (and (pair? (markup-body n))
- (number? (car (markup-body n)))))
- :action (lambda (n e)
- (printf "\n//~a~a # slide-vspace\n"
- (car (markup-body n))
- (case (markup-option n :unit)
- ((cm) "c")
- ((point points pt) "p")
- ((inch inches) "i")
- (else
- (skribe-error 'lout
- "Unknown vspace unit"
- (markup-option n :unit)))))))
-
-(markup-writer 'slide-pause
- ;; FIXME: Use a `pdfmark' custom action and a PDF transition action.
- ;; << /Type /Action
- ;; << /S /Trans
- ;; entry in the trans dict
- ;; << /Type /Trans /S /Dissolve >>
- :action (lambda (n e)
- (let ((filter (make-string-replace lout-verbatim-encoding))
- (pdfmark "
-[ {ThisPage} << /Trans << /S /Wipe /Dm /V /D 3 /M /O >> >> /PUT pdfmark"))
- (display (lout-embedded-postscript-code
- (filter pdfmark))))))
-
-;; For movies, see
-;; http://www.tug.org/tex-archive/macros/latex/contrib/movie15/movie15.sty .
-(markup-writer 'slide-embed
- :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))))))))
-
;*---------------------------------------------------------------------*/
;* Restore the base engine */
;*---------------------------------------------------------------------*/
diff --git a/src/guile/skribilo/package/Makefile.am b/src/guile/skribilo/package/Makefile.am
index 781b1aa..6cb30b9 100644
--- a/src/guile/skribilo/package/Makefile.am
+++ b/src/guile/skribilo/package/Makefile.am
@@ -4,3 +4,4 @@ dist_guilemodule_DATA = acmproc.scm french.scm jfp.scm letter.scm \
slide.scm web-article.scm web-book.scm \
eq.scm
+SUBDIRS = slide eq
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 9be8f61..410f04f 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -44,6 +44,7 @@
(fluid-set! current-reader %skribilo-module-reader)
+
;;;
;;; Utilities.
@@ -138,147 +139,6 @@
(body (the-body opts))))
-
-;;;
-;;; Lout implementation
-;;;
-
-(let ((lout (find-engine 'lout)))
- (if (not lout)
- (skribe-error 'eq "Lout engine not found" lout)
- (let ((includes (engine-custom lout 'includes)))
- ;; Append the `eq' include file
- (engine-custom-set! lout 'includes
- (string-append includes "\n"
- "@SysInclude { eq }\n")))))
-
-;; FIXME: Reimplement the `symbol' writer so that `@Sym' is not used within
-;; equations (e.g. output `alpha' instead of `{ @Sym alpha }').
-
-(markup-writer 'eq (find-engine 'lout)
- :before "\n@Eq { "
- :action (lambda (node engine)
- (let ((eq (markup-body node)))
- ;(fprint (current-error-port) "eq=" eq)
- (output eq engine)))
- :after " }\n")
-
-
-;;
-;; `+' and `-' have lower precedence than `*', `/', `=', etc., so their
-;; operands do not need to be enclosed in braces.
-;;
-
-(markup-writer 'eq:+ (find-engine 'lout)
- :action (lambda (node engine)
- (let loop ((operands (markup-body node)))
- (if (null? operands)
- #t
- (begin
- ;; no braces
- (output (car operands) engine)
- (if (pair? (cdr operands))
- (display " + "))
- (loop (cdr operands)))))))
-
-(markup-writer 'eq:- (find-engine 'lout)
- :action (lambda (node engine)
- (let loop ((operands (markup-body node)))
- (if (null? operands)
- #t
- (begin
- ;; no braces
- (output (car operands) engine)
- (if (pair? (cdr operands))
- (display " - "))
- (loop (cdr operands)))))))
-
-(define-macro (simple-lout-markup-writer sym . lout-name)
- `(markup-writer ',(symbol-append 'eq: sym)
- (find-engine 'lout)
- :action (lambda (node engine)
- (let loop ((operands (markup-body node)))
- (if (null? operands)
- #t
- (begin
- (display " { ")
- (output (car operands) engine)
- (display " }")
- (if (pair? (cdr operands))
- (display ,(string-append " "
- (if (null? lout-name)
- (symbol->string sym)
- (car lout-name))
- " ")))
- (loop (cdr operands))))))))
-
-(simple-lout-markup-writer * "times")
-(simple-lout-markup-writer / "over")
-(simple-lout-markup-writer =)
-(simple-lout-markup-writer <)
-(simple-lout-markup-writer >)
-(simple-lout-markup-writer <=)
-(simple-lout-markup-writer >=)
-
-(markup-writer 'eq:expt (find-engine 'lout)
- :action (lambda (node engine)
- (let ((body (markup-body node)))
- (if (= (length body) 2)
- (let ((base (car body))
- (expt (cadr body)))
- (display " { { ")
- (if (markup? base) (display "("))
- (output base engine)
- (if (markup? base) (display ")"))
- (display " } sup { ")
- (output expt engine)
- (display " } } "))
- (skribe-error 'eq:expt "wrong number of arguments"
- body)))))
-
-
-;;;
-;;; Sums, products, integrals, etc.
-;;;
-
-(define-macro (range-lout-markup-writer sym lout-name)
- `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
- :action (lambda (node engine)
- (let ((from (markup-option node :from))
- (to (markup-option node :to))
- (body (markup-body node)))
- (display ,(string-append " { big " lout-name
- " from { "))
- (output from engine)
- (display " } to { ")
- (output to engine)
- (display " } { ")
- (output body engine)
- (display " } } ")))))
-
-(range-lout-markup-writer sum "sum")
-(range-lout-markup-writer product "prod")
-
-(markup-writer 'eq:script (find-engine 'lout)
- :action (lambda (node engine)
- (let ((body (markup-body node))
- (sup (markup-option node :sup))
- (sub (markup-option node :sub)))
- (display " { { ")
- (output body engine)
- (display " } ")
- (if sup
- (begin
- (display (if sub " supp { " " sup { "))
- (output sup engine)
- (display " } ")))
- (if sub
- (begin
- (display " on { ")
- (output sub engine)
- (display " } ")))
- (display " } "))))
-
;;;
;;; Text-only implementation.
@@ -301,6 +161,16 @@
(display " / "))
(loop (cdr operands)))))))
+
+;;;
+;;; Initialization.
+;;;
+
+(when-engine-is-loaded 'lout
+ (lambda ()
+ (resolve-module '(skribilo package eq lout))))
+
+
;;; arch-tag: 58764650-2684-47a6-8cc7-6288f2b474da
;;; eq.scm ends here
diff --git a/src/guile/skribilo/package/eq/Makefile.am b/src/guile/skribilo/package/eq/Makefile.am
new file mode 100644
index 0000000..c7b4f93
--- /dev/null
+++ b/src/guile/skribilo/package/eq/Makefile.am
@@ -0,0 +1,4 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/package/eq
+dist_guilemodule_DATA = lout.scm
+
+## arch-tag: 3e816c9a-7989-4baa-b38b-a095a5428ba1
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
new file mode 100644
index 0000000..30a6d39
--- /dev/null
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -0,0 +1,184 @@
+;;; lout.scm -- Lout implementation of the `eq' package.
+;;;
+;;; Copyright 2005, 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-module (skribilo package eq lout)
+ :use-module (skribilo package eq)
+ :use-module (skribilo ast)
+ :autoload (skribilo output) (output)
+ :use-module (skribilo writer)
+ :use-module (skribilo engine)
+ :use-module (skribilo lib)
+ :use-module (skribilo utils syntax)
+ :use-module (skribilo skribe utils) ;; `the-options', etc.
+ :use-module (ice-9 optargs))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Initialization.
+;;;
+
+(let ((lout (find-engine 'lout)))
+ (if (not lout)
+ (skribe-error 'eq "Lout engine not found" lout)
+ (let ((includes (engine-custom lout 'includes)))
+ ;; Append the `eq' include file
+ (engine-custom-set! lout 'includes
+ (string-append includes "\n"
+ "@SysInclude { eq }\n")))))
+
+
+;;;
+;;; Simple markup writers.
+;;;
+
+
+;; FIXME: Reimplement the `symbol' writer so that `@Sym' is not used within
+;; equations (e.g. output `alpha' instead of `{ @Sym alpha }').
+
+(markup-writer 'eq (find-engine 'lout)
+ :before "\n@Eq { "
+ :action (lambda (node engine)
+ (let ((eq (markup-body node)))
+ ;(fprint (current-error-port) "eq=" eq)
+ (output eq engine)))
+ :after " }\n")
+
+
+;;
+;; `+' and `-' have lower precedence than `*', `/', `=', etc., so their
+;; operands do not need to be enclosed in braces.
+;;
+
+(markup-writer 'eq:+ (find-engine 'lout)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (begin
+ ;; no braces
+ (output (car operands) engine)
+ (if (pair? (cdr operands))
+ (display " + "))
+ (loop (cdr operands)))))))
+
+(markup-writer 'eq:- (find-engine 'lout)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (begin
+ ;; no braces
+ (output (car operands) engine)
+ (if (pair? (cdr operands))
+ (display " - "))
+ (loop (cdr operands)))))))
+
+(define-macro (simple-lout-markup-writer sym . lout-name)
+ `(markup-writer ',(symbol-append 'eq: sym)
+ (find-engine 'lout)
+ :action (lambda (node engine)
+ (let loop ((operands (markup-body node)))
+ (if (null? operands)
+ #t
+ (begin
+ (display " { ")
+ (output (car operands) engine)
+ (display " }")
+ (if (pair? (cdr operands))
+ (display ,(string-append " "
+ (if (null? lout-name)
+ (symbol->string sym)
+ (car lout-name))
+ " ")))
+ (loop (cdr operands))))))))
+
+(simple-lout-markup-writer * "times")
+(simple-lout-markup-writer / "over")
+(simple-lout-markup-writer =)
+(simple-lout-markup-writer <)
+(simple-lout-markup-writer >)
+(simple-lout-markup-writer <=)
+(simple-lout-markup-writer >=)
+
+(markup-writer 'eq:expt (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((body (markup-body node)))
+ (if (= (length body) 2)
+ (let ((base (car body))
+ (expt (cadr body)))
+ (display " { { ")
+ (if (markup? base) (display "("))
+ (output base engine)
+ (if (markup? base) (display ")"))
+ (display " } sup { ")
+ (output expt engine)
+ (display " } } "))
+ (skribe-error 'eq:expt "wrong number of arguments"
+ body)))))
+
+
+
+;;;
+;;; Sums, products, integrals, etc.
+;;;
+
+(define-macro (range-lout-markup-writer sym lout-name)
+ `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((from (markup-option node :from))
+ (to (markup-option node :to))
+ (body (markup-body node)))
+ (display ,(string-append " { big " lout-name
+ " from { "))
+ (output from engine)
+ (display " } to { ")
+ (output to engine)
+ (display " } { ")
+ (output body engine)
+ (display " } } ")))))
+
+(range-lout-markup-writer sum "sum")
+(range-lout-markup-writer product "prod")
+
+(markup-writer 'eq:script (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((body (markup-body node))
+ (sup (markup-option node :sup))
+ (sub (markup-option node :sub)))
+ (display " { { ")
+ (output body engine)
+ (display " } ")
+ (if sup
+ (begin
+ (display (if sub " supp { " " sup { "))
+ (output sup engine)
+ (display " } ")))
+ (if sub
+ (begin
+ (display " on { ")
+ (output sub engine)
+ (display " } ")))
+ (display " } "))))
+
+
+;;; arch-tag: 2a1410e5-977e-4600-b781-3d57f4409b35
diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm
index 5b39239..8968d00 100644
--- a/src/guile/skribilo/package/slide.scm
+++ b/src/guile/skribilo/package/slide.scm
@@ -1,82 +1,60 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/slide.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Fri Oct 3 12:22:13 2003 */
-;* Last change : Mon Aug 23 09:08:21 2004 (serrano) */
-;* Copyright : 2003-04 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* Skribe style for slides */
-;*=====================================================================*/
+;;; slide.scm -- Overhead transparencies.
+;;;
+;;; 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
(define-skribe-module (skribilo package slide)
- :autoload (skribilo engine html) (html-width html-title-authors))
+ :autoload (skribilo engine html) (html-width html-title-authors)
+ :autoload (skribilo package slide html) (%slide-html-initialize!)
+ :autoload (skribilo package slide lout) (%slide-lout-initialize!)
+ :autoload (skribilo package slide latex) (%slide-latex-initialize!))
;*---------------------------------------------------------------------*/
;* slide-options */
;*---------------------------------------------------------------------*/
-(define &slide-load-options (skribe-load-options))
-
-;*---------------------------------------------------------------------*/
-;* &slide-seminar-predocument ... */
-;*---------------------------------------------------------------------*/
-(define &slide-seminar-predocument
- "\\special{landscape}
- \\slideframe{none}
- \\centerslidesfalse
- \\raggedslides[0pt]
- \\renewcommand{\\slideleftmargin}{0.2in}
- \\renewcommand{\\slidetopmargin}{0.3in}
- \\newdimen\\slidewidth \\slidewidth 9in")
-
-;*---------------------------------------------------------------------*/
-;* &slide-seminar-maketitle ... */
-;*---------------------------------------------------------------------*/
-(define &slide-seminar-maketitle
- "\\def\\labelitemi{$\\bullet$}
- \\def\\labelitemii{$\\circ$}
- \\def\\labelitemiii{$\\diamond$}
- \\def\\labelitemiv{$\\cdot$}
- \\pagestyle{empty}
- \\slideframe{none}
- \\centerslidestrue
- \\begin{slide}
- \\date{}
- \\maketitle
- \\end{slide}
- \\slideframe{none}
- \\centerslidesfalse")
+(define-public &slide-load-options (skribe-load-options))
-;*---------------------------------------------------------------------*/
-;* &slide-prosper-predocument ... */
-;*---------------------------------------------------------------------*/
-(define &slide-prosper-predocument
- "\\slideCaption{}\n")
;*---------------------------------------------------------------------*/
;* %slide-the-slides ... */
;*---------------------------------------------------------------------*/
(define %slide-the-slides '())
(define %slide-the-counter 0)
-(define %slide-initialized #f)
-(define %slide-latex-mode 'seminar)
;*---------------------------------------------------------------------*/
;* %slide-initialize! ... */
;*---------------------------------------------------------------------*/
-(define (%slide-initialize!)
- (unless %slide-initialized
- (set! %slide-initialized #t)
- (case %slide-latex-mode
- ((seminar)
- (%slide-seminar-setup!))
- ((advi)
- (%slide-advi-setup!))
- ((prosper)
- (%slide-prosper-setup!))
- (else
- (skribe-error 'slide "Illegal latex mode" %slide-latex-mode)))))
+(format (current-error-port) "Slides initializing...~%")
+
+;; Register specific implementations for lazy loading.
+(when-engine-is-loaded 'latex
+ (lambda ()
+ (%slide-latex-initialize!)))
+(when-engine-is-loaded 'html
+ (lambda ()
+ (%slide-html-initialize!)))
+(when-engine-is-loaded 'lout
+ (lambda ()
+ (%slide-lout-initialize!)))
+
;*---------------------------------------------------------------------*/
;* slide ... */
@@ -89,7 +67,6 @@
(vspace #f) (vfill #f)
(transition #f)
(bg #f) (image #f))
- (%slide-initialize!)
(let ((s (new container
(markup 'slide)
(ident (if (not ident)
@@ -288,403 +265,12 @@
:action (lambda (n e)
(output (markup-option n :alt) e))))
-;*---------------------------------------------------------------------*/
-;* slide-body-width ... */
-;*---------------------------------------------------------------------*/
-(define (slide-body-width e)
- (let ((w (engine-custom e 'body-width)))
- (if (or (number? w) (string? w)) w 95.)))
-
-;*---------------------------------------------------------------------*/
-;* html-slide-title ... */
-;*---------------------------------------------------------------------*/
-(define (html-slide-title n e)
- (let* ((title (markup-body n))
- (authors (markup-option n 'author))
- (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>"
- (html-width (slide-body-width e)))
- (if (string? tbg)
- (printf "<td bgcolor=\"~a\">" tbg)
- (display "<td>"))
- (if (string? tfg)
- (printf "<font color=\"~a\">" tfg))
- (if title
- (begin
- (display "<center>")
- (if (string? tfont)
- (begin
- (printf "<font ~a><strong>" tfont)
- (output title e)
- (display "</strong></font>"))
- (begin
- (printf "<div class=\"skribetitle\"><strong><big><big><big>")
- (output title e)
- (display "</big></big></big></strong</div>")))
- (display "</center>\n")))
- (if (not authors)
- (display "\n")
- (html-title-authors authors e))
- (if (string? tfg)
- (display "</font>"))
- (display "</td></tr></tbody></table></center>\n")))
;*---------------------------------------------------------------------*/
;* slide-number ... */
;*---------------------------------------------------------------------*/
-(define (slide-number)
+(define-public (slide-number)
(length (filter (lambda (n)
(and (is-markup? n 'slide)
(markup-option n :number)))
%slide-the-slides)))
-
-;*---------------------------------------------------------------------*/
-;* html */
-;*---------------------------------------------------------------------*/
-(let ((he (find-engine 'html)))
- (skribe-message "HTML slides setup...\n")
- ;; &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"))
- :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)))
- :after "<br>")
- ;; slide-vspace
- (markup-writer 'slide-vspace he
- :action (lambda (n e) (display "<br>"))))
-
-;*---------------------------------------------------------------------*/
-;* latex */
-;*---------------------------------------------------------------------*/
-(define &latex-slide #f)
-(define &latex-pause #f)
-(define &latex-embed #f)
-(define &latex-record #f)
-(define &latex-play #f)
-(define &latex-play* #f)
-
-;;; FIXME: We shouldn't load `latex.scm' from here. Instead, we should
-;;; register a hook on its load.
-(let ((le (find-engine 'latex)))
- ;; slide-vspace
- (markup-writer 'slide-vspace le
- :options '(:unit)
- :action (lambda (n e)
- (display "\n\\vspace{")
- (output (markup-body n) e)
- (printf " ~a}\n\n" (markup-option n :unit))))
- ;; slide-slide
- (markup-writer 'slide le
- :options '(:title :number :transition :vfill :toc :vspace :image)
- :action (lambda (n e)
- (if (procedure? &latex-slide)
- (&latex-slide n e))))
- ;; slide-pause
- (markup-writer 'slide-pause le
- :options '()
- :action (lambda (n e)
- (if (procedure? &latex-pause)
- (&latex-pause n e))))
- ;; slide-embed
- (markup-writer 'slide-embed le
- :options '(:alt :command :geometry-opt :geometry
- :rgeometry :transient :transient-opt)
- :action (lambda (n e)
- (if (procedure? &latex-embed)
- (&latex-embed n e))))
- ;; slide-record
- (markup-writer 'slide-record le
- :options '(:tag :play)
- :action (lambda (n e)
- (if (procedure? &latex-record)
- (&latex-record n e))))
- ;; slide-play
- (markup-writer 'slide-play le
- :options '(:tag :color)
- :action (lambda (n e)
- (if (procedure? &latex-play)
- (&latex-play n e))))
- ;; slide-play*
- (markup-writer 'slide-play* le
- :options '(:tag :color :scolor)
- :action (lambda (n e)
- (if (procedure? &latex-play*)
- (&latex-play* n e)))))
-
-;*---------------------------------------------------------------------*/
-;* %slide-seminar-setup! ... */
-;*---------------------------------------------------------------------*/
-(define (%slide-seminar-setup!)
- (skribe-message "Seminar slides setup...\n")
- (let ((le (find-engine 'latex))
- (be (find-engine 'base)))
- ;; 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)))
- (output t e)
- (display "\\hrule\n"))
- (output (markup-body n) e)
- (if (markup-option n :vill) (display "\\vfill\n"))
- (display "\\end{slide}\n"))
- (engine-custom-set! le 'documentclass
- "\\documentclass[landscape]{seminar}\n")
- (let ((o (engine-custom le 'predocument)))
- (engine-custom-set! le 'predocument
- (if (string? o)
- (string-append &slide-seminar-predocument o)
- &slide-seminar-predocument)))
- (engine-custom-set! le 'maketitle
- &slide-seminar-maketitle)
- (engine-custom-set! le 'hyperref-usepackage
- "\\usepackage[setpagesize=false]{hyperref}\n")
- ;; slide-slide
- (set! &latex-slide seminar-slide)))
-
-;*---------------------------------------------------------------------*/
-;* %slide-advi-setup! ... */
-;*---------------------------------------------------------------------*/
-(define (%slide-advi-setup!)
- (skribe-message "Generating `Advi Seminar' slides...\n")
- (let ((le (find-engine 'latex))
- (be (find-engine 'base)))
- (define (advi-geometry geo)
- (let ((r (pregexp-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*))))
- (values "" (string-append w "x" h "+!x+!y")))
- (let ((r (pregexp-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*)))
- (h (number->string (/ (string->integer (caddr r))
- *skribe-slide-advi-scale*)))
- (x (cadddr r))
- (y (car (cddddr r))))
- (values (string-append "width=" w "cm,height=" h "cm")
- "!g"))
- (values "" geo))))))
- (define (advi-transition trans)
- (cond
- ((string? trans)
- (printf "\\advitransition{~s}" trans))
- ((and (symbol? trans)
- (memq trans '(wipe block slide)))
- (printf "\\advitransition{~s}" trans))
- (else
- #f)))
- ;; latex configuration
- (define (advi-slide n e)
- (let ((i (markup-option n :image))
- (n (markup-option n :number))
- (t (markup-option n :title))
- (lt (markup-option n :transition))
- (gt (engine-custom e 'transition)))
- (if (and i (engine-custom e 'advi))
- (printf "\\advibg[global]{image=~a}\n"
- (if (and (pair? i)
- (null? (cdr i))
- (string? (car i)))
- (car i)
- i)))
- (display "\\begin{slide}\n")
- (advi-transition (or lt gt))
- (if n (printf "~a/~a -- " n (slide-number)))
- (output t e)
- (display "\\hrule\n"))
- (output (markup-body n) e)
- (if (markup-option n :vill) (display "\\vfill\n"))
- (display "\\end{slide}\n\n\n"))
- ;; advi record
- (define (advi-record n e)
- (display "\\advirecord")
- (when (markup-option n :play) (display "[play]"))
- (printf "{~a}{" (markup-option n :tag))
- (output (markup-body n) e)
- (display "}"))
- ;; advi play
- (define (advi-play n e)
- (display "\\adviplay")
- (let ((c (markup-option n :color)))
- (when c
- (display "[")
- (display (skribe-get-latex-color c))
- (display "]")))
- (printf "{~a}" (markup-option n :tag)))
- ;; advi play*
- (define (advi-play* n e)
- (let ((c (skribe-get-latex-color (markup-option n :color)))
- (d (skribe-get-latex-color (markup-option n :scolor))))
- (let loop ((lbls (markup-body n))
- (last #f))
- (when last
- (display "\\adviplay[")
- (display d)
- (printf "]{~a}" last))
- (when (pair? lbls)
- (let ((lbl (car lbls)))
- (match-case lbl
- ((?id ?col)
- (display "\\adviplay[")
- (display (skribe-get-latex-color col))
- (printf "]{" ~a "}" id)
- (skribe-eval (slide-pause) e)
- (loop (cdr lbls) id))
- (else
- (display "\\adviplay[")
- (display c)
- (printf "]{~a}" lbl)
- (skribe-eval (slide-pause) e)
- (loop (cdr lbls) lbl))))))))
- (engine-custom-set! le 'documentclass
- "\\documentclass{seminar}\n")
- (let ((o (engine-custom le 'predocument)))
- (engine-custom-set! le 'predocument
- (if (string? o)
- (string-append &slide-seminar-predocument o)
- &slide-seminar-predocument)))
- (engine-custom-set! le 'maketitle
- &slide-seminar-maketitle)
- (engine-custom-set! le 'usepackage
- (string-append "\\usepackage{advi}\n"
- (engine-custom le 'usepackage)))
- ;; slide
- (set! &latex-slide advi-slide)
- (set! &latex-pause
- (lambda (n e) (display "\\adviwait\n")))
- (set! &latex-embed
- (lambda (n e)
- (let ((geometry-opt (markup-option n :geometry-opt))
- (geometry (markup-option n :geometry))
- (rgeometry (markup-option n :rgeometry))
- (transient (markup-option n :transient))
- (transient-opt (markup-option n :transient-opt))
- (cmd (markup-option n :command)))
- (let* ((a (string-append "ephemeral="
- (symbol->string (gensym))))
- (c (cond
- (geometry
- (string-append cmd " "
- geometry-opt " "
- geometry))
- (rgeometry
- (multiple-value-bind (aopt dopt)
- (advi-geometry rgeometry)
- (set! a (string-append a "," aopt))
- (string-append cmd " "
- geometry-opt " "
- dopt)))
- (else
- cmd)))
- (c (if (and transient transient-opt)
- (string-append c " " transient-opt " !p")
- c)))
- (printf "\\adviembed[~a]{~a}\n" a c)))))
- (set! &latex-record advi-record)
- (set! &latex-play advi-play)
- (set! &latex-play* advi-play*)))
-
-;*---------------------------------------------------------------------*/
-;* %slide-prosper-setup! ... */
-;*---------------------------------------------------------------------*/
-(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))
- ((eq? trans 'slide)
- (printf "[Blinds]"))
- ((and (symbol? trans)
- (memq trans '(split blinds box wipe dissolve glitter)))
- (printf "[~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))
- (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)))
- (display "\\begin{slide}")
- (prosper-transition (or lt gt))
- (display "{")
- (output t e)
- (display "}\n")
- (output (markup-body n) e)
- (display "\\end{slide}\n")
- (if (>= lpa 1) (display "}\n"))
- (newline)
- (newline)))
- (engine-custom-set! le 'documentclass "\\documentclass[pdf,skribe,slideColor,nototal]{prosper}\n")
- (let* ((cap (engine-custom le 'slide-caption))
- (o (engine-custom le 'predocument))
- (n (if (string? cap)
- (format #f "~a\\slideCaption{~a}\n"
- &slide-prosper-predocument
- cap)
- &slide-prosper-predocument)))
- (engine-custom-set! le 'predocument
- (if (string? o) (string-append n o) n)))
- (engine-custom-set! le 'hyperref-usepackage "\\usepackage{hyperref}\n")
- ;; writers
- (set! &latex-slide prosper-slide)
- (set! &latex-pause
- (lambda (n e)
- (set! overlay-count (+ 1 overlay-count))
- (printf "\\FromSlide{~s}%\n" overlay-count)))))
-
-;*---------------------------------------------------------------------*/
-;* Setup ... */
-;*---------------------------------------------------------------------*/
-(let* ((opt &slide-load-options)
- (p (memq :prosper opt)))
- (if (and (pair? p) (pair? (cdr p)) (cadr p))
- ;; prosper
- (set! %slide-latex-mode 'prosper)
- (let ((a (memq :advi opt)))
- (if (and (pair? a) (pair? (cdr a)) (cadr a))
- ;; advi
- (set! %slide-latex-mode 'advi)))))
diff --git a/src/guile/skribilo/package/slide/Makefile.am b/src/guile/skribilo/package/slide/Makefile.am
new file mode 100644
index 0000000..e5fb908
--- /dev/null
+++ b/src/guile/skribilo/package/slide/Makefile.am
@@ -0,0 +1,4 @@
+guilemoduledir = $(GUILE_SITE)/skribilo/package/slide
+dist_guilemodule_DATA = latex.scm html.scm lout.scm
+
+## arch-tag: 56b5fa5c-bb6a-4692-b929-74bdd032431c
diff --git a/src/guile/skribilo/package/slide/html.scm b/src/guile/skribilo/package/slide/html.scm
new file mode 100644
index 0000000..5398fbf
--- /dev/null
+++ b/src/guile/skribilo/package/slide/html.scm
@@ -0,0 +1,106 @@
+;;; html.scm -- HTML implementation of the `slide' package.
+;;;
+;;; Copyright 2003, 2004 Manuel Serrano
+;;;
+;;;
+;;; 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-skribe-module (skribilo package slide html)
+ :use-module (skribilo package slide))
+
+
+(define-public (%slide-html-initialize!)
+ (let ((he (find-engine 'html)))
+ (skribe-message "HTML slides setup...\n")
+ ;; &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"))
+ :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)))
+ :after "<br>")
+ ;; slide-vspace
+ (markup-writer 'slide-vspace he
+ :action (lambda (n e) (display "<br>")))))
+
+;*---------------------------------------------------------------------*/
+;* slide-body-width ... */
+;*---------------------------------------------------------------------*/
+(define (slide-body-width e)
+ (let ((w (engine-custom e 'body-width)))
+ (if (or (number? w) (string? w)) w 95.)))
+
+;*---------------------------------------------------------------------*/
+;* html-slide-title ... */
+;*---------------------------------------------------------------------*/
+(define (html-slide-title n e)
+ (let* ((title (markup-body n))
+ (authors (markup-option n 'author))
+ (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>"
+ (html-width (slide-body-width e)))
+ (if (string? tbg)
+ (printf "<td bgcolor=\"~a\">" tbg)
+ (display "<td>"))
+ (if (string? tfg)
+ (printf "<font color=\"~a\">" tfg))
+ (if title
+ (begin
+ (display "<center>")
+ (if (string? tfont)
+ (begin
+ (printf "<font ~a><strong>" tfont)
+ (output title e)
+ (display "</strong></font>"))
+ (begin
+ (printf "<div class=\"skribetitle\"><strong><big><big><big>")
+ (output title e)
+ (display "</big></big></big></strong</div>")))
+ (display "</center>\n")))
+ (if (not authors)
+ (display "\n")
+ (html-title-authors authors e))
+ (if (string? tfg)
+ (display "</font>"))
+ (display "</td></tr></tbody></table></center>\n")))
+
+
+;;; arch-tag: 8be0cdf2-b755-4baa-baf6-739cdd00e193
diff --git a/src/guile/skribilo/package/slide/latex.scm b/src/guile/skribilo/package/slide/latex.scm
new file mode 100644
index 0000000..15f4535
--- /dev/null
+++ b/src/guile/skribilo/package/slide/latex.scm
@@ -0,0 +1,385 @@
+;;; latex.scm -- LaTeX implementation of the `slide' package.
+;;;
+;;; Copyright 2003, 2004 Manuel Serrano
+;;;
+;;;
+;;; 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-skribe-module (skribilo package slide latex)
+ :use-module (skribilo package slide))
+
+
+(define-public %slide-latex-mode 'seminar)
+
+(define-public (%slide-latex-initialize!)
+ (case %slide-latex-mode
+ ((seminar)
+ (%slide-seminar-setup!))
+ ((advi)
+ (%slide-advi-setup!))
+ ((prosper)
+ (%slide-prosper-setup!))
+ (else
+ (skribe-error 'slide "Illegal latex mode" %slide-latex-mode))))
+
+;*---------------------------------------------------------------------*/
+;* &slide-seminar-predocument ... */
+;*---------------------------------------------------------------------*/
+(define &slide-seminar-predocument
+ "\\special{landscape}
+ \\slideframe{none}
+ \\centerslidesfalse
+ \\raggedslides[0pt]
+ \\renewcommand{\\slideleftmargin}{0.2in}
+ \\renewcommand{\\slidetopmargin}{0.3in}
+ \\newdimen\\slidewidth \\slidewidth 9in")
+
+;*---------------------------------------------------------------------*/
+;* &slide-seminar-maketitle ... */
+;*---------------------------------------------------------------------*/
+(define &slide-seminar-maketitle
+ "\\def\\labelitemi{$\\bullet$}
+ \\def\\labelitemii{$\\circ$}
+ \\def\\labelitemiii{$\\diamond$}
+ \\def\\labelitemiv{$\\cdot$}
+ \\pagestyle{empty}
+ \\slideframe{none}
+ \\centerslidestrue
+ \\begin{slide}
+ \\date{}
+ \\maketitle
+ \\end{slide}
+ \\slideframe{none}
+ \\centerslidesfalse")
+
+;*---------------------------------------------------------------------*/
+;* &slide-prosper-predocument ... */
+;*---------------------------------------------------------------------*/
+(define &slide-prosper-predocument
+ "\\slideCaption{}\n")
+
+;*---------------------------------------------------------------------*/
+;* latex */
+;*---------------------------------------------------------------------*/
+(define &latex-slide #f)
+(define &latex-pause #f)
+(define &latex-embed #f)
+(define &latex-record #f)
+(define &latex-play #f)
+(define &latex-play* #f)
+
+;;; FIXME: We shouldn't load `latex.scm' from here. Instead, we should
+;;; register a hook on its load.
+(let ((le (find-engine 'latex)))
+ ;; slide-vspace
+ (markup-writer 'slide-vspace le
+ :options '(:unit)
+ :action (lambda (n e)
+ (display "\n\\vspace{")
+ (output (markup-body n) e)
+ (printf " ~a}\n\n" (markup-option n :unit))))
+ ;; slide-slide
+ (markup-writer 'slide le
+ :options '(:title :number :transition :vfill :toc :vspace :image)
+ :action (lambda (n e)
+ (if (procedure? &latex-slide)
+ (&latex-slide n e))))
+ ;; slide-pause
+ (markup-writer 'slide-pause le
+ :options '()
+ :action (lambda (n e)
+ (if (procedure? &latex-pause)
+ (&latex-pause n e))))
+ ;; slide-embed
+ (markup-writer 'slide-embed le
+ :options '(:alt :command :geometry-opt :geometry
+ :rgeometry :transient :transient-opt)
+ :action (lambda (n e)
+ (if (procedure? &latex-embed)
+ (&latex-embed n e))))
+ ;; slide-record
+ (markup-writer 'slide-record le
+ :options '(:tag :play)
+ :action (lambda (n e)
+ (if (procedure? &latex-record)
+ (&latex-record n e))))
+ ;; slide-play
+ (markup-writer 'slide-play le
+ :options '(:tag :color)
+ :action (lambda (n e)
+ (if (procedure? &latex-play)
+ (&latex-play n e))))
+ ;; slide-play*
+ (markup-writer 'slide-play* le
+ :options '(:tag :color :scolor)
+ :action (lambda (n e)
+ (if (procedure? &latex-play*)
+ (&latex-play* n e)))))
+
+;*---------------------------------------------------------------------*/
+;* %slide-seminar-setup! ... */
+;*---------------------------------------------------------------------*/
+(define (%slide-seminar-setup!)
+ (skribe-message "Seminar slides setup...\n")
+ (let ((le (find-engine 'latex))
+ (be (find-engine 'base)))
+ ;; 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)))
+ (output t e)
+ (display "\\hrule\n"))
+ (output (markup-body n) e)
+ (if (markup-option n :vill) (display "\\vfill\n"))
+ (display "\\end{slide}\n"))
+ (engine-custom-set! le 'documentclass
+ "\\documentclass[landscape]{seminar}\n")
+ (let ((o (engine-custom le 'predocument)))
+ (engine-custom-set! le 'predocument
+ (if (string? o)
+ (string-append &slide-seminar-predocument o)
+ &slide-seminar-predocument)))
+ (engine-custom-set! le 'maketitle
+ &slide-seminar-maketitle)
+ (engine-custom-set! le 'hyperref-usepackage
+ "\\usepackage[setpagesize=false]{hyperref}\n")
+ ;; slide-slide
+ (set! &latex-slide seminar-slide)))
+
+;*---------------------------------------------------------------------*/
+;* %slide-advi-setup! ... */
+;*---------------------------------------------------------------------*/
+(define (%slide-advi-setup!)
+ (skribe-message "Generating `Advi Seminar' slides...\n")
+ (let ((le (find-engine 'latex))
+ (be (find-engine 'base)))
+ (define (advi-geometry geo)
+ (let ((r (pregexp-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*))))
+ (values "" (string-append w "x" h "+!x+!y")))
+ (let ((r (pregexp-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*)))
+ (h (number->string (/ (string->integer (caddr r))
+ *skribe-slide-advi-scale*)))
+ (x (cadddr r))
+ (y (car (cddddr r))))
+ (values (string-append "width=" w "cm,height=" h "cm")
+ "!g"))
+ (values "" geo))))))
+ (define (advi-transition trans)
+ (cond
+ ((string? trans)
+ (printf "\\advitransition{~s}" trans))
+ ((and (symbol? trans)
+ (memq trans '(wipe block slide)))
+ (printf "\\advitransition{~s}" trans))
+ (else
+ #f)))
+ ;; latex configuration
+ (define (advi-slide n e)
+ (let ((i (markup-option n :image))
+ (n (markup-option n :number))
+ (t (markup-option n :title))
+ (lt (markup-option n :transition))
+ (gt (engine-custom e 'transition)))
+ (if (and i (engine-custom e 'advi))
+ (printf "\\advibg[global]{image=~a}\n"
+ (if (and (pair? i)
+ (null? (cdr i))
+ (string? (car i)))
+ (car i)
+ i)))
+ (display "\\begin{slide}\n")
+ (advi-transition (or lt gt))
+ (if n (printf "~a/~a -- " n (slide-number)))
+ (output t e)
+ (display "\\hrule\n"))
+ (output (markup-body n) e)
+ (if (markup-option n :vill) (display "\\vfill\n"))
+ (display "\\end{slide}\n\n\n"))
+ ;; advi record
+ (define (advi-record n e)
+ (display "\\advirecord")
+ (when (markup-option n :play) (display "[play]"))
+ (printf "{~a}{" (markup-option n :tag))
+ (output (markup-body n) e)
+ (display "}"))
+ ;; advi play
+ (define (advi-play n e)
+ (display "\\adviplay")
+ (let ((c (markup-option n :color)))
+ (when c
+ (display "[")
+ (display (skribe-get-latex-color c))
+ (display "]")))
+ (printf "{~a}" (markup-option n :tag)))
+ ;; advi play*
+ (define (advi-play* n e)
+ (let ((c (skribe-get-latex-color (markup-option n :color)))
+ (d (skribe-get-latex-color (markup-option n :scolor))))
+ (let loop ((lbls (markup-body n))
+ (last #f))
+ (when last
+ (display "\\adviplay[")
+ (display d)
+ (printf "]{~a}" last))
+ (when (pair? lbls)
+ (let ((lbl (car lbls)))
+ (match-case lbl
+ ((?id ?col)
+ (display "\\adviplay[")
+ (display (skribe-get-latex-color col))
+ (printf "]{" ~a "}" id)
+ (skribe-eval (slide-pause) e)
+ (loop (cdr lbls) id))
+ (else
+ (display "\\adviplay[")
+ (display c)
+ (printf "]{~a}" lbl)
+ (skribe-eval (slide-pause) e)
+ (loop (cdr lbls) lbl))))))))
+ (engine-custom-set! le 'documentclass
+ "\\documentclass{seminar}\n")
+ (let ((o (engine-custom le 'predocument)))
+ (engine-custom-set! le 'predocument
+ (if (string? o)
+ (string-append &slide-seminar-predocument o)
+ &slide-seminar-predocument)))
+ (engine-custom-set! le 'maketitle
+ &slide-seminar-maketitle)
+ (engine-custom-set! le 'usepackage
+ (string-append "\\usepackage{advi}\n"
+ (engine-custom le 'usepackage)))
+ ;; slide
+ (set! &latex-slide advi-slide)
+ (set! &latex-pause
+ (lambda (n e) (display "\\adviwait\n")))
+ (set! &latex-embed
+ (lambda (n e)
+ (let ((geometry-opt (markup-option n :geometry-opt))
+ (geometry (markup-option n :geometry))
+ (rgeometry (markup-option n :rgeometry))
+ (transient (markup-option n :transient))
+ (transient-opt (markup-option n :transient-opt))
+ (cmd (markup-option n :command)))
+ (let* ((a (string-append "ephemeral="
+ (symbol->string (gensym))))
+ (c (cond
+ (geometry
+ (string-append cmd " "
+ geometry-opt " "
+ geometry))
+ (rgeometry
+ (multiple-value-bind (aopt dopt)
+ (advi-geometry rgeometry)
+ (set! a (string-append a "," aopt))
+ (string-append cmd " "
+ geometry-opt " "
+ dopt)))
+ (else
+ cmd)))
+ (c (if (and transient transient-opt)
+ (string-append c " " transient-opt " !p")
+ c)))
+ (printf "\\adviembed[~a]{~a}\n" a c)))))
+ (set! &latex-record advi-record)
+ (set! &latex-play advi-play)
+ (set! &latex-play* advi-play*)))
+
+;*---------------------------------------------------------------------*/
+;* %slide-prosper-setup! ... */
+;*---------------------------------------------------------------------*/
+(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))
+ ((eq? trans 'slide)
+ (printf "[Blinds]"))
+ ((and (symbol? trans)
+ (memq trans '(split blinds box wipe dissolve glitter)))
+ (printf "[~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))
+ (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)))
+ (display "\\begin{slide}")
+ (prosper-transition (or lt gt))
+ (display "{")
+ (output t e)
+ (display "}\n")
+ (output (markup-body n) e)
+ (display "\\end{slide}\n")
+ (if (>= lpa 1) (display "}\n"))
+ (newline)
+ (newline)))
+ (engine-custom-set! le 'documentclass "\\documentclass[pdf,skribe,slideColor,nototal]{prosper}\n")
+ (let* ((cap (engine-custom le 'slide-caption))
+ (o (engine-custom le 'predocument))
+ (n (if (string? cap)
+ (format #f "~a\\slideCaption{~a}\n"
+ &slide-prosper-predocument
+ cap)
+ &slide-prosper-predocument)))
+ (engine-custom-set! le 'predocument
+ (if (string? o) (string-append n o) n)))
+ (engine-custom-set! le 'hyperref-usepackage "\\usepackage{hyperref}\n")
+ ;; writers
+ (set! &latex-slide prosper-slide)
+ (set! &latex-pause
+ (lambda (n e)
+ (set! overlay-count (+ 1 overlay-count))
+ (printf "\\FromSlide{~s}%\n" overlay-count)))))
+
+;*---------------------------------------------------------------------*/
+;* Setup ... */
+;*---------------------------------------------------------------------*/
+(let* ((opt &slide-load-options)
+ (p (memq :prosper opt)))
+ (if (and (pair? p) (pair? (cdr p)) (cadr p))
+ ;; prosper
+ (set! %slide-latex-mode 'prosper)
+ (let ((a (memq :advi opt)))
+ (if (and (pair? a) (pair? (cdr a)) (cadr a))
+ ;; advi
+ (set! %slide-latex-mode 'advi)))))
+
+
+;;; arch-tag: b99e2c65-55f7-462c-8482-f47c7e223538
diff --git a/src/guile/skribilo/package/slide/lout.scm b/src/guile/skribilo/package/slide/lout.scm
new file mode 100644
index 0000000..f816469
--- /dev/null
+++ b/src/guile/skribilo/package/slide/lout.scm
@@ -0,0 +1,131 @@
+;;; lout.scm -- Lout implementation of the `slide' package.
+;;;
+;;; Copyright 2005, 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-skribe-module (skribilo package slide lout)
+ :use-module (skribilo utils syntax)
+
+ ;; FIXME: For some reason, changing the following `autoload' in
+ ;; `use-modules' doesn't work.
+
+ :autoload (skribilo engine lout) (lout-tagify lout-output-pdf-meta-info)
+ )
+
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+;;; TODO:
+;;;
+;;; Make some more PS/PDF trickery.
+
+(format (current-error-port) "slide/lout.scm~%")
+
+(define-public (%slide-lout-initialize!)
+ (format (current-error-port) "Lout slides initializing...~%")
+
+ (let ((le (find-engine 'lout)))
+
+ ;; Automatically switch to the `slides' document type.
+ (engine-custom-set! le 'document-type 'slides)
+
+ (markup-writer 'slide le
+ :options '(:title :number :toc :ident) ;; '(:bg :vspace :image)
+
+ :validate (lambda (n e)
+ (eq? (engine-custom e 'document-type) 'slides))
+
+ :before (lambda (n e)
+ (display "\n@Overhead\n")
+ (display " @Title { ")
+ (output (markup-option n :title) e)
+ (display " }\n")
+ (if (markup-ident n)
+ (begin
+ (display " @Tag { ")
+ (display (lout-tagify (markup-ident n)))
+ (display " }\n")))
+ (if (markup-option n :number)
+ (begin
+ (display " @BypassNumber { ")
+ (output (markup-option n :number) e)
+ (display " }\n")))
+ (display "@Begin\n")
+
+ ;; `doc' documents produce their PDF outline right after
+ ;; `@Text @Begin'; other types of documents must produce it
+ ;; as part of their first chapter.
+ (lout-output-pdf-meta-info (ast-document n) e))
+
+ :after "@End @Overhead\n")
+
+ (markup-writer 'slide-vspace le
+ :options '(:unit)
+ :validate (lambda (n e)
+ (and (pair? (markup-body n))
+ (number? (car (markup-body n)))))
+ :action (lambda (n e)
+ (printf "\n//~a~a # slide-vspace\n"
+ (car (markup-body n))
+ (case (markup-option n :unit)
+ ((cm) "c")
+ ((point points pt) "p")
+ ((inch inches) "i")
+ (else
+ (skribe-error 'lout
+ "Unknown vspace unit"
+ (markup-option n :unit)))))))
+
+ (markup-writer 'slide-pause le
+ ;; FIXME: Use a `pdfmark' custom action and a PDF transition action.
+ ;; << /Type /Action
+ ;; << /S /Trans
+ ;; entry in the trans dict
+ ;; << /Type /Trans /S /Dissolve >>
+ :action (lambda (n e)
+ (let ((filter (make-string-replace lout-verbatim-encoding))
+ (pdfmark "
+[ {ThisPage} << /Trans << /S /Wipe /Dm /V /D 3 /M /O >> >> /PUT pdfmark"))
+ (display (lout-embedded-postscript-code
+ (filter pdfmark))))))
+
+ ;; 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))))))))))
+
+
+;;; arch-tag: 0c717553-5cbb-46ed-937a-f844b6aeb145
diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm
index 3fce068..9ed9f3e 100644
--- a/src/guile/skribilo/utils/compat.scm
+++ b/src/guile/skribilo/utils/compat.scm
@@ -136,30 +136,28 @@
("acmproc.skr" . (skribilo package acmproc))))
(define*-public (skribe-load file :rest args)
- (call/cc
- (lambda (return)
- (guard (c ((file-search-error? c)
- ;; Regular file loading failed. Try built-ins.
- (let ((mod-name (assoc-ref %skribe-known-files file)))
- (if mod-name
- (begin
- (if (> (*verbose*) 1)
- (format (current-error-port)
- " skribe-load: `~a' -> `~a'~%"
- file mod-name))
- (let ((mod (false-if-exception
- (resolve-module mod-name))))
- (if (not mod)
- (raise c)
- (begin
- (set-module-uses!
- (current-module)
- (cons mod (module-uses (current-module))))
- (return #t)))))
- (raise c)))))
-
- ;; Try a regular `load-document'.
- (apply load-document file args)))))
+ (guard (c ((file-search-error? c)
+ ;; Regular file loading failed. Try built-ins.
+ (let ((mod-name (assoc-ref %skribe-known-files file)))
+ (if mod-name
+ (begin
+ (if (> (*verbose*) 1)
+ (format (current-error-port)
+ " skribe-load: `~a' -> `~a'~%"
+ file mod-name))
+ (let ((mod (false-if-exception
+ (resolve-module mod-name))))
+ (if (not mod)
+ (raise c)
+ (begin
+ (set-module-uses!
+ (current-module)
+ (cons mod (module-uses (current-module))))
+ #t))))
+ (raise c)))))
+
+ ;; Try a regular `load-document'.
+ (apply load-document file args)))
(define-public skribe-include include-document)
--
cgit v1.2.3
From 86ab326c628da803cf983a39768333f58a586bee Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Mon, 20 Feb 2006 17:04:14 +0000
Subject: Lout engine: fixed use of `@Sym' so that it works fine within `@Eq'.
* src/guile/skribilo/engine/lout.scm (lout-symbol-table): Take an
additional SYM parameter. Use it instead of blindly using `@Sym'.
(lout-engine): Use `{ Symbol Base } @Font @Char' instead of `@Sym'.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-52
---
src/guile/skribilo/engine/lout.scm | 215 +++++++++++++++++++------------------
1 file changed, 111 insertions(+), 104 deletions(-)
(limited to 'src')
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index 17eb237..c49211f 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -113,7 +113,7 @@
;*---------------------------------------------------------------------*/
;* lout-symbol-table ... */
;*---------------------------------------------------------------------*/
-(define (lout-symbol-table math)
+(define (lout-symbol-table sym math)
`(("iexcl" "{ @Char exclamdown }")
("cent" "{ @Char cent }")
("pound" "{ @Char sterling }")
@@ -157,7 +157,7 @@
("Ocircumflex" "{ @Char Ocircumflex }")
("Otilde" "{ @Char Otilde }")
("Ouml" "{ @Char Odieresis }")
- ("times" "{ @Sym multiply }")
+ ("times" ,(sym "multiply"))
("Oslash" "{ @Char oslash }")
("Ugrave" "{ @Char Ugrave }")
("Uacute" "{ @Char Uacute }")
@@ -197,100 +197,100 @@
("yacute" "{ @Char yacute }")
("ymul" "{ @Char ydieresis }") ;; FIXME: `yUMl'
;; Greek
- ("Alpha" "{ @Sym Alpha }")
- ("Beta" "{ @Sym Beta }")
- ("Gamma" "{ @Sym Gamma }")
- ("Delta" "{ @Sym Delta }")
- ("Epsilon" "{ @Sym Epsilon }")
- ("Zeta" "{ @Sym Zeta }")
- ("Eta" "{ @Sym Eta }")
- ("Theta" "{ @Sym Theta }")
- ("Iota" "{ @Sym Iota }")
- ("Kappa" "{ @Sym Kappa }")
- ("Lambda" "{ @Sym Lambda }")
- ("Mu" "{ @Sym Mu }")
- ("Nu" "{ @Sym Nu }")
- ("Xi" "{ @Sym Xi }")
- ("Omicron" "{ @Sym Omicron }")
- ("Pi" "{ @Sym Pi }")
- ("Rho" "{ @Sym Rho }")
- ("Sigma" "{ @Sym Sigma }")
- ("Tau" "{ @Sym Tau }")
- ("Upsilon" "{ @Sym Upsilon }")
- ("Phi" "{ @Sym Phi }")
- ("Chi" "{ @Sym Chi }")
- ("Psi" "{ @Sym Psi }")
- ("Omega" "{ @Sym Omega }")
- ("alpha" "{ @Sym alpha }")
- ("beta" "{ @Sym beta }")
- ("gamma" "{ @Sym gamma }")
- ("delta" "{ @Sym delta }")
- ("epsilon" "{ @Sym epsilon }")
- ("zeta" "{ @Sym zeta }")
- ("eta" "{ @Sym eta }")
- ("theta" "{ @Sym theta }")
- ("iota" "{ @Sym iota }")
- ("kappa" "{ @Sym kappa }")
- ("lambda" "{ @Sym lambda }")
- ("mu" "{ @Sym mu }")
- ("nu" "{ @Sym nu }")
- ("xi" "{ @Sym xi }")
- ("omicron" "{ @Sym omicron }")
- ("pi" "{ @Sym pi }")
- ("rho" "{ @Sym rho }")
- ("sigmaf" "{ @Sym sigmaf }") ;; FIXME!
- ("sigma" "{ @Sym sigma }")
- ("tau" "{ @Sym tau }")
- ("upsilon" "{ @Sym upsilon }")
- ("phi" "{ @Sym phi }")
- ("chi" "{ @Sym chi }")
- ("psi" "{ @Sym psi }")
- ("omega" "{ @Sym omega }")
- ("thetasym" "{ @Sym thetasym }")
- ("piv" "{ @Sym piv }") ;; FIXME!
+ ("Alpha" ,(sym "Alpha"))
+ ("Beta" ,(sym "Beta"))
+ ("Gamma" ,(sym "Gamma"))
+ ("Delta" ,(sym "Delta"))
+ ("Epsilon" ,(sym "Epsilon"))
+ ("Zeta" ,(sym "Zeta"))
+ ("Eta" ,(sym "Eta"))
+ ("Theta" ,(sym "Theta"))
+ ("Iota" ,(sym "Iota"))
+ ("Kappa" ,(sym "Kappa"))
+ ("Lambda" ,(sym "Lambda"))
+ ("Mu" ,(sym "Mu"))
+ ("Nu" ,(sym "Nu"))
+ ("Xi" ,(sym "Xi"))
+ ("Omicron" ,(sym "Omicron"))
+ ("Pi" ,(sym "Pi"))
+ ("Rho" ,(sym "Rho"))
+ ("Sigma" ,(sym "Sigma"))
+ ("Tau" ,(sym "Tau"))
+ ("Upsilon" ,(sym "Upsilon"))
+ ("Phi" ,(sym "Phi"))
+ ("Chi" ,(sym "Chi"))
+ ("Psi" ,(sym "Psi"))
+ ("Omega" ,(sym "Omega"))
+ ("alpha" ,(sym "alpha"))
+ ("beta" ,(sym "beta"))
+ ("gamma" ,(sym "gamma"))
+ ("delta" ,(sym "delta"))
+ ("epsilon" ,(sym "epsilon"))
+ ("zeta" ,(sym "zeta"))
+ ("eta" ,(sym "eta"))
+ ("theta" ,(sym "theta"))
+ ("iota" ,(sym "iota"))
+ ("kappa" ,(sym "kappa"))
+ ("lambda" ,(sym "lambda"))
+ ("mu" ,(sym "mu"))
+ ("nu" ,(sym "nu"))
+ ("xi" ,(sym "xi"))
+ ("omicron" ,(sym "omicron"))
+ ("pi" ,(sym "pi"))
+ ("rho" ,(sym "rho"))
+ ("sigmaf" ,(sym "sigmaf")) ;; FIXME!
+ ("sigma" ,(sym "sigma"))
+ ("tau" ,(sym "tau"))
+ ("upsilon" ,(sym "upsilon"))
+ ("phi" ,(sym "phi"))
+ ("chi" ,(sym "chi"))
+ ("psi" ,(sym "psi"))
+ ("omega" ,(sym "omega"))
+ ("thetasym" ,(sym "thetasym"))
+ ("piv" ,(sym "piv")) ;; FIXME!
;; punctuation
- ("bullet" "{ @Sym bullet }")
- ("ellipsis" "{ @Sym ellipsis }")
+ ("bullet" ,(sym "bullet"))
+ ("ellipsis" ,(sym "ellipsis"))
("weierp" "{ @Sym weierstrass }")
- ("image" "{ @Sym Ifraktur }")
- ("real" "{ @Sym Rfraktur }")
- ("tm" "{ @Sym trademarksans }") ;; alt: @Sym trademarkserif
- ("alef" "{ @Sym aleph }")
- ("<-" "{ @Sym arrowleft }")
+ ("image" ,(sym "Ifraktur"))
+ ("real" ,(sym "Rfraktur"))
+ ("tm" ,(sym "trademarksans")) ;; alt: @Sym trademarkserif
+ ("alef" ,(sym "aleph"))
+ ("<-" ,(sym "arrowleft"))
("<--" "{ { 1.6 1 } @Scale { @Sym arrowleft } }") ;; copied from `eqf'
- ("uparrow" "{ @Sym arrowup }")
- ("->" "{ @Sym arrowright }")
+ ("uparrow" ,(sym "arrowup"))
+ ("->" ,(sym "arrowright"))
("-->" "{ { 1.6 1 } @Scale { @Sym arrowright } }")
- ("downarrow" "{ @Sym arrowdown }")
- ("<->" "{ @Sym arrowboth }")
+ ("downarrow" ,(sym "arrowdown"))
+ ("<->" ,(sym "arrowboth"))
("<-->" "{ { 1.6 1 } @Scale { @Sym arrowboth } }")
- ("<+" "{ @Sym carriagereturn }")
- ("<=" "{ @Sym arrowdblleft }")
+ ("<+" ,(sym "carriagereturn"))
+ ("<=" ,(sym "arrowdblleft"))
("<==" "{ { 1.6 1 } @Scale { @Sym arrowdblleft } }")
- ("Uparrow" "{ @Sym arrowdblup }")
- ("=>" "{ @Sym arrowdblright }")
+ ("Uparrow" ,(sym "arrowdblup"))
+ ("=>" ,(sym "arrowdblright"))
("==>" "{ { 1.6 1 } @Scale { @Sym arrowdblright } }")
- ("Downarrow" "{ @Sym arrowdbldown }")
- ("<=>" "{ @Sym arrowdblboth }")
+ ("Downarrow" ,(sym "arrowdbldown"))
+ ("<=>" ,(sym "arrowdblboth"))
("<==>" "{ { 1.6 1 } @Scale { @Sym arrowdblboth } }")
;; Mathematical operators (we try to avoid `@Eq' since it
;; requires to `@SysInclude { eq }' -- one solution consists in copying
;; the symbol definition from `eqf')
("forall" "{ { Symbol Base } @Font \"\\042\" }")
- ("partial" "{ @Sym partialdiff }")
+ ("partial" ,(sym "partialdiff"))
("exists" "{ { Symbol Base } @Font \"\\044\" }")
("emptyset" "{ { Symbol Base } @Font \"\\306\" }")
- ("infinity" "{ @Sym infinity }")
+ ("infinity" ,(sym "infinity"))
("nabla" "{ { Symbol Base } @Font \"\\321\" }")
- ("in" "{ @Sym element }")
- ("notin" "{ @Sym notelement }")
+ ("in" ,(sym "element"))
+ ("notin" ,(sym "notelement"))
("ni" "{ 180d @Rotate @Sym element }")
- ("prod" "{ @Sym product }")
- ("sum" "{ @Sym summation }")
- ("asterisk" "{ @Sym asteriskmath }")
- ("sqrt" "{ @Sym radical }")
+ ("prod" ,(sym "product"))
+ ("sum" ,(sym "summation"))
+ ("asterisk" ,(sym "asteriskmath"))
+ ("sqrt" ,(sym "radical"))
("propto" ,(math "propto"))
- ("angle" "{ @Sym angle }")
+ ("angle" ,(sym "angle"))
("and" ,(math "bwedge"))
("or" ,(math "bvee"))
("cap" ,(math "bcap"))
@@ -299,33 +299,33 @@
("models" ,(math "models"))
("vdash" ,(math "vdash"))
("dashv" ,(math "dashv"))
- ("sim" "{ @Sym similar }")
- ("cong" "{ @Sym congruent }")
- ("approx" "{ @Sym approxequal }")
- ("neq" "{ @Sym notequal }")
- ("equiv" "{ @Sym equivalence }")
- ("le" "{ @Sym lessequal }")
- ("ge" "{ @Sym greaterequal }")
- ("subset" "{ @Sym propersubset }")
- ("supset" "{ @Sym propersuperset }")
- ("subseteq" "{ @Sym reflexsubset }")
- ("supseteq" "{ @Sym reflexsuperset }")
- ("oplus" "{ @Sym circleplus }")
- ("otimes" "{ @Sym circlemultiply }")
- ("perp" "{ @Sym perpendicular }")
- ("mid" "{ @Sym bar }")
- ("lceil" "{ @Sym bracketlefttp }")
- ("rceil" "{ @Sym bracketrighttp }")
- ("lfloor" "{ @Sym bracketleftbt }")
- ("rfloor" "{ @Sym bracketrightbt }")
- ("langle" "{ @Sym angleleft }")
- ("rangle" "{ @Sym angleright }")
+ ("sim" ,(sym "similar"))
+ ("cong" ,(sym "congruent"))
+ ("approx" ,(sym "approxequal"))
+ ("neq" ,(sym "notequal"))
+ ("equiv" ,(sym "equivalence"))
+ ("le" ,(sym "lessequal"))
+ ("ge" ,(sym "greaterequal"))
+ ("subset" ,(sym "propersubset"))
+ ("supset" ,(sym "propersuperset"))
+ ("subseteq" ,(sym "reflexsubset"))
+ ("supseteq" ,(sym "reflexsuperset"))
+ ("oplus" ,(sym "circleplus"))
+ ("otimes" ,(sym "circlemultiply"))
+ ("perp" ,(sym "perpendicular"))
+ ("mid" ,(sym "bar"))
+ ("lceil" ,(sym "bracketlefttp"))
+ ("rceil" ,(sym "bracketrighttp"))
+ ("lfloor" ,(sym "bracketleftbt"))
+ ("rfloor" ,(sym "bracketrightbt"))
+ ("langle" ,(sym "angleleft"))
+ ("rangle" ,(sym "angleright"))
;; Misc
("loz" "{ @Lozenge }")
- ("spades" "{ @Sym spade }")
- ("clubs" "{ @Sym club }")
- ("hearts" "{ @Sym heart }")
- ("diams" "{ @Sym diamond }")
+ ("spades" ,(sym "spade"))
+ ("clubs" ,(sym "club"))
+ ("hearts" ,(sym "heart"))
+ ("diams" ,(sym "diamond"))
("euro" "{ @Euro }")
;; Lout
("dag" "{ @Dagger }")
@@ -692,6 +692,11 @@
(source-type-color "#00cf00"))
:symbol-table (lout-symbol-table
+ (lambda (m)
+ ;; We don't use `@Sym' because it doesn't
+ ;; work within `@Eq'.
+ (string-append "{ { Symbol Base } @Font "
+ "@Char \"" m "\" }"))
(lambda (m)
(format #f "@Eq { ~a }\n" m)))))
@@ -2315,6 +2320,8 @@
;; option trick. FIXME: This would be much more efficient if
;; `ast-parent' would work as expected.
+;; FIXME: See whether `@II' can be useful. Use SRFI-39 parameters.
+
(markup-writer 'it
:before (lambda (node engine)
(let ((bold-children (search-down (lambda (n)
--
cgit v1.2.3
From c08a39d53562e20e9f3914ecad4b737a4a92abfe Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Mon, 20 Feb 2006 17:08:04 +0000
Subject: `eq': Added `eq:in', `eq:notin' and their Lout writers.
* src/guile/skribilo/package/eq.scm (%symbols): New.
(make-fast-member-predicate): New.
(known-operator?): New.
(known-symbol?): New.
(equation-markup?): New.
(eq:symbols->strings): When EQUATION is a symbol, check whether it is
KNOWN-SYMBOL?.
(eq:in): New markup
(eq:notin): New markup.
* src/guile/skribilo/package/eq/lout.scm (binary-lout-markup-writer):
New.
(eq:in): New writer.
(eq:notin): New writer.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-53
---
src/guile/skribilo/package/eq.scm | 49 ++++++++++++++++++++++++++++++++--
src/guile/skribilo/package/eq/lout.scm | 38 +++++++++++++++-----------
2 files changed, 70 insertions(+), 17 deletions(-)
(limited to 'src')
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 410f04f..058320f 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -51,13 +51,54 @@
;;;
(define %operators
- '(/ * + - = != ~= < > <= >= sqrt expt sum product script))
+ '(/ * + - = != ~= < > <= >= sqrt expt sum product script in notin))
+
+(define %symbols
+ ;; A set of symbols that are automatically recognized within an `eq' quoted
+ ;; list.
+ '(;; lower-case Greek
+ alpha beta gamma delta epsilon zeta eta theta iota kappa
+ lambda mu nu xi omicron pi rho sigma tau upsilon phi chi omega
+
+ ;; upper-case Greek
+ Alpha Beta Gamma Delta Epsilon Zeta Eta Theta Iota Kappa
+ Lambda Mu Nu Xi Omicron Pi Rho Sigma Tau Upsilon Phi Chi Omega
+
+ ;; Hebrew
+ alef
+
+ ;; mathematics
+ ellipsis weierp image real forall partial exists
+ emptyset infinity in notin nabla nipropto angle and or cap cup
+ sim cong approx neq equiv le ge subset supset subseteq supseteq
+ oplus otimes perp mid lceil rceil lfloor rfloor langle rangle))
(define %rebindings
(map (lambda (sym)
(list sym (symbol-append 'eq: sym)))
%operators))
+(define (make-fast-member-predicate lst)
+ (let ((h (make-hash-table)))
+ ;; initialize a hash table equivalent to LST
+ (for-each (lambda (s) (hashq-set! h s #t)) lst)
+
+ ;; the run-time, fast, definition
+ (lambda (sym)
+ (hashq-ref h sym #f))))
+
+(define-public known-operator? (make-fast-member-predicate %operators))
+(define-public known-symbol? (make-fast-member-predicate %symbols))
+
+(define-public (equation-markup? m)
+ "Return true if @var{m} is an instance of one of the equation sub-markups."
+ (define eq-sym?
+ (make-fast-member-predicate (map (lambda (s)
+ (symbol-append 'eq: s))
+ %operators)))
+ (and (markup? m)
+ (eq-sym? (markup-markup m))))
+
(define (eq:symbols->strings equation)
"Turn symbols located in non-@code{car} positions into strings."
@@ -67,7 +108,9 @@
(cons (car equation) ;; XXX: not tail-recursive
(map eq:symbols->strings (cdr equation)))))
((symbol? equation)
- (symbol->string equation))
+ (if (known-symbol? equation)
+ `(symbol ,(symbol->string equation))
+ (symbol->string equation)))
(else equation)))
(define-public (eq-evaluate equation)
@@ -138,6 +181,8 @@
(options (the-options opts))
(body (the-body opts))))
+(define-simple-markup eq:in)
+(define-simple-markup eq:notin)
;;;
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index 30a6d39..6469bea 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -120,21 +120,29 @@
(simple-lout-markup-writer <=)
(simple-lout-markup-writer >=)
-(markup-writer 'eq:expt (find-engine 'lout)
- :action (lambda (node engine)
- (let ((body (markup-body node)))
- (if (= (length body) 2)
- (let ((base (car body))
- (expt (cadr body)))
- (display " { { ")
- (if (markup? base) (display "("))
- (output base engine)
- (if (markup? base) (display ")"))
- (display " } sup { ")
- (output expt engine)
- (display " } } "))
- (skribe-error 'eq:expt "wrong number of arguments"
- body)))))
+(define-macro (binary-lout-markup-writer sym lout-name)
+ `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((body (markup-body node)))
+ (if (= (length body) 2)
+ (let* ((first (car body))
+ (second (cadr body))
+ (parentheses? (equation-markup? first)))
+ (display " { { ")
+ (if parentheses? (display "("))
+ (output first engine)
+ (if parentheses? (display ")"))
+ (display ,(string-append " } " lout-name " { "))
+ (output second engine)
+ (display " } } "))
+ (skribe-error ,(symbol-append 'eq: sym)
+ "wrong number of arguments"
+ body))))))
+
+(binary-lout-markup-writer expt "sup")
+(binary-lout-markup-writer in "element")
+(binary-lout-markup-writer notin "notelement")
+
--
cgit v1.2.3
From 716e3a477583ff7680b5188a60395fd2e4b150c3 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Tue, 21 Feb 2006 18:23:46 +0000
Subject: `eq': added the `apply' markup.
* src/guile/skribilo/package/eq.scm (%operators): Added `apply'.
(eq:apply): New markup.
* src/guile/skribilo/package/eq/lout.scm (eq:apply): New writer.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-54
---
src/guile/skribilo/package/eq.scm | 24 +++++++++++++++++++++++-
src/guile/skribilo/package/eq/lout.scm | 14 ++++++++++++++
2 files changed, 37 insertions(+), 1 deletion(-)
(limited to 'src')
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm
index 058320f..687a3f5 100644
--- a/src/guile/skribilo/package/eq.scm
+++ b/src/guile/skribilo/package/eq.scm
@@ -51,7 +51,8 @@
;;;
(define %operators
- '(/ * + - = != ~= < > <= >= sqrt expt sum product script in notin))
+ '(/ * + - = != ~= < > <= >= sqrt expt sum product script
+ in notin apply))
(define %symbols
;; A set of symbols that are automatically recognized within an `eq' quoted
@@ -184,6 +185,27 @@
(define-simple-markup eq:in)
(define-simple-markup eq:notin)
+(define-markup (eq:apply :rest opts :key (ident #f) (class "eq:apply"))
+ ;; This markup may receive either a list of arguments or arguments
+ ;; compatible with the real `apply'. Note: the real `apply' can take N
+ ;; non-list arguments but the last one has to be a list.
+ (new markup
+ (markup 'eq:apply)
+ (ident (or ident (symbol->string (gensym "eq:apply"))))
+ (options (the-options opts))
+ (body (let loop ((body (the-body opts))
+ (result '()))
+ (if (null? body)
+ (reverse! result)
+ (let ((first (car body)))
+ (if (list? first)
+ (if (null? (cdr body))
+ (append (reverse! result) first)
+ (skribe-error 'eq:apply
+ "wrong argument type"
+ body))
+ (loop (cdr body) (cons first result)))))))))
+
;;;
;;; Text-only implementation.
diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm
index 6469bea..bd2ccf4 100644
--- a/src/guile/skribilo/package/eq/lout.scm
+++ b/src/guile/skribilo/package/eq/lout.scm
@@ -143,6 +143,20 @@
(binary-lout-markup-writer in "element")
(binary-lout-markup-writer notin "notelement")
+(markup-writer 'eq:apply (find-engine 'lout)
+ :action (lambda (node engine)
+ (let ((func (car (markup-body node))))
+ (output func engine)
+ (display "(")
+ (let loop ((operands (cdr (markup-body node))))
+ (if (null? operands)
+ #t
+ (begin
+ (output (car operands) engine)
+ (if (not (null? (cdr operands)))
+ (display ", "))
+ (loop (cdr operands)))))
+ (display ")"))))
--
cgit v1.2.3