diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/guile/skribilo/package/base.scm | 36 | ||||
| -rw-r--r-- | src/guile/skribilo/prog.scm | 39 |
2 files changed, 21 insertions, 54 deletions
diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm index 9f6de43..872c1e2 100644 --- a/src/guile/skribilo/package/base.scm +++ b/src/guile/skribilo/package/base.scm @@ -1001,11 +1001,6 @@ (body (the-body opts)))) ;*---------------------------------------------------------------------*/ -;* *mark-table* ... */ -;*---------------------------------------------------------------------*/ -(define *mark-table* (make-hash-table)) - -;*---------------------------------------------------------------------*/ ;* mark ... */ ;* ------------------------------------------------------------- */ ;* doc: */ @@ -1028,12 +1023,11 @@ (let* ((bs (ast->string bd)) (n (new markup (markup 'mark) - (ident (symbol->string (gensym bs))) + (ident bs) (class class) (loc &invocation-location) (options (the-options opts :ident :class :text)) (body text)))) - (hash-set! *mark-table* bs n) n))))) ;*---------------------------------------------------------------------*/ @@ -1154,25 +1148,7 @@ (ast s)))) (unref n text (or kind 'ident))))))))) (define (mark-ref mark) - (if (not (string? mark)) - (skribe-type-error 'mark "Illegal mark, " mark "string") - (new unresolved - (loc &invocation-location) - (proc (lambda (n e env) - (let ((s (hash-ref *mark-table* mark))) - (if s - (new markup - (markup 'ref) - (ident (symbol->string (gensym "mark-ref"))) - (class class) - (loc &invocation-location) - (required-options '(:text)) - (options `((kind mark) - (mark ,mark) - ,@(the-options opts :ident :class))) - (body (new handle - (ast s)))) - (unref n mark 'mark)))))))) + (do-ident-ref mark 'mark)) (define (make-bib-ref v) (let ((s (resolve-bib bib-table v))) (if s @@ -1214,17 +1190,17 @@ (new unresolved (loc &invocation-location) (proc (lambda (n e env) - (let ((l (resolve-line line))) - (if (pair? l) + (let ((l (resolve-line (ast-document n) line))) + (if l (new markup (markup 'line-ref) (ident (symbol->string (gensym "line-ref"))) (class class) (loc &invocation-location) - (options `((:text ,(markup-ident (car l))) + (options `((:text ,(markup-ident l)) ,@(the-options opts :ident :class))) (body (new handle - (ast (car l))))) + (ast l)))) (unref n line 'line))))))) (let ((b (the-body opts))) (if (not (null? b)) diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm index 9ea334d..5f08420 100644 --- a/src/guile/skribilo/prog.scm +++ b/src/guile/skribilo/prog.scm @@ -21,6 +21,7 @@ (define-module (skribilo prog) :use-module (ice-9 regex) + :use-module (srfi srfi-1) :use-module (srfi srfi-11) :use-module (skribilo lib) ;; `new' @@ -52,37 +53,27 @@ ;*---------------------------------------------------------------------*/ -;* *lines* ... */ -;*---------------------------------------------------------------------*/ -;; FIXME: Remove that global. Rework the thing. -(define *lines* (make-hash-table)) - -;*---------------------------------------------------------------------*/ ;* make-line-mark ... */ ;*---------------------------------------------------------------------*/ -(define (make-line-mark m line-ident b) - (let* ((n (list (mark line-ident) b))) - (hash-set! *lines* m n) - n)) +(define (make-line-mark ident b) + (list (mark ident) b)) ;*---------------------------------------------------------------------*/ ;* resolve-line ... */ ;*---------------------------------------------------------------------*/ -(define (resolve-line id) - (hash-ref *lines* id)) +(define (resolve-line doc id) + (document-lookup-node doc id)) ;*---------------------------------------------------------------------*/ ;* extract-string-mark ... */ ;*---------------------------------------------------------------------*/ (define (extract-string-mark line mark regexp) - (let ((m (pregexp-match regexp line))) - (if (pair? m) - (values (substring (car m) - (string-length mark) - (string-length (car m))) - (pregexp-replace regexp line "")) - (values #f line)))) - + (let ((match (pregexp-match regexp line))) + (if match + (values (match:substring match 1) + (pregexp-replace regexp line "")) + (values #f line)))) + ;*---------------------------------------------------------------------*/ ;* extract-mark ... */ ;* ------------------------------------------------------------- */ @@ -153,7 +144,7 @@ ;* flat-lines ... */ ;*---------------------------------------------------------------------*/ (define (flat-lines lines) - (apply append (map split-line lines))) + (concatenate (map split-line lines))) ;*---------------------------------------------------------------------*/ ;* collect-lines ... */ @@ -181,13 +172,13 @@ (loop (cdr lines) res (cons (car lines) tmp)))))) - + ;*---------------------------------------------------------------------*/ ;* make-prog-body ... */ ;*---------------------------------------------------------------------*/ (define (make-prog-body src lnum-init ldigit mark) (let* ((regexp (and mark - (format #f "~a[-a-zA-Z_][-0-9a-zA-Z_]+" + (format #f "~a([-a-zA-Z_][-0-9a-zA-Z_]+)" (pregexp-quote mark)))) (src (cond ((not (pair? src)) (list src)) @@ -211,7 +202,7 @@ (markup '&prog-line) (ident line-ident) (options `((:number ,(and lnum-init lnum)))) - (body (if m (make-line-mark m line-ident l) l))))) + (body (if m (make-line-mark m l) l))))) (loop (cdr lines) (+ lnum 1) (cons n res)))))))) |