diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/guile/skribilo/engine/html.scm | 33 | ||||
| -rw-r--r-- | src/guile/skribilo/parameters.scm | 3 | ||||
| -rw-r--r-- | src/guile/skribilo/prog.scm | 4 | ||||
| -rw-r--r-- | src/guile/skribilo/resolve.scm | 11 | ||||
| -rw-r--r-- | src/guile/skribilo/utils/compat.scm | 61 |
5 files changed, 64 insertions, 48 deletions
diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm index a376713..1f3466f 100644 --- a/src/guile/skribilo/engine/html.scm +++ b/src/guile/skribilo/engine/html.scm @@ -17,6 +17,7 @@ ;*=====================================================================*/ (define-skribe-module (skribilo engine html) + :autoload (skribilo parameters) (*destination-file*) :use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:))) @@ -60,17 +61,17 @@ (engine-custom e 'subsection-file)) (and (is-markup? node 'subsubsection) (engine-custom e 'subsubsection-file))) - (let* ((b (or (and (string? *skribe-dest*) - (prefix *skribe-dest*)) + (let* ((b (or (and (string? (*destination-file*)) + (prefix (*destination-file*))) "")) - (s (or (and (string? *skribe-dest*) - (suffix *skribe-dest*)) + (s (or (and (string? (*destination-file*)) + (suffix (*destination-file*))) "html")) (nm (get-file-name b s))) (markup-option-add! node filename nm) nm)) ((document? node) - *skribe-dest*) + (*destination-file*)) (else (let ((p (ast-parent node))) (if (container? p) @@ -986,8 +987,8 @@ (sui-blocks 'subsection n e) (sui-blocks 'subsubsection n e) (display " )\n")) - (if (string? *skribe-dest*) - (let ((f (format #f "~a.sui" (prefix *skribe-dest*)))) + (if (string? (*destination-file*)) + (let ((f (format #f "~a.sui" (prefix (*destination-file*))))) (with-output-to-file f sui)) (sui))) @@ -1132,22 +1133,17 @@ (printf "<td colspan=\"~a\" width=\"100%\">" (- 4 level)) (printf "<a href=\"~a#~a\">" - (if (and *skribe-dest* - (string=? f *skribe-dest*)) + (if (and (*destination-file*) + (string=? f (*destination-file*))) "" - (strip-ref-base (or f *skribe-dest* ""))) + (strip-ref-base (or f (*destination-file*) ""))) (string-canonicalize id)) (output (markup-option c :title) e) (display "</a></td>") (display "</tr>\n") ;; the children (for-each (lambda (n) (toc-entry n (+ 1 level))) ch))) - (define (symbol->keyword s) - (cond-expand - (stklos - (make-keyword s)) - (bigloo - (string->keyword (string-append ":" (symbol->string s)))))) + (let* ((c (markup-option n :chapter)) (s (markup-option n :section)) (ss (markup-option n :subsection)) @@ -1925,9 +1921,10 @@ (markup-class n) "inbound"))) (printf "<a href=\"~a#~a\" class=\"~a\"" - (if (and *skribe-dest* (string=? f *skribe-dest*)) + (if (and (*destination-file*) + (string=? f (*destination-file*))) "" - (strip-ref-base (or f *skribe-dest* ""))) + (strip-ref-base (or f (*destination-file*) ""))) (string-canonicalize id) class) (display ">"))) diff --git a/src/guile/skribilo/parameters.scm b/src/guile/skribilo/parameters.scm index b464667..04517e7 100644 --- a/src/guile/skribilo/parameters.scm +++ b/src/guile/skribilo/parameters.scm @@ -76,8 +76,7 @@ (define-public *destination-file* (make-parameter "output.html")) (define-public *source-file* (make-parameter "default-input-file.skb")) -;; FIXME: I don't understand exactly what this is. See, for instance, the -;; HTML and Context engines. +;; Base prefix to remove from hyperlinks. (define-public *ref-base* (make-parameter "")) ;;; TODO: Skribe used to have other parameters as global variables. See diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm index 7c83270..020a275 100644 --- a/src/guile/skribilo/prog.scm +++ b/src/guile/skribilo/prog.scm @@ -89,7 +89,7 @@ (values #f line)) ((string? line) (extract-string-mark line mark regexp)) - ((pair? line) + ((list? line) (let loop ((ls line) (res '())) (if (null? ls) @@ -135,7 +135,7 @@ (loop r1 (+ r2 1) res)))))) - ((pair? line) + ((list? line) (let loop ((ls line) (res '())) (if (null? ls) diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm index c100b62..cbb939d 100644 --- a/src/guile/skribilo/resolve.scm +++ b/src/guile/skribilo/resolve.scm @@ -72,13 +72,16 @@ (define-method (do-resolve! (ast <pair>) engine env) (let Loop ((n* ast)) (cond - ((pair? n*) + ((null? n*) + ast) + ((list? n*) (set-car! n* (do-resolve! (car n*) engine env)) (Loop (cdr n*))) - ((not (null? n*)) - (error 'do-resolve "illegal argument" n*)) + ((pair? n*) + (set-car! n* (do-resolve! (car n*) engine env)) + (set-cdr! n* (do-resolve! (cdr n*) engine env))) (else - ast)))) + (error 'do-resolve "illegal argument" n*))))) (define-method (do-resolve! (node <node>) engine env) diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index c187975..c6e95bf 100644 --- a/src/guile/skribilo/utils/compat.scm +++ b/src/guile/skribilo/utils/compat.scm @@ -24,6 +24,7 @@ :use-module (skribilo parameters) :use-module (skribilo evaluator) :use-module (srfi srfi-1) + :autoload (srfi srfi-13) (string-rindex) :use-module (srfi srfi-34) :use-module (srfi srfi-35) :use-module (ice-9 optargs) @@ -63,6 +64,9 @@ ;;; Global variables that have been replaced by parameter objects ;;; in `(skribilo parameters)'. ;;; +;;; FIXME: There's not much we can do about these variables (as opposed to +;;; the _accessors_ below). Perhaps we should just not define them? +;;; ;;; Switches (define-public *skribe-verbose* 0) @@ -86,7 +90,7 @@ (define-public *skribe-dest* #f) ;;; Engine -(define-public *skribe-engine* 'html) ;; Use HTML by default +(define-public *skribe-engine* 'html) ;; Use HTML by default ;;; Misc (define-public *skribe-chapter-split* '()) @@ -112,7 +116,16 @@ (define %skribe-known-files ;; Like of Skribe package files and their equivalent Skribilo module. - '(("web-book.skr" . (skribilo packages web-book)))) + '(("web-book.skr" . (skribilo package web-book)) + ("web-article.skr" . (skribilo package web-article)) + ("slide.skr" . (skribilo package slide)) + ("sigplan.skr" . (skribilo package sigplan)) + ("scribe.skr" . (skribilo package scribe)) + ("lncs.skr" . (skribilo package lncs)) + ("letter.skr" . (skribilo package letter)) + ("jfp.skr" . (skribilo package jfp)) + ("french.skr" . (skribilo package french)) + ("acmproc.skr" . (skribilo package acmproc)))) (define*-public (skribe-load file :rest args) (call/cc @@ -121,15 +134,20 @@ ;; Regular file loading failed. Try built-ins. (let ((mod-name (assoc-ref %skribe-known-files file))) (if mod-name - (let ((mod (false-if-exception - (resolve-module mod-name)))) - (if (not mod) - (raise c) - (begin - (set-module-uses! - (current-module) - (cons mod (module-uses (current-module)))) - (return #t)))) + (begin + (if (> (*verbose*) 1) + (format (current-error-port) + " skribe-load: `~a' -> `~a'~%" + file mod-name)) + (let ((mod (false-if-exception + (resolve-module mod-name)))) + (if (not mod) + (raise c) + (begin + (set-module-uses! + (current-module) + (cons mod (module-uses (current-module)))) + (return #t))))) (raise c))))) ;; Try a regular `load-document'. @@ -175,19 +193,18 @@ (define-public (file-prefix fn) (if fn - (let ((match (regexp-match "(.*)\\.([^/]*$)" fn))) - (if match - (cadr match) - fn)) + (let ((dot (string-rindex fn #\.))) + (if dot (substring fn 0 dot) 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 (file-suffix fn) + (if fn + (let ((dot (string-rindex fn #\.))) + (if dot + (substring fn (+ dot 1) (string-length fn)) + "")) + #f)) + (define-public prefix file-prefix) (define-public suffix file-suffix) |