;*=====================================================================*/
;*    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))))))))