aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo/package/base.scm36
-rw-r--r--src/guile/skribilo/prog.scm39
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))))))))