From ee55493f9c05aeeb039f51ab169f1392c8593457 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Thu, 20 Jul 2006 10:04:35 +0000 Subject: Renamed `(skribilo runtime)' to `(skribilo utils strings)'. ... and updated users. git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-18 --- src/guile/skribilo/Makefile.am | 2 +- src/guile/skribilo/biblio.scm | 2 +- src/guile/skribilo/biblio/abbrev.scm | 4 +- src/guile/skribilo/biblio/author.scm | 2 +- src/guile/skribilo/biblio/bibtex.scm | 6 +- src/guile/skribilo/coloring/lisp.scm | 2 +- src/guile/skribilo/module.scm | 2 +- src/guile/skribilo/runtime.scm | 152 ----------------------------------- src/guile/skribilo/utils/Makefile.am | 2 +- src/guile/skribilo/utils/strings.scm | 145 +++++++++++++++++++++++++++++++++ src/guile/skribilo/verify.scm | 1 - 11 files changed, 156 insertions(+), 164 deletions(-) delete mode 100644 src/guile/skribilo/runtime.scm create mode 100644 src/guile/skribilo/utils/strings.scm diff --git a/src/guile/skribilo/Makefile.am b/src/guile/skribilo/Makefile.am index 8c17711..8de8774 100644 --- a/src/guile/skribilo/Makefile.am +++ b/src/guile/skribilo/Makefile.am @@ -2,7 +2,7 @@ guilemoduledir = $(GUILE_SITE)/skribilo dist_guilemodule_DATA = biblio.scm color.scm config.scm \ debug.scm engine.scm evaluator.scm \ lib.scm module.scm output.scm prog.scm \ - reader.scm resolve.scm runtime.scm \ + reader.scm resolve.scm \ source.scm parameters.scm verify.scm \ writer.scm ast.scm location.scm \ condition.scm diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm index 04a8bfd..7905593 100644 --- a/src/guile/skribilo/biblio.scm +++ b/src/guile/skribilo/biblio.scm @@ -21,7 +21,7 @@ (define-module (skribilo biblio) - :use-module (skribilo runtime) + :use-module (skribilo utils strings) :use-module (skribilo utils syntax) ;; `when', `unless' :autoload (srfi srfi-34) (raise) diff --git a/src/guile/skribilo/biblio/abbrev.scm b/src/guile/skribilo/biblio/abbrev.scm index 1e88e82..4440f1c 100644 --- a/src/guile/skribilo/biblio/abbrev.scm +++ b/src/guile/skribilo/biblio/abbrev.scm @@ -20,8 +20,8 @@ (define-module (skribilo biblio abbrev) :use-module (srfi srfi-13) - :autoload (skribilo ast) (markup? markup-body-set!) - :autoload (skribilo runtime) (make-string-replace) + :autoload (skribilo ast) (markup? markup-body-set!) + :autoload (skribilo utils strings) (make-string-replace) :autoload (ice-9 regex) (regexp-substitute/global) :export (is-abbreviation? is-acronym? abbreviate-word abbreviate-string abbreviate-markup diff --git a/src/guile/skribilo/biblio/author.scm b/src/guile/skribilo/biblio/author.scm index 43269ab..b9d78db 100644 --- a/src/guile/skribilo/biblio/author.scm +++ b/src/guile/skribilo/biblio/author.scm @@ -24,7 +24,7 @@ :use-module (skribilo biblio abbrev) :autoload (skribilo ast) (markup-option markup-body markup-ident) :autoload (skribilo lib) (skribe-error) - :autoload (skribilo runtime) (make-string-replace) + :autoload (skribilo utils strings) (make-string-replace) :export (comma-separated->author-list comma-separated->and-separated-authors diff --git a/src/guile/skribilo/biblio/bibtex.scm b/src/guile/skribilo/biblio/bibtex.scm index be5ed36..ac6cf2a 100644 --- a/src/guile/skribilo/biblio/bibtex.scm +++ b/src/guile/skribilo/biblio/bibtex.scm @@ -20,9 +20,9 @@ (define-module (skribilo biblio bibtex) - :autoload (skribilo runtime) (make-string-replace) - :autoload (skribilo ast) (markup-option ast->string) - :autoload (skribilo engine) (engine-filter find-engine) + :autoload (skribilo utils strings) (make-string-replace) + :autoload (skribilo ast) (markup-option ast->string) + :autoload (skribilo engine) (engine-filter find-engine) :use-module (skribilo biblio author) :use-module (srfi srfi-39) :export (print-as-bibtex-entry)) diff --git a/src/guile/skribilo/coloring/lisp.scm b/src/guile/skribilo/coloring/lisp.scm index e3458b1..b3efc51 100644 --- a/src/guile/skribilo/coloring/lisp.scm +++ b/src/guile/skribilo/coloring/lisp.scm @@ -24,7 +24,7 @@ :use-module (skribilo utils syntax) :use-module (skribilo source) :use-module (skribilo lib) - :use-module (skribilo runtime) + :use-module (skribilo utils strings) :use-module (srfi srfi-39) :use-module (ice-9 match) :autoload (ice-9 regex) (make-regexp) diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm index 6a6301b..1206747 100644 --- a/src/guile/skribilo/module.scm +++ b/src/guile/skribilo/module.scm @@ -48,10 +48,10 @@ (skribilo utils syntax) ;; `unless', `when', etc. (skribilo utils compat) ;; `skribe-load-path', etc. (skribilo utils keywords) ;; `the-body', `the-options' + (skribilo utils strings) ;; `make-string-replace', etc. (skribilo module) (skribilo ast) ;; `', `document?', etc. (skribilo config) - (skribilo runtime) ;; `make-string-replace', etc. (skribilo biblio) (skribilo lib) ;; `define-markup', `unwind-protect', etc. (skribilo resolve) diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm deleted file mode 100644 index 73d776c..0000000 --- a/src/guile/skribilo/runtime.scm +++ /dev/null @@ -1,152 +0,0 @@ -;;; runtime.scm -- Skribilo runtime system -;;; -;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI -;;; Copyright 2005, 2006 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, -;;; USA. - -(define-module (skribilo runtime) - ;; FIXME: Useful procedures are scattered between here and - ;; `(skribilo skribe utils)'. - :export (;; Utilities - strip-ref-base string-canonicalize - - ;; String writing - make-string-replace) - :autoload (skribilo parameters) (*ref-base*) - :use-module (skribilo lib) - :use-module (srfi srfi-13)) - - -;;; ====================================================================== -;;; -;;; U T I L I T I E S -;;; -;;; ====================================================================== - - -;;FIXME: Remonter cette fonction -(define (strip-ref-base file) - (if (not (string? (*ref-base*))) - file - (let ((l (string-length (*ref-base*)))) - (cond - ((not (> (string-length file) (+ l 2))) - file) - ((not (string-contains file (*ref-base*) 0 l)) - file) - ((not (char=? (string-ref file l) #\/)) - file) - (else - (substring file (+ l 1) (string-length file))))))) - - -;; FIXME: Remonter cette fonction -(define (string-canonicalize old) - (let* ((l (string-length old)) - (new (make-string l))) - (let loop ((r 0) - (w 0) - (s #f)) - (cond - ((= r l) - (cond - ((= w 0) - "") - ((char-whitespace? (string-ref new (- w 1))) - (substring new 0 (- w 1))) - ((= w r) - new) - (else - (substring new 0 w)))) - ((char-whitespace? (string-ref old r)) - (if s - (loop (+ r 1) w #t) - (begin - (string-set! new w #\-) - (loop (+ r 1) (+ w 1) #t)))) - ((or (char=? (string-ref old r) #\#) - (>= (char->integer (string-ref old r)) #x7f)) - (string-set! new w #\-) - (loop (+ r 1) (+ w 1) #t)) - (else - (string-set! new w (string-ref old r)) - (loop (+ r 1) (+ w 1) #f)))))) - - - -;;; ====================================================================== -;;; -;;; S T R I N G - W R I T I N G -;;; -;;; ====================================================================== - -;; -;; (define (%make-html-replace) -;; ;; Ad-hoc version for HTML, a little bit faster than the -;; ;; make-general-string-replace define later (particularily if there -;; ;; is nothing to replace since, it does not allocate a new string -;; (let ((specials (string->regexp "&|\"|<|>"))) -;; (lambda (str) -;; (if (regexp-match specials str) -;; (begin -;; (let ((out (open-output-string))) -;; (dotimes (i (string-length str)) -;; (let ((ch (string-ref str i))) -;; (case ch -;; ((#\") (display """ out)) -;; ((#\&) (display "&" out)) -;; ((#\<) (display "<" out)) -;; ((#\>) (display ">" out)) -;; (else (write-char ch out))))) -;; (get-output-string out))) -;; str)))) - - -(define (%make-general-string-replace lst) - ;; The general version - (let ((chars (make-hash-table))) - - ;; Setup a hash table equivalent to LST. - (for-each (lambda (chr) - (hashq-set! chars (car chr) (cadr chr))) - lst) - - ;; Help the GC. - (set! lst #f) - - (lambda (str) - (let ((out (open-output-string))) - (string-for-each (lambda (ch) - (let ((res (hashq-ref chars ch #f))) - (display (if res res ch) out))) - str) - (get-output-string out))))) - -(define string->html - (%make-general-string-replace '((#\" """) (#\& "&") (#\< "<") - (#\> ">")))) - -(define (make-string-replace lst) - (let ((l (sort lst (lambda (r1 r2) (char ">"))) - string->html) - (else - (%make-general-string-replace lst))))) - - - diff --git a/src/guile/skribilo/utils/Makefile.am b/src/guile/skribilo/utils/Makefile.am index 8f1d481..9d9df6f 100644 --- a/src/guile/skribilo/utils/Makefile.am +++ b/src/guile/skribilo/utils/Makefile.am @@ -1,5 +1,5 @@ guilemoduledir = $(GUILE_SITE)/skribilo/utils dist_guilemodule_DATA = syntax.scm compat.scm files.scm images.scm \ - keywords.scm + keywords.scm strings.scm ## arch-tag: 3a18b64b-1da2-417b-8338-2c534bca277f diff --git a/src/guile/skribilo/utils/strings.scm b/src/guile/skribilo/utils/strings.scm new file mode 100644 index 0000000..aea45c6 --- /dev/null +++ b/src/guile/skribilo/utils/strings.scm @@ -0,0 +1,145 @@ +;;; strings.scm -- Convenience functions to manipulate strings. +;;; +;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI +;;; Copyright 2005, 2006 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +;;; USA. + +(define-module (skribilo utils strings) + :export (strip-ref-base string-canonicalize + make-string-replace) + :autoload (skribilo parameters) (*ref-base*) + :use-module (skribilo lib) + :use-module (srfi srfi-13)) + + +;;; +;;; Utilities. +;;; + +(define (strip-ref-base file) + ;; Given FILE, a file path (a string), remove `(*ref-base*)' from it. + ;; This is useful, e.g., for hyperlinks. + (if (not (string? (*ref-base*))) + file + (let ((l (string-length (*ref-base*)))) + (cond + ((not (> (string-length file) (+ l 2))) + file) + ((not (string-contains file (*ref-base*) 0 l)) + file) + ((not (char=? (string-ref file l) #\/)) + file) + (else + (substring file (+ l 1) (string-length file))))))) + + +(define (string-canonicalize old) + ;; Return a string that is a canonical summarized representation of string + ;; OLD. This is a one-way function. + (let* ((l (string-length old)) + (new (make-string l))) + (let loop ((r 0) + (w 0) + (s #f)) + (cond + ((= r l) + (cond + ((= w 0) + "") + ((char-whitespace? (string-ref new (- w 1))) + (substring new 0 (- w 1))) + ((= w r) + new) + (else + (substring new 0 w)))) + ((char-whitespace? (string-ref old r)) + (if s + (loop (+ r 1) w #t) + (begin + (string-set! new w #\-) + (loop (+ r 1) (+ w 1) #t)))) + ((or (char=? (string-ref old r) #\#) + (>= (char->integer (string-ref old r)) #x7f)) + (string-set! new w #\-) + (loop (+ r 1) (+ w 1) #t)) + (else + (string-set! new w (string-ref old r)) + (loop (+ r 1) (+ w 1) #f)))))) + + + + +;;; +;;; String writing. +;;; + +;; +;; (define (%make-html-replace) +;; ;; Ad-hoc version for HTML, a little bit faster than the +;; ;; make-general-string-replace define later (particularily if there +;; ;; is nothing to replace since, it does not allocate a new string +;; (let ((specials (string->regexp "&|\"|<|>"))) +;; (lambda (str) +;; (if (regexp-match specials str) +;; (begin +;; (let ((out (open-output-string))) +;; (dotimes (i (string-length str)) +;; (let ((ch (string-ref str i))) +;; (case ch +;; ((#\") (display """ out)) +;; ((#\&) (display "&" out)) +;; ((#\<) (display "<" out)) +;; ((#\>) (display ">" out)) +;; (else (write-char ch out))))) +;; (get-output-string out))) +;; str)))) + + +(define (%make-general-string-replace lst) + ;; The general version + (let ((chars (make-hash-table))) + + ;; Setup a hash table equivalent to LST. + (for-each (lambda (chr) + (hashq-set! chars (car chr) (cadr chr))) + lst) + + ;; Help the GC. + (set! lst #f) + + (lambda (str) + (let ((out (open-output-string))) + (string-for-each (lambda (ch) + (let ((res (hashq-ref chars ch #f))) + (display (if res res ch) out))) + str) + (get-output-string out))))) + +(define %html-replacements + '((#\" """) (#\& "&") (#\< "<") (#\> ">"))) + +(define %string->html + (%make-general-string-replace %html-replacements)) + +(define (make-string-replace lst) + (let ((l (sort lst (lambda (r1 r2) (charhtml) + (else + (%make-general-string-replace lst))))) + diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm index 1bd874a..dfc3c0d 100644 --- a/src/guile/skribilo/verify.scm +++ b/src/guile/skribilo/verify.scm @@ -27,7 +27,6 @@ :export (verify)) (use-modules (skribilo debug) - (skribilo runtime) (skribilo ast) (skribilo utils syntax) (oop goops)) -- cgit v1.2.3