From 20e5a989999ca11d68bf90417402c60c275dd0cc Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Sun, 8 Jan 2006 17:13:42 +0000 Subject: Cleaning the compatibility module and other annoyances. * src/skribilo.in: Catch exceptions and call `(exit 1)' when caught. * doc/user/Makefile.am (skribilo): Fixed. * src/guile/skribilo.scm: Updated copyright year. * src/guile/skribilo/compat.scm: Moved to `utils'. * src/guile/skribilo/Makefile.am (dist_guilemodule_DATA): Removed `compat.scm'. * src/guile/skribilo/Makefile.am (dist_guilemodule_DATA): Added `compat.scm'. * src/guile/skribilo/coloring/lisp.scm: Use `(skribilo utils syntax)'. * src/guile/skribilo/module.scm (%skribilo-user-imports): Import `(skribilo utils compat)' instead of `(skribilo compat)'. Added more triggering procedures for `(skribilo source)'. * src/guile/skribilo/skribe/api.scm: Moved the definition of a Skribe-compatible `gensym' to `compat.scm'. * src/guile/skribilo/source.scm: Use `*source-path*' instead of `skribe-source-path'. git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-19 --- src/guile/skribilo.scm | 8 +- src/guile/skribilo/Makefile.am | 3 +- src/guile/skribilo/coloring/lisp.scm | 1 + src/guile/skribilo/compat.scm | 155 ------------------------------- src/guile/skribilo/module.scm | 6 +- src/guile/skribilo/skribe/api.scm | 13 +-- src/guile/skribilo/source.scm | 8 +- src/guile/skribilo/utils/Makefile.am | 2 +- src/guile/skribilo/utils/compat.scm | 173 +++++++++++++++++++++++++++++++++++ src/skribilo.in | 2 +- 10 files changed, 187 insertions(+), 184 deletions(-) delete mode 100644 src/guile/skribilo/compat.scm create mode 100644 src/guile/skribilo/utils/compat.scm mode change 100644 => 100755 src/skribilo.in (limited to 'src') diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm index e131ff3..bf849ab 100644 --- a/src/guile/skribilo.scm +++ b/src/guile/skribilo.scm @@ -4,11 +4,10 @@ main='(module-ref (resolve-module '\''(skribilo)) '\'main')' exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# -;;;; ;;;; skribilo.scm ;;;; ;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI -;;;; Copyright 2005 Ludovic Courtès +;;;; Copyright 2005, 2006 Ludovic Courtès ;;;; ;;;; ;;;; This program is free software; you can redistribute it and/or modify @@ -25,11 +24,6 @@ exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@" ;;;; along with this program; if not, write to the Free Software ;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;;; USA. -;;;; -;;;; Author: Erick Gallesio [eg@essi.fr] -;;;; Creation date: 24-Jul-2003 20:33 (eg) -;;;; Last file update: 6-Mar-2004 16:13 (eg) -;;;; ;;;; Commentary: ;;;; diff --git a/src/guile/skribilo/Makefile.am b/src/guile/skribilo/Makefile.am index c6765f5..f136956 100644 --- a/src/guile/skribilo/Makefile.am +++ b/src/guile/skribilo/Makefile.am @@ -4,7 +4,6 @@ dist_guilemodule_DATA = biblio.scm color.scm config.scm \ lib.scm module.scm output.scm prog.scm \ reader.scm resolve.scm runtime.scm \ source.scm parameters.scm verify.scm \ - writer.scm ast.scm location.scm \ - compat.scm + writer.scm ast.scm location.scm SUBDIRS = utils reader engine package skribe coloring diff --git a/src/guile/skribilo/coloring/lisp.scm b/src/guile/skribilo/coloring/lisp.scm index ad02431..55fb7d6 100644 --- a/src/guile/skribilo/coloring/lisp.scm +++ b/src/guile/skribilo/coloring/lisp.scm @@ -26,6 +26,7 @@ ;;;; (define-module (skribilo coloring lisp) + :use-module (skribilo utils syntax) :use-module (skribilo source) :use-module (skribilo lib) :use-module (skribilo runtime) diff --git a/src/guile/skribilo/compat.scm b/src/guile/skribilo/compat.scm deleted file mode 100644 index c90af1d..0000000 --- a/src/guile/skribilo/compat.scm +++ /dev/null @@ -1,155 +0,0 @@ -;;; compat.scm -- Skribe compatibility module. -;;; -;;; Copyright 2005 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 compat) - :use-module (skribilo parameters) - :use-module (srfi srfi-1)) - - -;;; -;;; Global variables that have been replaced by parameter objects -;;; in `(skribilo parameters)'. -;;; - -;;; Switches -(define-public *skribe-verbose* 0) -(define-public *skribe-warning* 5) -(define-public *load-rc* #t) - - -;;; Path variables -(define-public *skribe-path* #f) -(define-public *skribe-bib-path* '(".")) -(define-public *skribe-source-path* '(".")) -(define-public *skribe-image-path* '(".")) - - -(define-public *skribe-rc-directory* - (string-append (getenv "HOME") "/" ".skribilo")) - - -;;; In and out ports -(define-public *skribe-src* '()) -(define-public *skribe-dest* #f) - -;;; Engine -(define-public *skribe-engine* 'html) ;; Use HTML by default - -;;; Misc -(define-public *skribe-chapter-split* '()) -(define-public *skribe-ref-base* #f) -(define-public *skribe-convert-image* #f) ;; i.e. use the Skribe standard converter -(define-public *skribe-variants* '()) - - - -;;; -;;; Accessors mapped to parameter objects. -;;; - -(define-public skribe-path *document-path*) -(define-public skribe-image-path *image-path*) -(define-public skribe-source-path *source-path*) -(define-public skribe-bib-path *bib-path*) - - -;;; -;;; Compatibility with Bigloo. -;;; - -(define-public (substring=? s1 s2 len) - (let ((l1 (string-length s1)) - (l2 (string-length s2))) - (let Loop ((i 0)) - (cond - ((= i len) #t) - ((= i l1) #f) - ((= i l2) #f) - ((char=? (string-ref s1 i) (string-ref s2 i)) (Loop (+ i 1))) - (else #f))))) - -(define-public (directory->list str) - (map basename (glob (string-append str "/*") (string-append "/.*")))) - -(define-macro (printf . args) `(format #t ,@args)) -(export-syntax printf) -(define-public fprintf format) - -(define-public (fprint port . args) - (if port - (with-output-to-port port - (lambda () - (for-each display args) - (display "\n"))))) - -(define-public (file-prefix fn) - (if fn - (let ((match (regexp-match "(.*)\\.([^/]*$)" fn))) - (if match - (cadr match) - fn)) - "./SKRIBILO-OUTPUT")) - -(define-public (file-suffix s) - ;; Not completely correct, but sufficient here - (let* ((basename (regexp-replace "^(.*)/(.*)$" s "\\2")) - (split (string-split basename "."))) - (if (> (length split) 1) - (car (reverse! split)) - ""))) - -(define-public prefix file-prefix) -(define-public suffix file-suffix) -(define-public system->string system) ;; FIXME -(define-public any? any) -(define-public every? every) -(define-public find-file/path (lambda (. args) - (format #t "find-file/path: ~a~%" args) - #f)) -(define-public process-input-port #f) ;process-input) -(define-public process-output-port #f) ;process-output) -(define-public process-error-port #f) ;process-error) - -;;; hash tables -(define-public make-hashtable make-hash-table) -(define-public hashtable? hash-table?) -(define-public hashtable-get (lambda (h k) (hash-ref h k #f))) -(define-public hashtable-put! hash-set!) -(define-public hashtable-update! hash-set!) -(define-public hashtable->list (lambda (h) - (map cdr (hash-map->list cons h)))) - -(define-public find-runtime-type (lambda (obj) obj)) - - - -;;; -;;; Miscellaneous. -;;; - -(use-modules ((srfi srfi-19) #:renamer (symbol-prefix-proc 's19:))) - -(define (date) - (s19:date->string (s19:current-date) "~c")) - - - -;;; compat.scm ends here diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm index b88c3b7..c9b7034 100644 --- a/src/guile/skribilo/module.scm +++ b/src/guile/skribilo/module.scm @@ -47,8 +47,8 @@ (ice-9 optargs) ;; `define*' (skribilo utils syntax) ;; `unless', `when', etc. + (skribilo utils compat) ;; `skribe-load-path', etc. (skribilo module) - (skribilo compat) ;; `skribe-load-path', etc. (skribilo ast) ;; `', `document?', etc. (skribilo config) (skribilo runtime) ;; `the-options', `the-body', `make-string-replace' @@ -68,7 +68,9 @@ ;; FIXME: The following should eventually be ;; removed from here. lout-structure-number-string)) - ((skribilo source) . (source-read-lines source-fontify)) + ((skribilo source) . (source-read-lines source-fontify + language? language-extractor + language-fontifier source-fontify)) ((skribilo coloring lisp) . (skribe scheme lisp)) ((skribilo coloring xml) . (xml)) ((skribilo color) . diff --git a/src/guile/skribilo/skribe/api.scm b/src/guile/skribilo/skribe/api.scm index 9a6369d..bf99868 100644 --- a/src/guile/skribilo/skribe/api.scm +++ b/src/guile/skribilo/skribe/api.scm @@ -19,8 +19,7 @@ ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;; USA. -(define-skribe-module (skribilo skribe api) - :replace (gensym)) +(define-skribe-module (skribilo skribe api)) ;;; Author: Manuel Serrano ;;; Commentary: @@ -33,16 +32,6 @@ ;;; The contents of the file below are unchanged compared to Skribe 1.2d's ;;; `api.scm' file found in the `common' directory. -(define %gensym-orig (module-ref the-root-module 'gensym)) - -(define gensym - ;; In Skribe, `gensym' accepts a symbol. Guile's `gensym' accepts only - ;; strings (or no argument). - (lambda obj - (apply %gensym-orig - (cond ((null? obj) '()) - ((symbol? (car obj)) (list (symbol->string (car obj)))) - (else (skribe-error 'gensym "invalid argument" obj)))))) ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm index e4f9973..75e886e 100644 --- a/src/guile/skribilo/source.scm +++ b/src/guile/skribilo/source.scm @@ -53,11 +53,11 @@ ;* source-read-lines ... */ ;*---------------------------------------------------------------------*/ (define (source-read-lines file start stop tab) - (let ((p (search-path (skribe-source-path) file))) + (let ((p (search-path (*source-path*) file))) (if (or (not (string? p)) (not (file-exists? p))) (skribe-error 'source (format "Can't find `~a' source file in path" file) - (skribe-source-path)) + (*source-path*)) (with-input-from-file p (lambda () (if (> (*verbose*) 0) @@ -130,7 +130,7 @@ ;* source-read-definition ... */ ;*---------------------------------------------------------------------*/ (define (source-read-definition file definition tab lang) - (let ((p (search-path (skribe-source-path) file))) + (let ((p (search-path (*source-path*) file))) (cond ((not (language-extractor lang)) (skribe-error 'source @@ -139,7 +139,7 @@ ((or (not p) (not (file-exists? p))) (skribe-error 'source (format "Can't find `~a' program file in path" file) - (skribe-source-path))) + (*source-path*))) (else (let ((ip (open-input-file p))) (if (> (*verbose*) 0) diff --git a/src/guile/skribilo/utils/Makefile.am b/src/guile/skribilo/utils/Makefile.am index 810ee48..6a82ac7 100644 --- a/src/guile/skribilo/utils/Makefile.am +++ b/src/guile/skribilo/utils/Makefile.am @@ -1,4 +1,4 @@ guilemoduledir = $(GUILE_SITE)/skribilo/utils -dist_guilemodule_DATA = syntax.scm +dist_guilemodule_DATA = syntax.scm compat.scm ## arch-tag: 3a18b64b-1da2-417b-8338-2c534bca277f diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm new file mode 100644 index 0000000..d9a63d6 --- /dev/null +++ b/src/guile/skribilo/utils/compat.scm @@ -0,0 +1,173 @@ +;;; compat.scm -- Skribe compatibility module. +;;; +;;; 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 compat) + :use-module (skribilo parameters) + :use-module (srfi srfi-1) + :replace (gensym)) + + +;;; +;;; gensym +;;; + +(define %gensym-orig (module-ref the-root-module 'gensym)) + +(define gensym + ;; In Skribe, `gensym' accepts a symbol. Guile's `gensym' accepts only + ;; strings (or no argument). + (lambda obj + (apply %gensym-orig + (cond ((null? obj) '()) + ((symbol? (car obj)) (list (symbol->string (car obj)))) + ((string? (car obj)) (list (car obj))) + (else (skribe-error 'gensym "invalid argument" obj)))))) + + +;;; +;;; Global variables that have been replaced by parameter objects +;;; in `(skribilo parameters)'. +;;; + +;;; Switches +(define-public *skribe-verbose* 0) +(define-public *skribe-warning* 5) +(define-public *load-rc* #t) + + +;;; Path variables +(define-public *skribe-path* #f) +(define-public *skribe-bib-path* '(".")) +(define-public *skribe-source-path* '(".")) +(define-public *skribe-image-path* '(".")) + + +(define-public *skribe-rc-directory* + (string-append (getenv "HOME") "/" ".skribilo")) + + +;;; In and out ports +(define-public *skribe-src* '()) +(define-public *skribe-dest* #f) + +;;; Engine +(define-public *skribe-engine* 'html) ;; Use HTML by default + +;;; Misc +(define-public *skribe-chapter-split* '()) +(define-public *skribe-ref-base* #f) +(define-public *skribe-convert-image* #f) ;; i.e. use the Skribe standard converter +(define-public *skribe-variants* '()) + + + +;;; +;;; Accessors mapped to parameter objects. +;;; + +(define-public skribe-path *document-path*) +(define-public skribe-image-path *image-path*) +(define-public skribe-source-path *source-path*) +(define-public skribe-bib-path *bib-path*) + + +;;; +;;; Compatibility with Bigloo. +;;; + +(define-public (substring=? s1 s2 len) + (let ((l1 (string-length s1)) + (l2 (string-length s2))) + (let Loop ((i 0)) + (cond + ((= i len) #t) + ((= i l1) #f) + ((= i l2) #f) + ((char=? (string-ref s1 i) (string-ref s2 i)) (Loop (+ i 1))) + (else #f))))) + +(define-public (directory->list str) + (map basename (glob (string-append str "/*") (string-append "/.*")))) + +(define-macro (printf . args) `(format #t ,@args)) +(export-syntax printf) +(define-public fprintf format) + +(define-public (fprint port . args) + (if port + (with-output-to-port port + (lambda () + (for-each display args) + (display "\n"))))) + +(define-public (file-prefix fn) + (if fn + (let ((match (regexp-match "(.*)\\.([^/]*$)" fn))) + (if match + (cadr match) + fn)) + "./SKRIBILO-OUTPUT")) + +(define-public (file-suffix s) + ;; Not completely correct, but sufficient here + (let* ((basename (regexp-replace "^(.*)/(.*)$" s "\\2")) + (split (string-split basename "."))) + (if (> (length split) 1) + (car (reverse! split)) + ""))) + +(define-public prefix file-prefix) +(define-public suffix file-suffix) +(define-public system->string system) ;; FIXME +(define-public any? any) +(define-public every? every) +(define-public find-file/path (lambda (. args) + (format #t "find-file/path: ~a~%" args) + #f)) +(define-public process-input-port #f) ;process-input) +(define-public process-output-port #f) ;process-output) +(define-public process-error-port #f) ;process-error) + +;;; hash tables +(define-public make-hashtable make-hash-table) +(define-public hashtable? hash-table?) +(define-public hashtable-get (lambda (h k) (hash-ref h k #f))) +(define-public hashtable-put! hash-set!) +(define-public hashtable-update! hash-set!) +(define-public hashtable->list (lambda (h) + (map cdr (hash-map->list cons h)))) + +(define-public find-runtime-type (lambda (obj) obj)) + + + +;;; +;;; Miscellaneous. +;;; + +(use-modules ((srfi srfi-19) #:renamer (symbol-prefix-proc 's19:))) + +(define (date) + (s19:date->string (s19:current-date) "~c")) + + + +;;; compat.scm ends here diff --git a/src/skribilo.in b/src/skribilo.in old mode 100644 new mode 100755 index 5508e10..4b77c5e --- a/src/skribilo.in +++ b/src/skribilo.in @@ -3,5 +3,5 @@ main='(module-ref (resolve-module '\''(skribilo)) '\'main')' exec ${GUILE-@GUILE@} --debug \ - -c "(apply $main (cdr (command-line)))" "$@" + -c "(catch #t (lambda () (apply $main (cdr (command-line)))) (lambda (key . args) (format (current-error-port) \"exception \`~a' raised~%\" key) (exit 1)))" "$@" -- cgit v1.2.3