diff options
Diffstat (limited to 'src/guile/skribilo.scm')
| -rw-r--r-- | src/guile/skribilo.scm | 480 |
1 files changed, 480 insertions, 0 deletions
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm new file mode 100644 index 0000000..531b0fb --- /dev/null +++ b/src/guile/skribilo.scm @@ -0,0 +1,480 @@ +#!/bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(skribilo)) '\'main')' +exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@" +!# + +;;;; skribilo.scm +;;;; +;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> +;;;; +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;;; USA. + +;;;; Commentary: +;;;; +;;;; Usage: skribilo [ARGS] +;;;; +;;;; Process a skribilo document. +;;;; +;;;; Code: + + + +(define-module (skribilo) + :autoload (skribilo module) (make-run-time-module *skribilo-user-module*) + :autoload (skribilo engine) (*current-engine*) + :autoload (skribilo reader) (*document-reader*) + :use-module (skribilo utils syntax)) + +(use-modules (skribilo evaluator) + (skribilo debug) + (skribilo parameters) + (skribilo lib) + + (srfi srfi-39) + (ice-9 optargs) + (ice-9 getopt-long)) + + +;; Install the Skribilo module syntax reader. +(fluid-set! current-reader %skribilo-module-reader) + +(if (not (keyword? :kw)) + (error "guile-reader sucks")) + + + + +(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 ,(if arg #t #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 + (("reader" :alternate "R" :arg reader + (nothing))) + (("target" :alternate "t" :arg target + :help "sets the output format to <target>") + (set! engine (string->symbol target))) + (("load-path" :alternate "I" :arg path :help "adds <path> to Skribe path") + (set! paths (cons path paths))) + (("bib-path" :alternate "B" :arg path :help "adds <path> to bibliography path") + (skribe-bib-path-set! (cons path (skribe-bib-path)))) + (("source-path" :alternate "S" :arg path :help "adds <path> to source path") + (skribe-source-path-set! (cons path (skribe-source-path)))) + (("image-path" :alternate "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. + + --reader=READER Use READER to parse the input file (by default, + the `skribe' reader is used) + --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~%" (skribilo-release))) + +;;;; ====================================================================== +;;;; +;;;; P A R S E - A R G S +;;;; +;;;; ====================================================================== +(define (parse-args args) + + (define (version) + (format #t "skribe v~A\n" (skribe-release))) + + (define (query) + (version) + (for-each (lambda (x) + (let ((s (keyword->string (car x)))) + (printf " ~a: ~a\n" s (cadr x)))) + (skribe-configure))) + + ;; + ;; parse-args starts here + ;; + (let ((paths '()) + (engine #f)) + (parse-arguments args + "Usage: skribe [options] [input]" + "General 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))))) + (else + (set! *skribe-src* other-arguments))) + + ;; we have to configure Skribe path according to the environment variable + (skribe-path-set! (append (let ((path (getenv "SKRIBEPATH"))) + (if path + (string-split path ":") + '())) + (reverse! paths) + (skribe-default-path))) + ;; Final initializations + (if engine + (set! *skribe-engine* engine)))) + +;;;; ====================================================================== +;;;; +;;;; L O A D - R C +;;;; +;;;; ====================================================================== +(define *load-rc* #f) ;; FIXME: This should go somewhere else. + +(define (load-rc) + (if *load-rc* + (let ((file (make-path (*rc-directory*) (*rc-file*)))) + (if (and file (file-exists? file)) + (load file))))) + + +;;;; ====================================================================== +;;;; +;;;; S K R I B E +;;;; +;;;; ====================================================================== +; (define (doskribe) +; (let ((e (find-engine *skribe-engine*))) +; (if (and (engine? e) (pair? *skribe-precustom*)) +; (for-each (lambda (cv) +; (engine-custom-set! e (car cv) (cdr cv))) +; *skribe-precustom*)) +; (if (pair? *skribe-src*) +; (for-each (lambda (f) (skribe-load f :engine *skribe-engine*)) +; *skribe-src*) +; (skribe-eval-port (current-input-port) *skribe-engine*)))) + +(define *skribilo-output-port* (make-parameter (current-output-port))) + +(define (doskribe) + (let ((output-port (current-output-port)) + (user-module (current-module))) + (dynamic-wind + (lambda () + ;; FIXME: Using this technique, anything written to `stderr' will + ;; also end up in the output file (e.g. Guile warnings). + (set-current-output-port (*skribilo-output-port*)) + (let ((user (make-run-time-module))) + (set-current-module user) + (*skribilo-user-module* user))) + (lambda () + ;;(format #t "engine is ~a~%" (*current-engine*)) + (evaluate-document-from-port (current-input-port) + (*current-engine*))) + (lambda () + (set-current-output-port output-port) + (set-current-module user-module) + (*skribilo-user-module* #f))))) + + + +;;;; ====================================================================== +;;;; +;;;; M A I N +;;;; +;;;; ====================================================================== +(define-public (skribilo . args) + (let* ((options (getopt-long (cons "skribilo" args) + skribilo-options)) + (reader-name (string->symbol + (option-ref options 'reader "skribe"))) + (engine (string->symbol + (option-ref options 'target "html"))) + (output-file (option-ref options 'output #f)) + (debugging-level (option-ref options 'debug "0")) + (warning-level (option-ref options 'warning "2")) + (load-path (option-ref options 'load-path ".")) + (bib-path (option-ref options 'bib-path ".")) + (source-path (option-ref options 'source-path ".")) + (image-path (option-ref options 'image-path ".")) + (preload '()) + (variants '()) + + (help-wanted (option-ref options 'help #f)) + (version-wanted (option-ref options 'version #f))) + + ;; Set up the debugging infrastructure. + (debug-enable 'debug) + (debug-enable 'backtrace) + (debug-enable 'procnames) + + (cond (help-wanted (begin (skribilo-show-help) (exit 1))) + (version-wanted (begin (skribilo-show-version) (exit 1)))) + + ;; Parse the most important options. + + (if (> (*debug*) 4) + (set! %load-hook + (lambda (file) + (format #t "~~ loading `~a'...~%" file)))) + + (parameterize ((*document-reader* (make-reader reader-name)) + (*current-engine* engine) + (*document-path* (cons load-path (*document-path*))) + (*bib-path* (cons bib-path (*bib-path*))) + (*source-path* (cons source-path + (append %load-path + (*source-path*)))) + (*image-path* (cons image-path (*image-path*))) + (*debug* (string->number debugging-level)) + (*warning* (string->number warning-level)) + (*verbose* (let ((v (option-ref options + 'verbose 0))) + (if (number? v) v + (if v 1 0))))) + + ;; 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)))) + + (if (and output-file (file-exists? output-file)) + (delete-file output-file)) + + (parameterize ((*destination-file* output-file) + (*source-file* source-file) + (*skribilo-output-port* + (if (string? output-file) + (open-output-file output-file) + (current-output-port)))) + + (setvbuf (*skribilo-output-port*) _IOFBF 16384) + + ;; (start-stack 7 + (if source-file + (with-input-from-file source-file doskribe) + (doskribe)))))))) + + +(define main skribilo) + +;;; skribilo ends here. |