summaryrefslogtreecommitdiff
path: root/src/guile/skribilo/runtime.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile/skribilo/runtime.scm')
-rw-r--r--src/guile/skribilo/runtime.scm234
1 files changed, 16 insertions, 218 deletions
diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm
index 03e515c..d4be2e9 100644
--- a/src/guile/skribilo/runtime.scm
+++ b/src/guile/skribilo/runtime.scm
@@ -1,8 +1,8 @@
;;;
-;;; runtime.stk -- Skribe runtime system
+;;; runtime.scm -- Skribilo runtime system
;;;
;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;;
+;;; Copyright © 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;; 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
@@ -18,46 +18,22 @@
;;; 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: 13-Aug-2003 18:47 (eg)
-;;; Last file update: 15-Nov-2004 14:03 (eg)
-;;;
(define-module (skribilo runtime)
;; FIXME: Useful procedures are scattered between here and
;; `(skribilo skribe utils)'.
:export (;; Utilities
- strip-ref-base ast->file-location string-canonicalize
-
- ;; Markup functions
- markup-option markup-option-add! markup-output
+ strip-ref-base string-canonicalize
- ;; Container functions
- container-env-get
;; Images
convert-image
;; String writing
- make-string-replace
-
- ;; AST
- ast-parent ast->string
- markup-parent markup-document markup-chapter
-
- handle-body))
-
-(use-modules (skribilo debug)
- (skribilo types)
- (skribilo verify)
- (skribilo resolve)
- (skribilo output)
- (skribilo evaluator)
- (skribilo vars)
- (skribilo lib)
- (srfi srfi-13)
- (oop goops))
+ make-string-replace)
+ :use-module (skribilo parameters)
+ :use-module (skribilo lib)
+ :use-module (srfi srfi-13))
@@ -70,13 +46,13 @@
;;FIXME: Remonter cette fonction
(define (strip-ref-base file)
- (if (not (string? *skribe-ref-base*))
+ (if (not (string? (*ref-base*)))
file
- (let ((l (string-length *skribe-ref-base*)))
+ (let ((l (string-length (*ref-base*))))
(cond
((not (> (string-length file) (+ l 2)))
file)
- ((not (substring=? file *skribe-ref-base* l))
+ ((not (substring=? file (*ref-base*) l))
file)
((not (char=? (string-ref file l) (file-separator)))
file)
@@ -84,12 +60,6 @@
(substring file (+ l 1) (string-length file)))))))
-(define (ast->file-location ast)
- (let ((l (ast-loc ast)))
- (if (location? l)
- (format "~a:~a:" (location-file l) (location-line l))
- "")))
-
;; FIXME: Remonter cette fonction
(define (string-canonicalize old)
(let* ((l (string-length old))
@@ -123,58 +93,6 @@
(loop (+ r 1) (+ w 1) #f))))))
-;;; ======================================================================
-;;;
-;;; M A R K U P S F U N C T I O N S
-;;;
-;;; ======================================================================
-;; (define (markup-output markup
-;; :optional (engine #f)
-;; :key (predicate #f)
-;; (options '())
-;; (before #f)
-;; (action #f)
-;; (after #f))
-;; (let ((e (or engine (use-engine))))
-;; (cond
-;; ((not (is-a? e <engine>))
-;; (skribe-error 'markup-writer "illegal engine" e))
-;; ((and (not before)
-;; (not action)
-;; (not after))
-;; (%find-markup-output e markup))
-;; (else
-;; (let ((mp (if (procedure? predicate)
-;; (lambda (n e) (and (is-markup? n markup) (predicate n e)))
-;; (lambda (n e) (is-markup? n markup)))))
-;; (engine-output e markup mp options
-;; (or before (slot-ref e 'default-before))
-;; (or action (slot-ref e 'default-action))
-;; (or after (slot-ref e 'default-after))))))))
-
-(define (markup-option m opt)
- (if (markup? m)
- (let ((c (assq opt (slot-ref m 'options))))
- (and (pair? c) (pair? (cdr c))
- (cadr c)))
- (skribe-type-error 'markup-option "Illegal markup: " m "markup")))
-
-
-(define (markup-option-add! m opt val)
- (if (markup? m)
- (slot-set! m 'options (cons (list opt val)
- (slot-ref m 'options)))
- (skribe-type-error 'markup-option "Illegal markup: " m "markup")))
-
-;;; ======================================================================
-;;;
-;;; C O N T A I N E R S
-;;;
-;;; ======================================================================
-(define (container-env-get m key)
- (let ((c (assq key (slot-ref m 'env))))
- (and (pair? c) (cadr c))))
-
;;; ======================================================================
;;;
@@ -195,9 +113,9 @@
(string-append "fig2dev -L " fmt " " from " > " to)
(string-append "convert " from " " to))))
(cond
- ((> *skribe-verbose* 1)
+ ((> (*verbose*) 1)
(format (current-error-port) " [converting image: ~S (~S)]" from c))
- ((> *skribe-verbose* 0)
+ ((> (*verbose*) 0)
(format (current-error-port) " [converting image: ~S]" from)))
(and (zero? (system c))
to))))))
@@ -210,8 +128,8 @@
(skribe-image-path))
(let ((suf (suffix file)))
(if (member suf formats)
- (let* ((dir (if (string? *skribe-dest*)
- (dirname *skribe-dest*)
+ (let* ((dir (if (string? (*destination-file*))
+ (dirname (*destination-file*))
#f)))
(if dir
(let ((dest (basename path)))
@@ -221,8 +139,8 @@
(let loop ((fmts formats))
(if (null? fmts)
#f
- (let* ((dir (if (string? *skribe-dest*)
- (dirname *skribe-dest*)
+ (let* ((dir (if (string? (*destination-file*))
+ (dirname (*destination-file*))
"."))
(p (builtin-convert-image path (car fmts) dir)))
(if (string? p)
@@ -282,123 +200,3 @@
-
-;;; ======================================================================
-;;;
-;;; O P T I O N S
-;;;
-;;; ======================================================================
-
-;;NEW ;;
-;;NEW ;; GET-OPTION
-;;NEW ;;
-;;NEW (define (get-option obj key)
-;;NEW ;; This function either searches inside an a-list or a markup.
-;;NEW (cond
-;;NEW ((pair? obj) (let ((c (assq key obj)))
-;;NEW (and (pair? c) (pair? (cdr c)) (cadr c))))
-;;NEW ((markup? obj) (get-option (slot-ref obj 'option*) key))
-;;NEW (else #f)))
-;;NEW
-;;NEW ;;
-;;NEW ;; BIND-OPTION!
-;;NEW ;;
-;;NEW (define (bind-option! obj key value)
-;;NEW (slot-set! obj 'option* (cons (list key value)
-;;NEW (slot-ref obj 'option*))))
-;;NEW
-;;NEW
-;;NEW ;;
-;;NEW ;; GET-ENV
-;;NEW ;;
-;;NEW (define (get-env obj key)
-;;NEW ;; This function either searches inside an a-list or a container
-;;NEW (cond
-;;NEW ((pair? obj) (let ((c (assq key obj)))
-;;NEW (and (pair? c) (cadr c))))
-;;NEW ((container? obj) (get-env (slot-ref obj 'env) key))
-;;NEW (else #f)))
-;;NEW
-
-
-
-
-;;; ======================================================================
-;;;
-;;; A S T
-;;;
-;;; ======================================================================
-
-(define-generic ast->string)
-
-
-(define-method (ast->string (ast <top>)) "")
-(define-method (ast->string (ast <string>)) ast)
-(define-method (ast->string (ast <number>)) (number->string ast))
-
-(define-method (ast->string (ast <pair>))
- (let ((out (open-output-string)))
- (let Loop ((lst ast))
- (cond
- ((null? lst)
- (get-output-string out))
- (else
- (display (ast->string (car lst)) out)
- (unless (null? (cdr lst))
- (display #\space out))
- (Loop (cdr lst)))))))
-
-(define-method (ast->string (ast <node>))
- (ast->string (slot-ref ast 'body)))
-
-
-
-;;
-;; AST-PARENT
-;;
-(define (ast-parent n)
- (slot-ref n 'parent))
-
-;;
-;; MARKUP-PARENT
-;;
-(define (markup-parent m)
- (let ((p (slot-ref m 'parent)))
- (if (eq? p 'unspecified)
- (skribe-error 'markup-parent "Unresolved parent reference" m)
- p)))
-
-
-;;
-;; MARKUP-DOCUMENT
-;;
-(define (markup-document m)
- (let Loop ((p m)
- (l #f))
- (cond
- ((is-markup? p 'document) p)
- ((or (eq? p 'unspecified) (not p)) l)
- (else (Loop (slot-ref p 'parent) p)))))
-
-;;
-;;
-;; MARKUP-CHAPTER
-;;
-(define (markup-chapter m)
- (let loop ((p m)
- (l #f))
- (cond
- ((is-markup? p 'chapter) p)
- ((or (eq? p 'unspecified) (not p)) l)
- (else (loop (slot-ref p 'parent) p)))))
-
-
-
-;;;; ======================================================================
-;;;;
-;;;; H A N D L E S
-;;;;
-;;;; ======================================================================
-(define (handle-body h)
- (slot-ref h 'body))
-
generated by cgit v1.2.3 (git 2.45.0) at 2024-07-06 01:52:42 +0000