Changeset 32669 in project


Ignore:
Timestamp:
08/08/15 17:36:38 (4 years ago)
Author:
sjamaan
Message:

qwiki: Apply changes by Arthur Maciel to remove dependency on multidoc (basically, import the multidoc rules into qwiki)

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

Legend:

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

    r26535 r32669  
    3838(module qwiki-sxml
    3939
    40   (title-for-wiki-page
    41    qwiki-html-transformation-rules
    42    qwiki-LaTeX-transformation-rules
    43    qwiki-Texinfo-transformation-rules)
     40(title-for-wiki-page
     41 qwiki-html-transformation-rules)
    4442
    4543(import chicken scheme)
    4644
    47 (use posix srfi-1 srfi-13 data-structures extras multidoc)
     45(use posix srfi-1 srfi-13 data-structures extras irregex)
    4846(use sxml-transforms doctype uri-generic sxpath colorize html-parser)
    4947
     
    6563                     section-contents)))))
    6664
    67 ;;;;
    68 ;;;;  HTML stylesheet
    69 ;;;;
     65(define (lookup-def k lst . rest)
     66  (let-optionals rest ((default #f))
     67                 (alist-ref k lst eq? default)))
     68
     69(define (make-html-header head-params)
     70  `(head
     71    (title ,(or (lookup-def 'title head-params) "multidoc"))
     72    (meta (@ (http-equiv "Content-Style-Type") (content "text/css")))
     73    (meta (@ (http-equiv "Content-Type")
     74             (content ,(lookup-def 'Content-Type head-params
     75                                   "text/html; charset=UTF-8"))))
     76    ,(let ((style  (lookup-def 'style head-params))
     77           (print-style  (lookup-def 'print-style head-params))
     78           (canonical (lookup-def 'canonical head-params)))
     79       (list (if style `(link (@ (rel "stylesheet") (type "text/css") (href ,style))) '())
     80             (if print-style `(link (@ (rel "stylesheet") (type "text/css")
     81                                       (media "print")  (href ,print-style))) '())
     82             (if canonical `(link (@ (rel "canonical") (href ,canonical))) '())))
     83    ;; Remove already processed head parameters, inserting only unprocessed ones
     84    ,@(remove (lambda (param)
     85                (member (car param) '(title style print-style canonical new-file read-only read-write)))
     86              head-params)))
     87
     88(define (internal-link r)
     89  (pre-post-order*
     90   r
     91   `((*default* . ,(lambda (tag . elems) elems))
     92     (*text* . ,(lambda (trigger str)
     93                  (let ((str (string-downcase str)))
     94                    (fold (lambda (regex/subst str)
     95                            (irregex-replace/all (car regex/subst) str (cdr regex/subst)))
     96                          str
     97                          '(("^[^a-z]+" . "")
     98                            ("[^a-z0-9_ \t-]" . "")
     99                            ("[ \t]+" . "-")))))))))
    70100
    71101(define (qwiki-html-transformation-rules content)
    72   `(
    73     (
    74 
    75      (wiki-page
    76       *macro*
    77       . ,(lambda (tag elems)
    78            `(html:begin . ,elems)))
     102  `(((wiki-page
     103      *macro*
     104      . ,(lambda (tag elems)
     105           `(html:begin . ,elems)))
    79106
    80107     ;; Maybe this should be done in multiple steps to make it more "hookable"
     
    82109      *macro*
    83110      . ,(lambda (tag items)
    84            `(table
    85              (tr (th "revision")
    86                  (th "author")
    87                  (th "date")
    88                  (th "description"))
    89              ,@(map (lambda (item)
    90                       ;; XXX nofollow should really apply to the entire page
    91                       ;; instead of on each individual link.  But to do that
    92                       ;; we need to hack multidoc.  It's time to replace
    93                       ;; multidoc or clean it up and start maintaining it.
    94                       `(tr (td (a (@ (rel "nofollow")
     111           `(table
     112             (tr (th "revision")
     113                 (th "author")
     114                 (th "date")
     115                 (th "description"))
     116             ,@(map (lambda (item)
     117                      ;; TODO: The nofollow should really apply to the
     118                      ;; entire page instead of each individual link.
     119                      `(tr (td (a (@ (rel "nofollow")
    95120                                     (href ,(string-append
    96121                                             "?action=show&rev="
    97122                                             (number->string (car item)))))
    98123                                  ,(car item)))
    99                            (td ,(cadr item))
    100                            (td ,(time->string (caddr item)))
    101                            (td ,(cadddr item))))
    102                     items))))
     124                           (td ,(cadr item))
     125                           (td ,(time->string (caddr item)))
     126                           (td ,(cadddr item))))
     127                    items))))
    103128
    104129     (wiki-content
     
    125150                               (cdr elems)))))
    126151             `(pre (@ (class ,classname)) . ,code))))
    127      
     152
    128153     (examples
    129154      ((example
     
    156181      . ,(lambda (tag elems)
    157182           `(div (@ (class "examples"))
    158                  (span (@ (class "examples-heading")) "Examples:") . ,elems)))     
     183                 (span (@ (class "examples-heading")) "Examples:") . ,elems)))
     184
    159185     (page-specific-links
    160186      *macro*
    161187      . ,(lambda (tag elems)
    162            `(ul (@ (id "page-specific-links"))
    163                 (li ,(if ((if-sxpath '(// new-file)) (cons tag elems))
     188           `(ul (@ (id "page-specific-links"))
     189                (li ,(if ((if-sxpath '(// new-file)) (cons tag elems))
    164190                         `(span (@ (class "disabled")
    165191                                   (title "This page doesn't exist yet"))
    166192                                "show")
    167193                         `(a (@ (href "?action=show")) "show")))
    168                 (li ,(if ((if-sxpath '(// read-only)) (cons tag elems))
     194                (li ,(if ((if-sxpath '(// read-only)) (cons tag elems))
    169195                         `(span (@ (class "disabled")
    170196                                   (title "This page has been frozen. "
     
    173199                                "edit")
    174200                         `(a (@ (href "?action=edit") (rel "nofollow")) "edit")))
    175                 (li ,(if ((if-sxpath '(// new-file)) (cons tag elems))
     201                (li ,(if ((if-sxpath '(// new-file)) (cons tag elems))
    176202                         `(span (@ (class "disabled")
    177203                                   (title "This page doesn't exist yet"))
     
    179205                         `(a (@ (href "?action=history")) "history"))))))
    180206
    181      ,@alist-conv-rules*
    182      )
    183    
    184      ,@(html-transformation-rules content)
    185 
    186   ))
    187 
    188 ;;;;
    189 ;;;;  LaTeX stylesheet
    190 ;;;;
    191 
    192 (define nl (list->string (list #\newline)))
    193 
    194 (define (qwiki-LaTeX-transformation-rules content)
    195   `(
    196     (
    197      (wiki-page
    198       . ,(lambda (tag elems)
    199              (list
    200               `(tex
    201                 "\\documentclass[12pt]{article}" ,nl
    202                 "\\usepackage[left=3cm]{geometry}" ,nl
    203 
    204                 ,(map (lambda (p) (LaTeX-use-package (car p) (cadr p)))
    205                       (LaTeX-packages)) ,nl
    206                      
    207                       "%%%%%%%%%%%%%%%%%%%%%%%%%% Textclass specific LaTeX commands." ,nl
    208                       " \\newenvironment{lyxcode}" ,nl
    209                       "   {\\begin{list}{}{" ,nl
    210                       "     \\raggedright" ,nl
    211                       "     \\setlength{\\itemsep}{-5pt}" ,nl
    212                       "     \\setlength{\\parsep}{-3pt}" ,nl
    213                       "     \\normalfont\\ttfamily}%" ,nl
    214                       "    \\item[]}" ,nl
    215                       "   {\\end{list}}" ,nl
    216 
    217                       "\\makeatother" ,nl
    218                       "\\sloppy" ,nl
    219            
    220                       "\\newcommand{\\minitab}[2][l]{\\begin{tabular}{#1}#2\\end{tabular}}" ,nl)
    221              
    222               nl
    223               elems
    224               )))
    225 
    226      ;; No syntax highlighting yet, present as preformatted
    227      (highlight
    228       *macro*
    229       . ,(lambda (tag elems)
    230            ;; (highlight LANGUAGE "text" ...)
    231            `(pre . ,(cdr elems))))
    232      
    233      (examples
    234       ((example
    235         ((init
    236           *macro*
    237           . ,(lambda (tag elems)
    238                `(pre . ,elems)))
    239          (expr
    240           *macro*
    241           . ,(lambda (tag elems)
    242                `(pre . ,elems)))
    243          (input
    244           *macro*
    245           . ,(lambda (tag elems)
    246                `((em "input: ")
    247                  (pre . ,elems))))
    248          (output
    249           *macro*
    250           . ,(lambda (tag elems)
    251                `((em "output: ")
    252                  (pre . ,elems))))
    253          (result
    254           *macro*
    255           . ,(lambda (tag elems)
    256                `(pre " => " . ,elems))))
    257         . ,(lambda (tag elems)
    258              elems)))
     207     (@ *preorder* . ,(lambda (tag elements) (cons tag elements)))
     208
     209     (Header
     210      *preorder*
     211      . ,(lambda (tag headers)
     212           (make-html-header headers)))
     213
     214     (toc ;; Re-scan the content for "section" tags and generate
     215      *macro*
     216      . ,(lambda (tag rest) ;; the table of contents
     217           `(div (@ (id "toc"))
     218                 ,rest
     219                 (ol ,(let find-sections ((content content))
     220                        (cond
     221                         ((not (pair? content)) '())
     222                         ((pair? (car content))
     223                          (append (find-sections (car content))
     224                                  (find-sections (cdr content))))
     225                         ((eq? (car content) 'section)
     226                          (let* ((level (cadr content))
     227                                 (head-word (caddr content))
     228                                 (href (list "#" (internal-link head-word)))
     229                                 (subsections (find-sections (cdddr content))))
     230                            (cond ((and (integer? level) head-word)
     231                                   `((li (a (@ (href (,href))) ,head-word)
     232                                         ,@(if (null? subsections)
     233                                               '()
     234                                               `((ol ,subsections))))))
     235                                  (else
     236                                   (error 'html-transformation-rules
     237                                          "section elements must be of the form (section level head-word . contents)")))))
     238                         (else (find-sections (cdr content)))))))))
     239
     240     (section
     241      *macro*
     242      . ,(lambda (tag elems)
     243           (let ((level (car elems))
     244                 (head-word (cadr elems))
     245                 (contents (cddr elems)))
     246             (cond ((and (integer? level) head-word)
     247                    `((,(string->symbol (string-append "h" (number->string level)))
     248                       (@ (id ,(internal-link head-word)))
     249                       ,head-word ) . ,contents))
     250                   (else
     251                    (error 'html-transformation-rules
     252                           (conc "section elements must be of the form (section level head-word . contents), got " elems)))))))
     253
     254     (section*
     255      *macro*
     256      . ,(lambda (tag elems)
     257           (let ((level (car elems))
     258                 (head-word (cadr elems))
     259                 (contents (cddr elems)))
     260             (cond ((and (integer? level) head-word)
     261                    `((,(string->symbol (string-append "h" (number->string level)))
     262                       ,head-word ) . ,contents))
     263                   (else
     264                    (error 'html-transformation-rules
     265                           (conc "section elements must be of the form (section level head-word . contents), got " elems)))))))
     266
     267     (def
     268      ((sig . ,(lambda (tag types)
     269                 (map (lambda (spec)
     270                        `(span (@ (class ,(conc "definition " (car spec))))
     271                               (em "[" ,(symbol->string (car spec)) "]")
     272                               " " (tt ,@(cdr spec)) (br)))
     273                      types))))
     274      . ,(lambda (tag elems) elems))
     275
     276     (pre
     277      . ,(lambda (tag elems)
     278           `(pre (tt . ,elems))))
     279
     280     (image-link
     281      *macro*
     282      . ,(lambda (tag elems)
     283           `(img (@ (src ,(car elems)) . ,(if (null? (cdr elems))
     284                                              '()
     285                                              `((alt ,(cadr elems))
     286                                                (title ,(cadr elems))))))))
     287
     288     (int-link
     289      *macro*
     290      . ,(lambda (tag elems)
     291           ;; Normalize links so people can refer to sections by their proper name
     292           (let* ((parts (string-split (car elems) "#" #t))
     293                  (nparts (intersperse
     294                           (cons (car parts) (internal-link (cdr parts)))
     295                           "#")))
     296             `(a (@ (href ,@nparts) (class "internal"))
     297                 ,(if (null? (cdr elems)) (car elems) (cadr elems))))))
     298
     299     (link
     300      *macro*
     301      . ,(lambda (tag elems)
     302           `(a (@ (href ,(car elems)) (class "external"))
     303               ,(if (null? (cdr elems)) (car elems) (cadr elems)))))
     304
     305     ,@alist-conv-rules*)
     306
     307    ((html:begin
     308      . ,(lambda (tag elems)
     309           (list
     310            xhtml-1.0-strict
     311            "<html xmlns=\"http://www.w3.org/1999/xhtml\">"
     312            elems
     313            "</html>")))
     314
     315     (verbatim
     316      *preorder*
    259317      . ,(lambda (tag elems)
    260318           elems))
    261319
    262      ,@alist-conv-rules*
    263      )
    264 
    265      ,@(LaTeX-transformation-rules content)
    266      ))
    267 
    268 ;;;;
    269 ;;;;  Texinfo stylesheet
    270 ;;;;
    271 
    272 (define nl (list->string (list #\newline)))
    273 
    274 (define (qwiki-Texinfo-transformation-rules content)
    275   `(
    276     (
    277      (wiki-page
    278       *macro* .
    279       ,(lambda (tag elems) (cons 'body elems)))
    280 
    281 
    282      ;; No syntax highlighting yet, present as preformatted
    283      (highlight
    284       *macro*
    285       . ,(lambda (tag elems)
    286            ;; (highlight LANGUAGE "text" ...)
    287            `(pre . ,(cdr elems))))
    288      
    289      (examples
    290       ((example
    291         ((init
    292           *macro*
    293           . ,(lambda (tag elems)
    294                `(pre . ,elems)))
    295          (expr
    296           *macro*
    297           . ,(lambda (tag elems)
    298                `(pre . ,elems)))
    299          (input
    300           *macro*
    301           . ,(lambda (tag elems)
    302                `((em "input: ")
    303                  (pre . ,elems))))
    304          (output
    305           *macro*
    306           . ,(lambda (tag elems)
    307                `((em "output: ")
    308                  (pre . ,elems))))
    309          (result
    310           *macro*
    311           . ,(lambda (tag elems)
    312                `(pre " => " . ,elems)))
    313          (*text* . ,(lambda (tag elems) elems))
    314          (*default* . ,(lambda (tag elems) '())))
    315         . ,(lambda (tag elems)
    316              elems)))
    317       . ,(lambda (tag elems)
    318            elems))
    319 
    320      ,@alist-conv-rules
    321      )
    322 
    323      ,@(Texinfo-transformation-rules content)
    324      ))
    325 
     320     ,@universal-conversion-rules*)))
    326321
    327322)
  • release/4/qwiki/trunk/qwiki.meta

    r27854 r32669  
    22
    33((synopsis "qwiki - the quick wiki")
    4  (depends (intarweb "1.0") (uri-common "1.0") (spiffy "5.1") (doctype "1.2") 
    5           (sxml-transforms "1.4") multidoc (svn-client "0.17") estraier-client
     4 (depends (intarweb "1.0") (uri-common "1.0") (spiffy "5.1") (doctype "1.2")
     5          (sxml-transforms "1.4") (svn-client "0.17") estraier-client
    66          sxpath (message-digest "3.0.0") (sha1 "3.0.0") (svnwiki-sxml 0.2.1)
    77          html-parser colorize)
  • release/4/qwiki/trunk/qwiki.scm

    r27854 r32669  
    22;; qwiki - the quick wiki
    33;;
    4 ;; Copyright (c) 2009-2012 Peter Bex and Ivan Raikov
     4;; Copyright (c) 2009-2015 Peter Bex and Ivan Raikov
    55;;
    66;;  Redistribution and use in source and binary forms, with or without
  • release/4/qwiki/trunk/qwiki.setup

    r31181 r32669  
    1 ;;;; -*- Hen -*-
     1;; -*- Scheme -*-
    22
    33(compile -O2 -d2 -s qwiki-sxml.scm -j qwiki-sxml)
     
    2424    "qwiki-menu.so" "qwiki-menu.import.so"
    2525    "qwiki-install.so" "qwiki-install.import.so"
    26     "qwiki-post-commit-hook.so" "qwiki-post-commit-hook.import.so"
    27     )
     26    "qwiki-post-commit-hook.so" "qwiki-post-commit-hook.import.so")
    2827  `((version "1.6.1")
    2928    (documentation "qwiki.html")))
  • release/4/qwiki/trunk/tests/run.scm

    r26106 r32669  
    1 
    21(require-extension test qwiki-sxml sxml-transforms svnwiki-sxml)
    32
     
    109(test-begin "qwiki")
    1110
     11;; TODO: This test doesn't really test anything except for that the
     12;; conversion process doesn't result in an error.  Perhaps add
     13;; "expected" HTML files and test that the output doesn't differ?
    1214(for-each
    1315 (lambda (name)
     
    2224       (lambda ()
    2325         (output-xml `(wiki-page (Header (read-only)) (body (wiki-content ,content)))
    24                      (qwiki-html-transformation-rules content))))
    25 
    26      ;; The LaTeX rules are broken.  Since we aren't using those in the wiki
    27      ;; disable the test for now.  Eventually we should either resurrect
    28      ;; multidoc, write a replacement for it, or drop all non-html support.
    29      #;
    30      (with-output-to-file (string-append (->string name) ".tex")
    31        (lambda ()
    32          (output-xml `(wiki-page ,content) (qwiki-LaTeX-transformation-rules content))))
    33        
    34      (with-output-to-file (string-append (->string name) ".texi")
    35        (lambda ()
    36          (output-xml `(wiki-page ,content) (qwiki-Texinfo-transformation-rules content))))
    37 
    38      ))
     26                     (qwiki-html-transformation-rules content))))))
    3927 
    40  `(simple bb defstruct  index  one  opengl  ))
     28 `(simple bb defstruct index one opengl))
    4129
    4230(test-end)
    4331
    44 (unless (zero? (test-failure-count)) (exit 1))
     32(test-exit)
Note: See TracChangeset for help on using the changeset viewer.