aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo/engine/html.scm33
-rw-r--r--src/guile/skribilo/parameters.scm3
-rw-r--r--src/guile/skribilo/prog.scm4
-rw-r--r--src/guile/skribilo/resolve.scm11
-rw-r--r--src/guile/skribilo/utils/compat.scm61
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)
generated by cgit v1.2.3 (git 2.45.2) at 2024-12-23 08:24:54 +0000