From efea4dc93f2565555e47de0bfd027614a9c8674d Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Fri, 1 Jul 2005 23:55:56 +0000
Subject: Lots of changes, again.

Lots of changes, notably the following:

* skr/*.skr:  Moved engines to `src/guile/skribilo/engine'.

* src/guile/skribilo/engine.scm (lookup-engine):  Rewritten.  Don't use
  the auto-load alist.

* src/guile/skribilo/evaluator.scm:  New name of the `eval' module.
  `eval' couldn't be used as the module base-name because of Guile's
  recursive module name space.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-2
---
 skr/base.skr | 464 -----------------------------------------------------------
 1 file changed, 464 deletions(-)
 delete mode 100644 skr/base.skr

(limited to 'skr/base.skr')

diff --git a/skr/base.skr b/skr/base.skr
deleted file mode 100644
index ec987ec..0000000
--- a/skr/base.skr
+++ /dev/null
@@ -1,464 +0,0 @@
-;*=====================================================================*/
-;*    serrano/prgm/project/skribe/skr/base.skr                         */
-;*    -------------------------------------------------------------    */
-;*    Author      :  Manuel Serrano                                    */
-;*    Creation    :  Sat Jul 26 12:39:30 2003                          */
-;*    Last change :  Wed Oct 27 11:24:20 2004 (eg)                     */
-;*    Copyright   :  2003-04 Manuel Serrano                            */
-;*    -------------------------------------------------------------    */
-;*    BASE Skribe engine                                               */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;*    base-engine ...                                                  */
-;*---------------------------------------------------------------------*/
-(define base-engine
-   (default-engine-set!
-      (make-engine 'base
-		   :version 'plain
-		   :symbol-table '(("iexcl" "!")
-				   ("cent" "c")
-				   ("lguillemet" "\"")
-				   ("not" "!")
-				   ("registered" "(r)")
-				   ("degree" "o")
-				   ("plusminus" "+/-")
-				   ("micro" "o")
-				   ("paragraph" "p")
-				   ("middot" ".")
-				   ("rguillemet" "\"")
-				   ("iquestion" "?")
-				   ("Agrave" "À")
-				   ("Aacute" "A")
-				   ("Acircumflex" "Â")
-				   ("Atilde" "A")
-				   ("Amul" "A")
-				   ("Aring" "A")
-				   ("AEligature" "AE")
-				   ("Oeligature" "OE")
-				   ("Ccedilla" "Ç")
-				   ("Egrave" "È")
-				   ("Eacute" "É")
-				   ("Ecircumflex" "Ê")
-				   ("Euml" "E")
-				   ("Igrave" "I")
-				   ("Iacute" "I")
-				   ("Icircumflex" "Î")
-				   ("Iuml" "I")
-				   ("ETH" "D")
-				   ("Ntilde" "N")
-				   ("Ograve" "O")
-				   ("Oacute" "O")
-				   ("Ocurcumflex" "O")
-				   ("Otilde" "O")
-				   ("Ouml" "O")
-				   ("times" "x")
-				   ("Oslash" "O")
-				   ("Ugrave" "Ù")
-				   ("Uacute" "U")
-				   ("Ucircumflex" "Û")
-				   ("Uuml" "Ü")
-				   ("Yacute" "Y")
-				   ("agrave" "à")
-				   ("aacute" "a")
-				   ("acircumflex" "â")
-				   ("atilde" "a")
-				   ("amul" "a")
-				   ("aring" "a")
-				   ("aeligature" "æ")
-				   ("oeligature" "oe")
-				   ("ccedilla" "ç")
-				   ("egrave" "è")
-				   ("eacute" "é")
-				   ("ecircumflex" "ê")
-				   ("euml" "e")
-				   ("igrave" "i")
-				   ("iacute" "i")
-				   ("icircumflex" "î")
-				   ("iuml" "i")
-				   ("ntilde" "n")
-				   ("ograve" "o")
-				   ("oacute" "o")
-				   ("ocurcumflex" "o")
-				   ("otilde" "o")
-				   ("ouml" "o")
-				   ("divide" "/")
-				   ("oslash" "o")
-				   ("ugrave" "ù")
-				   ("uacute" "u")
-				   ("ucircumflex" "û")
-				   ("uuml" "ü")
-				   ("yacute" "y")
-				   ("ymul" "y")
-				   ;; punctuation
-				   ("bullet" ".")
-				   ("ellipsis" "...")
-				   ("<-" "<-")
-				   ("<--" "<--")
-				   ("uparrow" "^;")
-				   ("->" "->")
-				   ("-->" "-->")
-				   ("downarrow" "v")
-				   ("<->" "<->")
-				   ("<-->" "<-->")
-				   ("<+" "<+")
-				   ("<=" "<=;")
-				   ("<==" "<==")
-				   ("Uparrow" "^")
-				   ("=>" "=>")
-				   ("==>" "==>")
-				   ("Downarrow" "v")
-				   ("<=>" "<=>")
-				   ("<==>" "<==>")
-				   ;; Mathematical operators 
-				   ("asterisk" "*")
-				   ("angle" "<")
-				   ("and" "^;")
-				   ("or" "v")
-				   ("models" "|=")
-				   ("vdash" "|-")
-				   ("dashv" "-|")
-				   ("sim" "~")
-				   ("mid" "|")
-				   ("langle" "<")
-				   ("rangle" ">")
-				   ;; LaTeX 
-				   ("circ" "o")
-				   ("top" "T")
-				   ("lhd" "<")
-				   ("rhd" ">")
-				   ("parallel" "||")))))
-   
-;*---------------------------------------------------------------------*/
-;*    mark ...                                                         */
-;*---------------------------------------------------------------------*/
-(markup-writer 'symbol
-   :action (lambda (n e)
-	      (let* ((s (markup-body n))
-		     (c (assoc s (engine-symbol-table e))))
-		 (if (pair? c)
-		     (display (cadr c))
-		     (output s e)))))
-
-;*---------------------------------------------------------------------*/
-;*    unref ...                                                        */
-;*---------------------------------------------------------------------*/
-(markup-writer 'unref
-   :options 'all
-   :action (lambda (n e)
-	      (let* ((s (markup-option n :skribe))
-		     (k (markup-option n 'kind))
-		     (f (cond
-			   (s
-			    (format "?~a@~a " k s))
-			   (else
-			    (format "?~a " k))))
-		     (msg (list f (markup-body n)))
-		     (n (list "[" (color :fg "red" (bold msg)) "]")))
-		 (skribe-eval n e))))
-
-;*---------------------------------------------------------------------*/
-;*    &the-bibliography ...                                            */
-;*---------------------------------------------------------------------*/
-(markup-writer '&the-bibliography
-   :before (lambda (n e)
-	      (let ((w (markup-writer-get 'table e)))
-		 (and (writer? w) (invoke (writer-before w) n e))))
-   :action (lambda (n e)
-	      (when (pair? (markup-body n))
-		 (for-each (lambda (i) (output i e)) (markup-body n))))
-   :after (lambda (n e)
-	     (let ((w (markup-writer-get 'table e)))
-		(and (writer? w) (invoke (writer-after w) n e)))))
-
-;*---------------------------------------------------------------------*/
-;*    &bib-entry ...                                                   */
-;*---------------------------------------------------------------------*/
-(markup-writer '&bib-entry
-   :options '(:title)
-   :before (lambda (n e)
-	      (invoke (writer-before (markup-writer-get 'tr e)) n e))
-   :action (lambda (n e)
-	      (let ((wtc (markup-writer-get 'tc e)))
-		 ;; the label
-		 (markup-option-add! n :valign 'top)
-		 (markup-option-add! n :align 'right)
-		 (invoke (writer-before wtc) n e)
-		 (output n e (markup-writer-get '&bib-entry-label e))
-		 (invoke (writer-after wtc) n e)
-		 ;; the body
-		 (markup-option-add! n :valign 'top)
-		 (markup-option-add! n :align 'left)
-		 (invoke (writer-before wtc) n e)
-		 (output n e (markup-writer-get '&bib-entry-body))
-		 (invoke (writer-after wtc) n e)))
-   :after (lambda (n e)
-	     (invoke (writer-after (markup-writer-get 'tr e)) n e)))
-
-;*---------------------------------------------------------------------*/
-;*    &bib-entry-label ...                                             */
-;*---------------------------------------------------------------------*/
-(markup-writer '&bib-entry-label
-   :options '(:title)
-   :before "["
-   :action (lambda (n e) (output (markup-option n :title) e))
-   :after "]")
-	     
-;*---------------------------------------------------------------------*/
-;*    &bib-entry-body ...                                              */
-;*---------------------------------------------------------------------*/
-(markup-writer '&bib-entry-body
-   :action (lambda (n e)
-	      (define (output-fields descr)
-		 (let loop ((descr descr)
-			    (pending #f)
-			    (armed #f))
-		    (cond
-		       ((null? descr)
-			'done)
-		       ((pair? (car descr))
-			(if (eq? (caar descr) 'or)
-			    (let ((o1 (cadr (car descr))))
-			       (if (markup-option n o1)
-				   (loop (cons o1 (cdr descr)) 
-					 pending 
-					 #t)
-				   (let ((o2 (caddr (car descr))))
-				      (loop (cons o2 (cdr descr)) 
-					    pending
-					    armed))))
-			    (let ((o (markup-option n (cadr (car descr)))))
-			       (if o
-				   (begin
-				      (if (and pending armed)
-					  (output pending e))
-				      (output (caar descr) e)
-				      (output o e)
-				      (if (pair? (cddr (car descr)))
-					  (output (caddr (car descr)) e))
-				      (loop (cdr descr) #f #t))
-				   (loop (cdr descr) pending armed)))))
-		       ((symbol? (car descr))
-			(let ((o (markup-option n (car descr))))
-			   (if o 
-			       (begin
-				  (if (and armed pending)
-				      (output pending e))
-				  (output o e)
-				  (loop (cdr descr) #f #t))
-			       (loop (cdr descr) pending armed))))
-		       ((null? (cdr descr))
-			(output (car descr) e))
-		       ((string? (car descr))
-			(loop (cdr descr) 
-			      (if pending pending (car descr))
-			      armed))
-		       (else
-			(skribe-error 'output-bib-fields
-				      "Illegal description"
-				      (car descr))))))
-	      (output-fields
-	       (case (markup-option n 'kind)
-		  ((techreport)
-		   `(author " -- " (or title url documenturl) " -- " 
-			    number ", " institution ", "
-			    address ", " month ", " year ", " 
-			    ("pp. " pages) "."))
-		  ((article)
-		   `(author " -- " (or title url documenturl) " -- " 
-			    journal ", " volume "" ("(" number ")") ", "
-			    address ", " month ", " year ", "
-			    ("pp. " pages) "."))
-		  ((inproceedings)
-		   `(author " -- " (or title url documenturl) " -- " 
-			    booktitle ", " series ", " ("(" number ")") ", "
-			    address ", " month ", " year ", "
-			    ("pp. " pages) "."))
-		  ((book)
-		   '(author " -- " (or title url documenturl) " -- " 
-			    publisher ", " address
-			    ", " month ", " year ", " ("pp. " pages) "."))
-		  ((phdthesis)
-		   '(author " -- " (or title url documenturl) " -- " type ", " 
-			    school ", " address
-			    ", " month ", " year"."))
-		  ((misc)
-		   '(author " -- " (or title url documenturl) " -- "
-			    publisher ", " address
-			    ", " month ", " year"."))
-		  (else
-		   '(author " -- " (or title url documenturl) " -- "
-			    publisher ", " address
-			    ", " month ", " year ", " ("pp. " pages) "."))))))
-
-;*---------------------------------------------------------------------*/
-;*    &bib-entry-ident ...                                             */
-;*---------------------------------------------------------------------*/
-(markup-writer '&bib-entry-ident
-   :action (lambda (n e)
-	      (output (markup-option n 'number) e)))
-
-;*---------------------------------------------------------------------*/
-;*    &bib-entry-title ...                                             */
-;*---------------------------------------------------------------------*/
-(markup-writer '&bib-entry-title
-   :action (lambda (n e)
-	      (skribe-eval (bold (markup-body n)) e)))
-
-;*---------------------------------------------------------------------*/
-;*    &bib-entry-publisher ...                                         */
-;*---------------------------------------------------------------------*/
-(markup-writer '&bib-entry-publisher
-   :action (lambda (n e)
-	      (skribe-eval (it (markup-body n)) e)))
-
-;*---------------------------------------------------------------------*/
-;*    &the-index ...  @label the-index@                                */
-;*---------------------------------------------------------------------*/
-(markup-writer '&the-index
-   :options '(:column)
-   :before (lambda (n e)
-	      (output (markup-option n 'header) e))
-   :action (lambda (n e)
-	      (define (make-mark-entry n fst)
-		 (let ((l (tr :class 'index-mark-entry
-			     (td :colspan 2 :align 'left 
-				(bold (it (sf n)))))))
-		    (if fst
-			(list l)
-			(list (tr (td :colspan 2)) l))))
-	      (define (make-primary-entry n p)
-		 (let* ((note (markup-option n :note))
-			(b (markup-body n))
-			(c (if note 
-			       (list b
-				     (it (list " (" note ")")))
-			       b)))
-		    (when p 
-		       (markup-option-add! b :text 
-					   (list (markup-option b :text) 
-						 ", p."))
-		       (markup-option-add! b :page #t))
-		    (tr :class 'index-primary-entry
-		       (td :colspan 2 :valign 'top :align 'left c))))
-	      (define (make-secondary-entry n p)
-		 (let* ((note (markup-option n :note))
-			(b (markup-body n))
-			(bb (markup-body b)))
-		    (cond
-		       ((not (or bb (is-markup? b 'url-ref)))
-			(skribe-error 'the-index 
-				      "Illegal entry"
-				      b))
-		       (note
-			(let ((r (if bb
-				     (it (ref :class "the-index-secondary"
-					    :handle bb
-					    :page p
-					    :text (if p 
-						      (list note ", p.")
-						      note)))
-				     (it (ref :class "the-index-secondary"
-					    :url (markup-option b :url)
-					    :page p
-					    :text (if p 
-						      (list note ", p.")
-						      note))))))
-			   (tr :class 'index-secondary-entry
-			      (td :valign 'top :align 'right :width 1. " ...")
-			      (td :valign 'top :align 'left r))))
-		       (else
-			(let ((r (if bb
-				     (ref :class "the-index-secondary"
-					:handle bb 
-					:page p 
-					:text (if p " ..., p." " ..."))
-				     (ref :class "the-index-secondary"
-					:url (markup-option b :url)
-					:page p 
-					:text (if p " ..., p." " ...")))))
-			   (tr :class 'index-secondary-entry
-			      (td :valign 'top :align 'right :width 1.)
-			      (td :valign 'top :align 'left r)))))))
-	      (define (make-column ie p)
-		 (let loop ((ie ie)
-			    (f #t))
-		    (cond
-		       ((null? ie)
-			'())
-		       ((not (pair? (car ie)))
-			(append (make-mark-entry (car ie) f) 
-				(loop (cdr ie) #f)))
-		       (else
-			(cons (make-primary-entry (caar ie) p)
-			      (append (map (lambda (x) 
-					      (make-secondary-entry x p))
-					   (cdar ie))
-				      (loop (cdr ie) #f)))))))
-	      (define (make-sub-tables ie nc p)
-		 (let* ((l (length ie))
-			(w (/ 100. nc))
-			(iepc (let ((d (/ l nc)))
-				 (if (integer? d) 
-				     (inexact->exact d)
-				     (+ 1 (inexact->exact (truncate d))))))
-			(split (list-split ie iepc)))
-		    (tr (map (lambda (ies)
-				(td :valign 'top :width w
-				   (if (pair? ies)
-				       (table :width 100. (make-column ies p))
-				       "")))
-			     split))))
-	      (let* ((ie (markup-body n))
-		     (nc (markup-option n :column))
-		     (loc (ast-loc n))
-		     (pref (eq? (engine-custom e 'index-page-ref) #t))
-		     (t (cond
-			   ((null? ie)
-			    "")
-			   ((or (not (integer? nc)) (= nc 1))
-			    (table :width 100. 
-			       :&skribe-eval-location loc 
-			       :class "index-table"
-			       (make-column ie pref)))
-			   (else
-			    (table :width 100.
-			       :&skribe-eval-location loc 
-			       :class "index-table"
-			       (make-sub-tables ie nc pref))))))
-		 (output (skribe-eval t e) e))))
-
-;*---------------------------------------------------------------------*/
-;*    &the-index-header ...                                            */
-;*    -------------------------------------------------------------    */
-;*    The index header is only useful for targets that support         */
-;*    hyperlinks such as HTML.                                         */
-;*---------------------------------------------------------------------*/
-(markup-writer '&the-index-header 
-   :action (lambda (n e) #f))
-
-;*---------------------------------------------------------------------*/
-;*    &prog-line ...                                                   */
-;*---------------------------------------------------------------------*/
-(markup-writer '&prog-line
-   :before (lambda (n e)
-	      (let ((n (markup-ident n)))
-		 (if n (skribe-eval (it (list n) ": ") e))))
-   :after "\n")
-
-;*---------------------------------------------------------------------*/
-;*    line-ref ...                                                     */
-;*---------------------------------------------------------------------*/
-(markup-writer 'line-ref
-   :options '(:offset)
-   :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))))
-
-
-
-;;;; A VIRER (mais handle-body n'est pas défini)
-(markup-writer 'line-ref
-   :options '(:offset)
-   :action #f)
-- 
cgit v1.2.3