Changeset 18633 in project


Ignore:
Timestamp:
06/26/10 18:21:27 (11 years ago)
Author:
sjamaan
Message:

multidoc: Copy over the svnwiki-sxml branch to multidoc trunk. No mergetracking??... :(

Location:
release/4/multidoc/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • release/4/multidoc/trunk/html.scm

    r18519 r18633  
    2525
    2626(define (internal-link r)
    27   (post-order
    28    r
    29    `(
    30      (*default* . ,(lambda (tag elems) (cons tag elems)))
    31      
    32      (*text* . ,(lambda (trigger str)
    33                   (string-substitute* (string-downcase str)
    34                                       '(("[^A-Za-z0-9_ \t-]" . "")
    35                                         ("[ \t]+" . "-"))))))
    36    ))
     27  (string-concatenate-reverse
     28   ;; This is required because section headings might contain inline markup
     29   (let get-strings ((r r)
     30                     (s '()))
     31     (cond
     32      ((string? r)
     33       (cons (string-substitute* (string-downcase r)
     34                                 '(("[^A-Za-z0-9_ \t-]" . "")
     35                                   ("[ \t]+" . "-"))) s))
     36      ((not (pair? r)) s)
     37      (else (get-strings (cdr r) (get-strings (car r) s)))))))
    3738
    3839(define (html-transformation-rules content)
    3940  `((
    40      (@ *preorder* . ,(lambda element element))
     41     (@ *preorder* . ,(lambda (tag elements) (cons tag elements)))
    4142
    4243     (Header
    43       *macro*
     44      *preorder*
    4445      . ,(lambda (tag headers)
    4546           (make-html-header headers)))
    4647
    47      (Section
     48     (toc ;; Re-scan the content for "section" tags and generate
     49      *macro*
     50      . ,(lambda (tag rest) ;; the table of contents
     51           `(div (@ (id "toc"))
     52                 ,rest
     53                 (ol ,(let find-sections ((content content))
     54                        (cond
     55                         ((not (pair? content)) '())
     56                         ((pair? (car content))
     57                          (append (find-sections (car content))
     58                                  (find-sections (cdr content))))
     59                         ((eq? (car content) 'section)
     60                          (let* ((level (cadr content))
     61                                 (head-word (caddr content))
     62                                 (href (conc "#" (internal-link head-word)))
     63                                 (subsections (find-sections (cdddr content))))
     64                            (cond ((and (integer? level) head-word)
     65                                   `((li (a (@ (href ,href)) ,head-word)
     66                                         ,@(if (null? subsections)
     67                                               '()
     68                                               `((ol ,subsections))))))
     69                                  (else
     70                                   (error 'html-transformation-rules
     71                                          "section elements must be of the form (section level head-word . contents)")))))
     72                         (else (find-sections (cdr content)))))))))
     73     
     74     (section
    4875      *macro*
    4976      . ,(lambda (tag elems)
    5077           (let ((level (car elems))
    51                  (head-word (cadr elems)))
     78                 (head-word (cadr elems))
     79                 (contents (cddr elems)))
    5280             (cond ((and (integer? level) head-word)
    53                     `(,(string->symbol (string-append "h" (number->string level)))
    54                       ,head-word ))
     81                    `((,(string->symbol (string-append "h" (number->string level)))
     82                      (@ (id ,(internal-link head-word)))
     83                      ,head-word ) . ,contents))
    5584                  (else
    5685                   (error 'html-transformation-rules
    57                           "section elements must be of the form (Section level head-word)")))
     86                          (conc "section elements must be of the form (section level head-word . contents), got " elems))))
    5887             )))
    5988
    60      (Section*
     89     (def
     90       ((sig . ,(lambda (tag types)
     91                  (map (lambda (spec)
     92                         `(span (@ (class ,(conc "definition " (car spec))))
     93                                (em "[" ,(symbol->string (car spec)) "]")
     94                                " " (tt ,@(cdr spec)) (br)))
     95                       types))))
     96       . ,(lambda (tag elems) elems))
     97     
     98     (pre
     99      . ,(lambda (tag elems)
     100           `(pre (tt . ,elems))))
     101
     102     (image-link
    61103      *macro*
    62104      . ,(lambda (tag elems)
    63            (let ((level (car elems))
    64                  (head-word (cadr elems)))
    65              (cond ((and (integer? level) head-word)
    66                     `(,(string->symbol (string-append "h" (number->string level)))
    67                       ,head-word))
    68                    (else
    69                     (error 'html-transformation-rules
    70                            "section elements must be of the form (Section level head-word)")))
    71              )))
    72 
    73      (definition
    74        ((@
    75          ((type . ,(lambda (tag value) `(type ,value)))
    76          
    77           )
    78          . ,(lambda (tag elems) elems)))
    79        . ,(lambda (tag x)
    80             `(span (@ (class ,(conc "definition " (car x))))
    81                    (em "[" ,(symbol->string (car x)) "]")
    82                    (type ,@(cdr x))
    83                    (br))))
     105           `(img (@ (src ,(car elems)) . ,(if (null? (cdr elems))
     106                                              '()
     107                                              `((alt ,(cadr elems))
     108                                                (title ,(cadr elems))))))))
    84109     
    85      (special
    86       ((@
    87         ((*default* . ,(lambda (tag value)
    88                          (cons (string->symbol (string-upcase (symbol->string tag))) value))))
    89         . ,(lambda (tag elems) elems)))
    90       . ,(lambda (tag elems) elems))
    91 
    92      (preformatted
    93       . ,(lambda (tag elems)
    94            `(pre (tt ,elems))))
    95          
    96      (type
     110     (int-link
    97111      *macro*
    98112      . ,(lambda (tag elems)
    99            `(tt ,elems)))
    100 
    101      (url
     113           `(a (@ (href ,(car elems)) (class "internal"))
     114               ,(if (null? (cdr elems)) (car elems) (cadr elems)))))
     115     
     116     (link
    102117      *macro*
    103118      . ,(lambda (tag elems)
    104            `(a (@ (href ,(car elems))) ,(cadr elems))))
     119           `(a (@ (href ,(car elems)) (class "external"))
     120               ,(if (null? (cdr elems)) (car elems) (cadr elems)))))
    105121
    106122     ,@alist-conv-rules*
     
    116132             "</html>")))
    117133
    118      (toc ;; Re-scan the content for "Section" tags and generate
    119       . ,(lambda (tag rest) ;; the table of contents
    120            (let ((sections
    121                   (pre-post-order*
    122                    content
    123                    `(
    124                      (Section ;; (Section level "content ...")
    125                       ((*text* . ,(lambda (tag str) str)))
    126                       . ,(lambda (tag elems )
    127                            (let ((level (car elems))
    128                                  (head-word (cadr elems)))
    129                              (cond ((and (integer? level) head-word)
    130                                     (append
    131                                      (list "<li><a href=\"#"
    132                                            (internal-link head-word)
    133                                            "\">" head-word "</a>" nl)
    134                                      (list "</li>" nl)))
    135                                    (else
    136                                     (error 'html-transformation-rules
    137                                            "section elements must be of the form (Section level head-word)")))
    138                            )))
    139 
    140                      (*default*
    141                       . ,(lambda (tag elems) elems))
    142                      
    143                      (*text* . ,(lambda (trigger str) (list)))))))
    144 
    145              (list "<div id=\"toc\">"
    146                    rest
    147                    "<ul>"
    148                    sections
    149                    "</ul>"
    150                    "</div>"
    151                    ))))
    152 
    153134     (verbatim
    154135      *preorder*
  • release/4/multidoc/trunk/latex.scm

    r18463 r18633  
    6565(define (LaTeX-transformation-rules content)
    6666  `((
    67     (@
    68       ((*default*       ; local override for attributes
    69         . ,(lambda (attr-key value)
    70              (cons (string->symbol (->string attr-key)) (car value)))))
    71       . ,(lambda (trigger value) (list '@ value)))
     67    (@ . ,(lambda (trigger value) (cons '@ value)))
    7268
    7369     (*default* . ,(lambda (tag elems) (cons (->string tag) elems)))
     
    8480      . ,(lambda (tag elems) '()))
    8581
    86      (Section   ; (Section level head-word)
     82     (section   ; (section level head-word . contents)
    8783      . ,(lambda (tag elems)
    8884           (let* ((level (car elems))
    89                   (head-word (cadr elems)))
     85                  (head-word (cadr elems))
     86                  (contents (cddr elems)))
    9087            (cond ((and (integer? level) head-word)
    91                     (list #\\
    92                           (case level
    93                             ((1) "section")
    94                             ((2 3) "subsection*")
    95                             ((4) "subsubsection*")
    96                             (else (error "unsupported section level: " level)))
    97                           "{" head-word "}"  nl
    98                           (if (= level 1)
    99                               (list "\\label{" (LaTeX-label head-word)  "}")
    100                               (list)) nl))
     88                    `(#\\
     89                      ,(case level
     90                         ((1) "section")
     91                         ((2 3) "subsection*") ;; No nesting?
     92                         ((4) "subsubsection*")
     93                         ((5) "paragraph")
     94                         ((6) "subparagraph")
     95                         (else (error "unsupported section level: " level)))
     96                      "{" ,head-word "}"  ,nl
     97                      ,(if (= level 1)
     98                           (list "\\label{" (LaTeX-label head-word)  "}")
     99                           (list)) ,nl . ,contents))
    101100                  (else
    102101                   (error 'latex-transformation-rules
     
    105104
    106105
    107      (TOC . ,(lambda (tag elems) (list nl "\\tableofcontents{}" nl)))
     106     (toc . ,(lambda (tag elems) (list nl "\\tableofcontents{}" nl)))
    108107
    109108     (body
     
    113112                         )))
    114113
    115      (url
    116       ((@
    117         ((href . ,(lambda (tag value)
    118                     (LaTeX-add-package! 'url)
    119                     (list "\\url{" value "}"))))
    120         . ,(lambda (tag elems) elems)))
    121       . ,(lambda (tag elems) elems))
     114     (link
     115      . ,(lambda (tag elems)
     116           (LaTeX-add-package! 'url)
     117           (list "\\url{" (car elems) "}")))
    122118
    123119     ; Standard typography
     
    130126           (list "{\\rmfamily\\bfseries{}" elems "}")))
    131127
    132      (type
     128     (tt
    133129      . ,(lambda (tag elems)
    134130           (list "{\\ttfamily{}" elems "}")))
     
    197193      )
    198194       
    199      (definition
    200       ((@
    201         ((type . ,(lambda (tag value) `(type ,value))))
    202         ))
    203        . ,(lambda (tag elems)
    204             (in-LaTeX-env
    205              "description" '()
    206              (list  "\\item[" (car elems) "] {\\ttfamily{}" (cdr elems) "}"))))
    207                    
    208      (special
     195     (def
     196       ((sig . ,(lambda (tag types)
     197                  (map (lambda (spec)
     198                         (in-LaTeX-env
     199                          "description" '()
     200                          (list  "\\item[" (car spec) "] {\\ttfamily{}"
     201                                 (cdr spec) "}")))
     202                       types))))
     203       . ,(lambda (tag elems) elems))
     204
     205     (blockquote
     206      . ,(lambda (tag elems)
     207           (in-LaTeX-env "quote" '() elems)))
     208
     209     (pre
    209210      *macro*
    210       . ,(lambda (tag elems) '()))
    211 
    212 
    213      (blockquote
    214       . ,(lambda (tag elems)
    215            (in-LaTeX-env "quote" '() elems)))
    216 
    217      (preformatted
    218       *macro*
    219       . ,(lambda (tag elems)
    220            `(verbatim ,elems)))
    221          
    222 
     211      . ,(lambda (tag elems)
     212           `(verbatim . ,elems)))
     213     
    223214     (verbatim  ; set off pieces of code: one or several lines
    224215      ((*text* . ; Different quotation rules apply within a "verbatim" block
     
    233224           (in-LaTeX-env "lyxcode" '()
    234225                       (map (lambda (line)
    235                               (or (pair? line) (string? line)
     226                              (if (or (pair? line) (string? line))
     227                                  line
    236228                                  (list (if (equal? line "") "~" line)
    237229                                        "\\\\" nl)))
  • release/4/multidoc/trunk/multidoc.meta

    r16995 r18633  
    1818 ; A list of eggs multidoc depends on.
    1919
    20  (needs datatype sxml-transforms doctype uri-generic)
     20 (needs datatype sxml-transforms doctype uri-generic sxpath)
    2121
    2222 (author "Ivan Raikov and Peter Bex")
  • release/4/multidoc/trunk/multidoc.scm

    r16995 r18633  
    22;; multidoc - convert SXML to output in various document formats
    33;;
    4 ;; Copyright (c) 2009 Peter Bex and Ivan Raikov
     4;; Copyright (c) 2009-2010 Peter Bex and Ivan Raikov
    55;;
    66;;  Redistribution and use in source and binary forms, with or without
     
    5151
    5252(require-extension posix srfi-1 srfi-13 data-structures regex )
    53 (require-extension datatype sxml-transforms doctype uri-generic)
     53(require-extension datatype sxml-transforms sxpath doctype uri-generic)
    5454
    5555
  • release/4/multidoc/trunk/texinfo.scm

    r16995 r18633  
    44;;;;
    55
    6 (define (regions pred lst)
    7   (let recur ((lst lst) (rs '(())))
    8     (cond ((null? lst)
    9            (reverse (cons (reverse (car rs)) (cdr rs))))
    10 
    11           ((pred (car lst))
    12            (recur (cdr lst) (cons (list (car lst))
    13                                   (cons (reverse (car rs)) (cdr rs)))))
    14           (else
    15            (recur (cdr lst) (cons (cons (car lst) (car rs)) (cdr rs)))))))
    16            
    17 
    186(define (section? content)
    19   (and (pair? content) (and (eq? 'Section (car content)))))
     7  (and (pair? content) (and (eq? 'section (car content)))))
    208
    219
     
    9785           (let ((section (caar lst))
    9886                 (contents (cdar lst)))
    99              (let ((level (car (cadr section)))
    100                    (head-word (cadr (cadr section))))
     87             (let ((level (cadr section))
     88                   (head-word (cadr section)))
    10189               (let ((node (make-section level head-word contents '())))
    10290                 
     
    191179                                (recur (car elems))
    192180                                elems))))
    193              (let* ((sections (regions section? content))
     181             (let* ((sections ((sxpath '(// section)) content))
    194182                    (tree     (make-section-tree sections)))
    195183               (let recur ((tree tree))
     
    209197    (
    210198                        ; General conversion rules
    211      (@
    212       ((*default*       ; local override for attributes
    213         . ,(lambda (attr-key value)
    214              (cons (string->symbol (->string attr-key)) (car value)))))
    215       . ,(lambda (trigger value) (list '@ value)))
     199     (@ . ,(lambda (trigger value) (cons '@ value)))
    216200
    217201     (*default* . ,(lambda (tag elems) (cons (->string tag) elems)))
     
    234218                   (Texinfo-format-menu menu) nl))))
    235219
    236      (Section   ; (Section level "content ...")
     220     (section   ; (section level "content ..." . contents)
    237221      . ,(lambda (tag elems)
    238222           (let ((level (car elems))
    239223                 (head-word (cadr elems))
    240                  (menu  (caddr elems)))
    241              (list nl
    242                    "@node " (Texinfo-node-label head-word) nl
    243                    (case level
    244                      ((1)   "@chapter ")
    245                      ((2)   "@section ")
    246                      ((3)   "@subsection ")
    247                      ((4)   "@subsubsection ")
    248                      (else (error "unsupported section level: " level)))
    249                    head-word nl
    250                    (Texinfo-format-menu menu) nl))))
    251 
    252      (TOC . ,(lambda (tag elems) (list nl "@contents" nl)))
     224                 (menu  (caddr elems))
     225                 (contents (cdddr elems)))
     226             `(,nl
     227               "@node " ,(Texinfo-node-label head-word) ,nl
     228               ,(case level
     229                  ((1)   "@chapter ")
     230                  ((2)   "@section ")
     231                  ((3)   "@subsection ")
     232                  ((4)   "@subsubsection ")
     233                  ((5)   "@paragraph ")
     234                  ((6)   "@subparagraph ")
     235                  (else (error "unsupported section level: " level)))
     236               ,head-word ,nl
     237               ,(Texinfo-format-menu menu) ,nl . ,contents))))
     238
     239     (toc . ,(lambda (tag elems) (list nl "@contents" nl)))
    253240
    254241
     
    270257           (in-Texinfo-cmd "strong" elems)))
    271258
    272      (type
     259     (tt
    273260      . ,(lambda (tag elems)
    274261           (in-Texinfo-cmd "code" elems)))
     
    333320      )
    334321       
    335      (definition
    336       ((@
    337         ((type . ,(lambda (tag value) `(type ,value))))
    338         ))
    339        . ,(lambda (tag elems)
    340             (map (lambda (x)
    341                    (in-Texinfo-env "table" '("@asis")
    342                                    (list "@item " (car x) nl (cdr x) "}")))
    343                  elems)))
    344 
    345      (special
     322     (def
     323       ((sig . ,(lambda (tag types)
     324                  (map (lambda (spec)
     325                         (in-Texinfo-env "table" '("@asis")
     326                                   (list "@item " (car spec) nl (cdr spec) "}")))
     327                       types))))
     328       . ,(lambda (tag elems) elems))
     329
     330     (blockquote
     331      . ,(lambda (tag elems)
     332           (in-Texinfo-env "quotation" '() elems)))
     333
     334     (pre
    346335      *macro*
    347       . ,(lambda (tag elems) '()))
    348 
    349      (blockquote
    350       . ,(lambda (tag elems)
    351            (in-Texinfo-env "quotation" '() elems)))
    352 
    353 
    354      (preformatted
    355       *macro*
    356       . ,(lambda (tag elems)
    357            `(verbatim ,elems)))
     336      . ,(lambda (tag elems)
     337           `(verbatim . ,elems)))
    358338         
    359 
    360339     (verbatim  ;; set off pieces of code: one or several lines
    361340      ((*text* . ;; Different quotation rules apply within a "verbatim" block
Note: See TracChangeset for help on using the changeset viewer.