aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo/engine/base.scm44
-rw-r--r--src/guile/skribilo/evaluator.scm93
-rw-r--r--src/guile/skribilo/package/slide.scm26
-rw-r--r--src/guile/skribilo/utils/compat.scm7
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)))))