diff options
Diffstat (limited to 'src/guile')
| -rw-r--r-- | src/guile/skribilo/engine/base.scm | 44 | ||||
| -rw-r--r-- | src/guile/skribilo/evaluator.scm | 93 | ||||
| -rw-r--r-- | src/guile/skribilo/package/slide.scm | 26 | ||||
| -rw-r--r-- | src/guile/skribilo/utils/compat.scm | 7 |
4 files changed, 102 insertions, 68 deletions
diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm index 711c179..f339a40 100644 --- a/src/guile/skribilo/engine/base.scm +++ b/src/guile/skribilo/engine/base.scm @@ -19,11 +19,23 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo engine base) - :autoload (skribilo biblio template) (make-bib-entry-template/default - output-bib-entry-template) - :use-module (srfi srfi-13)) +(define-module (skribilo engine base) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo writer) + :autoload (skribilo output) (output) + :use-module (skribilo evaluator) + :autoload (skribilo package base) (color) + :autoload (skribilo utils keywords) (list-split) + :autoload (skribilo biblio template) (make-bib-entry-template/default + output-bib-entry-template) + ;; syntactic sugar + :use-module (skribilo reader) + :use-module (skribilo utils syntax)) +(fluid-set! current-reader (make-reader 'skribe)) + + ;*---------------------------------------------------------------------*/ ;* base-engine ... */ ;*---------------------------------------------------------------------*/ @@ -170,7 +182,7 @@ (format #f "?~a " k)))) (msg (list f (markup-body n))) (n (list "[" (color :fg "red" (bold msg)) "]"))) - (skribe-eval n e)))) + (evaluate-document n e)))) ;*---------------------------------------------------------------------*/ ;* &the-bibliography ... */ @@ -234,7 +246,7 @@ (markup-writer '&bib-entry-url :action (lambda (n e) (let ((url (markup-body n))) - (skribe-eval + (evaluate-document (ref :text (it url) :url url) e)))) ;*---------------------------------------------------------------------*/ @@ -258,7 +270,7 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-title :action (lambda (n e) - (skribe-eval (markup-body n)) e)) + (evaluate-document (markup-body n) e))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-booktitle ... */ @@ -266,21 +278,21 @@ (markup-writer '&bib-entry-booktitle :action (lambda (n e) (let ((title (markup-body n))) - (skribe-eval (it title) e)))) + (evaluate-document (it title) e)))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-journal ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-journal :action (lambda (n e) - (skribe-eval (it (markup-body n)) e))) + (evaluate-document (it (markup-body n)) e))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-publisher ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-publisher :action (lambda (n e) - (skribe-eval (markup-body n) e))) + (evaluate-document (markup-body n) e))) ;*---------------------------------------------------------------------*/ ;* &the-index ... @label the-index@ */ @@ -400,7 +412,7 @@ ;;:&skribe-eval-location loc :class "index-table" (make-sub-tables ie nc pref)))))) - (output (skribe-eval t e) e)))) + (output (evaluate-document t e) e)))) ;*---------------------------------------------------------------------*/ ;* &the-index-header ... */ @@ -418,7 +430,7 @@ :before (lambda (n e) (let ((num (markup-option n :number))) (if (number? num) - (skribe-eval + (evaluate-document (it (string-append (string-pad (number->string num) 3) ": ")) e)))) @@ -432,11 +444,5 @@ :action (lambda (n e) (let ((o (markup-option n :offset)) (n (markup-ident (handle-body (markup-body n))))) - (skribe-eval (it (if (integer? o) (+ o n) n)) e)))) - - + (evaluate-document (it (if (integer? o) (+ o n) n)) e)))) -;;;; A VIRER (mais handle-body n'est pas défini) -(markup-writer 'line-ref - :options '(:offset) - :action #f) diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm index 8502d51..5067b59 100644 --- a/src/guile/skribilo/evaluator.scm +++ b/src/guile/skribilo/evaluator.scm @@ -57,19 +57,18 @@ ;;; ;;; %EVALUATE ;;; -(define (%evaluate expr) - ;; Evaluate EXPR, an arbitrary S-expression that may contain calls to the - ;; markup functions defined in a markup package such as - ;; `(skribilo package base)', e.g., `(bold "hello")'. - (let ((result (eval expr (*skribilo-user-module*)))) - +(define (%evaluate expr module) + ;; Evaluate EXPR in the current module. EXPR is an arbitrary S-expression + ;; that may contain calls to the markup functions defined in a markup + ;; package such as `(skribilo package base)', e.g., `(bold "hello")'. + (let ((result (eval expr module))) (if (ast? result) - (let ((file (source-property expr 'filename)) - (line (source-property expr 'line)) - (column (source-property expr 'column))) - (slot-set! result 'loc - (make <location> - :file file :line line :pos column)))) + (let ((file (source-property expr 'filename)) + (line (source-property expr 'line)) + (column (source-property expr 'column))) + (slot-set! result 'loc + (make <location> + :file file :line line :pos column)))) result)) @@ -94,7 +93,8 @@ ;;; (define* (evaluate-document-from-port port engine :key (env '()) - (reader (*document-reader*))) + (reader (*document-reader*)) + (module (*skribilo-user-module*))) (with-debug 2 'evaluate-document-from-port (debug-item "engine=" engine) (debug-item "reader=" reader) @@ -103,12 +103,21 @@ (debug-item "e=" e) (if (not (engine? e)) (skribe-error 'evaluate-document-from-port "cannot find engine" engine) - (let loop ((exp (reader port))) - (with-debug 10 'evaluate-document-from-port - (debug-item "exp=" exp)) - (unless (eof-object? exp) - (evaluate-document (%evaluate exp) e :env env) - (loop (reader port)))))))) + (save-module-excursion + (lambda () + (with-debug 10 'evaluate-document-from-port + (debug-item "exp=" exp)) + (set-current-module (*skribilo-user-module*)) + + (let loop ((exp (reader port))) + (if (eof-object? exp) + (evaluate-document (%evaluate exp module) + e :env env) + (begin + (evaluate-document (%evaluate exp module) + e :env env) + (loop (reader port))))))))))) + ;;; @@ -121,9 +130,14 @@ ;; List of the names of files already loaded. (define *loaded-files* (make-parameter '())) -(define* (load-document file :key (engine #f) (path #f) :allow-other-keys + +(define* (load-document file + :key engine path + (module (*skribilo-user-module*)) + (reader (*document-reader*)) + :allow-other-keys :rest opt) - (with-debug 4 'skribe-load + (with-debug 4 'load-document (debug-item " engine=" engine) (debug-item " path=" path) (debug-item " opt=" opt) @@ -138,15 +152,7 @@ (argument path))))) (else path)) %load-path)) - (filep (or (search-path path file) - (search-path (append path %load-path) file) - (search-path (append path %load-path) - (let ((dot (string-rindex file #\.))) - (if dot - (string-append - (string-take file dot) - ".scm") - file)))))) + (filep (search-path path file))) (unless (and (string? filep) (file-exists? filep)) (raise (condition (&file-search-error @@ -169,7 +175,9 @@ ;; Load it (with-input-from-file filep (lambda () - (evaluate-document-from-port (current-input-port) ei))) + (evaluate-document-from-port (current-input-port) ei + :module module + :reader reader))) (*loaded-files* (cons filep (*loaded-files*)))))))) @@ -177,7 +185,8 @@ ;;; INCLUDE-DOCUMENT ;;; (define* (include-document file :key (path (*document-path*)) - (reader (*document-reader*))) + (reader (*document-reader*)) + (module (*skribilo-user-module*))) (unless (every string? path) (raise (condition (&invalid-argument-error (proc-name 'include-document) (argument path))))) @@ -193,11 +202,15 @@ (with-input-from-file full-path (lambda () - (let Loop ((exp (reader (current-input-port))) - (res '())) - (if (eof-object? exp) - (if (and (pair? res) (null? (cdr res))) - (car res) - (reverse! res)) - (Loop (reader (current-input-port)) - (cons (%evaluate exp) res)))))))) + (save-module-excursion + (lambda () + (set-current-module module) + + (let Loop ((exp (reader (current-input-port))) + (res '())) + (if (eof-object? exp) + (if (and (pair? res) (null? (cdr res))) + (car res) + (reverse! res)) + (Loop (reader (current-input-port)) + (cons (%evaluate exp module) res)))))))))) diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm index 898f105..cbcae0b 100644 --- a/src/guile/skribilo/package/slide.scm +++ b/src/guile/skribilo/package/slide.scm @@ -20,13 +20,29 @@ ;;; USA. -(define-skribe-module (skribilo package slide)) +(define-module (skribilo package slide) + :use-module (skribilo reader) + :use-module (skribilo utils syntax) + :use-module (skribilo lib) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo evaluator) ;; `*load-options*' + :use-module (skribilo package base) + :autoload (skribilo utils keywords) (the-options the-body) + + :use-module (srfi srfi-1) + :use-module (ice-9 optargs)) + +(fluid-set! current-reader (make-reader 'skribe)) + + + ;*---------------------------------------------------------------------*/ ;* slide-options */ ;*---------------------------------------------------------------------*/ -(define-public &slide-load-options (skribe-load-options)) +(define-public &slide-load-options (*load-options*)) ;*---------------------------------------------------------------------*/ @@ -49,7 +65,7 @@ (let ((s (new container (markup 'slide) (ident (if (not ident) - (symbol->string (gensym 'slide)) + (symbol->string (gensym "slide")) ident)) (class class) (required-options '(:title :number :toc)) @@ -232,7 +248,7 @@ (new container (markup 'slide-topic) (required-options '(:title :outline?)) - (ident (or ident (symbol->string (gensym 'slide-topic)))) + (ident (or ident (symbol->string (gensym "slide-topic")))) (class class) (options `((:outline? ,outline?) ,@(the-options opt :outline? :class))) @@ -247,7 +263,7 @@ (new container (markup 'slide-subtopic) (required-options '(:title :outline?)) - (ident (or ident (symbol->string (gensym 'slide-subtopic)))) + (ident (or ident (symbol->string (gensym "slide-subtopic")))) (class class) (options `((:outline? ,outline?) ,@(the-options opt :outline? :class))) diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index 4905cef..9f85658 100644 --- a/src/guile/skribilo/utils/compat.scm +++ b/src/guile/skribilo/utils/compat.scm @@ -153,13 +153,12 @@ " skribe-load: `~a' -> `~a'~%" file mod-name)) (let ((mod (false-if-exception - (resolve-module mod-name)))) + (resolve-interface mod-name)))) (if (not mod) (raise c) (begin - (set-module-uses! - (current-module) - (cons mod (module-uses (current-module)))) + (module-use-interfaces! (current-module) + (list mod)) #t)))) (raise c))))) |