From e4dc03b08786314ddf89e7fe506567c8783fdad8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Sun, 1 Jul 2007 23:47:37 +0000 Subject: Fixed (or almost so) the C lexer. * src/guile/skribilo/coloring/Makefile.am (.l.scm): Have the generated module use `srfi-1'. * src/guile/skribilo/coloring/c-lex.l: Support multi-line comments and properly use `*the-keys*'. * src/guile/skribilo/coloring/c-lex.scm: Updated. * src/guile/skribilo/coloring/c.scm: Fixed module name. (c-language): New. git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-127 --- src/guile/skribilo/coloring/Makefile.am | 1 + src/guile/skribilo/coloring/c-lex.l | 86 ++++++++++++++++++--------------- src/guile/skribilo/coloring/c-lex.scm | 66 +++++++++++++++++-------- src/guile/skribilo/coloring/c.scm | 8 ++- 4 files changed, 98 insertions(+), 63 deletions(-) (limited to 'src/guile') 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 -;;;; -;;;; -;;;; 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 +;;; Copyright 2007 Ludovic Courtès +;;; +;;; 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 -<> (skribe-error 'lisp-fontifier "Parse error" yytext) - - - - - - - \ No newline at end of file +<> (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. -- cgit v1.2.3 From 2f71af548b132d52db258bf57fc2e0e868411ef8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Sun, 1 Jul 2007 23:48:19 +0000 Subject: Autoload `(skribilo coloring c)' in the default module. * src/guile/skribilo/module.scm (%skribilo-user-autoloads): Fixed the `lout' autoload list. Added `(skribilo coloring c)'. git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-128 --- ChangeLog | 17 +++++++++++++++++ src/guile/skribilo/module.scm | 7 ++----- 2 files changed, 19 insertions(+), 5 deletions(-) (limited to 'src/guile') diff --git a/ChangeLog b/ChangeLog index 81b8122..c4807f4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,23 @@ # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2 # +2007-07-01 23:48:19 GMT Ludovic Courtes patch-128 + + Summary: + Autoload `(skribilo coloring c)' in the default module. + Revision: + skribilo--devo--1.2--patch-128 + + * src/guile/skribilo/module.scm (%skribilo-user-autoloads): Fixed the + `lout' autoload list. Added `(skribilo coloring c)'. + + modified files: + ChangeLog src/guile/skribilo/module.scm + + new patches: + lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-112 + + 2007-07-01 23:47:37 GMT Ludovic Courtes patch-127 Summary: 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!)) -- cgit v1.2.3 From 61d482a4b1e6e720f4607a4ebda3900c8e88c3b5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Sun, 1 Jul 2007 23:48:43 +0000 Subject: `lout' engine: Fixed argument passing for `lout-illustration'. * src/guile/skribilo/engine/lout.scm (lout-illustration): Better compute argument string for `lout'. git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-129 --- ChangeLog | 17 +++++++++++++++++ src/guile/skribilo/engine/lout.scm | 15 ++++++++------- 2 files changed, 25 insertions(+), 7 deletions(-) (limited to 'src/guile') diff --git a/ChangeLog b/ChangeLog index c4807f4..e993ff3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,23 @@ # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2 # +2007-07-01 23:48:43 GMT Ludovic Courtes patch-129 + + Summary: + `lout' engine: Fixed argument passing for `lout-illustration'. + Revision: + skribilo--devo--1.2--patch-129 + + * src/guile/skribilo/engine/lout.scm (lout-illustration): Better compute + argument string for `lout'. + + modified files: + ChangeLog src/guile/skribilo/engine/lout.scm + + new patches: + lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-113 + + 2007-07-01 23:48:19 GMT Ludovic Courtes patch-128 Summary: diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm index bc796bd..7c273ac 100644 --- a/src/guile/skribilo/engine/lout.scm +++ b/src/guile/skribilo/engine/lout.scm @@ -2811,13 +2811,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) -- cgit v1.2.3 From 303200b9e863d2a1ff07180b5211a6826ea75f36 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Sun, 1 Jul 2007 23:49:09 +0000 Subject: `base' package: Honor `:line #f' in `prog'. * src/guile/skribilo/prog.scm: Use `srfi-11' instead of `receive'. (make-prog-body): When creating a `&prog-line', set the `:number' option only if `lnum-init' is true. git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-130 --- ChangeLog | 18 ++++++++++++++++++ src/guile/skribilo/prog.scm | 32 ++++++++++++++++---------------- 2 files changed, 34 insertions(+), 16 deletions(-) (limited to 'src/guile') diff --git a/ChangeLog b/ChangeLog index e993ff3..8a5a0e0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,24 @@ # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2 # +2007-07-01 23:49:09 GMT Ludovic Courtes patch-130 + + Summary: + `base' package: Honor `:line #f' in `prog'. + Revision: + skribilo--devo--1.2--patch-130 + + * src/guile/skribilo/prog.scm: Use `srfi-11' instead of `receive'. + (make-prog-body): When creating a `&prog-line', set the `:number' + option only if `lnum-init' is true. + + modified files: + ChangeLog src/guile/skribilo/prog.scm + + new patches: + lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-114 + + 2007-07-01 23:48:43 GMT Ludovic Courtes patch-129 Summary: diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm index 0113db6..9ea334d 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 -;;; Copyright 2006 Ludovic Courtès +;;; Copyright 2003 Erick Gallesio - I3S-CNRS/ESSI +;;; Copyright 2006, 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -21,7 +21,8 @@ (define-module (skribilo prog) :use-module (ice-9 regex) - :autoload (ice-9 receive) (receive) + :use-module (srfi srfi-11) + :use-module (skribilo lib) ;; `new' :use-module (skribilo ast) :use-module (skribilo utils syntax) @@ -32,11 +33,10 @@ (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 @@ -54,7 +54,7 @@ ;*---------------------------------------------------------------------*/ ;* *lines* ... */ ;*---------------------------------------------------------------------*/ -;; FIXME: Removed that global. Rework the thing. +;; FIXME: Remove that global. Rework the thing. (define *lines* (make-hash-table)) ;*---------------------------------------------------------------------*/ @@ -99,14 +99,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 @@ -200,17 +200,17 @@ 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))) + (options `((:number ,(and lnum-init lnum)))) (body (if m (make-line-mark m line-ident l) l))))) (loop (cdr lines) (+ lnum 1) -- cgit v1.2.3 From 518ed0ad7bdd7b1bb34360d5480c09bcbdffe5cd Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Sun, 1 Jul 2007 23:49:58 +0000 Subject: Removed global hash tables for marks and program lines. * src/guile/skribilo/package/base.scm (*mark-table*): Removed. (mark): Return the new mark without touching `*mark-table*'. Use `bs' as the mark's identifier. (ref)[mark-ref]: Simplified using `do-ident-ref'. [line-ref]: Use the new `resolve-line'. * src/guile/skribilo/prog.scm: Use `srfi-1'. (*lines*): Removed. (make-line-mark): Don't use `*lines*'. Removed `m' parameter. (resolve-line): Take an additional `doc' argument. (extract-string-mark): Fixed. (flat-lines): Use `concatenate' instead of `apply append'. (make-prog-body)[regexp]: Use brackets. Fixed invocation of `make-line-mark'. git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-132 --- ChangeLog | 30 ++++++++++++++++++++++++++++ src/guile/skribilo/package/base.scm | 36 ++++++---------------------------- src/guile/skribilo/prog.scm | 39 ++++++++++++++----------------------- 3 files changed, 51 insertions(+), 54 deletions(-) (limited to 'src/guile') diff --git a/ChangeLog b/ChangeLog index 8c60204..43925d1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,36 @@ # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2 # +2007-07-01 23:49:58 GMT Ludovic Courtes patch-132 + + Summary: + Removed global hash tables for marks and program lines. + Revision: + skribilo--devo--1.2--patch-132 + + * src/guile/skribilo/package/base.scm (*mark-table*): Removed. + (mark): Return the new mark without touching `*mark-table*'. Use `bs' + as the mark's identifier. + (ref)[mark-ref]: Simplified using `do-ident-ref'. + [line-ref]: Use the new `resolve-line'. + + * src/guile/skribilo/prog.scm: Use `srfi-1'. + (*lines*): Removed. + (make-line-mark): Don't use `*lines*'. Removed `m' parameter. + (resolve-line): Take an additional `doc' argument. + (extract-string-mark): Fixed. + (flat-lines): Use `concatenate' instead of `apply append'. + (make-prog-body)[regexp]: Use brackets. + Fixed invocation of `make-line-mark'. + + modified files: + ChangeLog src/guile/skribilo/package/base.scm + src/guile/skribilo/prog.scm + + new patches: + lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-116 + + 2007-07-01 23:49:34 GMT Ludovic Courtes patch-131 Summary: 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 @@ -1000,11 +1000,6 @@ (options (the-options opts :ident :class)) (body (the-body opts)))) -;*---------------------------------------------------------------------*/ -;* *mark-table* ... */ -;*---------------------------------------------------------------------*/ -(define *mark-table* (make-hash-table)) - ;*---------------------------------------------------------------------*/ ;* mark ... */ ;* ------------------------------------------------------------- */ @@ -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' @@ -51,38 +52,28 @@ ;;; définir en bigloo node-body-set -;*---------------------------------------------------------------------*/ -;* *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)))))))) -- cgit v1.2.3 From 46122eb2392f848079320e09eda8b747dc9a4177 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Sun, 1 Jul 2007 23:50:22 +0000 Subject: Fixed and simplified `(ref :line ...)', aka. `line-ref'. * src/guile/skribilo/engine/base.scm (line-ref): Changed the way the number is obtained. * src/guile/skribilo/engine/context.scm (line-ref): Removed. * src/guile/skribilo/engine/html.scm (&prog-line): New. Produce an anchor. Needed because `mark' are no longer produced by `make-prog-body'. (line-ref): Changed the way the number is obtained. * src/guile/skribilo/engine/latex.scm (line-ref): Removed. * src/guile/skribilo/engine/lout.scm (line-ref): Removed. * src/guile/skribilo/prog.scm (make-line-mark): Removed. (make-prog-body): No longer use it. git-archimport-id: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-133 --- ChangeLog | 35 +++++++++++++++++++++++++++++++++++ src/guile/skribilo/engine/base.scm | 7 ++++--- src/guile/skribilo/engine/context.scm | 16 ---------------- src/guile/skribilo/engine/html.scm | 25 +++++++++++++++++++++---- src/guile/skribilo/engine/latex.scm | 16 ---------------- src/guile/skribilo/engine/lout.scm | 16 ---------------- src/guile/skribilo/prog.scm | 11 ++--------- 7 files changed, 62 insertions(+), 64 deletions(-) (limited to 'src/guile') diff --git a/ChangeLog b/ChangeLog index 43925d1..ea5d7de 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,41 @@ # arch-tag: automatic-ChangeLog--skribilo@sv.gnu.org--2006/skribilo--devo--1.2 # +2007-07-01 23:50:22 GMT Ludovic Courtes patch-133 + + Summary: + Fixed and simplified `(ref :line ...)', aka. `line-ref'. + Revision: + skribilo--devo--1.2--patch-133 + + * src/guile/skribilo/engine/base.scm (line-ref): Changed the way the + number is obtained. + + * src/guile/skribilo/engine/context.scm (line-ref): Removed. + + * src/guile/skribilo/engine/html.scm (&prog-line): New. Produce an + anchor. Needed because `mark' are no longer produced by + `make-prog-body'. + (line-ref): Changed the way the number is obtained. + + * src/guile/skribilo/engine/latex.scm (line-ref): Removed. + + * src/guile/skribilo/engine/lout.scm (line-ref): Removed. + + * src/guile/skribilo/prog.scm (make-line-mark): Removed. + (make-prog-body): No longer use it. + + modified files: + ChangeLog src/guile/skribilo/engine/base.scm + src/guile/skribilo/engine/context.scm + src/guile/skribilo/engine/html.scm + src/guile/skribilo/engine/latex.scm + src/guile/skribilo/engine/lout.scm src/guile/skribilo/prog.scm + + new patches: + lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-117 + + 2007-07-01 23:49:58 GMT Ludovic Courtes patch-132 Summary: 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 "") + +;*---------------------------------------------------------------------*/ +;* &prog-line ... */ +;*---------------------------------------------------------------------*/ +(markup-writer '&prog-line + :before (lambda (n e) + (let ((before (writer-before + (markup-writer-get '&prog-line base-engine)))) + (format #t "") + (before n e))) + :after "\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 "") ;*---------------------------------------------------------------------*/ 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 @@ -1578,22 +1578,6 @@ (display url) (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 ... */ ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm index 7c273ac..a93cde7 100644 --- a/src/guile/skribilo/engine/lout.scm +++ b/src/guile/skribilo/engine/lout.scm @@ -2471,22 +2471,6 @@ (markup-option-add! n '&transformed #t) (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 ... */ ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm index 5f08420..87321da 100644 --- a/src/guile/skribilo/prog.scm +++ b/src/guile/skribilo/prog.scm @@ -27,7 +27,6 @@ :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)) @@ -52,12 +51,6 @@ ;;; définir en bigloo node-body-set -;*---------------------------------------------------------------------*/ -;* make-line-mark ... */ -;*---------------------------------------------------------------------*/ -(define (make-line-mark ident b) - (list (mark ident) b)) - ;*---------------------------------------------------------------------*/ ;* resolve-line ... */ ;*---------------------------------------------------------------------*/ @@ -200,9 +193,9 @@ (let* ((line-ident (symbol->string (gensym "&prog-line"))) (n (new markup (markup '&prog-line) - (ident line-ident) + (ident (or m line-ident)) (options `((:number ,(and lnum-init lnum)))) - (body (if m (make-line-mark m l) l))))) + (body l)))) (loop (cdr lines) (+ lnum 1) (cons n res)))))))) -- cgit v1.2.3