From e9509518623d016880392237a298d4561a3b6a0b Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Mon, 31 Oct 2005 16:03:18 +0000
Subject: Removed useless files, integrated packages.

* src/guile/skribilo/packages: New directory and files.

* bin: Removed.

* skr: Removed (files moved to `src/guile/skribilo/packages').

* skribe: Removed.

* doc/skr/env.skr (*courtes-mail*): New.

* doc/user/user.skb: Removed postal addresses, added my name.

* src/guile/skribilo/engine/lout.scm: Uncommented the slide-related
  markup writers.

* src/guile/skribilo/evaluator.scm (%evaluate): Try weird things with
  source properties.

* src/guile/skribilo/reader/skribe.scm: Comply with the new guile-reader
  API.

* src/guile/skribilo/types.scm: Removed the special `initialize' method
  for ASTs which was supposed to set their location.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-7
---
 skribe/doc/skr/api.skr       | 575 -------------------------------------------
 skribe/doc/skr/env.skr       |  32 ---
 skribe/doc/skr/extension.skr |  95 -------
 skribe/doc/skr/manual.skr    | 281 ---------------------
 4 files changed, 983 deletions(-)
 delete mode 100644 skribe/doc/skr/api.skr
 delete mode 100644 skribe/doc/skr/env.skr
 delete mode 100644 skribe/doc/skr/extension.skr
 delete mode 100644 skribe/doc/skr/manual.skr

(limited to 'skribe/doc/skr')

diff --git a/skribe/doc/skr/api.skr b/skribe/doc/skr/api.skr
deleted file mode 100644
index a27c3a4..0000000
--- a/skribe/doc/skr/api.skr
+++ /dev/null
@@ -1,575 +0,0 @@
-;*=====================================================================*/
-;*    serrano/prgm/project/skribe/doc/skr/api.skr                      */
-;*    -------------------------------------------------------------    */
-;*    Author      :  Manuel Serrano                                    */
-;*    Creation    :  Wed Sep  3 07:45:33 2003                          */
-;*    Last change :  Tue Apr  6 06:51:34 2004 (serrano)                */
-;*    Copyright   :  2003-04 Manuel Serrano                            */
-;*    -------------------------------------------------------------    */
-;*    The Skribe style for documenting Lisp APIs.                      */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;*    Html configuration                                               */
-;*---------------------------------------------------------------------*/
-(let* ((he (find-engine 'html))
-       (tro (markup-writer-get 'tr he)))
-   (markup-writer 'tr he
-      :class 'api-table-header
-      :options '(:width :bg)
-      :action (lambda (n e)
-		 (let ((c (engine-custom e 'section-title-background)))
-		    (markup-option-add! n :bg c)
-		    (output n e tro))))
-   (markup-writer 'tr he
-      :class 'api-table-prototype
-      :options '(:width :bg)
-      :action (lambda (n e)
-		 (let ((c (engine-custom e 'title-background)))
-		    (markup-option-add! n :bg c)
-		    (output n e tro))))
-   (markup-writer 'tr he
-      :class 'api-symbol-prototype
-      :options '(:width :bg)
-      :action (lambda (n e)
-		 (let ((c (engine-custom e 'title-background)))
-		    (markup-option-add! n :bg c)
-		    (output n e tro)))))
-
-;*---------------------------------------------------------------------*/
-;*    LaTeX configuration                                              */
-;*---------------------------------------------------------------------*/
-(let* ((le (find-engine 'latex))
-       (tro (markup-writer-get 'tr le)))
-   (markup-writer 'tr le
-      :class 'api-table-prototype
-      :options '(:width :bg)
-      :action #f)
-   (markup-writer 'tr le
-      :class 'api-table-header
-      :options '(:width :bg)
-      :action (lambda (n e)
-		 (let ((c (engine-custom e 'section-title-background)))
-		    (markup-option-add! n :bg c)
-		    (output n e tro)))))
-
-;*---------------------------------------------------------------------*/
-;*    api-search-definition ...                                        */
-;*    -------------------------------------------------------------    */
-;*    Find a definition inside a source file.                          */
-;*---------------------------------------------------------------------*/
-(define (api-search-definition id file pred)
-   (let ((f (find-file/path file *skribe-source-path*)))
-      (if (not (string? f))
-	  (skribe-error 'api-search-definition
-			(format "Can't find source file `~a' in path" file)
-			*skribe-source-path*)
-	  (with-input-from-file f
-	     (lambda ()
-		(let loop ((exp (read)))
-		   (if (eof-object? exp)
-		       (skribe-error 'api-search-definition 
-				     (format "Can't find `~a' definition" id)
-				     file)
-		       (or (pred id exp) (loop (read))))))))))
-
-;*---------------------------------------------------------------------*/
-;*    api-compare-set ...                                              */
-;*    -------------------------------------------------------------    */
-;*    This function compares two sets. It returns either #t            */
-;*    is they are equal, or two subsets which contain elements         */
-;*    not present in the arguments. For instance:                      */
-;*      (api-compare-set '(foo bar) '(bar foo)) ==> #t                 */
-;*      (api-compare-set '(foo gee) '(gee bar)) ==> '((foo) (bar))     */
-;*---------------------------------------------------------------------*/
-(define (api-compare-set s1 s2)
-   (let ((d1 (filter (lambda (x) (not (memq x s2))) s1))
-	 (d2 (filter (lambda (x) (not (memq x s1))) s2)))
-      (or (and (null? d1) (null? d2))
-	  (list d1 d2))))
-
-;*---------------------------------------------------------------------*/
-;*    keyword->symbol ...                                              */
-;*---------------------------------------------------------------------*/
-(define (keyword->symbol kwd)
-   (let ((s (keyword->string kwd)))
-     (if (char=? #\: (string-ref s 0))
-	 ;; Bigloo
-	 (string->symbol (substring s 1 (string-length s)))
-	 ;; STklos
-	 (string->symbol s))))			 
-
-;*---------------------------------------------------------------------*/
-;*    define-markup? ...                                               */
-;*---------------------------------------------------------------------*/
-(define (define-markup? id o)
-   (match-case o
-      (((or define-markup define define-inline)
-	((? (lambda (x) (eq? x id))) . (? (lambda (x) (or (pair? x) (null? x))))) . ?-)
-       o)
-      ((define-simple-markup (? (lambda (x) (eq? x id))))
-       o)
-      ((define-simple-container (? (lambda (x) (eq? x id))))
-       o)
-      (else
-       #f)))
-
-;*---------------------------------------------------------------------*/
-;*    make-engine? ...                                                 */
-;*---------------------------------------------------------------------*/
-(define (make-engine? id o)
-   (match-case o
-      (((or make-engine copy-engine) (quote (? (lambda (x) (eq? x id)))) . ?-)
-       o)
-      ((quasiquote . ?-)
-       #f)
-      ((quote . ?-)
-       #f)
-      ((?a . ?d)
-       (or (make-engine? id a) (make-engine? id d)))
-      (else
-       #f)))
-
-;*---------------------------------------------------------------------*/
-;*    make-engine-custom ...                                           */
-;*---------------------------------------------------------------------*/
-(define (make-engine-custom def)
-   (match-case (memq :custom def)
-      ((:custom (quote ?custom) . ?-)
-       custom)
-      ((:custom ?custom . ?-)
-       (eval custom))
-      (else 
-       '())))
-
-;*---------------------------------------------------------------------*/
-;*    define-markup-formals ...                                        */
-;*    -------------------------------------------------------------    */
-;*    Returns the formal parameters of a define-markup (not the        */
-;*    options).                                                        */
-;*---------------------------------------------------------------------*/
-(define (define-markup-formals def)
-   (match-case def
-      ((?- (?- . ?args) . ?-)
-       (if (symbol? args)
-	   (list args)
-	   (let loop ((args args)
-		      (res '()))
-	      (cond
-		 ((null? args)
-		  (reverse! res))
-		 ((symbol? args)
-		  (reverse! (cons args res)))
-		 ((not (symbol? (car args)))
-		  (reverse! res))
-		 (else
-		  (loop (cdr args) (cons (car args) res)))))))
-      ((define-simple-markup ?-)
-       '())
-      ((define-simple-container ?-)
-       '())
-      (else
-       (skribe-error 'define-markup-formals 
-		     "Illegal `define-markup' form"
-		     def))))
-
-;*---------------------------------------------------------------------*/
-;*    define-markup-options ...                                        */
-;*    -------------------------------------------------------------    */
-;*    Returns the options parameters of a define-markup.               */
-;*---------------------------------------------------------------------*/
-(define (define-markup-options def)
-   (match-case def
-      ((?- (?- . ?args) . ?-)
-       (if (not (list? args))
-	   '()
-	   (let ((keys (memq #!key args)))
-	      (if (pair? keys)
-		  (cdr keys)
-		  '()))))
-      ((define-simple-markup ?-)
-       '((ident #f) (class #f)))
-      ((define-simple-container ?-)
-       '((ident #f) (class #f)))
-      (else
-       (skribe-error 'define-markup-formals 
-		     "Illegal `define-markup' form"
-		     def))))
-
-;*---------------------------------------------------------------------*/
-;*    define-markup-rest ...                                           */
-;*    -------------------------------------------------------------    */
-;*    Returns the rest parameter of a define-markup.                   */
-;*---------------------------------------------------------------------*/
-(define (define-markup-rest def)
-   (match-case def
-      ((?- (?- . ?args) . ?-)
-       (if (not (pair? args))
-	   args
-	   (let ((l (last-pair args)))
-	      (if (symbol? (cdr l))
-		  (cdr l)
-		  (let ((rest (memq #!rest args)))
-		     (if (pair? rest)
-			 (if (or (not (pair? (cdr rest)))
-				 (not (symbol? (cadr rest))))
-			     (skribe-error 'define-markup-rest
-					   "Illegal `define-markup' form"
-					   def)
-			     (cadr rest))
-			 #f))))))
-      ((define-simple-markup ?-)
-       'node)
-      ((define-simple-container ?-)
-       'node)
-      (else
-       (skribe-error 'define-markup-formals 
-		     "Illegal `define-markup' form"
-		     def))))
-
-;*---------------------------------------------------------------------*/
-;*    doc-check-arguments ...                                          */
-;*---------------------------------------------------------------------*/
-(define (doc-check-arguments id args dargs)
-   (if (not args)
-       (skribe-error 'doc-check-arguments id args))
-   (if (not dargs)
-       (skribe-error 'doc-check-arguments id dargs))
-   (let* ((s1 (map (lambda (x) (if (pair? x) (car x) x)) args))
-	  (s2 (map (lambda (x)
-		      (let ((i (car x)))
-			 (if (keyword? i)
-			     (keyword->symbol i)
-			     i)))
-		   dargs))
-	  (d (api-compare-set s1 s2)))
-      (if (pair? d)
-	  (let ((d1 (car d))
-		(d2 (cadr d)))
-	     (if (pair? d1)
-		 (skribe-error 'doc-markup 
-			       (format "~a: missing descriptions" id)
-			       d1)
-		 (skribe-error 'doc-markup 
-			       (format "~a: extra descriptions" id)
-			       d2))))))
-
-;*---------------------------------------------------------------------*/
-;*    exp->skribe ...                                                  */
-;*---------------------------------------------------------------------*/
-(define (exp->skribe exp)
-   (cond
-      ((number? exp) exp)
-      ((string? exp) (string-append "\"" exp "\""))
-      ((eq? exp #f) "#f")
-      ((eq? exp #t) "#t")
-      ((symbol? exp) (symbol->string exp))
-      ((equal? exp '(quote ())) "'()")
-      ((ast? exp) 
-       (table :cellpadding 0 :cellspacing 0 
-	  (tr (td :align 'left exp))))
-      (else 
-       (match-case exp
-	  ((quote (and ?sym (? symbol?)))
-	   (string-append "'" (symbol->string sym)))
-	  (else
-	   (with-output-to-string (lambda () (write exp))))))))
-
-;*---------------------------------------------------------------------*/
-;*    doc-markup-proto ...                                             */
-;*---------------------------------------------------------------------*/
-(define (doc-markup-proto id options formals rest)
-   (define (option opt)
-      (if (pair? opt)
-	  (if (eq? (cadr opt) #f)
-	      (list " [" (keyword (car opt)) "]")
-	      (list " [" (keyword (car opt)) " " 
-		    (code (exp->skribe (cadr opt))) "]"))
-	  (list " " (keyword opt))))
-   (define (formal f)
-      (list " " (param f)))
-   (code (list (bold "(") (bold :class 'api-proto-ident (format "~a" id)))
-	 (map option (sort options 
-			   (lambda (s1 s2)
-			      (cond
-				 ((and (pair? s1) (not (pair? s2)))
-				  #f)
-				 ((and (pair? s2) (not (pair? s1)))
-				  #t)
-				 (else
-				  #t)))))
-	 (if (pair? formals)
-	     (map formal formals))
-	 (if rest (list " " (param rest)))
-	 (bold ")")))
-
-;*---------------------------------------------------------------------*/
-;*    doc-markup ...                                                   */
-;*---------------------------------------------------------------------*/
-(define-markup (doc-markup id args
-			   #!rest 
-			   opts
-			   #!key 
-			   (writer-id #f)
-			   (common-args '((:ident "The node identifier.")
-					  (:class "The node class.")))
-			   (ignore-args '(&skribe-eval-location))
-			   (force-args '())
-			   (idx *markup-index*)
-			   (idx-note "definition")
-		           (idx-suffix #f)
-			   (source "src/common/api.scm")
-			   (def #f)
-			   (see-also '())
-			   (others '())
-			   (force-engines '())
-			   (engines *api-engines*)
-			   (sui #f)
-			   &skribe-eval-location)
-   (define (opt-engine-support opt)
-      ;; find the engines providing a writer for id
-      (map (lambda (e)
-	      (let* ((id (engine-ident e))
-		     (s (symbol->string id)))
-		 (if (engine-format? "latex")
-		     (list s " ")
-		     (list (if sui
-			       (ref :skribe sui 
-				  :mark (string-append s "-engine") 
-				  :text s)
-			       (ref :mark (string-append s "-engine") 
-				  :text s))
-			   " "))))
-	   (if (pair? force-engines) 
-	       force-engines 
-	       (filter (lambda (e)
-			  (or (memq opt '(:ident :class))
-			      (memq opt force-args)
-			      (let ((w (markup-writer-get (or writer-id id)
-							  e)))
-				 (cond
-				    ((not (writer? w))
-				     #f)
-				    (else
-				     (let ((o (writer-options w)))
-					(cond
-					   ((eq? o 'all)
-					    #t)
-					   ((not (pair? o))
-					    #f)
-					   (else
-					    (memq opt o)))))))))
-		       engines))))
-   (cond
-      ((and def source)
-       (skribe-error 'doc-markup "source and def both specified" id))
-      ((and (not def) (not source))
-       (skribe-error 'doc-markup "source or def must be specified" id))
-      (else
-       (let* ((d (or def (api-search-definition id source define-markup?)))
-	      (od (map (lambda (o)
-			  (api-search-definition o source define-markup?))
-		       others))
-	      (args (append common-args args))
-	      (formals (define-markup-formals d))
-	      (fformals (filter (lambda (s)
-				   (let ((c (assq s args)))
-				      (not 
-				       (and (pair? c) 
-					    (eq? (cadr c) 'ignore)))))
-				formals))
-	      (options (filter (lambda (s)
-				  (not (memq s ignore-args)))
-			       (define-markup-options d)))
-	      (dformals (filter (lambda (x) 
-				   (symbol? (car x)))
-				args))
-	      (doptions (filter (lambda (x) 
-				   (and (keyword? (car x))
-					;; useful for STklos only
-					(not (eq? (car x) #!rest))))
-				args))
-	      (drest (filter (lambda (x) 
-				(eq? #!rest (car x))) 
-			     args))
-	      (dargs (and (pair? drest) (cadr (car drest))))
-	      (p+ (cons (doc-markup-proto id options fformals dargs)
-			(map (lambda (id def)
-				(doc-markup-proto 
-				 id 
-				 (define-markup-options def)
-				 (define-markup-formals def)
-				 dargs))
-			     others od))))
-	  ;; doc table
-	  (define (doc-markup.html)
-	     (let ((df (map (lambda (f)
-			       (tr :bg *prgm-skribe-color*
-				  (td :colspan 2 :width 20. :align 'left
-				     (param (car f)) )
-				  (td :align 'left :width 80. (cadr f))))
-			    dformals))
-		   (dr (and (pair? drest)
-			    (tr :bg *prgm-skribe-color*
-			       (td :align 'left 
-				  :valign 'top
-				  :colspan 2 
-				  :width 20.
-				  (param (cadr (car drest))))
-			       (td :align 'left :width 80. 
-				  (caddr (car drest))))))
-		   (do (map (lambda (f)
-			       (tr :bg *prgm-skribe-color*
-				  (td :align 'left 
-				     :valign 'top
-				     :width 10.
-				     (param (car f)))
-				  (td :align 'left 
-				     :valign 'top
-				     :width 20.
-				     (opt-engine-support (car f)))
-				  (td :align 'left :width 70. (cadr f))))
-			    doptions))
-		   (so (map (lambda (x)
-			       (let ((s (symbol->string x)))
-				  (list 
-				   (ref :mark s :text (code s))
-				   " ")))
-			    see-also)))
-		(table :border (if (engine-format? "latex") 1 0)
-		   :width (if (engine-format? "latex") #f *prgm-width*)
-		   `(,(tr :class 'api-table-prototype
-			 (th :colspan 3 :align 'left :width *prgm-width*
-			    "prototype"))
-		     ,@(map (lambda (p)
-			       (tr :bg *prgm-skribe-color*
-				  (td :colspan 3 :width *prgm-width*
-				     :align 'left  p)))
-			    p+)
-		     ,@(if (pair? do)
-			   `(,(tr :class 'api-table-header
-				 (th :align 'left "option" 
-				    :width 10.) 
-				 (th :align 'center "engines"
-				    :width 20.)
-				 (th "description"))
-			     ,@do)
-			   '())
-		     ,@(if (or (pair? df) dr)
-			   `(,(tr :class 'api-table-header
-				 (th :colspan 2 
-				    :align 'left 
-				    :width 30.
-				    "argument") 
-				 (th "description"))
-			     ,@(if (pair? df) df '())
-			     ,@(if dr (list dr) '()))
-			   '())
-		     ,@(if (pair? so)
-			   `(,(tr :class 'api-table-header
-				 (th :colspan 3 :align 'left 
-				    (it "See also")))
-			     ,(tr :bg *prgm-skribe-color*
-				 (td :colspan 3 :align 'left so)))
-			   '())))))
-	  ;; doc enumerate
-	  (define (doc-markup.latex)
-	     (let ((df (map (lambda (f)
-			       (item :key (param (car f)) (cadr f)))
-			    dformals))
-		   (dr (if (pair? drest)
-			   (list (item :key (param (cadr (car drest))) 
-				    (caddr (car drest))))
-			   '()))
-		   (do (map (lambda (f)
-			       (item :key (param (car f))
-				  (list (opt-engine-support (car f))
-					(cadr f))))
-			    doptions))
-		   (so (map (lambda (x)
-			       (let ((s (symbol->string x)))
-				  (list 
-				   (ref :mark s :page #t 
-				      :text [,(code s), p.])
-				   " ")))
-			    see-also)))
-		(list (center 
-			 (frame :margin 5 :border 0 :width *prgm-width*
-			    (color :class 'api-table-prototype
-			       :margin 5 :width 100. :bg "#ccccff"
-			       p+)))
-		      (when (pair? do)
-			 (subsubsection :title "Options" :number #f :toc #f
-			    (description do)))
-		      (when (or (pair? df) (pair? dr))
-			 (subsubsection :title "Parameters" :number #f :toc #f
-			    (description (append df dr))))
-		      (when (pair? so)
-			 (subsubsection :title "See also" :number #f :toc #f
-			    (p so)
-			    (! "\\noindent"))))))
-	  ;; check all the descriptions
-	  (doc-check-arguments id formals dformals)
-	  (doc-check-arguments id options doptions)
-	  (if (and (pair? drest) (not (define-markup-rest d)))
-	      (skribe-error 'doc-markup "No rest argument for" id)
-	      options)
-	  (list (mark :class "public-definition" (symbol->string id))
-		(map (lambda (i) (mark (symbol->string i))) others)
-		(map (lambda (i)
-			(let ((is (symbol->string i)))
-			   (index (if (string? idx-suffix)
-				      (string-append is idx-suffix)
-				      is)
-			      :index idx
-			      :note idx-note)))
-		     (cons id others))
-		(cond
-		   ((engine-format? "latex")
-		    (doc-markup.latex))
-		   (else
-		    (center (doc-markup.html)))))))))
-
-;*---------------------------------------------------------------------*/
-;*    doc-engine ...                                                   */
-;*---------------------------------------------------------------------*/
-(define-markup (doc-engine id args
-			   #!rest 
-			   opts
-			   #!key 
-			   (idx *custom-index*)
-			   source
-			   (def #f))
-   (cond
-      ((and def source)
-       (skribe-error 'doc-engine "source and def both specified" id))
-      ((and (not def) (not source))
-       (skribe-error 'doc-engine "source or def must be specified" id))
-      (else
-       (let* ((d (or def (api-search-definition id source make-engine?)))
-	      (c (make-engine-custom d)))
-	  (doc-check-arguments id c args)
-	  (cond
-	     ((engine-format? "latex")
-	      #f)
-	     (else
-	      (center
-		 (apply table 
-			:width *prgm-width*
-			(tr :class 'api-table-header
-			   (th :align 'left :width 20. "custom")
-			   (th :width 10. "default")
-			   (th "description"))
-			(map (lambda (r)
-				(tr :bg *prgm-skribe-color*
-				   (td :align 'left :valign 'top
-				      (list (index (symbol->string (car r))
-					       :index idx
-					       :note (format "~a custom" id))
-					    (symbol->string (car r))))
-				   (let ((def (assq (car r) c)))
-				      (td :valign 'top
-					 (code (exp->skribe (cadr def)))))
-				   (td :align 'left :valign 'top (cadr r))))
-			     (filter cadr args))))))))))
-	  
diff --git a/skribe/doc/skr/env.skr b/skribe/doc/skr/env.skr
deleted file mode 100644
index 09d5146..0000000
--- a/skribe/doc/skr/env.skr
+++ /dev/null
@@ -1,32 +0,0 @@
-;*=====================================================================*/
-;*    serrano/prgm/project/skribe/doc/skr/env.skr                      */
-;*    -------------------------------------------------------------    */
-;*    Author      :  Manuel Serrano                                    */
-;*    Creation    :  Mon Sep  1 10:22:42 2003                          */
-;*    Last change :  Thu Jan 29 06:48:54 2004 (serrano)                */
-;*    Copyright   :  2003-04 Manuel Serrano                            */
-;*    -------------------------------------------------------------    */
-;*    The environment variables for the documentation.                 */
-;*=====================================================================*/
-
-(define *serrano-url* "http://www.inria.fr/mimosa/Manuel.Serrano")
-(define *serrano-mail* "Manuel.Serrano@sophia.inria.fr")
-(define *html-url* "http://www.w3.org/TR/html4")
-(define *html-form* "interact/forms.html")
-(define *emacs-url* "http://www.gnu.org/software/emacs")
-(define *xemacs-url* "http://www.xemacs.org")
-(define *texinfo-url* "http://www.texinfo.org")
-(define *r5rs-url* "http://www.inria.fr/mimosa/fp/Bigloo/doc/r5rs.html")
-(define *bigloo-url* "http://www.inria.fr/mimosa/fp/Bigloo")
-(define *skribe-user-doc-url* (string-append (skribe-doc-dir) "/user.html"))
-(define *skribe-dir-doc-url* (string-append (skribe-doc-dir) "/dir.html"))
-
-(define *prgm-width* 97.)
-(define *prgm-skribe-color* "#ffffcc")
-(define *prgm-default-color* "#ffffcc")
-(define *prgm-xml-color* "#ffcccc")
-(define *prgm-example-color* "#ccccff")
-(define *disp-color* "#ccffcc")
-(define *header-color* "#cccccc")
-
-(define *api-engines* (map find-engine '(html latex xml)))
diff --git a/skribe/doc/skr/extension.skr b/skribe/doc/skr/extension.skr
deleted file mode 100644
index ce10ce7..0000000
--- a/skribe/doc/skr/extension.skr
+++ /dev/null
@@ -1,95 +0,0 @@
-;*=====================================================================*/
-;*    serrano/prgm/project/skribe/doc/skr/extension.skr                */
-;*    -------------------------------------------------------------    */
-;*    Author      :  Manuel Serrano                                    */
-;*    Creation    :  Tue Dec 23 07:18:36 2003                          */
-;*    Last change :  Fri Jan  2 21:25:49 2004 (serrano)                */
-;*    Copyright   :  2003-04 Manuel Serrano                            */
-;*    -------------------------------------------------------------    */
-;*    The Skribe package for documenting extensions                    */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;*    extension                                                        */
-;*---------------------------------------------------------------------*/
-(define-markup (extension #!rest opt 
-			  #!key (ident (symbol->string (gensym 'extension)))
-			  (class "extension")
-			  title html-title ending author description 
-			  (env '()))
-   (new document
-      (markup 'extension)
-      (ident ident)
-      (class class)
-      (options (the-options opt))
-      (body (the-body opt))
-      (env (append env
-		   (list (list 'example-counter 0) (list 'example-env '())
-			 (list 'chapter-counter 0) (list 'chapter-env '())
-			 (list 'section-counter 0) (list 'section-env '())
-			 (list 'footnote-counter 0) (list 'footnote-env '())
-			 (list 'figure-counter 0) (list 'figure-env '()))))))
-		  
-;*---------------------------------------------------------------------*/
-;*    html engine                                                      */
-;*---------------------------------------------------------------------*/
-(let ((he (find-engine 'html)))
-   (engine-custom-set! he 'web-book-main-browsing-extra 
-      (lambda (n e)
-	 (let ((i (let ((m (find-markup-ident "Index")))
-		     (and (pair? m) (car m)))))
-	    (if (not i)
-		(table :width 100. :border 0 :cellspacing 0 :cellpadding 0
-		   (tr (td :align 'left :valign 'top (bold "Skribe: "))
-		      (td :align 'right :valign 'top
-			 (ref :url *skribe-dir-doc-url* 
-			    :text "Directory")))
-		   (tr (td)
-		      (td :align 'right :valign 'top
-			 (ref :url *skribe-user-doc-url* 
-			    :text "User Manual"))))
-		(table :width 100. :border 0 :cellspacing 0 :cellpadding 0
-		   (tr (td :align 'left :valign 'top (bold "index:"))
-		      (td :align 'right (ref :handle (handle i))))
-		   (tr (td :align 'left :valign 'top (bold "Skribe: "))
-		      (td :align 'right :valign 'top
-			 (ref :url *skribe-dir-doc-url* 
-			    :text "Directory")))
-		   (tr (td)
-		      (td :align 'right :valign 'top
-			 (ref :url *skribe-user-doc-url* 
-			    :text "User Manual"))))))))
-   (default-engine-set! he))
-
-;*---------------------------------------------------------------------*/
-;*    extension-sui ...                                                */
-;*---------------------------------------------------------------------*/
-(define (extension-sui n e)
-   (define (sui)
-      (display "(sui \"")
-      (skribe-eval (markup-option n :title) html-title-engine)
-      (display "\"\n")
-      (printf "  :file ~s\n" (sui-referenced-file n e))
-      (printf "  :description ~s\n" (markup-option n :description))
-      (sui-marks n e)
-      (display "  )\n"))
-   (if (string? *skribe-dest*)
-       (let ((f (format "~a.sui" (prefix *skribe-dest*))))
-	  (with-output-to-file f sui))
-       (sui)))
-
-;*---------------------------------------------------------------------*/
-;*    project ...                                                      */
-;*---------------------------------------------------------------------*/
-(markup-writer 'extension
-   :options '(:title :html-title :ending :author :description)
-   :action (lambda (n e)
-	      (output n e (markup-writer-get 'document he)))
-   :after (lambda (n e)
-	     (if (engine-custom e 'emit-sui)
-		 (extension-sui n e))))
-
-;*---------------------------------------------------------------------*/
-;*    Restore the base engine                                          */
-;*---------------------------------------------------------------------*/
-(default-engine-set! (find-engine 'base))
diff --git a/skribe/doc/skr/manual.skr b/skribe/doc/skr/manual.skr
deleted file mode 100644
index 1982237..0000000
--- a/skribe/doc/skr/manual.skr
+++ /dev/null
@@ -1,281 +0,0 @@
-;*=====================================================================*/
-;*    serrano/prgm/project/skribe/doc/skr/manual.skr                   */
-;*    -------------------------------------------------------------    */
-;*    Author      :  Manuel Serrano                                    */
-;*    Creation    :  Mon Sep  1 11:24:19 2003                          */
-;*    Last change :  Mon Sep 13 19:18:48 2004 (serrano)                */
-;*    Copyright   :  2003-04 Manuel Serrano                            */
-;*    -------------------------------------------------------------    */
-;*    Skribe manuals and documentation pages style                     */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;*    Base configuration                                               */
-;*---------------------------------------------------------------------*/
-(let ((be (find-engine 'base)))
-   (markup-writer 'example be
-      :options '(:legend :number)
-      :action (lambda (n e)
-		 (let ((ident (markup-ident n))
-		       (number (markup-option n :number))
-		       (legend (markup-option n :legend)))
-		    (skribe-eval (mark ident) e)
-		    (skribe-eval (center
-				  (markup-body n)
-				  (if number (bold (format "Ex. ~a: " number)))
-				  legend)
-				 e)))))
-
-;*---------------------------------------------------------------------*/
-;*    html-browsing-extra ...                                          */
-;*---------------------------------------------------------------------*/
-(define (html-browsing-extra n e)
-   (let ((i1 (let ((m (find-markup-ident "Index")))
-		(and (pair? m) (car m))))
-	 (i2 (let ((m (find-markup-ident "markups-index")))
-		(and (pair? m) (car m)))))
-      (cond
-	 ((not i1)
-	  (skribe-error 'left-margin "Can't find section" "Index"))
-	 ((not i2)
-	  (skribe-error 'left-margin "Can't find chapter" "Standard Markups"))
-	 (else
-	  (table :width 100.
-	     :border 0
-	     :cellspacing 0 :cellpadding 0
-	     (tr (td :align 'left :valign 'top (bold "index:"))
-		(td :align 'right (ref :handle (handle i1) :text "Global")))
-	     (tr (td :align 'left :valign 'top (bold "markups:"))
-		(td :align 'right (ref :handle (handle i2) :text "Index")))
-	     (tr (td :align 'left :valign 'top (bold "extensions:"))
-		(td :align 'right (ref :url *skribe-dir-doc-url* 
-				     :text "Directory"))))))))
-
-;*---------------------------------------------------------------------*/
-;*    Html configuration                                               */
-;*---------------------------------------------------------------------*/
-(let* ((he (find-engine 'html))
-       (bd (markup-writer-get 'bold he)))
-   (markup-writer 'bold he
-		  :class 'api-proto-ident
-		  :before "<font color=\"red\">"
-		  :action (lambda (n e) (output n e bd))
-		  :after "</font>")
-   (engine-custom-set! he 'web-book-main-browsing-extra html-browsing-extra)
-   (engine-custom-set! he 'favicon "lambda.gif"))
-
-;*---------------------------------------------------------------------*/
-;*    LaTeX                                                            */
-;*---------------------------------------------------------------------*/
-(let* ((le (find-engine 'latex))
-       (opckg (engine-custom le 'usepackage))
-       (lpckg "\\usepackage{fullpage}\n\\usepackage{eurosym}\n")
-       (npckg (if (string? opckg)
-		  (string-append lpckg opckg)
-		  lpckg)))
-   (engine-custom-set! le 'documentclass "\\documentclass{book}")
-   (engine-custom-set! le 'usepackage npckg))
-
-;*---------------------------------------------------------------------*/
-;*    prgm ...                                                         */
-;*---------------------------------------------------------------------*/
-(define-markup (prgm #!rest opts #!key (language skribe) (line #f) (file #f) (definition #f))
-   (let* ((c (cond
-		((eq? language skribe) *prgm-skribe-color*)
-		((eq? language xml) *prgm-xml-color*)
-		(else *prgm-default-color*)))
-	  (sc (cond
-		 ((and file definition)
-		  (source :language language :file file :definition definition))
-		 (file
-		  (source :language language :file file))
-		 (else
-		  (source :language language (the-body opts)))))
-	  (pr (cond
-		 (line
-		  (prog :line line sc))
-		 (else
-		  (pre sc)))))
-      (center
-       (frame :margin 5 :border 0 :width *prgm-width*
-	      (color :margin 5 :width 100. :bg c pr)))))
-
-;*---------------------------------------------------------------------*/
-;*    disp ...                                                         */
-;*---------------------------------------------------------------------*/
-(define-markup (disp #!rest opts #!key (verb #f) (line #f) (bg *disp-color*))
-   (if (engine-format? "latex")
-       (if verb 
-	   (pre (the-body opts))
-	   (the-body opts))
-       (center
-	  (frame :margin 5 :border 0 :width *prgm-width*
-	     (color :margin 5 :width 100. :bg bg
-		(if verb 
-		    (pre (the-body opts))
-		    (the-body opts)))))))
-
-;*---------------------------------------------------------------------*/
-;*    keyword ...                                                      */
-;*---------------------------------------------------------------------*/
-(define-markup (keyword arg)
-   (new markup
-      (markup '&source-key)
-      (body (cond
-	       ((keyword? arg)
-		(keyword->string arg))
-	       ((symbol? arg)
-		(string-append ":" (symbol->string arg)))
-	       (else
-		arg)))))
-
-;*---------------------------------------------------------------------*/
-;*    param ...                                                        */
-;*---------------------------------------------------------------------*/
-(define-markup (param arg)
-   (cond
-      ((keyword? arg)
-       (keyword arg))
-      ((symbol? arg)
-       (code (symbol->string arg)))
-      (else
-       arg)))
-
-;*---------------------------------------------------------------------*/
-;*    example ...                                                      */
-;*---------------------------------------------------------------------*/
-(define-markup (example #!rest opts #!key legend class)
-   (new container
-      (markup 'example)
-      (ident (symbol->string (gensym 'example)))
-      (class class)
-      (required-options '(:legend :number))
-      (options `((:number
-		  ,(new unresolved
-		      (proc (lambda (n e env)
-			       (resolve-counter n env 'example #t)))))
-		 ,@(the-options opts :ident :class)))
-      (body (the-body opts))))
-
-;*---------------------------------------------------------------------*/
-;*    example-produce ...                                              */
-;*---------------------------------------------------------------------*/
-(define-markup (example-produce example . produce)
-   (list (it "Example:")
-	 example
-	 (if (pair? produce)
-	     (list (paragraph "Produces:") (car produce)))))
-
-;*---------------------------------------------------------------------*/
-;*    markup-ref ...                                                   */
-;*---------------------------------------------------------------------*/
-(define-markup (markup-ref mk)
-   (ref :mark mk :text (code mk)))
-
-;*---------------------------------------------------------------------*/
-;*    &the-index ...                                                   */
-;*---------------------------------------------------------------------*/
-(markup-writer '&the-index
-   :class 'markup-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)))
-		    (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 b))))
-	      (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)
-			      (loop (cdr ie) #f))))))
-	      (define (make-sub-tables ie nc p)
-		 (define (split-list l num)
-		    (let loop ((l l)
-			       (i 0)
-			       (acc '())
-			       (res '()))
-		       (cond
-			  ((null? l)
-			   (reverse! (cons (reverse! acc) res)))
-			  ((= i num)
-			   (loop l
-				 0
-				 '()
-				 (cons (reverse! acc) res)))
-			  (else
-			   (loop (cdr l)
-				 (+ i 1)
-				 (cons (car l) acc)
-				 res)))))
-		 (let* ((l (length ie))
-			(w (/ 100. nc))
-			(iepc (let ((d (/ l nc)))
-				 (if (integer? d) 
-				     (inexact->exact d)
-				     (+ 1 (inexact->exact (truncate d))))))
-			(split (split-list 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))
-		     (pref (eq? (engine-custom e 'index-page-ref) #t))
-		     (loc (ast-loc n))
-		     (t (cond
-			   ((null? ie)
-			    "")
-			   ((or (not (integer? nc)) (= nc 1))
-			    (table :width 100. :&skribe-eval-location loc
-			       (make-column ie pref)))
-			   (else
-			    (table :width 100. :&skribe-eval-location loc
-			       (make-sub-tables ie nc pref))))))
-		 (output (skribe-eval t e) e))))
-
-;*---------------------------------------------------------------------*/
-;*    compiler-command ...                                             */
-;*---------------------------------------------------------------------*/
-(define-markup (compiler-command bin . opts)
-   (disp :verb #t 
-	 (color :fg "red" (bold bin))
-	 (map (lambda (o)
-		 (list " [" (it o) "]"))
-	      opts)
-	 "..."))
-
-;*---------------------------------------------------------------------*/
-;*    compiler-options ...                                             */
-;*---------------------------------------------------------------------*/
-(define-markup (compiler-options bin)
-   (skribe-message "  [executing: ~a --options]\n" bin)
-   (let ((port (open-input-file (format "| ~a --options" bin))))
-      (let ((opts (read port)))
-	 (close-input-port port)
-	 (apply description (map (lambda (opt) (item :key (bold (car opt))
-						     (cadr opt) "."))
-				 opts)))))
-- 
cgit v1.2.3