Changeset 15504 in project


Ignore:
Timestamp:
08/17/09 03:25:08 (10 years ago)
Author:
Ivan Raikov
Message:

added initial LaTeX output driver for qwiki

Location:
release/4/qwiki/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/qwiki/trunk/qwiki-sxml.scm

    r15477 r15504  
    3838(module qwiki-sxml
    3939
    40   (qwiki-html-transformation-rules)
     40  (qwiki-html-transformation-rules
     41   qwiki-LaTeX-transformation-rules)
    4142
    4243(import chicken scheme)
     
    5253
    5354
     55;;;;
     56;;;;  HTML stylesheet
     57;;;;
     58
    5459(define (qwiki-make-html-header head-parms)
    5560  `(head
    5661    (title ,(or (lookup-def 'title head-parms) "qwiki"))
    57     (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8")))
    5862    (meta (@ (http-equiv "Content-Style-Type") (content "text/css")))
     63    (meta (@ (http-equiv "Content-Type")
     64             (content ,(lookup-def 'Content-Type head-parms
     65                                   "text/html; charset=UTF-8"))))
    5966    ,(let ((style  (lookup-def 'style head-parms))
    6067           (print-style  (lookup-def 'print-style head-parms)))
     
    7885     (@ *preorder* . ,(lambda element element))
    7986
    80      (definition
    81        *macro*
    82        . ,(lambda (_ type . contents)
    83             `(span (@ (class ,(conc "definition " type)))
    84                    (em "[" ,(symbol->string type) "]")
    85                    (code ,@contents)
    86                    (br))))
    87      
    8887     (Header
    8988      *macro*
     
    9998             )))
    10099
     100     (definition
     101       *macro*
     102       . ,(lambda (_ type . contents)
     103            `(span (@ (class ,(conc "definition " type)))
     104                   (em "[" ,(symbol->string type) "]")
     105                   (type ,@contents)
     106                   (br))))
     107     
    101108     (special
    102109      *macro*
     
    147154                        (li (url "?action=edit" "edit"))
    148155                        (li (url "?action=history" "history")))))
     156
    149157     ,@alist-conv-rules
    150158     )
     
    192200  )
    193201
     202;;;;
     203;;;;  LaTeX stylesheet
     204;;;;
     205
     206(define nl (list->string (list #\newline)))
     207
     208; Given a string, check to make sure it does not contain characters
     209; such as '_' or '&' that require encoding. Return either the original
     210; string, or a list of string fragments with special characters
     211; replaced by appropriate "escape sequences"
     212
     213(define string->goodTeX
     214  (make-char-quotator
     215   '((#\# . "\\#") (#\$ . "\\$") (#\% . "\\%") (#\& . "\\&")
     216     (#\~ . "\\textasciitilde{}") (#\_ . "\\_") (#\^ . "\\^")
     217     (#\\ . "$\\backslash$") (#\{ . "\\{") (#\} . "\\}"))))
     218
     219(define LaTeX-packages
     220  (make-parameter (list)))
     221
     222(define (add-LaTeX-package! package-name . options)
     223  (let ((packages (LaTeX-packages)))
     224    (if (not (assoc package-name packages))
     225        (LaTeX-packages (cons (list package-name options)
     226                              packages)))))
     227
     228;;
     229;; Place the 'body' within the LaTeX environment named 'env-name'
     230;; options is a string or a list of strings that specify optional or
     231;; mandatory parameters for the environment
     232;; Return the list of fragments.
     233;;
     234(define (in-LaTeX-env env-name options body)
     235  (list "\\begin{" env-name "}" options nl
     236        body
     237        "\\end{" env-name "}" nl))
     238
     239(define (LaTeX-use-package package-name options)
     240  (list "\\usepackage{" package-name "}"
     241        (if (pair? options) (list "[" options "]") '())
     242        nl))
     243
     244(define (qwiki-LaTeX-transformation-rules content)
     245  `((
     246                        ; General conversion rules
     247     (@
     248      ((*default*       ; local override for attributes
     249        . ,(lambda (attr-key . value) (cons attr-key value))))
     250      . ,(lambda (trigger . value) (list '@ value)))
     251
     252     (*default* . ,(lambda (tag . elems) (cons (->string tag) elems)))
     253
     254     (*text* . ,(lambda (trigger str)
     255                  (if (string? str) (string->goodTeX str) str)))
     256
     257     (n_                ; a non-breaking space
     258      . ,(lambda (tag . elems)
     259           (list "~" elems)))
     260
     261     (wiki-page
     262      . ,(lambda (tag . elems)
     263             (list
     264              "\\documentclass[12pt]{article}" nl
     265              "\\usepackage[left=3cm]{geometry}" nl
     266             
     267              (map (lambda (p) (LaTeX-use-package (car p) (cadr p)))
     268                   (LaTeX-packages)) nl
     269                     
     270             "%%%%%%%%%%%%%%%%%%%%%%%%%% Textclass specific LaTeX commands." nl
     271             " \\newenvironment{lyxcode}" nl
     272             "   {\\begin{list}{}{" nl
     273             "     \\raggedright" nl
     274             "     \\setlength{\\itemsep}{-5pt}" nl
     275             "     \\setlength{\\parsep}{-3pt}" nl
     276             "     \\normalfont\\ttfamily}%" nl
     277             "    \\item[]}" nl
     278             "   {\\end{list}}" nl
     279
     280            "\\makeatother" nl
     281            "\\sloppy" nl
     282
     283            "\\newcommand{\\minitab}[2][l]{\\begin{tabular}{#1}#2\\end{tabular}}" nl
     284
     285            nl
     286            elems
     287            ))
     288      )
     289
     290     (Header           
     291      *preorder*
     292      . ,(lambda (tag . headers) '()))
     293
     294     (Section   ; (Section level "content ...")
     295      . ,(lambda (tag level head-word . elems)
     296           (list #\\
     297                 (case level
     298                   ((1 2) "section")
     299                   ((3) "subsection")
     300                   ((4) "subsubsection")
     301                   (else (error "unsupported section level: " level)))
     302                 "{" head-word elems "}" nl)))
     303
     304     (TOC . ,(lambda (tag . elems) (list nl "\\tableofcontents{}" nl)))
     305
     306     (body
     307      . ,(lambda (tag . elems)
     308           (in-LaTeX-env "document" '()
     309                       (list elems)
     310                       )))
     311
     312     (url
     313      . ,(lambda (tag href . contents)
     314           (add-LaTeX-package! 'url)
     315           (if (null? contents)
     316               (list "\\url{" href "}")
     317               (list contents " (\\url{" href "})"))))
     318
     319     (wiki
     320      *macro*
     321      . ,(lambda (tag href . contents)
     322           (add-LaTeX-package! 'hyperref "hypertex")
     323           `("\\href{" (href ,href) "}"
     324             "{" ,(if (pair? contents) contents href) "}")))
     325
     326     ; Standard typography
     327     (em
     328      . ,(lambda (tag . elems)
     329           (list "\\emph{" elems "}")))
     330
     331     (p
     332      . ,(lambda (tag . elems)
     333           (list elems nl nl)))
     334
     335     (div
     336      . ,(lambda (tag . elems)
     337           (in-LaTeX-env "trivlist" '()  (list "\\item{}" elems))))
     338
     339     (br
     340      . ,(lambda (tag)
     341           (list "\\\\ ")))
     342
     343     (indent
     344       . ,(lambda (tag) "\\indent{}"))
     345
     346     (ul                        ; Unnumbered lists
     347      . ,(lambda (tag . elems)
     348           (in-LaTeX-env "itemize" '() elems)))
     349
     350     (ol                        ; Numbered lists
     351      . ,(lambda (tag . elems)
     352           (in-LaTeX-env "enumerate" '() elems)))
     353
     354     (li
     355      . ,(lambda (tag . elems)
     356           (list "\\item " elems nl)))
     357
     358     (dl                        ; Definition list
     359
     360      ;; dl and dt are translated to procedures that take one argument:
     361      ;; previously set label: list of fragments or #f if none
     362      ;; The procedure returns a pair: (new-label . generate-fragments)
     363      ;; Initially, label is #f
     364
     365      ((dt                      ;; The item title
     366        . ,(lambda (tag . elems)
     367            (lambda (label)
     368              (cons elems       ;; elems become the new label
     369                    (if label   ;; the label was set: we've seen dt without dd
     370                        (list "\\item [" label "]" nl) ; empty body
     371                        '())))))
     372       (dd                      ;; The item body
     373        . ,(lambda (tag . elems)
     374            (lambda (label)
     375              (cons #f          ;; consume the existing label
     376                    (list "\\item [" (or label "") "] " elems nl)))))
     377       )
     378      . ,(lambda (tag . procs)  ;; execute procs generated by dt/dd
     379          (let loop ((procs (flatten procs)) (label #f) (accum '()))
     380            (if (null? procs) (in-LaTeX-env "description" '() (reverse accum))
     381                (let ((result ((car procs) label)))
     382                  (loop (cdr procs) (car result) (cons (cdr result) accum))))))
     383      )
     384       
     385
     386     (blockquote
     387      . ,(lambda (tag . elems)
     388           (in-LaTeX-env "quote" '() elems)))
     389
     390     (definition
     391       *macro*
     392       . ,(lambda (_ type . contents)
     393            (in-LaTeX-env "description" '()
     394                        `(type ,@contents))))
     395     
     396     (special
     397      *macro*
     398      . ,(lambda (tag name arg)
     399           `(,(string->symbol (string-upcase (symbol->string name))) ,arg)))
     400
     401     (preformatted
     402      *macro*
     403      . ,(lambda (tag . elems)
     404           `(verbatim ,elems)))
     405         
     406     (type
     407      *macro*
     408      . ,(lambda (tag . terms)
     409           `("\\begin{texttt}" ,@terms "\\end{texttt}")))
     410
     411
     412     (verbatim  ; set off pieces of code: one or several lines
     413      ((*text* . ; Different quotation rules apply within a "verbatim" block
     414               ,(let ((string->goodTeX-in-verbatim
     415                      (make-char-quotator
     416                       '((#\space "~")  ; All spaces are "hard"
     417                         (#\# . "\\#") (#\$ . "\\$") (#\% . "\\%")
     418                         (#\& . "\\&") (#\~ . "\\textasciitilde{}")
     419                         (#\_ . "\\_") (#\^ . "\\^")
     420                         (#\\ . "$\\backslash$") (#\{ . "\\{")
     421                         (#\} . "\\}")))))
     422                  (lambda (trigger str)
     423                    (if (string? str) (string->goodTeX-in-verbatim str) str)))
     424               )
     425        (strong
     426          . ,(lambda (tag . elems)
     427               (list "\\textrm{\\small\\bfseries{}" elems "}")))
     428        )
     429      . ,(lambda (tag . lines)
     430           (in-LaTeX-env "lyxcode" '()
     431                       (map (lambda (line)
     432                              (list (if (equal? line "") "~" line)
     433                                    "\\\\" nl))
     434                            lines))))
     435
     436      (small-verbatim   ; set off pieces of code: one or several lines
     437      ((*text* . ; Different quotation rules apply within a "verbatim" block
     438               ,(let ((string->goodTeX-in-verbatim
     439                      (make-char-quotator
     440                       '((#\space "~")  ; All spaces are "hard"
     441                         (#\# . "\\#") (#\$ . "\\$") (#\% . "\\%")
     442                         (#\& . "\\&") (#\~ . "\\textasciitilde{}")
     443                         (#\_ . "\\_") (#\^ . "\\^")
     444                         (#\\ . "$\\backslash$") (#\{ . "\\{")
     445                         (#\} . "\\}")))))
     446                  (lambda (trigger str)
     447                    (if (string? str) (string->goodTeX-in-verbatim str) str)))
     448               ))
     449      . ,(lambda (tag . lines)
     450           (in-LaTeX-env "list" '()
     451             (list "{}"
     452               "{%\\raggedright" nl
     453                "\\setlength{\\rightmargin}{-15pt}" nl
     454                "\\setlength{\\itemsep}{-12pt}" nl
     455                "\\setlength{\\parsep}{-4pt}" nl
     456                "\\small\\ttfamily}%" nl
     457               (map (lambda (line)
     458                      (list "\\item  "
     459                        (if (equal? line "") "~" line)
     460                        "\\\\" nl))
     461                 lines)))))
     462
     463     (table
     464                ; verbatim mode does not work in tabular <deep sigh> ...
     465                ; we have to emulate
     466      ((verbatim       
     467        ((*text* . ; Different quotation rules apply within a "verbatim" block
     468               ,(let ((string->goodTeX-in-verbatim
     469                      (make-char-quotator
     470                       '((#\space . "~")        ; All spaces are "hard"
     471                         (#\newline . "\\\\\n")
     472                         (#\# . "\\#") (#\$ . "\\$") (#\% . "\\%")
     473                         (#\& . "\\&") (#\~ . "\\textasciitilde{}")
     474                         (#\_ . "\\_") (#\^ . "\\^")
     475                         (#\\ . "$\\backslash$") (#\{ . "\\{")
     476                         (#\} . "\\}")))))
     477                  (lambda (trigger str)
     478                    (if (string? str) (string->goodTeX-in-verbatim str) str)))
     479               ))
     480        . ,(lambda (tag . lines)       
     481             (map (lambda (line) (list "\\ttfamily\\small " nl line "\\\\"))
     482                  lines)))
     483       (tr              ; elems ::= [(@ attrib ...)] td ...
     484                        ; we disregard all attributes of a row
     485                        ; The result is (td ...)
     486        . ,(lambda (tag . elems)
     487             (if (and (pair? elems) (pair? (car elems))
     488                      (eq? '@ (caar elems)))
     489                 (cdr elems)
     490                 elems)))
     491
     492       (td              ; elems ::= [(@ attrib ...)] body ...
     493                        ; we're only interested in (align "alignment") attr
     494                        ; and the (colspan "number") attr
     495                        ; The result is ("alignment" colspan body ...)
     496                        ; where "alignment" will be #\l, #\c, #\r
     497                        ; (#\l if not given); colspan is the integer
     498        . ,(lambda (tag . elems)
     499             (define (get-alignment attrs)
     500               (cond
     501                ((assq 'align attrs) =>
     502                 (lambda (attr)
     503                   ;(cerr "align attr: " attr nl)
     504                   (cond
     505                    ((string-ci=? (cadr attr) "left") #\l)
     506                    ((string-ci=? (cadr attr) "right") #\r)
     507                    ((string-ci=? (cadr attr) "center") #\c)
     508                    (else (error "wrong alignment attribute: " attr)))))
     509                (else #\l)))
     510             (define (get-colspan attrs)
     511               (cond
     512                ((assq 'colspan attrs) =>
     513                 (lambda (attr)
     514                   (let ((val (string->number (cadr attr))))
     515                     (assert val)
     516                     val)))
     517                (else 1)))
     518             (if (and (pair? elems) (pair? (car elems))
     519                      (eq? '@ (caar elems)))
     520                 (cons (get-alignment (cadar elems))
     521                   (cons (get-colspan (cadar elems))
     522                         (cdr elems)))
     523                 (cons (get-alignment '())
     524                   (cons (get-colspan '())
     525                        elems)))))
     526
     527       (th              ; elems ::= [(@ attrib ...)] body ...
     528                        ; we're only interested in (align "alignment") attr
     529                        ; and the (colspan "number") attr
     530                        ; The result is ("alignment" colspan body ...)
     531                        ; where "alignment" will be #\l, #\c, #\r
     532                        ; (#\c if not given); colspan is the integer
     533        . ,(lambda (tag . elems)
     534             (define (get-alignment attrs)
     535               (cond
     536                ((assq 'align attrs) =>
     537                 (lambda (attr)
     538                   ;(cerr "align attr: " attr nl)
     539                   (cond
     540                    ((string-ci=? (cadr attr) "left") #\l)
     541                    ((string-ci=? (cadr attr) "right") #\r)
     542                    ((string-ci=? (cadr attr) "center") #\c)
     543                    (else (error "wrong alignment attribute: " attr)))))
     544                (else #\c)))
     545             (define (get-colspan attrs)
     546               (cond
     547                ((assq 'colspan attrs) =>
     548                 (lambda (attr)
     549                   (let ((val (string->number (cadr attr))))
     550                     (assert val)
     551                     val)))
     552                (else 1)))
     553             (if (and (pair? elems) (pair? (car elems))
     554                      (eq? '@ (caar elems)))
     555                 (cons (get-alignment (cadar elems))
     556                   (cons (get-colspan (cadar elems))
     557                         (cdr elems)))
     558                 (cons (get-alignment '())
     559                   (cons (get-colspan '())
     560                        elems)))))
     561       )
     562                        ; (table [(@ attrib ...)] tr ...
     563      . ,(lambda (tag row . rows)
     564           (let*-values
     565            (((attrs rows)
     566              (if (and (pair? row) (eq? '@ (car row)))
     567                  (values (cadr row) rows)
     568                  (values '() (cons row rows))))
     569             ((border?)
     570              (cond
     571               ((assq 'border attrs) =>
     572                (lambda (border-attr) (not (equal? "0" (cadr border-attr)))))
     573               (else #f)))
     574             ((caption label table-type table-alignment)
     575              (apply values
     576                     (map (lambda (name)
     577                            (cond
     578                             ((assq name attrs) => cadr)
     579                             (else #f)))
     580                          '(caption key table-type align))))
     581             (dummy (assert (pair? rows))) ; at least one row must be given
     582             ((ncols) (length (car rows)))
     583             ((tex-cols)
     584              (let ((col-codes
     585                     (map (lambda (_) (if border? "l|" "l")) (car rows))))
     586                (if border?
     587                    (apply string-append
     588                           (cons "|" col-codes))
     589                    (apply string-append col-codes))))
     590             )
     591            (list
     592              (list
     593               (and (equal? table-alignment "center")
     594                    "\\centering")
     595               (in-LaTeX-env "tabular"
     596                             (list "{" ; "@{\\extracolsep{-25pt}}"
     597                                   tex-cols "}")
     598                (list (and border? "\\hline\n")
     599                  (map
     600                   (lambda (row)
     601                     (list
     602                      (intersperse
     603                       (map
     604                        (lambda (col)
     605                          (apply
     606                           (lambda (alignment span . data)
     607                             (if (> span 1)
     608                                 (list "\\multicolumn{" span "}{" alignment "}{"
     609                                       "\\minitab[" alignment "]{"
     610                                       data "}}")
     611                                 (list "\\minitab[" alignment "]{" data "}")))
     612                           col))
     613                        row)
     614                       " & ")
     615                      "\\\\" (and border? "\\hline") nl))
     616                   rows)
     617                  nl))
     618;              (and caption (list "\\caption{"
     619;                                 (and label
     620;                                      (list "\\label{" label "}"))
     621;                                 caption "}"))
     622               ))
     623            )))
     624
     625
     626     (small
     627      . ,(lambda (tag . elems)
     628           (list "{\\small{}" elems "}")))
     629
     630     (strong
     631      . ,(lambda (tag . elems)
     632           (list "{\\rmfamily\\bfseries{}" elems "}")))
     633
     634     (history . ,(lambda (history items) (list)))
     635     (page-specific-links . ,(lambda _ (list)))
     636
     637     (tex      ; raw tex expression
     638       *preorder*
     639       . ,(lambda (tag str) str))
     640           
     641     )))
     642
     643
    194644)
  • release/4/qwiki/trunk/qwiki.scm

    r15492 r15504  
    4545   qwiki-transformation-steps
    4646   qwiki-extensions
     47   qwiki-output-driver
    4748   )
    4849
  • release/4/qwiki/trunk/qwiki.setup

    r15497 r15504  
    11;;;; -*- Hen -*-
    22
    3 (compile -s -O2 qwiki-sxml.scm -j qwiki-sxml)
     3(compile -s -d2 qwiki-sxml.scm -j qwiki-sxml)
    44(compile -s -O2 qwiki-sxml.import.scm)
    55
Note: See TracChangeset for help on using the changeset viewer.