diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/guile/skribe/debug.scm | 5 | ||||
| -rw-r--r-- | src/guile/skribe/lib.scm | 29 | ||||
| -rwxr-xr-x | src/guile/skribilo.scm | 271 |
3 files changed, 237 insertions, 68 deletions
diff --git a/src/guile/skribe/debug.scm b/src/guile/skribe/debug.scm index 01f88c2..e2bff27 100644 --- a/src/guile/skribe/debug.scm +++ b/src/guile/skribe/debug.scm @@ -25,7 +25,8 @@ (define-module (skribe debug) - :export (debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol + :export (with-debug %with-debug + debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol no-debug-color)) (define *skribe-debug* 0) @@ -138,7 +139,7 @@ r))) (define-macro (with-debug level label . body) - `((in-module SKRIBE-DEBUG-MODULE %with-debug) ,level ,label (lambda () ,@body))) + `(%with-debug ,level ,label (lambda () ,@body))) ;;(define-macro (with-debug level label . body) ;; `(begin ,@body)) diff --git a/src/guile/skribe/lib.scm b/src/guile/skribe/lib.scm index 4a9b471..fa5e962 100644 --- a/src/guile/skribe/lib.scm +++ b/src/guile/skribe/lib.scm @@ -29,23 +29,34 @@ ;;; ;;; NEW ;;; -(define (maybe-copy obj) - (if (pair-mutable? obj) - obj - (copy-tree obj))) - (define-macro (new class . parameters) - `(make ,(string->symbol (format "<~a>" class)) + `(make ,(string->symbol (format #f "<~a>" class)) ,@(apply append (map (lambda (x) - `(,(make-keyword (car x)) (maybe-copy ,(cadr x)))) + `(,(symbol->keyword (car x)) ,(cadr x))) parameters)))) ;;; ;;; DEFINE-MARKUP ;;; (define-macro (define-markup bindings . body) - ;; This is just a STklos extended lambda. Nothing to do - `(define ,bindings ,@body)) + ;; This is just an `(ice-9 optargs)' kind of `lambda*', with DSSSL + ;; keyword-style conversion enabled. However, using `(ice-9 optargs)', the + ;; `#:rest' argument can only appear last which not what Skribe/DSSSL + ;; expect, hence `fix-rest-arg'. + (define (fix-rest-arg args) + (let loop ((args args) + (result '()) + (rest-arg #f)) + (if (null? args) + (if rest-arg (append (reverse result) rest-arg) (reverse result)) + (let ((is-rest-arg? (eq? (car args) #:rest))) + (loop (if is-rest-arg? (cddr args) (cdr args)) + (if is-rest-arg? result (cons (car args) result)) + (if is-rest-arg? (list (car args) (cadr args)) rest-arg)))))) + + (let ((name (car bindings)) + (opts (cdr bindings))) + `(define* ,(cons name (fix-rest-arg opts)) ,@body))) ;;; 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) |