Initial import of Skribe 1.2d.

Initial import of Skribe 1.2d.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0

7 files changed, 2040 insertions, 0 deletions

diff --git a/skribe/src/common/api.scm b/skribe/src/common/api.scm
new file mode 100644
index 0000000..397ba09
--- /dev/null
+++ b/skribe/src/common/api.scm
@@ -0,0 +1,1243 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/src/common/api.scm                   */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Mon Jul 21 18:11:56 2003                          */
+;*    Last change :  Mon Dec 20 10:38:23 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The Scribe API                                                   */
+;*    -------------------------------------------------------------    */
+;*    Implementation: @label api@                                      */
+;*       bigloo: @path ../bigloo/api.bgl@                              */
+;*    Documentation:                                                   */
+;*       @path ../../doc/user/markup.skb@                              */
+;*       @path ../../doc/user/document.skb@                            */
+;*       @path ../../doc/user/sectioning.skb@                          */
+;*       @path ../../doc/user/toc.skb@                                 */
+;*       @path ../../doc/user/ornament.skb@                            */
+;*       @path ../../doc/user/line.skb@                                */
+;*       @path ../../doc/user/font.skb@                                */
+;*       @path ../../doc/user/justify.skb@                             */
+;*       @path ../../doc/user/enumeration.skb@                         */
+;*       @path ../../doc/user/colframe.skb@                            */
+;*       @path ../../doc/user/figure.skb@                              */
+;*       @path ../../doc/user/image.skb@                               */
+;*       @path ../../doc/user/table.skb@                               */
+;*       @path ../../doc/user/footnote.skb@                            */
+;*       @path ../../doc/user/char.skb@                                */
+;*       @path ../../doc/user/links.skb@                               */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    include ...                                                      */
+;*---------------------------------------------------------------------*/
+(define-markup (include file)
+   (if (not (string? file))
+       (skribe-error 'include "Illegal file (string expected)" file)
+       (skribe-include file)))
+ 
+;*---------------------------------------------------------------------*/
+;*    document ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (document #!rest
+			 opts
+  			 #!key
+			 (ident #f) (class "document")
+			 (title #f) (html-title #f) (author #f)
+			 (ending #f) (env '()))
+   (new document
+      (markup 'document)
+      (ident (or ident
+		 (ast->string title)
+		 (symbol->string (gensym 'document))))
+      (class class)
+      (required-options '(:title :author :ending))
+      (options (the-options opts :ident :class :env))
+      (body (the-body opts))
+      (env (append env
+		   (list (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 '()))))))
+
+;*---------------------------------------------------------------------*/
+;*    author ...                                                       */
+;*---------------------------------------------------------------------*/
+(define-markup (author #!rest
+		       opts
+		       #!key
+		       (ident #f) (class "author")
+		       name
+		       (title #f)
+		       (affiliation #f)
+		       (email #f)
+		       (url #f)
+		       (address #f)
+		       (phone #f)
+		       (photo #f)
+		       (align 'center))
+   (if (not (memq align '(center left right)))
+       (skribe-error 'author "Illegal align value" align)
+       (new container
+	  (markup 'author)
+	  (ident (or ident (symbol->string (gensym 'author))))
+	  (class class)
+	  (required-options '(:name :title :affiliation :email :url :address :phone :photo :align))
+	  (options `((:name ,name)
+		     (:align ,align)
+		     ,@(the-options opts :ident :class)))
+	  (body #f))))
+
+;*---------------------------------------------------------------------*/
+;*    toc ...                                                          */
+;*---------------------------------------------------------------------*/
+(define-markup (toc #!rest
+		    opts
+		    #!key
+		    (ident #f) (class "toc")
+		    (chapter #t) (section #t) (subsection #f))
+   (let ((body (the-body opts)))
+      (new container
+	 (markup 'toc)
+	 (ident (or ident (symbol->string (gensym 'toc))))
+	 (class class)
+	 (required-options '())
+	 (options `((:chapter ,chapter)
+		    (:section ,section)
+		    (:subsection ,subsection)
+		    ,@(the-options opts :ident :class)))
+	 (body (cond
+		  ((null? body)
+		   (new unresolved
+		      (proc (lambda (n e env)
+			       (handle
+				(resolve-search-parent n env document?))))))
+		  ((null? (cdr body))
+		   (if (handle? (car body))
+		       (car body)
+		       (skribe-error 'toc
+				     "Illegal argument (handle expected)"
+				     (if (markup? (car body))
+					 (markup-markup (car body))
+					 "???"))))
+		  (else
+		   (skribe-error 'toc "Illegal argument" body)))))))
+
+;*---------------------------------------------------------------------*/
+;*    chapter ... ...                                                  */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/sectioning.skb:chapter@                   */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:chapter@                        */
+;*---------------------------------------------------------------------*/
+(define-markup (chapter #!rest
+			opts
+			#!key
+			(ident #f) (class "chapter")
+			title (html-title #f) (file #f) (toc #t) (number #t))
+   (new container
+      (markup 'chapter)
+      (ident (or ident (ast->string title)))
+      (class class)
+      (required-options '(:title :file :toc :number))
+      (options `((:toc ,toc)
+		 (:number ,(and number
+				(new unresolved
+				   (proc (lambda (n e env)
+					    (resolve-counter n
+							     env
+							     'chapter
+							     number))))))
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))
+      (env (list (list 'section-counter 0) (list 'section-env '())
+		 (list 'footnote-counter 0) (list 'footnote-env '())))))
+
+;*---------------------------------------------------------------------*/
+;*    section-number ...                                               */
+;*---------------------------------------------------------------------*/
+(define (section-number number markup)
+   (and number
+	(new unresolved
+	   (proc (lambda (n e env)
+		    (resolve-counter n env markup number))))))
+
+;*---------------------------------------------------------------------*/
+;*    section ...                                                      */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/sectioning.skb:section@                   */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:sectionr@                       */
+;*---------------------------------------------------------------------*/
+(define-markup (section #!rest
+			opts
+			#!key
+			(ident #f) (class "section")
+			title (file #f) (toc #t) (number #t))
+   (new container
+      (markup 'section)
+      (ident (or ident (ast->string title)))
+      (class class)
+      (required-options '(:title :toc :file :toc :number))
+      (options `((:number ,(section-number number 'section))
+		 (:toc ,toc)
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))
+      (env (if file
+	       (list (list 'subsection-counter 0) (list 'subsection-env '())
+		     (list 'footnote-counter 0) (list 'footnote-env '()))
+	       (list (list 'subsection-counter 0) (list 'subsection-env '()))))))
+
+;*---------------------------------------------------------------------*/
+;*    subsection ...                                                   */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/sectioning.skb:subsection@                */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:subsectionr@                    */
+;*---------------------------------------------------------------------*/
+(define-markup (subsection #!rest
+			   opts
+			   #!key
+			   (ident #f) (class "subsection")
+			   title (file #f) (toc #t) (number #t))
+   (new container
+      (markup 'subsection)
+      (ident (or ident (ast->string title)))
+      (class class)
+      (required-options '(:title :toc :file :number))
+      (options `((:number ,(section-number number 'subsection))
+		 (:toc ,toc)
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))
+      (env (list (list 'subsubsection-counter 0) (list 'subsubsection-env '())))))
+
+;*---------------------------------------------------------------------*/
+;*    subsubsection ...                                                */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/sectioning.skb:subsubsection@             */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:subsubsectionr@                 */
+;*---------------------------------------------------------------------*/
+(define-markup (subsubsection #!rest
+			      opts
+			      #!key
+			      (ident #f) (class "subsubsection")
+			      title (file #f) (toc #f) (number #t))
+   (new container
+      (markup 'subsubsection)
+      (ident (or ident (ast->string title)))
+      (class class)
+      (required-options '(:title :toc :number :file))
+      (options `((:number ,(section-number number 'subsubsection))
+		 (:toc ,toc)
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    paragraph ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-simple-markup paragraph)
+
+;*---------------------------------------------------------------------*/
+;*    footnote ...                                                     */
+;*---------------------------------------------------------------------*/
+(define-markup (footnote #!rest opts
+			 #!key (ident #f) (class "footnote") (number #f))
+   (new container
+      (markup 'footnote)
+      (ident (symbol->string (gensym 'footnote)))
+      (class class)
+      (required-options '())
+      (options `((:number
+		  ,(new unresolved
+		      (proc (lambda (n e env)
+			       (resolve-counter n env 'footnote #t)))))
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    linebreak ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (linebreak #!rest opts #!key (ident #f) (class #f))
+   (let ((ln (new markup
+		(ident (or ident (symbol->string (gensym 'linebreak))))
+		(class class)
+		(markup 'linebreak)))
+	 (num (the-body opts)))
+      (cond
+	 ((null? num)
+	  ln)
+	 ((not (null? (cdr num)))
+	  (skribe-error 'linebreak "Illegal arguments" num))
+	 ((not (and (integer? (car num)) (positive? (car num))))
+	  (skribe-error 'linebreak "Illegal argument" (car num)))
+	 (else
+	  (vector->list (make-vector (car num) ln))))))
+
+;*---------------------------------------------------------------------*/
+;*    hrule ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (hrule #!rest
+		      opts
+		      #!key
+		      (ident #f) (class #f)
+		      (width 100.) (height 1))
+   (new markup
+      (markup 'hrule)
+      (ident (or ident (symbol->string (gensym 'hrule))))
+      (class class)
+      (required-options '())
+      (options `((:width ,width)
+		 (:height ,height)
+		 ,@(the-options opts :ident :class)))
+      (body #f)))
+
+;*---------------------------------------------------------------------*/
+;*    color ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (color #!rest
+		      opts
+		      #!key
+		      (ident #f) (class "color")
+		      (bg #f) (fg #f) (width #f) (margin #f))
+   (new container
+      (markup 'color)
+      (ident (or ident (symbol->string (gensym 'color))))
+      (class class)
+      (required-options '(:bg :fg :width))
+      (options `((:bg ,(if bg (skribe-use-color! bg) bg))
+		 (:fg ,(if fg (skribe-use-color! fg) fg))
+		 ,@(the-options opts :ident :class :bg :fg)))
+      (body (the-body opts))))
+		    
+;*---------------------------------------------------------------------*/
+;*    frame ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (frame #!rest
+		      opts
+		      #!key
+		      (ident #f) (class "frame")
+		      (width #f) (margin 2) (border 1))
+   (new container
+      (markup 'frame)
+      (ident (or ident (symbol->string (gensym 'frame))))
+      (class class)
+      (required-options '(:width :border :margin))
+      (options `((:margin ,margin)
+		 (:border ,(cond
+			      ((integer? border) border)
+			      (border 1)
+			      (else #f)))
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    font ...                                                         */
+;*---------------------------------------------------------------------*/
+(define-markup (font #!rest
+		     opts
+		     #!key
+		     (ident #f) (class #f)
+		     (size #f) (face #f))
+   (new container
+      (markup 'font)
+      (ident (or ident (symbol->string (gensym 'font))))
+      (class class)
+      (required-options '(:size))
+      (options (the-options opts :ident :class))
+      (body (the-body opts))))
+   
+;*---------------------------------------------------------------------*/
+;*    flush ...                                                        */
+;*---------------------------------------------------------------------*/
+(define-markup (flush #!rest
+		      opts
+		      #!key
+		      (ident #f) (class #f)
+		      side)
+   (case side
+      ((center left right)
+       (new container
+	  (markup 'flush)
+	  (ident (or ident (symbol->string (gensym 'flush))))
+	  (class class)
+	  (required-options '(:side))
+	  (options (the-options opts :ident :class))
+	  (body (the-body opts))))
+      (else
+       (skribe-error 'flush "Illegal side" side))))
+
+;*---------------------------------------------------------------------*/
+;*    center ...                                                       */
+;*---------------------------------------------------------------------*/
+(define-simple-container center)
+
+;*---------------------------------------------------------------------*/
+;*    pre ...                                                          */
+;*---------------------------------------------------------------------*/
+(define-simple-container pre)
+
+;*---------------------------------------------------------------------*/
+;*    prog ...                                                         */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/prgm.skb:prog@                            */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:prog@                           */
+;*---------------------------------------------------------------------*/
+(define-markup (prog #!rest
+		     opts
+		     #!key
+		     (ident #f) (class "prog")
+		     (line 1) (linedigit #f) (mark ";!"))
+   (if (not (or (string? mark) (eq? mark #f)))
+       (skribe-error 'prog "Illegal mark" mark)
+       (new container
+	  (markup 'prog)
+	  (ident (or ident (symbol->string (gensym 'prog))))
+	  (class class)
+	  (required-options '(:line :mark))
+	  (options (the-options opts :ident :class :linedigit))
+	  (body (make-prog-body (the-body opts) line linedigit mark)))))
+
+;*---------------------------------------------------------------------*/
+;*    source ...                                                       */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/prgm.skb:source@                          */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:source@                         */
+;*---------------------------------------------------------------------*/
+(define-markup (source #!rest
+		       opts
+		       #!key
+		       language
+		       (file #f) (start #f) (stop #f)
+		       (definition #f) (tab 8))
+   (let ((body (the-body opts)))
+      (cond
+	 ((and (not (null? body)) (or file start stop definition))
+	  (skribe-error 'source
+			"file, start/stop, and definition are exclusive with body"
+			body))
+	 ((and start stop definition)
+	  (skribe-error 'source
+			"start/stop are exclusive with a definition"
+			body))
+	 ((and (or start stop definition) (not file))
+	  (skribe-error 'source
+			"start/stop and definition require a file specification"
+			file))
+	 ((and definition (not language))
+	  (skribe-error 'source
+			"definition requires a language specification"
+			definition))
+	 ((and file (not (string? file)))
+	  (skribe-error 'source "Illegal file" file))
+	 ((and start (not (or (integer? start) (string? start))))
+	  (skribe-error 'source "Illegal start" start))
+	 ((and stop (not (or (integer? stop) (string? stop))))
+	  (skribe-error 'source "Illegal start" stop))
+	 ((and (integer? start) (integer? stop) (> start stop))
+	  (skribe-error 'source
+			"start line > stop line"
+			(format "~a/~a" start stop)))
+	 ((and language (not (language? language)))
+	  (skribe-error 'source "Illegal language" language))
+	 ((and tab (not (integer? tab)))
+	  (skribe-error 'source "Illegal tab" tab))
+	 (file
+	  (let ((s (if (not definition)
+		       (source-read-lines file start stop tab)
+		       (source-read-definition file definition tab language))))
+	     (if language
+		 (source-fontify s language)
+		 s)))
+	 (language
+	  (source-fontify body language))
+	 (else
+	  body))))
+	  
+;*---------------------------------------------------------------------*/
+;*    language ...                                                     */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/prgm.skb:language@                        */
+;*---------------------------------------------------------------------*/
+(define-markup (language #!key name (fontifier #f) (extractor #f))
+   (if (not (string? name))
+       (skribe-type-error 'language "Illegal name, " name "string")
+       (new language
+	  (name name)
+	  (fontifier fontifier)
+	  (extractor extractor))))
+   
+;*---------------------------------------------------------------------*/
+;*    figure ...                                                       */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/figure.skb:figure@                        */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:figure@                         */
+;*---------------------------------------------------------------------*/
+(define-markup (figure #!rest
+		       opts
+		       #!key
+		       (ident #f) (class "figure")
+		       (legend #f) (number #t) (multicolumns #f))
+   (new container
+      (markup 'figure)
+      (ident (or ident
+		 (let ((s (ast->string legend)))
+		    (if (not (string=? s ""))
+			s
+			(symbol->string (gensym 'figure))))))
+      (class class)
+      (required-options '(:legend :number :multicolumns))
+      (options `((:number
+		  ,(new unresolved
+		      (proc (lambda (n e env)
+			       (resolve-counter n env 'figure number)))))
+		 ,@(the-options opts :ident :class)))
+      (body (the-body opts))))
+   
+;*---------------------------------------------------------------------*/
+;*    parse-list-of ...                                                */
+;*    -------------------------------------------------------------    */
+;*    The function table accepts two different prototypes. It          */
+;*    may receive its N elements in a list of N elements or in         */
+;*    a list of one element which is a list of N elements. This        */
+;*    gets rid of APPLY when calling container markup such as ITEMIZE  */
+;*    or TABLE.                                                        */
+;*---------------------------------------------------------------------*/
+(define (parse-list-of for markup lst)
+   (cond
+      ((null? lst)
+       '())
+      ((and (pair? lst)
+	    (or (pair? (car lst)) (null? (car lst)))
+	    (null? (cdr lst)))
+       (parse-list-of for markup (car lst)))
+      (else
+       (let loop ((lst lst))
+	  (cond
+	     ((null? lst)
+	      '())
+	     ((pair? (car lst))
+	      (loop (car lst)))
+	     (else
+	      (let ((r (car lst)))
+		 (if (not (is-markup? r markup))
+		     (skribe-warning 2
+				     for
+				     (format "Illegal `~a' element, `~a' expected"
+					     (if (markup? r)
+						 (markup-markup r)
+						 (find-runtime-type r))
+					     markup)))
+		 (cons r (loop (cdr lst))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    itemize ...                                                      */
+;*---------------------------------------------------------------------*/
+(define-markup (itemize #!rest opts #!key (ident #f) (class "itemize") symbol)
+   (new container
+      (markup 'itemize)
+      (ident (or ident (symbol->string (gensym 'itemize))))
+      (class class)
+      (required-options '(:symbol))
+      (options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
+      (body (parse-list-of 'itemize 'item (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    enumerate ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (enumerate #!rest opts #!key (ident #f) (class "enumerate") symbol)
+   (new container
+      (markup 'enumerate)
+      (ident (or ident (symbol->string (gensym 'enumerate))))
+      (class class)
+      (required-options '(:symbol))
+      (options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
+      (body (parse-list-of 'enumerate 'item (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    description ...                                                  */
+;*---------------------------------------------------------------------*/
+(define-markup (description #!rest opts #!key (ident #f) (class "description") symbol)
+   (new container
+      (markup 'description)
+      (ident (or ident (symbol->string (gensym 'description))))
+      (class class)
+      (required-options '(:symbol))
+      (options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
+      (body (parse-list-of 'description 'item (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    item ...                                                         */
+;*---------------------------------------------------------------------*/
+(define-markup (item #!rest opts #!key (ident #f) (class #f) key)
+   (if (and key (not (or (string? key)
+			 (number? key)
+			 (markup? key)
+			 (pair? key))))
+       (skribe-type-error 'item "Illegal key:" key "node")
+       (new container
+	  (markup 'item)
+	  (ident (or ident (symbol->string (gensym 'item))))
+	  (class class)
+	  (required-options '(:key))
+	  (options `((:key ,key) ,@(the-options opts :ident :class :key)))
+	  (body (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    table                                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (table #!rest
+		      opts
+		      #!key
+		      (ident #f) (class #f)
+		      (border #f) (width #f)
+		      (frame 'none) (rules 'none)
+		      (cellstyle 'collapse) (cellpadding #f) (cellspacing #f))
+   (let ((frame (cond
+		   ((string? frame)
+		    (string->symbol frame))
+		   ((not frame)
+		    #f)
+		   (else
+		    frame)))
+	 (rules (cond
+		   ((string? rules)
+		    (string->symbol rules))
+		   ((not rules)
+		    #f)
+		   (else
+		    rules)))
+	 (frame-vals '(none above below hsides vsides lhs rhs box border))
+	 (rules-vals '(none rows cols all header))
+	 (cells-vals '(collapse separate)))
+      (cond
+	 ((and frame (not (memq frame frame-vals)))
+	  (skribe-error 'table
+			(format "frame should be one of \"~a\"" frame-vals)
+			frame))
+	 ((and rules (not (memq rules rules-vals)))
+	  (skribe-error 'table
+			(format "rules should be one of \"~a\"" rules-vals)
+			rules))
+	 ((not (or (memq cellstyle cells-vals)
+		   (string? cellstyle)
+		   (number? cellstyle)))
+	  (skribe-error 'table
+			(format "cellstyle should be one of \"~a\", or a number, or a string" cells-vals)
+			cellstyle))
+	 (else
+	  (new container
+	     (markup 'table)
+	     (ident (or ident (symbol->string (gensym 'table))))
+	     (class class)
+	     (required-options '(:width :frame :rules))
+	     (options `((:frame ,frame)
+			(:rules ,rules)
+			(:cellstyle ,cellstyle)
+			,@(the-options opts :ident :class)))
+	     (body (parse-list-of 'table 'tr (the-body opts))))))))
+
+;*---------------------------------------------------------------------*/
+;*    tr ...                                                           */
+;*---------------------------------------------------------------------*/
+(define-markup (tr #!rest opts #!key (ident #f) (class #f) (bg #f))
+   (new container
+      (markup 'tr)
+      (ident (or ident (symbol->string (gensym 'tr))))
+      (class class)
+      (required-options '())
+      (options `(,@(if bg `((:bg ,(if bg (skribe-use-color! bg) bg))) '())
+		 ,@(the-options opts :ident :class :bg)))
+      (body (parse-list-of 'tr 'tc (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    tc...                                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (tc m
+		   #!rest
+		   opts
+		   #!key
+		   (ident #f) (class #f)
+		   (width #f) (align 'center) (valign #f)
+		   (colspan 1) (bg #f))
+   (let ((align (if (string? align)
+		    (string->symbol align)
+		    align))
+	 (valign (if (string? valign)
+		     (string->symbol valign)
+		     valign)))
+      (cond
+	 ((not (integer? colspan))
+	  (skribe-type-error 'tc "Illegal colspan, " colspan "integer"))
+	 ((not (symbol? align))
+	  (skribe-type-error 'tc "Illegal align, " align "align"))
+	 ((not (memq align '(#f center left right)))
+	  (skribe-error
+	   'tc
+	   "align should be one of 'left', `center', or `right'"
+	   align))
+	 ((not (memq valign '(#f top middle center bottom)))
+	  (skribe-error
+	   'tc
+	   "valign should be one of 'top', `middle', `center', or `bottom'"
+	   valign))
+	 (else
+	  (new container
+	     (markup 'tc)
+	     (ident (or ident (symbol->string (gensym 'tc))))
+	     (class class)
+	     (required-options '(:width :align :valign :colspan))
+	     (options `((markup ,m)
+			(:align ,align)
+			(:valign ,valign)
+			(:colspan ,colspan)
+			,@(if bg
+			      `((:bg ,(if bg (skribe-use-color! bg) bg)))
+			      '())
+			,@(the-options opts :ident :class :bg :align :valign)))
+	     (body (the-body opts)))))))
+
+;*---------------------------------------------------------------------*/
+;*    th ...                                                           */
+;*---------------------------------------------------------------------*/
+(define-markup (th #!rest
+		   opts
+		   #!key
+		   (ident #f) (class #f)
+		   (width #f) (align 'center) (valign #f)
+		   (colspan 1) (bg #f))
+   (apply tc 'th opts))
+
+;*---------------------------------------------------------------------*/
+;*    td ...                                                           */
+;*---------------------------------------------------------------------*/
+(define-markup (td #!rest
+		   opts
+		   #!key
+		   (ident #f) (class #f)
+		   (width #f) (align 'center) (valign #f)
+		   (colspan 1) (bg #f))
+   (apply tc 'td opts))
+
+;*---------------------------------------------------------------------*/
+;*    image ...                                                        */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/image.skb:image@                          */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:image@                          */
+;*       latex: @ref ../../skr/latex.skr:image@                        */
+;*---------------------------------------------------------------------*/
+(define-markup (image #!rest
+		      opts
+		      #!key
+		      (ident #f) (class #f)
+		      file (url #f) (width #f) (height #f) (zoom #f))
+   (cond
+      ((not (or (string? file) (string? url)))
+       (skribe-error 'image "No file or url provided" file))
+      ((and (string? file) (string? url))
+       (skribe-error 'image "Both file and url provided" (list file url)))
+      (else
+       (new markup
+	  (markup 'image)
+	  (ident (or ident (symbol->string (gensym 'image))))
+	  (class class)
+	  (required-options '(:file :url :width :height))
+	  (options (the-options opts :ident :class))
+	  (body (the-body opts))))))
+
+;*---------------------------------------------------------------------*/
+;*    blockquote                                                       */
+;*---------------------------------------------------------------------*/
+(define-simple-markup blockquote)
+
+;*---------------------------------------------------------------------*/
+;*    Ornaments ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-simple-markup roman)
+(define-simple-markup bold)
+(define-simple-markup underline)
+(define-simple-markup strike)
+(define-simple-markup emph)
+(define-simple-markup kbd)
+(define-simple-markup it)
+(define-simple-markup tt)
+(define-simple-markup code)
+(define-simple-markup var)
+(define-simple-markup samp)
+(define-simple-markup sf)
+(define-simple-markup sc)
+(define-simple-markup sub)
+(define-simple-markup sup)
+
+;*---------------------------------------------------------------------*/
+;*    char ...                                                         */
+;*---------------------------------------------------------------------*/
+(define-markup (char char)
+   (cond
+      ((char? char)
+       (string char))
+      ((integer? char)
+       (string (integer->char char)))
+      ((and (string? char) (= (string-length char) 1))
+       char)
+      (else
+       (skribe-error 'char "Illegal char" char))))
+
+;*---------------------------------------------------------------------*/
+;*    symbol ...                                                       */
+;*---------------------------------------------------------------------*/
+(define-markup (symbol symbol)
+   (let ((v (cond
+	       ((symbol? symbol)
+		(symbol->string symbol))
+	       ((string? symbol)
+		symbol)
+	       (else
+		(skribe-error 'symbol
+			      "Illegal argument (symbol expected)"
+			      symbol)))))
+      (new markup
+	 (markup 'symbol)
+	 (body v))))
+
+;*---------------------------------------------------------------------*/
+;*    ! ...                                                            */
+;*---------------------------------------------------------------------*/
+(define-markup (! format #!rest node)
+   (if (not (string? format))
+       (skribe-type-error '! "Illegal format:" format "string")
+       (new command
+	  (fmt format)
+	  (body node))))
+   
+;*---------------------------------------------------------------------*/
+;*    processor ...                                                    */
+;*---------------------------------------------------------------------*/
+(define-markup (processor #!rest opts
+			  #!key (combinator #f) (engine #f) (procedure #f))
+   (cond
+      ((and combinator (not (procedure? combinator)))
+       (skribe-error 'processor "Combinator not a procedure" combinator))
+      ((and engine (not (engine? engine)))
+       (skribe-error 'processor "Illegal engine" engine))
+      ((and procedure
+	    (or (not (procedure? procedure))
+		(not (correct-arity? procedure 2))))
+       (skribe-error 'processor "Illegal procedure" procedure))
+      (else
+       (new processor
+          (combinator combinator)
+	  (engine engine)
+	  (procedure (or procedure (lambda (n e) n)))
+	  (body (the-body opts))))))
+
+;*---------------------------------------------------------------------*/
+;*    Processors ...                                                   */
+;*---------------------------------------------------------------------*/
+(define-processor-markup html-processor)
+(define-processor-markup tex-processor)
+
+;*---------------------------------------------------------------------*/
+;*    handle ...                                                       */
+;*---------------------------------------------------------------------*/
+(define-markup (handle #!rest opts
+		       #!key (ident #f) (class "handle") value section)
+   (let ((body (the-body opts)))
+      (cond
+	 (section
+	  (error 'handle "Illegal handle `section' option" section)
+	  (new unresolved
+	     (proc (lambda (n e env)
+		      (let ((s (resolve-ident section 'section n env)))
+			 (new handle
+			    (ast s)))))))
+	 ((and (pair? body)
+	       (null? (cdr body))
+	       (markup? (car body)))
+	  (new handle
+	     (ast (car body))))
+	 (else
+	  (skribe-error 'handle "Illegal handle" opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    mailto ...                                                       */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/links.skb:mailto@                         */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:mailto@                         */
+;*---------------------------------------------------------------------*/
+(define-markup (mailto #!rest opts #!key (ident #f) (class "mailto") text)
+   (new markup
+      (markup 'mailto)
+      (ident (or ident (symbol->string (gensym 'ident))))
+      (class class)
+      (required-options '(:text))
+      (options (the-options opts :ident :class))
+      (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;*    *mark-table* ...                                                 */
+;*---------------------------------------------------------------------*/
+(define *mark-table* (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;*    mark ...                                                         */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/links.skb:mark@                           */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:mark@                           */
+;*---------------------------------------------------------------------*/
+(define-markup (mark #!rest opts #!key (ident #f) (class "mark") (text #f))
+   (let ((bd (the-body opts)))
+      (cond
+	 ((and (pair? bd) (not (null? (cdr bd))))
+	  (skribe-error 'mark "Too many argument provided" bd))
+	 ((null? bd)
+	  (skribe-error 'mark "Missing argument" '()))
+	 ((not (string? (car bd)))
+	  (skribe-type-error 'mark "Illegal ident:" (car bd) "string"))
+	 (ident
+	  (skribe-error 'mark "Illegal `ident:' option" ident))
+	 (else
+	  (let* ((bs (ast->string bd))
+		 (n (new markup
+		       (markup 'mark)
+		       (ident bs)
+		       (class class)
+		       (options (the-options opts :ident :class :text))
+		       (body text))))
+	     (hashtable-put! *mark-table* bs n)
+	     n)))))
+
+;*---------------------------------------------------------------------*/
+;*    ref ...                                                          */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/links.skb:ref@                            */
+;*    writer:                                                          */
+;*       html: @ref ../../skr/html.skr:ref@                            */
+;*       latex: @ref ../../skr/latex.skr:ref@                          */
+;*---------------------------------------------------------------------*/
+(define-markup (ref #!rest
+		    opts
+		    #!key
+		    (class #f)
+		    (ident #f)
+		    (text #f)
+		    (chapter #f)
+		    (section #f)
+		    (subsection #f)
+		    (subsubsection #f)
+		    (bib #f)
+		    (bib-table (default-bib-table))
+		    (url #f)
+		    (figure #f)
+		    (mark #f)
+		    (handle #f)
+		    (line #f)
+		    (skribe #f)
+		    (page #f))
+   (define (unref ast text kind)
+      (let ((msg (format "Can't find `~a': " kind)))
+	 (if (ast? ast)
+	     (begin
+		(skribe-warning/ast 1 ast 'ref msg text)
+		(new markup
+		   (markup 'unref)
+		   (ident (symbol->string 'unref))
+		   (class class)
+		   (required-options '(:text))
+		   (options `((kind ,kind) ,@(the-options opts :ident :class)))
+		   (body (list text ": " (ast->file-location ast)))))
+	     (begin
+		(skribe-warning 1 'ref msg text)
+		(new markup
+		   (markup 'unref)
+		   (ident (symbol->string 'unref))
+		   (class class)
+		   (required-options '(:text))
+		   (options `((kind ,kind) ,@(the-options opts :ident :class)))
+		   (body text))))))
+   (define (skribe-ref skribe)
+      (let ((path (find-file/path skribe (skribe-path))))
+	 (if (not path)
+	     (unref #f skribe 'sui-file)
+	     (let* ((sui (load-sui path))
+		    (os (the-options opts :skribe :class :text))
+		    (u (sui-ref->url (dirname path) sui ident os)))
+		(if (not u)
+		    (unref #f os 'sui-ref)
+		    (ref :url u :text text :ident ident :class class))))))
+   (define (handle-ref text)
+      (new markup
+	 (markup 'ref)
+	 (ident (symbol->string 'ref))
+	 (class class)
+	 (required-options '(:text))
+	 (options `((kind handle) ,@(the-options opts :ident :class)))
+	 (body text)))
+   (define (doref text kind)
+      (if (not (string? text))
+	  (skribe-type-error 'ref "Illegal reference" text "string")
+	  (new unresolved
+	     (proc (lambda (n e env)
+		      (let ((s (resolve-ident text kind n env)))
+			 (if s
+			     (new markup
+				(markup 'ref)
+				(ident (symbol->string 'ref))
+				(class class)
+				(required-options '(:text))
+				(options `((kind ,kind)
+					   (mark ,text)
+					   ,@(the-options opts :ident :class)))
+				(body (new handle
+					 (ast s))))
+			     (unref n text (or kind 'ident)))))))))
+   (define (mark-ref mark)
+      (if (not (string? mark))
+	  (skribe-type-error 'mark "Illegal mark, " mark "string")
+	  (new unresolved
+	     (proc (lambda (n e env)
+		      (let ((s (hashtable-get *mark-table* mark)))
+			 (if s
+			     (new markup
+				(markup 'ref)
+				(ident (symbol->string 'ref))
+				(class class)
+				(required-options '(:text))
+				(options `((kind mark)
+					   (mark ,mark)
+					   ,@(the-options opts :ident :class)))
+				(body (new handle
+					 (ast s))))
+			     (unref n mark 'mark))))))))
+   (define (make-bib-ref v)
+      (let ((s (resolve-bib bib-table v)))
+	 (if s
+	     (let* ((n (new markup
+			  (markup 'bib-ref)
+			  (ident (symbol->string 'bib-ref))
+			  (class class)
+			  (required-options '(:text))
+			  (options (the-options opts :ident :class))
+			  (body (new handle
+				   (ast s)))))
+		    (h (new handle (ast n)))
+		    (o (markup-option s 'used)))
+		(markup-option-add! s 'used (if (pair? o) (cons h o) (list h)))
+		n)
+	     (unref #f v 'bib))))
+   (define (bib-ref text)
+      (if (pair? text)
+	  (new markup
+	     (markup 'bib-ref+)
+	     (ident (symbol->string 'bib-ref+))
+	     (class class)
+	     (options (the-options opts :ident :class))
+	     (body (map make-bib-ref text)))
+	  (make-bib-ref text)))
+   (define (url-ref)
+      (new markup
+	 (markup 'url-ref)
+	 (ident (symbol->string 'url-ref))
+	 (class class)
+	 (required-options '(:url :text))
+	 (options (the-options opts :ident :class))))
+   (define (line-ref line)
+      (new unresolved
+	 (proc  (lambda (n e env)
+		   (let ((l (resolve-line line)))
+		      (if (pair? l)
+			  (new markup
+			     (markup 'line-ref)
+			     (ident (symbol->string 'line-ref))
+			     (class class)
+			     (options `((:text ,(markup-ident (car l)))
+					,@(the-options opts :ident :class)))
+			     (body (new handle
+				      (ast (car l)))))
+			  (unref n line 'line)))))))
+   (let ((b (the-body opts)))
+      (if (not (null? b))
+	  (skribe-warning 1 'ref "Arguments ignored " b))
+      (cond
+	 (skribe (skribe-ref skribe))
+	 (handle (handle-ref handle))
+	 (ident (doref ident #f))
+	 (chapter (doref chapter 'chapter))
+	 (section (doref section 'section))
+	 (subsection (doref subsection 'subsection))
+	 (subsubsection (doref subsubsection 'subsubsection))
+	 (figure (doref figure 'figure))
+	 (mark (mark-ref mark))
+	 (bib (bib-ref bib))
+	 (url (url-ref))
+	 (line (line-ref line))
+	 (else (skribe-error 'ref "Illegal reference" opts)))))
+
+;*---------------------------------------------------------------------*/
+;*    resolve ...                                                      */
+;*---------------------------------------------------------------------*/
+(define-markup (resolve fun)
+   (new unresolved
+      (proc fun)))
+
+;*---------------------------------------------------------------------*/
+;*    bibliography ...                                                 */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/bib.skb:bibliography@                     */
+;*---------------------------------------------------------------------*/
+(define-markup (bibliography #!rest files
+			     #!key
+			     (command #f) (bib-table (default-bib-table)))
+   (for-each (lambda (f)
+		(cond
+		   ((string? f)
+		    (bib-load! bib-table f command))
+		   ((pair? f)
+		    (bib-add! bib-table f))
+		   (else
+		    (skribe-error "bibliography" "Illegal entry" f))))
+	     (the-body files)))
+
+;*---------------------------------------------------------------------*/
+;*    the-bibliography ...                                             */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/bib.skb:the-bibliography@                 */
+;*    writer:                                                          */
+;*       base: @ref ../../skr/base.skr:the-bibliography@               */
+;*---------------------------------------------------------------------*/
+(define-markup (the-bibliography #!rest opts
+				 #!key
+				 pred
+				 (bib-table (default-bib-table))
+				 (sort bib-sort/authors)
+				 (count 'partial))
+   (if (not (memq count '(partial full)))
+       (skribe-error 'the-bibliography
+		     "Cound must be either `partial' or `full'"
+		     count)
+       (new unresolved
+	  (proc (lambda (n e env)
+		   (resolve-the-bib bib-table
+				    (new handle (ast n))
+				    sort
+				    pred
+				    count
+				    (the-options opts)))))))
+
+;*---------------------------------------------------------------------*/
+;*    make-index ...                                                   */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/index.skb:make-index@                     */
+;*---------------------------------------------------------------------*/
+(define-markup (make-index ident)
+   (make-index-table ident))
+   
+;*---------------------------------------------------------------------*/
+;*    index ...                                                        */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/index.skb:index@                          */
+;*---------------------------------------------------------------------*/
+(define-markup (index #!rest
+		      opts
+		      #!key
+		      (ident #f) (class "index")
+		      (note #f) (index #f) (shape #f)
+		      (url #f))
+   (let* ((entry-name (the-body opts))
+	  (ename (cond
+		    ((string? entry-name)
+		     entry-name)
+		    ((and (pair? entry-name) (every string? entry-name))
+		     (apply string-append entry-name))
+		    (else
+		     (skribe-error
+		      'index
+		      "entry-name must be either a string or a list of strings"
+		      entry-name))))
+	  (table (cond
+		    ((not index) (default-index))
+		    ((index? index) index)
+		    (else (skribe-type-error 'index
+					     "Illegal index table, "
+					     index
+					     "index"))))
+	  (m (mark (symbol->string (gensym))))
+	  (h (new handle (ast m)))
+	  (new (new markup
+		  (markup '&index-entry)
+		  (ident (or ident (symbol->string (gensym 'index))))
+		  (class class)
+		  (options `((name ,ename) ,@(the-options opts :ident :class)))
+		  (body (if url
+			    (ref :url url :text (or shape ename))
+			    (ref :handle h :text (or shape ename)))))))
+      ;; New is bound to a dummy option of the mark in order
+      ;; to make new options verified.
+      (markup-option-add! m 'to-verify new)
+      (hashtable-update! table
+			 ename
+			 (lambda (cur) (cons new cur))
+			 (list new))
+      m))
+
+;*---------------------------------------------------------------------*/
+;*    the-index ...                                                    */
+;*    -------------------------------------------------------------    */
+;*    doc:                                                             */
+;*       @ref ../../doc/user/index.skb:the-index@                      */
+;*    writer:                                                          */
+;*       base: @ref ../../skr/base.skr:the-index@                      */
+;*       html: @ref ../../skr/html.skr:the-index-header@               */
+;*---------------------------------------------------------------------*/
+(define-markup (the-index #!rest
+			  opts
+			  #!key
+			  (ident #f)
+			  (class "the-index")
+			  (split #f)
+			  (char-offset 0)
+			  (header-limit 50)
+			  (column 1))
+   (let ((bd (the-body opts)))
+      (cond
+	 ((not (and (integer? char-offset) (>= char-offset 0)))
+	  (skribe-error 'the-index "Illegal char offset" char-offset))
+	 ((not (integer? column))
+	  (skribe-error 'the-index "Illegal column number" column))
+	 ((not (every? index? bd))
+	  (skribe-error 'the-index
+			"Illegal indexes"
+			(filter (lambda (o) (not (index? o))) bd)))
+	 (else
+	  (new unresolved
+	     (proc (lambda (n e env)
+		      (resolve-the-index (ast-loc n)
+					 ident class
+					 bd
+					 split
+					 char-offset
+					 header-limit
+					 column))))))))
diff --git a/skribe/src/common/bib.scm b/skribe/src/common/bib.scm
new file mode 100644
index 0000000..b73c5f0
--- /dev/null
+++ b/skribe/src/common/bib.scm
@@ -0,0 +1,192 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/src/common/bib.scm                   */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Fri Dec  7 06:12:29 2001                          */
+;*    Last change :  Wed Jan 14 08:02:45 2004 (serrano)                */
+;*    Copyright   :  2001-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    Skribe Bibliography                                              */
+;*    -------------------------------------------------------------    */
+;*    Implementation: @label bib@                                      */
+;*    bigloo: @path ../bigloo/bib.bgl@                                 */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    bib-load! ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (bib-load! table filename command)
+   (if (not (bib-table? table))
+       (skribe-error 'bib-load "Illegal bibliography table" table)
+       ;; read the file
+       (let ((p (skribe-open-bib-file filename command)))
+	  (if (not (input-port? p))
+	      (skribe-error 'bib-load "Can't open data base" filename)
+	      (unwind-protect
+		 (parse-bib table p)
+		 (close-input-port p))))))
+
+;*---------------------------------------------------------------------*/
+;*    resolve-bib ...                                                  */
+;*---------------------------------------------------------------------*/
+(define (resolve-bib table ident)
+   (if (not (bib-table? table))
+       (skribe-error 'resolve-bib "Illegal bibliography table" table)
+       (let* ((i (cond
+		    ((string? ident) ident)
+		    ((symbol? ident) (symbol->string ident))
+		    (else (skribe-error 'resolve-bib "Illegal ident" ident))))
+	      (en (hashtable-get table i)))
+	  (if (is-markup? en '&bib-entry)
+	      en
+	      #f))))
+
+;*---------------------------------------------------------------------*/
+;*    make-bib-entry ...                                               */
+;*---------------------------------------------------------------------*/
+(define (make-bib-entry kind ident fields from)
+   (let* ((m (new markup
+		(markup '&bib-entry)
+		(ident ident)
+		(options `((kind ,kind) (from ,from)))))
+	  (h (new handle
+		(ast m))))
+      (for-each (lambda (f)
+		   (if (and (pair? f)
+			    (pair? (cdr f))
+			    (null? (cddr f))
+			    (symbol? (car f)))
+		       (markup-option-add! m 
+					   (car f)
+					   (new markup
+					      (markup (symbol-append
+						       '&bib-entry-
+						       (car f)))
+					      (parent h)
+					      (body (cadr f))))
+		       (bib-parse-error f)))
+		fields)
+      m))
+
+;*---------------------------------------------------------------------*/
+;*    bib-sort/authors ...                                             */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/authors l)
+   (define (cmp i1 i2 def)
+      (cond
+	 ((and (markup? i1) (markup? i2))
+	  (cmp (markup-body i1) (markup-body i2) def))
+	 ((markup? i1)
+	  (cmp (markup-body i1) i2 def))
+	 ((markup? i2)
+	  (cmp i1 (markup-body i2) def))
+	 ((and (string? i1) (string? i2))
+	  (if (string=? i1 i2)
+	      (def)
+	      (string<? i1 i2)))
+	 ((string? i1)
+	  #f)
+	 ((string? i2)
+	  #t)
+	 (else
+	  (def))))
+   (sort l (lambda (e1 e2)
+	      (cmp (markup-option e1 'author)
+		   (markup-option e2 'author)
+		   (lambda ()
+		      (cmp (markup-option e1 'year)
+			   (markup-option e2 'year)
+			   (lambda ()
+			      (cmp (markup-option e1 'title)
+				   (markup-option e2 'title)
+				   (lambda ()
+				      (cmp (markup-ident e1)
+					   (markup-ident e2)
+					   (lambda ()
+					      #t)))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-sort/idents ...                                              */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/idents l)
+   (sort l (lambda (e f) (string<? (markup-ident e) (markup-ident f)))))
+
+;*---------------------------------------------------------------------*/
+;*    bib-sort/dates ...                                               */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/dates l)
+   (sort l (lambda (p1 p2)
+	      (define (month-num m)
+		 (let ((body (markup-body m)))
+		    (if (not (string? body))
+			13
+			(let* ((s (if (> (string-length body) 3)
+				      (substring body 0 3)
+				      body))
+			       (sy (string->symbol (string-downcase body)))
+			       (c (assq sy '((jan . 1)
+					     (feb . 2)
+					     (mar . 3)
+					     (apr . 4)
+					     (may . 5)
+					     (jun . 6)
+					     (jul . 7)
+					     (aug . 8)
+					     (sep . 9)
+					     (oct . 10)
+					     (nov . 11)
+					     (dec . 12)))))
+			   (if (pair? c) (cdr c) 13)))))
+	      (let ((d1 (markup-option p1 'year))
+		    (d2 (markup-option p2 'year)))
+		 (cond
+		    ((not (markup? d1)) #f)
+		    ((not (markup? d2)) #t)
+		    (else
+		     (let ((y1 (markup-body d1))
+			   (y2 (markup-body d2)))
+			(cond
+			   ((string>? y1 y2) #t)
+			   ((string<? y1 y2) #f)
+			   (else
+			    (let ((d1 (markup-option p1 'month))
+				  (d2 (markup-option p2 'month)))
+			       (cond
+				  ((not (markup? d1)) #f)
+				  ((not (markup? d2)) #t)
+				  (else
+				   (let ((m1 (month-num d1))
+					 (m2 (month-num d2)))
+				      (> m1 m2))))))))))))))
+
+;*---------------------------------------------------------------------*/
+;*    resolve-the-bib ...                                              */
+;*---------------------------------------------------------------------*/
+(define (resolve-the-bib table n sort pred count opts)
+   (define (count! entries)
+      (let loop ((es entries)
+		 (i 1))
+	 (if (pair? es)
+	     (begin
+		(markup-option-add! (car es)
+				    :title
+				    (new markup
+				       (markup '&bib-entry-ident)
+				       (parent (car es))
+				       (options `((number ,i)))
+				       (body (new handle
+						(ast (car es))))))
+		(loop (cdr es) (+ i 1))))))
+   (if (not (bib-table? table))
+       (skribe-error 'resolve-the-bib "Illegal bibliography table" table)
+       (let* ((es (sort (hashtable->list table)))
+	      (fes (filter (if (procedure? pred)
+			       (lambda (m) (pred m n))
+			       (lambda (m) (pair? (markup-option m 'used))))
+			   es)))
+	  (count! (if (eq? count 'full) es fes))
+	  (new markup
+	     (markup '&the-bibliography)
+	     (options opts)
+	     (body fes)))))
+
diff --git a/skribe/src/common/configure.scm.in b/skribe/src/common/configure.scm.in
new file mode 100644
index 0000000..830ec4d
--- /dev/null
+++ b/skribe/src/common/configure.scm.in
@@ -0,0 +1,6 @@
+(define (skribe-release) "@SKRIBE_RELEASE@")
+(define (skribe-url) "@SKRIBE_URL@")
+(define (skribe-doc-dir) "@SKRIBE_DOC_DIR@")
+(define (skribe-ext-dir) "@SKRIBE_EXT_DIR@")
+(define (skribe-default-path) @SKRIBE_SKR_PATH@)
+(define (skribe-scheme) "@SKRIBE_SCHEME@")
diff --git a/skribe/src/common/index.scm b/skribe/src/common/index.scm
new file mode 100644
index 0000000..65c271f
--- /dev/null
+++ b/skribe/src/common/index.scm
@@ -0,0 +1,126 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/src/common/index.scm                 */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Sun Aug 24 08:01:45 2003                          */
+;*    Last change :  Wed Feb  4 14:58:05 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    Skribe indexes                                                   */
+;*    -------------------------------------------------------------    */
+;*    Implementation: @label index@                                    */
+;*    bigloo: @path ../bigloo/index.bgl@                               */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    index? ...                                                       */
+;*---------------------------------------------------------------------*/
+(define (index? obj)
+   (hashtable? obj))
+
+;*---------------------------------------------------------------------*/
+;*    *index-table* ...                                                */
+;*---------------------------------------------------------------------*/
+(define *index-table* #f)
+
+;*---------------------------------------------------------------------*/
+;*    make-index-table ...                                             */
+;*---------------------------------------------------------------------*/
+(define (make-index-table ident)
+   (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;*    default-index ...                                                */
+;*---------------------------------------------------------------------*/
+(define (default-index)
+   (if (not *index-table*)
+       (set! *index-table* (make-index-table "default-index")))
+   *index-table*)
+
+;*---------------------------------------------------------------------*/
+;*    resolve-the-index ...                                            */
+;*---------------------------------------------------------------------*/
+(define (resolve-the-index loc i c indexes split char-offset header-limit col)
+   ;; fetch the descriminating index name letter
+   (define (index-ref n)
+      (let ((name (markup-option n 'name)))
+	 (if (>= char-offset (string-length name))
+	     (skribe-error 'the-index "char-offset out of bound" char-offset)
+	     (string-ref name char-offset))))
+   ;; sort a bucket of entries (the entries in a bucket share there name)
+   (define (sort-entries-bucket ie)
+      (sort ie 
+	    (lambda (i1 i2)
+	       (or (not (markup-option i1 :note))
+		   (markup-option i2 :note)))))
+   ;; accumulate all the entries starting with the same letter
+   (define (letter-references refs)
+      (let ((letter (index-ref (car (car refs)))))
+	 (let loop ((refs refs)
+		    (acc '()))
+	    (if (or (null? refs)
+		    (not (char-ci=? letter (index-ref (car (car refs))))))
+		(values (char-upcase letter) acc refs)
+		(loop (cdr refs) (cons (car refs) acc))))))
+   ;; merge the buckets that comes from different index tables
+   (define (merge-buckets buckets)
+      (if (null? buckets)
+	  '()
+	  (let loop ((buckets buckets)
+		     (res '()))
+	     (cond
+		((null? (cdr buckets))
+		 (reverse! (cons (car buckets) res)))
+		((string=? (markup-option (car (car buckets)) 'name)
+			   (markup-option (car (cadr buckets)) 'name))
+		 ;; we merge
+		 (loop (cons (append (car buckets) (cadr buckets))
+			     (cddr buckets))
+		       res))
+		(else
+		 (loop (cdr buckets)
+		       (cons (car buckets) res)))))))
+   (let* ((entries (apply append (map hashtable->list indexes)))
+	  (sorted (map sort-entries-bucket
+		       (merge-buckets
+			(sort entries
+			      (lambda (e1 e2)
+				 (string-ci<?
+				  (markup-option (car e1) 'name)
+				  (markup-option (car e2) 'name))))))))
+      (if (and (not split) (< (apply + (map length sorted)) header-limit))
+	  (new markup
+	     (markup '&the-index)
+	     (loc loc)
+	     (ident i)
+	     (class c)
+	     (options `((:column ,col)))
+	     (body sorted))
+	  (let loop ((refs sorted)
+		     (lrefs '())
+		     (body '()))
+	     (if (null? refs)
+		 (new markup
+		    (markup '&the-index)
+		    (loc loc)
+		    (ident i)
+		    (class c)
+		    (options `((:column ,col)
+			       (header ,(new markup
+					   (markup '&the-index-header)
+					   (loc loc)
+					   (body (reverse! lrefs))))))
+		    (body (reverse! body)))
+		 (call-with-values
+		    (lambda () (letter-references refs))
+		    (lambda (l lr next-refs)
+		       (let* ((s (string l))
+			      (m (mark (symbol->string (gensym s)) :text s))
+			      (h (new handle (loc loc) (ast m)))
+			      (r (ref :handle h :text s)))
+			  (ast-loc-set! m loc)
+			  (ast-loc-set! r loc)
+			  (loop next-refs
+				(cons r lrefs)
+				(append lr (cons m body)))))))))))
+
diff --git a/skribe/src/common/lib.scm b/skribe/src/common/lib.scm
new file mode 100644
index 0000000..b0fa2d0
--- /dev/null
+++ b/skribe/src/common/lib.scm
@@ -0,0 +1,238 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/src/common/lib.scm                   */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Wed Sep 10 11:57:54 2003                          */
+;*    Last change :  Wed Oct 27 12:16:40 2004 (eg)                     */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    The Scheme independent lib part.                                 */
+;*    -------------------------------------------------------------    */
+;*    Implementation: @label lib@                                      */
+;*    bigloo: @path ../bigloo/lib.bgl@                                 */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    engine-custom-add! ...                                           */
+;*---------------------------------------------------------------------*/
+(define (engine-custom-add! e id val)
+   (let ((old (engine-custom e id)))
+      (if (unspecified? old)
+	  (engine-custom-set! e id (list val))
+	  (engine-custom-set! e id (cons val old)))))
+
+;*---------------------------------------------------------------------*/
+;*    find-markup-ident ...                                            */
+;*---------------------------------------------------------------------*/
+(define (find-markup-ident ident)
+   (let ((r (find-markups ident)))
+      (if (or (pair? r) (null? r))
+	  r
+	  '())))
+
+;*---------------------------------------------------------------------*/
+;*    container-search-down ...                                        */
+;*---------------------------------------------------------------------*/
+(define (container-search-down pred obj)
+   (with-debug 4 'container-search-down
+      (debug-item "obj=" (find-runtime-type obj))
+      (let loop ((obj (markup-body obj)))
+	 (cond
+	    ((pair? obj)
+	     (apply append (map (lambda (o) (loop o)) obj)))
+	    ((container? obj)
+	     (let ((rest (loop (markup-body obj))))
+		(if (pred obj)
+		    (cons obj rest)
+		    rest)))
+	    ((pred obj)
+	     (list obj))
+	    (else
+	     '())))))
+       
+;*---------------------------------------------------------------------*/
+;*    search-down ...                                                  */
+;*---------------------------------------------------------------------*/
+(define (search-down pred obj)
+   (with-debug 4 'search-down
+      (debug-item "obj=" (find-runtime-type obj))
+      (let loop ((obj (markup-body obj)))
+	 (cond
+	    ((pair? obj)
+	     (apply append (map (lambda (o) (loop o)) obj)))
+	    ((markup? obj)
+	     (let ((rest (loop (markup-body obj))))
+		(if (pred obj)
+		    (cons obj rest)
+		    rest)))
+	    ((pred obj)
+	     (list obj))
+	    (else
+	     '())))))
+       
+;*---------------------------------------------------------------------*/
+;*    find-down ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (find-down pred obj)
+   (with-debug 4 'find-down
+      (debug-item "obj=" (find-runtime-type obj))
+      (let loop ((obj obj))
+	 (cond
+	    ((pair? obj)
+	     (apply append (map (lambda (o) (loop o)) obj)))
+	    ((markup? obj)
+	     (debug-item "loop=" (find-runtime-type obj)
+			 " " (markup-ident obj))
+	     (if (pred obj)
+		 (list (cons obj (loop (markup-body obj))))
+		 '()))
+	    (else
+	     (if (pred obj)
+		 (list obj)
+		 '()))))))
+       
+;*---------------------------------------------------------------------*/
+;*    find1-down ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (find1-down pred obj)
+   (with-debug 4 'find1-down
+      (let loop ((obj obj)
+		 (stack '()))
+	 (debug-item "obj=" (find-runtime-type obj)
+		     " " (if (markup? obj) (markup-markup obj) "???")
+		     " " (if (markup? obj) (markup-ident obj) ""))
+	 (cond
+	    ((memq obj stack)
+	     (skribe-error 'find1-down "Illegal cyclic object" obj))
+	    ((pair? obj)
+	     (let liip ((obj obj))
+		(cond
+		   ((null? obj)
+		    #f)
+		   (else
+		    (or (loop (car obj) (cons obj stack))
+			(liip (cdr obj)))))))
+	    ((pred obj)
+	     obj)
+	    ((markup? obj)
+	     (loop (markup-body obj) (cons obj stack)))
+	    (else
+	     #f)))))
+
+;*---------------------------------------------------------------------*/
+;*    find-up ...                                                      */
+;*---------------------------------------------------------------------*/
+(define (find-up pred obj)
+   (let loop ((obj obj)
+	      (res '()))
+      (cond
+	 ((not (ast? obj))
+	  res)
+	 ((pred obj)
+	  (loop (ast-parent obj) (cons obj res)))
+	 (else
+	  (loop (ast-parent obj) (cons obj res))))))
+
+;*---------------------------------------------------------------------*/
+;*    find1-up ...                                                     */
+;*---------------------------------------------------------------------*/
+(define (find1-up pred obj)
+   (let loop ((obj obj))
+      (cond
+	 ((not (ast? obj))
+	  #f)
+	 ((pred obj)
+	  obj)
+	 (else
+	  (loop (ast-parent obj))))))
+
+;*---------------------------------------------------------------------*/
+;*    ast-document ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (ast-document m)
+   (find1-up document? m))
+
+;*---------------------------------------------------------------------*/
+;*    ast-chapter ...                                                  */
+;*---------------------------------------------------------------------*/
+(define (ast-chapter m)
+   (find1-up (lambda (n) (is-markup? n 'chapter)) m))
+
+;*---------------------------------------------------------------------*/
+;*    ast-section ...                                                  */
+;*---------------------------------------------------------------------*/
+(define (ast-section m)
+   (find1-up (lambda (n) (is-markup? n 'section)) m))
+
+;*---------------------------------------------------------------------*/
+;*    the-body ...                                                     */
+;*    -------------------------------------------------------------    */
+;*    Filter out the options                                           */
+;*---------------------------------------------------------------------*/
+(define (the-body opt+)
+   (let loop ((opt* opt+)
+	      (res '()))
+      (cond
+	 ((null? opt*)
+	  (reverse! res))
+	 ((not (pair? opt*))
+	  (skribe-error 'the-body "Illegal body" opt*))
+	 ((keyword? (car opt*))
+	  (if (null? (cdr opt*))
+	      (skribe-error 'the-body "Illegal option" (car opt*))
+	      (loop (cddr opt*) res)))
+	 (else
+	  (loop (cdr opt*) (cons (car opt*) res))))))
+
+;*---------------------------------------------------------------------*/
+;*    the-options ...                                                  */
+;*    -------------------------------------------------------------    */
+;*    Returns an list made of options. The OUT argument contains       */
+;*    keywords that are filtered out.                                  */
+;*---------------------------------------------------------------------*/
+(define (the-options opt+ . out)
+   (let loop ((opt* opt+)
+	      (res '()))
+      (cond
+	 ((null? opt*)
+	  (reverse! res))
+	 ((not (pair? opt*))
+	  (skribe-error 'the-options "Illegal options" opt*))
+	 ((keyword? (car opt*))
+	  (cond
+	     ((null? (cdr opt*))
+	      (skribe-error 'the-options "Illegal option" (car opt*)))
+	     ((memq (car opt*) out)
+	      (loop (cdr opt*) res))
+	     (else
+	      (loop (cdr opt*)
+		    (cons (list (car opt*) (cadr opt*)) res)))))
+	 (else
+	  (loop (cdr opt*) res)))))
+
+;*---------------------------------------------------------------------*/
+;*    list-split ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (list-split l num . fill)
+   (let loop ((l l)
+	      (i 0)
+	      (acc '())
+	      (res '()))
+      (cond
+	 ((null? l)
+	  (reverse! (cons (if (or (null? fill) (= i num))
+			      (reverse! acc)
+			      (append! (reverse! acc)
+				       (make-list (- num i) (car fill))))
+			  res)))
+	 ((= i num)
+	  (loop l
+		0
+		'()
+		(cons (reverse! acc) res)))
+	 (else
+	  (loop (cdr l)
+		(+ i 1)
+		(cons (car l) acc)
+		res)))))
+
diff --git a/skribe/src/common/param.scm b/skribe/src/common/param.scm
new file mode 100644
index 0000000..ba8d489
--- /dev/null
+++ b/skribe/src/common/param.scm
@@ -0,0 +1,69 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/src/common/param.scm                 */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Wed Jul 30 09:06:53 2003                          */
+;*    Last change :  Thu Oct 28 21:51:49 2004 (eg)                */
+;*    Copyright   :  2003 Manuel Serrano                               */
+;*    -------------------------------------------------------------    */
+;*    Common Skribe parameters                                         */
+;*    Implementation: @label param@                                    */
+;*       bigloo: @path ../bigloo/param.bgl@                            */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    *skribe-rc-file* ...                                             */
+;*    -------------------------------------------------------------    */
+;*    The "runtime command" file.                                      */
+;*---------------------------------------------------------------------*/
+(define *skribe-rc-file* "skriberc")
+
+;*---------------------------------------------------------------------*/
+;*    *skribe-auto-mode-alist* ...                                     */
+;*---------------------------------------------------------------------*/
+(define *skribe-auto-mode-alist*
+   '(("html" . html)
+     ("sui" . sui)
+     ("tex" . latex)
+     ("ctex" . context)
+     ("xml" . xml)
+     ("info" . info)
+     ("txt" . ascii)
+     ("mgp" . mgp)
+     ("man" . man)))
+
+;*---------------------------------------------------------------------*/
+;*    *skribe-auto-load-alist* ...                                     */
+;*    -------------------------------------------------------------    */
+;*    Autoload engines.                                                */
+;*---------------------------------------------------------------------*/
+(define *skribe-auto-load-alist*
+   '((base . "base.skr")
+     (html . "html.skr")
+     (sui . "html.skr")
+     (latex . "latex.skr")
+     (context . "context.skr")
+     (xml . "xml.skr")))
+
+;*---------------------------------------------------------------------*/
+;*    *skribe-preload* ...                                             */
+;*    -------------------------------------------------------------    */
+;*    The list of skribe files (e.g. styles) to be loaded at boot-time */
+;*---------------------------------------------------------------------*/
+(define *skribe-preload*
+   '("skribe.skr"))
+
+;*---------------------------------------------------------------------*/
+;*    *skribe-precustom* ...                                           */
+;*    -------------------------------------------------------------    */
+;*    The list of pair <custom x value> to be assigned to the default  */
+;*    engine.                                                          */
+;*---------------------------------------------------------------------*/
+(define *skribe-precustom*
+   '())
+
+;*---------------------------------------------------------------------*/
+;*    *skribebib-auto-mode-alist* ...                                  */
+;*---------------------------------------------------------------------*/
+(define *skribebib-auto-mode-alist*
+   '(("bib" . "skribebibtex")))
diff --git a/skribe/src/common/sui.scm b/skribe/src/common/sui.scm
new file mode 100644
index 0000000..eb6134b
--- /dev/null
+++ b/skribe/src/common/sui.scm
@@ -0,0 +1,166 @@
+;*=====================================================================*/
+;*    serrano/prgm/project/skribe/src/common/sui.scm                   */
+;*    -------------------------------------------------------------    */
+;*    Author      :  Manuel Serrano                                    */
+;*    Creation    :  Wed Dec 31 11:44:33 2003                          */
+;*    Last change :  Tue Feb 17 11:35:32 2004 (serrano)                */
+;*    Copyright   :  2003-04 Manuel Serrano                            */
+;*    -------------------------------------------------------------    */
+;*    Skribe Url Indexes                                               */
+;*    -------------------------------------------------------------    */
+;*    Implementation: @label lib@                                      */
+;*    bigloo: @path ../bigloo/sui.bgl@                                 */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;*    *sui-table* ...                                                  */
+;*---------------------------------------------------------------------*/
+(define *sui-table* (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;*    load-sui ...                                                     */
+;*    -------------------------------------------------------------    */
+;*    Returns a SUI sexp if already loaded. Load it otherwise.         */
+;*    Raise an error if the file cannot be open.                       */
+;*---------------------------------------------------------------------*/
+(define (load-sui path)
+   (let ((sexp (hashtable-get *sui-table* path)))
+      (or sexp
+	  (begin
+	     (when (> *skribe-verbose* 0)
+		(fprintf (current-error-port) "  [loading sui: ~a]\n" path))
+	     (let ((p (open-input-file path)))
+		(if (not (input-port? p))
+		    (skribe-error 'load-sui
+				  "Can't find `Skribe Url Index' file"
+				  path)
+		    (unwind-protect
+		       (let ((sexp (read p)))
+			  (match-case sexp
+			     ((sui (? string?) . ?-)
+			      (hashtable-put! *sui-table* path sexp))
+			     (else
+			      (skribe-error 'load-sui
+					    "Illegal `Skribe Url Index' file"
+					    path)))
+			  sexp)
+		       (close-input-port p))))))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-ref->url ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (sui-ref->url dir sui ident opts)
+   (let ((refs (sui-find-ref sui ident opts)))
+      (and (pair? refs)
+	   (let ((base (sui-file sui))
+		 (file (car (car refs)))
+		 (mark (cdr (car refs))))
+	      (format "~a/~a#~a" dir (or file base) mark)))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-title ...                                                    */
+;*---------------------------------------------------------------------*/
+(define (sui-title sexp)
+   (match-case sexp
+      ((sui (and ?title (? string?)) . ?-)
+       title)
+      (else
+       (skribe-error 'sui-title "Illegal `sui' format" sexp))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-file ...                                                     */
+;*---------------------------------------------------------------------*/
+(define (sui-file sexp)
+   (sui-key sexp :file))
+
+;*---------------------------------------------------------------------*/
+;*    sui-key ...                                                      */
+;*---------------------------------------------------------------------*/
+(define (sui-key sexp key)
+   (match-case sexp
+      ((sui ?- . ?rest)
+       (let loop ((rest rest))
+	  (and (pair? rest)
+	       (if (eq? (car rest) key)
+		   (and (pair? (cdr rest))
+			(cadr rest))
+		   (loop (cdr rest))))))
+      (else
+       (skribe-error 'sui-key "Illegal `sui' format" sexp))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-find-ref ...                                                 */
+;*---------------------------------------------------------------------*/
+(define (sui-find-ref sui ident opts)
+   (let ((ident (assq :ident opts))
+	 (mark (assq :mark opts))
+	 (class (let ((c (assq :class opts)))
+		   (and (pair? c) (cadr c))))
+	 (chapter (assq :chapter opts))
+	 (section (assq :section opts))
+	 (subsection (assq :subsection opts))
+	 (subsubsection (assq :subsubsection opts)))
+      (match-case sui
+	 ((sui (? string?) . ?refs)
+	  (cond
+	     (mark (sui-search-ref 'marks refs (cadr mark) class))
+	     (chapter (sui-search-ref 'chapters refs (cadr chapter) class))
+	     (section (sui-search-ref 'sections refs (cadr section) class))
+	     (subsection (sui-search-ref 'subsections refs (cadr subsection) class))
+	     (subsubsection (sui-search-ref 'subsubsections refs (cadr subsubsection) class))
+	     (ident (sui-search-all-refs sui ident class))
+	     (else '())))
+	 (else
+	  (skribe-error 'sui-find-ref "Illegal `sui' format" sui)))))
+
+;*---------------------------------------------------------------------*/
+;*    sui-search-all-refs ...                                          */
+;*---------------------------------------------------------------------*/
+(define (sui-search-all-refs sui id refs)
+   '())
+
+;*---------------------------------------------------------------------*/
+;*    sui-search-ref ...                                               */
+;*---------------------------------------------------------------------*/
+(define (sui-search-ref kind refs val class)
+   (define (find-ref refs val class)
+      (map (lambda (r)
+	      (let ((f (memq :file r))
+		    (c (memq :mark r)))
+		 (cons (and (pair? f) (cadr f)) (and (pair? c) (cadr c)))))
+	   (filter (if class
+		       (lambda (m)
+			  (and (pair? m)
+			       (string? (car m))
+			       (string=? (car m) val)
+			       (let ((c (memq :class m)))
+				  (and (pair? c)
+				       (eq? (cadr c) class)))))
+		       (lambda (m)
+			  (and (pair? m)
+			       (string? (car m))
+			       (string=? (car m) val))))
+		   refs)))
+   (let loop ((refs refs))
+      (if (pair? refs)
+	  (if (and (pair? (car refs)) (eq? (caar refs) kind))
+	      (find-ref (cdar refs) val class)
+	      (loop (cdr refs)))
+	  '())))
+   
+;*---------------------------------------------------------------------*/
+;*    sui-filter ...                                                   */
+;*---------------------------------------------------------------------*/
+(define (sui-filter sui pred1 pred2)
+   (match-case sui
+      ((sui (? string?) . ?refs)
+       (let loop ((refs refs)
+		  (res '()))
+	  (if (pair? refs)
+	      (if (and (pred1 (car refs)))
+		  (loop (cdr refs)
+			(cons (filter pred2 (cdar refs)) res))
+		  (loop (cdr refs) res))
+	      (reverse! res))))
+      (else
+       (skribe-error 'sui-filter "Illegal `sui' format" sui))))