aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile')
-rwxr-xr-xsrc/guile/skribilo.scm121
-rw-r--r--src/guile/skribilo/ast.scm (renamed from src/guile/skribilo/types.scm)278
-rw-r--r--src/guile/skribilo/biblio.scm50
-rw-r--r--src/guile/skribilo/compat.scm155
-rw-r--r--src/guile/skribilo/engine.scm108
-rw-r--r--src/guile/skribilo/engine/html.scm5
-rw-r--r--src/guile/skribilo/engine/lout.scm355
-rw-r--r--src/guile/skribilo/evaluator.scm49
-rw-r--r--src/guile/skribilo/lib.scm153
-rw-r--r--src/guile/skribilo/location.scm68
-rw-r--r--src/guile/skribilo/module.scm30
-rw-r--r--src/guile/skribilo/output.scm25
-rw-r--r--src/guile/skribilo/parameters.scm65
-rw-r--r--src/guile/skribilo/reader/skribe.scm1
-rw-r--r--src/guile/skribilo/resolve.scm2
-rw-r--r--src/guile/skribilo/runtime.scm234
-rw-r--r--src/guile/skribilo/source.scm30
-rw-r--r--src/guile/skribilo/vars.scm66
-rw-r--r--src/guile/skribilo/verify.scm2
-rw-r--r--src/guile/skribilo/writer.scm78
20 files changed, 916 insertions, 959 deletions
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
index 33c2bb4..c4a5eac 100755
--- a/src/guile/skribilo.scm
+++ b/src/guile/skribilo.scm
@@ -60,23 +60,21 @@ exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@"
-(define-module (skribilo))
+(define-module (skribilo)
+ :autoload (skribilo module) (make-run-time-module)
+ :autoload (skribilo engine) (*current-engine*))
-(use-modules (skribilo module)
- (skribilo runtime)
- (skribilo evaluator)
- (skribilo types)
- (skribilo engine)
+(use-modules (skribilo evaluator)
(skribilo debug)
- (skribilo vars)
+ (skribilo parameters)
(skribilo lib)
+ (srfi srfi-39)
(ice-9 optargs)
(ice-9 getopt-long))
-;;; FIXME: With my `#:reader' thing added to `define-module',
@@ -351,7 +349,7 @@ Processes a Skribilo/Skribe source file and produces its output.
(define (load-rc)
(if *load-rc*
- (let ((file (make-path *skribe-rc-directory* *skribe-rc-file*)))
+ (let ((file (make-path (*rc-directory*) (*rc-file*))))
(if (and file (file-exists? file))
(load file)))))
@@ -373,8 +371,15 @@ Processes a Skribilo/Skribe source file and produces its output.
; (skribe-eval-port (current-input-port) *skribe-engine*))))
(define (doskribe)
- (set-current-module (make-run-time-module))
- (skribe-eval-port (current-input-port) *skribe-engine*))
+ (let ((user-module (current-module)))
+ (dynamic-wind
+ (lambda ()
+ (set-current-module (make-run-time-module)))
+ (lambda ()
+ (format #t "engine is ~a~%" (*current-engine*))
+ (skribe-eval-port (current-input-port) (*current-engine*)))
+ (lambda ()
+ (set-current-module user-module)))))
;;;; ======================================================================
@@ -407,8 +412,6 @@ Processes a Skribilo/Skribe source file and produces its output.
;; Parse the most important options.
- (set! *skribe-engine* engine)
-
(set-skribe-debug! (string->number debugging-level))
(if (> (skribe-debug) 4)
@@ -416,54 +419,50 @@ Processes a Skribilo/Skribe source file and produces its output.
(lambda (file)
(format #t "~~ loading `~a'...~%" file))))
- (set! %skribilo-load-path
- (cons load-path %skribilo-load-path))
- (set! %skribilo-bib-path
- (cons bib-path %skribilo-bib-path))
-
- (if (option-ref options 'verbose #f)
- (set! *skribe-verbose* #t))
-
- ;; Load the user rc file
- ;(load-rc)
-
- ;; Load the base file to bootstrap the system as well as the files
- ;; that are in the PRELOAD variable.
- (find-engine 'base)
- (for-each (lambda (f)
- (skribe-load f :engine *skribe-engine*))
- preload)
-
- ;; Load the specified variants.
- (for-each (lambda (x)
- (skribe-load (format #f "~a.skr" x) :engine *skribe-engine*))
- (reverse! variants))
-
- (let ((files (option-ref options '() '())))
-
- (if (> (length files) 2)
- (error "you can specify at most one input file and one output file"
- files))
-
- (let* ((source-file (if (null? files) #f (car files)))
- (dest-file (if (or (not source-file)
- (null? (cdr files)))
- #f
- (cadr files)))
- (do-it! (lambda ()
- (if (string? dest-file)
- (with-output-to-file dest-file doskribe)
- (doskribe)))))
-
- (set! *skribe-dest* dest-file)
-
- (if (and dest-file (file-exists? dest-file))
- (delete-file dest-file))
-
- (if source-file
- (with-input-from-file source-file
- do-it!)
- (do-it!))))))
+ (parameterize ((*current-engine* engine)
+ (*document-path* (cons load-path (*document-path*)))
+ (*bib-path* (cons bib-path (*bib-path*)))
+ (*verbose* (option-ref options 'verbose #f)))
+
+ ;; Load the user rc file
+ ;;(load-rc)
+
+ (for-each (lambda (f)
+ (skribe-load f :engine (*current-engine*)))
+ preload)
+
+ ;; Load the specified variants.
+ (for-each (lambda (x)
+ (skribe-load (format #f "~a.skr" x)
+ :engine (*current-engine*)))
+ (reverse! variants))
+
+ (let ((files (option-ref options '() '())))
+
+ (if (> (length files) 2)
+ (error "you can specify at most one input file and one output file"
+ files))
+
+ (let* ((source-file (if (null? files) #f (car files)))
+ (dest-file (if (or (not source-file)
+ (null? (cdr files)))
+ #f
+ (cadr files)))
+ (do-it! (lambda ()
+ (if (string? dest-file)
+ (with-output-to-file dest-file doskribe)
+ (doskribe)))))
+
+ (parameterize ((*destination-file* dest-file)
+ (*source-file* source-file))
+
+ (if (and dest-file (file-exists? dest-file))
+ (delete-file dest-file))
+
+ ;; (start-stack 7
+ (if source-file
+ (with-input-from-file source-file do-it!)
+ (do-it!))))))))
(define main skribilo)
diff --git a/src/guile/skribilo/types.scm b/src/guile/skribilo/ast.scm
index ac1edc4..fc6859e 100644
--- a/src/guile/skribilo/types.scm
+++ b/src/guile/skribilo/ast.scm
@@ -1,7 +1,7 @@
+;;; ast.scm -- Skribilo abstract syntax trees.
;;;
-;;; types.stk -- Definition of Skribe classes
-;;;
-;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;; 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
@@ -18,37 +18,43 @@
;;; 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 ast)
+ :use-module (oop goops)
+ :autoload (skribilo location) (location?)
+ :export (<ast> ast? ast-loc ast-loc-set!
+ ast-parent ast->string
+
+ <command> command? command-fmt command-body
+ <unresolved> unresolved? unresolved-proc
+ <handle> handle? handle-ast handle-body
+ <node> node? node-options node-loc
+ <processor> processor? processor-combinator processor-engine
+
+ <markup> markup? bind-markup! markup-options is-markup?
+ markup-markup markup-body markup-ident markup-class
+ find-markups
+ markup-option markup-option-add! markup-output
+ markup-parent markup-document markup-chapter
+
+ <container> container? container-options
+ container-ident container-body
+ container-env-get
+
+ <document> document? document-ident document-body
+ document-options document-end))
+
+;;; Author: Ludovic Courtès
+;;;
+;;; Commentary:
;;;
-;;; Author: Erick Gallesio [eg@essi.fr]
-;;; Creation date: 12-Aug-2003 22:18 (eg)
-;;; Last file update: 28-Oct-2004 16:18 (eg)
+;;; The abstract syntax tree (AST) and its sub-types. These class form the
+;;; core of a document: each part of a document is an instance of `<ast>' or
+;;; one of its sub-classes.
;;;
+;;; Code:
(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 writer-options writer-ident
- writer-before writer-action writer-after writer-class
- <processor> processor? processor-combinator processor-engine
- <markup> markup? bind-markup! markup-options is-markup?
- markup-markup markup-body markup-ident markup-class
- find-markups write-object
- <container> container? container-options
- container-ident container-body
- <document> document? document-ident document-body
- document-options document-end
- <language> language? language-extractor language-fontifier
- <location> location? ast-location
- location-file location-line location-pos
-
- *node-table*)
- :use-module (oop goops))
(define *node-table* (make-hash-table))
; Used to stores the nodes of an AST.
@@ -56,6 +62,7 @@
; identifier.
+
;;; ======================================================================
;;;
;;; <AST>
@@ -70,7 +77,36 @@
(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))
+(define (ast-parent n)
+ (slot-ref n 'parent))
+
+(define (ast->file-location ast)
+ (let ((l (ast-loc ast)))
+ (if (location? l)
+ (format #f "~a:~a:" (location-file l) (location-line l))
+ "")))
+
+(define-generic ast->string)
+
+(define-method (ast->string (ast <top>)) "")
+(define-method (ast->string (ast <string>)) ast)
+(define-method (ast->string (ast <number>)) (number->string ast))
+
+(define-method (ast->string (ast <pair>))
+ (let ((out (open-output-string)))
+ (let Loop ((lst ast))
+ (cond
+ ((null? lst)
+ (get-output-string out))
+ (else
+ (display (ast->string (car lst)) out)
+ (unless (null? (cdr lst))
+ (display #\space out))
+ (Loop (cdr lst)))))))
+
+
+
;;; ======================================================================
;;;
;;; <COMMAND>
@@ -105,70 +141,7 @@
(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)))
+(define (handle-body h) (slot-ref h 'body))
;;; ======================================================================
;;;
@@ -185,6 +158,9 @@
(define (node-options obj) (slot-ref obj 'options))
(define node-loc ast-loc)
+(define-method (ast->string (ast <node>))
+ (ast->string (slot-ref ast 'body)))
+
;;; ======================================================================
;;;
@@ -200,6 +176,8 @@
(define (processor-combinator obj) (slot-ref obj 'combinator))
(define (processor-engine obj) (slot-ref obj 'engine))
+
+
;;; ======================================================================
;;;
;;; <MARKUP>
@@ -227,12 +205,49 @@
(define (markup-options obj) (slot-ref obj 'options))
(define markup-body node-body)
+(define (markup-option m opt)
+ (if (markup? m)
+ (let ((c (assq opt (slot-ref m 'options))))
+ (and (pair? c) (pair? (cdr c))
+ (cadr c)))
+ (skribe-type-error 'markup-option "Illegal markup: " m "markup")))
+
+
+(define (markup-option-add! m opt val)
+ (if (markup? m)
+ (slot-set! m 'options (cons (list opt val)
+ (slot-ref m 'options)))
+ (skribe-type-error 'markup-option "Illegal markup: " m "markup")))
+
(define (is-markup? obj markup)
(and (is-a? obj <markup>)
(eq? (slot-ref obj 'markup) markup)))
+(define (markup-parent m)
+ (let ((p (slot-ref m 'parent)))
+ (if (eq? p 'unspecified)
+ (skribe-error 'markup-parent "Unresolved parent reference" m)
+ p)))
+
+(define (markup-document m)
+ (let Loop ((p m)
+ (l #f))
+ (cond
+ ((is-markup? p 'document) p)
+ ((or (eq? p 'unspecified) (not p)) l)
+ (else (Loop (slot-ref p 'parent) p)))))
+
+(define (markup-chapter m)
+ (let loop ((p m)
+ (l #f))
+ (cond
+ ((is-markup? p 'chapter) p)
+ ((or (eq? p 'unspecified) (not p)) l)
+ (else (loop (slot-ref p 'parent) p)))))
+
+
(define (find-markups ident)
(hash-ref *node-table* ident #f))
@@ -245,6 +260,35 @@
(slot-ref obj 'ident)
(address-of obj)))
+
+;;; XXX: This was already commented out in the original Skribe source.
+;;;
+;; (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))
+;; (%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))))))))
+
+
+
;;; ======================================================================
;;;
;;; <CONTAINER>
@@ -259,6 +303,9 @@
(define container-ident markup-ident)
(define container-body node-body)
+(define (container-env-get m key)
+ (let ((c (assq key (slot-ref m 'env))))
+ (and (pair? c) (cadr c))))
;;; ======================================================================
@@ -275,45 +322,6 @@
(define document-env container-env)
+;;; arch-tag: e2489bd6-1b6d-4b03-bdfb-83cffd2f7ce7
-;;; ======================================================================
-;;;
-;;; <LANGUAGE>
-;;;
-;;; ======================================================================
-(define-class <language> ()
- (name :init-keyword :name :init-value #f :getter langage-name)
- (fontifier :init-keyword :fontifier :init-value #f :getter language-fontifier)
- (extractor :init-keyword :extractor :init-value #f :getter language-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 #f "~a, line ~a" file line))
- "no source location")))
+;;; ast.scm ends here
diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm
index f3ddf97..dd04f68 100644
--- a/src/guile/skribilo/biblio.scm
+++ b/src/guile/skribilo/biblio.scm
@@ -1,7 +1,6 @@
+;;; biblio.scm -- Bibliography functions.
;;;
-;;; biblio.scm -- Bibliography functions
-;;;
-;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; 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
@@ -18,21 +17,22 @@
;;; 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)
:use-module (skribilo lib) ;; `when', `unless'
- :use-module (skribilo vars)
+ :use-module (skribilo module)
+ :use-module (skribilo skribe bib) ;; `make-bib-entry'
+ :autoload (skribilo parameters) (*bib-path*)
+ :autoload (ice-9 format) (format)
:export (bib-table? make-bib-table default-bib-table
bib-add!))
+
+
+;; FIXME: Should be a fluid?
(define *bib-table* #f)
;; Forward declarations
@@ -76,13 +76,13 @@
(let ((ofrom (markup-option old 'from)))
(skribe-warning 2
'bib
- (format "Duplicated bibliographic entry ~a'.\n" ident)
+ (format #f "duplicated bibliographic entry ~a'.\n" ident)
(if ofrom
- (format " Using version of `~a'.\n" ofrom)
+ (format #f " using version of `~a'.\n" ofrom)
"")
(if from
- (format " Ignoring version of `~a'." from)
- " Ignoring redefinition."))))
+ (format #f " ignoring version of `~a'." from)
+ " ignoring redefinition."))))
;;; ======================================================================
@@ -99,14 +99,13 @@
(cond
((and (list? entry) (> (length entry) 2))
(let* ((kind (car entry))
- (key (format "~A" (cadr entry)))
+ (key (format #f "~A" (cadr entry)))
(fields (cddr entry))
- (old (hashtable-get table key)))
+ (old (hash-ref table key)))
(if old
(bib-duplicate ident from old)
- (hash-table-put! table
- key
- (make-bib-entry kind key fields from)))
+ (hash-set! table key
+ (make-bib-entry kind key fields from)))
(Loop (read port))))
(else
(%bib-error 'bib-parse entry))))))))
@@ -124,14 +123,13 @@
(cond
((and (list? entry) (> (length entry) 2))
(let* ((kind (car entry))
- (key (format "~A" (cadr entry)))
+ (key (format #f "~A" (cadr entry)))
(fields (cddr entry))
- (old (hashtable-get table ident)))
+ (old (hash-ref table key)))
(if old
(bib-duplicate key #f old)
- (hash-table-put! table
- key
- (make-bib-entry kind key fields #f)))))
+ (hash-set! table key
+ (make-bib-entry kind key fields #f)))))
(else
(%bib-error 'bib-add! entry))))
entries)))
@@ -144,14 +142,14 @@
;;; ======================================================================
;; FIXME: Factoriser
(define (skribe-open-bib-file file command)
- (let ((path (search-path *skribe-bib-path* file)))
+ (let ((path (search-path (*bib-path*) file)))
(if (string? path)
(begin
- (when (> *skribe-verbose* 0)
+ (when (> (*verbose*) 0)
(format (current-error-port) " [loading bibliography: ~S]\n" path))
(open-input-file (if (string? command)
(string-append "| "
- (format command path))
+ (format #f command path))
path)))
(begin
(skribe-warning 1
diff --git a/src/guile/skribilo/compat.scm b/src/guile/skribilo/compat.scm
new file mode 100644
index 0000000..c90af1d
--- /dev/null
+++ b/src/guile/skribilo/compat.scm
@@ -0,0 +1,155 @@
+;;; compat.scm -- Skribe compatibility module.
+;;;
+;;; 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 compat)
+ :use-module (skribilo parameters)
+ :use-module (srfi srfi-1))
+
+
+;;;
+;;; Global variables that have been replaced by parameter objects
+;;; in `(skribilo parameters)'.
+;;;
+
+;;; 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* '())
+
+
+
+;;;
+;;; Accessors mapped to parameter objects.
+;;;
+
+(define-public skribe-path *document-path*)
+(define-public skribe-image-path *image-path*)
+(define-public skribe-source-path *source-path*)
+(define-public skribe-bib-path *bib-path*)
+
+
+;;;
+;;; Compatibility with Bigloo.
+;;;
+
+(define-public (substring=? s1 s2 len)
+ (let ((l1 (string-length s1))
+ (l2 (string-length s2)))
+ (let Loop ((i 0))
+ (cond
+ ((= i len) #t)
+ ((= i l1) #f)
+ ((= i l2) #f)
+ ((char=? (string-ref s1 i) (string-ref s2 i)) (Loop (+ i 1)))
+ (else #f)))))
+
+(define-public (directory->list str)
+ (map basename (glob (string-append str "/*") (string-append "/.*"))))
+
+(define-macro (printf . args) `(format #t ,@args))
+(export-syntax printf)
+(define-public fprintf format)
+
+(define-public (fprint port . args)
+ (if port
+ (with-output-to-port port
+ (lambda ()
+ (for-each display args)
+ (display "\n")))))
+
+(define-public (file-prefix fn)
+ (if fn
+ (let ((match (regexp-match "(.*)\\.([^/]*$)" fn)))
+ (if match
+ (cadr match)
+ fn))
+ "./SKRIBILO-OUTPUT"))
+
+(define-public (file-suffix s)
+ ;; Not completely correct, but sufficient here
+ (let* ((basename (regexp-replace "^(.*)/(.*)$" s "\\2"))
+ (split (string-split basename ".")))
+ (if (> (length split) 1)
+ (car (reverse! split))
+ "")))
+
+(define-public prefix file-prefix)
+(define-public suffix file-suffix)
+(define-public system->string system) ;; FIXME
+(define-public any? any)
+(define-public every? every)
+(define-public find-file/path (lambda (. args)
+ (format #t "find-file/path: ~a~%" args)
+ #f))
+(define-public process-input-port #f) ;process-input)
+(define-public process-output-port #f) ;process-output)
+(define-public process-error-port #f) ;process-error)
+
+;;; hash tables
+(define-public make-hashtable make-hash-table)
+(define-public hashtable? hash-table?)
+(define-public hashtable-get (lambda (h k) (hash-ref h k #f)))
+(define-public hashtable-put! hash-set!)
+(define-public hashtable-update! hash-set!)
+(define-public hashtable->list (lambda (h)
+ (map cdr (hash-map->list cons h))))
+
+(define-public find-runtime-type (lambda (obj) obj))
+
+
+
+;;;
+;;; Miscellaneous.
+;;;
+
+(use-modules ((srfi srfi-19) #:renamer (symbol-prefix-proc 's19:)))
+
+(define (date)
+ (s19:date->string (s19:current-date) "~c"))
+
+
+
+;;; compat.scm ends here
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
index 0353e2d..5b18b5c 100644
--- a/src/guile/skribilo/engine.scm
+++ b/src/guile/skribilo/engine.scm
@@ -1,7 +1,6 @@
+;;; engine.scm -- Skribilo engines.
;;;
-;;; engine.scm -- Skribe Engines Stuff
-;;;
-;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
@@ -19,24 +18,24 @@
;;; 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 module)
:use-module (skribilo debug)
- :use-module (skribilo writer)
- :use-module (skribilo types)
:use-module (skribilo lib)
- :use-module (skribilo vars)
+
+ ;; `(skribilo writer)' depends on this module so it needs to be loaded
+ ;; after we defined `<engine>' and the likes.
+ :autoload (skribilo writer) (<writer>)
:use-module (oop goops)
:use-module (ice-9 optargs)
+ :autoload (srfi srfi-39) (make-parameter)
- :export (default-engine default-engine-set!
+ :export (<engine> engine? engine-ident engine-format
+ engine-customs engine-filter engine-symbol-table
+
+ *current-engine*
+ default-engine default-engine-set!
make-engine copy-engine find-engine lookup-engine
engine-custom engine-custom-set!
engine-format? engine-add-writer!
@@ -45,10 +44,47 @@
+
+;;;
+;;; Class definition.
+;;;
+
+(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)
+ (slot-ref obj 'ident))
+
+(define (engine-format obj)
+ (slot-ref obj 'format))
+
+(define (engine-customs obj)
+ (slot-ref obj 'customs))
+
+(define (engine-filter obj)
+ (slot-ref obj 'filter))
-;;; Module definition is split here because this file is read by the
-;;; documentation Should be changed.
-;(select-module SKRIBE-ENGINE-MODULE)
+(define (engine-symbol-table obj)
+ (slot-ref obj 'symbol-table))
+
+
+
+;;;
+;;; Default engines.
+;;;
(define *engines* '())
(define *default-engine* #f)
@@ -97,8 +133,7 @@
(define (engine-format? fmt . e)
(let ((e (cond
((pair? e) (car e))
- ((engine? *skribe-engine*) *skribe-engine*)
- (else (find-engine *skribe-engine*)))))
+ (else (*current-engine*)))))
(if (not (engine? e))
(skribe-error 'engine-format? "no engine" e)
(string=? fmt (engine-format e)))))
@@ -164,9 +199,11 @@ otherwise the requested engine is returned."
(false-if-exception (apply lookup-engine args)))
+
;;;
-;;; ENGINE-CUSTOM
+;;; Engine methods.
;;;
+
(define (engine-custom e id)
(let* ((customs (slot-ref e 'customs))
(c (assq id customs)))
@@ -175,9 +212,6 @@ otherwise the requested engine is returned."
'unspecified)))
-;;;
-;;; ENGINE-CUSTOM-SET!
-;;;
(define (engine-custom-set! e id val)
(let* ((customs (slot-ref e 'customs))
(c (assq id customs)))
@@ -186,9 +220,6 @@ otherwise the requested engine is returned."
(slot-set! e 'customs (cons (list id val) customs)))))
-;;;
-;;; ENGINE-ADD-WRITER!
-;;;
(define (engine-add-writer! e ident pred upred opt before action after class valid)
(define (check-procedure name proc arity)
(cond
@@ -233,14 +264,27 @@ otherwise the requested engine is returned."
(slot-set! e 'writers (cons n (slot-ref e 'writers)))
n))
-;;; ======================================================================
+
+
;;;
-;;; I N I T S
+;;; Current engine.
;;;
-;;; ======================================================================
-;; 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.
+;;; `(skribilo module)' must be loaded before the first `find-engine' call.
+(use-modules (skribilo module))
+
+;; At this point, we're almost done with the bootstrap process.
+(format #t "base engine: ~a~%" (lookup-engine 'base))
+
+(define *current-engine*
+ ;; By default, use the HTML engine.
+ (make-parameter (lookup-engine 'html)
+ (lambda (val)
+ (cond ((symbol? val) (lookup-engine val))
+ ((engine? val) val)
+ (else
+ (error "invalid value for `*current-engine*'"
+ val))))))
+
-(make-engine 'base :version 'bootstrap)
+;;; engine.scm ends here
diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
index 6e0dc85..01708c8 100644
--- a/src/guile/skribilo/engine/html.scm
+++ b/src/guile/skribilo/engine/html.scm
@@ -17,12 +17,15 @@
;*=====================================================================*/
(define-skribe-module (skribilo engine html)
- #:use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:)))
+ :use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:)))
;; Keep a reference to the base engine.
(define base-engine (find-engine 'base))
+(if (not (engine? base-engine))
+ (error "bootstrap problem: base engine broken" base-engine))
+
;*---------------------------------------------------------------------*/
;* html-file-default ... */
;*---------------------------------------------------------------------*/
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index 36df9f9..64a3c5d 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -515,184 +515,183 @@
;* lout-engine ... */
;*---------------------------------------------------------------------*/
(define lout-engine
- (default-engine-set!
- (make-engine 'lout
- :version 0.2
- :format "lout"
- :delegate (find-engine 'base)
- :filter (make-string-replace lout-encoding)
- :custom `(;; The underlying Lout document type, i.e. one
- ;; of `doc', `report', `book' or `slides'.
- (document-type report)
-
- ;; Document style file include line (a string
- ;; such as `@Include { doc-style.lout }') or
- ;; `auto' (symbol) in which case the include
- ;; file is deduced from `document-type'.
- (document-include auto)
-
- (includes "@SysInclude { tbl }\n")
- (initial-font "Palatino Base 10p")
- (initial-break
- ,(string-append "unbreakablefirst "
- "unbreakablelast "
- "hyphen adjust 1.2fx"))
-
- ;; The document's language, used for hyphenation
- ;; and other things.
- (initial-language "English")
-
- ;; Number of columns.
- (column-number 1)
-
- ;; First page number.
- (first-page-number 1)
-
- ;; Page orientation, `portrait', `landscape',
- ;; `reverse-portrait' or `reverse-landscape'.
- (page-orientation portrait)
-
- ;; For reports, whether to produce a cover
- ;; sheet. The `doc-cover-sheet-proc' custom may
- ;; also honor this custom for `doc' documents.
- (cover-sheet? #t)
-
- ;; For reports, the date line.
- (date-line #t)
-
- ;; For reports, an abstract.
- (abstract #f)
-
- ;; For reports, title/name of the abstract. If
- ;; `#f', the no abstract title will be
- ;; produced. If `#t', a default name in the
- ;; current language is chosen.
- (abstract-title #t)
-
- ;; Whether to optimize pages.
- (optimize-pages? #f)
-
- ;; For docs, the procedure that produces the
- ;; Lout code for the cover sheet or title.
- (doc-cover-sheet-proc
- ,lout-make-doc-cover-sheet)
-
- ;; Procedure used to sort bibliography
- ;; references when several are referred to at
- ;; the same time, as in:
- ;; (ref :bib '("smith03" "jones98")) .
- ;; By default they are sorted by number. If
- ;; `#f' is given, they are left as is.
- (bib-refs-sort-proc
- ,lout-bib-refs-sort/number)
-
- ;; Lout code for paragraph gaps (similar to
- ;; `@PP' with `@ParaGap' equal to `1.0vx' by
- ;; default)
- (paragraph-gap
- "\n//1.0vx @ParaIndent @Wide &{0i}\n")
-
- ;; For multi-page tables, it may be
- ;; useful to set this to `#t'. However,
- ;; this looks kind of buggy.
- (use-header-rows? #f)
-
- ;; Tells whether to use Skribe's footnote
- ;; numbers or Lout's numbering scheme (the
- ;; latter may be better, typography-wise).
- (use-skribe-footnote-numbers? #t)
-
- ;; A procedure that is passed the engine
- ;; and produces Lout definitions.
- (inline-definitions-proc ,lout-definitions)
-
- ;; A procedure that takes a URL `ref' markup and
- ;; returns a list containing (maybe) one such
- ;; `ref' markup. This custom can be used to
- ;; modified the way URLs are rendered. The
- ;; default value is a procedure that limits the
- ;; size of Lout's @ExternalLink symbols since
- ;; they are unbreakable. In order to completely
- ;; disable use of @ExternalLinks, just set it to
- ;; `markup-body'.
- (transform-url-ref-proc
- ,lout-split-external-link)
-
- ;; Leader used in the table of contents entries.
- (toc-leader ".")
-
- ;; Inter-leader spacing in the TOC entries.
- (toc-leader-space "2.5s")
-
- ;; Procedure that takes a large-scale structure
- ;; (chapter, section, etc.) and the engine and
- ;; produces the number and possibly title of
- ;; this structure for use the TOC.
- (toc-entry-proc ,lout-make-toc-entry)
-
- ;; The Lout program name, only useful when using
- ;; `lout-illustration' on other back-ends.
- (lout-program-name "lout")
-
- ;; Title and author information in the PDF
- ;; document information. If `#t', the
- ;; document's `:title' and `:author' are used.
- (pdf-title #t)
- (pdf-author #t)
-
- ;; Keywords (a list of string) in the PDF
- ;; document information.
- (pdf-keywords #f)
-
- ;; Extra PDF information, an alist of key-value
- ;; pairs (string pairs).
- (pdf-extra-info (("SkribeVersion"
- ,(skribe-release))))
-
- ;; Tells whether to produce PDF "docinfo"
- ;; (meta-information with title, author,
- ;; keywords, etc.).
- (make-pdf-docinfo? #t)
-
- ;; Tells whether a PDF outline
- ;; (aka. "bookmarks") should be produced.
- (make-pdf-outline? #t)
-
- ;; Procedure that takes a node and an engine and
- ;; return a string representing the title of
- ;; that node's PDF bookmark.
- (pdf-bookmark-title-proc ,lout-pdf-bookmark-title)
-
- ;; Procedure that takes a node and an engine and
- ;; returns true if that node should have a PDF
- ;; outline entry.
- (pdf-bookmark-node-pred ,lout-pdf-bookmark-node?)
-
- ;; Procedure that takes a node and an engine and
- ;; returns true if the bookmark for that node
- ;; should be closed ("folded") when the user
- ;; opens the PDF document.
- (pdf-bookmark-closed-pred
- ,(lambda (n e)
- (not (is-markup? n 'chapter))))
-
- ;; color
- (color? #t)
-
- ;; source fontification
- (source-color #t)
- (source-comment-color "#ffa600")
- (source-define-color "#6959cf")
- (source-module-color "#1919af")
- (source-markup-color "#1919af")
- (source-thread-color "#ad4386")
- (source-string-color "red")
- (source-bracket-color "red")
- (source-type-color "#00cf00"))
-
- :symbol-table (lout-symbol-table
- (lambda (m)
- (format #f "@Eq { ~a }\n" m))))))
+ (make-engine 'lout
+ :version 0.2
+ :format "lout"
+ :delegate (find-engine 'base)
+ :filter (make-string-replace lout-encoding)
+ :custom `(;; The underlying Lout document type, i.e. one
+ ;; of `doc', `report', `book' or `slides'.
+ (document-type report)
+
+ ;; Document style file include line (a string
+ ;; such as `@Include { doc-style.lout }') or
+ ;; `auto' (symbol) in which case the include
+ ;; file is deduced from `document-type'.
+ (document-include auto)
+
+ (includes "@SysInclude { tbl }\n")
+ (initial-font "Palatino Base 10p")
+ (initial-break
+ ,(string-append "unbreakablefirst "
+ "unbreakablelast "
+ "hyphen adjust 1.2fx"))
+
+ ;; The document's language, used for hyphenation
+ ;; and other things.
+ (initial-language "English")
+
+ ;; Number of columns.
+ (column-number 1)
+
+ ;; First page number.
+ (first-page-number 1)
+
+ ;; Page orientation, `portrait', `landscape',
+ ;; `reverse-portrait' or `reverse-landscape'.
+ (page-orientation portrait)
+
+ ;; For reports, whether to produce a cover
+ ;; sheet. The `doc-cover-sheet-proc' custom may
+ ;; also honor this custom for `doc' documents.
+ (cover-sheet? #t)
+
+ ;; For reports, the date line.
+ (date-line #t)
+
+ ;; For reports, an abstract.
+ (abstract #f)
+
+ ;; For reports, title/name of the abstract. If
+ ;; `#f', the no abstract title will be
+ ;; produced. If `#t', a default name in the
+ ;; current language is chosen.
+ (abstract-title #t)
+
+ ;; Whether to optimize pages.
+ (optimize-pages? #f)
+
+ ;; For docs, the procedure that produces the
+ ;; Lout code for the cover sheet or title.
+ (doc-cover-sheet-proc
+ ,lout-make-doc-cover-sheet)
+
+ ;; Procedure used to sort bibliography
+ ;; references when several are referred to at
+ ;; the same time, as in:
+ ;; (ref :bib '("smith03" "jones98")) .
+ ;; By default they are sorted by number. If
+ ;; `#f' is given, they are left as is.
+ (bib-refs-sort-proc
+ ,lout-bib-refs-sort/number)
+
+ ;; Lout code for paragraph gaps (similar to
+ ;; `@PP' with `@ParaGap' equal to `1.0vx' by
+ ;; default)
+ (paragraph-gap
+ "\n//1.0vx @ParaIndent @Wide &{0i}\n")
+
+ ;; For multi-page tables, it may be
+ ;; useful to set this to `#t'. However,
+ ;; this looks kind of buggy.
+ (use-header-rows? #f)
+
+ ;; Tells whether to use Skribe's footnote
+ ;; numbers or Lout's numbering scheme (the
+ ;; latter may be better, typography-wise).
+ (use-skribe-footnote-numbers? #t)
+
+ ;; A procedure that is passed the engine
+ ;; and produces Lout definitions.
+ (inline-definitions-proc ,lout-definitions)
+
+ ;; A procedure that takes a URL `ref' markup and
+ ;; returns a list containing (maybe) one such
+ ;; `ref' markup. This custom can be used to
+ ;; modified the way URLs are rendered. The
+ ;; default value is a procedure that limits the
+ ;; size of Lout's @ExternalLink symbols since
+ ;; they are unbreakable. In order to completely
+ ;; disable use of @ExternalLinks, just set it to
+ ;; `markup-body'.
+ (transform-url-ref-proc
+ ,lout-split-external-link)
+
+ ;; Leader used in the table of contents entries.
+ (toc-leader ".")
+
+ ;; Inter-leader spacing in the TOC entries.
+ (toc-leader-space "2.5s")
+
+ ;; Procedure that takes a large-scale structure
+ ;; (chapter, section, etc.) and the engine and
+ ;; produces the number and possibly title of
+ ;; this structure for use the TOC.
+ (toc-entry-proc ,lout-make-toc-entry)
+
+ ;; The Lout program name, only useful when using
+ ;; `lout-illustration' on other back-ends.
+ (lout-program-name "lout")
+
+ ;; Title and author information in the PDF
+ ;; document information. If `#t', the
+ ;; document's `:title' and `:author' are used.
+ (pdf-title #t)
+ (pdf-author #t)
+
+ ;; Keywords (a list of string) in the PDF
+ ;; document information.
+ (pdf-keywords #f)
+
+ ;; Extra PDF information, an alist of key-value
+ ;; pairs (string pairs).
+ (pdf-extra-info (("SkribeVersion"
+ ,(skribe-release))))
+
+ ;; Tells whether to produce PDF "docinfo"
+ ;; (meta-information with title, author,
+ ;; keywords, etc.).
+ (make-pdf-docinfo? #t)
+
+ ;; Tells whether a PDF outline
+ ;; (aka. "bookmarks") should be produced.
+ (make-pdf-outline? #t)
+
+ ;; Procedure that takes a node and an engine and
+ ;; return a string representing the title of
+ ;; that node's PDF bookmark.
+ (pdf-bookmark-title-proc ,lout-pdf-bookmark-title)
+
+ ;; Procedure that takes a node and an engine and
+ ;; returns true if that node should have a PDF
+ ;; outline entry.
+ (pdf-bookmark-node-pred ,lout-pdf-bookmark-node?)
+
+ ;; Procedure that takes a node and an engine and
+ ;; returns true if the bookmark for that node
+ ;; should be closed ("folded") when the user
+ ;; opens the PDF document.
+ (pdf-bookmark-closed-pred
+ ,(lambda (n e)
+ (not (is-markup? n 'chapter))))
+
+ ;; color
+ (color? #t)
+
+ ;; source fontification
+ (source-color #t)
+ (source-comment-color "#ffa600")
+ (source-define-color "#6959cf")
+ (source-module-color "#1919af")
+ (source-markup-color "#1919af")
+ (source-thread-color "#ad4386")
+ (source-string-color "red")
+ (source-bracket-color "red")
+ (source-type-color "#00cf00"))
+
+ :symbol-table (lout-symbol-table
+ (lambda (m)
+ (format #f "@Eq { ~a }\n" m)))))
diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index def3280..bbf92e3 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -1,7 +1,6 @@
+;;; eval.scm -- Skribilo evaluator.
;;;
-;;; eval.stk -- Skribe Evaluator
-;;;
-;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
@@ -19,26 +18,24 @@
;;; 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 (skribilo evaluator)
:export (skribe-eval skribe-eval-port skribe-load skribe-load-options
- skribe-include))
+ skribe-include)
+ :autoload (skribilo parameters) (*verbose*)
+ :autoload (skribilo location) (<location>)
+ :autoload (skribilo ast) (ast? markup?)
+ :autoload (skribilo engine) (engine? find-engine engine-ident)
+ :autoload (skribilo reader) (%default-reader)
+
+ :autoload (skribilo verify) (verify)
+ :autoload (skribilo resolve) (resolve!))
+
(use-modules (skribilo debug)
- (skribilo reader)
- (skribilo engine)
- (skribilo verify)
- (skribilo resolve)
(skribilo output)
- (skribilo types)
(skribilo lib)
- (skribilo vars)
(ice-9 optargs)
(oop goops)
@@ -94,8 +91,10 @@
(let ((e (if (symbol? engine) (find-engine engine) engine)))
(debug-item "e=" e)
- (if (not (is-a? e <engine>))
- (skribe-error 'skribe-eval-port "cannot find engine" engine)
+ (if (not (engine? e))
+ (begin
+ (format #t "engine: ~a~%" e)
+ (skribe-error 'skribe-eval-port "cannot find engine" engine))
(let loop ((exp (reader port)))
(with-debug 10 'skribe-eval-port
(debug-item "exp=" exp))
@@ -106,6 +105,8 @@
;;;
;;; SKRIBE-LOAD
;;;
+
+;;; FIXME: Use a fluid for that.
(define *skribe-load-options* '())
(define (skribe-load-options)
@@ -117,13 +118,7 @@
(debug-item " path=" path)
(debug-item " opt=" opt)
- (let* ((ei (cond
- ((not engine) *skribe-engine*)
- ((engine? engine) engine)
- ((not (symbol? engine))
- (skribe-error 'skribe-load
- "illegal engine" engine))
- (else engine)))
+ (let* ((ei (*current-engine*))
(path (append (cond
((not path) (skribe-path))
((string? path) (list path))
@@ -151,9 +146,9 @@
;; Load this file if not already done
(unless (member filep *skribe-loaded*)
(cond
- ((> *skribe-verbose* 1)
+ ((> (*verbose*) 1)
(format (current-error-port) " [loading file: ~S ~S]\n" filep opt))
- ((> *skribe-verbose* 0)
+ ((> (*verbose*) 0)
(format (current-error-port) " [loading file: ~S]\n" filep)))
;; Load it
(with-input-from-file filep
@@ -173,7 +168,7 @@
(skribe-error 'skribe-load
(format #t "cannot find ~S in path" file)
path))
- (when (> *skribe-verbose* 0)
+ (when (> (*verbose*) 0)
(format (current-error-port) " [including file: ~S]\n" path))
(with-input-from-file path
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
index 2961fc6..b15960e 100644
--- a/src/guile/skribilo/lib.scm
+++ b/src/guile/skribilo/lib.scm
@@ -2,6 +2,7 @@
;;; lib.scm -- Utilities
;;;
;;; 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
@@ -26,37 +27,9 @@
skribe-type-error
skribe-warning skribe-warning/ast
skribe-message
-
- ;; paths as lists of directories
-
- %skribilo-load-path
- %skribilo-image-path %skribilo-bib-path %skribilo-source-path
-
- ;; compatibility
-
- 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
- %procedure-arity
-
- make-hashtable hashtable?
- hashtable-get hashtable-put! hashtable-update!
- hashtable->list
-
skribe-read
- find-runtime-type
- date)
+ %procedure-arity)
:export-syntax (new define-markup define-simple-markup
define-simple-container define-processor-markup
@@ -65,12 +38,16 @@
unwind-protect unless when)
:use-module (skribilo config)
- :use-module (skribilo types)
+ :use-module (skribilo ast)
+
+ ;; useful for `new' to work well with <language>
+ :autoload (skribilo source) (<language>)
+
:use-module (skribilo reader)
- :use-module (skribilo vars)
+ :use-module (skribilo parameters)
+ :use-module (skribilo location)
:use-module (srfi srfi-1)
- :use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:)) ;; date
:use-module (oop goops)
:use-module (ice-9 optargs))
@@ -81,11 +58,11 @@
;;; NEW
;;;
-(define %types-module (resolve-module '(skribilo types)))
+(define %types-module (current-module))
(define-macro (new class . parameters)
;; Thanks to the trick below, modules don't need to import `(oop goops)'
- ;; and `(skribilo types)' in order to make use of `new'.
+ ;; and `(skribilo ast)' in order to make use of `new'.
(let* ((class-name (symbol-append '< class '>))
(actual-class (module-ref %types-module class-name)))
`(let ((make ,make)
@@ -221,12 +198,12 @@
(define (skribe-warning level . obj)
- (if (>= *skribe-warning* level)
+ (if (>= (*warning*) level)
(%skribe-warn level #f #f obj)))
(define (skribe-warning/ast level ast . obj)
- (if (>= *skribe-warning* level)
+ (if (>= (*warning*) level)
(let ((l (ast-loc ast)))
(if (location? l)
(%skribe-warn level (location-file l) (location-line l) obj)
@@ -236,27 +213,9 @@
;;; SKRIBE-MESSAGE
;;;
(define (skribe-message fmt . obj)
- (when (> *skribe-verbose* 0)
+ (when (> (*verbose*) 0)
(apply format (current-error-port) fmt obj)))
-;;;
-;;; FILE-PREFIX / FILE-SUFFIX
-;;;
-(define (file-prefix fn)
- (if fn
- (let ((match (regexp-match "(.*)\\.([^/]*$)" fn)))
- (if match
- (cadr match)
- fn))
- "./SKRIBE-OUTPUT"))
-
-(define (file-suffix s)
- ;; Not completely correct, but sufficient here
- (let* ((basename (regexp-replace "^(.*)/(.*)$" s "\\2"))
- (split (string-split basename ".")))
- (if (> (length split) 1)
- (car (reverse! split))
- "")))
;;;
@@ -289,87 +248,6 @@
(else
(Loop (cdr l))))))
-
-
-;;; ======================================================================
-;;;
-;;; A C C E S S O R S
-;;;
-;;; ======================================================================
-
-
-(define %skribilo-load-path (list (skribilo-default-path) "."))
-(define %skribilo-image-path '("."))
-(define %skribilo-bib-path '("."))
-(define %skribilo-source-path '("."))
-
-(define-macro (define-compatibility-accessors var oldname)
- (let ((newname (symbol-append '%skribilo- var))
- (setter (symbol-append oldname '-set!)))
- `(begin
- (define (,oldname) ,newname)
- (define (,setter path)
- (if (not (and (list? path) (every string? path)))
- (skribe-error ',setter "illegal path" path)
- (set! ,newname path))))))
-
-(define-compatibility-accessors load-path skribe-path)
-(define-compatibility-accessors image-path skribe-image-path)
-(define-compatibility-accessors bib-path skribe-bib-path)
-(define-compatibility-accessors source-path skribe-source-path)
-
-
-
-;;; ======================================================================
-;;;
-;;; Compatibility with Bigloo
-;;;
-;;; ======================================================================
-
-(define (substring=? s1 s2 len)
- (let ((l1 (string-length s1))
- (l2 (string-length s2)))
- (let Loop ((i 0))
- (cond
- ((= i len) #t)
- ((= i l1) #f)
- ((= i l2) #f)
- ((char=? (string-ref s1 i) (string-ref s2 i)) (Loop (+ i 1)))
- (else #f)))))
-
-(define (directory->list str)
- (map basename (glob (string-append str "/*") (string-append "/.*"))))
-
-(define-macro (printf . args) `(format #t ,@args))
-(define fprintf format)
-
-
-(define prefix file-prefix)
-(define suffix file-suffix)
-(define system->string system) ;; FIXME
-(define any? any)
-(define every? every)
-(define find-file/path (lambda (. args)
- (format #t "find-file/path: ~a~%" args)
- #f))
-(define process-input-port #f) ;process-input)
-(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 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-map->list cons h))))
-
-(define find-runtime-type (lambda (obj) obj))
-
;;;
;;; Various things.
@@ -396,8 +274,5 @@
(define-macro (when condition . exprs)
`(if ,condition (begin ,@exprs)))
-(define (date)
- (s19:date->string (s19:current-date) "~c"))
-
;;; lib.scm ends here
diff --git a/src/guile/skribilo/location.scm b/src/guile/skribilo/location.scm
new file mode 100644
index 0000000..a134f8a
--- /dev/null
+++ b/src/guile/skribilo/location.scm
@@ -0,0 +1,68 @@
+;;; location.scm -- Skribilo source location.
+;;;
+;;; 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 location)
+ :use-module (oop goops)
+ :export (<location> location? ast-location
+ location-file location-line location-pos))
+
+;;; Author: Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; An abstract data type to keep track of source locations.
+;;;
+;;; Code:
+
+(read-set! keywords 'prefix)
+
+
+;;;
+;;; Class definition.
+;;;
+
+(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 #f "~a, line ~a" file line))
+ "no source location")))
+
+
+;;; arch-tag: d68fa45d-a200-465e-a3c2-eb2861907f83
+
+;;; location.scm ends here.
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index bb0c5ad..21917b2 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -20,7 +20,6 @@
(define-module (skribilo module)
:use-module (skribilo reader)
- :use-module (skribilo evaluator)
:use-module (skribilo debug)
:use-module (srfi srfi-1)
:use-module (ice-9 optargs))
@@ -37,20 +36,20 @@
;;;
;;; Code:
-(define *skribilo-user-imports*
+(define %skribilo-user-imports
;; List of modules that should be imported by any good Skribilo module.
'((srfi srfi-1) ;; lists
(srfi srfi-13) ;; strings
- ;(srfi srfi-19) ;; date and time
(ice-9 optargs) ;; `define*'
(ice-9 and-let-star) ;; `and-let*'
(ice-9 receive) ;; `receive'
(skribilo module)
- (skribilo types) ;; `<document>', `document?', etc.
+ (skribilo parameters) ;; run-time parameters
+ (skribilo compat) ;; `skribe-load-path', etc.
+ (skribilo ast) ;; `<document>', `document?', etc.
(skribilo config)
- (skribilo vars)
- (skribilo runtime) ;; `the-options', `the-body'
+ (skribilo runtime) ;; `the-options', `the-body', `make-string-replace'
(skribilo biblio)
(skribilo lib) ;; `define-markup', `unwind-protect', etc.
(skribilo resolve)
@@ -78,7 +77,7 @@
;; Pull all the bindings that Skribe code may expect, plus those needed
;; to actually create and read the module.
,(cons 'use-modules
- (append *skribilo-user-imports*
+ (append %skribilo-user-imports
(filter-map (lambda (mod)
(let ((m `(skribilo skribe
,(string->symbol
@@ -94,7 +93,7 @@
-(define *skribilo-user-module* #f)
+(define %skribilo-user-module #f)
;;;
;;; MAKE-RUN-TIME-MODULE
@@ -105,7 +104,7 @@ execution of Skribilo/Skribe code."
(let ((the-module (make-module)))
(for-each (lambda (iface)
(module-use! the-module (resolve-module iface)))
- (append *skribilo-user-imports*
+ (append %skribilo-user-imports
(map (lambda (mod)
`(skribilo skribe
,(string->symbol mod)))
@@ -118,9 +117,9 @@ execution of Skribilo/Skribe code."
;;;
(define-public (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*)
+ (if (not %skribilo-user-module)
+ (set! %skribilo-user-module (make-run-time-module)))
+ %skribilo-user-module)
;; FIXME: This will eventually be replaced by the per-module reader thing in
@@ -134,12 +133,11 @@ execution of Skribilo/Skribe code."
; (format #t "load-file-with-read: ~a~%" read)
(let loop ((sexp (read))
(result #f))
- (if (eof-object? sexp)
- result
+ (if (not (eof-object? sexp))
(begin
; (format #t "preparing to evaluate `~a'~%" sexp)
- (loop (read)
- (primitive-eval sexp)))))))))
+ (primitive-eval sexp)
+ (loop (read)))))))))
(define-public (load-skribilo-file file reader-name)
(load-file-with-read file (make-reader reader-name) (current-module)))
diff --git a/src/guile/skribilo/output.scm b/src/guile/skribilo/output.scm
index 8a63a48..cbd4523 100644
--- a/src/guile/skribilo/output.scm
+++ b/src/guile/skribilo/output.scm
@@ -1,7 +1,6 @@
+;;;; output.scm -- Skribilo output stage.
;;;;
-;;;; output.stk -- Skribe Output Stage
-;;;;
-;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
@@ -18,21 +17,15 @@
;;;; 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:42 (eg)
-;;;; Last file update: 5-Mar-2004 10:32 (eg)
-;;;;
+
(define-module (skribilo output)
- :export (output))
-
-(use-modules (skribilo debug)
- (skribilo types)
-; (skribilo engine)
- (skribilo writer)
- (skribilo lib) ;; `when', `unless'
- (oop goops))
+ :export (output)
+ :use-module (skribilo ast)
+ :use-module (skribilo writer)
+ :use-module (skribilo lib)
+ :use-module (skribilo debug)
+ :use-module (oop goops))
(define-generic out)
diff --git a/src/guile/skribilo/parameters.scm b/src/guile/skribilo/parameters.scm
new file mode 100644
index 0000000..d8b259f
--- /dev/null
+++ b/src/guile/skribilo/parameters.scm
@@ -0,0 +1,65 @@
+;;; parameters.scm -- Skribilo settings as parameter objects.
+;;;
+;;; 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 parameters)
+ :use-module (srfi srfi-39))
+
+;;; Author: Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module defines parameter objects that may be used to specify
+;;; run-time parameters of a Skribilo process.
+;;;
+;;; Code:
+
+
+;;;
+;;; Switches.
+;;;
+
+(define-public *verbose* (make-parameter #f))
+(define-public *warning* (make-parameter 5))
+(define-public *load-rc-file?* (make-parameter #f))
+
+;;;
+;;; Paths.
+;;;
+
+(define-public *document-path* (make-parameter (list ".")))
+(define-public *bib-path* (make-parameter (list ".")))
+(define-public *source-path* (make-parameter (list ".")))
+(define-public *image-path* (make-parameter (list ".")))
+
+;;;
+;;; Files.
+;;;
+
+(define-public *destination-file* (make-parameter "output.html"))
+(define-public *source-file* (make-parameter "default-input-file.skb"))
+
+
+;;; TODO: Skribe used to have other parameters as global variables. See
+;;; which ones need to be kept.
+
+
+;;; arch-tag: 3c0d2e18-b997-4615-8a3d-b6622ae28874
+
+;;; parameters.scm ends here
diff --git a/src/guile/skribilo/reader/skribe.scm b/src/guile/skribilo/reader/skribe.scm
index 714f19e..5c71cc1 100644
--- a/src/guile/skribilo/reader/skribe.scm
+++ b/src/guile/skribilo/reader/skribe.scm
@@ -37,6 +37,7 @@
;;;
;;; Code:
+;;; Note: We need guile-reader 0.2 at least.
(define* (make-skribe-reader #:optional (version "1.2d"))
"Return a Skribe reader (a procedure) suitable for version @var{version} of
diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm
index a39bb77..7075f2d 100644
--- a/src/guile/skribilo/resolve.scm
+++ b/src/guile/skribilo/resolve.scm
@@ -27,7 +27,7 @@
(define-module (skribilo resolve)
:use-module (skribilo debug)
:use-module (skribilo runtime)
- :use-module (skribilo types)
+ :use-module (skribilo ast)
:use-module (skribilo lib) ;; `unless' and `when'
:use-module (oop goops)
diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm
index 03e515c..d4be2e9 100644
--- a/src/guile/skribilo/runtime.scm
+++ b/src/guile/skribilo/runtime.scm
@@ -1,8 +1,8 @@
;;;
-;;; runtime.stk -- Skribe runtime system
+;;; runtime.scm -- Skribilo runtime system
;;;
;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;;
+;;; Copyright © 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;; 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
@@ -18,46 +18,22 @@
;;; 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)
;; FIXME: Useful procedures are scattered between here and
;; `(skribilo skribe utils)'.
:export (;; Utilities
- strip-ref-base ast->file-location string-canonicalize
-
- ;; Markup functions
- markup-option markup-option-add! markup-output
+ strip-ref-base string-canonicalize
- ;; Container functions
- container-env-get
;; Images
convert-image
;; String writing
- make-string-replace
-
- ;; AST
- ast-parent ast->string
- markup-parent markup-document markup-chapter
-
- handle-body))
-
-(use-modules (skribilo debug)
- (skribilo types)
- (skribilo verify)
- (skribilo resolve)
- (skribilo output)
- (skribilo evaluator)
- (skribilo vars)
- (skribilo lib)
- (srfi srfi-13)
- (oop goops))
+ make-string-replace)
+ :use-module (skribilo parameters)
+ :use-module (skribilo lib)
+ :use-module (srfi srfi-13))
@@ -70,13 +46,13 @@
;;FIXME: Remonter cette fonction
(define (strip-ref-base file)
- (if (not (string? *skribe-ref-base*))
+ (if (not (string? (*ref-base*)))
file
- (let ((l (string-length *skribe-ref-base*)))
+ (let ((l (string-length (*ref-base*))))
(cond
((not (> (string-length file) (+ l 2)))
file)
- ((not (substring=? file *skribe-ref-base* l))
+ ((not (substring=? file (*ref-base*) l))
file)
((not (char=? (string-ref file l) (file-separator)))
file)
@@ -84,12 +60,6 @@
(substring file (+ l 1) (string-length file)))))))
-(define (ast->file-location ast)
- (let ((l (ast-loc ast)))
- (if (location? l)
- (format "~a:~a:" (location-file l) (location-line l))
- "")))
-
;; FIXME: Remonter cette fonction
(define (string-canonicalize old)
(let* ((l (string-length old))
@@ -123,58 +93,6 @@
(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))
-;; (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))
-;; (%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))))))))
-
-(define (markup-option m opt)
- (if (markup? m)
- (let ((c (assq opt (slot-ref m 'options))))
- (and (pair? c) (pair? (cdr c))
- (cadr c)))
- (skribe-type-error 'markup-option "Illegal markup: " m "markup")))
-
-
-(define (markup-option-add! m opt val)
- (if (markup? m)
- (slot-set! m 'options (cons (list opt val)
- (slot-ref m 'options)))
- (skribe-type-error 'markup-option "Illegal markup: " m "markup")))
-
-;;; ======================================================================
-;;;
-;;; 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))))
-
;;; ======================================================================
;;;
@@ -195,9 +113,9 @@
(string-append "fig2dev -L " fmt " " from " > " to)
(string-append "convert " from " " to))))
(cond
- ((> *skribe-verbose* 1)
+ ((> (*verbose*) 1)
(format (current-error-port) " [converting image: ~S (~S)]" from c))
- ((> *skribe-verbose* 0)
+ ((> (*verbose*) 0)
(format (current-error-port) " [converting image: ~S]" from)))
(and (zero? (system c))
to))))))
@@ -210,8 +128,8 @@
(skribe-image-path))
(let ((suf (suffix file)))
(if (member suf formats)
- (let* ((dir (if (string? *skribe-dest*)
- (dirname *skribe-dest*)
+ (let* ((dir (if (string? (*destination-file*))
+ (dirname (*destination-file*))
#f)))
(if dir
(let ((dest (basename path)))
@@ -221,8 +139,8 @@
(let loop ((fmts formats))
(if (null? fmts)
#f
- (let* ((dir (if (string? *skribe-dest*)
- (dirname *skribe-dest*)
+ (let* ((dir (if (string? (*destination-file*))
+ (dirname (*destination-file*))
"."))
(p (builtin-convert-image path (car fmts) dir)))
(if (string? p)
@@ -282,123 +200,3 @@
-
-;;; ======================================================================
-;;;
-;;; O P T I O N S
-;;;
-;;; ======================================================================
-
-;;NEW ;;
-;;NEW ;; GET-OPTION
-;;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 ((markup? obj) (get-option (slot-ref obj 'option*) key))
-;;NEW (else #f)))
-;;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 ;;
-;;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 ((container? obj) (get-env (slot-ref obj 'env) key))
-;;NEW (else #f)))
-;;NEW
-
-
-
-
-;;; ======================================================================
-;;;
-;;; A S T
-;;;
-;;; ======================================================================
-
-(define-generic ast->string)
-
-
-(define-method (ast->string (ast <top>)) "")
-(define-method (ast->string (ast <string>)) ast)
-(define-method (ast->string (ast <number>)) (number->string ast))
-
-(define-method (ast->string (ast <pair>))
- (let ((out (open-output-string)))
- (let Loop ((lst ast))
- (cond
- ((null? lst)
- (get-output-string out))
- (else
- (display (ast->string (car lst)) out)
- (unless (null? (cdr lst))
- (display #\space out))
- (Loop (cdr lst)))))))
-
-(define-method (ast->string (ast <node>))
- (ast->string (slot-ref ast 'body)))
-
-
-
-;;
-;; AST-PARENT
-;;
-(define (ast-parent n)
- (slot-ref n 'parent))
-
-;;
-;; MARKUP-PARENT
-;;
-(define (markup-parent m)
- (let ((p (slot-ref m 'parent)))
- (if (eq? p 'unspecified)
- (skribe-error 'markup-parent "Unresolved parent reference" m)
- p)))
-
-
-;;
-;; MARKUP-DOCUMENT
-;;
-(define (markup-document m)
- (let Loop ((p m)
- (l #f))
- (cond
- ((is-markup? p 'document) p)
- ((or (eq? p 'unspecified) (not p)) l)
- (else (Loop (slot-ref p 'parent) p)))))
-
-;;
-;;
-;; MARKUP-CHAPTER
-;;
-(define (markup-chapter m)
- (let loop ((p m)
- (l #f))
- (cond
- ((is-markup? p 'chapter) p)
- ((or (eq? p 'unspecified) (not p)) l)
- (else (loop (slot-ref p 'parent) p)))))
-
-
-
-;;;; ======================================================================
-;;;;
-;;;; H A N D L E S
-;;;;
-;;;; ======================================================================
-(define (handle-body h)
- (slot-ref h 'body))
-
diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm
index e03deae..bd523f2 100644
--- a/src/guile/skribilo/source.scm
+++ b/src/guile/skribilo/source.scm
@@ -1,4 +1,3 @@
-;;;;
;;;; source.scm -- Highlighting source files.
;;;;
;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
@@ -22,16 +21,33 @@
;;;;
-
(define-module (skribilo source)
- :export (source-read-lines source-read-definition source-fontify)
- :use-module (skribilo types)
- :use-module (skribilo vars)
+ :export (<language> language? language-extractor language-fontifier
+ source-read-lines source-read-definition source-fontify)
+ :use-module (skribilo parameters)
:use-module (skribilo lib)
+ :use-module (oop goops)
:use-module (ice-9 rdelim))
+(read-set! keywords 'prefix)
+
+
+;;;
+;;; Class definition.
+;;;
+
+(define-class <language> ()
+ (name :init-keyword :name :init-value #f :getter langage-name)
+ (fontifier :init-keyword :fontifier :init-value #f
+ :getter language-fontifier)
+ (extractor :init-keyword :extractor :init-value #f
+ :getter language-extractor))
+
+(define (language? obj)
+ (is-a? obj <language>))
+
;*---------------------------------------------------------------------*/
;* source-read-lines ... */
;*---------------------------------------------------------------------*/
@@ -43,7 +59,7 @@
(skribe-source-path))
(with-input-from-file p
(lambda ()
- (if (> *skribe-verbose* 0)
+ (if (> (*verbose*) 0)
(format (current-error-port) " [source file: ~S]\n" p))
(let ((startl (if (string? start) (string-length start) -1))
(stopl (if (string? stop) (string-length stop) -1)))
@@ -125,7 +141,7 @@
(skribe-source-path)))
(else
(let ((ip (open-input-file p)))
- (if (> *skribe-verbose* 0)
+ (if (> (*verbose*) 0)
(format (current-error-port) " [source file: ~S]\n" p))
(if (not (input-port? ip))
(skribe-error 'source "Can't open file for input" p)
diff --git a/src/guile/skribilo/vars.scm b/src/guile/skribilo/vars.scm
deleted file mode 100644
index 4877e78..0000000
--- a/src/guile/skribilo/vars.scm
+++ /dev/null
@@ -1,66 +0,0 @@
-;;;
-;;; 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/skribilo/verify.scm b/src/guile/skribilo/verify.scm
index 0f9e053..aa2dd78 100644
--- a/src/guile/skribilo/verify.scm
+++ b/src/guile/skribilo/verify.scm
@@ -31,7 +31,7 @@
(skribilo engine)
(skribilo writer)
(skribilo runtime)
- (skribilo types)
+ (skribilo ast)
(skribilo lib) ;; `when', `unless'
(oop goops))
diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm
index abfb10c..b393c5c 100644
--- a/src/guile/skribilo/writer.scm
+++ b/src/guile/skribilo/writer.scm
@@ -26,25 +26,57 @@
(define-module (skribilo writer)
- :export (invoke markup-writer markup-writer-get markup-writer-get*
- lookup-markup-writer copy-markup-writer))
+ :export (<writer> writer? write-object writer-options writer-ident
+ writer-before writer-action writer-after writer-class
+
+ invoke markup-writer markup-writer-get markup-writer-get*
+ lookup-markup-writer copy-markup-writer)
+
+ :autoload (skribilo engine) (engine? engine-ident? default-engine))
(use-modules (skribilo debug)
- (skribilo engine)
(skribilo output)
- (skribilo types)
+ (skribilo ast)
(skribilo lib)
(oop goops)
(ice-9 optargs))
-;;;; ======================================================================
-;;;;
-;;;; INVOKE
-;;;;
-;;;; ======================================================================
+
+;;;
+;;; Class definition.
+;;;
+
+(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)))
+
+
+
+;;;
+;;; Writer methods.
+;;;
+
(define (invoke proc node e)
(with-debug 5 'invoke
(debug-item "e=" (engine-ident e))
@@ -56,11 +88,6 @@
(proc node e)))))
-;;;; ======================================================================
-;;;;
-;;;; LOOKUP-MARKUP-WRITER
-;;;;
-;;;; ======================================================================
(define (lookup-markup-writer node e)
(let ((writers (slot-ref e 'writers))
(delegate (slot-ref e 'delegate)))
@@ -76,11 +103,6 @@
(else
#f)))))
-;;;; ======================================================================
-;;;;
-;;;; MAKE-WRITER-PREDICATE
-;;;;
-;;;; ======================================================================
(define (make-writer-predicate markup predicate class)
(let* ((t1 (if (symbol? markup)
(lambda (n e) (is-markup? n markup))
@@ -165,11 +187,6 @@
options before ac after class validate))))))
-;;;; ======================================================================
-;;;;
-;;;; MARKUP-WRITER-GET
-;;;;
-;;;; ======================================================================
(define* (markup-writer-get markup :optional engine :key (class #f) (pred #f))
(let ((e (or engine (default-engine))))
(cond
@@ -193,14 +210,8 @@
(else
#f))))))))
-;;;; ======================================================================
-;;;;
-;;;; MARKUP-WRITER-GET*
-;;;;
-;;;; ======================================================================
;; Finds all writers that matches MARKUP with optional CLASS attribute.
-
(define* (markup-writer-get* markup #:optional engine #:key (class #f))
(let ((e (or engine (default-engine))))
(cond
@@ -224,11 +235,6 @@
(else
(reverse! res)))))))))
-;;; ======================================================================
-;;;;
-;;;; COPY-MARKUP-WRITER
-;;;;
-;;;; ======================================================================
(define* (copy-markup-writer markup old-engine :optional new-engine
:key (predicate 'unspecified)
(class 'unspecified)
@@ -247,3 +253,5 @@
:before (if (unspecified? before) (slot-ref old 'before) before)
:action (if (unspecified? action) (slot-ref old 'action) action)
:after (if (unspecified? after) (slot-ref old 'after) after))))
+
+;;; writer.scm ends here