diff options
| -rw-r--r-- | src/guile/skribe/configure.scm | 112 | ||||
| -rw-r--r-- | src/guile/skribe/reader.scm | 136 | ||||
| -rw-r--r-- | src/guile/skribe/types.scm | 314 | ||||
| -rw-r--r-- | src/guile/skribe/vars.scm | 82 | ||||
| -rwxr-xr-x | src/guile/skribilo.scm | 68 | ||||
| -rw-r--r-- | src/guile/skribilo/Makefile.in (renamed from src/guile/skribe/Makefile.in) | 0 | ||||
| -rw-r--r-- | src/guile/skribilo/biblio.scm (renamed from src/guile/skribe/biblio.scm) | 120 | ||||
| -rw-r--r-- | src/guile/skribilo/color.scm (renamed from src/guile/skribe/color.scm) | 2 | ||||
| -rw-r--r-- | src/guile/skribilo/coloring/c-lex.l (renamed from src/guile/skribe/c-lex.l) | 0 | ||||
| -rw-r--r-- | src/guile/skribilo/coloring/c.scm (renamed from src/guile/skribe/c.scm) | 2 | ||||
| -rw-r--r-- | src/guile/skribilo/coloring/lisp-lex.l (renamed from src/guile/skribe/lisp-lex.l) | 0 | ||||
| -rw-r--r-- | src/guile/skribilo/coloring/lisp.scm (renamed from src/guile/skribe/lisp.scm) | 2 | ||||
| -rw-r--r-- | src/guile/skribilo/coloring/xml-lex.l (renamed from src/guile/skribe/xml-lex.l) | 0 | ||||
| -rw-r--r-- | src/guile/skribilo/coloring/xml.scm (renamed from src/guile/skribe/xml.scm) | 4 | ||||
| -rw-r--r-- | src/guile/skribilo/config.scm.in | 21 | ||||
| -rw-r--r-- | src/guile/skribilo/debug.scm (renamed from src/guile/skribe/debug.scm) | 89 | ||||
| -rw-r--r-- | src/guile/skribilo/engine.scm (renamed from src/guile/skribe/engine.scm) | 134 | ||||
| -rw-r--r-- | src/guile/skribilo/eval.scm (renamed from src/guile/skribe/eval.scm) | 113 | ||||
| -rw-r--r-- | src/guile/skribilo/lib.scm (renamed from src/guile/skribe/lib.scm) | 164 | ||||
| -rw-r--r-- | src/guile/skribilo/module.scm | 118 | ||||
| -rw-r--r-- | src/guile/skribilo/output.scm (renamed from src/guile/skribe/output.scm) | 6 | ||||
| -rw-r--r-- | src/guile/skribilo/prog.scm (renamed from src/guile/skribe/prog.scm) | 0 | ||||
| -rw-r--r-- | src/guile/skribilo/reader.scm | 82 | ||||
| -rw-r--r-- | src/guile/skribilo/reader/skribe.scm | 80 | ||||
| -rw-r--r-- | src/guile/skribilo/resolve.scm (renamed from src/guile/skribe/resolve.scm) | 8 | ||||
| -rw-r--r-- | src/guile/skribilo/runtime.scm (renamed from src/guile/skribe/runtime.scm) | 316 | ||||
| -rw-r--r-- | src/guile/skribilo/skribe/api.scm | 1260 | ||||
| -rw-r--r-- | src/guile/skribilo/skribe/bib.scm | 215 | ||||
| -rw-r--r-- | src/guile/skribilo/skribe/index.scm | 149 | ||||
| -rw-r--r-- | src/guile/skribilo/skribe/param.scm | 93 | ||||
| -rw-r--r-- | src/guile/skribilo/skribe/sui.scm | 187 | ||||
| -rw-r--r-- | src/guile/skribilo/skribe/utils.scm | 259 | ||||
| -rw-r--r-- | src/guile/skribilo/source.scm (renamed from src/guile/skribe/source.scm) | 2 | ||||
| -rw-r--r-- | src/guile/skribilo/types.scm | 315 | ||||
| -rw-r--r-- | src/guile/skribilo/vars.scm | 65 | ||||
| -rw-r--r-- | src/guile/skribilo/verify.scm (renamed from src/guile/skribe/verify.scm) | 12 | ||||
| -rw-r--r-- | src/guile/skribilo/writer.scm (renamed from src/guile/skribe/writer.scm) | 8 |
37 files changed, 3399 insertions, 1139 deletions
diff --git a/src/guile/skribe/configure.scm b/src/guile/skribe/configure.scm deleted file mode 100644 index 36b6540..0000000 --- a/src/guile/skribe/configure.scm +++ /dev/null @@ -1,112 +0,0 @@ -;;;; -;;;; configure.stk -- Skribe configuration options -;;;; -;;;; Copyright © 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: 10-Feb-2004 11:47 (eg) -;;;; Last file update: 17-Feb-2004 09:43 (eg) -;;;; - -(define-module (skribe configure) - :export (skribe-release skribe-scheme skribe-url - skribe-doc-dir skribe-ext-dir skribe-default-path - - skribe-configure skribe-enforce-configure)) - -(define (skribe-release) - "1.2d/skribilo") - -(define (skribe-scheme) - "Guile") - -(define (skribe-url) - "http://www.google.com") - -;; FIXME: The directory names should be defined at installation time. - -(define (skribe-doc-dir) - "/usr/share/doc/skribilo") - -(define (skribe-ext-dir) - "/usr/share/skribilo/ext") - -(define (skribe-default-path) - "/usr/share/skribe/") - - -(define %skribe-conf - `((:release ,(skribe-release)) - (:scheme ,(skribe-scheme)) - (:url ,(skribe-url)) - (:doc-dir ,(skribe-doc-dir)) - (:ext-dir ,(skribe-ext-dir)) - (:default-path ,(skribe-default-path)))) - -;;; -;;; SKRIBE-CONFIGURE -;;; -(define (skribe-configure . opt) - (let ((conf %skribe-conf)) - (cond - ((null? opt) - conf) - ((null? (cdr opt)) - (let ((cell (assq (car opt) conf))) - (if (pair? cell) - (cadr cell) - 'void))) - (else - (let loop ((opt opt)) - (cond - ((null? opt) - #t) - ((not (keyword? (car opt))) - #f) - ((or (null? (cdr opt)) (keyword? (cadr opt))) - #f) - (else - (let ((cell (assq (car opt) conf))) - (if (and (pair? cell) - (if (procedure? (cadr opt)) - ((cadr opt) (cadr cell)) - (equal? (cadr opt) (cadr cell)))) - (loop (cddr opt)) - #f))))))))) -;;; -;;; SKRIBE-ENFORCE-CONFIGURE ... -;;; -(define (skribe-enforce-configure . opt) - (let loop ((o opt)) - (when (pair? o) - (cond - ((or (not (keyword? (car o))) - (null? (cdr o))) - (skribe-error 'skribe-enforce-configure "Illegal enforcement" opt)) - ((skribe-configure (car o) (cadr o)) - (loop (cddr o))) - (else - (skribe-error 'skribe-enforce-configure - (format "Configuration mismatch: ~a" (car o)) - (if (procedure? (cadr o)) - (format "provided `~a'" - (skribe-configure (car o))) - (format "provided `~a', required `~a'" - (skribe-configure (car o)) - (cadr o))))))))) diff --git a/src/guile/skribe/reader.scm b/src/guile/skribe/reader.scm deleted file mode 100644 index bd38562..0000000 --- a/src/guile/skribe/reader.scm +++ /dev/null @@ -1,136 +0,0 @@ -;;;; -;;;; reader.stk -- Reader hook for the open bracket -;;;; -;;;; Copyright (C) 2001-2003 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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@unice.fr] -;;;; Creation date: 6-Dec-2001 22:59 (eg) -;;;; Last file update: 28-Feb-2004 10:22 (eg) -;;;; - -;; Examples of ISO-2022-JP (here for cut'n paste tests, since my japanese -;; is *very* limited ;-). -;; -;; "Japan" $BF|K\(B -;; "China and Chinese music" $BCf9q$HCf9q$N2;3Z(B - - -;; -;; This function is a hook for the standard reader. After defining, -;; %read-bracket, the reader calls it when it encounters an open -;; bracket - - -(define (%read-bracket in) - - (define (read-japanese in) - ;; This function reads an ISO-2022-JP sequence. Susch s sequence is coded - ;; as "^[$B......^[(B" . When entering in this function the current - ;; character is 'B' (the opening sequence one). Function reads until the - ;; end of the sequence and return it as a string - (read-char in) ;; to skip the starting #\B - (let ((res (open-output-string))) - (let Loop ((c (peek-char in))) - (cond - ((eof-object? c) ;; EOF - (error '%read-bracket "EOF encountered")) - ((char=? c #\escape) - (read-char in) - (let ((next1 (peek-char in))) - (if (char=? next1 #\() - (begin - (read-char in) - (let ((next2 (peek-char in))) - (if (char=? next2 #\B) - (begin - (read-char in) - (format "\033$B~A\033(B" (get-output-string res))) - (begin - (format res "\033~A" next1) - (Loop next2))))) - (begin - (display #\escape res) - (Loop next1))))) - (else (display (read-char in) res) - (Loop (peek-char in))))))) - ;; - ;; Body of %read-bracket starts here - ;; - (let ((out (open-output-string)) - (res '()) - (in-string? #f)) - - (read-char in) ; skip open bracket - - (let Loop ((c (peek-char in))) - (cond - ((eof-object? c) ;; EOF - (error '%read-bracket "EOF encountered")) - - ((char=? c #\escape) ;; ISO-2022-JP string? - (read-char in) - (let ((next1 (peek-char in))) - (if (char=? next1 #\$) - (begin - (read-char in) - (let ((next2 (peek-char in))) - (if (char=? next2 #\B) - (begin - (set! res - (append! res - (list (get-output-string out) - (list 'unquote - (list 'jp - (read-japanese in)))))) - (set! out (open-output-string))) - (format out "\033~A" next1)))) - (display #\escape out))) - (Loop (peek-char in))) - - ((char=? c #\\) ;; Quote char - (read-char in) - (display (read-char in) out) - (Loop (peek-char in))) - - ((and (not in-string?) (char=? c #\,)) ;; Comma - (read-char in) - (let ((next (peek-char in))) - (if (char=? next #\() - (begin - (set! res (append! res (list (get-output-string out) - (list 'unquote - (read in))))) - (set! out (open-output-string))) - (display #\, out)) - (Loop (peek-char in)))) - - ((and (not in-string?) (char=? c #\[)) ;; Open bracket - (display (%read-bracket in) out) - (Loop (peek-char in))) - - ((and (not in-string?) (char=? c #\])) ;; Close bracket - (read-char in) - (let ((str (get-output-string out))) - (list 'quasiquote - (append! res (if (string=? str "") '() (list str)))))) - - (else (when (char=? c #\") (set! in-string? (not in-string?))) - (display (read-char in) out) - (Loop (peek-char in))))))) - diff --git a/src/guile/skribe/types.scm b/src/guile/skribe/types.scm deleted file mode 100644 index 2ec7318..0000000 --- a/src/guile/skribe/types.scm +++ /dev/null @@ -1,314 +0,0 @@ -;;;; -;;;; types.stk -- Definition of Skribe classes -;;;; -;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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: 12-Aug-2003 22:18 (eg) -;;;; Last file update: 28-Oct-2004 16:18 (eg) -;;;; - -(define-module (skribe types) ;; FIXME: Why should it be a separate module? - :export (<ast> ast? ast-loc ast-loc-set! - <command> command? command-fmt command-body - <unresolved> unresolved? unresolved-proc - <handle> handle? handle-ast - <node> node? node-options node-loc - <engine> engine? engine-ident engine-format engine-customs - engine-filter engine-symbol-table - <writer> writer? write-object - <processor> processor? processor-combinator processor-engine - <markup> markup? bind-markup! markup-options is-markup? - markup-body find-markups write-object - <container> container? container-options - container-ident container-body - <document> document? document-ident document-body - document-options document-end - <language> language? - <location> location? ast-location - - *node-table*) - :use-module (oop goops)) - -(define *node-table* (make-hash-table)) - ; Used to stores the nodes of an AST. - ; It permits to retrieve a node from its - ; identifier. - - -;;;; ====================================================================== -;;;; -;;;; <AST> -;;;; -;;;; ====================================================================== -;;FIXME: set! location in <ast> -(define-class <ast> () - (parent :accessor ast-parent :init-keyword :parent :init-form 'unspecified) - (loc :init-form #f)) - -(define (ast? obj) (is-a? obj <ast>)) -(define (ast-loc obj) (slot-ref obj 'loc)) -(define (ast-loc-set! obj v) (slot-set! obj 'loc v)) - -;;;; ====================================================================== -;;;; -;;;; <COMMAND> -;;;; -;;;; ====================================================================== -(define-class <command> (<ast>) - (fmt :init-keyword :fmt) - (body :init-keyword :body)) - -(define (command? obj) (is-a? obj <command>)) -(define (command-fmt obj) (slot-ref obj 'fmt)) -(define (command-body obj) (slot-ref obj 'body)) - -;;;; ====================================================================== -;;;; -;;;; <UNRESOLVED> -;;;; -;;;; ====================================================================== -(define-class <unresolved> (<ast>) - (proc :init-keyword :proc)) - -(define (unresolved? obj) (is-a? obj <unresolved>)) -(define (unresolved-proc obj) (slot-ref obj 'proc)) - -;;;; ====================================================================== -;;;; -;;;; <HANDLE> -;;;; -;;;; ====================================================================== -(define-class <handle> (<ast>) - (ast :init-keyword :ast :init-form #f :getter handle-ast)) - -(define (handle? obj) (is-a? obj <handle>)) -(define (handle-ast obj) (slot-ref obj 'ast)) - -;;;; ====================================================================== -;;;; -;;;; <ENGINE> -;;;; -;;;; ====================================================================== -(define-class <engine> () - (ident :init-keyword :ident :init-form '???) - (format :init-keyword :format :init-form "raw") - (info :init-keyword :info :init-form '()) - (version :init-keyword :version :init-form 'unspecified) - (delegate :init-keyword :delegate :init-form #f) - (writers :init-keyword :writers :init-form '()) - (filter :init-keyword :filter :init-form #f) - (customs :init-keyword :custom :init-form '()) - (symbol-table :init-keyword :symbol-table :init-form '())) - - - - -(define (engine? obj) - (is-a? obj <engine>)) - -(define (engine-ident obj) ;; Define it here since the doc searches it - (slot-ref obj 'ident)) - -(define (engine-format obj) ;; Define it here since the doc searches it - (slot-ref obj 'format)) - -(define (engine-customs obj) ;; Define it here since the doc searches it - (slot-ref obj 'customs)) - -(define (engine-filter obj) ;; Define it here since the doc searches it - (slot-ref obj 'filter)) - -(define (engine-symbol-table obj) ;; Define it here since the doc searches it - (slot-ref obj 'symbol-table)) - -;;;; ====================================================================== -;;;; -;;;; <WRITER> -;;;; -;;;; ====================================================================== -(define-class <writer> () - (ident :init-keyword :ident :init-form '??? :getter writer-ident) - (class :init-keyword :class :init-form 'unspecified - :getter writer-class) - (pred :init-keyword :pred :init-form 'unspecified) - (upred :init-keyword :upred :init-form 'unspecified) - (options :init-keyword :options :init-form '() :getter writer-options) - (verified? :init-keyword :verified? :init-form #f) - (validate :init-keyword :validate :init-form #f) - (before :init-keyword :before :init-form #f :getter writer-before) - (action :init-keyword :action :init-form #f :getter writer-action) - (after :init-keyword :after :init-form #f :getter writer-after)) - -(define (writer? obj) - (is-a? obj <writer>)) - -(define-method (write-object (obj <writer>) port) - (format port "#[~A (~A) ~A]" - (class-name (class-of obj)) - (slot-ref obj 'ident) - (address-of obj))) - -;;;; ====================================================================== -;;;; -;;;; <NODE> -;;;; -;;;; ====================================================================== -(define-class <node> (<ast>) - (required-options :init-keyword :required-options :init-form '()) - (options :init-keyword :options :init-form '()) - (body :init-keyword :body :init-form #f - :getter node-body)) - -(define (node? obj) (is-a? obj <node>)) -(define (node-options obj) (slot-ref obj 'options)) -(define node-loc ast-loc) - - -;;;; ====================================================================== -;;;; -;;;; <PROCESSOR> -;;;; -;;;; ====================================================================== -(define-class <processor> (<node>) - (combinator :init-keyword :combinator :init-form (lambda (e1 e2) e1)) - (engine :init-keyword :engine :init-form 'unspecified) - (procedure :init-keyword :procedure :init-form (lambda (n e) n))) - -(define (processor? obj) (is-a? obj <processor>)) -(define (processor-combinator obj) (slot-ref obj 'combinator)) -(define (processor-engine obj) (slot-ref obj 'engine)) - -;;;; ====================================================================== -;;;; -;;;; <MARKUP> -;;;; -;;;; ====================================================================== -(define-class <markup> (<node>) - (ident :init-keyword :ident :getter markup-ident :init-form #f) - (class :init-keyword :class :getter markup-class :init-form #f) - (markup :init-keyword :markup :getter markup-markup)) - - -(define (bind-markup! node) - (hash-set! *node-table* - (markup-ident node) - ;(lambda (cur) (cons node cur)) - (list node))) - - -(define-method (initialize (self <markup>) initargs) - (next-method) - (bind-markup! self)) - - -(define (markup? obj) (is-a? obj <markup>)) -(define (markup-options obj) (slot-ref obj 'options)) -(define markup-body node-body) - - -(define (is-markup? obj markup) - (and (is-a? obj <markup>) - (eq? (slot-ref obj 'markup) markup))) - - - -(define (find-markups ident) - (hash-ref *node-table* ident #f)) - - -(define-method (write-object (obj <markup>) port) - (format port "#[~A (~A/~A) ~A]" - (class-name (class-of obj)) - (slot-ref obj 'markup) - (slot-ref obj 'ident) - (address-of obj))) - -;;;; ====================================================================== -;;;; -;;;; <CONTAINER> -;;;; -;;;; ====================================================================== -(define-class <container> (<markup>) - (env :init-keyword :env :init-form '())) - -(define (container? obj) (is-a? obj <container>)) -(define (container-env obj) (slot-ref obj 'env)) -(define container-options markup-options) -(define container-ident markup-ident) -(define container-body node-body) - - - -;;;; ====================================================================== -;;;; -;;;; <DOCUMENT> -;;;; -;;;; ====================================================================== -(define-class <document> (<container>)) - -(define (document? obj) (is-a? obj <document>)) -(define (document-ident obj) (slot-ref obj 'ident)) -(define (document-body obj) (slot-ref obj 'body)) -(define document-options markup-options) -(define document-env container-env) - - - -;;;; ====================================================================== -;;;; -;;;; <LANGUAGE> -;;;; -;;;; ====================================================================== -(define-class <language> () - (name :init-keyword :name :init-form #f :getter langage-name) - (fontifier :init-keyword :fontifier :init-form #f :getter langage-fontifier) - (extractor :init-keyword :extractor :init-form #f :getter langage-extractor)) - -(define (language? obj) - (is-a? obj <language>)) - - -;;;; ====================================================================== -;;;; -;;;; <LOCATION> -;;;; -;;;; ====================================================================== -(define-class <location> () - (file :init-keyword :file :getter location-file) - (pos :init-keyword :pos :getter location-pos) - (line :init-keyword :line :getter location-line)) - -(define (location? obj) - (is-a? obj <location>)) - -(define (ast-location obj) - (let ((loc (slot-ref obj 'loc))) - (if (location? loc) - (let* ((fname (location-file loc)) - (line (location-line loc)) - (pwd (getcwd)) - (len (string-length pwd)) - (lenf (string-length fname)) - (file (if (and (substring=? pwd fname len) - (> lenf len)) - (substring fname len (+ 1 (string-length fname))) - fname))) - (format "~a, line ~a" file line)) - "no source location"))) diff --git a/src/guile/skribe/vars.scm b/src/guile/skribe/vars.scm deleted file mode 100644 index d78439c..0000000 --- a/src/guile/skribe/vars.scm +++ /dev/null @@ -1,82 +0,0 @@ -;;;; -;;;; vars.stk -- Skribe Globals -;;;; -;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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: 11-Aug-2003 16:18 (eg) -;;;; Last file update: 26-Feb-2004 20:36 (eg) -;;;; - - -;;; -;;; Switches -;;; -(define *skribe-verbose* 0) -(define *skribe-warning* 5) -(define *load-rc* #t) - -;;; -;;; PATH variables -;;; -(define *skribe-path* #f) -(define *skribe-bib-path* '(".")) -(define *skribe-source-path* '(".")) -(define *skribe-image-path* '(".")) - - -(define *skribe-rc-directory* - (make-path (getenv "HOME") ".skribe")) - - -;;; -;;; In and out ports -;;; -(define *skribe-src* '()) -(define *skribe-dest* #f) - -;;; -;;; Engine -;;; -(define *skribe-engine* 'html) ;; Use HTML by default - -;;; -;;; Misc -;;; -(define *skribe-chapter-split* '()) -(define *skribe-ref-base* #f) -(define *skribe-convert-image* #f) ;; i.e. use the Skribe standard converter -(define *skribe-variants* '()) - - - - -;;; Forward definitions (to avoid warnings when compiling Skribe) -;;; This is a KLUDGE. -(define mark #f) -(define ref #f) -;;(define invoke 3) -(define lookup-markup-writer #f) - -; (define-module SKRIBE-ENGINE-MODULE -; (define find-engine #f)) - -; (define-module SKRIBE-OUTPUT-MODULE) - -; (define-module SKRIBE-RUNTIME-MODULE) diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm index e766830..c352f7f 100755 --- a/src/guile/skribilo.scm +++ b/src/guile/skribilo.scm @@ -6,26 +6,26 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" ;;;; ;;;; skribilo.scm -;;;; +;;;; ;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> ;;;; Copyright 2005 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, +;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;;; USA. -;;;; +;;;; ;;;; Author: Erick Gallesio [eg@essi.fr] ;;;; Creation date: 24-Jul-2003 20:33 (eg) ;;;; Last file update: 6-Mar-2004 16:13 (eg) @@ -65,21 +65,21 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" the-arg)))))))) ; (use-modules (skribe eval) -; (skribe configure) -; (skribe runtime) -; (skribe engine) -; (skribe writer) -; (skribe verify) -; (skribe output) -; (skribe biblio) -; (skribe prog) -; (skribe resolve) -; (skribe source) -; (skribe lisp) -; (skribe xml) -; (skribe c) -; (skribe debug) -; (skribe color)) +; (skribe configure) +; (skribe runtime) +; (skribe engine) +; (skribe writer) +; (skribe verify) +; (skribe output) +; (skribe biblio) +; (skribe prog) +; (skribe resolve) +; (skribe source) +; (skribe lisp) +; (skribe xml) +; (skribe c) +; (skribe debug) +; (skribe color)) (use-modules (skribe runtime) (skribe configure) @@ -192,7 +192,7 @@ specifications." (set-skribe-debug! val) (begin ;; Use the symbol for debug - (set-skribe-debug! 1) + (set-skribe-debug! 1) (add-skribe-debug-symbol (string->symbol level)))))) (("no-color" :help "disable coloring for output") (no-debug-color)) @@ -265,7 +265,7 @@ Processes a Skribilo/Skribe source file and produces its output. (let ((s (keyword->string (car x)))) (printf " ~a: ~a\n" s (cadr x)))) (skribe-configure))) - + ;; ;; parse-args starts here ;; @@ -286,21 +286,21 @@ Processes a Skribilo/Skribe source file and produces its output. (("P" :arg path :help "adds <path> to image path") (skribe-image-path-set! (cons path (skribe-image-path)))) (("split-chapters" :alternate "C" :arg chapter - :help "emit chapter's sections in separate files") + :help "emit chapter's sections in separate files") (set! *skribe-chapter-split* (cons chapter *skribe-chapter-split*))) (("preload" :arg file :help "preload <file>") (set! *skribe-preload* (cons file *skribe-preload*))) (("use-variant" :alternate "u" :arg variant - :help "use <variant> output format") + :help "use <variant> output format") (set! *skribe-variants* (cons variant *skribe-variants*))) (("base" :alternate "b" :arg base - :help "base prefix to remove from hyperlinks") + :help "base prefix to remove from hyperlinks") (set! *skribe-ref-base* base)) (("rc-dir" :arg dir :alternate "d" :help "set the RC directory to <dir>") (set! *skribe-rc-directory* dir)) - + "File options:" - (("no-init-file" :help "Dont load rc Skribe file") + (("no-init-file" :help "Dont load rc Skribe file") (set! *load-rc* #f)) (("output" :alternate "o" :arg file :help "set the output to <file>") (set! *skribe-dest* file) @@ -310,7 +310,7 @@ Processes a Skribilo/Skribe source file and produces its output. (set! *skribe-engine* (cdr c))))) "Misc:" - (("help" :alternate "h" :help "provides help for the command") + (("help" :alternate "h" :help "provides help for the command") (arg-usage (current-error-port)) (exit 0)) (("options" :help "display the skribe options and exit") @@ -320,7 +320,7 @@ Processes a Skribilo/Skribe source file and produces its output. (version) (exit 0)) (("query" :alternate "q" - :help "displays informations about Skribe conf.") + :help "displays informations about Skribe conf.") (query) (exit 0)) (("verbose" :alternate "v" :arg level @@ -339,7 +339,7 @@ Processes a Skribilo/Skribe source file and produces its output. (set-skribe-debug! val) (begin ;; Use the symbol for debug - (set-skribe-debug! 1) + (set-skribe-debug! 1) (add-skribe-debug-symbol (string->symbol level)))))) (("no-color" :help "disable coloring for output") (no-debug-color)) @@ -356,10 +356,10 @@ Processes a Skribilo/Skribe source file and produces its output. (lambda () (eval (read))))) (else (set! *skribe-src* other-arguments))) - + ;; we have to configure Skribe path according to the environment variable (skribe-path-set! (append (let ((path (getenv "SKRIBEPATH"))) - (if path + (if path (string-split path ":") '())) (reverse! paths) diff --git a/src/guile/skribe/Makefile.in b/src/guile/skribilo/Makefile.in index 80a26de..80a26de 100644 --- a/src/guile/skribe/Makefile.in +++ b/src/guile/skribilo/Makefile.in diff --git a/src/guile/skribe/biblio.scm b/src/guile/skribilo/biblio.scm index 122a36b..0a4fc98 100644 --- a/src/guile/skribe/biblio.scm +++ b/src/guile/skribilo/biblio.scm @@ -1,51 +1,50 @@ -;;;; -;;;; biblio.scm -- Bibliography functions -;;;; -;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> -;;;; Copyright 2005 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.main.st -;;;; -;;;; Author: Erick Gallesio [eg@essi.fr] -;;;; Creation date: 31-Aug-2003 22:07 (eg) -;;;; Last file update: 28-Oct-2004 21:19 (eg) -;;;; - - - -(define-module (skribe biblio) - :use-module (skribe runtime) +;;; +;;; biblio.scm -- Bibliography functions +;;; +;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;; Copyright 2005 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.main.st +;;; +;;; Author: Erick Gallesio [eg@essi.fr] +;;; Creation date: 31-Aug-2003 22:07 (eg) +;;; Last file update: 28-Oct-2004 21:19 (eg) +;;; + + + +(define-module (skribilo biblio) + :use-module (skribilo runtime) :export (bib-tables? make-bib-table default-bib-table bib-load! resolve-bib resolve-the-bib bib-sort/authors bib-sort/idents bib-sort/dates)) -(define *bib-table* #f) - +(define *bib-table* #f) + ;; Forward declarations (define skribe-open-bib-file #f) -(define parse-bib #f) +(define parse-bib #f) -(include "../common/bib.scm") -;;;; ====================================================================== -;;;; -;;;; Utilities -;;;; -;;;; ====================================================================== + +;;; ====================================================================== +;;; +;;; Utilities +;;; +;;; ====================================================================== (define (make-bib-table ident) (make-hash-table)) @@ -67,11 +66,11 @@ (skribe-line-error (%epair-file entry) (%epair-line entry) who msg entry) (skribe-error who msg entry)))) -;;;; ====================================================================== -;;;; -;;;; BIB-DUPLICATE -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; BIB-DUPLICATE +;;; +;;; ====================================================================== (define (bib-duplicate ident from old) (let ((ofrom (markup-option old 'from))) (skribe-warning 2 @@ -85,11 +84,11 @@ " Ignoring redefinition.")))) -;;;; ====================================================================== -;;;; -;;;; PARSE-BIB -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; PARSE-BIB +;;; +;;; ====================================================================== (define (parse-bib table port) (if (not (bib-table? table)) (skribe-error 'parse-bib "Illegal bibliography table" table) @@ -112,11 +111,11 @@ (%bib-error 'bib-parse entry)))))))) -;;;; ====================================================================== -;;;; -;;;; BIB-ADD! -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; BIB-ADD! +;;; +;;; ====================================================================== (define (bib-add! table . entries) (if (not (bib-table? table)) (skribe-error 'bib-add! "Illegal bibliography table" table) @@ -137,11 +136,11 @@ entries))) -;;;; ====================================================================== -;;;; -;;;; SKRIBE-OPEN-BIB-FILE -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; SKRIBE-OPEN-BIB-FILE +;;; +;;; ====================================================================== ;; FIXME: Factoriser (define (skribe-open-bib-file file command) (let ((path (find-path file *skribe-bib-path*))) @@ -158,4 +157,3 @@ 'bibliography "Can't find bibliography -- " file) #f)))) - diff --git a/src/guile/skribe/color.scm b/src/guile/skribilo/color.scm index 3bca7d9..1e762e6 100644 --- a/src/guile/skribe/color.scm +++ b/src/guile/skribilo/color.scm @@ -24,7 +24,7 @@ ;;;; Last file update: 12-Feb-2004 18:24 (eg) ;;;; -(define-module (skribe color) +(define-module (skribilo color) :export (skribe-color->rgb skribe-get-used-colors skribe-use-color!)) (define *used-colors* '()) diff --git a/src/guile/skribe/c-lex.l b/src/guile/skribilo/coloring/c-lex.l index a5b337e..a5b337e 100644 --- a/src/guile/skribe/c-lex.l +++ b/src/guile/skribilo/coloring/c-lex.l diff --git a/src/guile/skribe/c.scm b/src/guile/skribilo/coloring/c.scm index 7961876..baa3e53 100644 --- a/src/guile/skribe/c.scm +++ b/src/guile/skribilo/coloring/c.scm @@ -26,7 +26,7 @@ (require "lex-rt") ;; to avoid module problems -(define-module (skribe c) +(define-module (skribilo c) :export (c java) :import (skribe runtime)) diff --git a/src/guile/skribe/lisp-lex.l b/src/guile/skribilo/coloring/lisp-lex.l index efad24b..efad24b 100644 --- a/src/guile/skribe/lisp-lex.l +++ b/src/guile/skribilo/coloring/lisp-lex.l diff --git a/src/guile/skribe/lisp.scm b/src/guile/skribilo/coloring/lisp.scm index 30a81fc..53cf670 100644 --- a/src/guile/skribe/lisp.scm +++ b/src/guile/skribilo/coloring/lisp.scm @@ -26,7 +26,7 @@ (require "lex-rt") ;; to avoid module problems -(define-module (skribe lisp) +(define-module (skribilo lisp) :export (skribe scheme stklos bigloo lisp) :import (skribe source)) diff --git a/src/guile/skribe/xml-lex.l b/src/guile/skribilo/coloring/xml-lex.l index 5d9a8d9..5d9a8d9 100644 --- a/src/guile/skribe/xml-lex.l +++ b/src/guile/skribilo/coloring/xml-lex.l diff --git a/src/guile/skribe/xml.scm b/src/guile/skribilo/coloring/xml.scm index 072813f..d71e98c 100644 --- a/src/guile/skribe/xml.scm +++ b/src/guile/skribilo/coloring/xml.scm @@ -28,10 +28,10 @@ ;(require "lex-rt") ;; to avoid module problems -(define-module (skribe xml) +(define-module (skribilo xml) :export (xml)) -(use-modules (skribe source)) +(use-modules (skribilo source)) (include "xml-lex.stk") ;; SILex generated diff --git a/src/guile/skribilo/config.scm.in b/src/guile/skribilo/config.scm.in new file mode 100644 index 0000000..6e40e7f --- /dev/null +++ b/src/guile/skribilo/config.scm.in @@ -0,0 +1,21 @@ +;;; -*- Scheme -*- +;;; + +(define-module (skribilo config)) + +(define-public (skribilo-release) "1.3") +(define-public (skribilo-url) "http://www.laas.fr/~lcourtes/") +(define-public (skribilo-doc-directory) "@SKRIBILO_DOC_DIR@") +(define-public (skribilo-extension-directory) "@SKRIBILO_EXT_DIR@") +(define-public (skribilo-default-path) "@SKRIBILO_SKR_PATH@") +(define-public (skribilo-scheme) "guile") + + +;; Compatibility. + +(define-public skribe-release skribilo-release) +(define-public skribe-url skribilo-url) +(define-public skribe-doc-dir skribilo-doc-directory) +(define-public skribe-ext-dir skribilo-extension-directory) +(define-public skribe-default-path skribilo-default-path) +(define-public skribe-scheme skribilo-scheme) diff --git a/src/guile/skribe/debug.scm b/src/guile/skribilo/debug.scm index e2bff27..1a5478e 100644 --- a/src/guile/skribe/debug.scm +++ b/src/guile/skribilo/debug.scm @@ -1,41 +1,42 @@ -;;;; -;;;; debug.stk -- Debug Facilities (stolen to Manuel Serrano) -;;;; -;;;; -;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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: 10-Aug-2003 20:45 (eg) -;;;; Last file update: 28-Oct-2004 13:16 (eg) -;;;; - - -(define-module (skribe debug) +;;; +;;; debug.scm -- Debug Facilities (stolen to Manuel Serrano) +;;; +;;; +;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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: 10-Aug-2003 20:45 (eg) +;;; Last file update: 28-Oct-2004 13:16 (eg) +;;; + + +(define-module (skribilo debug) :export (with-debug %with-debug debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol no-debug-color)) -(define *skribe-debug* 0) + +(define *skribe-debug* 0) (define *skribe-debug-symbols* '()) -(define *skribe-debug-color* #t) -(define *skribe-debug-item* #f) -(define *debug-port* (current-error-port)) -(define *debug-depth* 0) -(define *debug-margin* "") +(define *skribe-debug-color* #t) +(define *skribe-debug-item* #f) +(define *debug-port* (current-error-port)) +(define *debug-depth* 0) +(define *debug-margin* "") (define *skribe-margin-debug-level* 0) @@ -73,7 +74,7 @@ (with-output-to-string (if (and *skribe-debug-color* (equal? (getenv "TERM") "xterm") - (interactive-port? *debug-port*)) + (interactive-port? *debug-port*)) (lambda () (format #t "[0m[1;~Am" (+ 31 col)) (for-each display o) @@ -91,12 +92,13 @@ ;;; debug-item ;;; (define (debug-item . args) - (when (or (>= *skribe-debug* *skribe-margin-debug-level*) - *skribe-debug-item*) - (display *debug-margin* *debug-port*) - (display (debug-color (- *debug-depth* 1) "- ") *debug-port*) - (for-each (lambda (a) (display a *debug-port*)) args) - (newline *debug-port*))) + (if (or (>= *skribe-debug* *skribe-margin-debug-level*) + *skribe-debug-item*) + (begin + (display *debug-margin* *debug-port*) + (display (debug-color (- *debug-depth* 1) "- ") *debug-port*) + (for-each (lambda (a) (display a *debug-port*)) args) + (newline *debug-port*)))) ;;(define-macro (debug-item . args) ;; `()) @@ -112,7 +114,7 @@ (set! *debug-depth* (- *debug-depth* 1)) (set! *debug-margin* om) res))) - + ;;; ;;; %with-debug ;; @@ -153,8 +155,7 @@ ; (with-debug 0 'foo2.3 ; (debug-item 'foo3.1) ; (with-debug 0 'foo3.2 -; (debug-item 'foo4.1) -; (debug-item 'foo4.2)) +; (debug-item 'foo4.1) +; (debug-item 'foo4.2)) ; (debug-item 'foo3.3)) ; (debug-item 'foo2.4)) - diff --git a/src/guile/skribe/engine.scm b/src/guile/skribilo/engine.scm index 1cac168..9584f5e 100644 --- a/src/guile/skribe/engine.scm +++ b/src/guile/skribilo/engine.scm @@ -1,40 +1,41 @@ -;;;; -;;;; engines.stk -- Skribe Engines Stuff -;;;; -;;;; 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: 24-Jul-2003 20:33 (eg) -;;;; Last file update: 28-Oct-2004 21:21 (eg) -;;;; - -(define-module (skribe engine) - :use-module (skribe debug) -; :use-module (skribe eval) - :use-module (skribe writer) - :use-module (skribe types) +;;; +;;; engine.scm -- Skribe Engines Stuff +;;; +;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;; Copyright 2005 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. +;;; +;;; Author: Erick Gallesio [eg@essi.fr] +;;; Creation date: 24-Jul-2003 20:33 (eg) +;;; Last file update: 28-Oct-2004 21:21 (eg) +;;; + +(define-module (skribilo engine) + :use-module (skribilo debug) +; :use-module (skribilo eval) + :use-module (skribilo writer) + :use-module (skribilo types) :use-module (oop goops) :use-module (ice-9 optargs) - + :export (default-engine default-engine-set! - make-engine copy-engine find-engine + make-engine copy-engine find-engine lookup-engine engine-custom engine-custom-set! engine-format? engine-add-writer! processor-get-engine @@ -43,13 +44,13 @@ -;;; Module definition is split here because this file is read by the documentation -;;; Should be changed. +;;; Module definition is split here because this file is read by the +;;; documentation Should be changed. ;(select-module SKRIBE-ENGINE-MODULE) (define *engines* '()) -(define *default-engine* #f) -(define *default-engines* '()) +(define *default-engine* #f) +(define *default-engines* '()) (define (default-engine) @@ -57,8 +58,8 @@ (define (default-engine-set! e) - (unless (engine? e) - (skribe-error 'default-engine-set! "bad engine ~S" e)) + (if (not (engine? e)) + (skribe-error 'default-engine-set! "bad engine ~S" e)) (set! *default-engine* e) (set! *default-engines* (cons e *default-engines*)) e) @@ -99,16 +100,16 @@ ;;; ;;; MAKE-ENGINE -;;; +;;; (define* (make-engine ident #:key (version 'unspecified) - (format "raw") + (format "raw") (filter #f) (delegate #f) (symbol-table '()) (custom '()) (info '())) (let ((e (make <engine> :ident ident :version version :format format - :filter filter :delegate delegate + :filter filter :delegate delegate :symbol-table symbol-table :custom custom :info info))) ;; store the engine in the global table @@ -126,8 +127,8 @@ (symbol-table #f) (custom #f)) (let ((new (shallow-clone e))) - (slot-set! new 'ident ident) - (slot-set! new 'version version) + (slot-set! new 'ident ident) + (slot-set! new 'version version) (slot-set! new 'filter (or filter (slot-ref e 'filter))) (slot-set! new 'delegate (or delegate (slot-ref e 'delegate))) (slot-set! new 'symbol-table (or symbol-table (slot-ref e 'symbol-table))) @@ -138,17 +139,17 @@ ;;; -;;; FIND-ENGINE +;;; FIND-ENGINE ;;; (define (%find-loaded-engine id version) - (let Loop ((es *engines*)) + (let loop ((es *engines*)) (cond ((null? es) #f) ((eq? (slot-ref (car es) 'ident) id) (cond - ((eq? version 'unspecified) (car es)) + ((eq? version 'unspecified) (car es)) ((eq? version (slot-ref (car es) 'version)) (car es)) - (else (Loop (cdr es))))) + (else (Loop (cdr es))))) (else (loop (cdr es)))))) @@ -165,6 +166,9 @@ (%find-loaded-engine id version)) #f))))) +(define lookup-engine find-engine) + + ;;; ;;; ENGINE-CUSTOM ;;; @@ -194,9 +198,9 @@ (define (check-procedure name proc arity) (cond ((not (procedure? proc)) - (skribe-error ident "Illegal procedure" proc)) + (skribe-error ident "Illegal procedure" proc)) ((not (equal? (%procedure-arity proc) arity)) - (skribe-error ident + (skribe-error ident (format #f "Illegal ~S procedure" name) proc)))) @@ -206,20 +210,20 @@ ;; ;; Engine-add-writer! starts here ;; - (unless (is-a? e <engine>) - (skribe-error ident "Illegal engine" e)) - + (if (not (is-a? e <engine>)) + (skribe-error ident "Illegal engine" e)) + ;; check the options - (unless (or (eq? opt 'all) (list? opt)) - (skribe-error ident "Illegal options" opt)) - + (if (not (or (eq? opt 'all) (list? opt))) + (skribe-error ident "Illegal options" opt)) + ;; check the correctness of the predicate (check-procedure "predicate" pred 2) ;; check the correctness of the validation proc - (when valid + (if valid (check-procedure "validate" valid 2)) - + ;; check the correctness of the three actions (check-output "before" before) (check-output "action" action) @@ -234,16 +238,14 @@ (slot-set! e 'writers (cons n (slot-ref e 'writers))) n)) -;;;; ====================================================================== -;;;; -;;;; I N I T S -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; I N I T S +;;; +;;; ====================================================================== ;; A base engine must pre-exist before anything is loaded. In ;; particular, this dummy base engine is used to load the actual -;; definition of base. +;; definition of base. (make-engine 'base :version 'bootstrap) - - diff --git a/src/guile/skribe/eval.scm b/src/guile/skribilo/eval.scm index 746d763..8bae8ad 100644 --- a/src/guile/skribe/eval.scm +++ b/src/guile/skribilo/eval.scm @@ -1,54 +1,87 @@ -;;;; -;;;; eval.stk -- Skribe Evaluator -;;;; -;;;; 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: 27-Jul-2003 09:15 (eg) -;;;; Last file update: 28-Oct-2004 15:05 (eg) -;;;; +;;; +;;; eval.stk -- Skribe Evaluator +;;; +;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;; Copyright 2005 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. +;;; + ;; FIXME; On peut implémenter maintenant skribe-warning/node -(define-module (skribe eval) +(define-module (skribilo eval) :export (skribe-eval skribe-eval-port skribe-load skribe-load-options - skribe-include)) + skribe-include -(use-modules (skribe debug) - (skribe engine) - (skribe verify) - (skribe resolve) - (skribe output) + run-time-module make-run-time-module)) + +(use-modules (skribilo debug) + (skribilo engine) + (skribilo verify) + (skribilo resolve) + (skribilo output) (ice-9 optargs)) -(define *skribe-loaded* '()) ;; List of already loaded files +(define *skribe-loaded* '()) ;; List of already loaded files (define *skribe-load-options* '()) (define (%evaluate expr) - (with-handler - (lambda (c) - (flush-output-port (current-error-port)) - (raise c)) - (eval expr (find-module 'STklos)))) + (eval expr (current-module))) + + +(define *skribilo-user-module* #f) + +(define *skribilo-user-imports* + '((srfi srfi-1) + (oop goops) + (skribilo module) + (skribilo config) + (skribilo vars) + (skribilo runtime) + (skribilo biblio) + (skribilo lib) + (skribilo resolve))) + + +;;; +;;; MAKE-RUN-TIME-MODULE +;;; +(define (make-run-time-module) + "Return a new module that imports all the necessary bindings required for +execution of Skribilo/Skribe code." + (let ((the-module (make-module))) + (for-each (lambda (iface) + (module-use! the-module (resolve-module iface))) + *skribilo-user-imports*) + (set-module-name! the-module '(skribilo-user)) + the-module)) + +;;; +;;; RUN-TIME-MODULE +;;; +(define (run-time-module) + "Return the default instance of a Skribilo/Skribe run-time module." + (if (not *skribilo-user-module*) + (set! *skribilo-user-module* (make-run-time-module))) + *skribilo-user-module*) ;;; ;;; SKRIBE-EVAL @@ -103,7 +136,7 @@ ((not path) (skribe-path)) ((string? path) (list path)) ((not (and (list? path) (every? string? path))) - (skribe-error 'skribe-load "Illegal path" path)) + (skribe-error 'skribe-load "Illegal path" path)) (else path))) (filep (find-path file path))) @@ -113,7 +146,7 @@ (skribe-error 'skribe-load (format "Cannot find ~S in path" file) *skribe-path*)) - + ;; Load this file if not already done (unless (member filep *skribe-loaded*) (cond diff --git a/src/guile/skribe/lib.scm b/src/guile/skribilo/lib.scm index fa5e962..26b348a 100644 --- a/src/guile/skribe/lib.scm +++ b/src/guile/skribilo/lib.scm @@ -1,31 +1,69 @@ -;;;; -;;;; lib.stk -- Utilities -;;;; -;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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: 11-Aug-2003 20:29 (eg) -;;;; Last file update: 27-Oct-2004 12:41 (eg) -;;;; - -(use-modules (srfi srfi-1)) +;;; +;;; lib.stk -- Utilities +;;; +;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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: 11-Aug-2003 20:29 (eg) +;;; Last file update: 27-Oct-2004 12:41 (eg) +;;; + +(read-set! keywords 'prefix) + +(define-module (skribilo lib) + :export (skribe-eval-location skribe-ast-error skribe-error + skribe-type-error skribe-line-error + skribe-warning skribe-warning/ast + skribe-message + + skribe-path skribe-path-set! + skribe-image-path skribe-image-path-set! + skribe-bib-path skribe-bib-path-set! + skribe-source-path skribe-source-path-set! + + ;; various utilities for compatiblity + + substring=? + file-suffix file-prefix prefix suffix + directory->list find-file/path + printf fprintf + any? every? + process-input-port process-output-port process-error-port + + make-hashtable hashtable? + hashtable-get hashtable-put! hashtable-update! + hashtable->list + + find-runtime-type) + :export-syntax (new define-markup define-simple-markup + define-simple-container define-processor-markup + + ;; for compatibility + unwind-protect unless when) + + :use-module (srfi srfi-1) + :use-module (ice-9 optargs)) + + + + ;;; ;;; NEW ;;; @@ -169,7 +207,7 @@ ;;; ;;; FILE-PREFIX / FILE-SUFFIX -;;; +;;; (define (file-prefix fn) (if fn (let ((match (regexp-match "(.*)\\.([^/]*$)" fn))) @@ -218,19 +256,14 @@ (Loop (cdr l)))))) + +;;; ====================================================================== ;;; -;;; UNSPECIFIED? +;;; A C C E S S O R S ;;; -(define (unspecified? obj) - (eq? obj 'unspecified)) - -;;;; ====================================================================== -;;;; -;;;; A C C E S S O R S -;;;; -;;;; ====================================================================== +;;; ====================================================================== -;; SKRIBE-PATH +;; SKRIBE-PATH (define (skribe-path) *skribe-path*) (define (skribe-path-set! path) @@ -238,7 +271,7 @@ (skribe-error 'skribe-path-set! "Illegal path" path) (set! *skribe-path* path))) -;; SKRIBE-IMAGE-PATH +;; SKRIBE-IMAGE-PATH (define (skribe-image-path) *skribe-image-path*) (define (skribe-image-path-set! path) @@ -246,7 +279,7 @@ (skribe-error 'skribe-image-path-set! "Illegal path" path) (set! *skribe-image-path* path))) -;; SKRIBE-BIB-PATH +;; SKRIBE-BIB-PATH (define (skribe-bib-path) *skribe-bib-path*) (define (skribe-bib-path-set! path) @@ -254,7 +287,7 @@ (skribe-error 'skribe-bib-path-set! "Illegal path" path) (set! *skribe-bib-path* path))) -;; SKRBE-SOURCE-PATH +;; SKRBE-SOURCE-PATH (define (skribe-source-path) *skribe-source-path*) (define (skribe-source-path-set! path) @@ -262,11 +295,12 @@ (skribe-error 'skribe-source-path-set! "Illegal path" path) (set! *skribe-source-path* path))) -;;;; ====================================================================== -;;;; -;;;; Compatibility with Bigloo -;;;; -;;;; ====================================================================== + +;;; ====================================================================== +;;; +;;; Compatibility with Bigloo +;;; +;;; ====================================================================== (define (substring=? s1 s2 len) (let ((l1 (string-length s1)) @@ -285,25 +319,12 @@ (define-macro (printf . args) `(format #t ,@args)) (define fprintf format) -(define (symbol-append . l) - (string->symbol (apply string-append (map symbol->string l)))) - - -(define (make-list n . fill) - (let ((fill (if (null? fill) (void) (car fill)))) - (let Loop ((i n) (res '())) - (if (zero? i) - res - (Loop (- i 1) (cons fill res)))))) - -(define string-capitalize string-titlecase) -(define prefix file-prefix) -(define suffix file-suffix) -(define system->string system) +(define prefix file-prefix) +(define suffix file-suffix) +(define system->string system) ;; FIXME (define any? any) (define every? every) -(define cons* list*) (define find-file/path (lambda (. args) (format #t "find-file/path: ~a~%" args) #f)) @@ -311,22 +332,29 @@ (define process-output-port #f) ;process-output) (define process-error-port #f) ;process-error) + ;;; ;;; h a s h t a b l e s ;;; -(define make-hashtable (lambda () (make-hash-table))) -(define hashtable? hash-table?) +(define make-hashtable make-hash-table) +(define hashtable? hash-table?) (define hashtable-get (lambda (h k) (hash-ref h k #f))) (define hashtable-put! hash-set!) (define hashtable-update! hash-set!) -(define hashtable->list (lambda (h) - (map cdr (hash-table->list h)))) +(define hashtable->list (lambda (h) + (map cdr (hash-table->list h)))) -(define find-runtime-type (lambda (obj) obj)) +(define find-runtime-type (lambda (obj) obj)) (define-macro (unwind-protect expr1 expr2) - ;; This is no completely correct. + ;; This is no completely correct. `(dynamic-wind (lambda () #f) (lambda () ,expr1) (lambda () ,expr2))) + +(define-macro (unless expr body) + `(if (not ,expr) ,body)) + +(define-macro (when expr . exprs) + `(if ,expr (begin ,@exprs))) diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm new file mode 100644 index 0000000..4d29f31 --- /dev/null +++ b/src/guile/skribilo/module.scm @@ -0,0 +1,118 @@ +;;; module.scm -- Integration of Skribe code as Guile modules. +;;; +;;; Copyright 2005 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 module) + :use-module (skribilo reader) + :use-module (skribilo eval) + :use-module (ice-9 optargs)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This (fake) module defines a macro called `define-skribe-module' which +;;; allows to package Skribe code (which uses Skribe built-ins and most +;;; importantly a Skribe syntax) as a Guile module. This module +;;; automatically exports the macro as a core binding so that future +;;; `use-modules' referring to Skribe modules will work as expected. +;;; +;;; Code: + +(define-macro (define-skribe-module name) + `(begin + (define-module ,name) + + ;; Pull all the bindings that Skribe code may expect, plus those needed + ;; to actually create and read the module. + (use-modules (skribilo module) + (skribilo reader) + (skribilo eval) ;; `run-time-module' + + (srfi srfi-1) + (ice-9 optargs) + + (skribilo lib) ;; `define-markup', `unwind-protect', etc. + (skribilo runtime) + (skribilo vars) + (skribilo config)) + + (use-syntax (skribilo lib)) + + ;; The `define' below results in a module-local definition. So the + ;; definition of `read' in the `(guile-user)' module is left untouched. + ;(define read ,(make-reader 'skribe)) + + ;; Everything is exported. + (define-macro (define . things) + (let* ((first (car things)) + (binding (cond ((symbol? first) first) + ((list? first) (car first)) + ((pair? first) (car first)) + (else + (error "define/skribe: bad formals" first))))) + `(begin + (define-public ,@things) + ;; Automatically push it to the run-time user module. +; (module-define! ,(run-time-module) +; (quote ,binding) ,binding) + ))))) + + +;; Make it available to the top-level module. +(module-define! the-root-module + 'define-skribe-module define-skribe-module) + + +(define-public (load-file-with-read file read module) + (with-input-from-file file + (lambda () +; (format #t "load-file-with-read: ~a~%" read) + (let loop ((sexp (read)) + (result #f)) + (if (eof-object? sexp) + result + (begin +; (format #t "preparing to evaluate `~a'~%" sexp) + (loop (read) + (eval sexp module)))))))) + +(define-public (load-skribilo-file file reader-name) + (load-file-with-read file (make-reader reader-name) (current-module))) + +(define-public *skribe-core-modules* + '("utils" "api" "bib" "index" "param" "sui")) + +(define*-public (load-skribe-modules #:optional (debug? #f)) + "Load the core Skribe modules, both in the @code{(skribilo skribe)} +hierarchy and in @code{(run-time-module)}." + (for-each (lambda (mod) + (if debug? + (format #t "loading skribe module `~a'...~%" mod)) + (load-skribilo-file (string-append "skribe/" mod ".scm") + 'skribe)) + *skribe-core-modules*) + (for-each (lambda (mod) + (module-use! (run-time-module) + (resolve-interface (list skribilo skribe + (string->symbol + mod))))) + *skribe-core-modules*)) + +;;; module.scm ends here diff --git a/src/guile/skribe/output.scm b/src/guile/skribilo/output.scm index 03c251c..cc690ec 100644 --- a/src/guile/skribe/output.scm +++ b/src/guile/skribilo/output.scm @@ -24,11 +24,11 @@ ;;;; Last file update: 5-Mar-2004 10:32 (eg) ;;;; -(define-module (skribe output) +(define-module (skribilo output) :export (output)) -(use-modules (skribe debug) - (skribe types) +(use-modules (skribilo debug) + (skribilo types) ; (skribe engine) ; (skribe writer) (oop goops)) diff --git a/src/guile/skribe/prog.scm b/src/guile/skribilo/prog.scm index eb0b3db..eb0b3db 100644 --- a/src/guile/skribe/prog.scm +++ b/src/guile/skribilo/prog.scm diff --git a/src/guile/skribilo/reader.scm b/src/guile/skribilo/reader.scm new file mode 100644 index 0000000..a149ab1 --- /dev/null +++ b/src/guile/skribilo/reader.scm @@ -0,0 +1,82 @@ +;;; reader.scm -- Skribilo's front-end (aka. reader) interface. +;;; +;;; Copyright 2005 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 reader) + :use-module (srfi srfi-9) ;; records + :use-module (srfi srfi-17) ;; generalized `set!' + :export (%make-reader lookup-reader make-reader) + :export-syntax (define-reader define-public-reader)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module contains Skribilo's front-end (aka. ``reader'') interface. +;;; Skribilo's default reader is `(skribilo reader skribe)' which provides a +;;; reader for the Skribe syntax. +;;; +;;; Code: + +(define-record-type <reader> + (%make-reader name version make) + reader? + (name reader:name reader:set-name!) ;; a symbol + (version reader:version reader:set-version!) ;; a string + (make reader:make reader:set-make!)) ;; a one-argument proc + ;; that returns a reader + ;; proc + +(define-public reader:name + (getter-with-setter reader:name reader:set-name!)) + +(define-public reader:version + (getter-with-setter reader:version reader:set-version!)) + +(define-public reader:make + (getter-with-setter reader:make reader:set-make!)) + +(define-macro (define-reader name version make-proc) + `(define reader-specification + (%make-reader (quote ,name) ,version ,make-proc))) + +(define-macro (define-public-reader name version make-proc) + `(define-reader ,name ,version ,make-proc)) + + + +;;; The mechanism below is inspired by Guile-VM code written by K. Nishida. + +(define (lookup-reader name) + "Look for a reader named @var{name} (a symbol) in the @code{(skribilo +readers)} module hierarchy. If no such reader was found, an error is +raised." + (let ((m (resolve-module `(skribilo reader ,name)))) + (if (module-bound? m 'reader-specification) + (module-ref m 'reader-specification) + (error "no such reader" name)))) + +(define (make-reader name) + "Look for reader @var{name} and instantiate it." + (let* ((spec (lookup-reader name)) + (make (reader:make spec))) + (make))) + + +;;; reader.scm ends here diff --git a/src/guile/skribilo/reader/skribe.scm b/src/guile/skribilo/reader/skribe.scm new file mode 100644 index 0000000..673a166 --- /dev/null +++ b/src/guile/skribilo/reader/skribe.scm @@ -0,0 +1,80 @@ +;;; skribe.scm -- A reader for the Skribe syntax. +;;; +;;; Copyright 2005 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 reader skribe) + :use-module (skribilo reader) + :use-module (ice-9 optargs) + + ;; the Scheme reader composition framework + :use-module ((system reader) #:renamer (symbol-prefix-proc 'r:)) + + :export (reader-specification + make-skribe-reader)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; A reader for the Skribe syntax, i.e. roughly R5RS Scheme plus DSSSL-style +;;; keywords and sk-exps (expressions introduced using a square bracket). +;;; +;;; Code: + + +(define* (make-skribe-reader #:optional (version "1.2d")) + "Return a Skribe reader (a procedure) suitable for version @var{version} of +the Skribe syntax." + (if (string> version "1.2d") + (error "make-skribe-reader: unsupported version" version) + *skribe-reader*)) + + +(define (%make-skribe-reader) + (let* ((dsssl-keyword-reader ;; keywords à la `#!key' + (r:make-token-reader #\! + (r:token-reader-procedure + (r:standard-token-reader 'keyword)))) + (sharp-reader (r:make-reader (cons dsssl-keyword-reader + (map r:standard-token-reader + '(character srfi-4 + number+radix + boolean)))))) + (r:make-reader (cons (r:make-token-reader #\# sharp-reader) + (map r:standard-token-reader + `(whitespace + sexp string number + symbol-lower-case + symbol-upper-case + symbol-misc-chars + quote-quasiquote-unquote + semicolon-comment + keyword ;; keywords à la `:key' + skribe-exp)))))) + +;; We actually cache an instance here. +(define *skribe-reader* (%make-skribe-reader)) + + + +;;; The reader specification. + +(define-reader skribe "1.2d" make-skribe-reader) + +;;; skribe.scm ends here diff --git a/src/guile/skribe/resolve.scm b/src/guile/skribilo/resolve.scm index 166e8fc..2dc5e98 100644 --- a/src/guile/skribe/resolve.scm +++ b/src/guile/skribilo/resolve.scm @@ -24,10 +24,10 @@ ;;;; Last file update: 17-Feb-2004 14:43 (eg) ;;;; -(define-module (skribe resolve) - :use-module (skribe debug) - :use-module (skribe runtime) - :use-module (skribe types) +(define-module (skribilo resolve) + :use-module (skribilo debug) + :use-module (skribilo runtime) + :use-module (skribilo types) :use-module (oop goops) diff --git a/src/guile/skribe/runtime.scm b/src/guile/skribilo/runtime.scm index abac32c..af76237 100644 --- a/src/guile/skribe/runtime.scm +++ b/src/guile/skribilo/runtime.scm @@ -1,30 +1,30 @@ -;;;; -;;;; runtime.stk -- Skribe runtime system -;;;; -;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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: 13-Aug-2003 18:47 (eg) -;;;; Last file update: 15-Nov-2004 14:03 (eg) -;;;; - -(define-module (skribe runtime) +;;; +;;; runtime.stk -- Skribe runtime system +;;; +;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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: 13-Aug-2003 18:47 (eg) +;;; Last file update: 15-Nov-2004 14:03 (eg) +;;; + +(define-module (skribilo runtime) :export (;; Utilities strip-ref-base ast->file-location string-canonicalize @@ -43,24 +43,24 @@ ;; AST ast->string)) -(use-modules (skribe debug) - (skribe types) - (skribe verify) - (skribe resolve) - (skribe output) - (skribe eval) +(use-modules (skribilo debug) + (skribilo types) + (skribilo verify) + (skribilo resolve) + (skribilo output) + (skribilo eval) (oop goops)) -;;;; ====================================================================== -;;;; -;;;; U T I L I T I E S -;;;; -;;;; ====================================================================== -(define skribe-load 'function-defined-below) +;;; ====================================================================== +;;; +;;; U T I L I T I E S +;;; +;;; ====================================================================== -;;FIXME: Remonter cette fonction + +;;FIXME: Remonter cette fonction (define (strip-ref-base file) (if (not (string? *skribe-ref-base*)) file @@ -74,7 +74,7 @@ file) (else (substring file (+ l 1) (string-length file))))))) - + (define (ast->file-location ast) (let ((l (ast-loc ast))) @@ -82,7 +82,7 @@ (format "~a:~a:" (location-file l) (location-line l)) ""))) -;; FIXME: Remonter cette fonction +;; FIXME: Remonter cette fonction (define (string-canonicalize old) (let* ((l (string-length old)) (new (make-string l))) @@ -115,34 +115,34 @@ (loop (+ r 1) (+ w 1) #f)))))) -;;;; ====================================================================== -;;;; -;;;; M A R K U P S F U N C T I O N S -;;;; -;;;; ====================================================================== -;;; (define (markup-output markup -;; :optional (engine #f) -;; :key (predicate #f) -;; (options '()) -;; (before #f) -;; (action #f) -;; (after #f)) +;;; ====================================================================== +;;; +;;; M A R K U P S F U N C T I O N S +;;; +;;; ====================================================================== +;; (define (markup-output markup +;; :optional (engine #f) +;; :key (predicate #f) +;; (options '()) +;; (before #f) +;; (action #f) +;; (after #f)) ;; (let ((e (or engine (use-engine)))) ;; (cond ;; ((not (is-a? e <engine>)) ;; (skribe-error 'markup-writer "illegal engine" e)) ;; ((and (not before) -;; (not action) -;; (not after)) +;; (not action) +;; (not after)) ;; (%find-markup-output e markup)) ;; (else -;; (let ((mp (if (procedure? predicate) -;; (lambda (n e) (and (is-markup? n markup) (predicate n e))) -;; (lambda (n e) (is-markup? n markup))))) -;; (engine-output e markup mp options -;; (or before (slot-ref e 'default-before)) -;; (or action (slot-ref e 'default-action)) -;; (or after (slot-ref e 'default-after)))))))) +;; (let ((mp (if (procedure? predicate) +;; (lambda (n e) (and (is-markup? n markup) (predicate n e))) +;; (lambda (n e) (is-markup? n markup))))) +;; (engine-output e markup mp options +;; (or before (slot-ref e 'default-before)) +;; (or action (slot-ref e 'default-action)) +;; (or after (slot-ref e 'default-after)))))))) (define (markup-option m opt) (if (markup? m) @@ -158,21 +158,21 @@ (slot-ref m 'options))) (skribe-type-error 'markup-option "Illegal markup: " m "markup"))) -;;;; ====================================================================== -;;;; -;;;; C O N T A I N E R S -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; C O N T A I N E R S +;;; +;;; ====================================================================== (define (container-env-get m key) (let ((c (assq key (slot-ref m 'env)))) (and (pair? c) (cadr c)))) -;;;; ====================================================================== -;;;; -;;;; I M A G E S -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; I M A G E S +;;; +;;; ====================================================================== (define (builtin-convert-image from fmt dir) (let* ((s (suffix from)) (f (string-append (prefix (basename from)) "." fmt)) @@ -182,7 +182,7 @@ to) ((file-exists? to) to) - (else + (else (let ((c (if (string=? s "fig") (string-append "fig2dev -L " fmt " " from " > " to) (string-append "convert " from " " to)))) @@ -221,13 +221,13 @@ p (loop (cdr fmts))))))))))) -;;;; ====================================================================== -;;;; -;;;; S T R I N G - W R I T I N G -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; S T R I N G - W R I T I N G +;;; +;;; ====================================================================== -;; +;; ;; (define (%make-html-replace) ;; ;; Ad-hoc version for HTML, a little bit faster than the ;; ;; make-general-string-replace define later (particularily if there @@ -235,18 +235,18 @@ ;; (let ((specials (string->regexp "&|\"|<|>"))) ;; (lambda (str) ;; (if (regexp-match specials str) -;; (begin -;; (let ((out (open-output-string))) -;; (dotimes (i (string-length str)) -;; (let ((ch (string-ref str i))) -;; (case ch -;; ((#\") (display """ out)) -;; ((#\&) (display "&" out)) -;; ((#\<) (display "<" out)) -;; ((#\>) (display ">" out)) -;; (else (write-char ch out))))) -;; (get-output-string out))) -;; str)))) +;; (begin +;; (let ((out (open-output-string))) +;; (dotimes (i (string-length str)) +;; (let ((ch (string-ref str i))) +;; (case ch +;; ((#\") (display """ out)) +;; ((#\&) (display "&" out)) +;; ((#\<) (display "<" out)) +;; ((#\>) (display ">" out)) +;; (else (write-char ch out))))) +;; (get-output-string out))) +;; str)))) (define (%make-general-string-replace lst) @@ -264,58 +264,58 @@ (let ((l (sort lst (lambda (r1 r2) (char<? (car r1) (car r2)))))) (cond ((equal? l '((#\" """) (#\& "&") (#\< "<") (#\> ">"))) - string->html) + string->html) (else - (%make-general-string-replace lst))))) + (%make-general-string-replace lst))))) -;;;; ====================================================================== -;;;; -;;;; O P T I O N S -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; O P T I O N S +;;; +;;; ====================================================================== ;;NEW ;; ;;NEW ;; GET-OPTION -;;NEW ;; +;;NEW ;; ;;NEW (define (get-option obj key) ;;NEW ;; This function either searches inside an a-list or a markup. ;;NEW (cond ;;NEW ((pair? obj) (let ((c (assq key obj))) -;;NEW (and (pair? c) (pair? (cdr c)) (cadr c)))) +;;NEW (and (pair? c) (pair? (cdr c)) (cadr c)))) ;;NEW ((markup? obj) (get-option (slot-ref obj 'option*) key)) ;;NEW (else #f))) -;;NEW +;;NEW ;;NEW ;; ;;NEW ;; BIND-OPTION! ;;NEW ;; ;;NEW (define (bind-option! obj key value) ;;NEW (slot-set! obj 'option* (cons (list key value) -;;NEW (slot-ref obj 'option*)))) -;;NEW -;;NEW +;;NEW (slot-ref obj 'option*)))) +;;NEW +;;NEW ;;NEW ;; ;;NEW ;; GET-ENV ;;NEW ;; ;;NEW (define (get-env obj key) ;;NEW ;; This function either searches inside an a-list or a container ;;NEW (cond -;;NEW ((pair? obj) (let ((c (assq key obj))) -;;NEW (and (pair? c) (cadr c)))) +;;NEW ((pair? obj) (let ((c (assq key obj))) +;;NEW (and (pair? c) (cadr c)))) ;;NEW ((container? obj) (get-env (slot-ref obj 'env) key)) ;;NEW (else #f))) -;;NEW +;;NEW -;;;; ====================================================================== -;;;; -;;;; A S T -;;;; -;;;; ====================================================================== +;;; ====================================================================== +;;; +;;; A S T +;;; +;;; ====================================================================== (define-generic ast->string) @@ -345,52 +345,52 @@ ;;NEW ;; ;;NEW (define (ast-parent n) ;;NEW (slot-ref n 'parent)) -;;NEW +;;NEW ;;NEW ;; ;;NEW ;; MARKUP-PARENT ;;NEW ;; ;;NEW (define (markup-parent m) ;;NEW (let ((p (slot-ref m 'parent))) ;;NEW (if (eq? p 'unspecified) -;;NEW (skribe-error 'markup-parent "Unresolved parent reference" m) -;;NEW p))) -;;NEW -;;NEW +;;NEW (skribe-error 'markup-parent "Unresolved parent reference" m) +;;NEW p))) +;;NEW +;;NEW ;;NEW ;; ;;NEW ;; MARKUP-DOCUMENT ;;NEW ;; ;;NEW (define (markup-document m) ;;NEW (let Loop ((p m) -;;NEW (l #f)) +;;NEW (l #f)) ;;NEW (cond ;;NEW ((is-markup? p 'document) p) ;;NEW ((or (eq? p 'unspecified) (not p)) l) ;;NEW (else (Loop (slot-ref p 'parent) p))))) -;;NEW +;;NEW ;;NEW ;; ;;NEW ;; MARKUP-CHAPTER ;;NEW ;; ;;NEW (define (markup-chapter m) ;;NEW (let loop ((p m) -;;NEW (l #f)) +;;NEW (l #f)) ;;NEW (cond ;;NEW ((is-markup? p 'chapter) p) ;;NEW ((or (eq? p 'unspecified) (not p)) l) ;;NEW (else (loop (slot-ref p 'parent) p))))) -;;NEW -;;NEW +;;NEW +;;NEW ;;NEW ;;;; ====================================================================== ;;NEW ;;;; -;;NEW ;;;; H A N D L E S +;;NEW ;;;; H A N D L E S ;;NEW ;;;; ;;NEW ;;;; ====================================================================== ;;NEW (define (handle-body h) ;;NEW (slot-ref h 'body)) -;;NEW -;;NEW +;;NEW +;;NEW ;;NEW ;;;; ====================================================================== ;;NEW ;;;; -;;NEW ;;;; F I N D +;;NEW ;;;; F I N D ;;NEW ;;;; ;;NEW ;;;; ====================================================================== ;;NEW (define (find pred obj) @@ -398,28 +398,28 @@ ;;NEW (debug-item "obj=" obj) ;;NEW (let loop ((obj (if (is-a? obj <container>) (container-body obj) obj))) ;;NEW (cond -;;NEW ((pair? obj) -;;NEW (apply append (map (lambda (o) (loop o)) obj))) -;;NEW ((is-a? obj <container>) -;;NEW (debug-item "loop=" obj " " (slot-ref obj 'ident)) -;;NEW (if (pred obj) -;;NEW (list (cons obj (loop (container-body obj)))) -;;NEW '())) -;;NEW (else -;;NEW (if (pred obj) -;;NEW (list obj) -;;NEW '())))))) -;;NEW +;;NEW ((pair? obj) +;;NEW (apply append (map (lambda (o) (loop o)) obj))) +;;NEW ((is-a? obj <container>) +;;NEW (debug-item "loop=" obj " " (slot-ref obj 'ident)) +;;NEW (if (pred obj) +;;NEW (list (cons obj (loop (container-body obj)))) +;;NEW '())) +;;NEW (else +;;NEW (if (pred obj) +;;NEW (list obj) +;;NEW '())))))) +;;NEW ;;NEW ;;;; ====================================================================== ;;NEW ;;;; -;;NEW ;;;; M A R K U P A R G U M E N T P A R S I N G +;;NEW ;;;; M A R K U P A R G U M E N T P A R S I N G ;;NEW ;;; ;;NEW ;;;; ====================================================================== ;;NEW (define (the-body opt) ;;NEW ;; Filter out the options ;;NEW (let loop ((opt* opt) -;;NEW (res '())) +;;NEW (res '())) ;;NEW (cond ;;NEW ((null? opt*) ;;NEW (reverse! res)) @@ -427,18 +427,18 @@ ;;NEW (skribe-error 'the-body "Illegal body" opt)) ;;NEW ((keyword? (car opt*)) ;;NEW (if (null? (cdr opt*)) -;;NEW (skribe-error 'the-body "Illegal option" (car opt*)) -;;NEW (loop (cddr opt*) res))) +;;NEW (skribe-error 'the-body "Illegal option" (car opt*)) +;;NEW (loop (cddr opt*) res))) ;;NEW (else ;;NEW (loop (cdr opt*) (cons (car opt*) res)))))) -;;NEW -;;NEW -;;NEW +;;NEW +;;NEW +;;NEW ;;NEW (define (the-options opt+ . out) -;;NEW ;; Returns an list made of options.The OUT argument contains -;;NEW ;; keywords that are filtered out. +;;NEW ;; Returns an list made of options.The OUT argument contains +;;NEW ;; keywords that are filtered out. ;;NEW (let loop ((opt* opt+) -;;NEW (res '())) +;;NEW (res '())) ;;NEW (cond ;;NEW ((null? opt*) ;;NEW (reverse! res)) @@ -446,15 +446,13 @@ ;;NEW (skribe-error 'the-options "Illegal options" opt*)) ;;NEW ((keyword? (car opt*)) ;;NEW (cond -;;NEW ((null? (cdr opt*)) -;;NEW (skribe-error 'the-options "Illegal option" (car opt*))) -;;NEW ((memq (car opt*) out) -;;NEW (loop (cdr opt*) res)) -;;NEW (else -;;NEW (loop (cdr opt*) -;;NEW (cons (list (car opt*) (cadr opt*)) res))))) +;;NEW ((null? (cdr opt*)) +;;NEW (skribe-error 'the-options "Illegal option" (car opt*))) +;;NEW ((memq (car opt*) out) +;;NEW (loop (cdr opt*) res)) +;;NEW (else +;;NEW (loop (cdr opt*) +;;NEW (cons (list (car opt*) (cadr opt*)) res))))) ;;NEW (else ;;NEW (loop (cdr opt*) res))))) -;;NEW - - +;;NEW diff --git a/src/guile/skribilo/skribe/api.scm b/src/guile/skribilo/skribe/api.scm new file mode 100644 index 0000000..2828908 --- /dev/null +++ b/src/guile/skribilo/skribe/api.scm @@ -0,0 +1,1260 @@ +;;; api.scm +;;; +;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2005 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 skribe api)) + +;;; Author: Manuel Serrano +;;; Commentary: +;;; +;;; This module contains all the core markups of Skribe/Skribilo. +;;; +;;; Code: + + +;;; The contents of the file below are unchanged compared to Skribe 1.2d's +;;; `api.scm' file found in the `common' directory. + +(let ((gensym-orig gensym)) + ;; In Skribe, `gensym' accepts a symbol. Guile's `gensym' accepts only + ;; strings. + (set! gensym + (lambda (obj) + (gensym-orig (cond ((symbol? obj) (symbol->string obj)) + (else obj)))))) + +;*---------------------------------------------------------------------*/ +;* include ... */ +;*---------------------------------------------------------------------*/ +(define-markup (include file) + (if (not (string? file)) + (skribe-error 'include "Illegal file (string expected)" file) + (skribe-include file))) + +;*---------------------------------------------------------------------*/ +;* document ... */ +;*---------------------------------------------------------------------*/ +(define-markup (document #!rest + opts + #!key + (ident #f) (class "document") + (title #f) (html-title #f) (author #f) + (ending #f) (env '())) + (new document + (markup 'document) + (ident (or ident + (ast->string title) + (symbol->string (gensym 'document)))) + (class class) + (required-options '(:title :author :ending)) + (options (the-options opts :ident :class :env)) + (body (the-body opts)) + (env (append env + (list (list 'chapter-counter 0) (list 'chapter-env '()) + (list 'section-counter 0) (list 'section-env '()) + (list 'footnote-counter 0) (list 'footnote-env '()) + (list 'figure-counter 0) (list 'figure-env '())))))) + +;*---------------------------------------------------------------------*/ +;* author ... */ +;*---------------------------------------------------------------------*/ +(define-markup (author #!rest + opts + #!key + (ident #f) (class "author") + name + (title #f) + (affiliation #f) + (email #f) + (url #f) + (address #f) + (phone #f) + (photo #f) + (align 'center)) + (if (not (memq align '(center left right))) + (skribe-error 'author "Illegal align value" align) + (new container + (markup 'author) + (ident (or ident (symbol->string (gensym 'author)))) + (class class) + (required-options '(:name :title :affiliation :email :url :address :phone :photo :align)) + (options `((:name ,name) + (:align ,align) + ,@(the-options opts :ident :class))) + (body #f)))) + +;*---------------------------------------------------------------------*/ +;* toc ... */ +;*---------------------------------------------------------------------*/ +(define-markup (toc #!rest + opts + #!key + (ident #f) (class "toc") + (chapter #t) (section #t) (subsection #f)) + (let ((body (the-body opts))) + (new container + (markup 'toc) + (ident (or ident (symbol->string (gensym 'toc)))) + (class class) + (required-options '()) + (options `((:chapter ,chapter) + (:section ,section) + (:subsection ,subsection) + ,@(the-options opts :ident :class))) + (body (cond + ((null? body) + (new unresolved + (proc (lambda (n e env) + (handle + (resolve-search-parent n env document?)))))) + ((null? (cdr body)) + (if (handle? (car body)) + (car body) + (skribe-error 'toc + "Illegal argument (handle expected)" + (if (markup? (car body)) + (markup-markup (car body)) + "???")))) + (else + (skribe-error 'toc "Illegal argument" body))))))) + +;*---------------------------------------------------------------------*/ +;* chapter ... ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/sectioning.skb:chapter@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:chapter@ */ +;*---------------------------------------------------------------------*/ +(define-markup (chapter #!rest + opts + #!key + (ident #f) (class "chapter") + title (html-title #f) (file #f) (toc #t) (number #t)) + (new container + (markup 'chapter) + (ident (or ident (symbol->string (gensym 'chapter)))) + (class class) + (required-options '(:title :file :toc :number)) + (options `((:toc ,toc) + (:number ,(and number + (new unresolved + (proc (lambda (n e env) + (resolve-counter n + env + 'chapter + number)))))) + ,@(the-options opts :ident :class))) + (body (the-body opts)) + (env (list (list 'section-counter 0) (list 'section-env '()) + (list 'footnote-counter 0) (list 'footnote-env '()))))) + +;*---------------------------------------------------------------------*/ +;* section-number ... */ +;*---------------------------------------------------------------------*/ +(define (section-number number markup) + (and number + (new unresolved + (proc (lambda (n e env) + (resolve-counter n env markup number)))))) + +;*---------------------------------------------------------------------*/ +;* section ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/sectioning.skb:section@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:sectionr@ */ +;*---------------------------------------------------------------------*/ +(define-markup (section #!rest + opts + #!key + (ident #f) (class "section") + title (file #f) (toc #t) (number #t)) + (new container + (markup 'section) + (ident (or ident (symbol->string (gensym 'section)))) + (class class) + (required-options '(:title :toc :file :toc :number)) + (options `((:number ,(section-number number 'section)) + (:toc ,toc) + ,@(the-options opts :ident :class))) + (body (the-body opts)) + (env (if file + (list (list 'subsection-counter 0) (list 'subsection-env '()) + (list 'footnote-counter 0) (list 'footnote-env '())) + (list (list 'subsection-counter 0) (list 'subsection-env '())))))) + +;*---------------------------------------------------------------------*/ +;* subsection ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/sectioning.skb:subsection@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:subsectionr@ */ +;*---------------------------------------------------------------------*/ +(define-markup (subsection #!rest + opts + #!key + (ident #f) (class "subsection") + title (file #f) (toc #t) (number #t)) + (new container + (markup 'subsection) + (ident (or ident (symbol->string (gensym 'subsection)))) + (class class) + (required-options '(:title :toc :file :number)) + (options `((:number ,(section-number number 'subsection)) + (:toc ,toc) + ,@(the-options opts :ident :class))) + (body (the-body opts)) + (env (list (list 'subsubsection-counter 0) (list 'subsubsection-env '()))))) + +;*---------------------------------------------------------------------*/ +;* subsubsection ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/sectioning.skb:subsubsection@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:subsubsectionr@ */ +;*---------------------------------------------------------------------*/ +(define-markup (subsubsection #!rest + opts + #!key + (ident #f) (class "subsubsection") + title (file #f) (toc #f) (number #t)) + (new container + (markup 'subsubsection) + (ident (or ident (symbol->string (gensym 'subsubsection)))) + (class class) + (required-options '(:title :toc :number :file)) + (options `((:number ,(section-number number 'subsubsection)) + (:toc ,toc) + ,@(the-options opts :ident :class))) + (body (the-body opts)))) + +;*---------------------------------------------------------------------*/ +;* paragraph ... */ +;*---------------------------------------------------------------------*/ +(define-simple-markup paragraph) + +;*---------------------------------------------------------------------*/ +;* footnote ... */ +;*---------------------------------------------------------------------*/ +(define-markup (footnote #!rest opts + #!key (ident #f) (class "footnote") (label #t)) + ;; The `:label' option used to be called `:number'. + (new container + (markup 'footnote) + (ident (symbol->string (gensym 'footnote))) + (class class) + (required-options '()) + (options `((:label + ,(cond ((string? label) label) + ((number? label) label) + ((not label) label) + (else + (new unresolved + (proc (lambda (n e env) + (resolve-counter n env + 'footnote #t))))) + ,@(the-options opts :ident :class))))) + (body (the-body opts)))) + +;*---------------------------------------------------------------------*/ +;* linebreak ... */ +;*---------------------------------------------------------------------*/ +(define-markup (linebreak #!rest opts #!key (ident #f) (class #f)) + (let ((ln (new markup + (ident (or ident (symbol->string (gensym 'linebreak)))) + (class class) + (markup 'linebreak))) + (num (the-body opts))) + (cond + ((null? num) + ln) + ((not (null? (cdr num))) + (skribe-error 'linebreak "Illegal arguments" num)) + ((not (and (integer? (car num)) (positive? (car num)))) + (skribe-error 'linebreak "Illegal argument" (car num))) + (else + (vector->list (make-vector (car num) ln)))))) + +;*---------------------------------------------------------------------*/ +;* hrule ... */ +;*---------------------------------------------------------------------*/ +(define-markup (hrule #!rest + opts + #!key + (ident #f) (class #f) + (width 100.) (height 1)) + (new markup + (markup 'hrule) + (ident (or ident (symbol->string (gensym 'hrule)))) + (class class) + (required-options '()) + (options `((:width ,width) + (:height ,height) + ,@(the-options opts :ident :class))) + (body #f))) + +;*---------------------------------------------------------------------*/ +;* color ... */ +;*---------------------------------------------------------------------*/ +(define-markup (color #!rest + opts + #!key + (ident #f) (class "color") + (bg #f) (fg #f) (width #f) (margin #f)) + (new container + (markup 'color) + (ident (or ident (symbol->string (gensym 'color)))) + (class class) + (required-options '(:bg :fg :width)) + (options `((:bg ,(if bg (skribe-use-color! bg) bg)) + (:fg ,(if fg (skribe-use-color! fg) fg)) + ,@(the-options opts :ident :class :bg :fg))) + (body (the-body opts)))) + +;*---------------------------------------------------------------------*/ +;* frame ... */ +;*---------------------------------------------------------------------*/ +(define-markup (frame #!rest + opts + #!key + (ident #f) (class "frame") + (width #f) (margin 2) (border 1)) + (new container + (markup 'frame) + (ident (or ident (symbol->string (gensym 'frame)))) + (class class) + (required-options '(:width :border :margin)) + (options `((:margin ,margin) + (:border ,(cond + ((integer? border) border) + (border 1) + (else #f))) + ,@(the-options opts :ident :class))) + (body (the-body opts)))) + +;*---------------------------------------------------------------------*/ +;* font ... */ +;*---------------------------------------------------------------------*/ +(define-markup (font #!rest + opts + #!key + (ident #f) (class #f) + (size #f) (face #f)) + (new container + (markup 'font) + (ident (or ident (symbol->string (gensym 'font)))) + (class class) + (required-options '(:size)) + (options (the-options opts :ident :class)) + (body (the-body opts)))) + +;*---------------------------------------------------------------------*/ +;* flush ... */ +;*---------------------------------------------------------------------*/ +(define-markup (flush #!rest + opts + #!key + (ident #f) (class #f) + side) + (case side + ((center left right) + (new container + (markup 'flush) + (ident (or ident (symbol->string (gensym 'flush)))) + (class class) + (required-options '(:side)) + (options (the-options opts :ident :class)) + (body (the-body opts)))) + (else + (skribe-error 'flush "Illegal side" side)))) + +;*---------------------------------------------------------------------*/ +;* center ... */ +;*---------------------------------------------------------------------*/ +(define-simple-container center) + +;*---------------------------------------------------------------------*/ +;* pre ... */ +;*---------------------------------------------------------------------*/ +(define-simple-container pre) + +;*---------------------------------------------------------------------*/ +;* prog ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/prgm.skb:prog@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:prog@ */ +;*---------------------------------------------------------------------*/ +(define-markup (prog #!rest + opts + #!key + (ident #f) (class "prog") + (line 1) (linedigit #f) (mark ";!")) + (if (not (or (string? mark) (eq? mark #f))) + (skribe-error 'prog "Illegal mark" mark) + (new container + (markup 'prog) + (ident (or ident (symbol->string (gensym 'prog)))) + (class class) + (required-options '(:line :mark)) + (options (the-options opts :ident :class :linedigit)) + (body (make-prog-body (the-body opts) line linedigit mark))))) + +;*---------------------------------------------------------------------*/ +;* source ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/prgm.skb:source@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:source@ */ +;*---------------------------------------------------------------------*/ +(define-markup (source #!rest + opts + #!key + language + (file #f) (start #f) (stop #f) + (definition #f) (tab 8)) + (let ((body (the-body opts))) + (cond + ((and (not (null? body)) (or file start stop definition)) + (skribe-error 'source + "file, start/stop, and definition are exclusive with body" + body)) + ((and start stop definition) + (skribe-error 'source + "start/stop are exclusive with a definition" + body)) + ((and (or start stop definition) (not file)) + (skribe-error 'source + "start/stop and definition require a file specification" + file)) + ((and definition (not language)) + (skribe-error 'source + "definition requires a language specification" + definition)) + ((and file (not (string? file))) + (skribe-error 'source "Illegal file" file)) + ((and start (not (or (integer? start) (string? start)))) + (skribe-error 'source "Illegal start" start)) + ((and stop (not (or (integer? stop) (string? stop)))) + (skribe-error 'source "Illegal start" stop)) + ((and (integer? start) (integer? stop) (> start stop)) + (skribe-error 'source + "start line > stop line" + (format "~a/~a" start stop))) + ((and language (not (language? language))) + (skribe-error 'source "Illegal language" language)) + ((and tab (not (integer? tab))) + (skribe-error 'source "Illegal tab" tab)) + (file + (let ((s (if (not definition) + (source-read-lines file start stop tab) + (source-read-definition file definition tab language)))) + (if language + (source-fontify s language) + s))) + (language + (source-fontify body language)) + (else + body)))) + +;*---------------------------------------------------------------------*/ +;* language ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/prgm.skb:language@ */ +;*---------------------------------------------------------------------*/ +(define-markup (language #!key name (fontifier #f) (extractor #f)) + (if (not (string? name)) + (skribe-type-error 'language "Illegal name, " name "string") + (new language + (name name) + (fontifier fontifier) + (extractor extractor)))) + +;*---------------------------------------------------------------------*/ +;* figure ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/figure.skb:figure@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:figure@ */ +;*---------------------------------------------------------------------*/ +(define-markup (figure #!rest + opts + #!key + (ident #f) (class "figure") + (legend #f) (number #t) (multicolumns #f)) + (new container + (markup 'figure) + (ident (or ident + (let ((s (ast->string legend))) + (if (not (string=? s "")) + s + (symbol->string (gensym 'figure)))))) + (class class) + (required-options '(:legend :number :multicolumns)) + (options `((:number + ,(new unresolved + (proc (lambda (n e env) + (resolve-counter n env 'figure number))))) + ,@(the-options opts :ident :class))) + (body (the-body opts)))) + +;*---------------------------------------------------------------------*/ +;* parse-list-of ... */ +;* ------------------------------------------------------------- */ +;* The function table accepts two different prototypes. It */ +;* may receive its N elements in a list of N elements or in */ +;* a list of one element which is a list of N elements. This */ +;* gets rid of APPLY when calling container markup such as ITEMIZE */ +;* or TABLE. */ +;*---------------------------------------------------------------------*/ +(define (parse-list-of for markup lst) + (cond + ((null? lst) + '()) + ((and (pair? lst) + (or (pair? (car lst)) (null? (car lst))) + (null? (cdr lst))) + (parse-list-of for markup (car lst))) + (else + (let loop ((lst lst)) + (cond + ((null? lst) + '()) + ((pair? (car lst)) + (loop (car lst))) + (else + (let ((r (car lst))) + (if (not (is-markup? r markup)) + (skribe-warning 2 + for + (format "Illegal `~a' element, `~a' expected" + (if (markup? r) + (markup-markup r) + (find-runtime-type r)) + markup))) + (cons r (loop (cdr lst)))))))))) + +;*---------------------------------------------------------------------*/ +;* itemize ... */ +;*---------------------------------------------------------------------*/ +(define-markup (itemize #!rest opts #!key (ident #f) (class "itemize") symbol) + (new container + (markup 'itemize) + (ident (or ident (symbol->string (gensym 'itemize)))) + (class class) + (required-options '(:symbol)) + (options `((:symbol ,symbol) ,@(the-options opts :ident :class))) + (body (parse-list-of 'itemize 'item (the-body opts))))) + +;*---------------------------------------------------------------------*/ +;* enumerate ... */ +;*---------------------------------------------------------------------*/ +(define-markup (enumerate #!rest opts #!key (ident #f) (class "enumerate") symbol) + (new container + (markup 'enumerate) + (ident (or ident (symbol->string (gensym 'enumerate)))) + (class class) + (required-options '(:symbol)) + (options `((:symbol ,symbol) ,@(the-options opts :ident :class))) + (body (parse-list-of 'enumerate 'item (the-body opts))))) + +;*---------------------------------------------------------------------*/ +;* description ... */ +;*---------------------------------------------------------------------*/ +(define-markup (description #!rest opts #!key (ident #f) (class "description") symbol) + (new container + (markup 'description) + (ident (or ident (symbol->string (gensym 'description)))) + (class class) + (required-options '(:symbol)) + (options `((:symbol ,symbol) ,@(the-options opts :ident :class))) + (body (parse-list-of 'description 'item (the-body opts))))) + +;*---------------------------------------------------------------------*/ +;* item ... */ +;*---------------------------------------------------------------------*/ +(define-markup (item #!rest opts #!key (ident #f) (class #f) key) + (if (and key (not (or (string? key) + (number? key) + (markup? key) + (pair? key)))) + (skribe-type-error 'item "Illegal key:" key "node") + (new container + (markup 'item) + (ident (or ident (symbol->string (gensym 'item)))) + (class class) + (required-options '(:key)) + (options `((:key ,key) ,@(the-options opts :ident :class :key))) + (body (the-body opts))))) + +;*---------------------------------------------------------------------*/ +;* table */ +;*---------------------------------------------------------------------*/ +(define-markup (table #!rest + opts + #!key + (ident #f) (class #f) + (border #f) (width #f) + (frame 'none) (rules 'none) + (cellstyle 'collapse) (cellpadding #f) (cellspacing #f)) + (let ((frame (cond + ((string? frame) + (string->symbol frame)) + ((not frame) + #f) + (else + frame))) + (rules (cond + ((string? rules) + (string->symbol rules)) + ((not rules) + #f) + (else + rules))) + (frame-vals '(none above below hsides vsides lhs rhs box border)) + (rules-vals '(none rows cols all header)) + (cells-vals '(collapse separate))) + (cond + ((and frame (not (memq frame frame-vals))) + (skribe-error 'table + (format "frame should be one of \"~a\"" frame-vals) + frame)) + ((and rules (not (memq rules rules-vals))) + (skribe-error 'table + (format "rules should be one of \"~a\"" rules-vals) + rules)) + ((not (or (memq cellstyle cells-vals) + (string? cellstyle) + (number? cellstyle))) + (skribe-error 'table + (format "cellstyle should be one of \"~a\", or a number, or a string" cells-vals) + cellstyle)) + (else + (new container + (markup 'table) + (ident (or ident (symbol->string (gensym 'table)))) + (class class) + (required-options '(:width :frame :rules)) + (options `((:frame ,frame) + (:rules ,rules) + (:cellstyle ,cellstyle) + ,@(the-options opts :ident :class))) + (body (parse-list-of 'table 'tr (the-body opts)))))))) + +;*---------------------------------------------------------------------*/ +;* tr ... */ +;*---------------------------------------------------------------------*/ +(define-markup (tr #!rest opts #!key (ident #f) (class #f) (bg #f)) + (new container + (markup 'tr) + (ident (or ident (symbol->string (gensym 'tr)))) + (class class) + (required-options '()) + (options `(,@(if bg `((:bg ,(if bg (skribe-use-color! bg) bg))) '()) + ,@(the-options opts :ident :class :bg))) + (body (parse-list-of 'tr 'tc (the-body opts))))) + +;*---------------------------------------------------------------------*/ +;* tc... */ +;*---------------------------------------------------------------------*/ +(define-markup (tc m + #!rest + opts + #!key + (ident #f) (class #f) + (width #f) (align 'center) (valign #f) + (colspan 1) (bg #f)) + (let ((align (if (string? align) + (string->symbol align) + align)) + (valign (if (string? valign) + (string->symbol valign) + valign))) + (cond + ((not (integer? colspan)) + (skribe-type-error 'tc "Illegal colspan, " colspan "integer")) + ((not (symbol? align)) + (skribe-type-error 'tc "Illegal align, " align "align")) + ((not (memq align '(#f center left right))) + (skribe-error + 'tc + "align should be one of 'left', `center', or `right'" + align)) + ((not (memq valign '(#f top middle center bottom))) + (skribe-error + 'tc + "valign should be one of 'top', `middle', `center', or `bottom'" + valign)) + (else + (new container + (markup 'tc) + (ident (or ident (symbol->string (gensym 'tc)))) + (class class) + (required-options '(:width :align :valign :colspan)) + (options `((markup ,m) + (:align ,align) + (:valign ,valign) + (:colspan ,colspan) + ,@(if bg + `((:bg ,(if bg (skribe-use-color! bg) bg))) + '()) + ,@(the-options opts :ident :class :bg :align :valign))) + (body (the-body opts))))))) + +;*---------------------------------------------------------------------*/ +;* th ... */ +;*---------------------------------------------------------------------*/ +(define-markup (th #!rest + opts + #!key + (ident #f) (class #f) + (width #f) (align 'center) (valign #f) + (colspan 1) (bg #f)) + (apply tc 'th opts)) + +;*---------------------------------------------------------------------*/ +;* td ... */ +;*---------------------------------------------------------------------*/ +(define-markup (td #!rest + opts + #!key + (ident #f) (class #f) + (width #f) (align 'center) (valign #f) + (colspan 1) (bg #f)) + (apply tc 'td opts)) + +;*---------------------------------------------------------------------*/ +;* image ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/image.skb:image@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:image@ */ +;* latex: @ref ../../skr/latex.skr:image@ */ +;*---------------------------------------------------------------------*/ +(define-markup (image #!rest + opts + #!key + (ident #f) (class #f) + file (url #f) (width #f) (height #f) (zoom #f)) + (cond + ((not (or (string? file) (string? url))) + (skribe-error 'image "No file or url provided" file)) + ((and (string? file) (string? url)) + (skribe-error 'image "Both file and url provided" (list file url))) + (else + (new markup + (markup 'image) + (ident (or ident (symbol->string (gensym 'image)))) + (class class) + (required-options '(:file :url :width :height)) + (options (the-options opts :ident :class)) + (body (the-body opts)))))) + +;*---------------------------------------------------------------------*/ +;* blockquote */ +;*---------------------------------------------------------------------*/ +(define-simple-markup blockquote) + +;*---------------------------------------------------------------------*/ +;* Ornaments ... */ +;*---------------------------------------------------------------------*/ +(define-simple-markup roman) +(define-simple-markup bold) +(define-simple-markup underline) +(define-simple-markup strike) +(define-simple-markup emph) +(define-simple-markup kbd) +(define-simple-markup it) +(define-simple-markup tt) +(define-simple-markup code) +(define-simple-markup var) +(define-simple-markup samp) +(define-simple-markup sf) +(define-simple-markup sc) +(define-simple-markup sub) +(define-simple-markup sup) + +;*---------------------------------------------------------------------*/ +;* char ... */ +;*---------------------------------------------------------------------*/ +(define-markup (char char) + (cond + ((char? char) + (string char)) + ((integer? char) + (string (integer->char char))) + ((and (string? char) (= (string-length char) 1)) + char) + (else + (skribe-error 'char "Illegal char" char)))) + +;*---------------------------------------------------------------------*/ +;* symbol ... */ +;*---------------------------------------------------------------------*/ +(define-markup (symbol symbol) + (let ((v (cond + ((symbol? symbol) + (symbol->string symbol)) + ((string? symbol) + symbol) + (else + (skribe-error 'symbol + "Illegal argument (symbol expected)" + symbol))))) + (new markup + (markup 'symbol) + (body v)))) + +;*---------------------------------------------------------------------*/ +;* ! ... */ +;*---------------------------------------------------------------------*/ +(define-markup (! format #!rest node) + (if (not (string? format)) + (skribe-type-error '! "Illegal format:" format "string") + (new command + (fmt format) + (body node)))) + +;*---------------------------------------------------------------------*/ +;* processor ... */ +;*---------------------------------------------------------------------*/ +(define-markup (processor #!rest opts + #!key (combinator #f) (engine #f) (procedure #f)) + (cond + ((and combinator (not (procedure? combinator))) + (skribe-error 'processor "Combinator not a procedure" combinator)) + ((and engine (not (engine? engine))) + (skribe-error 'processor "Illegal engine" engine)) + ((and procedure + (or (not (procedure? procedure)) + (not (correct-arity? procedure 2)))) + (skribe-error 'processor "Illegal procedure" procedure)) + (else + (new processor + (combinator combinator) + (engine engine) + (procedure (or procedure (lambda (n e) n))) + (body (the-body opts)))))) + +;*---------------------------------------------------------------------*/ +;* Processors ... */ +;*---------------------------------------------------------------------*/ +(define-processor-markup html-processor) +(define-processor-markup tex-processor) + +;*---------------------------------------------------------------------*/ +;* handle ... */ +;*---------------------------------------------------------------------*/ +(define-markup (handle #!rest opts + #!key (ident #f) (class "handle") value section) + (let ((body (the-body opts))) + (cond + (section + (error 'handle "Illegal handle `section' option" section) + (new unresolved + (proc (lambda (n e env) + (let ((s (resolve-ident section 'section n env))) + (new handle + (ast s))))))) + ((and (pair? body) + (null? (cdr body)) + (markup? (car body))) + (new handle + (ast (car body)))) + (else + (skribe-error 'handle "Illegal handle" opts))))) + +;*---------------------------------------------------------------------*/ +;* mailto ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/links.skb:mailto@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:mailto@ */ +;*---------------------------------------------------------------------*/ +(define-markup (mailto #!rest opts #!key (ident #f) (class "mailto") text) + (new markup + (markup 'mailto) + (ident (or ident (symbol->string (gensym 'ident)))) + (class class) + (required-options '(:text)) + (options (the-options opts :ident :class)) + (body (the-body opts)))) + +;*---------------------------------------------------------------------*/ +;* *mark-table* ... */ +;*---------------------------------------------------------------------*/ +(define *mark-table* (make-hashtable)) + +;*---------------------------------------------------------------------*/ +;* mark ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/links.skb:mark@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:mark@ */ +;*---------------------------------------------------------------------*/ +(define-markup (mark #!rest opts #!key (ident #f) (class "mark") (text #f)) + (let ((bd (the-body opts))) + (cond + ((and (pair? bd) (not (null? (cdr bd)))) + (skribe-error 'mark "Too many argument provided" bd)) + ((null? bd) + (skribe-error 'mark "Missing argument" '())) + ((not (string? (car bd))) + (skribe-type-error 'mark "Illegal ident:" (car bd) "string")) + (ident + (skribe-error 'mark "Illegal `ident:' option" ident)) + (else + (let* ((bs (ast->string bd)) + (n (new markup + (markup 'mark) + (ident bs) + (class class) + (options (the-options opts :ident :class :text)) + (body text)))) + (hashtable-put! *mark-table* bs n) + n))))) + +;*---------------------------------------------------------------------*/ +;* ref ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/links.skb:ref@ */ +;* writer: */ +;* html: @ref ../../skr/html.skr:ref@ */ +;* latex: @ref ../../skr/latex.skr:ref@ */ +;*---------------------------------------------------------------------*/ +(define-markup (ref #!rest + opts + #!key + (class #f) + (ident #f) + (text #f) + (chapter #f) + (section #f) + (subsection #f) + (subsubsection #f) + (bib #f) + (bib-table (default-bib-table)) + (url #f) + (figure #f) + (mark #f) + (handle #f) + (line #f) + (skribe #f) + (page #f)) + (define (unref ast text kind) + (let ((msg (format "Can't find `~a': " kind))) + (if (ast? ast) + (begin + (skribe-warning/ast 1 ast 'ref msg text) + (new markup + (markup 'unref) + (ident (symbol->string 'unref)) + (class class) + (required-options '(:text)) + (options `((kind ,kind) ,@(the-options opts :ident :class))) + (body (list text ": " (ast->file-location ast))))) + (begin + (skribe-warning 1 'ref msg text) + (new markup + (markup 'unref) + (ident (symbol->string 'unref)) + (class class) + (required-options '(:text)) + (options `((kind ,kind) ,@(the-options opts :ident :class))) + (body text)))))) + (define (skribe-ref skribe) + (let ((path (find-file/path skribe (skribe-path)))) + (if (not path) + (unref #f skribe 'sui-file) + (let* ((sui (load-sui path)) + (os (the-options opts :skribe :class :text)) + (u (sui-ref->url (dirname path) sui ident os))) + (if (not u) + (unref #f os 'sui-ref) + (ref :url u :text text :ident ident :class class)))))) + (define (handle-ref text) + (new markup + (markup 'ref) + (ident (symbol->string 'ref)) + (class class) + (required-options '(:text)) + (options `((kind handle) ,@(the-options opts :ident :class))) + (body text))) + (define (doref text kind) + (if (not (string? text)) + (skribe-type-error 'ref "Illegal reference" text "string") + (new unresolved + (proc (lambda (n e env) + (let ((s (resolve-ident text kind n env))) + (if s + (new markup + (markup 'ref) + (ident (symbol->string 'ref)) + (class class) + (required-options '(:text)) + (options `((kind ,kind) + (mark ,text) + ,@(the-options opts :ident :class))) + (body (new handle + (ast s)))) + (unref n text (or kind 'ident))))))))) + (define (mark-ref mark) + (if (not (string? mark)) + (skribe-type-error 'mark "Illegal mark, " mark "string") + (new unresolved + (proc (lambda (n e env) + (let ((s (hashtable-get *mark-table* mark))) + (if s + (new markup + (markup 'ref) + (ident (symbol->string 'ref)) + (class class) + (required-options '(:text)) + (options `((kind mark) + (mark ,mark) + ,@(the-options opts :ident :class))) + (body (new handle + (ast s)))) + (unref n mark 'mark)))))))) + (define (make-bib-ref v) + (let ((s (resolve-bib bib-table v))) + (if s + (let* ((n (new markup + (markup 'bib-ref) + (ident (symbol->string 'bib-ref)) + (class class) + (required-options '(:text)) + (options (the-options opts :ident :class)) + (body (new handle + (ast s))))) + (h (new handle (ast n))) + (o (markup-option s 'used))) + (markup-option-add! s 'used (if (pair? o) (cons h o) (list h))) + n) + (unref #f v 'bib)))) + (define (bib-ref text) + (if (pair? text) + (new markup + (markup 'bib-ref+) + (ident (symbol->string 'bib-ref+)) + (class class) + (options (the-options opts :ident :class)) + (body (map make-bib-ref text))) + (make-bib-ref text))) + (define (url-ref) + (new markup + (markup 'url-ref) + (ident (symbol->string 'url-ref)) + (class class) + (required-options '(:url :text)) + (options (the-options opts :ident :class)))) + (define (line-ref line) + (new unresolved + (proc (lambda (n e env) + (let ((l (resolve-line line))) + (if (pair? l) + (new markup + (markup 'line-ref) + (ident (symbol->string 'line-ref)) + (class class) + (options `((:text ,(markup-ident (car l))) + ,@(the-options opts :ident :class))) + (body (new handle + (ast (car l))))) + (unref n line 'line))))))) + (let ((b (the-body opts))) + (if (not (null? b)) + (skribe-warning 1 'ref "Arguments ignored " b)) + (cond + (skribe (skribe-ref skribe)) + (handle (handle-ref handle)) + (ident (doref ident #f)) + (chapter (doref chapter 'chapter)) + (section (doref section 'section)) + (subsection (doref subsection 'subsection)) + (subsubsection (doref subsubsection 'subsubsection)) + (figure (doref figure 'figure)) + (mark (mark-ref mark)) + (bib (bib-ref bib)) + (url (url-ref)) + (line (line-ref line)) + (else (skribe-error 'ref "Illegal reference" opts))))) + +;*---------------------------------------------------------------------*/ +;* resolve ... */ +;*---------------------------------------------------------------------*/ +(define-markup (resolve fun) + (new unresolved + (proc fun))) + +;*---------------------------------------------------------------------*/ +;* bibliography ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/bib.skb:bibliography@ */ +;*---------------------------------------------------------------------*/ +(define-markup (bibliography #!rest files + #!key + (command #f) (bib-table (default-bib-table))) + (for-each (lambda (f) + (cond + ((string? f) + (bib-load! bib-table f command)) + ((pair? f) + (bib-add! bib-table f)) + (else + (skribe-error "bibliography" "Illegal entry" f)))) + (the-body files))) + +;*---------------------------------------------------------------------*/ +;* the-bibliography ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/bib.skb:the-bibliography@ */ +;* writer: */ +;* base: @ref ../../skr/base.skr:the-bibliography@ */ +;*---------------------------------------------------------------------*/ +(define-markup (the-bibliography #!rest opts + #!key + pred + (bib-table (default-bib-table)) + (sort bib-sort/authors) + (count 'partial)) + (if (not (memq count '(partial full))) + (skribe-error 'the-bibliography + "Cound must be either `partial' or `full'" + count) + (new unresolved + (proc (lambda (n e env) + (resolve-the-bib bib-table + (new handle (ast n)) + sort + pred + count + (the-options opts))))))) + +;*---------------------------------------------------------------------*/ +;* make-index ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/index.skb:make-index@ */ +;*---------------------------------------------------------------------*/ +(define-markup (make-index ident) + (make-index-table ident)) + +;*---------------------------------------------------------------------*/ +;* index ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/index.skb:index@ */ +;*---------------------------------------------------------------------*/ +(define-markup (index #!rest + opts + #!key + (ident #f) (class "index") + (note #f) (index #f) (shape #f) + (url #f)) + (let* ((entry-name (the-body opts)) + (ename (cond + ((string? entry-name) + entry-name) + ((and (pair? entry-name) (every string? entry-name)) + (apply string-append entry-name)) + (else + (skribe-error + 'index + "entry-name must be either a string or a list of strings" + entry-name)))) + (table (cond + ((not index) (default-index)) + ((index? index) index) + (else (skribe-type-error 'index + "Illegal index table, " + index + "index")))) + (m (mark (symbol->string (gensym)))) + (h (new handle (ast m))) + (new (new markup + (markup '&index-entry) + (ident (or ident (symbol->string (gensym 'index)))) + (class class) + (options `((name ,ename) ,@(the-options opts :ident :class))) + (body (if url + (ref :url url :text (or shape ename)) + (ref :handle h :text (or shape ename))))))) + ;; New is bound to a dummy option of the mark in order + ;; to make new options verified. + (markup-option-add! m 'to-verify new) + (hashtable-update! table + ename + (lambda (cur) (cons new cur)) + (list new)) + m)) + +;*---------------------------------------------------------------------*/ +;* the-index ... */ +;* ------------------------------------------------------------- */ +;* doc: */ +;* @ref ../../doc/user/index.skb:the-index@ */ +;* writer: */ +;* base: @ref ../../skr/base.skr:the-index@ */ +;* html: @ref ../../skr/html.skr:the-index-header@ */ +;*---------------------------------------------------------------------*/ +(define-markup (the-index #!rest + opts + #!key + (ident #f) + (class "the-index") + (split #f) + (char-offset 0) + (header-limit 50) + (column 1)) + (let ((bd (the-body opts))) + (cond + ((not (and (integer? char-offset) (>= char-offset 0))) + (skribe-error 'the-index "Illegal char offset" char-offset)) + ((not (integer? column)) + (skribe-error 'the-index "Illegal column number" column)) + ((not (every? index? bd)) + (skribe-error 'the-index + "Illegal indexes" + (filter (lambda (o) (not (index? o))) bd))) + (else + (new unresolved + (proc (lambda (n e env) + (resolve-the-index (ast-loc n) + ident class + bd + split + char-offset + header-limit + column)))))))) diff --git a/src/guile/skribilo/skribe/bib.scm b/src/guile/skribilo/skribe/bib.scm new file mode 100644 index 0000000..f1a32c1 --- /dev/null +++ b/src/guile/skribilo/skribe/bib.scm @@ -0,0 +1,215 @@ +;;; lib.scm +;;; +;;; Copyright 2001, 2002, 2003, 2004 Manuel Serrano +;;; Copyright 2005 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 skribe bib)) + +;;; Author: Manuel Serrano +;;; Commentary: +;;; +;;; A library of bibliography-related functions. +;;; +;;; Code: + + +;;; The contents of the file below are unchanged compared to Skribe 1.2d's +;;; `bib.scm' file found in the `common' directory. + + +;*---------------------------------------------------------------------*/ +;* bib-load! ... */ +;*---------------------------------------------------------------------*/ +(define (bib-load! table filename command) + (if (not (bib-table? table)) + (skribe-error 'bib-load "Illegal bibliography table" table) + ;; read the file + (let ((p (skribe-open-bib-file filename command))) + (if (not (input-port? p)) + (skribe-error 'bib-load "Can't open data base" filename) + (unwind-protect + (parse-bib table p) + (close-input-port p)))))) + +;*---------------------------------------------------------------------*/ +;* resolve-bib ... */ +;*---------------------------------------------------------------------*/ +(define (resolve-bib table ident) + (if (not (bib-table? table)) + (skribe-error 'resolve-bib "Illegal bibliography table" table) + (let* ((i (cond + ((string? ident) ident) + ((symbol? ident) (symbol->string ident)) + (else (skribe-error 'resolve-bib "Illegal ident" ident)))) + (en (hashtable-get table i))) + (if (is-markup? en '&bib-entry) + en + #f)))) + +;*---------------------------------------------------------------------*/ +;* make-bib-entry ... */ +;*---------------------------------------------------------------------*/ +(define (make-bib-entry kind ident fields from) + (let* ((m (new markup + (markup '&bib-entry) + (ident ident) + (options `((kind ,kind) (from ,from))))) + (h (new handle + (ast m)))) + (for-each (lambda (f) + (if (and (pair? f) + (pair? (cdr f)) + (null? (cddr f)) + (symbol? (car f))) + (markup-option-add! m + (car f) + (new markup + (markup (symbol-append + '&bib-entry- + (car f))) + (parent h) + (body (cadr f)))) + (bib-parse-error f))) + fields) + m)) + +;*---------------------------------------------------------------------*/ +;* bib-sort/authors ... */ +;*---------------------------------------------------------------------*/ +(define (bib-sort/authors l) + (define (cmp i1 i2 def) + (cond + ((and (markup? i1) (markup? i2)) + (cmp (markup-body i1) (markup-body i2) def)) + ((markup? i1) + (cmp (markup-body i1) i2 def)) + ((markup? i2) + (cmp i1 (markup-body i2) def)) + ((and (string? i1) (string? i2)) + (if (string=? i1 i2) + (def) + (string<? i1 i2))) + ((string? i1) + #f) + ((string? i2) + #t) + (else + (def)))) + (sort l (lambda (e1 e2) + (cmp (markup-option e1 'author) + (markup-option e2 'author) + (lambda () + (cmp (markup-option e1 'year) + (markup-option e2 'year) + (lambda () + (cmp (markup-option e1 'title) + (markup-option e2 'title) + (lambda () + (cmp (markup-ident e1) + (markup-ident e2) + (lambda () + #t))))))))))) + +;*---------------------------------------------------------------------*/ +;* bib-sort/idents ... */ +;*---------------------------------------------------------------------*/ +(define (bib-sort/idents l) + (sort l (lambda (e f) (string<? (markup-ident e) (markup-ident f))))) + +;*---------------------------------------------------------------------*/ +;* bib-sort/dates ... */ +;*---------------------------------------------------------------------*/ +(define (bib-sort/dates l) + (sort l (lambda (p1 p2) + (define (month-num m) + (let ((body (markup-body m))) + (if (not (string? body)) + 13 + (let* ((s (if (> (string-length body) 3) + (substring body 0 3) + body)) + (sy (string->symbol (string-downcase body))) + (c (assq sy '((jan . 1) + (feb . 2) + (mar . 3) + (apr . 4) + (may . 5) + (jun . 6) + (jul . 7) + (aug . 8) + (sep . 9) + (oct . 10) + (nov . 11) + (dec . 12))))) + (if (pair? c) (cdr c) 13))))) + (let ((d1 (markup-option p1 'year)) + (d2 (markup-option p2 'year))) + (cond + ((not (markup? d1)) #f) + ((not (markup? d2)) #t) + (else + (let ((y1 (markup-body d1)) + (y2 (markup-body d2))) + (cond + ((string>? y1 y2) #t) + ((string<? y1 y2) #f) + (else + (let ((d1 (markup-option p1 'month)) + (d2 (markup-option p2 'month))) + (cond + ((not (markup? d1)) #f) + ((not (markup? d2)) #t) + (else + (let ((m1 (month-num d1)) + (m2 (month-num d2))) + (> m1 m2)))))))))))))) + +;*---------------------------------------------------------------------*/ +;* resolve-the-bib ... */ +;*---------------------------------------------------------------------*/ +(define (resolve-the-bib table n sort pred count opts) + (define (count! entries) + (let loop ((es entries) + (i 1)) + (if (pair? es) + (begin + (markup-option-add! (car es) + :title + (new markup + (markup '&bib-entry-ident) + (parent (car es)) + (options `((number ,i))) + (body (new handle + (ast (car es)))))) + (loop (cdr es) (+ i 1)))))) + (if (not (bib-table? table)) + (skribe-error 'resolve-the-bib "Illegal bibliography table" table) + (let* ((es (sort (hashtable->list table))) + (fes (filter (if (procedure? pred) + (lambda (m) (pred m n)) + (lambda (m) (pair? (markup-option m 'used)))) + es))) + (count! (if (eq? count 'full) es fes)) + (new markup + (markup '&the-bibliography) + (options opts) + (body fes))))) + + +;;; bib.scm ends here diff --git a/src/guile/skribilo/skribe/index.scm b/src/guile/skribilo/skribe/index.scm new file mode 100644 index 0000000..840a179 --- /dev/null +++ b/src/guile/skribilo/skribe/index.scm @@ -0,0 +1,149 @@ +;;; index.scm +;;; +;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2005 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 skribe index)) + +;;; Author: Manuel Serrano +;;; Commentary: +;;; +;;; A library of index-related functions. +;;; +;;; Code: + + +;;; The contents of the file below are unchanged compared to Skribe 1.2d's +;;; `index.scm' file found in the `common' directory. + + +;*---------------------------------------------------------------------*/ +;* index? ... */ +;*---------------------------------------------------------------------*/ +(define (index? obj) + (hashtable? obj)) + +;*---------------------------------------------------------------------*/ +;* *index-table* ... */ +;*---------------------------------------------------------------------*/ +(define *index-table* #f) + +;*---------------------------------------------------------------------*/ +;* make-index-table ... */ +;*---------------------------------------------------------------------*/ +(define (make-index-table ident) + (make-hashtable)) + +;*---------------------------------------------------------------------*/ +;* default-index ... */ +;*---------------------------------------------------------------------*/ +(define (default-index) + (if (not *index-table*) + (set! *index-table* (make-index-table "default-index"))) + *index-table*) + +;*---------------------------------------------------------------------*/ +;* resolve-the-index ... */ +;*---------------------------------------------------------------------*/ +(define (resolve-the-index loc i c indexes split char-offset header-limit col) + ;; fetch the descriminating index name letter + (define (index-ref n) + (let ((name (markup-option n 'name))) + (if (>= char-offset (string-length name)) + (skribe-error 'the-index "char-offset out of bound" char-offset) + (string-ref name char-offset)))) + ;; sort a bucket of entries (the entries in a bucket share there name) + (define (sort-entries-bucket ie) + (sort ie + (lambda (i1 i2) + (or (not (markup-option i1 :note)) + (markup-option i2 :note))))) + ;; accumulate all the entries starting with the same letter + (define (letter-references refs) + (let ((letter (index-ref (car (car refs))))) + (let loop ((refs refs) + (acc '())) + (if (or (null? refs) + (not (char-ci=? letter (index-ref (car (car refs)))))) + (values (char-upcase letter) acc refs) + (loop (cdr refs) (cons (car refs) acc)))))) + ;; merge the buckets that comes from different index tables + (define (merge-buckets buckets) + (if (null? buckets) + '() + (let loop ((buckets buckets) + (res '())) + (cond + ((null? (cdr buckets)) + (reverse! (cons (car buckets) res))) + ((string=? (markup-option (car (car buckets)) 'name) + (markup-option (car (cadr buckets)) 'name)) + ;; we merge + (loop (cons (append (car buckets) (cadr buckets)) + (cddr buckets)) + res)) + (else + (loop (cdr buckets) + (cons (car buckets) res))))))) + (let* ((entries (apply append (map hashtable->list indexes))) + (sorted (map sort-entries-bucket + (merge-buckets + (sort entries + (lambda (e1 e2) + (string-ci<? + (markup-option (car e1) 'name) + (markup-option (car e2) 'name)))))))) + (if (and (not split) (< (apply + (map length sorted)) header-limit)) + (new markup + (markup '&the-index) + (loc loc) + (ident i) + (class c) + (options `((:column ,col))) + (body sorted)) + (let loop ((refs sorted) + (lrefs '()) + (body '())) + (if (null? refs) + (new markup + (markup '&the-index) + (loc loc) + (ident i) + (class c) + (options `((:column ,col) + (header ,(new markup + (markup '&the-index-header) + (loc loc) + (body (reverse! lrefs)))))) + (body (reverse! body))) + (call-with-values + (lambda () (letter-references refs)) + (lambda (l lr next-refs) + (let* ((s (string l)) + (m (mark (symbol->string (gensym s)) :text s)) + (h (new handle (loc loc) (ast m))) + (r (ref :handle h :text s))) + (ast-loc-set! m loc) + (ast-loc-set! r loc) + (loop next-refs + (cons r lrefs) + (append lr (cons m body))))))))))) + + +;;; index.scm ends here diff --git a/src/guile/skribilo/skribe/param.scm b/src/guile/skribilo/skribe/param.scm new file mode 100644 index 0000000..8daca62 --- /dev/null +++ b/src/guile/skribilo/skribe/param.scm @@ -0,0 +1,93 @@ +;;; param.scm +;;; +;;; Copyright 2003 Manuel Serrano +;;; Copyright 2005 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 skribe param)) + +;;; Author: Manuel Serrano +;;; Commentary: +;;; +;;; Definition of various Skribe run-time parameters. +;;; +;;; Code: + + +;;; The contents of the file below are unchanged compared to Skribe 1.2d's +;;; `param.scm' file found in the `common' directory. + + +;*---------------------------------------------------------------------*/ +;* *skribe-rc-file* ... */ +;* ------------------------------------------------------------- */ +;* The "runtime command" file. */ +;*---------------------------------------------------------------------*/ +(define *skribe-rc-file* "skriberc") + +;*---------------------------------------------------------------------*/ +;* *skribe-auto-mode-alist* ... */ +;*---------------------------------------------------------------------*/ +(define *skribe-auto-mode-alist* + '(("html" . html) + ("sui" . sui) + ("tex" . latex) + ("ctex" . context) + ("xml" . xml) + ("info" . info) + ("txt" . ascii) + ("mgp" . mgp) + ("man" . man))) + +;*---------------------------------------------------------------------*/ +;* *skribe-auto-load-alist* ... */ +;* ------------------------------------------------------------- */ +;* Autoload engines. */ +;*---------------------------------------------------------------------*/ +(define *skribe-auto-load-alist* + '((base . "base.skr") + (html . "html.skr") + (sui . "html.skr") + (latex . "latex.skr") + (context . "context.skr") + (xml . "xml.skr"))) + +;*---------------------------------------------------------------------*/ +;* *skribe-preload* ... */ +;* ------------------------------------------------------------- */ +;* The list of skribe files (e.g. styles) to be loaded at boot-time */ +;*---------------------------------------------------------------------*/ +(define *skribe-preload* + '("skribe.skr")) + +;*---------------------------------------------------------------------*/ +;* *skribe-precustom* ... */ +;* ------------------------------------------------------------- */ +;* The list of pair <custom x value> to be assigned to the default */ +;* engine. */ +;*---------------------------------------------------------------------*/ +(define *skribe-precustom* + '()) + +;*---------------------------------------------------------------------*/ +;* *skribebib-auto-mode-alist* ... */ +;*---------------------------------------------------------------------*/ +(define *skribebib-auto-mode-alist* + '(("bib" . "skribebibtex"))) + +;;; param.scm ends here diff --git a/src/guile/skribilo/skribe/sui.scm b/src/guile/skribilo/skribe/sui.scm new file mode 100644 index 0000000..9baa36a --- /dev/null +++ b/src/guile/skribilo/skribe/sui.scm @@ -0,0 +1,187 @@ +;;; sui.scm +;;; +;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2005 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 skribe sui)) + +;;; Author: Manuel Serrano +;;; Commentary: +;;; +;;; Library dealing with Skribe URL Indexes (SUI). +;;; +;;; Code: + + +;;; The contents of the file below are unchanged compared to Skribe 1.2d's +;;; `sui.scm' file found in the `common' directory. + + +;*---------------------------------------------------------------------*/ +;* *sui-table* ... */ +;*---------------------------------------------------------------------*/ +(define *sui-table* (make-hashtable)) + +;*---------------------------------------------------------------------*/ +;* load-sui ... */ +;* ------------------------------------------------------------- */ +;* Returns a SUI sexp if already loaded. Load it otherwise. */ +;* Raise an error if the file cannot be open. */ +;*---------------------------------------------------------------------*/ +(define (load-sui path) + (let ((sexp (hashtable-get *sui-table* path))) + (or sexp + (begin + (when (> *skribe-verbose* 0) + (fprintf (current-error-port) " [loading sui: ~a]\n" path)) + (let ((p (open-input-file path))) + (if (not (input-port? p)) + (skribe-error 'load-sui + "Can't find `Skribe Url Index' file" + path) + (unwind-protect + (let ((sexp (read p))) + (match-case sexp + ((sui (? string?) . ?-) + (hashtable-put! *sui-table* path sexp)) + (else + (skribe-error 'load-sui + "Illegal `Skribe Url Index' file" + path))) + sexp) + (close-input-port p)))))))) + +;*---------------------------------------------------------------------*/ +;* sui-ref->url ... */ +;*---------------------------------------------------------------------*/ +(define (sui-ref->url dir sui ident opts) + (let ((refs (sui-find-ref sui ident opts))) + (and (pair? refs) + (let ((base (sui-file sui)) + (file (car (car refs))) + (mark (cdr (car refs)))) + (format "~a/~a#~a" dir (or file base) mark))))) + +;*---------------------------------------------------------------------*/ +;* sui-title ... */ +;*---------------------------------------------------------------------*/ +(define (sui-title sexp) + (match-case sexp + ((sui (and ?title (? string?)) . ?-) + title) + (else + (skribe-error 'sui-title "Illegal `sui' format" sexp)))) + +;*---------------------------------------------------------------------*/ +;* sui-file ... */ +;*---------------------------------------------------------------------*/ +(define (sui-file sexp) + (sui-key sexp :file)) + +;*---------------------------------------------------------------------*/ +;* sui-key ... */ +;*---------------------------------------------------------------------*/ +(define (sui-key sexp key) + (match-case sexp + ((sui ?- . ?rest) + (let loop ((rest rest)) + (and (pair? rest) + (if (eq? (car rest) key) + (and (pair? (cdr rest)) + (cadr rest)) + (loop (cdr rest)))))) + (else + (skribe-error 'sui-key "Illegal `sui' format" sexp)))) + +;*---------------------------------------------------------------------*/ +;* sui-find-ref ... */ +;*---------------------------------------------------------------------*/ +(define (sui-find-ref sui ident opts) + (let ((ident (assq :ident opts)) + (mark (assq :mark opts)) + (class (let ((c (assq :class opts))) + (and (pair? c) (cadr c)))) + (chapter (assq :chapter opts)) + (section (assq :section opts)) + (subsection (assq :subsection opts)) + (subsubsection (assq :subsubsection opts))) + (match-case sui + ((sui (? string?) . ?refs) + (cond + (mark (sui-search-ref 'marks refs (cadr mark) class)) + (chapter (sui-search-ref 'chapters refs (cadr chapter) class)) + (section (sui-search-ref 'sections refs (cadr section) class)) + (subsection (sui-search-ref 'subsections refs (cadr subsection) class)) + (subsubsection (sui-search-ref 'subsubsections refs (cadr subsubsection) class)) + (ident (sui-search-all-refs sui ident class)) + (else '()))) + (else + (skribe-error 'sui-find-ref "Illegal `sui' format" sui))))) + +;*---------------------------------------------------------------------*/ +;* sui-search-all-refs ... */ +;*---------------------------------------------------------------------*/ +(define (sui-search-all-refs sui id refs) + '()) + +;*---------------------------------------------------------------------*/ +;* sui-search-ref ... */ +;*---------------------------------------------------------------------*/ +(define (sui-search-ref kind refs val class) + (define (find-ref refs val class) + (map (lambda (r) + (let ((f (memq :file r)) + (c (memq :mark r))) + (cons (and (pair? f) (cadr f)) (and (pair? c) (cadr c))))) + (filter (if class + (lambda (m) + (and (pair? m) + (string? (car m)) + (string=? (car m) val) + (let ((c (memq :class m))) + (and (pair? c) + (eq? (cadr c) class))))) + (lambda (m) + (and (pair? m) + (string? (car m)) + (string=? (car m) val)))) + refs))) + (let loop ((refs refs)) + (if (pair? refs) + (if (and (pair? (car refs)) (eq? (caar refs) kind)) + (find-ref (cdar refs) val class) + (loop (cdr refs))) + '()))) + +;*---------------------------------------------------------------------*/ +;* sui-filter ... */ +;*---------------------------------------------------------------------*/ +(define (sui-filter sui pred1 pred2) + (match-case sui + ((sui (? string?) . ?refs) + (let loop ((refs refs) + (res '())) + (if (pair? refs) + (if (and (pred1 (car refs))) + (loop (cdr refs) + (cons (filter pred2 (cdar refs)) res)) + (loop (cdr refs) res)) + (reverse! res)))) + (else + (skribe-error 'sui-filter "Illegal `sui' format" sui)))) diff --git a/src/guile/skribilo/skribe/utils.scm b/src/guile/skribilo/skribe/utils.scm new file mode 100644 index 0000000..f963020 --- /dev/null +++ b/src/guile/skribilo/skribe/utils.scm @@ -0,0 +1,259 @@ +;;; utils.scm +;;; +;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2005 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 skribe utils)) + +;;; Author: Manuel Serrano +;;; Commentary: +;;; +;;; A library of various utilities, including AST traversal helper functions. +;;; +;;; Code: + + +;;; The contents of the file below are unchanged compared to Skribe 1.2d's +;;; `lib.scm' file found in the `common' directory. + +;*---------------------------------------------------------------------*/ +;* engine-custom-add! ... */ +;*---------------------------------------------------------------------*/ +(define (engine-custom-add! e id val) + (let ((old (engine-custom e id))) + (if (unspecified? old) + (engine-custom-set! e id (list val)) + (engine-custom-set! e id (cons val old))))) + +;*---------------------------------------------------------------------*/ +;* find-markup-ident ... */ +;*---------------------------------------------------------------------*/ +(define (find-markup-ident ident) + (let ((r (find-markups ident))) + (if (or (pair? r) (null? r)) + r + '()))) + +;*---------------------------------------------------------------------*/ +;* container-search-down ... */ +;*---------------------------------------------------------------------*/ +(define (container-search-down pred obj) + (with-debug 4 'container-search-down + (debug-item "obj=" (find-runtime-type obj)) + (let loop ((obj (markup-body obj))) + (cond + ((pair? obj) + (apply append (map (lambda (o) (loop o)) obj))) + ((container? obj) + (let ((rest (loop (markup-body obj)))) + (if (pred obj) + (cons obj rest) + rest))) + ((pred obj) + (list obj)) + (else + '()))))) + +;*---------------------------------------------------------------------*/ +;* search-down ... */ +;*---------------------------------------------------------------------*/ +(define (search-down pred obj) + (with-debug 4 'search-down + (debug-item "obj=" (find-runtime-type obj)) + (let loop ((obj (markup-body obj))) + (cond + ((pair? obj) + (apply append (map (lambda (o) (loop o)) obj))) + ((markup? obj) + (let ((rest (loop (markup-body obj)))) + (if (pred obj) + (cons obj rest) + rest))) + ((pred obj) + (list obj)) + (else + '()))))) + +;*---------------------------------------------------------------------*/ +;* find-down ... */ +;*---------------------------------------------------------------------*/ +(define (find-down pred obj) + (with-debug 4 'find-down + (debug-item "obj=" (find-runtime-type obj)) + (let loop ((obj obj)) + (cond + ((pair? obj) + (apply append (map (lambda (o) (loop o)) obj))) + ((markup? obj) + (debug-item "loop=" (find-runtime-type obj) + " " (markup-ident obj)) + (if (pred obj) + (list (cons obj (loop (markup-body obj)))) + '())) + (else + (if (pred obj) + (list obj) + '())))))) + +;*---------------------------------------------------------------------*/ +;* find1-down ... */ +;*---------------------------------------------------------------------*/ +(define (find1-down pred obj) + (with-debug 4 'find1-down + (let loop ((obj obj) + (stack '())) + (debug-item "obj=" (find-runtime-type obj) + " " (if (markup? obj) (markup-markup obj) "???") + " " (if (markup? obj) (markup-ident obj) "")) + (cond + ((memq obj stack) + (skribe-error 'find1-down "Illegal cyclic object" obj)) + ((pair? obj) + (let liip ((obj obj)) + (cond + ((null? obj) + #f) + (else + (or (loop (car obj) (cons obj stack)) + (liip (cdr obj))))))) + ((pred obj) + obj) + ((markup? obj) + (loop (markup-body obj) (cons obj stack))) + (else + #f))))) + +;*---------------------------------------------------------------------*/ +;* find-up ... */ +;*---------------------------------------------------------------------*/ +(define (find-up pred obj) + (let loop ((obj obj) + (res '())) + (cond + ((not (ast? obj)) + res) + ((pred obj) + (loop (ast-parent obj) (cons obj res))) + (else + (loop (ast-parent obj) (cons obj res)))))) + +;*---------------------------------------------------------------------*/ +;* find1-up ... */ +;*---------------------------------------------------------------------*/ +(define (find1-up pred obj) + (let loop ((obj obj)) + (cond + ((not (ast? obj)) + #f) + ((pred obj) + obj) + (else + (loop (ast-parent obj)))))) + +;*---------------------------------------------------------------------*/ +;* ast-document ... */ +;*---------------------------------------------------------------------*/ +(define (ast-document m) + (find1-up document? m)) + +;*---------------------------------------------------------------------*/ +;* ast-chapter ... */ +;*---------------------------------------------------------------------*/ +(define (ast-chapter m) + (find1-up (lambda (n) (is-markup? n 'chapter)) m)) + +;*---------------------------------------------------------------------*/ +;* ast-section ... */ +;*---------------------------------------------------------------------*/ +(define (ast-section m) + (find1-up (lambda (n) (is-markup? n 'section)) m)) + +;*---------------------------------------------------------------------*/ +;* the-body ... */ +;* ------------------------------------------------------------- */ +;* Filter out the options */ +;*---------------------------------------------------------------------*/ +(define (the-body opt+) + (let loop ((opt* opt+) + (res '())) + (cond + ((null? opt*) + (reverse! res)) + ((not (pair? opt*)) + (skribe-error 'the-body "Illegal body" opt*)) + ((keyword? (car opt*)) + (if (null? (cdr opt*)) + (skribe-error 'the-body "Illegal option" (car opt*)) + (loop (cddr opt*) res))) + (else + (loop (cdr opt*) (cons (car opt*) res)))))) + +;*---------------------------------------------------------------------*/ +;* the-options ... */ +;* ------------------------------------------------------------- */ +;* Returns an list made of options. The OUT argument contains */ +;* keywords that are filtered out. */ +;*---------------------------------------------------------------------*/ +(define (the-options opt+ . out) + (let loop ((opt* opt+) + (res '())) + (cond + ((null? opt*) + (reverse! res)) + ((not (pair? opt*)) + (skribe-error 'the-options "Illegal options" opt*)) + ((keyword? (car opt*)) + (cond + ((null? (cdr opt*)) + (skribe-error 'the-options "Illegal option" (car opt*))) + ((memq (car opt*) out) + (loop (cdr opt*) res)) + (else + (loop (cdr opt*) + (cons (list (car opt*) (cadr opt*)) res))))) + (else + (loop (cdr opt*) res))))) + +;*---------------------------------------------------------------------*/ +;* list-split ... */ +;*---------------------------------------------------------------------*/ +(define (list-split l num . fill) + (let loop ((l l) + (i 0) + (acc '()) + (res '())) + (cond + ((null? l) + (reverse! (cons (if (or (null? fill) (= i num)) + (reverse! acc) + (append! (reverse! acc) + (make-list (- num i) (car fill)))) + res))) + ((= i num) + (loop l + 0 + '() + (cons (reverse! acc) res))) + (else + (loop (cdr l) + (+ i 1) + (cons (car l) acc) + res))))) + +;;; utils.scm ends here diff --git a/src/guile/skribe/source.scm b/src/guile/skribilo/source.scm index 6ec0963..e56f350 100644 --- a/src/guile/skribe/source.scm +++ b/src/guile/skribilo/source.scm @@ -26,7 +26,7 @@ -(define-module (skribe source) +(define-module (skribilo source) :export (source-read-lines source-read-definition source-fontify)) diff --git a/src/guile/skribilo/types.scm b/src/guile/skribilo/types.scm new file mode 100644 index 0000000..0d51c70 --- /dev/null +++ b/src/guile/skribilo/types.scm @@ -0,0 +1,315 @@ +;;; +;;; types.stk -- Definition of Skribe classes +;;; +;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.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: 12-Aug-2003 22:18 (eg) +;;; Last file update: 28-Oct-2004 16:18 (eg) +;;; + +(read-set! keywords 'prefix) +(define-module (skribilo types) ;; FIXME: Why should it be a separate module? + :export (<ast> ast? ast-loc ast-loc-set! + <command> command? command-fmt command-body + <unresolved> unresolved? unresolved-proc + <handle> handle? handle-ast + <node> node? node-options node-loc + <engine> engine? engine-ident engine-format engine-customs + engine-filter engine-symbol-table + <writer> writer? write-object + <processor> processor? processor-combinator processor-engine + <markup> markup? bind-markup! markup-options is-markup? + markup-body find-markups write-object + <container> container? container-options + container-ident container-body + <document> document? document-ident document-body + document-options document-end + <language> language? + <location> location? ast-location + + *node-table*) + :use-module (oop goops)) + +(define *node-table* (make-hash-table)) + ; Used to stores the nodes of an AST. + ; It permits to retrieve a node from its + ; identifier. + + +;;; ====================================================================== +;;; +;;; <AST> +;;; +;;; ====================================================================== +;;FIXME: set! location in <ast> +(define-class <ast> () + (parent :accessor ast-parent :init-keyword :parent :init-value 'unspecified) + (loc :init-value #f)) + +(define (ast? obj) (is-a? obj <ast>)) +(define (ast-loc obj) (slot-ref obj 'loc)) +(define (ast-loc-set! obj v) (slot-set! obj 'loc v)) + +;;; ====================================================================== +;;; +;;; <COMMAND> +;;; +;;; ====================================================================== +(define-class <command> (<ast>) + (fmt :init-keyword :fmt) + (body :init-keyword :body)) + +(define (command? obj) (is-a? obj <command>)) +(define (command-fmt obj) (slot-ref obj 'fmt)) +(define (command-body obj) (slot-ref obj 'body)) + +;;; ====================================================================== +;;; +;;; <UNRESOLVED> +;;; +;;; ====================================================================== +(define-class <unresolved> (<ast>) + (proc :init-keyword :proc)) + +(define (unresolved? obj) (is-a? obj <unresolved>)) +(define (unresolved-proc obj) (slot-ref obj 'proc)) + +;;; ====================================================================== +;;; +;;; <HANDLE> +;;; +;;; ====================================================================== +(define-class <handle> (<ast>) + (ast :init-keyword :ast :init-value #f :getter handle-ast)) + +(define (handle? obj) (is-a? obj <handle>)) +(define (handle-ast obj) (slot-ref obj 'ast)) + +;;; ====================================================================== +;;; +;;; <ENGINE> +;;; +;;; ====================================================================== +(define-class <engine> () + (ident :init-keyword :ident :init-value '???) + (format :init-keyword :format :init-value "raw") + (info :init-keyword :info :init-value '()) + (version :init-keyword :version :init-value 'unspecified) + (delegate :init-keyword :delegate :init-value #f) + (writers :init-keyword :writers :init-value '()) + (filter :init-keyword :filter :init-value #f) + (customs :init-keyword :custom :init-value '()) + (symbol-table :init-keyword :symbol-table :init-value '())) + + + + +(define (engine? obj) + (is-a? obj <engine>)) + +(define (engine-ident obj) ;; Define it here since the doc searches it + (slot-ref obj 'ident)) + +(define (engine-format obj) ;; Define it here since the doc searches it + (slot-ref obj 'format)) + +(define (engine-customs obj) ;; Define it here since the doc searches it + (slot-ref obj 'customs)) + +(define (engine-filter obj) ;; Define it here since the doc searches it + (slot-ref obj 'filter)) + +(define (engine-symbol-table obj) ;; Define it here since the doc searches it + (slot-ref obj 'symbol-table)) + +;;; ====================================================================== +;;; +;;; <WRITER> +;;; +;;; ====================================================================== +(define-class <writer> () + (ident :init-keyword :ident :init-value '??? :getter writer-ident) + (class :init-keyword :class :init-value 'unspecified + :getter writer-class) + (pred :init-keyword :pred :init-value 'unspecified) + (upred :init-keyword :upred :init-value 'unspecified) + (options :init-keyword :options :init-value '() :getter writer-options) + (verified? :init-keyword :verified? :init-value #f) + (validate :init-keyword :validate :init-value #f) + (before :init-keyword :before :init-value #f :getter writer-before) + (action :init-keyword :action :init-value #f :getter writer-action) + (after :init-keyword :after :init-value #f :getter writer-after)) + +(define (writer? obj) + (is-a? obj <writer>)) + +(define-method (write-object (obj <writer>) port) + (format port "#[~A (~A) ~A]" + (class-name (class-of obj)) + (slot-ref obj 'ident) + (address-of obj))) + +;;; ====================================================================== +;;; +;;; <NODE> +;;; +;;; ====================================================================== +(define-class <node> (<ast>) + (required-options :init-keyword :required-options :init-value '()) + (options :init-keyword :options :init-value '()) + (body :init-keyword :body :init-value #f + :getter node-body)) + +(define (node? obj) (is-a? obj <node>)) +(define (node-options obj) (slot-ref obj 'options)) +(define node-loc ast-loc) + + +;;; ====================================================================== +;;; +;;; <PROCESSOR> +;;; +;;; ====================================================================== +(define-class <processor> (<node>) + (combinator :init-keyword :combinator :init-value (lambda (e1 e2) e1)) + (engine :init-keyword :engine :init-value 'unspecified) + (procedure :init-keyword :procedure :init-value (lambda (n e) n))) + +(define (processor? obj) (is-a? obj <processor>)) +(define (processor-combinator obj) (slot-ref obj 'combinator)) +(define (processor-engine obj) (slot-ref obj 'engine)) + +;;; ====================================================================== +;;; +;;; <MARKUP> +;;; +;;; ====================================================================== +(define-class <markup> (<node>) + (ident :init-keyword :ident :getter markup-ident :init-value #f) + (class :init-keyword :class :getter markup-class :init-value #f) + (markup :init-keyword :markup :getter markup-markup)) + + +(define (bind-markup! node) + (hash-set! *node-table* + (markup-ident node) + ;(lambda (cur) (cons node cur)) + (list node))) + + +(define-method (initialize (self <markup>) initargs) + (next-method) + (bind-markup! self)) + + +(define (markup? obj) (is-a? obj <markup>)) +(define (markup-options obj) (slot-ref obj 'options)) +(define markup-body node-body) + + +(define (is-markup? obj markup) + (and (is-a? obj <markup>) + (eq? (slot-ref obj 'markup) markup))) + + + +(define (find-markups ident) + (hash-ref *node-table* ident #f)) + + +(define-method (write-object (obj <markup>) port) + (format port "#[~A (~A/~A) ~A]" + (class-name (class-of obj)) + (slot-ref obj 'markup) + (slot-ref obj 'ident) + (address-of obj))) + +;;; ====================================================================== +;;; +;;; <CONTAINER> +;;; +;;; ====================================================================== +(define-class <container> (<markup>) + (env :init-keyword :env :init-value '())) + +(define (container? obj) (is-a? obj <container>)) +(define (container-env obj) (slot-ref obj 'env)) +(define container-options markup-options) +(define container-ident markup-ident) +(define container-body node-body) + + + +;;; ====================================================================== +;;; +;;; <DOCUMENT> +;;; +;;; ====================================================================== +(define-class <document> (<container>)) + +(define (document? obj) (is-a? obj <document>)) +(define (document-ident obj) (slot-ref obj 'ident)) +(define (document-body obj) (slot-ref obj 'body)) +(define document-options markup-options) +(define document-env container-env) + + + +;;; ====================================================================== +;;; +;;; <LANGUAGE> +;;; +;;; ====================================================================== +(define-class <language> () + (name :init-keyword :name :init-value #f :getter langage-name) + (fontifier :init-keyword :fontifier :init-value #f :getter langage-fontifier) + (extractor :init-keyword :extractor :init-value #f :getter langage-extractor)) + +(define (language? obj) + (is-a? obj <language>)) + + +;;; ====================================================================== +;;; +;;; <LOCATION> +;;; +;;; ====================================================================== +(define-class <location> () + (file :init-keyword :file :getter location-file) + (pos :init-keyword :pos :getter location-pos) + (line :init-keyword :line :getter location-line)) + +(define (location? obj) + (is-a? obj <location>)) + +(define (ast-location obj) + (let ((loc (slot-ref obj 'loc))) + (if (location? loc) + (let* ((fname (location-file loc)) + (line (location-line loc)) + (pwd (getcwd)) + (len (string-length pwd)) + (lenf (string-length fname)) + (file (if (and (substring=? pwd fname len) + (> lenf len)) + (substring fname len (+ 1 (string-length fname))) + fname))) + (format "~a, line ~a" file line)) + "no source location"))) diff --git a/src/guile/skribilo/vars.scm b/src/guile/skribilo/vars.scm new file mode 100644 index 0000000..51a7ee7 --- /dev/null +++ b/src/guile/skribilo/vars.scm @@ -0,0 +1,65 @@ +;;; +;;; vars.scm -- Skribe Globals +;;; +;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;; Copyright 2005 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 vars)) + +;;; +;;; Switches +;;; +(define-public *skribe-verbose* 0) +(define-public *skribe-warning* 5) +(define-public *load-rc* #t) + +;;; +;;; PATH variables +;;; +(define-public *skribe-path* #f) +(define-public *skribe-bib-path* '(".")) +(define-public *skribe-source-path* '(".")) +(define-public *skribe-image-path* '(".")) + + +(define-public *skribe-rc-directory* + (string-append (getenv "HOME") "/" ".skribilo")) + + +;;; +;;; In and out ports +;;; +(define-public *skribe-src* '()) +(define-public *skribe-dest* #f) + +;;; +;;; Engine +;;; +(define-public *skribe-engine* 'html) ;; Use HTML by default + +;;; +;;; Misc +;;; +(define-public *skribe-chapter-split* '()) +(define-public *skribe-ref-base* #f) +(define-public *skribe-convert-image* #f) ;; i.e. use the Skribe standard converter +(define-public *skribe-variants* '()) + + diff --git a/src/guile/skribe/verify.scm b/src/guile/skribilo/verify.scm index 7c88616..93a1be3 100644 --- a/src/guile/skribe/verify.scm +++ b/src/guile/skribilo/verify.scm @@ -24,14 +24,14 @@ ;;;; Last file update: 27-Oct-2004 16:35 (eg) ;;;; -(define-module (skribe verify) +(define-module (skribilo verify) :export (verify)) -(use-modules (skribe debug) -; (skribe engine) -; (skribe writer) -; (skribe runtime) - (skribe types) +(use-modules (skribilo debug) +; (skribilo engine) +; (skribilo writer) +; (skribilo runtime) + (skribilo types) (oop goops)) diff --git a/src/guile/skribe/writer.scm b/src/guile/skribilo/writer.scm index 9e7faf6..048dcfb 100644 --- a/src/guile/skribe/writer.scm +++ b/src/guile/skribilo/writer.scm @@ -25,14 +25,14 @@ ;;;; -(define-module (skribe writer) +(define-module (skribilo writer) :export (invoke markup-writer markup-writer-get markup-writer-get* lookup-markup-writer copy-markup-writer)) -(use-modules (skribe debug) -; (skribe engine) - (skribe output) +(use-modules (skribilo debug) +; (skribilo engine) + (skribilo output) (oop goops) (ice-9 optargs)) |