source: project/release/3/stream-wiki/trunk/stream-wiki.scm @ 12533

Last change on this file since 12533 was 12533, checked in by azul, 11 years ago

Importing svnwiki extensions.

File size: 67.6 KB
Line 
1;; $Id: stream-wiki.scm 5587 2006-05-19 06:24:51Z azul $
2;;
3;; This file is in the public domain and may be reproduced or copied without
4;; permission from its author.  Citation of the source is appreciated.
5;;
6;; Alejandro Forero Cuervo <azul@freaks-unidos.net>
7;;
8;; This file implements an egg for Chicken Scheme for parsing files in wiki
9;; format and rendering them to HTML.
10;;
11;; Documentation is available in HTML format.
12;;
13;; Newer versions might be available at:
14;;
15;;    http://anonymous:@afc.no-ip.info:8000/svn/home/src/chicken-eggs/stream-wiki
16
17(declare
18  (export
19    make-html-header
20    wiki->html
21    wiki->text
22    wiki->toc wiki->sections
23    load-linktypes
24    wiki->latex latex-page
25    wiki->texi texi-page
26    wiki-links
27    wiki-tags
28
29    ; Exports for extensions:
30
31    driver-horizontal-line
32    driver-math
33    driver-literal
34    driver-literal-line
35    driver-center
36    driver-big
37    driver-em
38    driver-strong
39    driver-small
40    driver-header
41    driver-blockquote
42    driver-line-break
43    driver-anchor)
44  (usual-integrations))
45
46(use svnwiki-extensions-support srfi-1 srfi-40 stream-ext html-stream stream-parser posix format-modular stream-sections uri match)
47
48; An output driver is simply a table of functions.
49
50; For each field FIELD in our driver record, we also want to define a function
51; wikidata-FIELD such that
52;
53;   (wikidata-FIELD x)
54;
55; evaluates to whatever
56;
57;   (driver-FIELD (wikidata-driver x))
58;
59; evaluates to.  This is just to save some typing, since actually the driver is
60; usuall stored inside a wikidata record everywhere.
61;
62; That's all there is to the following macro.
63
64(define-macro (define-driver-record . funcs)
65  `(begin
66     (define-record driver ,@funcs)
67     ,@(map (lambda (sym)
68              `(define (,(string->symbol (format #f "wikidata-~A" sym)) info . args)
69                 (apply
70                   (,(string->symbol (format #f "driver-~A" sym)) (wikidata-driver info))
71                   args)))
72            funcs)))
73
74; Now lets define all the functions that make up an output driver.
75;
76; linktypes is a hashing table: the first element is a symbol for the name of
77; the type of link and the second is what we should use, with escape character
78; %t (replaced with the link's target).
79
80(define-driver-record output-format horizontal-line header blockquote center small big literal literal-line paragraph strong em link image math ordered-list unordered-list list-item definition-list definition-item toc special-char tags comment line-break anchor)
81
82(let ((get driver-anchor))
83  (set! driver-anchor
84    (lambda (driver)
85      (lambda (anchor . rest)
86        (let-optionals rest ((text stream-null))
87          ((get driver) (text->html-id anchor) text))))))
88
89; Output is an output driver.  See html-driver for an example.
90
91; linktypes-current is a list with the currently applied linktypes.  When
92; expanding a linktype (parsing its output recursively), we append its type
93; to linktypes-current.  That way we can detect infinite loops and react
94; gracefully.
95
96; tags is a hash table of record objects of type tags.
97
98(define-record wikidata driver open include name linktypes environment linktypes-current previous-sections)
99
100; Macro used to generate the functions in the HTML driver.
101
102(define-macro (tags-func . tags)
103  (let ((arg (gensym "arg")))
104    `(lambda (,arg)
105       (html-stream
106         ,(fold-right list arg tags)))))
107
108;;; Helper functions
109;
110; Functions useful for all the drivers.
111
112; Is URL external?  Currently we simply check to see if it is an absolute URL.
113; We could be smarter than this if we had more information about the canonical
114; URL for the repository and of the current file but this is not that easy (for
115; instance, "/foo", "http://bar/foo" and "../foo" might be external or not).
116;
117; This function is replicated in svnwiki's links.scm.
118
119(define (url-external? url)
120  (let ((rest (stream-drop-while
121                (disjoin char-alphabetic? char-numeric?)
122                url)))
123    (and (not (stream-null? rest))
124         (not (stream-null? (stream-cdr rest)))
125         (char=? (stream-car rest) #\:))))
126
127; I had to duplicate this in Svnwiki.  It should really be a function passwd
128; by the caller.
129
130(define (name-to-base str)
131  (stream-downcase
132    (stream-map
133      (lambda (c) (if (char-whitespace? c) #\- c))
134      (stream-filter
135        (disjoin char-alphabetic?
136                 char-numeric?
137                 char-whitespace?
138                 (cut char=? <> #\/)
139                 (cut char=? <> #\-))
140        str))))
141
142(define (fix-suffix suffix)
143  (receive (querystring anchor)
144           (stream-break (cut char=? <> #\#) suffix)
145    (if (stream-null? anchor)
146      suffix
147      (stream-append querystring
148                     (stream-cons #\#
149                                  (text->html-id (stream-cdr anchor)))))))
150
151; Function to handle links intelligently.
152;
153; Analyzes the target and returns two things:
154;
155; - The type of link ("external", "internal" or "unexistant")
156;
157; - The URL that should be used as the target.  This is based on the input
158;   target but it might be modified.  For instance, its case might be changed
159;   to match a file (so users won't have to worry about the case of files when
160;   creating links) or a relative URL might be turned into an absolute URL.
161
162(define (parse-link dst check-exists? url-adjust)
163  (assert (and 'parse-link (stream? dst)))
164  (if (url-external? dst)
165    (values 'external dst)
166    (receive (dst-file dst-suffix)
167             (stream-break (disjoin (cut char=? <> #\?) (cut char=? <> #\#)) dst)
168      (let ((dst-real (stream-find check-exists? (parse-link-file dst-file))))
169        (if dst-real
170          (values "internal" (url-adjust (stream-append dst-real (fix-suffix dst-suffix))))
171          (values "unexistant" (name-to-base dst-file)))))))
172
173(define (parse-link-file file)
174  (stream-map
175    (lambda (f) (f file))
176    (stream identity stream-downcase name-to-base)))
177
178;;; OpenOffice.org Driver
179
180; Wildly incomplete.
181
182(define (ooo-driver header-start)
183  (make-driver
184    'open-document-format
185    (constantly (html-stream (hr)))
186    (lambda (name depth id)
187      (stream-append
188        (html-stream ((a name (text->html-id name))))
189        (string->stream (format #f "<h~A>" (min 6 (+ depth header-start))))
190        name
191        (string->stream (format #f "</h~A>" (min 6 (+ depth header-start))))))
192    (tags-func blockquote)
193    (tags-func center)
194    (tags-func small)
195    (tags-func big)
196    (tags-func pre)
197    (tags-func tt)
198    (tags-func p)
199    (tags-func strong)
200    (tags-func em)
201    (lambda (dst name) (html-stream ((a href dst) name)))
202    (lambda (dst name)
203      (receive (type alt)
204               (stream-break (cut char=? <> #\|) name)
205        (cond
206          ((stream-null? alt) (html-stream ((img src dst alt name))))
207          ((stream= char=? type (stream #\r #\i #\g #\h #\t))
208           (html-stream ((img style "margin-top: 1em; margin-left: 1em; margin-bottom: 1em;" align "right" src dst alt (stream-cdr alt)))))
209          ((stream= char=? type (stream #\l #\e #\f #\t))
210           (html-stream ((img style "margin-top: 1em; margin-right: 1em; margin-bottom: 1em;" align "left" src dst alt (stream-cdr alt)))))
211          (else (html-stream ((img src dst alt name)))))))
212    (lambda (text)
213      (string->stream "[[Math support is currently disabled]]"))
214    (constantly stream-null)
215    (lambda (char)
216      (if (char? char)
217        (stream char)
218        stream-null))
219    (constantly stream-null)
220    (constantly stream-null)
221    (constantly (html-stream (br)))
222    ; anchor
223    (constantly stream-null)))
224
225;;; HTML Driver
226
227; header-start is the depth of the headers (for example, 1 makes == become
228; <h1>).
229;
230; header-prefix is a function
231
232(define (make-html-header . rest)
233  (let-optionals rest ((header-start 1))
234    (lambda (name depth id)
235      (html-stream
236        ((a name (text->html-id id)))
237        (string->stream (format #f "<h~A>" (min 6 (+ depth header-start))))
238        name
239        (string->stream (format #f "</h~A>" (min 6 (+ depth header-start))))))))
240
241(define (html-driver-link check-exists? url-adjust no-follow? dst name)
242  (assert (and 'html-driver-link (stream? dst)))
243  (assert (and 'html-driver-link (stream? name)))
244  (receive (type dst-real)
245           (parse-link dst check-exists? url-adjust)
246    (assert (and html-driver-link '(stream? dst-real)))
247    (if (and (eq? type 'external)
248             (no-follow? dst-real))
249      (html-stream ((a href dst-real class type rel "nofollow") name))
250      (html-stream ((a href dst-real class type) name)))))
251
252(define (html-driver-image check-exists? url-adjust dst name)
253  (assert (and 'html-driver-image (stream? dst)))
254  (assert (and 'html-driver-image (stream? name)))
255  (receive (type alt)
256           (stream-break (cut char=? <> #\|) name)
257    (receive (_ url)
258             (parse-link dst check-exists? url-adjust)
259      (if (and (not (stream-null? alt))
260               (or (stream= char=? type (string->stream "right"))
261                   (stream= char=? type (string->stream "left"))
262                   (stream= char=? type (string->stream "center"))))
263        (let ((class (format #f "image-~A" (stream->string type))))
264          (html-stream
265            ((div class class)
266             ((img class class src url alt (stream-cdr alt)))
267             (if (stream-null? (stream-cdr alt))
268               stream-null
269               (html-stream ((p class class) (stream-cdr alt)))))))
270        (html-stream ((img src url alt name)))))))
271
272(define (texvc-math data-output-func text)
273  (data-output-func
274    (stream-append (string->stream "texvc-math:") text)
275    "image/png"
276    (lambda (file url)
277      (if (file-exists? file)
278        (html-stream ((img src url)))
279        (let ((dir (string-intersperse (butlast (cons "" (string-split file "/"))) "/")))
280          (receive (in out pid)
281                   (process (format #f "texvc /tmp ~A ~A latin1" dir (shell-escape text)))
282            (close-output-port out)
283            (let ((texvc-in (port->stream in)))
284              (case (and (not (stream-null? texvc-in)) (stream-car texvc-in))
285                ((#\+ #\c #\m #\l #\C #\M #\L #\X)
286                 (rename-file (string-append dir "/" (stream->string (stream-take (stream-cdr texvc-in) 32)) ".png") file)
287                 (html-stream ((img src url))))
288                (else
289                  (string->stream "[[Markup error or TexVC not found]]"))))))))))
290
291(define (html-driver make-header data-output-func check-exists? url-adjust no-follow?)
292  (make-driver
293    'html
294    ; horizontal line
295    (constantly (html-stream (hr)))
296    ; make header
297    make-header
298    ; blockquote
299    (tags-func blockquote)
300    ; center
301    (tags-func center)
302    ; small
303    (tags-func small)
304    ; big
305    (tags-func big)
306    ; literal
307    (tags-func pre)
308    ; literal-line
309    (tags-func tt)
310    ; paragraph
311    (tags-func p)
312    ; strong
313    (tags-func strong)
314    ; emphasis
315    (tags-func em)
316    ; link
317    (cut html-driver-link check-exists? url-adjust no-follow? <...>)
318    ; image
319    (cut html-driver-image check-exists? url-adjust <...>)
320    ; math
321    (if data-output-func
322      (cut texvc-math data-output-func <>)
323      (lambda (text)
324        (string->stream "[[Math support is currently disabled]]")))
325    ; ordered list
326    (tags-func ol)
327    ; bullets list
328    (tags-func ul)
329    ; list item
330    (tags-func li)
331    ; definition list
332    (tags-func dl)
333    ; definition
334    (lambda (term definition)
335      (html-stream
336        (if (stream-null? term)
337          stream-null
338          (html-stream (dt term)))
339        (if (stream-null? definition)
340          stream-null
341          (html-stream (dd definition)))))
342    ; toc
343    (lambda (info dst)
344      (let* ((file (if (stream-null? dst) (wikidata-name info) (stream->string dst))))
345        (wiki-parse
346          (wikidata-driver info)
347          (wiki->toc ((wikidata-open info) file))
348          stream-null
349          file
350          (wikidata-open info)
351          (wikidata-include info))))
352    ; special-char
353    (lambda (x)
354      (string->stream
355        (case x
356          ((#\&) "&amp;")
357          ((#\<) "&lt;")
358          ((#\>) "&gt;")
359          ((copyright) "&copy;")
360          ((reg) "&reg;")
361          ((left-arrow) "&larr;")
362          ((right-arrow) "&rarr;")
363          ((double-arrow) "&harr;")
364          ((double-arrow-wide) "&hArr;")
365          ((left-arrow-wide) "&lArr;")
366          ((right-arrow-wide) "&rArr;")
367          ((mdash) "&mdash;")
368          ((ndash) "&ndash;")
369          ((laquo) "&laquo;")
370          ((raquo) "&raquo;")
371          (else
372            (cond
373              ((char? x) (string x))
374              ((symbol? x) (symbol->string x)))))))
375    ; tags
376    (constantly stream-null)
377    ; comments
378    (lambda (text)
379      (stream-append
380        (string->stream "<!-- ")
381        text
382        (string->stream " -->")))
383    ; line-break
384    (constantly (html-stream (br)))
385    (lambda (anchor text)
386      (html-stream ((a name anchor) text)))))
387
388;;; Plain text driver
389
390; human-readable is a boolean specifying that the output should be optimized
391; to be read by a human (as opposed to a machine indexing the text in the
392; file, say a search engine).
393
394(define (text-driver human-readable)
395  (make-driver
396    'text
397    ; horizontal line
398    (if human-readable
399      (constantly (stream-append (make-stream 60 #\-) (stream #\newline)))
400      (constantly stream-null))
401    ; make header
402    (lambda (name depth id)
403      (stream-append name (stream #\newline #\newline)))
404    ; blockquote
405    (if human-readable
406      (lambda (text)
407        (stream-cons* #\> #\space text))
408      identity)
409    ; center
410    identity
411    ; small
412    identity
413    ; big
414    identity
415    ; literal
416    identity
417    ; literal-line
418    identity
419    ; paragraph
420    (lambda (text)
421      (assert (stream? text))
422      (stream-append text (stream #\newline #\newline)))
423    ; strong
424    identity
425    ; emphasis
426    identity
427    ; link
428    (lambda (dst name)
429      (assert (stream? dst))
430      (assert (stream? name))
431      (if (stream= char=? dst name)
432        (stream-append (stream #\[) dst (stream #\]))
433        (stream-append name (stream #\space #\[) dst (stream #\]))))
434    ; image
435    (if human-readable
436      (lambda (dst name)
437        (stream-append
438          (string->stream "[IMAGE:")
439          name
440          (stream #\])))
441      (lambda (dst name)
442        name))
443    ; math
444    identity
445    ; ordered list
446    identity
447    ; bullets list
448    identity
449    ; list item
450    (lambda (item)
451      ; TODO: Somehow get the depth right!
452      (stream-append
453        (if human-readable (stream #\* #\space) stream-null)
454        item
455        (stream #\newline #\newline)))
456    ; definition list
457    identity
458    ; definition
459    (lambda (term definition)
460      (stream-append
461        (if human-readable (stream #\- #\space) stream-null)
462        term
463        (stream #\newline #\newline #\space #\space)
464        definition
465        (stream #\newline #\newline)))
466    ; toc
467    (lambda (info dst)
468      ; TODO: write!
469      stream-null)
470    ; special-char
471    (lambda (x)
472      (string->stream
473        (case x
474          ((#\&) "&")
475          ((#\<) "<")
476          ((#\>) ">")
477          ((copyright) "(copyright)")
478          ((reg) "(reg)")
479          ((left-arrow) "<-")
480          ((right-arrow) "->")
481          ((double-arrow) "<->")
482          ((double-arrow-wide) "<=>")
483          ((left-arrow-wide) "<=")
484          ((right-arrow-wide) "=>")
485          ((mdash) "---")
486          ((ndash) "--")
487          ((laquo) "<<")
488          ((raquo) ">>")
489          (else
490            (cond
491              ((char? x) (string x))
492              ((symbol? x) (symbol->string x)))))))
493    ; tags
494    (constantly stream-null)
495    ; comments
496    (constantly stream-null)
497    (constantly (stream #\newline))
498    ; anchor
499    (lambda (anchor text)
500      text)))
501
502;;; Special Drivers
503
504(define (stream-traverse x)
505  (stream-null? (stream-drop-while (constantly #t) x)))
506
507(define (links-driver register)
508  (make-driver
509    'links
510    (constantly stream-null)
511    (constantly stream-null)
512    (compose (constantly stream-null) stream-traverse)
513    (compose (constantly stream-null) stream-traverse)
514    (compose (constantly stream-null) stream-traverse)
515    (compose (constantly stream-null) stream-traverse)
516    (compose (constantly stream-null) stream-traverse)
517    (compose (constantly stream-null) stream-traverse)
518    (compose (constantly stream-null) stream-traverse)
519    (compose (constantly stream-null) stream-traverse)
520    (compose (constantly stream-null) stream-traverse)
521    (lambda (dst name)
522      (register (list (stream-take-while (complement (conjoin (cut char=? <> #\|) (cut char=? <> #\#))) dst) name))
523      stream-null)
524    (constantly stream-null)
525    (constantly stream-null)
526    (compose (constantly stream-null) stream-traverse)
527    (compose (constantly stream-null) stream-traverse)
528    (compose (constantly stream-null) stream-traverse)
529    (compose (constantly stream-null) stream-traverse)
530    (lambda (t d)
531      (stream-traverse t)
532      (stream-traverse d)
533      stream-null)
534    ; toc
535    (constantly stream-null)
536    ; special-char
537    (constantly stream-null)
538    ; tags
539    (constantly stream-null)
540    ; comments
541    (constantly stream-null)
542    ; line-break
543    (constantly stream-null)
544    ; anchor
545    (constantly stream-null)))
546
547(define (tags-driver register)
548  (make-driver
549    'tags
550    (constantly stream-null)
551    (constantly stream-null)
552    (compose (constantly stream-null) stream-traverse)
553    (compose (constantly stream-null) stream-traverse)
554    (compose (constantly stream-null) stream-traverse)
555    (compose (constantly stream-null) stream-traverse)
556    (compose (constantly stream-null) stream-traverse)
557    (compose (constantly stream-null) stream-traverse)
558    (compose (constantly stream-null) stream-traverse)
559    (compose (constantly stream-null) stream-traverse)
560    (compose (constantly stream-null) stream-traverse)
561    (constantly stream-null)
562    (constantly stream-null)
563    (constantly stream-null)
564    (compose (constantly stream-null) stream-traverse)
565    (compose (constantly stream-null) stream-traverse)
566    (compose (constantly stream-null) stream-traverse)
567    (compose (constantly stream-null) stream-traverse)
568    (lambda (t d)
569      (stream-traverse t)
570      (stream-traverse d)
571      stream-null)
572    ; toc
573    (constantly stream-null)
574    ; special-char
575    (constantly stream-null)
576    ; tags
577    (let ((old-tags (make-hash-table)))
578      (lambda (tags)
579        (stream-for-each
580          (lambda (t)
581            (let ((ts (stream->symbol t)))
582              (unless (hash-table-ref/default old-tags ts #f)
583                (register ts)
584                (hash-table-set! old-tags ts #t))))
585          (stream-filter
586            (complement stream-null?)
587            (stream-split
588              (stream-map
589                char-downcase
590                (stream-filter
591                  (disjoin char-numeric? char-alphabetic? char-whitespace?)
592                  tags))
593              char-whitespace?)))
594        stream-null))
595    (compose (constantly stream-null) stream-traverse)
596    (constantly stream-null)
597    ; anchor
598    (constantly stream-null)))
599
600;;; LaTeX driver
601
602(define (latex-text-parse dst)
603  (if (stream-null? dst)
604    stream-null
605    (case (stream-car dst)
606      ((#\& #\$ #\{ #\} #\# #\_) (stream-cons* #\\ (stream-car dst) (latex-text-parse (stream-cdr dst))))
607      (else (stream-cons (stream-car dst) (latex-text-parse (stream-cdr dst)))))))
608
609(define (latex-wrap start end . rest)
610  (let-optionals rest ((parse #f))
611    (let ((real-start (string->stream start)) (real-end (string->stream end)) (parse-func (if parse latex-text-parse identity)))
612      (lambda (arg) (stream-append real-start (parse-func arg) real-end)))))
613
614(define *latex-default-document-class* "article")
615
616(define *latex-document-classes* '("article" "book" "report"))
617(define *latex-languages* '("spanish" "english" "german"))
618
619(define (latex-page lang class content)
620  (->stream-char
621    (format #f "\\documentclass[12pt]{~A}~%\\usepackage[~A]{babel}~%\\usepackage[T1]{fontenc}~%\\usepackage[utf8]{inputenc}~%\\usepackage{palatino}~%\\usepackage[pdftex]{hyperref}\\begin{document}~%" 
622            (if (and class (member class *latex-document-classes*)) class *latex-default-document-class*) 
623            (if (and lang (member lang *latex-languages*)) lang "english"))
624    (stream-append content (string->stream "\n\\end{document}\n"))))
625
626(define (latex-environment name)
627  (latex-wrap (format #f "\\begin{~A}\n" name)
628              (format #f "\\end{~A}\n" name)))
629
630(define (latex-driver class links-base . rest)
631  (let-optionals rest ((include-in-toc (list 0 1 2 3 4))
632                       (newpage-after-section (list))
633                       )
634  (make-driver
635    'latex
636    ; horizontal line
637    (constantly stream-null)
638    ; make header
639    (let ((add (if (or (string=? class "book") (string=? class "report")) 0 1)))
640      (lambda (name depth id)
641        (stream-append
642          (let ((real-depth (+ depth add)))
643            (cond
644              ((zero? real-depth)
645               (string->stream "\\chapter{"))
646              ((<= real-depth 3)
647               (stream-append
648                 (if (member real-depth newpage-after-section) (string->stream "\\newpage\n") stream-null)
649                 (stream #\\ )
650                 (stream-concatenate (make-stream (- real-depth 1) (string->stream "sub")))
651                 (if (member real-depth include-in-toc) (string->stream "section{") (string->stream "section*{"))
652                 ))
653              (else
654                (string->stream "\\noindent \\textbf{"))))
655          (latex-text-parse name)
656          (stream #\} #\newline #\newline))))
657    ; blockquote
658    (latex-environment 'quote)
659    ; center
660    (latex-environment 'center)
661    ; small
662    (latex-environment 'small)
663    ; big
664    (latex-environment 'large)
665    ; literal
666    (latex-environment 'verbatim)
667    ; literal-line
668    (latex-wrap "\\verb|" "|")
669    ; paragraph
670    (latex-wrap "" "\n\n")
671    ; strong
672    (latex-wrap "\\textbf{" "}")
673    ; emphasis
674    (latex-wrap "\\textit{" "}")
675    ; link
676    (lambda (dst name)
677      (string->stream
678        (format #f "\\href{~A}{~A}"
679                (stream->string
680                  ((if (url-external? dst) identity links-base)
681                   (latex-text-parse dst)))
682                (stream->string (latex-text-parse name)))))
683    ; image
684    (lambda (dst name)
685      (warning "Image not implemented yet in LaTeX mode.~%")
686      (receive (type alt)
687               (stream-break (cut char=? <> #\|) name)
688        (string->stream (format #f "[[IMAGE:~A]]" (stream->string (or alt dst))))))
689    ; math
690    (lambda (text)
691      (string->stream (format #f "$$~A$$" (stream->string text))))
692    ; ordered list
693    (latex-environment 'enumerate)
694    ; bullets list
695    (latex-environment 'itemize)
696    ; list item
697    (latex-wrap "\\item " "\n\n")
698    ; definition list
699    (latex-environment 'description)
700    ; definition
701    (lambda (term definition)
702      (string->stream
703        (format #f "\\item[~A]~%~%~A~%" (stream->string term) (stream->string definition))))
704    ; toc
705    (lambda (info dst)
706      (if (stream-null? dst)
707        (string->stream "\\tableofcontents\n\n")
708        ; Can't get TOC of other documents yet:
709        stream-null))
710    ; special-character
711    (lambda (x)
712      (->stream-char
713        (case x
714          ((#\& #\$ #\{ #\} #\# #\_) (stream #\\ x))
715
716          ; Not much else we can do right now about quotation marks, is there?
717          ; We don't know if they are opening or closing quotation marks... :-/
718
719          ((#\\ #\") stream-null)
720
721          ((#\<) "<")
722          ((#\>) ">")
723          ((#\[) "\\[")
724          ((#\]) "\\]")
725          ((copyright) "(C)")
726          ((reg) "(R)")
727          ((left-arrow) "<-")
728          ((right-arrow) "->")
729          ((double-arrow) "<->")
730          ((double-arrow-wide) "<=>")
731          ((left-arrow-wide) "<=")
732          ((right-arrow-wide) "=>")
733          ((mdash) "---")
734          ((ndash) "--")
735          ((laquo) "<<")
736          ((raquo) ">>")
737          (else (string x)))))
738    ; tags
739    (constantly stream-null)
740    ; comments
741    (constantly stream-null)
742    (constantly (stream #\\ #\\ ))
743    ; anchor
744    ; TODO: I think LaTeX does support anchor, we should get them to work.
745    (constantly stream-null))))
746
747;;; Parsing
748
749(define (char-blank? x) (or (equal? x #\space) (equal? x #\tab)))
750
751; This is the parser for text that occurs inside a given set of
752; <p>, <pre>, <blockquote>, <li>, <dt> or <dd> tags.
753
754(define (text-transform info strong em literal start newline-rep)
755  (assert (wikidata? info))
756  (lambda (str fail parsed)
757    (parse-token str fail parsed
758
759      ; Cases for EOL.  If it is followed by a character, we want
760      ; to replace it with newline-rep (which is normally a space
761      ; but is a #\newline when we're inside a <pre> tag):
762
763      ((#\newline (assert newline-rep) (end)) stream-null)
764      ((#\newline (assert (and newline-rep start)) start) (stream newline-rep))
765      ((#\newline (assert (and newline-rep (not start)))) (stream newline-rep))
766
767      ; <strong> and <em>:
768
769      ((#\' #\' #\' (assert (not strong)) (bind text (*? (rule-apply (text-transform info #t em literal start newline-rep)))) #\' #\' #\')
770       (wikidata-strong info text))
771
772      ((#\' #\' (assert (not em)) (bind text (*? (rule-apply (text-transform info strong #t literal start newline-rep)))) #\' #\')
773       (wikidata-em info text))
774
775      ; Links: [ TYPE : ] DST [ | NAME ] (type and name are
776      ; optional).
777
778      ((#\[ #\[
779        (all char-whitespace?)
780        (? (bind type (*? (not (or #\[ #\: #\| #\] #\newline))))
781           (all char-whitespace?) #\: (all char-whitespace?))
782        (bind dst (*? (not (or #\[ #\| #\] #\newline))))
783        (all char-whitespace?)
784        (? #\| (all char-whitespace?)
785           (bind name (*? (rule-apply (text-transform info strong em literal start newline-rep))))
786           (all char-whitespace?))
787        #\] #\])
788       (make-link info
789         (if (stream-null? type) #f type)
790         dst
791         (if (stream-null? name) #f name)))
792
793      ; Typewritten text:
794
795      ((#\{ #\{ (bind text (*? char?)) #\} #\})
796       (wikidata-literal-line info
797         (parse-all text (lambda () (error "bar")) (text-transform info strong em #t start newline-rep) stream-null)))
798
799      ; Comments
800
801      ((#\< #\! (all char-whitespace?) #\- (all char-whitespace?) #\- (all char-whitespace?)
802        (bind text (*? char?))
803        (all char-whitespace?) #\- (all char-whitespace?) #\- (all char-whitespace?) #\>)
804       (wikidata-comment info text))
805
806      ; Span tags:
807
808      ((#\< (all char-whitespace?) (bind tag (all char-alphabetic?))
809        (assert (wiki-extension tag 'code-span))
810        ; Parameters
811        (* (+ char-whitespace?)
812           (bind name (all char-alphabetic?))
813           (all char-whitespace?)
814           (? #\= (all char-whitespace?)
815              (or (#\" (bind value (all (not #\"))) #\")
816                  (#\' (bind value (all (not #\'))) #\')
817                  ((bind value (all (or char-alphabetic? char-numeric?))))))
818           (bind-accum (params '()) cons (cons (stream->symbol (stream-downcase name)) value)))
819        (all char-whitespace?) #\>
820        (bind text (*? char?))
821        #\< (all char-whitespace?) #\/ tag (all char-whitespace?) #\>)
822
823       (run-span-extension tag text params info))
824
825      ; Break tags:
826
827      ((#\< (all char-whitespace?) (bind tag (all char-alphabetic?))
828        (assert (wiki-extension tag 'code-break))
829        ; Parameters
830        (* (+ char-whitespace?)
831           (bind name (all (or char-alphabetic? char-numeric?)))
832           (all char-whitespace?)
833           (? #\= (all char-whitespace?)
834              (or (#\" (bind value (all (not #\"))) #\")
835                  (#\' (bind value (all (not #\'))) #\')
836                  ((bind value (all (or char-alphabetic? char-numeric?))))))
837           (bind-accum (params '()) cons (cons (stream->symbol (stream-downcase name)) value)))
838        (all char-whitespace?) (? #\/) (all char-whitespace?) #\>)
839       (run-break-extension tag params info))
840
841      ; Replace certain sequences with HTML entities, unless we are inside a
842      ; <pre>, <tt> or <code> tag.
843
844      ((#\< #\< (assert (not literal))) (wikidata-special-char info 'laquo))
845      ((#\> #\> (assert (not literal))) (wikidata-special-char info 'raquo))
846      ((#\( (or #\R #\r) #\) (assert (not literal))) (wikidata-special-char info 'reg))
847      ((#\( (or #\C #\c) #\) (assert (not literal))) (wikidata-special-char info 'copyright))
848      ((#\1 #\/ #\2 (assert (not literal))) (string->stream "&frac12;"))
849      ((#\1 #\/ #\4 (assert (not literal))) (string->stream "&frac14;"))
850      ((#\3 #\/ #\4 (assert (not literal))) (string->stream "&frac34;"))
851      ((#\< #\- #\> (assert (not literal))) (wikidata-special-char info 'double-arrow))
852      ((#\< #\- (assert (not literal))) (wikidata-special-char info 'left-arrow))
853      ((#\- #\> (assert (not literal))) (wikidata-special-char info 'right-arrow))
854      ((#\< #\= #\> (assert (not literal))) (wikidata-special-char info 'double-arrow-wide))
855      ((#\< #\= (assert (not literal))) (wikidata-special-char info 'left-arrow-wide))
856      ((#\= #\> (assert (not literal))) (wikidata-special-char info 'right-arrow-wide))
857      ((#\- #\- #\- (assert (not literal))) (wikidata-special-char info 'mdash))
858      ((#\- #\- (assert (not literal))) (wikidata-special-char info 'ndash))
859
860      ; Some entities that we don't want to include literally.
861
862      (((bind char special-char?))
863       (wikidata-special-char info (stream-car char)))
864
865      ; An email address:
866
867      (((bind initial (?? char?))
868        (bind email
869              char-alphabetic?
870              (all (or char-alphabetic? char-numeric? #\. #\- #\_ #\+))
871              #\@
872              (+
873                (or char-alphabetic? char-numeric?)
874                (* (or char-alphabetic? char-numeric? #\-))
875                (or char-alphabetic? char-numeric?)
876                #\.)
877              (or char-alphabetic? char-numeric?)
878              (* (or char-alphabetic? char-numeric? #\-))
879              (or char-alphabetic? char-numeric?)))
880       (stream-append
881         initial
882         (make-link info
883           (string->stream "mailto")
884           email
885           email)))
886
887      ; A URL:
888
889      (((bind initial (?? char?))
890        (bind type (all char-alphabetic?))
891        #\:
892        (assert (assoc (stream->symbol (stream-downcase type)) *allowed-url-schemes*))
893        (bind dst
894              #\/ #\/
895              (+
896                (or char-alphabetic? char-numeric?)
897                (* (or char-alphabetic? char-numeric? #\-))
898                (or char-alphabetic? char-numeric?)
899                #\.)
900              (or char-alphabetic? char-numeric?)
901              (* (or char-alphabetic? char-numeric? #\-))
902              (or char-alphabetic? char-numeric?)
903              ; Port
904              (? #\: (+ char-numeric?))
905              ; File or QUERY STRING or Anchor
906              (?
907                (or #\/ #\? #\#)
908                (?
909                  (* (or char-alphabetic? char-numeric? #\~ #\/ #\. #\? #\& #\# #\% #\= #\- #\_))
910                  ; The last character must not be a dot:
911                  (or char-alphabetic? char-numeric? #\~ #\/ #\? #\& #\# #\% #\= #\- #\_)))))
912       (stream-append initial (make-link info type dst #f)))
913
914      ; Normal text:
915
916      (((bind str
917              (not (or special-char? #\newline))
918              (all standard-char?)))
919       str))))
920
921(define (not-newline? x)
922  (not (char=? x #\newline)))
923
924(define *allowed-url-schemes*
925  '((http) (https) (ftp)))
926
927; Characters that should be handled by wikidata-special-char instead of
928; included verbatim.
929
930(define (special-char? x)
931  (case x
932    ((or #\# #\$ #\< #\> #\& #\_ #\\ #\" #\{ #\} #\@ #\[ #\] ) #t)
933    (else #f)))
934
935(define (standard-char? x)
936  (and (not (special-char? x))
937       (case x
938         ((#\newline #\' #\: #\| #\( #\space #\, #\. #\- #\=) #f)
939         (else #t))))
940
941(define (make-link info type dst name)
942  (assert (wikidata? info))
943  ((let ((type-sym (and type (stream->symbol (stream-downcase type)))))
944     (cond
945        ((not type-sym) make-default-link)
946        ((assoc type-sym *link-types*) => cadr)
947        ((hash-table-ref/default (wikidata-linktypes info) type-sym #f) => run-linktype)
948        (else make-default-link)))
949   info type dst name))
950
951(define (make-default-link info type dst name)
952  (assert (wikidata? info))
953  (let ((real-dst (if type (stream-append type (stream-cons #\: dst)) dst)))
954    (wikidata-link info real-dst (or name real-dst))))
955
956(define (make-link-image info type dst name)
957  (assert (wikidata? info))
958  (wikidata-image info dst (or name dst)))
959
960(define (register-link-tag info type dst name)
961  (assert (wikidata? info))
962  (wikidata-tags info (or name dst)))
963
964(define (make-link-include info type dst name)
965  (assert (wikidata? info))
966  ((wikidata-include info) (stream->string dst) stream-null))
967
968(define (make-link-toc info type dst name)
969  (assert (wikidata? info))
970  (wikidata-toc info info dst))
971
972(define (make-link-mailto info type dst name)
973  (wikidata-link info (stream-append type (stream-cons #\: dst)) (or name dst)))
974
975(define *link-types*
976  `((include ,make-link-include)
977    (toc ,make-link-toc)
978    (image ,make-link-image)
979    (tags ,register-link-tag)
980    (mailto ,make-link-mailto)))
981
982(define (list-transform info current)
983  (assert (wikidata? info))
984  (lambda (str fail parsed)
985    (parse-token str fail parsed
986      (((bind data
987              current (all #\space) (bind list-item (or #\* #\#))
988              (all (all #\space) (or #\* #\#))
989              (? #\newline)
990              (all (not (or #\* #\# #\newline))
991                   (all (not #\newline))
992                   (? #\newline))
993              (all #\newline)
994              (all
995                current (all #\space) list-item
996                (all (all #\space) (or #\* #\#))
997                (? #\newline)
998                (all (not (or #\* #\# #\newline))
999                     (all (not #\newline))
1000                     (? #\newline))
1001                (all #\newline))))
1002       ((if (char=? (stream-car list-item) #\*)
1003          wikidata-unordered-list
1004          wikidata-ordered-list)
1005        info
1006        (parse-all data fail (list-transform info (stream-append current list-item)))))
1007      (((bind head
1008              (? current (all #\space)
1009                 (? #\newline)
1010                 (bind text
1011                       (all (not (or #\* #\# #\newline))
1012                            (all (not #\newline))
1013                            (? #\newline)))))
1014        (all #\newline)
1015        (bind tail
1016              (all current
1017                   (+all (all #\space) (or #\* #\#))
1018                   (all #\space)
1019                   (? #\newline)
1020                   (all (not (or #\* #\#))
1021                        (all (not #\newline))
1022                        (? #\newline))))
1023        (assert (not (and (stream-null? head) (stream-null? tail)))))
1024       (wikidata-list-item info
1025         (stream-append
1026           (if (stream-null? head)
1027             stream-null
1028             (parse-all
1029               (stream-reverse
1030                 (stream-drop-while
1031                   char-whitespace?
1032                   (stream-reverse text)))
1033               (lambda () (error "foo"))
1034               (text-transform info #f #f #f #f #\space)))
1035           (if (stream-null? tail)
1036             stream-null
1037             (parse-all tail fail (list-transform info current)))))))))
1038
1039(define (definition-list info)
1040  (assert (wikidata? info))
1041  (lambda (str fail parsed)
1042    (parse-token str fail parsed
1043      ((#\; (all char-whitespace?)
1044        (bind term (*? (rule-apply (text-transform info #f #f #f #f #f))))
1045        (? (all char-blank?) #\: (all char-blank?)
1046           (bind definition (*? (not #\: #\newline) (all standard-char?)))
1047           (all char-blank?))
1048        (+ (all char-blank?) (or #\newline ((end)))))
1049       (wikidata-definition-item
1050         info
1051         term
1052         (parse-all definition (lambda () (error "foo")) (text-transform info #f #f #f #f #\space)))))))
1053
1054(define (global-token output open include name linktypes environment)
1055  (assert (driver? output))
1056  (global-token-info (make-wikidata output open include name linktypes environment '() (make-hash-table))))
1057
1058; This is the global parser which gets called by wiki->html.  It
1059; splits the input in chunks of lines (corresponding to
1060; paragraphs, lists, quotes, etc.) that must be processed
1061; together.
1062
1063(define (global-token-info info)
1064  (assert (wikidata? info))
1065  (lambda (str fail parsed)
1066    (parse-token str fail parsed
1067
1068      ; Simple line break:
1069
1070      ((#\- #\- #\- #\- (all char-blank?)) (wikidata-horizontal-line info))
1071
1072      ; Get all headers.  The type of header depends on the number
1073      ; of #\= signs:
1074
1075      ((#\= (bind depth (+all #\=))
1076        (all char-blank?)
1077        (bind name (*? (not #\newline)))
1078        (all char-blank?)
1079        (? #\= depth (all char-blank?))
1080        (or #\newline ((end))))
1081       (wikidata-header
1082         info
1083         (parse-all
1084           name
1085           (lambda () (error "noparse" (stream->string name)))
1086           (text-transform info #f #f #f #f #\space))
1087         (min 5 (stream-length (stream-cdr depth)))
1088         (sections-accept-new-name! (wikidata-previous-sections info) name)))
1089
1090      ; Skip empty lines:
1091
1092      ((#\newline) stream-null)
1093
1094      ; Process <ul> or <ol> lists calling the list-transform
1095      ; parser:
1096
1097     (((bind lines
1098             (+ (+all (or #\# #\*) (all #\space))
1099                (? #\newline)
1100                (all (not (or #\* #\# #\newline (#\= #\=)))
1101                     (all (not #\newline))
1102                     (or #\newline ((end))))
1103                (all #\newline))))
1104      (parse-all lines (lambda () (error "list-transform failed to parse")) (list-transform info stream-null)))
1105
1106      ; Process definition lists with the definition-list parser:
1107
1108      (((bind lines (+ (rule-apply (definition-list info)))))
1109       (wikidata-definition-list info lines))
1110
1111      ; Get quoted text (lines starting with #\>) inside a pair of
1112      ; <blockquote> tags:
1113
1114      (((+all #\> (all (or #\space #\tab))
1115              (bind text (all (not #\newline)) (or #\newline ((end))))
1116              (bind-accum (result '()) cons text)))
1117       (wikidata-blockquote info
1118         (parse-all
1119           (stream-concatenate (list->stream (reverse result)))
1120           (lambda () (error "noparse" (stream->string (stream-reverse (stream-cdr text)))))
1121           (global-token-info info))))
1122
1123      ; Get literal text (lines starting with #\space) inside a
1124      ; pair of <pre> tags:
1125
1126      (((bind text (+ #\space (*? char?) (or #\newline ((end))))))
1127       (wikidata-literal info
1128         (parse-all (stream-cdr text) (lambda () (error "foo")) (text-transform info #f #f #t #\space #\newline))))
1129
1130      ; Comments
1131
1132      ((#\< #\! (all char-whitespace?) #\- (all char-whitespace?) #\- (all char-whitespace?)
1133        (bind text (*? char?))
1134        (all char-whitespace?) #\- (all char-whitespace?) #\- (all char-whitespace?) #\>)
1135       (wikidata-comment info text))
1136
1137      ; Detect span extensions:
1138
1139      ((#\< (all char-whitespace?) (bind tag (all (or char-alphabetic? char-numeric?)))
1140        (assert (wiki-extension tag 'code-span))
1141        ; Parameters
1142        (* (+ char-whitespace?)
1143           (bind name (all (or char-alphabetic? char-numeric?)))
1144           (all char-whitespace?)
1145           (? #\= (all char-whitespace?)
1146              (or (#\" (bind value (all (not #\"))) #\")
1147                  (#\' (bind value (all (not #\'))) #\')
1148                  ((bind value (all (or char-alphabetic? char-numeric?))))))
1149           (bind-accum (params '()) cons (cons (stream->symbol (stream-downcase name)) value)))
1150        (all char-whitespace?) #\>
1151        (bind text (*? char?))
1152        #\< (all char-whitespace?) #\/ tag (all char-whitespace?) #\>)
1153
1154       ; *tags-span-external*
1155
1156       (run-span-extension tag text params info))
1157
1158      ; Detect break tags:
1159
1160      ((#\< (all char-whitespace?) (bind tag (all char-alphabetic?))
1161        (assert (wiki-extension tag 'code-break))
1162        ; Parameters
1163        (* (+ char-whitespace?)
1164           (bind name (all (or char-alphabetic? char-numeric?)))
1165           (all char-whitespace?)
1166           (? #\= (all char-whitespace?)
1167              (or (#\" (bind value (all (not #\"))) #\")
1168                  (#\' (bind value (all (not #\'))) #\')
1169                  ((bind value (all (or char-alphabetic? char-numeric?))))))
1170           (bind-accum (params '()) cons (cons (stream->symbol (stream-downcase name)) value)))
1171        (all char-whitespace?) (? #\/) #\>)
1172
1173       (run-break-extension tag params info))
1174
1175      ; Rule for normal paragraphs:
1176
1177      (((bind text (+all (not (or #\space #\newline #\> #\* #\# (#\= #\=))) (all (not #\newline)) (or #\newline ((end))))))
1178       (let ((text (parse-all text (lambda () (error "noparse" (stream->string (stream-reverse (stream-cdr text))))) (text-transform info #f #f #f #f #\space))))
1179         (if (stream-null? text)
1180           stream-null
1181           (wikidata-paragraph info text)))))))
1182
1183(define (accum-with-driver driver)
1184  (lambda (str . rest)
1185    (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)))
1186      (iterator->stream
1187        (lambda (collect stop)
1188          (stream-traverse
1189            (wiki-parse (driver collect) str tail name open include linktypes)))))))
1190
1191(define wiki-links
1192  (accum-with-driver links-driver))
1193
1194(define wiki-tags
1195  (accum-with-driver tags-driver))
1196
1197; TODO: This is already broken: we need to split PROCEDURE into two procs, one
1198; to generate the file and another one to include it (which can get called even
1199; if the file does not need to be generated).
1200;
1201; data-output-func receives three arguments:
1202;
1203; - a STREAM with some representation of the contents that will get rendered to
1204; the file.  Or #f.
1205;
1206; - the MIME-TYPE (eg. "image/jpeg")
1207;
1208; - a PROCEDURE.
1209;
1210; If STREAM evaluates to true, it gets hashed and a filename (path) at some
1211; directory is created with the hash on it (only the filename, no actual file
1212; is created).  If STREAM is #f, a random path (in the same directory) is used.
1213; If data-output-func wants to allow the contents to be rendered, it calls the
1214; procedure and passes two arguments: the actual filename that should be
1215; generated and the URL where that filename can be loaded.  data-output-func
1216; returns whatever the procedure returned (or, if it doesn't want any file to
1217; be created, whatever stream it wants to display instead of the file).
1218;
1219; The caller should not assume that the file it specified was created, just
1220; assume that it may have been created.  There might have been problems that
1221; prevented the procedure from actually creating it.
1222;
1223; Alternatively, data-output-func may be just #f, in which case wiki->html will
1224; now that it is never allowed to create any files.
1225;
1226; This interface hasa the following advantages:
1227;
1228; 1. The caller to wiki->html can register all the files created as a result of
1229; the parsing.
1230;
1231; 2. The caller to wiki->html gets full control as to where the files are
1232; actually created.  It can even specify that no file should actually be
1233; created.
1234;
1235; 3. Extensions can render new files, they just need to be given access to
1236; data-output-func.
1237;
1238; 4. We reuse paths, since their names depend on the hash of the content being
1239; rendered.  That way, if some content doesn't change, wiki->html will always
1240; use the same filename for it.  While this isn't a *requirement*, it makes
1241; wiki->html generated directories/files play nice with mirror software such as
1242; the file-mirror egg (which would otherwise constantly have to reupload
1243; everything, since the paths would change).
1244;
1245; 5. The data-output-func is responsible for mapping the mime-type to the
1246; actual extension that should be used.  Which is good: wiki->html shouldn't be
1247; the one to do that (because it would require to make assumptions that may not
1248; always hold).
1249;
1250; The mime type passed is one of the following:
1251;
1252; - image/png
1253;
1254; For functions/extensions calling data-output-func, here are some guidelines:
1255;
1256; - Make sure the mime type you use is documented above.
1257;
1258; - Note that the actual pathname created will depend on the actual value of
1259; the stream (very likely be a md5 or sha1 hash of it).  You should make sure
1260; that the inputs from which your file depends are fully included in the
1261; stream.  Otherwise you could end up overwriting the file with a different
1262; one.   For that reason, your stream should always start with the name of the
1263; caller (such as "html-math") followed by a colon followed by the actual input
1264; used by that caller.  If you can't fully specify your inputs here, just use
1265; #f (but this practice is discouraged!).
1266;
1267; This interface should hopefully accomodate well the needs of extensions'
1268; creators.  I know that at some point it will break and we will need something
1269; else, but I hope quite a long time passes before that horrid day.
1270
1271(define (wiki->html str . rest)
1272  (stream-delay
1273    (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (make-header (make-html-header)) (data-output-func (constantly stream-null)) (check-exists? (constantly #t)) (url-adjust identity) (environment (environment ())) (no-follow? (constantly #f)))
1274      (wiki-parse (html-driver make-header data-output-func check-exists? url-adjust no-follow?) str tail name open include linktypes environment))))
1275
1276(define (wiki->text str . rest)
1277  (stream-delay
1278    (let-optionals rest ((human-readable #t) (tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (environment (environment ())))
1279      (wiki-parse (text-driver human-readable) str tail name open include linktypes environment))))
1280
1281(define (wiki->latex str . rest)
1282  (stream-delay
1283    (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (class *latex-default-document-class*) (links-base identity) (environment (environment ())) (include-in-toc (list 0 1 2 3 4)) (newpage-after-section (list)))
1284      (wiki-parse (latex-driver class links-base include-in-toc newpage-after-section)
1285                  str tail name open include linktypes environment))))
1286
1287(define (wiki-parse output str . rest)
1288  (assert (driver? output))
1289  (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (environment (environment ())))
1290    (parse-all str (lambda () (error "Syntax error")) (global-token output open include name linktypes environment) tail)))
1291
1292;;; Linktypes
1293;
1294; Used for interwiki links and stuff.  For example, have [[google:something]]
1295; translate into a Google search for that keyword.
1296
1297; Load the linktypes specified in file into hash.  The file has the format
1298; NAME:CONTENT, where CONTENT is the wiki code we will replace the link with.
1299; CONTENT must have %t for the target and %n for the link's name.
1300;
1301; E.g.: google:[[http://www.google.com/search?hl=es&q=%t|%n]]
1302;
1303; All the linktypes are added to hash hash, indexed by their type.  The value
1304; is a stream where entries are either streams of characters (to be included
1305; literally) or characters for the escape sequences.
1306
1307(define (load-linktypes hash file)
1308  (with-input-from-file file
1309    (lambda ()
1310      (stream-for-each
1311        (lambda (line)
1312          (receive (name type)
1313                   (stream-break (cut char=? #\: <>) line)
1314            (unless (stream-null? type)
1315              (hash-table-set! hash
1316                (stream->symbol (stream-downcase name))
1317                (linktype-parse (stream-cdr type))))))
1318        (stream-remove
1319          (lambda (x) (or (stream-null? x) (char=? (stream-car x) #\#)))
1320          (stream-map
1321            (cut stream-drop-while char-whitespace? <>)
1322            (stream-lines (port->stream (current-input-port)))))))))
1323
1324(define (linktype-parse type)
1325  (receive (literal escape)
1326           (stream-break (cut char=? #\% <>) type)
1327    (if (stream-null? literal)
1328      (linktype-parse-escape escape)
1329      (stream-cons literal (linktype-parse-escape escape)))))
1330
1331(define (linktype-parse-escape escape)
1332  (if (or (stream-null? escape) (stream-null? (stream-cdr escape)))
1333    stream-null
1334    (stream-cons (stream-cadr escape) (linktype-parse (stream-cddr escape)))))
1335
1336(define (run-linktype lt)
1337  (lambda (info type dst name)
1338    (let* ((type-sym (stream->symbol (stream-downcase type)))
1339           (text (run-linktype-first lt dst name)))
1340      ; Avoid infinite recursion
1341      (if (member type-sym (wikidata-linktypes-current info))
1342        text
1343        (parse-all
1344          text
1345          (lambda ()
1346            (error "Internal error: Unable to parse" (stream->string text)))
1347          (text-transform
1348            (apply make-wikidata
1349                   (map
1350                     (lambda (f) (f info))
1351                     (list
1352                       wikidata-driver
1353                       wikidata-open
1354                       wikidata-include
1355                       wikidata-name
1356                       wikidata-linktypes
1357                       wikidata-environment
1358                       (lambda (o)
1359                         (cons type-sym (wikidata-linktypes-current o)))
1360                       wikidata-previous-sections)))
1361            #f #f #f #f #\newline)
1362          stream-null)))))
1363
1364(define (run-linktype-first lt dst name)
1365  (let ((votes (delay (vote-linktype (or name dst)))))
1366    (let loop ((lt lt))
1367      (stream-delay
1368        (if (stream-null? lt)
1369          stream-null
1370          (stream-append
1371            (if (stream? (stream-car lt))
1372              (stream-car lt)
1373              (case (stream-car lt)
1374                ((#\c) (number->stream (stream-length (force votes))))
1375                ((#\n) (or name dst))
1376                ((#\o) (stream-map char-downcase (or name dst)))
1377                ((#\t) dst)
1378                ((#\u) (stream-map char-downcase dst))
1379                ((#\v) (string->stream (format #f "~,2F" (votes-average (force votes) 0 0))))
1380                (else (error "Invalid escape sequence" (stream-car lt)))))
1381            (loop (stream-cdr lt))))))))
1382
1383(define (votes-average str total count)
1384  (cond
1385    ((not (stream-null? str)) (votes-average (stream-cdr str) (+ total (stream-car str)) (+ count 1)))
1386    ((zero? count) 0)
1387    (else (/ total count))))
1388
1389(define (vote-linktype str)
1390  (stream-filter identity (stream-map stream->number (stream-split str char-whitespace?))))
1391
1392;;
1393
1394(define (simple-tag-span-get name get-parser)
1395  (list name
1396        (let ((open  (stream-append (stream #\<) (symbol->stream name) (stream #\>)))
1397              (close (stream-append (stream #\< #\/) (symbol->stream name) (stream #\>))))
1398          (lambda (text params . args)
1399            (stream-append
1400              open
1401              (parse-all
1402                text
1403                (lambda () (error "bar"))
1404                (apply get-parser args)
1405                stream-null)
1406              close)))))
1407
1408(define (simple-tag-span name) (simple-tag-span-get name text-transform))
1409
1410(define (shell-escape path)
1411  (list->string
1412    (cons #\space
1413      (fold-right
1414        (lambda (c rest)
1415          (if (or (char-alphabetic? c) (char-numeric? c) (member c '(#\/ #\-)))
1416            (cons c rest)
1417            (cons* #\\ c rest)))
1418        '()
1419        (stream->list path)))))
1420
1421(define *tags-span*
1422  `(
1423    ,@(map simple-tag-span '(u i span small big b sup sub))))
1424
1425;;; Sections for wiki pages
1426
1427(define (recognize-start-wiki document)
1428  (receive (result rest new-fail parsed)
1429           (parse-token document (constantly #f #f #f #f) stream-null
1430             ((#\= #\= (bind depth (all #\=))
1431               (all char-blank?)
1432               (bind name (*? (not #\newline)))
1433               (all char-blank?)
1434               (? #\= #\= depth (all char-blank?))
1435               (or #\newline ((end))))
1436              (make-section (stream-length depth) name)))
1437    (if result
1438      (values result (stream-reverse parsed) rest)
1439      (take-one-line document))))
1440
1441(define (wiki->sections document)
1442  (document->sections recognize-start-wiki document))
1443
1444(define wiki->toc (compose sections->toc wiki->sections))
1445
1446;;; Extensions
1447
1448(define (wiki-extension name type)
1449  (svnwiki-extensions-get type (stream->symbol (stream-downcase name))))
1450
1451(define (environment-code-extensions info params)
1452  (environment
1453    (wikidata-environment info)
1454    ((params params)
1455     (parse (lambda (str)
1456              (parse-all str
1457                         (lambda () (error "Syntax error"))
1458                         (global-token-info info)
1459                         stream-null)))
1460
1461     ; Function to parse some text as a paragraph.  Receives the text and an
1462     ; optional alist with properties corresponding to parameters for
1463     ; text-transform.
1464
1465     (parse-paragraph
1466      (lambda (text . rest)
1467        (let-optionals rest ((properties '()))
1468          (parse-all
1469            text
1470            (lambda () (error "bar"))
1471            (apply
1472              text-transform
1473              info
1474              (map (lambda (data)
1475                     (cadr (or (assoc (car data) properties) data)))
1476                   '((strong #f) (em #f) (literal #f) (start #f) (newline #\newline))))
1477            stream-null))))
1478
1479     ; This used to be deprecated but it really is needed by some
1480     ; format-dependant extensions.
1481
1482     (output-format
1483      (driver-output-format (wikidata-driver info)))
1484
1485     (driver (wikidata-driver info)))))
1486
1487(define (run-span-extension name text params info)
1488  ((wiki-extension name 'code-span)
1489   (environment
1490     (environment-code-extensions info params)
1491     ((text text)))))
1492
1493(define (run-break-extension name params info)
1494  ((wiki-extension name 'code-break)
1495   (environment-code-extensions info params)))
1496
1497;;; TEXI driver
1498
1499(define (wiki->texi str . rest)
1500  (stream-delay
1501    (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) 
1502                         (include (lambda (name tail) tail)) (linktypes (make-hash-table)) 
1503                         (environment (environment ())))
1504     (let-values (((texi-nodes lookup-table) (texi-menu str)))
1505         (stream-append
1506          (->stream-char "@menu\n")
1507          texi-nodes
1508          (->stream-char "@end menu\n")
1509          (wiki-parse (texi-driver lookup-table) str
1510                      tail name open include linktypes environment))))))
1511
1512(define (texi-page author title copyright first content . rest)
1513  (let-optionals rest ((subtitle #f) (month-year #f) (version #f))
1514    (stream-concatenate
1515      (stream-map
1516        ->stream-char
1517        (stream
1518          "\\input texinfo @c -*- texinfo -*-\n"
1519          (format #f "@settitle ~A\n" title)
1520          "@setchapternewpage on\n"
1521          (if month-year (format #f "@set month-year ~A\n" month-year) "")
1522          (if version (format #f "@set version ~A\n" version) "")
1523          "@copying\n"
1524          copyright
1525          "\n"
1526          "@end copying\n"
1527          "@titlepage\n"
1528          "@sp 10\n"
1529          (format #f "@title{~A}\n" title)
1530          (if subtitle (format #f "@subtitle{~A}\n" subtitle) "")
1531          (if version (format #f "@subtitle{Edition @value{version}}\n") "")
1532          (format #f "@author{~A}\n" author)
1533          "@comment  The following two commands start the copyright page.\n"
1534          "@page\n"
1535          "@vskip 0pt plus 1fill\n"
1536          copyright "\n"
1537          "@end titlepage\n"
1538          (format #f "@node Top, ~A, (dir), (dir)\n"  first)
1539          (format #f "@top ~A\n" title)
1540          (format #f "This is the top node.\n")
1541          content
1542          "\n"
1543          "@shortcontents\n"
1544          "@contents\n"
1545          "@bye\n")))))
1546
1547
1548
1549(define (texi-find-node lookup-table n up-node . rest)
1550  (let-optionals rest ((handler #f))
1551    (let ((name  (string->symbol (escape-texi-node-name n up-node))))
1552      (if handler
1553          (hash-table-ref lookup-table name handler)
1554          (hash-table-ref lookup-table name)))))
1555
1556(define (texi-wrap start end)
1557  (let ((real-start (string->stream start)) 
1558        (real-end (string->stream end)))
1559    (lambda (arg) 
1560      (stream-append real-start arg real-end))))
1561
1562(define (texi-escape-text dst)
1563  (stream-delay 
1564   (if (stream-null? dst)
1565       stream-null
1566       (case (stream-car dst)
1567         ((#\@) 
1568          (stream-cons* #\@ (stream-car dst) (texi-escape-text (stream-cdr dst))))
1569         (else (stream-cons (stream-car dst) (texi-escape-text (stream-cdr dst))))))))
1570
1571;; Look for a node starting at start-depth and checking at every level
1572;; between 0 and start-depth.
1573(define (texi-find-node-in-tree lookup-table n start-depth last-at-depth)
1574  (let ((name  (string-intersperse
1575                (string-tokenize n (char-set-complement (list->char-set (list #\#))))
1576                " - ")))
1577    (let loop ((depth start-depth))
1578      (if (positive? depth)
1579          (let* ((up-node  (vector-ref last-at-depth depth))
1580                 (node     (texi-find-node lookup-table name up-node
1581                                           (lambda () #f))))
1582            (or node  (loop (- depth 1))))
1583          (texi-find-node lookup-table name #f)))))
1584                         
1585;; If the stream has at least n elements, return a list containing
1586;; those elements, otherwise return #f
1587(define (stream->n-list strm n)
1588  (error "stream->n-list has bugs and has therefore been disabled.")
1589  (let loop ((strm strm) (i 0) (lst (list)))
1590    (if (stream-null? strm) 
1591        (if (= (+ 1 i) n) (list->string (reverse ax)) #f)
1592        (if (< i n) 
1593            (loop (stream-cdr strm) (+ 1 i) (cons (stream-car strm) lst))
1594            (list->string (reverse lst))))))
1595
1596(define (texi-unescape str)
1597  (stream-delay
1598    (if (stream-null? str) str
1599        (match (stream-car str)
1600          (#\@   (stream-cons (stream-cadr str) (texi-unescape (stream-cddr str))))
1601          (else  (stream-cons (stream-car str) (texi-unescape (stream-cdr str))))))))
1602
1603
1604(define (texi-driver lookup-table) 
1605  (let ((last-at-depth (make-vector 10 #f))
1606        (last-depth  0))
1607    (make-driver
1608     'texi
1609     ;; horizontal line
1610     ;; TODO: Implement!
1611     (constantly stream-null)
1612     ;; make header
1613     (lambda (name depth id)
1614       (let ((up-node (and (positive? depth) (vector-ref last-at-depth (- depth 1)))))
1615         (stream-append
1616          ;; print the @node and @menu.
1617          (string->stream 
1618           (let ((node (texi-find-node lookup-table (stream->string name) up-node)))
1619             (set! last-depth depth)
1620             (vector-set! last-at-depth depth node)
1621             (vector-set! last-at-depth (+ depth 1) #f)
1622             (let ((prologue (string-concatenate 
1623                              (list (case depth
1624                                      ((0)  "@chapter")
1625                                      ((1)  "@section")
1626                                      ((2)  "@subsection")
1627                                      (else "@subsubsection")) " "
1628                                      (stream->string name)))))
1629               (call-with-output-string
1630                (lambda (out) (print-node node out prologue))))))
1631          (stream #\newline #\newline))))
1632     ;; blockquote
1633     (texi-wrap "@quotation\n" "\n@end quotation\n")
1634     ;; center
1635     (texi-wrap "@center " "")
1636     ;; small
1637     (lambda (x)
1638       (error "Small not implemented yet in Texinfo mode."))
1639     ;; big
1640     (lambda (x)
1641       (error "Big not implemented yet in Texinfo mode."))
1642     ;; verbatim
1643     (lambda (arg) 
1644       (let ((start (string->stream "@verbatim\n")) 
1645             (end (string->stream "\n@end verbatim\n")))
1646      (stream-append start (texi-unescape arg) end)))
1647     ;; code
1648     (texi-wrap "@code{" "}")
1649     ;; paragraph
1650     (texi-wrap "" "\n\n")
1651     ;; strong
1652     (texi-wrap "@b{" "}")
1653     ;; emphasis
1654     (texi-wrap "@emph{" "}")
1655     ;; link
1656     (lambda (dst name)
1657       (let* ((link-external?  (url-external? dst))
1658              (link-email?     (let ((prefix (stream->n-list dst 7)))
1659                                 (and prefix (string=? prefix "mailto:" ))))
1660              (link            (if link-external? dst
1661                                   (texi-find-node-in-tree lookup-table (stream->string dst) 
1662                                                           last-depth last-at-depth))))
1663         (stream-append
1664          (string->stream (if link-external? "@uref{" "@ref{"))
1665          (if link-external? 
1666              (if link-email? (texi-escape-text dst)  dst)
1667              (string->stream (symbol->string (texi-node-name link))))
1668          (stream #\, #\space)
1669          (if link-external?
1670              (if link-email? (texi-escape-text name)  name)
1671              name)
1672          (stream #\}))))
1673     ;; image
1674     (lambda (dst name)
1675       (warning "Image not implemented in Texinfo mode.~%")
1676       (receive (type alt)
1677                (stream-break (cut char=? <> #\|) name)
1678                (stream->string (format #f "[[IMAGE:~A]]" (stream->string (or alt dst))))))
1679     ;; math
1680     (lambda (text)
1681       (string->stream (format #f "$$~A$$" (stream->string text))))
1682     ;; ordered list
1683     (texi-wrap "@enumerate\n" "\n@end enumerate\n")
1684     ;; bullets list
1685     (texi-wrap "@itemize\n" "\n@end itemize\n")
1686     ;; list item
1687     (texi-wrap "@item " "\n\n")
1688     ;; definition list
1689     (texi-wrap "@table @b\n" "\n@end table\n")
1690     ;; definition
1691     (lambda (term definition)
1692       (string->stream
1693        (format #f "@item ~A~%~%~A~%" (stream->string term) (stream->string definition))))
1694     ;; toc, gets discarded in texi files.
1695     (constantly stream-null)
1696     ;; special-character
1697     (lambda (x)
1698       (->stream-char
1699        (case x
1700          ((#\{ #\} #\@) (stream #\@ x))
1701          ((#\<) "<")
1702          ((#\>) ">")
1703          ((copyright) "(C)")
1704          ((reg) "(R)")
1705          ((left-arrow) "<-")
1706          ((right-arrow) "->")
1707          ((double-arrow) "<->")
1708          ((double-arrow-wide) "<=>")
1709          ((left-arrow-wide) "<=")
1710          ((right-arrow-wide) "=>")
1711          ((mdash) "---")
1712          ((ndash) "--")
1713          ((laquo) #\xab)
1714          ((raquo) #\xbb)
1715          (else (stream x)))))
1716     ;; tags
1717     (constantly stream-null)
1718     ;; comments
1719     (constantly stream-null)
1720     ;; line-break
1721     (constantly (stream #\\ #\\ ))
1722     ;; anchor
1723     (lambda (anchor text)
1724       (string->stream (format #f "@anchor{~A}" (stream->string text)))))))
1725
1726;;; Texi: menus, navigation, node relationships
1727
1728;; The current strategy is to do a pre-pass on the wiki-stream, and
1729;; build a lookup table of all the sections (which will become nodes
1730;; in the texi output). This table is passed as an argument when the
1731;; texi-driver is being created, and used in the TOC and Section
1732;; handlers to generate the appropriate navigational cues.
1733
1734;; This isn't very streamy code. :-) I'm sure we can make it more
1735;; consistent with the stream-wiki style once it's working correctly.
1736
1737;; Values in the lookup table are texi-node records. (Keys are
1738;; node-names.)
1739
1740(define-record texi-node name next prev up submenu depth)
1741
1742(define (print-node node out . rest)
1743  (let-optionals rest ((prologue #f))
1744  ;; print the @node line for the node, an optional prologue, and its
1745  ;; menu if any.
1746  (fprintf out "@node ~A, ~A, ~A, ~A~%"
1747           (texi-node-name node)
1748           (or (texi-node-next node) " ")
1749           (or (texi-node-prev node) " ")
1750           (let ((up-node (texi-node-up node)))
1751             (if up-node (texi-node-name up-node) "Top")))
1752  (when prologue
1753    (fprintf out "~A~%" prologue))
1754  (let ((sub (texi-node-submenu node)))
1755    (if sub
1756        (unless (null? sub)
1757          (fprintf out "~%@menu~%")
1758          (for-each (lambda (sub)
1759                      (fprintf out "* ~A::~%" sub))
1760                    (reverse sub))
1761          (fprintf out "~%@end menu~%"))))))
1762
1763(define-record-printer (texi-node node out)
1764  (print-node node out #f))
1765
1766(define (texi-name-parse str)
1767  (let loop ((mode? #t) (cmd? #f) (lst  (string->list str)) (ax (list)))
1768    (if (null? lst) (list->string (reverse ax))
1769        (match lst
1770               ((#\@ #\@ . rest)  (loop mode? cmd? rest (if mode? (cons #\@ ax) ax)))
1771               ((#\@ . rest)      (loop #f #t rest ax))
1772               ((#\{ . rest)      (loop (if (and cmd? (not mode?)) #t mode?) cmd? 
1773                                        rest ax))
1774               ((#\} . rest)      (loop mode? (not cmd?) rest ax))
1775               ((x . rest)        (loop mode? cmd? rest (if mode? (cons x ax) ax)))))))
1776
1777;; Assign compound names to sectional units inside sections, escape
1778;; periods, commas, colons and parentheses, and convert Texinfo
1779;; @cmd{str} forms to str in the resulting string.
1780(define (escape-texi-node-name s up)
1781  (let ((prefix  (if up (list (symbol->string (texi-node-name up))) (list))))
1782    (let ((n (string-intersperse (reverse (cons (texi-name-parse s) prefix)) " - ")))
1783      (string-translate* n '(("." . ";") ("," . ";") (":" . ";") ("(" . ";") (")" . ";"))))))
1784
1785(define (texi-menu str)
1786  (let ((lookup (make-hash-table)))
1787    (values ((accum-with-driver (texi-node-driver lookup)) str)
1788            lookup)))
1789
1790
1791(define (texi-node-driver lookup)
1792  (lambda (register)
1793    (let ((last-at-depth (make-vector 10 #f))
1794          (last-depth 0)
1795          (last-link #f))
1796      (vector-set! last-at-depth 0 (make-texi-node 'Top #f #f #f #f 0))
1797      (make-driver
1798       'texi-node
1799       (constantly stream-null)
1800       ;; make header
1801       (lambda (name depth id)
1802         (let* ((up-node    (and (positive? depth) (vector-ref last-at-depth (- depth 1))))
1803                (sym        (string->symbol (escape-texi-node-name (stream->string name) up-node)))
1804                (this-node  (make-texi-node sym #f #f up-node (list) depth)))
1805           (set! last-depth depth)
1806           ;; if a node by that name already exists, there are two
1807           ;; possibilities: there are two nodes of the same name in the
1808           ;; wiki document (which is an error) or a dummy node of that
1809           ;; name was created by a "Next/Previous" link (see below)
1810           (let ((l (hash-table-ref/default lookup sym #f)))
1811             (if (and l (texi-node-name l))
1812                 ;; Texinfo does not support two nodes with the same name
1813                 (error 'texi-node-driver "two nodes cannot have the same name" sym))
1814             ;; use the next/prev link in the dummy node, if it was created
1815             (and l (cond ((texi-node-prev l) (texi-node-prev-set! this-node (texi-node-prev l)))
1816                          ((texi-node-next l) (texi-node-next-set! this-node (texi-node-next l)))))
1817             ;; discard the dummy node and insert the real node in the table
1818             (hash-table-set! lookup sym this-node)
1819             (if (= 0 depth)
1820                 (stream-for-each register (string->stream (format #f "* ~A::\n" (texi-node-name this-node)))))
1821             (if up-node (texi-node-submenu-set! up-node (cons sym (texi-node-submenu up-node))))
1822             (let ((last-node (vector-ref last-at-depth depth)))
1823               (if last-node
1824                   (begin
1825                     (texi-node-next-set! last-node (texi-node-name this-node))
1826                     (texi-node-prev-set! this-node (texi-node-name last-node)))))
1827             (vector-set! last-at-depth depth this-node)
1828             (vector-set! last-at-depth (+ depth 1) #f)
1829             stream-null)))
1830
1831       ;; blockquote
1832       (constantly stream-null)
1833       ;; center
1834       identity
1835       ;; small
1836       identity
1837       ;; big
1838       identity
1839       ;; verbatim
1840       (constantly stream-null)
1841       ;; code
1842       identity
1843
1844       ;; paragraph
1845       ;; The text "Next: " or "Previous: ", followed by a link serves to
1846       ;; override the default prev/next nodes on level 0
1847       (lambda (x) 
1848         (cond ((and (<= 6 (stream-length x))
1849                     (string=? "Next: " (stream->string (stream-take x 6))))
1850                (let ((texi-last-node (vector-ref last-at-depth 0)))
1851                  (if (and texi-last-node last-link)
1852                      (let ((texi-next last-link))
1853                        (let ((texi-next-node (hash-table-ref/default lookup texi-next #f)))
1854                          (texi-node-prev-set! texi-last-node texi-next)
1855                          (if (not texi-next-node)
1856                              (let ((dummy-node (make-texi-node #f (texi-node-name texi-last-node) #f #f #f #f)))
1857                                (hash-table-set! lookup texi-next dummy-node))))))
1858                  stream-null))
1859               ((and (<= 10 (stream-length x))
1860                     (string=? "Previous: " (stream->string (stream-take x 10))))
1861                (let ((texi-last-node (vector-ref last-at-depth 0)))
1862                  (if (and texi-last-node last-link)
1863                      (let ((texi-prev last-link))
1864                        (let ((texi-prev-node (hash-table-ref/default lookup texi-prev #f)))
1865                          (texi-node-next-set! texi-last-node texi-prev)
1866                          (if (not texi-prev-node)
1867                              (let ((dummy-node (make-texi-node #f #f (texi-node-name texi-last-node) #f #f #f)))
1868                                (hash-table-set! lookup texi-prev dummy-node))))))
1869                  stream-null))
1870               
1871               (else (begin
1872                       (set! last-link #f)
1873                       stream-null))))
1874
1875       ;; strong
1876       identity
1877       ;; emphasis
1878       identity
1879       
1880       ;; link
1881       (constantly stream-null)
1882       
1883       (constantly stream-null)
1884       (constantly stream-null)
1885       (constantly stream-null) 
1886       (constantly stream-null)
1887       (constantly stream-null)
1888       (constantly stream-null)
1889       (constantly stream-null)
1890       ;; toc
1891       (constantly stream-null)
1892       ;; special-char
1893       (lambda (x)
1894         (->stream-char
1895          (case x
1896            ((#\@ #\{ #\}) (stream #\@ x))
1897            ((copyright) "(C)")
1898            ((reg) "(R)")
1899            ((left-arrow) "<-")
1900            ((right-arrow) "->")
1901            ((double-arrow) "<->")
1902            ((double-arrow-wide) "<=>")
1903            ((left-arrow-wide) "<=")
1904            ((right-arrow-wide) "=>")
1905            ((mdash) "---")
1906            ((ndash) "--")
1907            ((laquo) #\xab)
1908            ((raquo) #\xbb)
1909            (else (stream x)))))
1910       ;; tags
1911       (constantly stream-null)
1912       (constantly stream-null) 
1913       (constantly stream-null)
1914       ;; anchor
1915       (constantly stream-null)))))
Note: See TracBrowser for help on using the repository browser.