source: project/release/4/multidoc/trunk/multidoc.scm @ 15912

Last change on this file since 15912 was 15912, checked in by Ivan Raikov, 10 years ago

The TOC rule for html output in multidoc now uses a div.

File size: 21.1 KB
Line 
1;;
2;; multidoc - convert SXML to output in various document formats
3;;
4;; Copyright (c) 2009 Peter Bex and Ivan Raikov
5;;
6;;  Redistribution and use in source and binary forms, with or without
7;;  modification, are permitted provided that the following conditions
8;;  are met:
9;;
10;;  - Redistributions of source code must retain the above copyright
11;;  notice, this list of conditions and the following disclaimer.
12;;
13;;  - Redistributions in binary form must reproduce the above
14;;  copyright notice, this list of conditions and the following
15;;  disclaimer in the documentation and/or other materials provided
16;;  with the distribution.
17;;
18;;  - Neither name of the copyright holders nor the names of its
19;;  contributors may be used to endorse or promote products derived
20;;  from this software without specific prior written permission.
21;;
22;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE
23;;  CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
24;;  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
25;;  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
26;;  DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE
27;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
28;;  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
29;;  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
30;;  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
31;;  AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
32;;  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
33;;  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34;;  POSSIBILITY OF SUCH DAMAGE.
35
36(provide 'multidoc)
37
38(module multidoc
39
40  (multidoc-html-transformation-rules
41   multidoc-LaTeX-transformation-rules
42   LaTeX-use-package
43   add-LaTeX-package!
44   LaTeX-packages
45   LaTeX-label
46;;   multidoc-Texinfo-transformation-rules
47   )
48
49(import chicken scheme)
50
51(use posix srfi-1 srfi-13 data-structures regex )
52(use sxml-transforms doctype uri-generic)
53
54
55(define lookup-def 
56  (lambda (k lst . rest)
57    (let-optionals rest ((default #f))
58      (alist-ref k lst eq? default))))
59
60
61;;;;
62;;;;  HTML stylesheet
63;;;;
64
65(define (make-html-header head-parms)
66  `(head
67    (title ,(or (lookup-def 'title head-parms) "multidoc"))
68    (meta (@ (http-equiv "Content-Style-Type") (content "text/css")))
69    (meta (@ (http-equiv "Content-Type") 
70             (content ,(lookup-def 'Content-Type head-parms 
71                                   "text/html; charset=UTF-8"))))
72    ,(let ((style  (lookup-def 'style head-parms))
73           (print-style  (lookup-def 'print-style head-parms)))
74       (list (if style `(link (@ (rel "stylesheet") (type "text/css") (href ,style))) '())
75             (if print-style `(link (@ (rel "stylesheet") (type "text/css") 
76                                       (media "print")  (href ,print-style))) '())))
77    ,(map
78      (lambda (key)
79        (let ((val (lookup-def key head-parms )))
80          (and val
81               `(meta (@ (name ,(symbol->string key)) (content ,val))))))
82      '(description Author keywords
83                    Date-Revision-yyyymmdd Date-Creation-yyyymmdd))))
84
85(define (internal-link str)
86  (string-substitute* (string-downcase str) '(("[^A-Za-z0-9_ \t-]" . "")
87                                              ("[ \t]+" . "-"))))
88
89(define (multidoc-html-transformation-rules content)
90  `((
91     (@ *preorder* . ,(lambda element element))
92
93     (Header
94      *macro*
95      . ,(lambda (tag . headers)
96           (make-html-header headers)))
97
98     (Section
99      *macro*
100      . ,(lambda (tag level head-word . elems)
101           `((,(string->symbol (string-append "h" (number->string level)))
102              (@ (id ,(internal-link head-word)))
103              ,head-word ,elems)
104             )))
105
106     (Section*
107      *macro*
108      . ,(lambda (tag level head-word . elems)
109           `((,(string->symbol (string-append "h" (number->string level)))
110              ,head-word ,elems)
111             )))
112
113     (definition
114       *macro*
115       . ,(lambda (_ type . contents)
116            `(span (@ (class ,(conc "definition " type)))
117                   (em "[" ,(symbol->string type) "]")
118                   (type ,@contents)
119                   (br))))
120     
121     (special
122      *macro*
123      . ,(lambda (tag name arg)
124           `(,(string->symbol (string-upcase (symbol->string name))) ,arg)))
125
126     (preformatted
127      . ,(lambda (tag . elems)
128           `(pre (tt ,elems))))
129         
130     (type
131      *macro*
132      . ,(lambda (tag . terms)
133           `(tt ,@terms)))
134
135     (url *macro* . ,(lambda (tag href . contents)
136                       `(a (@ (class "external") (href ,href))
137                           ,(if (pair? contents) contents
138                                href))))
139
140     ,@alist-conv-rules
141     )
142
143    (
144     (html:begin
145      . ,(lambda (tag . elems)
146           (list
147            xhtml-1.0-strict
148            "<html xmlns=\"http://www.w3.org/1999/xhtml\">"
149             elems
150             "</html>")))
151
152     (TOC ;; Re-scan the content for "Section" tags and generate
153      . ,(lambda (tag . rest) ;; the table of contents
154           (let ((sections
155                  (pre-post-order content
156                                  `(
157                                    (Section ;; (Section level "content ...")
158                                     ((*text* . ,(lambda (tag str) str)))
159                                     . ,(lambda (tag level head-word . elems)
160                                          (append
161                                           (list "<li><a href=\"#"
162                                                 (internal-link head-word)
163                                                 "\">" head-word "</a>" nl)
164                                           (if (null? elems)
165                                               elems
166                                               (list "<ul>" elems "</ul>"))
167                                           (list "</li>" nl)))
168                                     )
169                                    (*default*
170                                     . ,(lambda (tag . elems) elems))
171                                   
172                                    (*text* . ,(lambda (trigger str) (list)))))))
173             (list "<div id=\"toc\">"
174                   rest
175                   "<ul>"
176                   sections 
177                   "</ul>"
178                   "</div>"
179                   ))))
180
181     (verbatim
182      *preorder*
183      . ,(lambda (tag . contents)
184           contents))
185
186     ,@universal-conversion-rules)
187    )
188  )
189
190;;;;
191;;;;  LaTeX stylesheet
192;;;;
193
194(define nl (list->string (list #\newline)))
195
196; Given a string, check to make sure it does not contain characters
197; such as '_' or '&' that require encoding. Return either the original
198; string, or a list of string fragments with special characters
199; replaced by appropriate "escape sequences"
200
201(define string->goodTeX
202  (make-char-quotator
203   '((#\# . "\\#") (#\$ . "\\$") (#\% . "\\%") (#\& . "\\&")
204     (#\~ . "\\textasciitilde{}") (#\_ . "\\_") (#\^ . "\\^")
205     (#\\ . "$\\backslash$") (#\{ . "\\{") (#\} . "\\}"))))
206
207(define string->goodTeX-in-verbatim
208  (make-char-quotator
209   '((#\space "~")      ; All spaces are "hard"
210     (#\# . "\\#") (#\$ . "\\$") (#\% . "\\%")
211     (#\& . "\\&") (#\~ . "\\textasciitilde{}")
212     (#\_ . "\\_") (#\^ . "\\^")
213     (#\\ . "$\\backslash$") (#\{ . "\\{")
214     (#\} . "\\}"))))
215
216(define LaTeX-packages
217  (make-parameter (list)))
218
219(define (add-LaTeX-package! package-name . options)
220  (let ((packages (LaTeX-packages)))
221    (if (not (assoc package-name packages))
222        (LaTeX-packages (cons (list package-name options)
223                              packages)))))
224
225;;
226;; Place the 'body' within the LaTeX environment named 'env-name'
227;; options is a string or a list of strings that specify optional or
228;; mandatory parameters for the environment
229;; Return the list of fragments.
230;;
231(define (in-LaTeX-env env-name options body)
232  (list "\\begin{" env-name "}" options nl
233        body
234        "\\end{" env-name "}" nl))
235
236(define (LaTeX-use-package package-name . options)
237  (list "\\usepackage{" package-name "}" 
238        (if (pair? options) (list "[" options "]") '()) 
239        nl))
240
241(define (LaTeX-label str)
242  (define (f0 str)
243    (let* ((cs   (string-split str " "))
244           (ins  (map (lambda (s) 
245                        (let ((s (string-downcase s)))
246                          (string-copy s 0 (min 3 (- (string-length s) 1))))) cs)))
247      (string-concatenate ins)))
248  (cond ((pair? str)   (string-concatenate (map f0 str)))
249        (else          (f0 (->string str)))))
250
251
252(define (multidoc-LaTeX-transformation-rules content)
253  `((
254                        ; General conversion rules
255     (@
256      ((*default*       ; local override for attributes
257        . ,(lambda (attr-key . value) (cons attr-key value))))
258      . ,(lambda (trigger . value) (list '@ value)))
259
260     (*default* . ,(lambda (tag . elems) (cons (->string tag) elems)))
261
262     (*text* . ,(lambda (trigger str) 
263                  (if (string? str) (string->goodTeX str) str)))
264
265     (n_                ; a non-breaking space
266      . ,(lambda (tag . elems)
267           (list "~" elems)))
268
269     (Header           
270      *preorder*
271      . ,(lambda (tag . headers) '()))
272
273     (Section   ; (Section level "content ...")
274      . ,(lambda (tag level head-word . elems)
275           (list #\\
276                 (case level
277                   ((1 2) "section")
278                   ((3) "subsection")
279                   ((4) "subsubsection")
280                   (else (error "unsupported section level: " level)))
281                 "{" head-word elems "}"  nl
282                 (if (= level 1) 
283                     (list "\\label{" (LaTeX-label head-word)  "}") 
284                     (list)) nl)))
285
286     (TOC . ,(lambda (tag . elems) (list nl "\\tableofcontents{}" nl)))
287
288     (body
289      . ,(lambda (tag . elems)
290           (in-LaTeX-env "document" '() 
291                       (list elems)
292                       )))
293
294     (url 
295      . ,(lambda (tag href . contents) 
296           (add-LaTeX-package! 'url)
297           (if (null? contents)
298               (list "\\url{" href "}")
299               (list contents " (\\url{" href "})"))))
300
301     ; Standard typography
302     (small
303      . ,(lambda (tag . elems)
304           (list "{\\small{}" elems "}")))
305
306     (strong
307      . ,(lambda (tag . elems)
308           (list "{\\rmfamily\\bfseries{}" elems "}")))
309
310     (type
311      . ,(lambda (tag . elems)
312           (list "{\\ttfamily{}" elems "}")))
313
314     (em
315      . ,(lambda (tag . elems)
316           (list "\\emph{" elems "}")))
317
318     (p
319      . ,(lambda (tag . elems)
320           (list elems nl nl)))
321
322     (div
323      . ,(lambda (tag . elems)
324           (list elems nl)))
325
326     (br
327      . ,(lambda (tag)
328           (list "\\\\ ")))
329
330     (hr . ,(lambda (tag) 
331              (list "\\begin{center}" 
332                    "\\rule{0.8\\textwidth}{0.4pt}" 
333                    "\\end{center}" nl)))
334
335     (indent 
336      . ,(lambda (tag) "\\indent{}"))
337
338     (ul                        ; Unnumbered lists
339      . ,(lambda (tag . elems)
340           (in-LaTeX-env "itemize" '() elems)))
341
342     (ol                        ; Numbered lists
343      . ,(lambda (tag . elems)
344           (in-LaTeX-env "enumerate" '() elems)))
345
346     (li
347      . ,(lambda (tag . elems)
348           (list "\\item " elems nl)))
349
350     (dl                        ; Definition list
351
352      ;; dl and dt are translated to procedures that take one argument:
353      ;; previously set label: list of fragments or #f if none
354      ;; The procedure returns a pair: (new-label . generate-fragments)
355      ;; Initially, label is #f
356
357      ((dt                      ;; The item title
358        . ,(lambda (tag . elems)
359            (lambda (label)
360              (cons elems       ;; elems become the new label
361                    (if label   ;; the label was set: we've seen dt without dd
362                        (list "\\item [" label "]" nl) ; empty body
363                        '())))))
364       (dd                      ;; The item body
365        . ,(lambda (tag . elems)
366            (lambda (label)
367              (cons #f          ;; consume the existing label
368                    (list "\\item [" (or label "") "] " elems nl)))))
369       )
370      . ,(lambda (tag . procs)  ;; execute procs generated by dt/dd
371          (let loop ((procs (flatten procs)) (label #f) (accum '()))
372            (if (null? procs) (in-LaTeX-env "description" '() (reverse accum))
373                (let ((result ((car procs) label)))
374                  (loop (cdr procs) (car result) (cons (cdr result) accum))))))
375      )
376       
377
378     (special
379      *macro*
380      . ,(lambda (tag name arg)
381           `(,(string->symbol (string-upcase (symbol->string name))) ,arg)))
382
383     (definition
384       . ,(lambda (_ type . elems)
385            (in-LaTeX-env "description" '()
386               (list "{\\ttfamily{}" elems "}"))))
387
388     (blockquote
389      . ,(lambda (tag . elems)
390           (in-LaTeX-env "quote" '() elems)))
391
392     (preformatted
393      *macro*
394      . ,(lambda (tag . elems)
395           `(verbatim ,elems)))
396         
397
398     (verbatim  ; set off pieces of code: one or several lines
399      ((*text* . ; Different quotation rules apply within a "verbatim" block
400               ,(lambda (trigger str) 
401                  (if (string? str) (string->goodTeX-in-verbatim str) str)))
402               
403        (strong
404          . ,(lambda (tag . elems)
405               (list "\\textrm{\\small\\bfseries{}" elems "}")))
406        )
407      . ,(lambda (tag . lines)
408           (in-LaTeX-env "lyxcode" '()
409                       (map (lambda (line) 
410                              (list (if (equal? line "") "~" line) 
411                                    "\\\\" nl))
412                            lines))))
413
414     (table
415      ;; (table [(@ attrib ...)] tr ...
416      . ,(lambda (tag row . rows)
417           (let*-values
418            (((attrs rows)
419              (if (and (pair? row) (eq? '@ (car row)))
420                  (values (cadr row) rows)
421                  (values '() (cons row rows))))
422             
423             ((border?)
424              (cond
425               ((assq 'border attrs) =>
426                (lambda (border-attr) (not (equal? "0" (cadr border-attr)))))
427               (else #f)))
428
429             ((caption label table-type table-alignment)
430              (apply values
431                     (map (lambda (name)
432                            (cond
433                             ((assq name attrs) => cadr)
434                             (else #f)))
435                          '(caption key table-type align))))
436
437             (dummy (assert (pair? rows))) ; at least one row must be given
438
439             ((ncols) (length (car rows)))
440             ((tex-cols)
441              (let* ((verbatim? 
442                      (lambda (r) 
443                        (pre-post-order r
444                          `(
445                            (verbatim
446                             . ,(lambda (tag . elems) elems))
447                           
448                            (*default*
449                             . ,(lambda (tag . elems) elems))
450                           
451                            (*text* . ,(lambda (trigger str) (list))))
452                          )))
453
454                     (col-codes (map (lambda (r) (if (verbatim? r) "p" "l")) (car rows)))
455
456                     (col-codes (if border? 
457                                    (intersperse (flatten (list "" col-codes "")) "|") 
458                                    col-codes)))
459                (apply string-append col-codes)))
460             )
461            (list
462              (list
463               (and (equal? table-alignment "center")
464                    "\\centering")
465               (in-LaTeX-env "tabular" (list "{" tex-cols "}")
466                (list (and border? "\\hline\n")
467                  (map
468                   (lambda (row)
469                     (list
470                      (intersperse
471                       (map
472                        (lambda (col)
473                          (apply
474                           (lambda (alignment span . data)
475                             (if (> span 1)
476                                 (list "\\multicolumn{" span "}{" alignment "}{"
477                                       "\\minitab[" alignment "]{"
478                                       data "}}")
479                                 (list "\\minitab[" alignment "]{" data "}")))
480                           col))
481                        row)
482                       " & ")
483                      "\\\\" (and border? "\\hline") nl))
484                   rows)
485                  nl))
486               ))
487            )))
488
489
490     (tex      ; raw tex expression
491       *preorder*
492       . ,(lambda (tag . str) str))
493           
494     )))
495
496;;;;
497;;;;  Texinfo stylesheet
498;;;;
499
500; Given a string, check to make sure it does not contain characters
501; such as '_' or '&' that require encoding. Return either the original
502; string, or a list of string fragments with special characters
503; replaced by appropriate "escape sequences"
504
505(define string->goodTexinfo
506  (make-char-quotator
507   `(
508     (#\{ . "@{") 
509     (#\} . "@}")
510     (#\@ . "@@")
511     (#\, . "@comma{}") ;; only in argument lists
512     (,(integer->char 160) . "@")
513     )))
514
515(define (in-Texinfo-cmd cmd-name body)
516  (list #\@ cmd-name #\{ body #\} nl))
517
518(define (in-Texinfo-env env-name options body)
519  (list "@" env-name " " options nl
520        body
521        "@end " env-name nl))
522
523(define Texinfo-headers (make-parameter (list)))
524
525(define (Texinfo-add-header! str)
526  (Texinfo-headers (cons str (Texinfo-headers))))
527
528(define (make-Texinfo-header head-parms)
529  (let ((titletext (lookup-def 'title head-parms))
530        (authorstext (lookup-def 'Author head-parms)))
531    (list "\\input texinfo" nl
532          (Texinfo-headers)
533          "@titlepage" nl
534          (and titletext (list "@title " titletext nl))
535          (and authorstext (list "@author " authorstext nl))
536          "@end titlepage"
537          )))
538#|
539(define (multidoc-Texinfo-transformation-rules content)
540  `((
541                        ; General conversion rules
542     (@
543      ((*default*       ; local override for attributes
544        . ,(lambda (attr-key . value) (cons attr-key value))))
545      . ,(lambda (trigger . value) (list '@ value)))
546
547     (*default* . ,(lambda (tag . elems) (cons (->string tag) elems)))
548
549     (*text* . ,(lambda (trigger str)
550                  (if (string? str) (string->goodTexinfo str) str)))
551
552     (n_                ; a non-breaking space
553      . ,(lambda (tag . elems)
554           (list "@{ }" elems)))
555
556     (Header           
557      *preorder*
558      . ,(lambda (tag . headers) (make-Texinfo-headers headers)))
559
560     (Section   ; (Section level "content ...")
561      . ,(lambda (tag level head-word . elems)
562           (list nl
563                 "@node " (Texinfo-node-label head-word elems) nl
564                 (case level
565                   ((1)   "@chapter ")
566                   ((2)   "@section ")
567                   ((3)   "@subsection ")
568                   ((4)   "@subsubsection ")
569                   (else (error "unsupported section level: " level)))
570                 head-word elems  nl)))
571
572     (TOC . ,(lambda (tag . elems) (list nl "@contents" nl)))
573
574     (body
575      . ,(lambda (tag . elems) elems))
576
577     (url
578      . ,(lambda (tag href . contents)
579           (list contents "@url{" href "}")))
580
581     ; Standard typography
582     (small
583      . ,(lambda (tag . elems)
584           (in-Texinfo-cmd "smallformat" elems)))
585
586     (strong
587      . ,(lambda (tag . elems)
588           (in-Texinfo-cmd "strong" elems)))
589
590     (type
591      . ,(lambda (tag . elems)
592           (in-Texinfo-cmd "code" elems)))
593
594     (em
595      . ,(lambda (tag . elems)
596           (in-Texinfo-cmd "emph" elems)))
597
598     (p
599      . ,(lambda (tag . elems)
600           (list elems nl nl)))
601
602     (div
603      . ,(lambda (tag . elems)
604           (list elems nl)))
605
606     (br
607      . ,(lambda (tag)
608           (list "@*")))
609
610     (hr . ,(lambda (tag)  '()))
611
612     (indent . ,(lambda (tag) '()))
613
614     (ul                        ; Unnumbered lists
615      . ,(lambda (tag . elems)
616           (in-Texinfo-env "itemize" '() elems)))
617
618     (ol                        ; Numbered lists
619      . ,(lambda (tag . elems)
620           (in-Texinfo-env "enumerate" '() elems)))
621
622     (li
623      . ,(lambda (tag . elems)
624           (list "@item " elems nl)))
625
626     (dl                        ; Definition list
627
628      ;; dl and dt are translated to procedures that take one argument:
629      ;; previously set label: list of fragments or #f if none
630      ;; The procedure returns a pair: (new-label . generate-fragments)
631      ;; Initially, label is #f
632
633      ((dt                      ;; The item title
634        . ,(lambda (tag . elems)
635            (lambda (label)
636              (cons elems       ;; elems become the new label
637                    (if label   ;; the label was set: we've seen dt without dd
638                        (list "@item " label nl) ; empty body
639                        '())))))
640       (dd                      ;; The item body
641        . ,(lambda (tag . elems)
642            (lambda (label)
643              (cons #f          ;; consume the existing label
644                    (list "@item " (or label "") nl elems nl)))))
645       )
646      . ,(lambda (tag . procs)  ;; execute procs generated by dt/dd
647          (let loop ((procs (flatten procs)) (label #f) (accum '()))
648            (if (null? procs) (in-Texinfo-env "table" '("@asis") (reverse accum))
649                (let ((result ((car procs) label)))
650                  (loop (cdr procs) (car result) (cons (cdr result) accum))))))
651      )
652       
653
654     (special
655      *macro*
656      . ,(lambda (tag name arg)
657           `(,(string->symbol (string-upcase (symbol->string name))) ,arg)))
658
659     (definition
660       . ,(lambda (_ type . elems)
661            (in-Texinfo-env "table" '("@asis")
662               (list "@item " type nl elems "}"))))
663
664     (blockquote
665      . ,(lambda (tag . elems)
666           (in-Texinfo-env "quotation" '() elems)))
667
668     (preformatted
669      *macro*
670      . ,(lambda (tag . elems)
671           `(verbatim ,elems)))
672         
673
674     (verbatim  ; set off pieces of code: one or several lines
675      ((*text* . ; Different quotation rules apply within a "verbatim" block
676               ,(lambda (trigger str)
677                  (if (string? str) (string->goodTexinfo-in-verbatim str) str)))
678        )
679      . ,(lambda (tag . lines)
680           (in-Texinfo-env "verbatim" '()
681                           (map (lambda (line)
682                                  (list (if (equal? line "") "~" line)
683                                        "@*" nl))
684                                lines))))
685
686
687     (table
688      ;; (table [(@ attrib ...)] tr ...
689      . ,(lambda (tag row . rows)
690           (let*-values
691            (((attrs rows)
692              (if (and (pair? row) (eq? '@ (car row)))
693                  (values (cadr row) rows)
694                  (values '() (cons row rows))))
695             
696             ((border?)
697              (cond
698               ((assq 'border attrs) =>
699                (lambda (border-attr) (not (equal? "0" (cadr border-attr)))))
700               (else #f)))
701
702             ((caption label table-type table-alignment)
703              (apply values
704                     (map (lambda (name)
705                            (cond
706                             ((assq name attrs) => cadr)
707                             (else #f)))
708                          '(caption key table-type align))))
709
710             (dummy (assert (pair? rows))) ; at least one row must be given
711
712             ((ncols) (length (car rows)))
713
714             ((texinfo-cols)
715              (let* ((verbatim?
716                      (lambda (r)
717                        (pre-post-order r
718                          `(
719                            (verbatim
720                             . ,(lambda (tag . elems) elems))
721                           
722                            (*default*
723                             . ,(lambda (tag . elems) elems))
724                           
725                            (*text* . ,(lambda (trigger str) (list))))
726                          )))
727
728                     (col-prototypes (map (lambda (r) (list "{" r "}" )) (car rows))))
729
730                (apply string-append col-prototypes)))
731             )
732            (list
733              (list
734               (and (equal? table-alignment "center")
735                    "@center")
736               (in-Texinfo-env "multitable" texinfo-cols
737                (list
738                  (map
739                   (lambda (row)
740                     (list
741                      "@item "
742                      (intersperse
743                       (map
744                        (lambda (col)
745                          (apply
746                           (lambda (alignment span . data) data)
747                           col))
748                        row)
749                       (list nl "@tab "))
750                      nl
751                   rows)
752                  nl))
753               (and (equal? table-alignment "center")
754                    "@end center")
755               ))
756            )))
757
758           ))
759
760     (tex      ; raw tex expression
761       *preorder*
762       . ,(lambda (tag . str) str))
763           
764     )))
765
766
767|#
768
769)
Note: See TracBrowser for help on using the repository browser.