Changeset 8347 in project


Ignore:
Timestamp:
02/11/08 08:06:23 (11 years ago)
Author:
iraikov
Message:

Multiple additions and fixes to the Texinfo functionality.

Location:
stream-wiki
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • stream-wiki/tags

    • Property latest changed from 1.10 to 1.11
  • stream-wiki/trunk/stream-wiki.scm

    r6535 r8347  
    5454(include "chicken-more-macros")                                                                                               
    5555
    56 (use srfi-1 srfi-40 stream-ext html-stream stream-parser sandbox posix format-modular stream-sections)
     56(use srfi-1 srfi-40 stream-ext html-stream stream-parser sandbox posix format-modular stream-sections uri)
    5757
    5858; An output driver is simply a table of functions.
     
    16251625                         (include (lambda (name tail) tail)) (linktypes (make-hash-table))
    16261626                         (extensions (make-hash-table)) (extension-args #f))
    1627        (let-values (((texi-nodes lookup-table) (texi-menu str)))
    1628          (stream-append
    1629            (->stream-char "@menu\n")
    1630            texi-nodes
    1631            (->stream-char "@end menu\n")
    1632            (wiki-parse (texi-driver lookup-table) str tail name open include linktypes extensions extension-args))))))
    1633 
    1634 (define (texi-wrap start end)
    1635   (let ((real-start (string->stream start))
    1636         (real-end (string->stream end)))
    1637     (lambda (arg)
    1638       (stream-append real-start arg real-end))))
     1627     (let-values (((texi-nodes lookup-table) (texi-menu str)))
     1628         (stream-append
     1629          (->stream-char "@menu\n")
     1630          texi-nodes
     1631          (->stream-char "@end menu\n")
     1632          (wiki-parse (texi-driver lookup-table) str
     1633                      tail name open include linktypes extensions extension-args))))))
    16391634
    16401635(define (texi-page author title copyright first content . rest)
     
    16731668          "@bye\n")))))
    16741669
    1675 (define (texi-find-node lookup-table n)
    1676   (hash-table-ref lookup-table (string->symbol (escape-texi-node-name n))))
     1670
     1671
     1672(define (texi-find-node lookup-table n up-node . rest)
     1673  (let-optionals rest ((handler #f))
     1674    (let ((name  (string->symbol (escape-texi-node-name n up-node))))
     1675      (if handler
     1676          (hash-table-ref lookup-table name handler)
     1677          (hash-table-ref lookup-table name)))))
     1678
     1679(define (texi-wrap start end)
     1680  (let ((real-start (string->stream start))
     1681        (real-end (string->stream end)))
     1682    (lambda (arg)
     1683      (stream-append real-start arg real-end))))
     1684
     1685(define (texi-escape-text dst)
     1686  (stream-delay
     1687   (if (stream-null? dst)
     1688       stream-null
     1689       (case (stream-car dst)
     1690         ((#\@)
     1691          (stream-cons* #\@ (stream-car dst) (texi-escape-text (stream-cdr dst))))
     1692         (else (stream-cons (stream-car dst) (texi-escape-text (stream-cdr dst))))))))
     1693
     1694;; Look for a node starting at start-depth and checking at every level
     1695;; between 0 and start-depth.
     1696(define (texi-find-node-in-tree lookup-table n start-depth last-at-depth)
     1697  (let ((name  (string-intersperse
     1698                (string-tokenize n (char-set-complement (list->char-set (list #\#))))
     1699                " - ")))
     1700    (let loop ((depth start-depth))
     1701      (if (positive? depth)
     1702          (let* ((up-node  (vector-ref last-at-depth depth))
     1703                 (node     (texi-find-node lookup-table name up-node
     1704                                           (lambda () #f))))
     1705            (or node  (loop (- depth 1))))
     1706          (texi-find-node lookup-table name #f)))))
     1707                         
     1708;; If the stream has at least n elements, return a list containing
     1709;; those elements, otherwise return #f
     1710(define (stream->n-list strm n)
     1711  (let loop ((strm strm) (i 0) (lst (list)))
     1712    (if (stream-null? strm)
     1713        (if (= (+ 1 i) n) (list->string (reverse ax)) #f)
     1714        (if (< i n)
     1715            (loop (stream-cdr strm) (+ 1 i) (cons (stream-car strm) lst))
     1716            (list->string (reverse lst))))))
     1717
     1718(define (texi-unescape str)
     1719  (stream-delay
     1720    (if (stream-null? str) str
     1721        (match (stream-car str)
     1722          (#\@   (stream-cons (stream-cadr str) (texi-unescape (stream-cddr str))))
     1723          (else  (stream-cons (stream-car str) (texi-unescape (stream-cdr str))))))))
     1724
    16771725
    16781726(define (texi-driver lookup-table)
    1679   (make-driver
    1680     'texi
    1681     ; horizontal line
    1682     ; TODO: Implement!
    1683     (constantly stream-null)
    1684     ; make header
    1685     (lambda (name depth id)
    1686       (stream-append
    1687         ;; print the @node and @menu.
    1688         (->stream-char (texi-find-node lookup-table (stream->string name)))
    1689         (stream #\newline #\@)
    1690         (string->stream
    1691           (case depth
    1692             ((0) "chapter")
    1693             ((1) "section")
    1694             ((2) "subsection")
    1695             (else "subsubsection")))
    1696         (stream #\space)
    1697         name
    1698         (stream #\newline #\newline)))
    1699     ;; blockquote
    1700     (texi-wrap "@quotation\n" "\n@end quotation\n")
    1701     ; center
    1702     (texi-wrap "@center " "")
    1703     ; small
    1704     (lambda (x)
    1705       (error "Small not implemented yet in Texinfo mode."))
    1706     ; big
    1707     (lambda (x)
    1708       (error "Big not implemented yet in Texinfo mode."))
    1709     ; verbatim
    1710     (texi-wrap "@verbatim\n" "\n@end verbatim\n")
    1711     ; code
    1712     (texi-wrap "@code{" "}")
    1713     ; paragraph
    1714     (texi-wrap "" "\n\n")
    1715     ; strong
    1716     (texi-wrap "@b{" "}")
    1717     ; emphasis
    1718     (texi-wrap "@emph{" "}")
    1719     ; link
    1720     (lambda (dst name)
    1721       (stream-append
    1722         (string->stream
    1723           (if (and dst
    1724                    (not (stream-null? dst))
    1725                    (char=? (stream-car dst) #\#))
    1726             "@ref{"
    1727             "@uref{"))
    1728         dst
    1729         (stream #\, #\space)
    1730         name
    1731         (stream #\})))
    1732     ; image
    1733     (lambda (dst name)
    1734       (warning "Image not implemented in Texinfo mode.~%")
    1735       (receive (type alt)
    1736                (stream-break (cut char=? <> #\|) name)
    1737         (stream->string (format #f "[[IMAGE:~A]]" (stream->string (or alt dst))))))
    1738     ; math
    1739     (lambda (text)
    1740       (string->stream (format #f "$$~A$$" (stream->string text))))
    1741     ; ordered list
    1742     (texi-wrap "@enumerate\n" "\n@end enumerate\n")
    1743     ; bullets list
    1744     (texi-wrap "@itemize\n" "\n@end itemize\n")
    1745     ; list item
    1746     (texi-wrap "@item " "\n\n")
    1747     ; definition list
    1748     (texi-wrap "@table @b\n" "\n@end table\n")
    1749     ; definition
    1750     (lambda (term definition)
    1751       (string->stream
     1727  (let ((last-at-depth (make-vector 10 #f))
     1728        (last-depth  0))
     1729    (make-driver
     1730     'texi
     1731     ;; horizontal line
     1732     ;; TODO: Implement!
     1733     (constantly stream-null)
     1734     ;; make header
     1735     (lambda (name depth id)
     1736       (let ((up-node (and (positive? depth) (vector-ref last-at-depth (- depth 1)))))
     1737         (stream-append
     1738          ;; print the @node and @menu.
     1739          (string->stream
     1740           (let ((node (texi-find-node lookup-table (stream->string name) up-node)))
     1741             (set! last-depth depth)
     1742             (vector-set! last-at-depth depth node)
     1743             (vector-set! last-at-depth (+ depth 1) #f)
     1744             (let ((prologue (string-concatenate
     1745                              (list (case depth
     1746                                      ((0)  "@chapter")
     1747                                      ((1)  "@section")
     1748                                      ((2)  "@subsection")
     1749                                      (else "@subsubsection")) " "
     1750                                      (stream->string name)))))
     1751               (call-with-output-string
     1752                (lambda (out) (print-node node out prologue))))))
     1753          (stream #\newline #\newline))))
     1754     ;; blockquote
     1755     (texi-wrap "@quotation\n" "\n@end quotation\n")
     1756     ;; center
     1757     (texi-wrap "@center " "")
     1758     ;; small
     1759     (lambda (x)
     1760       (error "Small not implemented yet in Texinfo mode."))
     1761     ;; big
     1762     (lambda (x)
     1763       (error "Big not implemented yet in Texinfo mode."))
     1764     ;; verbatim
     1765     (lambda (arg)
     1766       (let ((start (string->stream "@verbatim\n"))
     1767             (end (string->stream "\n@end verbatim\n")))
     1768      (stream-append start (texi-unescape arg) end)))
     1769     ;; code
     1770     (texi-wrap "@code{" "}")
     1771     ;; paragraph
     1772     (texi-wrap "" "\n\n")
     1773     ;; strong
     1774     (texi-wrap "@b{" "}")
     1775     ;; emphasis
     1776     (texi-wrap "@emph{" "}")
     1777     ;; link
     1778     (lambda (dst name)
     1779       (let* ((link-external?  (url-external? dst))
     1780              (link-email?     (let ((prefix (stream->n-list dst 7)))
     1781                                 (and prefix (string=? prefix "mailto:" ))))
     1782              (link            (if link-external? dst
     1783                                   (texi-find-node-in-tree lookup-table (stream->string dst)
     1784                                                           last-depth last-at-depth))))
     1785         (stream-append
     1786          (string->stream (if link-external? "@uref{" "@ref{"))
     1787          (if link-external?
     1788              (if link-email? (texi-escape-text dst)  dst)
     1789              (string->stream (symbol->string (texi-node-name link))))
     1790          (stream #\, #\space)
     1791          (if link-external?
     1792              (if link-email? (texi-escape-text name)  name)
     1793              name)
     1794          (stream #\}))))
     1795     ;; image
     1796     (lambda (dst name)
     1797       (warning "Image not implemented in Texinfo mode.~%")
     1798       (receive (type alt)
     1799                (stream-break (cut char=? <> #\|) name)
     1800                (stream->string (format #f "[[IMAGE:~A]]" (stream->string (or alt dst))))))
     1801     ;; math
     1802     (lambda (text)
     1803       (string->stream (format #f "$$~A$$" (stream->string text))))
     1804     ;; ordered list
     1805     (texi-wrap "@enumerate\n" "\n@end enumerate\n")
     1806     ;; bullets list
     1807     (texi-wrap "@itemize\n" "\n@end itemize\n")
     1808     ;; list item
     1809     (texi-wrap "@item " "\n\n")
     1810     ;; definition list
     1811     (texi-wrap "@table @b\n" "\n@end table\n")
     1812     ;; definition
     1813     (lambda (term definition)
     1814       (string->stream
    17521815        (format #f "@item ~A~%~%~A~%" (stream->string term) (stream->string definition))))
    1753     ; toc, gets silently discared in texi files.
    1754     (constantly stream-null)
    1755     ; special-character
    1756     ; fixme: just borrowed this from latex-driver.
    1757     (lambda (x)
    1758       (->stream-char
     1816     ;; toc, gets discarded in texi files.
     1817     (constantly stream-null)
     1818     ;; special-character
     1819     (lambda (x)
     1820       (->stream-char
    17591821        (case x
    1760           ((#\@ #\{ #\}) (stream #\@ x))
     1822          ((#\{ #\} #\@) (stream #\@ x))
     1823          ((#\<) "<")
     1824          ((#\>) ">")
    17611825          ((copyright) "(C)")
    17621826          ((reg) "(R)")
     
    17721836          ((raquo) #\xbb)
    17731837          (else (stream x)))))
    1774     ; tags
    1775     (constantly stream-null)
    1776     ; comments
    1777     (constantly stream-null)
    1778     ; line-break
    1779     (constantly (stream #\\ #\\ ))
    1780     ; anchor
    1781     (lambda (anchor text)
    1782       (string->stream (format #f "@anchor{~A}" (stream->string text))))))
    1783 
    1784 ; Escape occurences of #\#:
    1785 
    1786 (define (texi-link-target dst)
    1787   (stream-fold-right-delay
    1788     (lambda (c rest)
    1789       (if (char=? c #\#)
    1790         (stream-cons* #\\ c rest)
    1791         (stream-cons c rest)))
    1792     stream-null
    1793     dst))
     1838     ;; tags
     1839     (constantly stream-null)
     1840     ;; comments
     1841     (constantly stream-null)
     1842     ;; line-break
     1843     (constantly (stream #\\ #\\ ))
     1844     ;; anchor
     1845     (lambda (anchor text)
     1846       (string->stream (format #f "@anchor{~A}" (stream->string text)))))))
    17941847
    17951848;;; Texi: menus, navigation, node relationships
     
    18061859;; Values in the lookup table are texi-node records. (Keys are
    18071860;; node-names.)
     1861
    18081862(define-record texi-node name next prev up submenu depth)
    18091863
    1810 (define (print-node node out #!optional (prologue #f))
     1864(define (print-node node out . rest)
     1865  (let-optionals rest ((prologue #f))
    18111866  ;; print the @node line for the node, an optional prologue, and its
    18121867  ;; menu if any.
    18131868  (fprintf out "@node ~A, ~A, ~A, ~A~%"
    1814            (texi-node-name node)
    1815            (or (texi-node-next node) "(dir)")
    1816            (or (texi-node-prev node) "(dir)")
    1817            (or (texi-node-up node) "(dir)"))
     1869           (texi-node-name node)
     1870           (or (texi-node-next node) " ")
     1871           (or (texi-node-prev node) " ")
     1872           (let ((up-node (texi-node-up node)))
     1873             (if up-node (texi-node-name up-node) "Top")))
    18181874  (when prologue
    1819     (print prologue))
     1875    (fprintf out "~A~%" prologue))
    18201876  (let ((sub (texi-node-submenu node)))
    1821     (unless (null? sub)
    1822       (fprintf out "~%@menu~%")
    1823       (for-each (lambda (sub)
    1824                   (fprintf out "* ~A::~%" sub))
    1825                 (reverse sub))
    1826       (fprintf out "~%@end menu~%"))))
     1877    (if sub
     1878        (unless (null? sub)
     1879          (fprintf out "~%@menu~%")
     1880          (for-each (lambda (sub)
     1881                      (fprintf out "* ~A::~%" sub))
     1882                    (reverse sub))
     1883          (fprintf out "~%@end menu~%"))))))
    18271884
    18281885(define-record-printer (texi-node node out)
    18291886  (print-node node out #f))
    18301887
    1831 (define (escape-texi-node-name s)
    1832   ;; commas are not allowed in node names. What else?
    1833   (string-translate* s '(("," . ";"))))
     1888(define (texi-name-parse str)
     1889  (let loop ((mode? #t) (cmd? #f) (lst  (string->list str)) (ax (list)))
     1890    (if (null? lst) (list->string (reverse ax))
     1891        (match lst
     1892               ((#\@ #\@ . rest)  (loop mode? cmd? rest (if mode? (cons #\@ ax) ax)))
     1893               ((#\@ . rest)      (loop #f #t rest ax))
     1894               ((#\{ . rest)      (loop (if (and cmd? (not mode?)) #t mode?) cmd?
     1895                                        rest ax))
     1896               ((#\} . rest)      (loop mode? (not cmd?) rest ax))
     1897               ((x . rest)        (loop mode? cmd? rest (if mode? (cons x ax) ax)))))))
     1898
     1899;; Assign compound names to sectional units inside sections, escape
     1900;; periods, commas, colons and parentheses, and convert Texinfo
     1901;; @cmd{str} forms to str in the resulting string.
     1902(define (escape-texi-node-name s up)
     1903  (let ((prefix  (if up (list (symbol->string (texi-node-name up))) (list))))
     1904    (let ((n (string-intersperse (reverse (cons (texi-name-parse s) prefix)) " - ")))
     1905      (string-translate* n '(("." . ";") ("," . ";") (":" . ";") ("(" . ";") (")" . ";"))))))
    18341906
    18351907(define (texi-menu str)
     
    18381910            lookup)))
    18391911
     1912
    18401913(define (texi-node-driver lookup)
    18411914  (lambda (register)
    18421915    (let ((last-at-depth (make-vector 10 #f))
     1916          (last-depth 0)
    18431917          (last-link #f))
    1844     (make-driver
    1845      'texi-node
    1846      (constantly stream-null)
    1847      ;; make header
    1848      (lambda (name depth id)
    1849        (let* ((sym        (string->symbol (escape-texi-node-name (stream->string name))))
    1850               (up-node    (and (positive? depth) (vector-ref last-at-depth (- depth 1))))
    1851               (this-node  (make-texi-node sym #f #f (and up-node (texi-node-name up-node))
    1852                                           (list) depth)))
    1853          ;; if a node by that name already exists, there are two possibilities:
    1854          ;; there are two nodes of the same name in the wiki document (which is an error)
    1855          ;; or a dummy node of that name was created by a "Next" link (see below)
    1856          (let ((l (hash-table-ref/default lookup sym #f)))
    1857            (if (and l (texi-node-name l))
    1858                ;; Texinfo does not support two nodes with the same name
    1859                (error 'texi-node-driver "two nodes cannot have the same name: " (stream->string name)))
    1860            ;; use the next/prev link in the dummy node, if it was created
    1861            (and l (cond ((texi-node-prev l) (texi-node-prev-set! this-node (texi-node-prev l)))
    1862                         ((texi-node-next l) (texi-node-next-set! this-node (texi-node-next l)))))
    1863            ;; discard the dummy node and insert the real node in the table
    1864            (hash-table-set! lookup sym this-node)
    1865            (if (= 0 depth)
    1866                (stream-for-each register (string->stream (format #f "* ~A::\n" (texi-node-name this-node)))))
    1867            (if up-node (texi-node-submenu-set! up-node (cons sym (texi-node-submenu up-node))))
    1868            (let ((last-node (vector-ref last-at-depth depth)))
    1869              (if last-node
    1870                  (begin
    1871                    (texi-node-next-set! last-node (texi-node-name this-node))
    1872                    (texi-node-prev-set! this-node (texi-node-name last-node)))))
    1873            (vector-set! last-at-depth depth this-node)
    1874            stream-null)))
    1875 
    1876       (constantly stream-null)
    1877       (constantly stream-null)
    1878       (constantly stream-null)
    1879       (constantly stream-null)
    1880       (constantly stream-null)
    1881       (constantly stream-null)
    1882 
    1883      ;; The text "Next: " or "Previous: ", followed by a link serves to
    1884      ;; override the default prev/next nodes, respectively
    1885      (lambda (x)
    1886        (cond ((and (<= 6 (stream-length x))
    1887                    (string=? "Next: " (stream->string (stream-take x 6))))
    1888               (begin
    1889                 (let ((up-node (vector-ref last-at-depth 0)))
    1890                   (if (and up-node last-link)
    1891                       (let ((texi-next last-link))
    1892                         (texi-node-next-set! up-node texi-next)
    1893                         (let ((texi-next-node (hash-table-ref/default lookup texi-next #f)))
    1894                           (if texi-next-node
    1895                               (texi-node-prev-set! texi-next-node (texi-node-name up-node))
    1896                               (let ((dummy-node (make-texi-node #f #f (texi-node-name up-node) #f #f #f)))
    1897                                 (hash-table-set! lookup texi-next dummy-node))))))
    1898                   stream-null)))
    1899              ((and (<= 10 (stream-length x))
    1900                    (string=? "Previous: " (stream->string (stream-take x 10))))
    1901               (begin
    1902                 (let ((up-node (vector-ref last-at-depth 0)))
    1903                   (if (and up-node last-link)
    1904                       (let ((texi-prev last-link))
    1905                         (texi-node-prev-set! up-node texi-prev)
    1906                         (let ((texi-prev-node (hash-table-ref/default lookup texi-prev #f)))
    1907                           (if texi-prev-node
    1908                               (texi-node-next-set! texi-prev-node (texi-node-name up-node))
    1909                               (let ((dummy-node (make-texi-node #f (texi-node-name up-node) #f #f #f #f)))
    1910                                 (hash-table-set! lookup texi-prev dummy-node))))))
    1911                   stream-null)))
    1912 
    1913              (else (begin
    1914                      (set! last-link #f)
    1915                      stream-null))))
    1916      
    1917       (constantly stream-null)
    1918       (constantly stream-null)
    1919 
    1920      ;; Local links named "Next" or "Previous" override the default
    1921      ;; prev/next nodes in the Texinfo navigation menu
    1922      (lambda (dst name)
    1923        (let* ((link  (stream->string (texi-link-target dst)))
    1924               (url   (uri link #f)))
    1925          (if (not (and url (uri-scheme url)))
    1926              (set! last-link (string->symbol (escape-texi-node-name (stream->string dst)))))
    1927          (cond ((and url (uri-scheme url))  (values))
    1928                ((string=? (stream->string name) "Next")
    1929                 (let ((up-node (vector-ref last-at-depth 0)))
    1930                   (if up-node
    1931                       (let ((texi-next (string->symbol (escape-texi-node-name (stream->string name)))))
    1932                         (texi-node-next-set! up-node texi-next)
    1933                         (let ((texi-next-node (hash-table-ref/default lookup texi-next #f)))
    1934                           (if texi-next-node
    1935                               (texi-node-prev-set! texi-next-node (texi-node-name up-node))
    1936                               (let ((dummy-node (make-texi-node #f #f (texi-node-name up-node) #f #f #f)))
    1937                                 (hash-table-set! lookup texi-next dummy-node))))))))
    1938                 ((string=? (stream->string name) "Previous")
    1939                  (let ((up-node (vector-ref last-at-depth 0)))
    1940                    (if up-node
    1941                      (let ((texi-prev (string->symbol (escape-texi-node-name (stream->string name)))))
    1942                        (texi-node-prev-set! up-node texi-prev)
    1943                        (let ((texi-prev-node (hash-table-ref/default lookup texi-prev #f)))
    1944                          (if texi-prev-node
    1945                              (texi-node-next-set! texi-prev-node (texi-node-name up-node))
    1946                              (let ((dummy-node (make-texi-node #f (texi-node-name up-node) #f #f #f #f)))
    1947                                (hash-table-set! lookup texi-prev dummy-node)))))))))
    1948           stream-null))
    1949 
    1950      (constantly stream-null)
    1951      (constantly stream-null)
    1952      (constantly stream-null)
    1953      (constantly stream-null)
    1954      (constantly stream-null)
    1955      (constantly stream-null)
    1956      (constantly stream-null)
    1957      ;; toc
    1958      (constantly stream-null)
    1959      ;; special-char
    1960      (constantly stream-null)
    1961      ;; tags
    1962      (constantly stream-null)
    1963      (constantly stream-null)
    1964      (constantly stream-null)
    1965      ;; anchor
    1966      (constantly stream-null)))))
     1918      (vector-set! last-at-depth 0 (make-texi-node 'Top #f #f #f #f 0))
     1919      (make-driver
     1920       'texi-node
     1921       (constantly stream-null)
     1922       ;; make header
     1923       (lambda (name depth id)
     1924         (let* ((up-node    (and (positive? depth) (vector-ref last-at-depth (- depth 1))))
     1925                (sym        (string->symbol (escape-texi-node-name (stream->string name) up-node)))
     1926                (this-node  (make-texi-node sym #f #f up-node (list) depth)))
     1927           (set! last-depth depth)
     1928           ;; if a node by that name already exists, there are two
     1929           ;; possibilities: there are two nodes of the same name in the
     1930           ;; wiki document (which is an error) or a dummy node of that
     1931           ;; name was created by a "Next/Previous" link (see below)
     1932           (let ((l (hash-table-ref/default lookup sym #f)))
     1933             (if (and l (texi-node-name l))
     1934                 ;; Texinfo does not support two nodes with the same name
     1935                 (error 'texi-node-driver "two nodes cannot have the same name" sym))
     1936             ;; use the next/prev link in the dummy node, if it was created
     1937             (and l (cond ((texi-node-prev l) (texi-node-prev-set! this-node (texi-node-prev l)))
     1938                          ((texi-node-next l) (texi-node-next-set! this-node (texi-node-next l)))))
     1939             ;; discard the dummy node and insert the real node in the table
     1940             (hash-table-set! lookup sym this-node)
     1941             (if (= 0 depth)
     1942                 (stream-for-each register (string->stream (format #f "* ~A::\n" (texi-node-name this-node)))))
     1943             (if up-node (texi-node-submenu-set! up-node (cons sym (texi-node-submenu up-node))))
     1944             (let ((last-node (vector-ref last-at-depth depth)))
     1945               (if last-node
     1946                   (begin
     1947                     (texi-node-next-set! last-node (texi-node-name this-node))
     1948                     (texi-node-prev-set! this-node (texi-node-name last-node)))))
     1949             (vector-set! last-at-depth depth this-node)
     1950             (vector-set! last-at-depth (+ depth 1) #f)
     1951             stream-null)))
     1952
     1953       ;; blockquote
     1954       (constantly stream-null)
     1955       ;; center
     1956       identity
     1957       ;; small
     1958       identity
     1959       ;; big
     1960       identity
     1961       ;; verbatim
     1962       (constantly stream-null)
     1963       ;; code
     1964       identity
     1965
     1966       ;; paragraph
     1967       ;; The text "Next: " or "Previous: ", followed by a link serves to
     1968       ;; override the default prev/next nodes on level 0
     1969       (lambda (x)
     1970         (cond ((and (<= 6 (stream-length x))
     1971                     (string=? "Next: " (stream->string (stream-take x 6))))
     1972                (let ((texi-last-node (vector-ref last-at-depth 0)))
     1973                  (if (and texi-last-node last-link)
     1974                      (let ((texi-next last-link))
     1975                        (let ((texi-next-node (hash-table-ref/default lookup texi-next #f)))
     1976                          (texi-node-prev-set! texi-last-node texi-next)
     1977                          (if (not texi-next-node)
     1978                              (let ((dummy-node (make-texi-node #f (texi-node-name texi-last-node) #f #f #f #f)))
     1979                                (hash-table-set! lookup texi-next dummy-node))))))
     1980                  stream-null))
     1981               ((and (<= 10 (stream-length x))
     1982                     (string=? "Previous: " (stream->string (stream-take x 10))))
     1983                (let ((texi-last-node (vector-ref last-at-depth 0)))
     1984                  (if (and texi-last-node last-link)
     1985                      (let ((texi-prev last-link))
     1986                        (let ((texi-prev-node (hash-table-ref/default lookup texi-prev #f)))
     1987                          (texi-node-next-set! texi-last-node texi-prev)
     1988                          (if (not texi-prev-node)
     1989                              (let ((dummy-node (make-texi-node #f #f (texi-node-name texi-last-node) #f #f #f)))
     1990                                (hash-table-set! lookup texi-prev dummy-node))))))
     1991                  stream-null))
     1992               
     1993               (else (begin
     1994                       (set! last-link #f)
     1995                       stream-null))))
     1996
     1997       ;; strong
     1998       identity
     1999       ;; emphasis
     2000       identity
     2001       
     2002       ;; link
     2003       (constantly stream-null)
     2004       
     2005       (constantly stream-null)
     2006       (constantly stream-null)
     2007       (constantly stream-null)
     2008       (constantly stream-null)
     2009       (constantly stream-null)
     2010       (constantly stream-null)
     2011       (constantly stream-null)
     2012       ;; toc
     2013       (constantly stream-null)
     2014       ;; special-char
     2015       (lambda (x)
     2016         (->stream-char
     2017          (case x
     2018            ((#\@ #\{ #\}) (stream #\@ x))
     2019            ((copyright) "(C)")
     2020            ((reg) "(R)")
     2021            ((left-arrow) "<-")
     2022            ((right-arrow) "->")
     2023            ((double-arrow) "<->")
     2024            ((double-arrow-wide) "<=>")
     2025            ((left-arrow-wide) "<=")
     2026            ((right-arrow-wide) "=>")
     2027            ((mdash) "---")
     2028            ((ndash) "--")
     2029            ((laquo) #\xab)
     2030            ((raquo) #\xbb)
     2031            (else (stream x)))))
     2032       ;; tags
     2033       (constantly stream-null)
     2034       (constantly stream-null)
     2035       (constantly stream-null)
     2036       ;; anchor
     2037       (constantly stream-null)))))
     2038
  • stream-wiki/trunk/stream-wiki.setup

    r4044 r8347  
    1 (compile -s -O2 -d1 stream-wiki.scm)
    2 (install-extension 'stream-wiki '("stream-wiki.so" "stream-wiki.html") `((version ,(if (file-exists? "version") (with-input-from-file "version" read) "unknown")) (documentation "stream-wiki.html")))
     1(compile -s -O -d2 stream-wiki.scm)
     2
     3(install-extension
     4 'stream-wiki
     5 '("stream-wiki.so" "stream-wiki.html")
     6 `((version 1.11)
     7   (documentation "stream-wiki.html")))
Note: See TracChangeset for help on using the changeset viewer.