Changeset 12533 in project


Ignore:
Timestamp:
11/16/08 19:13:36 (11 years ago)
Author:
azul
Message:

Importing svnwiki extensions.

Location:
release/3
Files:
87 added
1 deleted
4 edited
18 copied

Legend:

Unmodified
Added
Removed
  • release/3/iconv/trunk/iconv.setup

    r6315 r12533  
     1;; -*- scheme -*-
     2
    13(define libiconv
    24  (if (or (eq? 'macosx (software-version))
     
    57    ""))
    68
    7 (compile -s -O2 -d1 iconv.scm ,libiconv)
    8 (install-extension
    9  'iconv
    10  "iconv.so"
    11  '((version 1.5)
    12    (documentation "iconv.html")))
     9(define has-exports? (string>=? (chicken-version) "2.310"))
     10
     11(define (dynld-name fn)
     12  (make-pathname #f fn ##sys#load-dynamic-extension))   
     13
     14(compile  -O2 -d0 -s
     15         ,@(if has-exports? '(-check-imports -emit-exports iconv.exports) '())
     16         iconv.scm)
     17
     18(install-extension 'iconv
     19                   `(,(dynld-name "iconv")
     20                     ,@(if has-exports? '("iconv.exports") (list)))
     21                   `((version ,(if (file-exists? "version") (with-input-from-file "version" read) "unknown"))
     22                     ,@(if has-exports? `((exports "iconv.exports")) (list))
     23                     (documentation "iconv.html")))
  • release/3/stream-wiki/trunk/stream-wiki.meta

    r12418 r12533  
    77 (category web)
    88 (synopsis "Parsing files in wiki format and rendering them to HTML")
    9  (needs srfi-40 stream-ext html-stream stream-parser format-modular stream-sections uri))
     9 (needs srfi-40 stream-ext html-stream stream-parser format-modular stream-sections uri svnwiki-extensions))
  • release/3/stream-wiki/trunk/stream-wiki.scm

    r12418 r12533  
    2626    wiki-links
    2727    wiki-tags
    28     load-extensions-from-file
    29     extension-update
    30     extension-files-actions-links
    31     extension-toc-header
    32     extension-data
    3328
    3429    ; Exports for extensions:
     
    4641    driver-blockquote
    4742    driver-line-break
    48     driver-anchor
    49 
    50     *extensions*)
    51   (usual-integrations)
    52   (run-time-macros))
    53 
    54 (include "chicken-more-macros")                                                                                               
    55 
    56 (use srfi-1 srfi-40 stream-ext html-stream stream-parser posix format-modular stream-sections uri)
     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)
    5747
    5848; An output driver is simply a table of functions.
     
    9787          ((get driver) (text->html-id anchor) text))))))
    9888
    99 ; An extension tag for the wiki syntax.
    100 
    101 ; name is a symbol with the name for the tag (all in lower).
    102 
    103 (define-record extension name table)
    104 
    10589; Output is an output driver.  See html-driver for an example.
    10690
     
    11296; tags is a hash table of record objects of type tags.
    11397
    114 (define-record wikidata driver open include name linktypes extensions extension-args linktypes-current previous-sections)
     98(define-record wikidata driver open include name linktypes environment linktypes-current previous-sections)
    11599
    116100; Macro used to generate the functions in the HTML driver.
     
    359343    (lambda (info dst)
    360344      (let* ((file (if (stream-null? dst) (wikidata-name info) (stream->string dst))))
    361         (wiki-parse (wikidata-driver info) (wiki->toc ((wikidata-open info) file)) stream-null file (wikidata-open info) (wikidata-include info) (wikidata-extensions info))))
     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))))
    362352    ; special-char
    363353    (lambda (x)
     
    817807
    818808      ((#\< (all char-whitespace?) (bind tag (all char-alphabetic?))
    819         (assert
    820           (and-let* ((ext (hash-table-ref/default
    821                             (wikidata-extensions info)
    822                             (stream->symbol (stream-downcase tag))
    823                             #f)))
    824             (extension-code-span ext)))
     809        (assert (wiki-extension tag 'code-span))
    825810        ; Parameters
    826811        (* (+ char-whitespace?)
     
    836821        #\< (all char-whitespace?) #\/ tag (all char-whitespace?) #\>)
    837822
    838        (run-span-extension
    839          (hash-table-ref
    840            (wikidata-extensions info)
    841            (stream->symbol (stream-downcase tag)))
    842          text
    843          params
    844          info))
     823       (run-span-extension tag text params info))
    845824
    846825      ; Break tags:
    847826
    848827      ((#\< (all char-whitespace?) (bind tag (all char-alphabetic?))
    849         (assert
    850           (and-let* ((ext (hash-table-ref/default
    851                             (wikidata-extensions info)
    852                             (stream->symbol (stream-downcase tag))
    853                             #f)))
    854             (extension-code-break ext)))
     828        (assert (wiki-extension tag 'code-break))
    855829        ; Parameters
    856830        (* (+ char-whitespace?)
     
    863837           (bind-accum (params '()) cons (cons (stream->symbol (stream-downcase name)) value)))
    864838        (all char-whitespace?) (? #\/) (all char-whitespace?) #\>)
    865        (run-break-extension
    866          (hash-table-ref
    867            (wikidata-extensions info)
    868            (stream->symbol (stream-downcase tag)))
    869          params
    870          info))
     839       (run-break-extension tag params info))
    871840
    872841      ; Replace certain sequences with HTML entities, unless we are inside a
     
    10831052         (parse-all definition (lambda () (error "foo")) (text-transform info #f #f #f #f #\space)))))))
    10841053
    1085 (define (global-token output open include name linktypes extensions extensions-args)
     1054(define (global-token output open include name linktypes environment)
    10861055  (assert (driver? output))
    1087   (global-token-info (make-wikidata output open include name linktypes extensions extensions-args '() (make-hash-table))))
     1056  (global-token-info (make-wikidata output open include name linktypes environment '() (make-hash-table))))
    10881057
    10891058; This is the global parser which gets called by wiki->html.  It
     
    11691138
    11701139      ((#\< (all char-whitespace?) (bind tag (all (or char-alphabetic? char-numeric?)))
    1171         (assert
    1172           (and-let* ((ext (hash-table-ref/default
    1173                             (wikidata-extensions info)
    1174                             (stream->symbol (stream-downcase tag))
    1175                             #f)))
    1176             (extension-code-span ext)))
     1140        (assert (wiki-extension tag 'code-span))
    11771141        ; Parameters
    11781142        (* (+ char-whitespace?)
     
    11901154       ; *tags-span-external*
    11911155
    1192        (run-span-extension
    1193          (hash-table-ref
    1194            (wikidata-extensions info)
    1195            (stream->symbol (stream-downcase tag)))
    1196          text
    1197          params
    1198          info))
     1156       (run-span-extension tag text params info))
    11991157
    12001158      ; Detect break tags:
    12011159
    12021160      ((#\< (all char-whitespace?) (bind tag (all char-alphabetic?))
    1203         (assert
    1204           (and-let* ((ext (hash-table-ref/default
    1205                             (wikidata-extensions info)
    1206                             (stream->symbol (stream-downcase tag))
    1207                             #f)))
    1208             (extension-code-break ext)))
     1161        (assert (wiki-extension tag 'code-break))
    12091162        ; Parameters
    12101163        (* (+ char-whitespace?)
     
    12181171        (all char-whitespace?) (? #\/) #\>)
    12191172
    1220        (run-break-extension
    1221          (hash-table-ref
    1222            (wikidata-extensions info)
    1223            (stream->symbol (stream-downcase tag)))
    1224          params
    1225          info))
     1173       (run-break-extension tag params info))
    12261174
    12271175      ; Rule for normal paragraphs:
     
    12351183(define (accum-with-driver driver)
    12361184  (lambda (str . rest)
    1237     (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (extensions (make-hash-table)))
     1185    (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)))
    12381186      (iterator->stream
    12391187        (lambda (collect stop)
    12401188          (stream-traverse
    1241             (wiki-parse (driver collect) str tail name open include linktypes extensions)))))))
     1189            (wiki-parse (driver collect) str tail name open include linktypes)))))))
    12421190
    12431191(define wiki-links
     
    13231271(define (wiki->html str . rest)
    13241272  (stream-delay
    1325     (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)) (extensions (make-hash-table)) (url-adjust identity) (extension-args #f) (no-follow? (constantly #f)))
    1326       (wiki-parse (html-driver make-header data-output-func check-exists? url-adjust no-follow?) str tail name open include linktypes extensions extension-args))))
     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))))
    13271275
    13281276(define (wiki->text str . rest)
    13291277  (stream-delay
    1330     (let-optionals rest ((human-readable #t) (tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (extensions (make-hash-table)) (extension-args #f))
    1331       (wiki-parse (text-driver human-readable) str tail name open include linktypes extensions extension-args))))
     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))))
    13321280
    13331281(define (wiki->latex str . rest)
    13341282  (stream-delay
    1335     (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (extensions (make-hash-table)) (class *latex-default-document-class*) (links-base identity) (extension-args #f) (include-in-toc (list 0 1 2 3 4)) (newpage-after-section (list)))
    1336       (wiki-parse (latex-driver class links-base include-in-toc newpage-after-section )
    1337                   str tail name open include linktypes extensions extension-args))))
     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))))
    13381286
    13391287(define (wiki-parse output str . rest)
    13401288  (assert (driver? output))
    1341   (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (extensions (make-hash-table)) (extension-args #f))
    1342     (parse-all str (lambda () (error "Syntax error")) (global-token output open include name linktypes extensions extension-args) tail)))
     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)))
    13431291
    13441292;;; Linktypes
     
    14071355                       wikidata-name
    14081356                       wikidata-linktypes
    1409                        wikidata-extensions
    1410                        wikidata-extension-args
    1411                        wikidata-previous-sections
     1357                       wikidata-environment
    14121358                       (lambda (o)
    1413                          (cons type-sym (wikidata-linktypes-current o))))))
     1359                         (cons type-sym (wikidata-linktypes-current o)))
     1360                       wikidata-previous-sections)))
    14141361            #f #f #f #f #\newline)
    14151362          stream-null)))))
     
    14991446;;; Extensions
    15001447
    1501 (define (load-extensions-from-file extensions file)
    1502   (set! *extensions* '()) ; just in case.
    1503   (load file)
    1504   (when (null? *extensions*)
    1505     (warning "Extension does not define anything!" file))
    1506   (for-each
    1507     (lambda (alist)
    1508       (and (pair? alist)
    1509            (not (null? alist))
    1510            (hash-table-set! extensions (car alist) (alist->extension alist))))
    1511     *extensions*))
    1512 
    1513 ; TODO: This is bad, we shouldn't do this.  Ugh.  But we need some way
    1514 ; to communicate with the code in the extensions.
    1515 
    1516 (define *extensions* '())
    1517 
    1518 (define (alist->extension alist)
    1519   (make-extension (car alist) (cdr alist)))
    1520 
    1521 (define (extension-data ext data)
    1522   (let ((value (assoc data (extension-table ext))))
    1523     (and value
    1524          (pair? (cdr value))
    1525          (cadr value))))
    1526 
    1527 (define extension-code-span (cut extension-data <> 'code-span))
    1528 (define extension-code-break (cut extension-data <> 'code-break))
    1529 (define extension-update (cut extension-data <> 'update))
    1530 (define extension-files-actions-links (cut extension-data <> 'files-actions-links))
    1531 (define extension-toc-header (cut extension-data <> 'toc-header))
    1532 
    1533 (define (run-span-extension extension text params info)
    1534   ((extension-code-span extension)
    1535 
    1536    ; TODO: This really ought to be an environment.
    1537 
    1538    (lambda (op)
    1539      (case op
    1540 
    1541        ((text) text)
    1542        ((params) params)
    1543 
    1544        ((parse)
    1545         (lambda (str)
    1546           (parse-all str
    1547                      (lambda () (error "Syntax error"))
    1548                      (global-token-info info)
    1549                      stream-null)))
    1550 
    1551        ; Function to parse some text as a paragraph.  Receives the text and an
    1552        ; optional alist with properties corresponding to parameters for
    1553        ; text-transform.
    1554 
    1555        ((parse-paragraph)
    1556         (lambda (text . rest)
    1557           (let-optionals rest ((properties '()))
    1558             (parse-all
    1559               text
    1560               (lambda () (error "bar"))
    1561               (apply
    1562                 text-transform
    1563                 info
    1564                 (map (lambda (data)
    1565                        (cadr (or (assoc (car data) properties) data)))
    1566                      '((strong #f) (em #f) (literal #f) (start #f) (newline #\newline))))
    1567               stream-null))))
    1568 
    1569        ; This used to be deprecated but it really is needed by some
    1570        ; format-dependant extensions.
    1571 
    1572        ((output-format)
    1573         (driver-output-format (wikidata-driver info)))
    1574 
    1575        ((driver)
    1576         (wikidata-driver info))
    1577 
    1578        (else ((wikidata-extension-args info) op))))))
    1579 
    1580 (define (run-break-extension extension params info)
    1581   ((extension-code-break extension)
    1582    (lambda (op)
    1583      (case op
    1584        ((params) params)
    1585        ((parse)
    1586         (lambda (str)
    1587           (parse-all str
    1588                      (lambda () (error "Syntax error"))
    1589                      (global-token-info info)
    1590                      stream-null)))
    1591 
    1592        ; Function to parse some text as a paragraph.  Receives the text and an
    1593        ; optional alist with properties corresponding to parameters for
    1594        ; text-transform.
    1595 
    1596        ((parse-paragraph)
    1597         (lambda (text . rest)
    1598           (let-optionals rest ((properties '()))
    1599             (parse-all
    1600               text
    1601               (lambda () (error "bar"))
    1602               (apply
    1603                 text-transform
    1604                 info
    1605                 (map (lambda (data)
    1606                        (cadr (or (assoc (car data) properties) data)))
    1607                      '((strong #f) (em #f) (literal #f) (start #f) (newline #\newline))))
    1608               stream-null))))
    1609 
    1610        ; Deprecated.  The reason to deprecate it is that extensions shouldn't
    1611        ; have to deal with having to recognize multiple formats ever.  They
    1612        ; should really on the drivers for format-specific things.
    1613        ;
    1614        ; Why am I committing it if it is deprecated?  Because drivers still
    1615        ; don't know about <table>, <tr>, <td> and <th>.  They ought to.  Once
    1616        ; they do, the core-extension tags.scm won't need output-format so this
    1617        ; whole thing will go away.
    1618        ;
    1619        ; Including this terribly nice comment, damn.
    1620 
    1621        ((output-format) (driver-output-format (wikidata-driver info)))
    1622 
    1623        ((driver) (wikidata-driver info))
    1624 
    1625        (else
    1626          (if (wikidata-extension-args info)
    1627            ((wikidata-extension-args info) op)
    1628            (warning "Requested environment object but environment is not defined~%" op)))))))
     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)))
    16291496
    16301497;;; TEXI driver
     
    16341501    (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null))
    16351502                         (include (lambda (name tail) tail)) (linktypes (make-hash-table))
    1636                          (extensions (make-hash-table)) (extension-args #f))
     1503                         (environment (environment ())))
    16371504     (let-values (((texi-nodes lookup-table) (texi-menu str)))
    16381505         (stream-append
     
    16411508          (->stream-char "@end menu\n")
    16421509          (wiki-parse (texi-driver lookup-table) str
    1643                       tail name open include linktypes extensions extension-args))))))
     1510                      tail name open include linktypes environment))))))
    16441511
    16451512(define (texi-page author title copyright first content . rest)
     
    17191586;; those elements, otherwise return #f
    17201587(define (stream->n-list strm n)
     1588  (error "stream->n-list has bugs and has therefore been disabled.")
    17211589  (let loop ((strm strm) (i 0) (lst (list)))
    17221590    (if (stream-null? strm)
     
    20461914       ;; anchor
    20471915       (constantly stream-null)))))
    2048 
  • release/3/stream-wiki/trunk/stream-wiki.setup

    r10471 r12533  
    1 (compile -s -O2 -d0 stream-wiki.scm)
     1;; -*- scheme -*-
    22
    3 (install-extension
    4  'stream-wiki
    5  '("stream-wiki.so" "stream-wiki.html")
    6  `((version 1.16)
    7    (documentation "stream-wiki.html")))
     3(define has-exports? (string>=? (chicken-version) "2.310"))
     4
     5(define (dynld-name fn)
     6  (make-pathname #f fn ##sys#load-dynamic-extension))   
     7
     8(compile  -O2 -d0 -s
     9         ,@(if has-exports? '(-check-imports -emit-exports stream-wiki.exports) '())
     10         stream-wiki.scm)
     11
     12(install-extension 'stream-wiki
     13                   `(,(dynld-name "stream-wiki")
     14                     ,@(if has-exports? '("stream-wiki.exports") (list)))
     15                   `((version ,(if (file-exists? "version") (with-input-from-file "version" read) "unknown"))
     16                     ,@(if has-exports? `((exports "stream-wiki.exports")) (list))
     17                     (documentation "stream-wiki.html")))
  • release/3/svnwiki-archives/trunk/svnwiki-archives.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use syntax-case svn-post-commit-hooks orders format-modular srfi-40)
    2 
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
     6(use svnwiki-extensions-support stream-ext srfi-40 html-stream svn-post-commit-hooks orders format-modular srfi-1 orders svn-client)
    327
    338(define (get-archive-path-startup env)
     
    6035            (let ((id (format #f "archive-~A" (random 9999999)))
    6136                  (link (make-link-url path-out-real (format #f "~A/xsvnwiki-archive" real-path) #f)))
    62               (when (and path-out (string=? program "post-commit"))
    63                 (assert (and 'archive-toc-links (string? path-out)))
    64                 (unless (directory? (svnwiki-make-pathname path-out "xsvnwiki-helper"))
    65                   (create-directory (svnwiki-make-pathname path-out "xsvnwiki-helper")))
    66                 (unless (directory? (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "archive"))
    67                   (create-directory (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "archive")))
    68                 (write-file-with-tmp
    69                   (svnwiki-make-pathname (list "xsvnwiki-helper" "archive") "archive")
    70                   "text/javascript"
    71                   path-out
    72                   (string->stream *archive-js-code*)))
    7337              (html-stream
    7438                ((div id id class "archive")
     
    358322      (get-props-parents-first "svnarchive:ignore" path-in (svnwiki-make-pathname path (car entry)) #f)))
    359323
    360 (define *extensions*
    361   `((archive (update ,archive-update)
    362              (code-break ,archive-toc-links))))
     324(define (archive-start-update-notify env)
     325  (let-from-environment env (path-out)
     326    (unless (directory? (svnwiki-make-pathname path-out "xsvnwiki-helper"))
     327      (create-directory (svnwiki-make-pathname path-out "xsvnwiki-helper")))
     328    (unless (directory? (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "archive"))
     329      (create-directory (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "archive")))
     330    (write-file-with-tmp
     331      (svnwiki-make-pathname (list "xsvnwiki-helper" "archive") "archive")
     332      "text/javascript"
     333      path-out
     334      (string->stream *archive-js-code*))))
     335
     336(svnwiki-extension-define 'update-notify 'archive archive-update)
     337(svnwiki-extension-define 'start-update-notify 'archive archive-start-update-notify)
     338(svnwiki-extension-define 'code-break 'archive archive-toc-links)
  • release/3/svnwiki-chicken/trunk/svnwiki-chicken.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use syntax-case svn-post-commit-hooks orders format-modular srfi-40 html-stream)
     1; $id$
     2;
     3; License: GPL-3
    24
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     5(declare (export))
     6(use svnwiki-extensions-support svn-post-commit-hooks orders format-modular srfi-40 html-stream stream-ext)
    327
    338(define *url-eggs*
     
    10176    (html-stream prefix " " text "\n")))
    10277
    103 (define *extensions*
    104   `((chickenegg (code-break ,chicken-egg-html))
    105     (procedure (code-span ,(cut chicken-def "procedure" <>)))
    106     (macro     (code-span ,(cut chicken-def "macro" <>)))
    107     (read      (code-span ,(cut chicken-def "read" <>)))
    108     (parameter (code-span ,(cut chicken-def "parameter" <>)))
    109     (record    (code-span ,(cut chicken-def "record" <>)))
    110     (string    (code-span ,(cut chicken-def "string" <>)))
    111     (class     (code-span ,(cut chicken-def "class" <>)))
    112     (method    (code-span ,(cut chicken-def "method" <>)))
    113     (examples (code-span ,chicken-examples))
    114     (expr (code-span ,chicken-expr))
    115     (result (code-span ,(cut chicken-example "=>" <>)))
    116     (input  (code-span ,(cut chicken-example "[input]" <>)))
    117     (output (code-span ,(cut chicken-example "[output]" <>)))))
     78(svnwiki-extension-define 'code-break 'chickenegg chicken-egg-html)
     79(svnwiki-extension-define 'code-span 'procedure (cut chicken-def "procedure" <>))
     80(svnwiki-extension-define 'code-span 'macro (cut chicken-def "macro" <>))
     81(svnwiki-extension-define 'code-span 'read (cut chicken-def "read" <>))
     82(svnwiki-extension-define 'code-span 'parameter (cut chicken-def "parameter" <>))
     83(svnwiki-extension-define 'code-span 'record (cut chicken-def "record" <>))
     84(svnwiki-extension-define 'code-span 'string (cut chicken-def "string" <>))
     85(svnwiki-extension-define 'code-span 'class (cut chicken-def "class" <>))
     86(svnwiki-extension-define 'code-span 'method (cut chicken-def "method" <>))
     87(svnwiki-extension-define 'code-span 'examples chicken-examples)
     88(svnwiki-extension-define 'code-span 'expr chicken-expr)
     89(svnwiki-extension-define 'code-span 'result (cut chicken-example "=>" <>))
     90(svnwiki-extension-define 'code-span 'input (cut chicken-example "[input]" <>))
     91(svnwiki-extension-define 'code-span 'output (cut chicken-example "[output]" <>))
  • release/3/svnwiki-contributor/trunk/svnwiki-contributor.scm

    • Property svn:keywords set to id
    r12412 r12533  
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
     6(use svnwiki-extensions-support srfi-40 stream-ext html-stream srfi-1)
     7
    18(define (contributor env)
    29  (let-from-environment env (user password path-in path)
     
    2128                          author)))))))))))))
    2229
    23 (set! *extensions*
    24   `((contributor (render-bottom-span ,contributor))))
     30(svnwiki-extension-define 'render-bottom-span 'contributor contributor)
  • release/3/svnwiki-discuss/trunk/svnwiki-discuss.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use syntax-case html-stream)
     1; $id$
     2;
     3; License: GPL-3
    24
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     5(declare (export))
     6(use svnwiki-extensions-support html-stream format-modular stream-ext srfi-40 posix)
    327
    338(define (discuss-counter env)
     
    5732                   (else "~I Discussion (~N)")))))))))))
    5833
    59 (set! *extensions*
    60   `((discuss-counter (render-bottom-span ,discuss-counter))))
     34(define (discuss-update-directory-accept env)
     35  (let-from-environment env (path)
     36    (and-let* ((path)
     37               (comps (string-split path "/"))
     38               ((> (length comps) 1)))
     39      (string=? "xsvnwiki-discuss" (last (butlast comps))))))
     40
     41(when "SVNWIKI_UNITTESTS"
     42  (assert (discuss-update-directory-accept (environment ((path "xsvnwiki-discuss/foo")))))
     43  (assert (discuss-update-directory-accept (environment ((path "bar/xsvnwiki-discuss/foo")))))
     44  (assert (not (discuss-update-directory-accept (environment ((path "bar/foo"))))))
     45  (assert (not (discuss-update-directory-accept (environment ((path #f)))))))
     46
     47; TODO: Figure out what we need to do here.  Maybe register links.
     48
     49(define (discuss-update-directory-meta env)
     50  (and (discuss-update-directory-accept env)
     51       (let-from-environment env (for-each-change)
     52         (for-each-change
     53           (lambda (env entry)
     54             (discuss-update-file-meta env))))))
     55
     56; TODO: estraier-update-document!
     57
     58(define (discuss-update-file-meta env)
     59  #f)
     60
     61(define *comments-separator*
     62  (html-stream (hr)))
     63
     64(define (discuss-update-directory-content env)
     65  (let-from-environment env (path-in path path-out return regenerate-page)
     66    (and-let* (((discuss-update-directory-accept env))
     67               (new-path-output (svnwiki-make-pathname #f path "text/html"))
     68               (env (environment env ((path-out-real new-path-output)))))
     69      ; Regenerate its associated page so its counters for the number of posts
     70      ; looks right.  In the future that counter should probably be loaded
     71      ; dynamically with AJAX.  However, we also need to regenerate it so that
     72      ; the emails for the discussion get sent out.
     73      (regenerate-page (svnwiki-discuss->normal path))
     74      (svnwiki-report-progress env (svnwiki-translate env "Generating discussion page for: ~A~%") path)
     75      (write-file-with-tmp path "text/html" path-out
     76        (svnwiki-render-template
     77          env
     78          "Discuss: "
     79          (stream-append
     80            (stream-concatenate
     81              (stream-intersperse
     82                (stream-map
     83                  (lambda (comment-path)
     84                    (svnwiki-report-progress env (svnwiki-translate env "Generating discussion page for: ~A (comment ~A)~%") path comment-path)
     85                    (let ((comment-path-full (svnwiki-make-pathname path comment-path)))
     86                      (stream-append
     87                        (let ((subject (get-props-parents-first "svnwiki:mail:headers:subject" path-in comment-path-full)))
     88                          (if subject
     89                            (html-stream (h2 (stream-html-escape subject)))
     90                            stream-null))
     91                        (render-file-contents
     92                          ; TODO: Maybe we need path-original or something like that to get links right?
     93                          (environment env ((path comment-path-full)))
     94                          path)
     95                        ; TODO: Show the date
     96                        (html-stream
     97                          (p ((span class "author")
     98                              (stream-html-escape (get-props-parents-first "svnwiki:mail:headers:from" path-in comment-path-full "Anonymous")))
     99                             ", "
     100                             ((span class "date")
     101                              (seconds->string
     102                                (string->number (car (string-split comment-path ":"))))))))))
     103                  (list->stream (sort (directory (svnwiki-repository-path env)) string<?)))
     104                *comments-separator*))
     105            (html-stream
     106              ((div id "post-comment")
     107               (show-edit-form env))))
     108          'view))
     109      (return #t))))
     110
     111(svnwiki-extension-define 'render-bottmon-span 'discuss-counter discuss-counter)
     112(svnwiki-extension-define 'update-directory-meta 'discuss discuss-update-directory-meta)
     113(svnwiki-extension-define 'update-directory-content 'discuss discuss-update-directory-content)
  • release/3/svnwiki-edit-question/trunk/svnwiki-edit-question.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use srfi-1)
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
     6(use svnwiki-extensions-support srfi-1 format-modular)
    27
    38(define (edit-question-arithmetic env)
     
    813      (format #f "~A" (+ num0 num1)))))
    914
    10 (set! *extensions*
    11   `((edit-question-arithmetic (edit-question ,edit-question-arithmetic))))
     15(svnwiki-extension-define 'edit-question 'edit-question-arithmetic edit-question-arithmetic)
  • release/3/svnwiki-enscript/trunk/svnwiki-enscript.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (require-extension syntax-case srfi-40 html-stream stream-ext)
     1; $id$
     2;
     3; License: GPL-3
    24
    3 (use syntax-case)
    4 
    5 (define-syntax environment
    6   (syntax-rules ()
    7     ((environment original ((name expr) ...))
    8      (lambda (op)
    9        (case op
    10          ((name) expr)
    11          ...
    12          (else (original op)))))
    13     ((environment ((name expr) ...))
    14      (environment (lambda (op)
    15                     (warning "unbound variable (dynamic environment)" op)
    16                     (if #f #f))
    17                   ((name expr) ...)))))
    18 
    19 (define-syntax environment-get
    20   (syntax-rules ()
    21     ((environment-get env sym) (env 'sym))))
    22 
    23 (define-syntax let-from-environment
    24   (syntax-rules ()
    25     ((let-from-environment env (sym ...) body ...)
    26      (let ((sym (environment-get env sym)) ...) body ...))))
    27 
    28 (define-syntax environment-capture
    29   (syntax-rules ()
    30     ((environment-capture env (sym ...))
    31      (environment env ((sym sym) ...)))
    32     ((environment-capture (sym ...))
    33      (environment ((sym sym) ...)))))
     5(declare (export))
     6(use svnwiki-extensions-support srfi-40 html-stream stream-ext)
    347
    358(define (stream-take-while-all pred str)
     
    9164        stream-null))))
    9265
    93 (define *extensions*
    94   `((enscript (code-span ,tag-enscript))))
     66(svnwiki-extension-define 'code-span 'enscript tag-enscript)
  • release/3/svnwiki-folksonomy/trunk/svnwiki-folksonomy.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (declare (run-time-macros))
    2 
    3 (use syntax-case)
    4 
    5 (define-syntax environment
    6   (syntax-rules ()
    7     ((environment original ((name expr) ...))
    8      (lambda (op)
    9        (case op
    10          ((name) expr)
    11          ...
    12          (else (original op)))))
    13     ((environment ((name expr) ...))
    14      (environment (lambda (op)
    15                     (warning "unbound variable (dynamic environment)" op)
    16                     (if #f #f))
    17                   ((name expr) ...)))))
    18 
    19 (define-syntax environment-get
    20   (syntax-rules ()
    21     ((environment-get env sym) (env 'sym))))
    22 
    23 (define-syntax let-from-environment
    24   (syntax-rules ()
    25     ((let-from-environment env (sym ...) body ...)
    26      (let ((sym (environment-get env sym)) ...) body ...))))
    27 
    28 (define-syntax environment-capture
    29   (syntax-rules ()
    30     ((environment-capture env (sym ...))
    31      (environment env ((sym sym) ...)))
    32     ((environment-capture (sym ...))
    33      (environment ((sym sym) ...)))))
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
     6(use svnwiki-extensions-support html-stream srfi-40 stream-ext format-modular)
    347
    358(define (show-tags-related env)
     
    293266)
    294267
    295 (define *extensions*
    296   `((folksonomy (render-bottom-div ,show-tags-related))))
     268(svnwiki-extension-define 'render-bottom-div 'folksonomy show-tags-related)
  • release/3/svnwiki-image/trunk/svnwiki-image.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (require-extension syntax-case svn-post-commit-hooks orders format-modular html-stream)
    2 
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
     6(use svnwiki-extensions-support srfi-40 stream-ext srfi-1 svn-post-commit-hooks orders format-modular html-stream)
    327
    338(define *image-javascript*
     
    9368EOF
    9469)
    95 
    96 (define (svnwiki-image-create-helper env)
    97   (let-from-environment env (path-out program)
    98     (when (and path-out (string=? program "post-commit"))
    99       (assert (and 'svnwiki-image-create-helper (string? path-out)))
    100       (unless (directory? (svnwiki-make-pathname path-out "xsvnwiki-helper"))
    101         (create-directory (svnwiki-make-pathname path-out "xsvnwiki-helper")))
    102       (unless (directory? (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "image"))
    103         (create-directory (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "image")))
    104       (write-file-with-tmp
    105         (svnwiki-make-pathname (list "xsvnwiki-helper" "image") "image")
    106         "text/javascript"
    107         path-out
    108         (string->stream
    109           *image-javascript*)))))
    11070
    11171(define (svnwiki-image-show-sizes-link env random-id)
     
    13292  (let-from-environment env (initial-header-depth path-in path static-url)
    13393    (svnwiki-report-progress env "Image generate HTML: ~A~%" path)
    134     (svnwiki-image-create-helper env)
    13594    (let ((random-id (random 100000)))
    13695      (html-stream
     
    202161  '("png"
    203162    "jpeg"))
     163
     164(define (svnwiki-image-start-update-notify env)
     165  (let-from-environment env (path-out)
     166    (assert (and 'svnwiki-image-start-update-notify (string? path-out)))
     167    (unless (directory? (svnwiki-make-pathname path-out "xsvnwiki-helper"))
     168      (create-directory (svnwiki-make-pathname path-out "xsvnwiki-helper")))
     169    (unless (directory? (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "image"))
     170      (create-directory (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "image")))
     171    (write-file-with-tmp
     172      (svnwiki-make-pathname (list "xsvnwiki-helper" "image") "image")
     173      "text/javascript"
     174      path-out
     175      (string->stream
     176        *image-javascript*))))
    204177
    205178(define (svnwiki-image-update env)
     
    273246                ((a href link title title) title))))))))))
    274247
    275 (define *extensions*
    276   `((image (render-file-contents ,svnwiki-image-handler-render)
    277            (update ,svnwiki-image-update)
    278            (code-break ,svnwiki-image-code-break))))
     248(svnwiki-extension-define 'render-file-contents 'image svnwiki-image-handler-render)
     249(svnwiki-extension-define 'update-notify 'image svnwiki-image-update)
     250(svnwiki-extension-define 'start-update-notify 'image svnwiki-image-start-update-notify)
     251(svnwiki-extension-define 'code-break 'image svnwiki-image-code-break)
  • release/3/svnwiki-links/trunk/svnwiki-links.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use html-stream)
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
     6(use svnwiki-extensions-support srfi-40 html-stream stream-ext srfi-1)
    27
    38(define (link-digg-it env)
     
    6772              links)))))))
    6873
    69 (set! *extensions*
    70   `((digg   (files-actions-links ,link-digg-it))
    71     (sociallinks (render-bottom-span ,svnwiki-social-links))
    72     (reddit (files-actions-links ,link-reddit))))
     74(svnwiki-extension-define 'files-actions-links 'digg link-digg-it)
     75(svnwiki-extension-define 'files-actions-links 'reddit link-reddit)
     76(svnwiki-extension-define 'render-bottom-span 'sociallinks svnwiki-social-links)
  • release/3/svnwiki-math/trunk/svnwiki-math.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use syntax-case)
     1; $id$
     2;
     3; License: GPL-3
    24
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
     5(declare (export))
     6(use svnwiki-extensions-support stream-wiki)
    167
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
    32 
    33 (define *extensions*
    34   `((math (code-span ,(lambda (env)
    35                         (let-from-environment env (text driver)
    36                           ((driver-math driver) text)))))))
     8(svnwiki-extension-define 'code-span 'math
     9  (lambda (env)
     10    (let-from-environment env (text driver)
     11      ((driver-math driver) text))))
  • release/3/svnwiki-nowiki/trunk/svnwiki-nowiki.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use syntax-case)
     1; $id$
     2;
     3; License: GPL-3
    24
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     5(declare (export))
     6(use svnwiki-extensions-support)
    327
    338(define (tag-nowiki env)
     
    3510    text))
    3611
    37 (define *extensions*
    38   `((nowiki (code-span ,tag-nowiki))))
     12(svnwiki-extension-define 'code-span 'nowiki tag-nowiki)
  • release/3/svnwiki-progress/trunk/svnwiki-progress.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use html-stream stream-ext srfi-40)
    2 
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
     6(use svnwiki-extensions-support srfi-40 html-stream stream-ext srfi-1)
    327
    338(define *progress-js-code*
     
    192167  if (!svnwikiProgress.loading) {
    193168    svnwikiProgress.redirectTime = 5;
    194     var report = document.getElementById('progress-commit-message');
     169    var report = document.getElementById('commit-results');
    195170    if (report) {
    196171      svnwikiProgress.cleanContent(report);
     
    216191svnwikiProgress.checkProgress = function ( )
    217192{
    218   svnwikiProgress.loadXml('?action=progress', svnwikiProgress.registerProgress);
     193  svnwikiProgress.loadXml('?action=extension&extension=progress&format=xml', svnwikiProgress.registerProgress);
    219194}
    220195
     
    238213          *progress-js-code*)))))
    239214
     215(define (show-progress-xml env)
     216  (let-from-environment env (path-out)
     217    (->stream-char
     218      "Content-type: application/xml\n\n"
     219      (port->stream
     220        (open-input-file
     221          (svnwiki-make-pathname (list path-out "xsvnwiki-helper") "progress-report" "xml"))))))
     222
    240223(define (progress-commit-dynamic env)
    241   (->stream-char
    242     "Content-type: text/html\n\n"
    243     (html-stream
    244       (html
    245         (body
    246           (progress-commit-code (environment env ((commit-rev -1)))))))))
     224  (let-from-environment env (user-input)
     225    (case (stream->symbol (user-input 'format stream-null))
     226      ((xml) (show-progress-xml env))
     227      (else
     228        (->stream-char
     229          "Content-type: text/html\n\n"
     230          (html-stream
     231            (html
     232              (body
     233                (progress-commit-code (environment env ((commit-rev -1))))))))))))
    247234
    248235(define (progress-commit-code env)
     
    258245
    259246(define (progress-commit-confirmation env)
    260   (let-from-environment env (path)
    261     (svnwiki-render-commit-confirmation
    262       env
    263       (html-stream
    264         ((div id "progress-commit-message")
    265          (p (b "Your changes have been saved."))
    266          (p "The wiki system is preparing to display your changes.  While waiting, you could:")
    267          (ul
    268            (li ((a href (last (string-split (environment-get env path) "/"))) "Go to the " (b "currently published revision") " of the file") " (which probably won't reflect your changes yet).")
    269            (li ((a href (format #f "~A?action=edit" (last (string-split path "/")))) "Go back to the " (b "edit form") " and continue making changes") ".")))
    270         (progress-commit-code env)))))
    271 
    272 (set! *extensions*
    273   `((progress (commit-confirmation ,progress-commit-confirmation)
    274               (update ,progress-code-write)
    275               (dynamic ,progress-commit-dynamic))))
     247  (svnwiki-commit-handler-info
     248    env
     249    (progress-commit-code env)))
     250
     251(svnwiki-extension-define 'commit-handler 'progress progress-commit-confirmation)
     252(svnwiki-extension-define 'start-update-notify 'progress progress-code-write)
     253(svnwiki-extension-define 'dynamic 'progress progress-commit-dynamic)
  • release/3/svnwiki-rating/trunk/svnwiki-rating.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use html-stream stream-ext srfi-40 format-modular)
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
     6(use svnwiki-extensions-support srfi-40 html-stream stream-ext format-modular orders srfi-1 svn-client svn-post-commit-hooks)
    27
    38(define (create-rating-helper env)
     
    214219
    215220(define (rating-update env)
    216   (create-rating-helper env)
    217221  (let-from-environment env (path-out path-in base path user password old-rev)
    218222    (let* ((entry (post-commit-changed-files
     
    378382        (rating-produce-xml env)))))
    379383
    380 (set! *extensions*
    381   `((rating
    382       (render-bottom-span ,rating-render-bottom-span)
    383       (dynamic ,rating-dynamic)
    384       (update ,rating-update))))
     384(svnwiki-extension-define 'render-bottom-span 'rating rating-render-bottom-span)
     385(svnwiki-extension-define 'dynamic 'rating rating-dynamic)
     386(svnwiki-extension-define 'update-notify 'rating rating-update)
     387(svnwiki-extension-define 'start-update-notify 'rating create-rating-helper)
  • release/3/svnwiki-scheme/trunk/svnwiki-scheme.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use syntax-case)
     1; $id$
     2;
     3; License: GPL-3
    24
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     5(declare (export))
     6(use svnwiki-extensions-support sandbox format-modular stream-ext)
    327
    338(define (tag-scheme env)
     
    4924                  (loop (read)))))))))))
    5025
    51 (set! *extensions*
    52   `((scheme (code-span ,tag-scheme))))
     26(svnwiki-extension-define 'code-span 'scheme tag-scheme)
  • release/3/svnwiki-tags/trunk/svnwiki-tags.scm

    • Property svn:keywords set to id
    r12412 r12533  
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
    16; This extension implements support for basic tags.
    27;
    38; See *extensions* at the end for a list of all them.
    49
    5 (require-extension syntax-case stream-ext html-stream format-modular)
     10(use svnwiki-extensions-support srfi-40 stream-ext html-stream format-modular stream-wiki)
    611
    7 (define-syntax environment
    8   (syntax-rules ()
    9     ((environment original ((name expr) ...))
    10      (lambda (op)
    11        (case op
    12          ((name) expr)
    13          ...
    14          (else (original op)))))
    15     ((environment ((name expr) ...))
    16      (environment (lambda (op)
    17                     (warning "unbound variable (dynamic environment)" op)
    18                     (if #f #f))
    19                   ((name expr) ...)))))
     12(define (driver-func func)
     13  (lambda (env)
     14    (let-from-environment env (driver)
     15      ((func driver)))))
    2016
    21 (define-syntax environment-get
    22   (syntax-rules ()
    23     ((environment-get env sym) (env 'sym))))
     17(svnwiki-extension-define 'code-break 'br (driver-func driver-line-break))
     18(svnwiki-extension-define 'code-break 'hr (driver-func driver-horizontal-line))
    2419
    25 (define-syntax let-from-environment
    26   (syntax-rules ()
    27     ((let-from-environment env (sym ...) body ...)
    28      (let ((sym (environment-get env sym)) ...) body ...))))
     20(define (tag-parse-recursively-paragraph driver-function props env)
     21  (let-from-environment env (driver parse-paragraph text)
     22    ((driver-function driver)
     23     (parse-paragraph text props))))
    2924
    30 (define-syntax environment-capture
    31   (syntax-rules ()
    32     ((environment-capture env (sym ...))
    33      (environment env ((sym sym) ...)))
    34     ((environment-capture (sym ...))
    35      (environment ((sym sym) ...)))))
     25(define (tag-parse-recursively driver-function env)
     26  (let-from-environment env (driver parse text)
     27    ((driver-function driver)
     28     (parse text))))
     29
     30(svnwiki-extension-define 'code-span 'pre
     31  (cut tag-parse-recursively-paragraph driver-literal '((literal #t)) <>))
     32
     33(svnwiki-extension-define 'code-span 'tt
     34  (cut tag-parse-recursively-paragraph driver-literal-line '((literal #t)) <>))
     35
     36(svnwiki-extension-define 'code-span 'code
     37  (cut tag-parse-recursively-paragraph driver-literal-line '((literal #t)) <>))
     38
     39(svnwiki-extension-define 'code-span 'strong
     40  (cut tag-parse-recursively-paragraph driver-strong '((strong #t)) <>))
     41
     42(svnwiki-extension-define 'code-span 'em
     43  (cut tag-parse-recursively-paragraph driver-em '((em #t)) <>))
     44
     45(svnwiki-extension-define 'code-span 'blockquote
     46  (cut tag-parse-recursively driver-blockquote <>))
     47
     48(svnwiki-extension-define 'code-span 'center
     49  (cut tag-parse-recursively driver-center <>))
     50
     51(svnwiki-extension-define 'code-span 'small
     52  (cut tag-parse-recursively driver-small <>))
     53
     54(svnwiki-extension-define 'code-span 'big
     55  (cut tag-parse-recursively driver-big <>))
     56
     57(svnwiki-extension-define 'code-span 'strike
     58  (cut tag-parse-recursively driver-strike <>))
     59
     60(define (tag-parse-recursively-header depth env)
     61  (let-from-environment env (driver parse-paragraph text)
     62    ((driver-header driver) (parse-paragraph text '()) depth text)))
     63
     64(svnwiki-extension-define 'code-span 'h1
     65  (cut tag-parse-recursively-header 1 <>))
     66(svnwiki-extension-define 'code-span 'h2
     67  (cut tag-parse-recursively-header 1 <>))
     68(svnwiki-extension-define 'code-span 'h3
     69  (cut tag-parse-recursively-header 1 <>))
     70(svnwiki-extension-define 'code-span 'h4
     71  (cut tag-parse-recursively-header 1 <>))
     72(svnwiki-extension-define 'code-span 'h5
     73  (cut tag-parse-recursively-header 1 <>))
     74(svnwiki-extension-define 'code-span 'h6
     75  (cut tag-parse-recursively-header 1 <>))
     76
     77(define (tag-a-break env)
     78  (tag-a-span (environment env ((text stream-null)))))
     79
     80(define (tag-a-span env)
     81  (let-from-environment env (params text parse-paragraph driver)
     82    (let ((path-param (assoc 'name params)))
     83      ((if path-param
     84         (cut (driver-anchor driver) (cdr path-param) <...>)
     85         identity)
     86       (parse-paragraph text '())))))
     87
     88(svnwiki-extension-define 'code-break 'a tag-a-break)
     89(svnwiki-extension-define 'code-span 'a tag-a-span)
    3690
    3791; Deprecated:
     
    4195
    4296; Deprecated:
    43 (define (tag-span-case name latex texi odf)
    44   `(,name
    45      (code-span
    46        ,(lambda (env)
    47           (let-from-environment env (output-format)
    48             ((case output-format
    49                ((html) html-tag)
    50                ((latex) latex)
    51                ((odf) odf)
    52                ((texi) texi))
    53              name
    54              env))))))
     97(define (tag-span-output-case name latex texi odf)
     98  (lambda (env)
     99    (let-from-environment env (output-format)
     100      ((case output-format
     101         ((html) html-tag)
     102         ((latex) latex)
     103         ((odf) odf)
     104         ((texi) texi))
     105       name
     106       env))))
    55107
    56108; Deprecated:
     
    64116    (stream #\>)))
    65117
    66 (define (tag-span-driver name func)
    67   `(,name (code-span ,func)))
    68 
    69 (define (tag-break-driver name func)
    70   `(,name (code-break
    71             ,(lambda (env)
    72                (let-from-environment env (driver)
    73                  ((func driver)))))))
    74 
    75 (define (tag-parse-recursively driver-function env)
    76   (let-from-environment env (driver parse text)
    77     ((driver-function driver)
    78      (parse text))))
    79 
    80 (define (tag-parse-recursively-paragraph driver-function props env)
    81   (let-from-environment env (driver parse-paragraph text)
    82     ((driver-function driver)
    83      (parse-paragraph text props))))
    84 
    85 (define (tag-parse-recursively-header depth env)
    86   (let-from-environment env (driver parse-paragraph text)
    87     ((driver-header driver) (parse-paragraph text '()) depth text)))
    88 
    89 (define (tag-a-break env)
    90   (format (current-error-port) "Call break~%")
    91   (tag-a-span (environment env ((text stream-null)))))
    92 
    93 (define (tag-a-span env)
    94   (format (current-error-port) "Call span~%")
    95   (let-from-environment env (params text parse-paragraph driver)
    96     (let ((path-param (assoc 'name params)))
    97       ((if path-param
    98          (cut (driver-anchor driver) (cdr path-param) <...>)
    99          identity)
    100        (parse-paragraph text '())))))
    101 
    102 (define *extensions*
    103   (list
    104 
    105     (tag-span-driver 'pre
    106       (cut tag-parse-recursively-paragraph driver-literal '((literal #t)) <>))
    107 
    108     (tag-span-driver 'tt
    109       (cut tag-parse-recursively-paragraph driver-literal-line '((literal #t)) <>))
    110 
    111     (tag-span-driver 'code
    112       (cut tag-parse-recursively-paragraph driver-literal-line '((literal #t)) <>))
    113 
    114     (tag-span-driver 'strong
    115       (cut tag-parse-recursively-paragraph driver-strong '((strong #t)) <>))
    116 
    117     (tag-span-driver 'em
    118       (cut tag-parse-recursively-paragraph driver-em '((em #t)) <>))
    119 
    120     (tag-span-driver 'blockquote
    121       (cut tag-parse-recursively driver-blockquote <>))
    122 
    123     (tag-span-driver 'center
    124       (cut tag-parse-recursively driver-center <>))
    125 
    126     (tag-span-driver 'small
    127       (cut tag-parse-recursively driver-small <>))
    128 
    129     (tag-span-driver 'big
    130       (cut tag-parse-recursively driver-big <>))
    131 
    132     (tag-span-driver 'strike
    133       (cut tag-parse-recursively driver-strike <>))
    134 
    135     (tag-span-driver 'h1
    136       (cut tag-parse-recursively-header 1 <>))
    137     (tag-span-driver 'h2
    138       (cut tag-parse-recursively-header 1 <>))
    139     (tag-span-driver 'h3
    140       (cut tag-parse-recursively-header 1 <>))
    141     (tag-span-driver 'h4
    142       (cut tag-parse-recursively-header 1 <>))
    143     (tag-span-driver 'h5
    144       (cut tag-parse-recursively-header 1 <>))
    145     (tag-span-driver 'h6
    146       (cut tag-parse-recursively-header 1 <>))
    147 
    148     `(a (code-break ,tag-a-break)
    149         (code-span ,tag-a-span))
    150 
    151     (tag-break-driver 'br driver-line-break)
    152     (tag-break-driver 'hr driver-horizontal-line)
    153 
    154     (tag-span-case 'table unsupported unsupported unsupported)
    155     (tag-span-case 'tr unsupported unsupported unsupported)
    156     (tag-span-case 'td unsupported unsupported unsupported)
    157     (tag-span-case 'th unsupported unsupported unsupported)))
     118(svnwiki-extension-define 'code-span 'table (tag-span-output-case 'table unsupported unsupported unsupported))
     119(svnwiki-extension-define 'code-span 'tr    (tag-span-output-case 'tr    unsupported unsupported unsupported))
     120(svnwiki-extension-define 'code-span 'td    (tag-span-output-case 'td    unsupported unsupported unsupported))
     121(svnwiki-extension-define 'code-span 'th    (tag-span-output-case 'th    unsupported unsupported unsupported))
  • release/3/svnwiki-translations/trunk/svnwiki-translations.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use syntax-case orders format-modular srfi-40 html-stream)
     1; $id$
     2;
     3; License: GPL-3
    24
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     5(declare (export))
     6(use svnwiki-extensions-support iconv stream-ext srfi-1 srfi-40 orders format-modular html-stream posix)
    327
    338(define *languages*
     
    9166                translations))))))))
    9267
    93 (define *extensions*
    94   `((translations (code-break ,translations-links))))
     68(svnwiki-extension-define 'code-break 'translations translations-links)
  • release/3/svnwiki-upload/trunk/svnwiki-upload.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (use srfi-1)
     1; $id$
     2;
     3; License: GPL-3
    24
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     5(declare (export))
     6(use svnwiki-extensions-support svn-client posix srfi-40 stream-ext html-stream srfi-1 iconv)
    327
    338(define (svnwiki-upload-with-dir env func)
     
    200175        "Upload"))))
    201176
    202 (set! *extensions*
    203   `((upload (dynamic ,svnwiki-upload-dynamic)
    204             (files-actions-links ,svnwiki-upload-action-link))))
     177(svnwiki-extension-define 'dynamic 'upload svnwiki-upload-dynamic)
     178(svnwiki-extension-define 'files-actions-links 'upload svnwiki-upload-action-link)
  • release/3/svnwiki-weblog/trunk/svnwiki-weblog.scm

    • Property svn:keywords set to id
    r12412 r12533  
    1 (require-extension syntax-case svn-post-commit-hooks orders format-modular html-stream)
    2 
    3 (define-syntax environment
    4   (syntax-rules ()
    5     ((environment original ((name expr) ...))
    6      (lambda (op)
    7        (case op
    8          ((name) expr)
    9          ...
    10          (else (original op)))))
    11     ((environment ((name expr) ...))
    12      (environment (lambda (op)
    13                     (warning "unbound variable (dynamic environment)" op)
    14                     (if #f #f))
    15                   ((name expr) ...)))))
    16 
    17 (define-syntax environment-get
    18   (syntax-rules ()
    19     ((environment-get env sym) (env 'sym))))
    20 
    21 (define-syntax let-from-environment
    22   (syntax-rules ()
    23     ((let-from-environment env (sym ...) body ...)
    24      (let ((sym (environment-get env sym)) ...) body ...))))
    25 
    26 (define-syntax environment-capture
    27   (syntax-rules ()
    28     ((environment-capture env (sym ...))
    29      (environment env ((sym sym) ...)))
    30     ((environment-capture (sym ...))
    31      (environment ((sym sym) ...)))))
     1; $id$
     2;
     3; License: GPL-3
     4
     5(declare (export))
     6(use svnwiki-extensions-support srfi-40 svn-post-commit-hooks orders format-modular html-stream srfi-1 stream-ext svn-client)
    327
    338(define (weblog-update env)
     
    303278        stream-null))))
    304279   
    305 
    306 (define *extensions*
    307   `((weblog (update ,weblog-update))
    308     (weblogabout (code-break ,weblog-about))
    309     (weblogcontent (code-break ,weblog-content-posts))))
     280(svnwiki-extension-define 'update-notify 'weblog weblog-update)
     281(svnwiki-extension-define 'code-break 'weblogabout weblog-about)
     282(svnwiki-extension-define 'code-break 'weblogcontent weblog-content-posts)
Note: See TracChangeset for help on using the changeset viewer.