aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo/coloring/Makefile.am1
-rw-r--r--src/guile/skribilo/coloring/c-lex.l86
-rw-r--r--src/guile/skribilo/coloring/c-lex.scm66
-rw-r--r--src/guile/skribilo/coloring/c.scm8
-rw-r--r--src/guile/skribilo/engine/base.scm7
-rw-r--r--src/guile/skribilo/engine/context.scm16
-rw-r--r--src/guile/skribilo/engine/html.scm25
-rw-r--r--src/guile/skribilo/engine/latex.scm16
-rw-r--r--src/guile/skribilo/engine/lout.scm31
-rw-r--r--src/guile/skribilo/module.scm7
-rw-r--r--src/guile/skribilo/package/base.scm36
-rw-r--r--src/guile/skribilo/prog.scm74
12 files changed, 168 insertions, 205 deletions
diff --git a/src/guile/skribilo/coloring/Makefile.am b/src/guile/skribilo/coloring/Makefile.am
index 9a3e043..5073575 100644
--- a/src/guile/skribilo/coloring/Makefile.am
+++ b/src/guile/skribilo/coloring/Makefile.am
@@ -18,6 +18,7 @@ EXTRA_DIST = lisp-lex.l xml-lex.l c-lex.l
echo ' :use-module (skribilo lib)' >> "$@" && \
echo ' :use-module (skribilo coloring parameters)' \
>> "$@" && \
+ echo ' :use-module (srfi srfi-1)' >> "$@" && \
echo ' :export (lexer-init lexer' >> "$@" && \
echo ' lexer-get-func-column' >> "$@" && \
echo ' lexer-get-func-offset' >> "$@" && \
diff --git a/src/guile/skribilo/coloring/c-lex.l b/src/guile/skribilo/coloring/c-lex.l
index 7d7b1ce..b28a91a 100644
--- a/src/guile/skribilo/coloring/c-lex.l
+++ b/src/guile/skribilo/coloring/c-lex.l
@@ -1,28 +1,22 @@
-;;;;
-;;;; c-lex.l -- C fontifier for Skribe
-;;;;
-;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.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.
-;;;;
-;;;; Author: Erick Gallesio [eg@essi.fr]
-;;;; Creation date: 6-Mar-2004 15:35 (eg)
-;;;; Last file update: 7-Mar-2004 00:10 (eg)
-;;;;
+;;; c-lex.l -- C fontifier for Skribilo.
+;;;
+;;; Copyright 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2007 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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.
space [ \n\9]
letter [_a-zA-Z]
@@ -34,34 +28,46 @@ alphanum [_a-zA-Z0-9]
\"[^\"]*\" (new markup
(markup '&source-string)
(body yytext))
-;;Comments
-/\*.*\*/ (new markup
- (markup '&source-line-comment)
- (body yytext))
+;; Comments
+;; FIXME: We shouldn't exclude `/' from comments but we do so to match the
+;; shortest multi-line comment.
+/\*(\n|[^/])*\*/ (let* ((not-line (char-set-complement (char-set #\newline)))
+ (lines (string-tokenize yytext not-line)))
+ (reverse!
+ (pair-fold (lambda (line* result)
+ (let* ((line (car line*))
+ (last? (null? (cdr line*)))
+ (markup
+ (new markup
+ (markup '&source-line-comment)
+ (body line))))
+ (if last?
+ (cons markup result)
+ (cons* (string #\newline)
+ markup result))))
+ '()
+ lines)))
+
//.* (new markup
(markup '&source-line-comment)
(body yytext))
;; Identifiers (only letters since we are interested in keywords only)
[_a-zA-Z]+ (let* ((ident (string->symbol yytext))
- (tmp (memq ident *the-keys*)))
+ (tmp (memq ident (*the-keys*))))
(if tmp
(new markup
(markup '&source-module)
(body yytext))
yytext))
-;; Regular text
-[^\"a-zA-Z]+ (begin yytext)
+;; Regular text (excluding `/' and `*')
+[^\"a-zA-Z/*]+ (begin yytext)
+;; `/' and `*' alone.
+/[^\*] (begin yytext)
+\*[^/] (begin yytext)
<<EOF>> 'eof
-<<ERROR>> (skribe-error 'lisp-fontifier "Parse error" yytext)
-
-
-
-
-
-
- \ No newline at end of file
+<<ERROR>> (skribe-error 'c-fontifier "Parse error" yytext)
diff --git a/src/guile/skribilo/coloring/c-lex.scm b/src/guile/skribilo/coloring/c-lex.scm
index 8ed6160..162c0c2 100644
--- a/src/guile/skribilo/coloring/c-lex.scm
+++ b/src/guile/skribilo/coloring/c-lex.scm
@@ -1,6 +1,7 @@
(define-module (skribilo coloring c-lex)
:use-module (skribilo lib)
:use-module (skribilo coloring parameters)
+ :use-module (srfi srfi-1)
:export (lexer-init lexer
lexer-get-func-column
lexer-get-func-offset
@@ -1152,7 +1153,7 @@
))
(lambda (yycontinue yygetc yyungetc)
(lambda (yytext yyline)
- (skribe-error 'lisp-fontifier "Parse error" yytext)
+ (skribe-error 'c-fontifier "Parse error" yytext)
))
(vector
#t
@@ -1161,14 +1162,29 @@
(new markup
(markup '&source-string)
(body yytext))
-;;Comments
+;; Comments
+;; FIXME: We shouldn't exclude `/' from comments but we do so to match the
+;; shortest multi-line comment.
))
#t
(lambda (yycontinue yygetc yyungetc)
(lambda (yytext yyline)
- (new markup
- (markup '&source-line-comment)
- (body yytext))
+ (let* ((not-line (char-set-complement (char-set #\newline)))
+ (lines (string-tokenize yytext not-line)))
+ (reverse!
+ (pair-fold (lambda (line* result)
+ (let* ((line (car line*))
+ (last? (null? (cdr line*)))
+ (markup
+ (new markup
+ (markup '&source-line-comment)
+ (body line))))
+ (if last?
+ (cons markup result)
+ (cons* (string #\newline)
+ markup result))))
+ '()
+ lines)))
))
#t
(lambda (yycontinue yygetc yyungetc)
@@ -1183,36 +1199,44 @@
(lambda (yycontinue yygetc yyungetc)
(lambda (yytext yyline)
(let* ((ident (string->symbol yytext))
- (tmp (memq ident *the-keys*)))
+ (tmp (memq ident (*the-keys*))))
(if tmp
(new markup
(markup '&source-module)
(body yytext))
yytext))
-;; Regular text
+;; Regular text (excluding `/' and `*')
+ ))
+ #t
+ (lambda (yycontinue yygetc yyungetc)
+ (lambda (yytext yyline)
+ (begin yytext)
+
+;; `/' and `*' alone.
+ ))
+ #t
+ (lambda (yycontinue yygetc yyungetc)
+ (lambda (yytext yyline)
+ (begin yytext)
))
#t
(lambda (yycontinue yygetc yyungetc)
(lambda (yytext yyline)
- (begin yytext)
+ (begin yytext)
)))
'decision-trees
0
0
- '#((65 (35 (34 1 5) (= 47 4 1)) (96 (91 3 (95 1 2)) (97 1 (123 3 1))))
- (65 (= 34 err 1) (97 (91 err 1) (123 err 1))) (91 (35 (34 1 err) (65 1
- 3)) (96 (95 1 2) (97 1 (123 3 1)))) (95 (65 err (91 3 err)) (97 (96 3
- err) (123 3 err))) (47 (35 (34 1 err) (= 42 7 1)) (91 (48 6 (65 1 err))
- (97 1 (123 err 1)))) (= 34 8 5) (35 (11 (10 6 1) (34 6 9)) (91 (65 6 9)
- (97 6 (123 9 6)))) (42 (11 (10 7 1) (= 34 10 7)) (91 (43 11 (65 7 10))
- (97 7 (123 10 7)))) err (= 10 err 9) (11 (10 10 err) (= 42 12 10)) (43
- (34 (= 10 1 7) (35 10 (42 7 11))) (65 (= 47 13 7) (97 (91 10 7) (123 10
- 7)))) (42 (= 10 err 10) (47 (43 12 10) (48 14 10))) (42 (11 (10 7 1) (=
- 34 10 7)) (91 (43 11 (65 7 10)) (97 7 (123 10 7)))) (11 (10 10 err) (=
- 42 12 10)))
- '#((#f . #f) (4 . 4) (3 . 3) (3 . 3) (4 . 4) (#f . #f) (2 . 2) (4 . 4)
- (0 . 0) (2 . 2) (#f . #f) (4 . 4) (#f . #f) (1 . 1) (1 . 1))))
+ '#((48 (42 (= 34 6 2) (43 1 (47 2 5))) (95 (65 2 (91 4 2)) (97 (96 3 2)
+ (123 4 2)))) (= 47 err 7) (47 (35 (34 2 err) (= 42 err 2)) (91 (48 err
+ (65 2 err)) (97 2 (123 err 2)))) (48 (42 (= 34 err 2) (43 err (47 2
+ err))) (95 (65 2 (91 4 2)) (97 (96 3 2) (123 4 2)))) (95 (65 err (91 4
+ err)) (97 (96 4 err) (123 4 err))) (43 (42 8 10) (= 47 9 8)) (= 34 11
+ 6) err err (= 10 err 12) (43 (42 10 13) (= 47 err 10)) err (= 10 err
+ 12) (43 (42 10 13) (= 47 14 10)) err)
+ '#((#f . #f) (#f . #f) (4 . 4) (3 . 3) (3 . 3) (#f . #f) (#f . #f) (6 .
+ 6) (5 . 5) (2 . 2) (#f . #f) (0 . 0) (2 . 2) (#f . #f) (1 . 1))))
;
; User functions
diff --git a/src/guile/skribilo/coloring/c.scm b/src/guile/skribilo/coloring/c.scm
index 28533b4..0d94307 100644
--- a/src/guile/skribilo/coloring/c.scm
+++ b/src/guile/skribilo/coloring/c.scm
@@ -19,13 +19,13 @@
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;; USA.
-(define-module (skribilo c)
+(define-module (skribilo coloring c)
:use-module (skribilo lib)
:use-module (skribilo utils syntax)
:use-module (skribilo coloring c-lex) ;; SILex generated
:use-module (skribilo coloring parameters)
:use-module (srfi srfi-39)
- :export (c java))
+ :export (c c-language java))
(fluid-set! current-reader %skribilo-module-reader)
@@ -62,6 +62,10 @@
(fontifier c-fontifier)
(extractor #f)))
+(define c-language
+ ;; This alias is defined for the user's convenience.
+ c)
+
;;;
;;; Java.
diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm
index 9e9445e..344146e 100644
--- a/src/guile/skribilo/engine/base.scm
+++ b/src/guile/skribilo/engine/base.scm
@@ -498,7 +498,8 @@
(markup-writer 'line-ref
:options '(:offset)
:action (lambda (n e)
- (let ((o (markup-option n :offset))
- (n (markup-ident (handle-body (markup-body n)))))
- (evaluate-document (it (if (integer? o) (+ o n) n)) e))))
+ (let ((o (markup-option n :offset))
+ (n (markup-option (handle-ast (markup-body n)) :number)))
+ (if (integer? n)
+ (display (if (integer? o) (+ o n) n))))))
diff --git a/src/guile/skribilo/engine/context.scm b/src/guile/skribilo/engine/context.scm
index 1b4301b..98069a3 100644
--- a/src/guile/skribilo/engine/context.scm
+++ b/src/guile/skribilo/engine/context.scm
@@ -1060,22 +1060,6 @@
:action (lambda (n e)
(context-url (markup-option n :url) (markup-option n :text) e)))
-;;//;*---------------------------------------------------------------------*/
-;;//;* line-ref ... */
-;;//;*---------------------------------------------------------------------*/
-;;//(markup-writer 'line-ref
-;;// :options '(:offset)
-;;// :before "{\\textit{"
-;;// :action (lambda (n e)
-;;// (let ((o (markup-option n :offset))
-;;// (v (string->number (markup-option n :text))))
-;;// (cond
-;;// ((and (number? o) (number? v))
-;;// (display (+ o v)))
-;;// (else
-;;// (display v)))))
-;;// :after "}}")
-
;;; ======================================================================
;;; &the-bibliography ...
diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
index 688d33d..a16f01f 100644
--- a/src/guile/skribilo/engine/html.scm
+++ b/src/guile/skribilo/engine/html.scm
@@ -2069,6 +2069,21 @@
(output (or v (markup-option n :url)) e)))
:after "</a>")
+
+;*---------------------------------------------------------------------*/
+;* &prog-line ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&prog-line
+ :before (lambda (n e)
+ (let ((before (writer-before
+ (markup-writer-get '&prog-line base-engine))))
+ (format #t "<a name=\"~a\""
+ (string-canonicalize (markup-ident n)))
+ (html-class n)
+ (display ">")
+ (before n e)))
+ :after "</a>\n")
+
;*---------------------------------------------------------------------*/
;* line-ref ... */
;*---------------------------------------------------------------------*/
@@ -2077,12 +2092,14 @@
:before (html-markup-class "i")
:action (lambda (n e)
(let ((o (markup-option n :offset))
- (v (string->number (markup-option n :text))))
- (if (and (number? o) (number? v))
- (markup-option-add! n :text (+ o v)))
+ (v (markup-option (handle-ast (markup-body n)) :number)))
+ (cond ((and (number? o) (number? v))
+ (markup-option-set! n :text (+ o v)))
+ ((number? v)
+ (markup-option-set! n :text v)))
(output n e (markup-writer-get 'ref e))
(if (and (number? o) (number? v))
- (markup-option-add! n :text v))))
+ (markup-option-set! n :text v))))
:after "</i>")
;*---------------------------------------------------------------------*/
diff --git a/src/guile/skribilo/engine/latex.scm b/src/guile/skribilo/engine/latex.scm
index 9b49545..8523c9a 100644
--- a/src/guile/skribilo/engine/latex.scm
+++ b/src/guile/skribilo/engine/latex.scm
@@ -1579,22 +1579,6 @@
(format #t "}{~a}" url))))))
;*---------------------------------------------------------------------*/
-;* line-ref ... */
-;*---------------------------------------------------------------------*/
-(markup-writer 'line-ref
- :options '(:offset)
- :before "{\\textit{"
- :action (lambda (n e)
- (let ((o (markup-option n :offset))
- (v (string->number (markup-option n :text))))
- (cond
- ((and (number? o) (number? v))
- (display (+ o v)))
- (else
- (display v)))))
- :after "}}")
-
-;*---------------------------------------------------------------------*/
;* &the-bibliography ... */
;*---------------------------------------------------------------------*/
(markup-writer '&the-bibliography
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index bc796bd..a93cde7 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -2472,22 +2472,6 @@
(output (transform n) e))))))
;*---------------------------------------------------------------------*/
-;* line-ref ... */
-;*---------------------------------------------------------------------*/
-(markup-writer 'line-ref
- :options '(:offset)
- :before "{ @I {" ;; FIXME: Not tested
- :action (lambda (n e)
- (let ((o (markup-option n :offset))
- (v (string->number (markup-option n :text))))
- (cond
- ((and (number? o) (number? v))
- (display (+ o v)))
- (else
- (display v)))))
- :after "} }")
-
-;*---------------------------------------------------------------------*/
;* &the-bibliography ... */
;*---------------------------------------------------------------------*/
(markup-writer '&the-bibliography
@@ -2811,13 +2795,14 @@
(gensym "lout-illustration")))
".eps"))
(port (open-output-pipe
- (apply string-append
- (or (engine-custom lout 'lout-program-name)
- "lout")
- " -o " output
- " -EPS "
- (engine-custom lout
- 'lout-program-arguments)))))
+ (string-append
+ (or (engine-custom lout 'lout-program-name)
+ "lout")
+ " -o " output
+ " -EPS "
+ (string-join
+ (engine-custom lout
+ 'lout-program-arguments))))))
;; send the illustration to Lout's standard input
(display (illustration-header) port)
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index ccded17..81d2a16 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -65,11 +65,7 @@
(define %skribilo-user-autoloads
;; List of auxiliary modules that may be lazily autoloaded.
- '(((skribilo engine lout) . (!lout
- lout-illustration
- ;; FIXME: The following should eventually be
- ;; removed from here.
- lout-structure-number-string))
+ '(((skribilo engine lout) . (!lout lout-illustration))
((skribilo engine latex) . (!latex LaTeX TeX))
((skribilo engine html) . (html-markup-class html-class
html-width))
@@ -81,6 +77,7 @@
language-fontifier source-fontify))
((skribilo coloring lisp) . (skribe scheme lisp))
((skribilo coloring xml) . (xml))
+ ((skribilo coloring c) . (c java))
((skribilo prog) . (make-prog-body resolve-line))
((skribilo color) .
(skribe-color->rgb skribe-get-used-colors skribe-use-color!))
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 0113db6..87321da 100644
--- a/src/guile/skribilo/prog.scm
+++ b/src/guile/skribilo/prog.scm
@@ -1,7 +1,7 @@
;;; prog.scm -- All the stuff for the prog markup
;;;
-;;; Copyright 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;; Copyright 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;; Copyright 2006, 2007 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -21,22 +21,22 @@
(define-module (skribilo prog)
:use-module (ice-9 regex)
- :autoload (ice-9 receive) (receive)
+ :use-module (srfi srfi-1)
+ :use-module (srfi srfi-11)
+
:use-module (skribilo lib) ;; `new'
:use-module (skribilo ast)
:use-module (skribilo utils syntax)
- :autoload (skribilo package base) (mark)
:export (make-prog-body resolve-line))
(fluid-set! current-reader %skribilo-module-reader)
-;;; ======================================================================
;;;
-;;; COMPATIBILITY
+;;; Bigloo compatibility.
;;;
-;;; ======================================================================
+
(define pregexp-match string-match)
(define pregexp-replace (lambda (rx str what)
(regexp-substitute/global #f rx str
@@ -52,37 +52,21 @@
;*---------------------------------------------------------------------*/
-;* *lines* ... */
-;*---------------------------------------------------------------------*/
-;; FIXME: Removed 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))
-
-;*---------------------------------------------------------------------*/
;* 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 ... */
;* ------------------------------------------------------------- */
@@ -99,14 +83,14 @@
(res '()))
(if (null? ls)
(values #f line)
- (receive (m l)
- (extract-mark (car ls) mark regexp)
+ (let-values (((m l)
+ (extract-mark (car ls) mark regexp)))
(if (not m)
(loop (cdr ls) (cons l res))
(values m (append (reverse! res) (cons l (cdr ls)))))))))
((node? line)
- (receive (m l)
- (extract-mark (node-body line) mark regexp)
+ (let-values (((m l)
+ (extract-mark (node-body line) mark regexp)))
(if (not m)
(values #f line)
(begin
@@ -153,7 +137,7 @@
;* flat-lines ... */
;*---------------------------------------------------------------------*/
(define (flat-lines lines)
- (apply append (map split-line lines)))
+ (concatenate (map split-line lines)))
;*---------------------------------------------------------------------*/
;* collect-lines ... */
@@ -181,13 +165,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))
@@ -200,18 +184,18 @@
lnum)
(length lines)))))
(let loop ((lines lines)
- (lnum lnum)
- (res '()))
+ (lnum lnum)
+ (res '()))
(if (null? lines)
(reverse! res)
- (receive (m l)
- (extract-mark (car lines) mark regexp)
+ (let-values (((m l)
+ (extract-mark (car lines) mark regexp)))
(let* ((line-ident (symbol->string (gensym "&prog-line")))
(n (new markup
(markup '&prog-line)
- (ident line-ident)
- (options `((:number ,lnum)))
- (body (if m (make-line-mark m line-ident l) l)))))
+ (ident (or m line-ident))
+ (options `((:number ,(and lnum-init lnum))))
+ (body l))))
(loop (cdr lines)
(+ lnum 1)
(cons n res))))))))
generated by cgit v1.2.3 (git 2.45.2) at 2024-11-16 23:13:07 +0000