Changeset 36888 in project


Ignore:
Timestamp:
11/24/18 17:15:23 (2 weeks ago)
Author:
syn
Message:

hyde: Drop multidoc dependency

Location:
release/4/hyde/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/hyde/trunk/hyde.meta

    r36884 r36888  
    1313        svnwiki-sxml
    1414        defstruct
    15         multidoc
     15        sxpath
     16        html-parser
    1617        atom
    1718        rfc3339))
  • release/4/hyde/trunk/hyde.scm

    r36884 r36888  
    7070     svnwiki-sxml
    7171     defstruct
    72      (rename multidoc (html-transformation-rules
    73                        multidoc-html-transformation-rules)))
     72     sxpath
     73     html-parser)
    7474
    7575(use hyde-page-eval-env)
     
    521521          (cdr attrs))))
    522522
     523;; Copied from qwiki-sxml
     524(define (internal-link r)
     525  (pre-post-order*
     526   r
     527   `((*default* . ,(lambda (tag . elems) elems))
     528     (*text* . ,(lambda (trigger str)
     529                  (let ((str (string-downcase str)))
     530                    (fold (lambda (regex/subst str)
     531                            (irregex-replace/all (car regex/subst) str (cdr regex/subst)))
     532                          str
     533                          '(("^[^a-z]+" . "")
     534                            ("[^a-z0-9_ \t-]" . "")
     535                            ("[ \t]+" . "-")))))))))
     536
     537;; Copied from qwiki-sxml; some unnecessary rules were removed
     538(define (svnwiki-html-transformation-rules content)
     539  `(((diff
     540      *macro*
     541      . ,(lambda (tag elems)
     542           ;; The diff-language class is a bit weird here, but
     543           ;; consistent with what we would emit in a highlight block.
     544           (let* ((classname "highlight diff-language diff-page")
     545                  (diff (handle-exceptions exn elems
     546                          (map (lambda (s)
     547                                 (cdr (html->sxml (html-colorize 'diff s))))
     548                               elems))))
     549             `(pre (@ (class ,classname)) . ,diff))))
     550
     551     (wiki-content
     552      *macro* .
     553      ,(lambda (tag contents)
     554         `(div (@ (id "content")) . ,contents)))
     555
     556     (tags
     557      *preorder* .
     558      ,(lambda (tag page-tags)
     559         `(ul (@ (class "tags"))
     560              . ,(map (lambda (tag) `(li ,tag))
     561                      (string-split (car page-tags))))))
     562
     563     (highlight
     564      *macro*
     565      . ,(lambda (tag elems)
     566           (let* ((lang (car elems))
     567                  (classname (conc "highlight " lang "-language"))
     568                  (code (handle-exceptions exn
     569                            (cdr elems)
     570                          (map (lambda (s)
     571                                 (cdr (html->sxml (html-colorize lang s))))
     572                               (cdr elems)))))
     573             `(pre (@ (class ,classname)) . ,code))))
     574
     575     (examples
     576      ((example
     577        ((init
     578          *macro*
     579          . ,(lambda (tag elems)
     580               `(div (@ (class "init")) (highlight scheme . ,elems))))
     581         (expr
     582          *macro*
     583          . ,(lambda (tag elems)
     584               `(div (@ (class "expression")) (highlight scheme . ,elems))))
     585         (input
     586          *macro*
     587          . ,(lambda (tag elems)
     588               `(div (@ (class "io input")) (em "input: ")
     589                     (highlight scheme . ,elems))))
     590         (output
     591          *macro*
     592          . ,(lambda (tag elems)
     593               `(div (@ (class "io output")) (em "output: ")
     594                     (highlight scheme . ,elems))))
     595         (result
     596          *macro*
     597          . ,(lambda (tag elems)
     598               `(div (@ (class "result"))
     599                     (span (@ (class "result-symbol")) " => ")
     600                     (highlight scheme . ,elems))))) ;; Or use "basic lisp" here?
     601        . ,(lambda (tag elems)
     602             `(div (@ (class "example")) . ,elems))))
     603      . ,(lambda (tag elems)
     604           `(div (@ (class "examples"))
     605                 (span (@ (class "examples-heading")) "Examples:") . ,elems)))
     606
     607     (page-specific-links
     608      *macro*
     609      . ,(lambda (tag elems)
     610           `(ul (@ (id "page-specific-links"))
     611                (li ,(if ((if-sxpath '(// new-file)) (cons tag elems))
     612                         `(span (@ (class "disabled")
     613                                   (title "This page doesn't exist yet"))
     614                                "show")
     615                         `(a (@ (href "?action=show")) "show")))
     616                (li ,(if ((if-sxpath '(// read-only)) (cons tag elems))
     617                         `(span (@ (class "disabled")
     618                                   (title "This page has been frozen. "
     619                                          "Only someone with direct access "
     620                                          "to the repository can edit it."))
     621                                "edit")
     622                         `(a (@ (href "?action=edit") (rel "nofollow")) "edit")))
     623                (li ,(if ((if-sxpath '(// new-file)) (cons tag elems))
     624                         `(span (@ (class "disabled")
     625                                   (title "This page doesn't exist yet"))
     626                                "history")
     627                         `(a (@ (href "?action=history")) "history"))))))
     628
     629     (@ *preorder* . ,(lambda (tag elements) (cons tag elements)))
     630
     631     (toc ;; Re-scan the content for "section" tags and generate
     632      *macro*
     633      . ,(lambda (tag rest) ;; the table of contents
     634           `(div (@ (id "toc"))
     635                 ,rest
     636                 (ol ,(let find-sections ((content content))
     637                        (cond
     638                         ((not (pair? content)) '())
     639                         ((pair? (car content))
     640                          (append (find-sections (car content))
     641                                  (find-sections (cdr content))))
     642                         ((eq? (car content) 'section)
     643                          (let* ((level (cadr content))
     644                                 (head-word (caddr content))
     645                                 (href (list "#" (internal-link head-word)))
     646                                 (subsections (find-sections (cdddr content))))
     647                            (cond ((and (integer? level) head-word)
     648                                   `((li (a (@ (href (,href))) ,head-word)
     649                                         ,@(if (null? subsections)
     650                                               '()
     651                                               `((ol ,subsections))))))
     652                                  (else
     653                                   (error 'html-transformation-rules
     654                                          "section elements must be of the form (section level head-word . contents)")))))
     655                         (else (find-sections (cdr content)))))))))
     656
     657     (section
     658      *macro*
     659      . ,(lambda (tag elems)
     660           (let* ((level (car elems))
     661                  (head-word (cadr elems))
     662                  (link (internal-link head-word))
     663                  (contents (cddr elems)))
     664             (cond ((and (integer? level) head-word)
     665                    `((a (@ (href ,@(list "#" link)))
     666                         (,(string->symbol (string-append "h" (number->string level)))
     667                          (@ (id ,link))
     668                          ,head-word)) . ,contents))
     669                   (else
     670                    (error 'html-transformation-rules
     671                           (conc "section elements must be of the form (section level head-word . contents), got " elems)))))))
     672
     673     (section*
     674      *macro*
     675      . ,(lambda (tag elems)
     676           (let ((level (car elems))
     677                 (head-word (cadr elems))
     678                 (contents (cddr elems)))
     679             (cond ((and (integer? level) head-word)
     680                    `((,(string->symbol (string-append "h" (number->string level)))
     681                       ,head-word ) . ,contents))
     682                   (else
     683                    (error 'html-transformation-rules
     684                           (conc "section elements must be of the form (section level head-word . contents), got " elems)))))))
     685
     686     (def
     687      ((sig . ,(lambda (tag types)
     688                 (map (lambda (spec)
     689                        `(span (@ (class ,(conc "definition " (car spec))))
     690                               (em "[" ,(symbol->string (car spec)) "]")
     691                               " " (tt ,@(cdr spec)) (br)))
     692                      types))))
     693      . ,(lambda (tag elems) elems))
     694
     695     (pre
     696      . ,(lambda (tag elems)
     697           `(pre (tt . ,elems))))
     698
     699     (image-link
     700      *macro*
     701      . ,(lambda (tag elems)
     702           `(img (@ (src ,(car elems)) . ,(if (null? (cdr elems))
     703                                              '()
     704                                              `((alt ,(cadr elems))
     705                                                (title ,(cadr elems))))))))
     706
     707     (int-link
     708      *macro*
     709      . ,(lambda (tag elems)
     710           ;; Normalize links so people can refer to sections by their proper name
     711           (let* ((parts (string-split (car elems) "#" #t))
     712                  (nparts (intersperse
     713                           (cons (car parts) (internal-link (cdr parts)))
     714                           "#")))
     715             `(a (@ (href ,@nparts) (class "internal"))
     716                 ,(if (null? (cdr elems)) (car elems) (cadr elems))))))
     717
     718     (link
     719      *macro*
     720      . ,(lambda (tag elems)
     721           `(a (@ (href ,(car elems)) (class "external"))
     722               ,(if (null? (cdr elems)) (car elems) (cadr elems)))))
     723
     724     ,@alist-conv-rules*)
     725
     726    ((html:begin
     727      . ,(lambda (tag elems)
     728           (list xhtml-1.0-strict
     729                 "<html xmlns=\"http://www.w3.org/1999/xhtml\">"
     730                 elems
     731                 "</html>")))
     732
     733     (verbatim
     734      *preorder*
     735      . ,(lambda (tag elems)
     736           elems))
     737
     738     ,@universal-conversion-rules*)))
     739
    523740(define (translate-svnwiki)
    524741  (let* ((doc (svnwiki->sxml (current-input-port)))
    525742         (doc (pre-post-order* doc `((int-link . ,expand-link-shortcut/svnwiki)
    526743                                     ,@alist-conv-rules*)))
    527          (rules (multidoc-html-transformation-rules doc))
     744         (rules (svnwiki-html-transformation-rules doc))
    528745         (rules (append (butlast rules)
    529746                        (list (cons (assq 'inject sxml-conversion-rules)
Note: See TracChangeset for help on using the changeset viewer.