From e6bda4dce5fa0fdc935484e2a2540953f43b5a2d Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Wed, 6 Jun 2007 13:06:45 +0000 Subject: Cleaned up the core modules. git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-65 --- src/guile/skribilo/ast.scm | 12 ++++++------ src/guile/skribilo/biblio.scm | 24 ++++++++++++++++-------- src/guile/skribilo/debug.scm | 3 +-- src/guile/skribilo/evaluator.scm | 5 +---- src/guile/skribilo/index.scm | 1 - src/guile/skribilo/lib.scm | 15 ++++++--------- src/guile/skribilo/location.scm | 3 ++- src/guile/skribilo/module.scm | 5 +---- src/guile/skribilo/prog.scm | 16 ++++------------ src/guile/skribilo/reader.scm | 2 +- src/guile/skribilo/resolve.scm | 11 ++++------- src/guile/skribilo/source.scm | 7 ++++--- src/guile/skribilo/utils/compat.scm | 3 +-- src/guile/skribilo/verify.scm | 6 ++---- src/guile/skribilo/writer.scm | 7 ++----- 15 files changed, 51 insertions(+), 69 deletions(-) diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm index e60957c..5484815 100644 --- a/src/guile/skribilo/ast.scm +++ b/src/guile/skribilo/ast.scm @@ -29,7 +29,7 @@ :use-module (skribilo utils syntax) :autoload (skribilo location) (location?) - :autoload (srfi srfi-1) (fold) + :autoload (srfi srfi-1) (fold concatenate) :use-module (ice-9 optargs) @@ -47,7 +47,7 @@ markup-markup markup-body markup-body-set! markup-ident markup-class markup-option markup-option-set! - markup-option-add! markup-output + markup-option-add! markup-parent markup-document markup-chapter container? container-options @@ -55,7 +55,7 @@ container-env-get document? document-ident document-body - document-options document-end + document-options document-env document-lookup-node document-bind-node! document-bind-nodes! @@ -510,7 +510,7 @@ (let loop ((obj (markup-body obj))) (cond ((pair? obj) - (apply append (map (lambda (o) (loop o)) obj))) + (concatenate (map (lambda (o) (loop o)) obj))) ((container? obj) (let ((rest (loop (markup-body obj)))) (if (pred obj) @@ -525,7 +525,7 @@ (let loop ((obj (markup-body obj))) (cond ((pair? obj) - (apply append (map (lambda (o) (loop o)) obj))) + (concatenate (map (lambda (o) (loop o)) obj))) ((markup? obj) (let ((rest (loop (markup-body obj)))) (if (pred obj) @@ -540,7 +540,7 @@ (let loop ((obj obj)) (cond ((pair? obj) - (apply append (map (lambda (o) (loop o)) obj))) + (concatenate (map (lambda (o) (loop o)) obj))) ((markup? obj) (if (pred obj) (list (cons obj (loop (markup-body obj)))) diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm index 0c2cfa7..64eaea4 100644 --- a/src/guile/skribilo/biblio.scm +++ b/src/guile/skribilo/biblio.scm @@ -22,7 +22,6 @@ (define-module (skribilo biblio) - :use-module (skribilo utils strings) :use-module (skribilo utils syntax) ;; `when', `unless' :use-module (srfi srfi-1) @@ -54,10 +53,13 @@ ;; error conditions &biblio-error &biblio-entry-error &biblio-template-error + &biblio-parse-error biblio-error? biblio-entry-error? biblio-template-error? + biblio-parse-error? biblio-entry-error:entry biblio-template-error:expression - biblio-template-error:template)) + biblio-template-error:template + biblio-parse-error:sexp)) ;;; Author: Erick Gallesio, Manuel Serrano, Ludovic Courtès ;;; @@ -88,6 +90,10 @@ (expression biblio-template-error:expression) (template biblio-template-error:template)) +(define-condition-type &biblio-parse-error &biblio-error + biblio-parse-error? + (sexp biblio-parse-error:sexp)) + (define (handle-biblio-error c) ;; Issue a user-friendly error message for error condition C. @@ -108,6 +114,10 @@ (_ "invalid bibliography entry template: `~a', in `~a'~%") (biblio-template-error:expression c) (biblio-template-error:template c))) + ((biblio-parse-error? c) + (format (current-error-port) + (_ "invalid bibliography entry s-exp: `~a'~%") + (biblio-parse-error:sexp c))) (else (format (current-error-port) (_ "undefined bibliography error: ~a~%") @@ -197,7 +207,7 @@ (fields (cddr entry)) (old (hash-ref table key))) (if old - (bib-duplicate ident from old) + (bib-duplicate key from old) (hash-set! table key (make-bib-entry kind key fields from))) (Loop (read port)))) @@ -290,7 +300,8 @@ (car f)) :parent h :body (cadr f))) - (bib-parse-error f))) + (raise (condition (&biblio-parse-error + (sexp f)))))) fields) m)) @@ -351,10 +362,7 @@ (let ((body (markup-body m))) (if (not (string? body)) 13 - (let* ((s (if (> (string-length body) 3) - (substring body 0 3) - body)) - (sy (string->symbol (string-downcase body))) + (let* ((sy (string->symbol (string-downcase body))) (c (assq sy '((jan . 1) (feb . 2) (mar . 3) diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm index f7709a0..3b62b6f 100644 --- a/src/guile/skribilo/debug.scm +++ b/src/guile/skribilo/debug.scm @@ -21,9 +21,8 @@ (define-module (skribilo debug) :use-module (skribilo utils syntax) - :use-module (srfi srfi-17) :use-module (srfi srfi-39) - :export-syntax (debug-item with-debug)) + :export-syntax (debug-item debug-bold with-debug)) (fluid-set! current-reader %skribilo-module-reader) diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm index 3e984fc..8b26a89 100644 --- a/src/guile/skribilo/evaluator.scm +++ b/src/guile/skribilo/evaluator.scm @@ -25,8 +25,6 @@ evaluate-document evaluate-document-from-port load-document include-document *load-options*) :autoload (skribilo parameters) (*verbose* *document-path*) - :autoload (skribilo location) () - :autoload (skribilo ast) (ast? markup?) :autoload (skribilo engine) (*current-engine* engine? find-engine engine-ident) :autoload (skribilo reader) (*document-reader*) @@ -44,7 +42,6 @@ (skribilo lib) (ice-9 optargs) - (oop goops) (srfi srfi-1) (srfi srfi-13) (srfi srfi-34) @@ -160,7 +157,7 @@ (path (append (cond ((not path) (*document-path*)) ((string? path) (list path)) - ((not (and (list? path) (every? string? path))) + ((not (and (list? path) (every string? path))) (raise (condition (&invalid-argument-error (proc-name 'load-document) (argument path))))) diff --git a/src/guile/skribilo/index.scm b/src/guile/skribilo/index.scm index 33f8d15..c6ee2d1 100644 --- a/src/guile/skribilo/index.scm +++ b/src/guile/skribilo/index.scm @@ -23,7 +23,6 @@ :use-syntax (skribilo utils syntax) :use-syntax (skribilo lib) - :use-module (skribilo lib) :use-module (skribilo ast) :use-module (srfi srfi-39) diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm index 18a60a3..3be013a 100644 --- a/src/guile/skribilo/lib.scm +++ b/src/guile/skribilo/lib.scm @@ -34,19 +34,16 @@ ;; Re-exported because used in `define-markup'. :re-export (invocation-location) - :use-module (skribilo config) :use-module (skribilo ast) ;; useful for `new' to work well with :autoload (skribilo source) () - :use-module (skribilo reader) :use-module (skribilo parameters) :use-module (skribilo location) :use-module (srfi srfi-1) - :use-module (oop goops) - :use-module (ice-9 optargs)) + :use-module (oop goops)) (fluid-set! current-reader %skribilo-module-reader) @@ -66,9 +63,9 @@ `(let ((make ,make) (,class-name ,actual-class)) (make ,class-name - ,@(apply append (map (lambda (x) - `(,(symbol->keyword (car x)) ,(cadr x))) - parameters)))))) + ,@(concatenate (map (lambda (x) + `(,(symbol->keyword (car x)) ,(cadr x))) + parameters)))))) ;;; ;;; DEFINE-MARKUP @@ -190,7 +187,7 @@ ;;; SKRIBE-TYPE-ERROR ;;; (define (skribe-type-error proc msg obj etype) - (skribe-error proc (format "~a ~s (~a expected)" msg obj etype) #f)) + (skribe-error proc (format #f "~a ~s (~a expected)" msg obj etype) #f)) ;;; @@ -200,7 +197,7 @@ (let ((port (current-error-port))) (when (and file line col) (format port "~a:~a:~a: " file line col)) - (format port "warning: ") + (display "warning: " port) (for-each (lambda (x) (format port "~a " x)) lst) (newline port))) diff --git a/src/guile/skribilo/location.scm b/src/guile/skribilo/location.scm index e6bf54f..47f72b7 100644 --- a/src/guile/skribilo/location.scm +++ b/src/guile/skribilo/location.scm @@ -22,6 +22,7 @@ (define-module (skribilo location) :use-module (oop goops) :use-module ((skribilo utils syntax) :select (%skribilo-module-reader)) + :autoload (srfi srfi-13) (string-prefix?) :export ( location? ast-location location-file location-line location-column invocation-location)) @@ -57,7 +58,7 @@ (pwd (getcwd)) (len (string-length pwd)) (lenf (string-length fname)) - (file (if (and (substring=? pwd fname len) + (file (if (and (string-prefix? pwd fname len) (> lenf len)) (substring fname len (+ 1 (string-length fname))) fname))) diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm index ac8eee0..ccded17 100644 --- a/src/guile/skribilo/module.scm +++ b/src/guile/skribilo/module.scm @@ -1,6 +1,6 @@ ;;; module.scm -- Integration of Skribe code as Guile modules. ;;; -;;; Copyright 2005, 2006 Ludovic Courtès +;;; Copyright 2005, 2006, 2007 Ludovic Courtès ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -19,10 +19,7 @@ ;;; USA. (define-module (skribilo module) - :autoload (skribilo reader) (make-reader) - :use-module (skribilo debug) :use-module (srfi srfi-1) - :use-module (ice-9 optargs) :use-module (srfi srfi-39) :use-module (skribilo utils syntax) :export (make-run-time-module *skribilo-user-module*)) diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm index 2f531cd..0113db6 100644 --- a/src/guile/skribilo/prog.scm +++ b/src/guile/skribilo/prog.scm @@ -23,8 +23,9 @@ :use-module (ice-9 regex) :autoload (ice-9 receive) (receive) :use-module (skribilo lib) ;; `new' - :autoload (skribilo ast) (node? node-body) + :use-module (skribilo ast) :use-module (skribilo utils syntax) + :autoload (skribilo package base) (mark) :export (make-prog-body resolve-line)) @@ -43,8 +44,7 @@ (define pregexp-quote regexp-quote) -(define (node-body-set! b v) - (slot-set! b 'body v)) +(define node-body-set! markup-body-set!) ;;; ;;; FIXME: Tout le module peut se factoriser @@ -186,13 +186,6 @@ ;* make-prog-body ... */ ;*---------------------------------------------------------------------*/ (define (make-prog-body src lnum-init ldigit mark) - (define (int->str i rl) - (let* ((s (number->string i)) - (l (string-length s))) - (if (= l rl) - s - (string-append (make-string (- rl l) #\space) s)))) - (let* ((regexp (and mark (format #f "~a[-a-zA-Z_][-0-9a-zA-Z_]+" (pregexp-quote mark)))) @@ -205,8 +198,7 @@ (s (number->string (+ (if (integer? ldigit) (max lnum (expt 10 (- ldigit 1))) lnum) - (length lines)))) - (cs (string-length s))) + (length lines))))) (let loop ((lines lines) (lnum lnum) (res '())) diff --git a/src/guile/skribilo/reader.scm b/src/guile/skribilo/reader.scm index 871d92c..d9abd1f 100644 --- a/src/guile/skribilo/reader.scm +++ b/src/guile/skribilo/reader.scm @@ -30,7 +30,7 @@ &reader-search-error reader-search-error? reader-search-error:reader) - :export-syntax (define-reader define-public-reader)) + :export-syntax (define-reader define-public-reader reader?)) ;;; Author: Ludovic Courtès ;;; diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm index 94ab360..4a83703 100644 --- a/src/guile/skribilo/resolve.scm +++ b/src/guile/skribilo/resolve.scm @@ -31,8 +31,8 @@ :use-module (srfi srfi-34) :use-module (srfi srfi-35) - :export (resolve! resolve-search-parent resolve-children resolve-children* - find1 resolve-counter resolve-parent resolve-ident + :export (resolve! resolve-search-parent + resolve-counter resolve-parent resolve-ident *document-being-resolved*)) (fluid-set! current-reader %skribilo-module-reader) @@ -239,7 +239,7 @@ (debug-item "searching=" pred) (let ((p (resolve-parent n e))) (debug-item "parent=" p " " - (if (is-a? p 'markup) (slot-ref p 'markup) "???")) + (if (is-a? p ) (slot-ref p 'markup) "???")) (cond ((pred p) p) ((is-a? p ) p) @@ -262,10 +262,7 @@ (list (list (symbol-append cnt '-counter) 0) (list (symbol-append cnt '-env) '()))) (resolve-counter n e cnt val))) - (let* ((num (cadr c)) - (nval (if (integer? val) - val - (+ 1 num)))) + (let* ((num (cadr c))) (let ((c2 (assq (symbol-append cnt '-env) e))) (set-car! (cdr c2) (cons (resolve-parent n e) (cadr c2)))) (cond diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm index a61de4f..3513e98 100644 --- a/src/guile/skribilo/source.scm +++ b/src/guile/skribilo/source.scm @@ -22,11 +22,12 @@ (define-module (skribilo source) :export ( language? language-extractor language-fontifier + language-name source-read-lines source-read-definition source-fontify) :use-module (srfi srfi-35) :autoload (srfi srfi-34) (raise) - :autoload (srfi srfi-13) (string-prefix-length) + :autoload (srfi srfi-13) (string-prefix-length string-concatenate) :autoload (skribilo condition) (&file-search-error &file-open-error) :use-module (skribilo utils syntax) @@ -44,7 +45,7 @@ ;;; (define-class () - (name :init-keyword :name :init-value #f :getter langage-name) + (name :init-keyword :name :init-value #f :getter language-name) (fontifier :init-keyword :fontifier :init-value #f :getter language-fontifier) (extractor :init-keyword :extractor :init-value #f @@ -78,7 +79,7 @@ (and (integer? stop) (> l stop)) (and (string? stop) (= (string-prefix-length stop s) stopl))) - (apply string-append (reverse! r))) + (string-concatenate (reverse! r))) (armedp (loop (+ l 1) #t diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index 3f13c42..6ba066b 100644 --- a/src/guile/skribilo/utils/compat.scm +++ b/src/guile/skribilo/utils/compat.scm @@ -24,7 +24,7 @@ :use-module (skribilo utils files) :use-module (skribilo parameters) :use-module (skribilo evaluator) - :use-module (skribilo location) + :use-module (skribilo lib) :use-module (srfi srfi-1) :autoload (srfi srfi-13) (string-rindex) :use-module (srfi srfi-34) @@ -32,7 +32,6 @@ :autoload (skribilo ast) (ast? document? document-lookup-node) :autoload (skribilo condition) (file-search-error? &file-search-error) :autoload (skribilo reader) (make-reader) - :autoload (skribilo lib) (type-name) :autoload (skribilo resolve) (*document-being-resolved*) :autoload (skribilo output) (*document-being-output*) :autoload (skribilo biblio) (*bib-table* open-bib-file) diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm index 052b5cc..3d37817 100644 --- a/src/guile/skribilo/verify.scm +++ b/src/guile/skribilo/verify.scm @@ -42,7 +42,6 @@ ;;; (define (check-required-options markup writer engine) (let ((required-options (slot-ref markup 'required-options)) - (ident (slot-ref writer 'ident)) (options (slot-ref writer 'options)) (verified? (slot-ref writer 'verified?))) (or verified? @@ -150,11 +149,10 @@ ;; verify the engine customs (for-each (lambda (c) - (let ((i (car c)) - (a (cadr c))) + (let ((a (cadr c))) (set-car! (cdr c) (verify a e)))) (slot-ref e 'customs)) node) -;;; verify.scm ends here \ No newline at end of file +;;; verify.scm ends here diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm index b16819d..9c00f82 100644 --- a/src/guile/skribilo/writer.scm +++ b/src/guile/skribilo/writer.scm @@ -20,7 +20,7 @@ ;;; USA. (define-module (skribilo writer) - :export ( writer? write-object writer-options writer-ident + :export ( writer? writer-options writer-ident writer-before writer-action writer-after writer-class invoke markup-writer markup-writer-get markup-writer-get* @@ -89,11 +89,9 @@ (define (make-writer-predicate markup predicate class) - (define (%always-true n e) #t) - (let* ((t2 (if class (lambda (n e) - (and (equal? (markup-class n) class))) + (equal? (markup-class n) class)) #f))) (if predicate (cond @@ -230,7 +228,6 @@ (skribe-error 'markup-writer "illegal engine" e)) (else (let* ((writers (slot-ref e 'writers)) - (markup-writers (hashq-ref writers markup '())) (delegate (slot-ref e 'delegate))) (append (matching-writers writers) -- cgit v1.2.3