summaryrefslogtreecommitdiff
path: root/src/guile/skribilo.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile/skribilo.scm')
-rwxr-xr-xsrc/guile/skribilo.scm271
1 files changed, 214 insertions, 57 deletions
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
index 77e9618..e766830 100755
--- a/src/guile/skribilo.scm
+++ b/src/guile/skribilo.scm
@@ -42,6 +42,28 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
;; Allow for this `:style' of keywords.
(read-set! keywords 'prefix)
+;; Allow for DSSSL-style keywords (i.e. `#!key', etc.).
+;; See http://lists.gnu.org/archive/html/guile-devel/2005-06/msg00060.html
+;; for details.
+(read-hash-extend #\! (lambda (chr port)
+ (symbol->keyword (read port))))
+
+(let ((gensym-orig gensym))
+ ;; In Skribe, `gensym' expects a symbol as its (optional) argument, while
+ ;; Guile's `gensym' expect a string. XXX
+ (set! gensym
+ (lambda (. args)
+ (if (null? args)
+ (gensym-orig)
+ (let ((the-arg (car args)))
+ (cond ((symbol? the-arg)
+ (gensym-orig (symbol->string the-arg)))
+ ((string? the-arg)
+ (gensym-orig the-arg))
+ (else
+ (skribe-error 'gensym "Invalid argument type"
+ the-arg))))))))
+
; (use-modules (skribe eval)
; (skribe configure)
; (skribe runtime)
@@ -63,45 +85,169 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(skribe configure)
(skribe eval)
(skribe engine)
+ (skribe types) ;; because `new' is a macro and refers to classes
- (ice-9 optargs))
+ (oop goops) ;; because `new' is a macro
+ (ice-9 optargs)
+
+ (ice-9 getopt-long))
(load "skribe/lib.scm")
(load "../common/configure.scm")
(load "../common/param.scm")
-
-; (include "vars.stk")
-; (include "reader.stk")
-; (include "configure.stk")
-; (include "types.stk")
-; (include "debug.stk")
-; (include "lib.stk")
(load "../common/lib.scm")
-; (include "resolve.stk")
-; (include "writer.stk")
-; (include "verify.stk")
-; (include "output.stk")
-; (include "prog.stk")
-; (include "eval.stk")
-; (include "runtime.stk")
-; (include "engine.stk")
-; (include "biblio.stk")
-; (include "source.stk")
-; (include "lisp.stk")
-; (include "xml.stk")
-; (include "c.stk")
-; (include "color.stk")
(load "../common/sui.scm")
-
(load "../common/index.scm")
+
+;; Markup definitions...
(load "../common/api.scm")
-;;; KLUDGE for allowing redefinition of Skribe INCLUDE
-;(remove-expander! 'include)
+
+(define* (process-option-specs longname #:key (alternate #f)
+ (arg #f) (help #f)
+ #:rest thunk)
+ "Process STkLos-like option specifications and return getopt-long option
+specifications."
+ `(,(string->symbol longname)
+ ,@(if alternate
+ `((single-char ,(string-ref alternate 0)))
+ '())
+ (value #f)))
+
+(define (raw-options->getopt-long options)
+ "Converts @var{options} to a getopt-long-compatible representation."
+ (map (lambda (option-specs)
+ (apply process-option-specs (car option-specs)))
+ options))
+
+(define-macro (define-options binding . options)
+ `(define ,binding (quote ,(raw-options->getopt-long options))))
+
+(define-options skribilo-options
+ (("target" :alternate "t" :arg target
+ :help "sets the output format to <target>")
+ (set! engine (string->symbol target)))
+ (("I" :arg path :help "adds <path> to Skribe path")
+ (set! paths (cons path paths)))
+ (("B" :arg path :help "adds <path> to bibliography path")
+ (skribe-bib-path-set! (cons path (skribe-bib-path))))
+ (("S" :arg path :help "adds <path> to source path")
+ (skribe-source-path-set! (cons path (skribe-source-path))))
+ (("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")
+ (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")
+ (set! *skribe-variants* (cons variant *skribe-variants*)))
+ (("base" :alternate "b" :arg base
+ :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")
+ (set! *load-rc* #f))
+ (("output" :alternate "o" :arg file :help "set the output to <file>")
+ (set! *skribe-dest* file)
+ (let* ((s (file-suffix file))
+ (c (assoc s *skribe-auto-mode-alist*)))
+ (if (and (pair? c) (symbol? (cdr c)))
+ (set! *skribe-engine* (cdr c)))))
+
+ ;;"Misc:"
+ (("help" :alternate "h" :help "provides help for the command")
+ (arg-usage (current-error-port))
+ (exit 0))
+ (("options" :help "display the skribe options and exit")
+ (arg-usage (current-output-port) #t)
+ (exit 0))
+ (("version" :alternate "V" :help "displays the version of Skribe")
+ (version)
+ (exit 0))
+ (("query" :alternate "q"
+ :help "displays informations about Skribe conf.")
+ (query)
+ (exit 0))
+ (("verbose" :alternate "v" :arg level
+ :help "sets the verbosity to <level>. Use -v0 for crystal silence")
+ (let ((val (string->number level)))
+ (if (integer? val)
+ (set! *skribe-verbose* val))))
+ (("warning" :alternate "w" :arg level
+ :help "sets the verbosity to <level>. Use -w0 for crystal silence")
+ (let ((val (string->number level)))
+ (if (integer? val)
+ (set! *skribe-warning* val))))
+ (("debug" :alternate "g" :arg level :help "sets the debug <level>")
+ (let ((val (string->number level)))
+ (if (integer? val)
+ (set-skribe-debug! val)
+ (begin
+ ;; Use the symbol for debug
+ (set-skribe-debug! 1)
+ (add-skribe-debug-symbol (string->symbol level))))))
+ (("no-color" :help "disable coloring for output")
+ (no-debug-color))
+ (("custom" :alternate "c" :arg key=val :help "Preset custom value")
+ (let ((args (string-split key=val "=")))
+ (if (and (list args) (= (length args) 2))
+ (let ((key (car args))
+ (val (cadr args)))
+ (set! *skribe-precustom* (cons (cons (string->symbol key) val)
+ *skribe-precustom*)))
+ (error 'parse-arguments "Bad custom ~S" key=val))))
+ (("eval" :alternate "e" :arg expr :help "evaluate expression <expr>")
+ (with-input-from-string expr
+ (lambda () (eval (read))))))
+
+; (define skribilo-options
+; ;; Skribilo options in getopt-long's format, as computed by
+; ;; `raw-options->getopt-long'.
+; `((target (single-char #\t) (value #f))
+; (I (value #f))
+; (B (value #f))
+; (S (value #f))
+; (P (value #f))
+; (split-chapters (single-char #\C) (value #f))
+; (preload (value #f))
+; (use-variant (single-char #\u) (value #f))
+; (base (single-char #\b) (value #f))
+; (rc-dir (single-char #\d) (value #f))
+; (no-init-file (value #f))
+; (output (single-char #\o) (value #f))
+; (help (single-char #\h) (value #f))
+; (options (value #f))
+; (version (single-char #\V) (value #f))
+; (query (single-char #\q) (value #f))
+; (verbose (single-char #\v) (value #f))
+; (warning (single-char #\w) (value #f))
+; (debug (single-char #\g) (value #f))
+; (no-color (value #f))
+; (custom (single-char #\c) (value #f))
+; (eval (single-char #\e) (value #f))))
+
+(define (skribilo-show-help)
+ (format #t "Usage: skribilo [OPTIONS] [INPUT]
+
+Processes a Skribilo/Skribe source file and produces its output.
+
+ --target=ENGINE Use ENGINE as the underlying engine
+
+ --help Give this help list
+ --version Print program version
+"))
+
+(define (skribilo-show-version)
+ (format #t "skribilo ~a~%" (skribe-release)))
;;;; ======================================================================
;;;;
@@ -160,7 +306,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(set! *skribe-dest* file)
(let* ((s (file-suffix file))
(c (assoc s *skribe-auto-mode-alist*)))
- (when (and (pair? c) (symbol? (cdr c)))
+ (if (and (pair? c) (symbol? (cdr c)))
(set! *skribe-engine* (cdr c)))))
"Misc:"
@@ -180,12 +326,12 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(("verbose" :alternate "v" :arg level
:help "sets the verbosity to <level>. Use -v0 for crystal silence")
(let ((val (string->number level)))
- (when (integer? val)
+ (if (integer? val)
(set! *skribe-verbose* val))))
(("warning" :alternate "w" :arg level
:help "sets the verbosity to <level>. Use -w0 for crystal silence")
(let ((val (string->number level)))
- (when (integer? val)
+ (if (integer? val)
(set! *skribe-warning* val))))
(("debug" :alternate "g" :arg level :help "sets the debug <level>")
(let ((val (string->number level)))
@@ -219,7 +365,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(reverse! paths)
(skribe-default-path)))
;; Final initializations
- (when engine
+ (if engine
(set! *skribe-engine* engine))))
;;;; ======================================================================
@@ -227,13 +373,14 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
;;;; L O A D - R C
;;;;
;;;; ======================================================================
+(define *load-rc* #f) ;; FIXME: This should go somewhere else.
+
(define (load-rc)
- (when *load-rc*
+ (if *load-rc*
(let ((file (make-path *skribe-rc-directory* *skribe-rc-file*)))
- (when (and file (file-exists? file))
+ (if (and file (file-exists? file))
(load file)))))
-
;;;; ======================================================================
;;;;
@@ -254,35 +401,45 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
;;;; ======================================================================
;;;;
-;;;; M A I N
+;;;; M A I N
;;;;
;;;; ======================================================================
(define (skribilo . args)
- ;; Load the user rc file
- (load-rc)
-
- ;; Parse command line
- (parse-args args)
-
- ;; Load the base file to bootstrap the system as well as the files
- ;; that are in the *skribe-preload* variable
- (skribe-load "base.skr" :engine 'base)
- (for-each (lambda (f) (skribe-load f :engine *skribe-engine*)) *skribe-preload*)
-
- ;; Load the specified variants
- (for-each (lambda (x) (skribe-load (format "~a.skr" x) :engine *skribe-engine*))
- (reverse! *skribe-variants*))
-
-;; (if (string? *skribe-dest*)
-;; (with-handler (lambda (kind loc msg)
-;; (remove-file *skribe-dest*)
-;; (error loc msg))
-;; (with-output-to-file *skribe-dest* doskribe))
-;; (doskribe))
-(if (string? *skribe-dest*)
- (with-output-to-file *skribe-dest* doskribe)
- (doskribe))
+ (let* ((options (getopt-long (cons "skribilo" args) skribilo-options))
+ (target (option-ref options 'target #f))
+ (help-wanted (option-ref options 'help #f))
+ (version-wanted (option-ref options 'version #f)))
+
+ (cond (help-wanted (begin (skribilo-show-help) (exit 1)))
+ (version-wanted (begin (skribilo-show-version) (exit 1)))
+ (target (format #t "target set to `~a'~%" target)))
+
+ ;; Load the user rc file
+ (load-rc)
+
+ ;; Load the base file to bootstrap the system as well as the files
+ ;; that are in the *skribe-preload* variable
+ (skribe-load "base.skr" :engine 'base)
+ (for-each (lambda (f)
+ (skribe-load f :engine *skribe-engine*))
+ *skribe-preload*)
+
+ ;; Load the specified variants
+ (for-each (lambda (x)
+ (skribe-load (format #f "~a.skr" x) :engine *skribe-engine*))
+ (reverse! *skribe-variants*))
+
+ ;; (if (string? *skribe-dest*)
+ ;; (with-handler (lambda (kind loc msg)
+ ;; (remove-file *skribe-dest*)
+ ;; (error loc msg))
+ ;; (with-output-to-file *skribe-dest* doskribe))
+ ;; (doskribe))
+ (if (string? *skribe-dest*)
+ (with-output-to-file *skribe-dest* doskribe)
+ (doskribe))))
+(display "skribilo loaded\n")
(define main skribilo)