diff options
Diffstat (limited to 'src/guile')
| -rw-r--r-- | src/guile/skribilo/biblio.scm | 12 | ||||
| -rw-r--r-- | src/guile/skribilo/runtime.scm | 10 | ||||
| -rw-r--r-- | src/guile/skribilo/source.scm | 81 | ||||
| -rw-r--r-- | src/guile/skribilo/utils/compat.scm | 46 |
4 files changed, 93 insertions, 56 deletions
diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm index 2ea35bc..082fb99 100644 --- a/src/guile/skribilo/biblio.scm +++ b/src/guile/skribilo/biblio.scm @@ -25,6 +25,11 @@ :use-module (skribilo utils syntax) ;; `when', `unless' :use-module (skribilo module) :use-module (skribilo skribe bib) ;; `make-bib-entry' + + :autoload (srfi srfi-34) (raise) + :use-module (srfi srfi-35) + :autoload (skribilo condition) (&file-search-error) + :autoload (skribilo reader) (%default-reader) :autoload (skribilo parameters) (*bib-path*) :autoload (ice-9 format) (format) @@ -155,8 +160,5 @@ (string-append "| " (format #f command path)) path))) - (begin - (skribe-warning 1 - 'bibliography - "Can't find bibliography -- " file) - #f)))) + (raise (condition (&file-search-error (file-name file) + (path (*bib-path*)))))))) diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm index b129652..e302ee9 100644 --- a/src/guile/skribilo/runtime.scm +++ b/src/guile/skribilo/runtime.scm @@ -33,7 +33,10 @@ make-string-replace) :use-module (skribilo parameters) :use-module (skribilo lib) - :use-module (srfi srfi-13)) + :use-module (srfi srfi-13) + :use-module (srfi srfi-35) + :autoload (skribilo condition) (&file-search-error) + :autoload (srfi srfi-34) (raise)) (define (suffix path) @@ -128,9 +131,8 @@ (define (convert-image file formats) (let ((path (search-path (*image-path*) file))) (if (not path) - (skribe-error 'convert-image - (format #f "can't find `~a' image file in path: " file) - (*image-path*)) + (raise (condition (&file-search-error (file-name file) + (path (*image-path*))))) (let ((suf (suffix file))) (if (member suf formats) (let* ((dir (if (string? (*destination-file*)) diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm index 3eb7d65..a632f18 100644 --- a/src/guile/skribilo/source.scm +++ b/src/guile/skribilo/source.scm @@ -23,6 +23,11 @@ (define-module (skribilo source) :export (<language> language? language-extractor language-fontifier source-read-lines source-read-definition source-fontify) + + :use-module (srfi srfi-35) + :autoload (srfi srfi-34) (raise) + :autoload (skribilo condition) (&file-search-error &file-open-error) + :use-module (skribilo utils syntax) :use-module (skribilo parameters) :use-module (skribilo lib) @@ -53,40 +58,39 @@ ;* source-read-lines ... */ ;*---------------------------------------------------------------------*/ (define (source-read-lines file start stop tab) - (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) - (*source-path*)) - (with-input-from-file p - (lambda () - (if (> (*verbose*) 0) - (format (current-error-port) " [source file: ~S]\n" p)) - (let ((startl (if (string? start) (string-length start) -1)) - (stopl (if (string? stop) (string-length stop) -1))) - (let loop ((l 1) - (armedp (not (or (integer? start) (string? start)))) - (s (read-line)) - (r '())) - (cond - ((or (eof-object? s) - (and (integer? stop) (> l stop)) - (and (string? stop) (substring=? stop s stopl))) - (apply string-append (reverse! r))) - (armedp - (loop (+ l 1) - #t - (read-line) - (cons* "\n" (untabify s tab) r))) - ((and (integer? start) (>= l start)) - (loop (+ l 1) - #t - (read-line) - (cons* "\n" (untabify s tab) r))) - ((and (string? start) (substring=? start s startl)) - (loop (+ l 1) #t (read-line) r)) - (else - (loop (+ l 1) #f (read-line) r)))))))))) + (let ((p (search-path (*source-path*) file))) + (if (or (not (string? p)) (not (file-exists? p))) + (raise (condition (&file-search-error (file-name file) + (path (*source-path*))))) + (with-input-from-file p + (lambda () + (if (> (*verbose*) 0) + (format (current-error-port) " [source file: ~S]\n" p)) + (let ((startl (if (string? start) (string-length start) -1)) + (stopl (if (string? stop) (string-length stop) -1))) + (let loop ((l 1) + (armedp (not (or (integer? start) (string? start)))) + (s (read-line)) + (r '())) + (cond + ((or (eof-object? s) + (and (integer? stop) (> l stop)) + (and (string? stop) (substring=? stop s stopl))) + (apply string-append (reverse! r))) + (armedp + (loop (+ l 1) + #t + (read-line) + (cons* "\n" (untabify s tab) r))) + ((and (integer? start) (>= l start)) + (loop (+ l 1) + #t + (read-line) + (cons* "\n" (untabify s tab) r))) + ((and (string? start) (substring=? start s startl)) + (loop (+ l 1) #t (read-line) r)) + (else + (loop (+ l 1) #f (read-line) r)))))))))) ;*---------------------------------------------------------------------*/ ;* untabify ... */ @@ -136,16 +140,17 @@ (skribe-error 'source "The specified language has not defined extractor" (slot-ref lang 'name))) + ((or (not p) (not (file-exists? p))) - (skribe-error 'source - (format "Can't find `~a' program file in path" file) - (*source-path*))) + (raise (condition (&file-search-error (file-name file) + (path (*source-path*)))))) + (else (let ((ip (open-input-file p))) (if (> (*verbose*) 0) (format (current-error-port) " [source file: ~S]\n" p)) (if (not (input-port? ip)) - (skribe-error 'source "Can't open file for input" p) + (raise (condition (&file-open-error (file-name p)))) (unwind-protect (let ((s ((language-extractor lang) ip definition tab))) (if (not (string? s)) diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index b6e6420..45abd10 100644 --- a/src/guile/skribilo/utils/compat.scm +++ b/src/guile/skribilo/utils/compat.scm @@ -24,7 +24,11 @@ :use-module (skribilo parameters) :use-module (skribilo evaluator) :use-module (srfi srfi-1) + :use-module (srfi srfi-34) + :use-module (srfi srfi-35) :use-module (ice-9 optargs) + :autoload (skribilo ast) (ast?) + :autoload (skribilo condition) (file-search-error? &file-search-error) :replace (gensym)) ;;; Author: Ludovic Courtès @@ -111,11 +115,26 @@ '(("web-book.skr" . (skribilo packages web-book)))) (define*-public (skribe-load file :rest args) - (let ((mod (assoc-ref %skribe-known-files file))) - (if mod - (set-module-uses! (current-module) - (cons mod (module-uses (current-module)))) - (apply load-document file args)))) + (call/cc + (lambda (return) + (guard (c ((file-search-error? c) + ;; Regular file loading failed. Try built-ins. + (let ((mod-name (assoc-ref %skribe-known-files file))) + (if mod-name + (let ((mod (false-if-exception + (resolve-module mod-name)))) + (if (not mod) + (raise c) + (begin + (set-module-uses! + (current-module) + (cons mod (module-uses (current-module)))) + (return #t)))) + (raise c))))) + + ;; Try a regular `load-document'. + (apply load-document file args))))) + (define-public skribe-include include-document) (define-public skribe-load-options *load-options*) @@ -175,9 +194,9 @@ (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 (find-file/path file path) + (search-path path file)) + (define-public process-input-port #f) ;process-input) (define-public process-output-port #f) ;process-output) (define-public process-error-port #f) ;process-error) @@ -191,7 +210,16 @@ (define-public hashtable->list (lambda (h) (map cdr (hash-map->list cons h)))) -(define-public find-runtime-type (lambda (obj) obj)) +(define-public (find-runtime-type obj) + (cond ((string? obj) "string") + ((ast? obj) "ast") + ((list? obj) "list") + ((pair? obj) "pair") + ((number? obj) "number") + ((char? obj) "character") + ((keyword? obj) "keyword") + (else (with-output-to-string + (lambda () (write obj)))))) |