Changeset 21337 in project


Ignore:
Timestamp:
11/08/10 13:39:31 (11 years ago)
Author:
Moritz Heidkamp
Message:

hyde: add link-shortcuts and improve error formatting a bit

File:
1 edited

Legend:

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

    r20904 r21337  
    2121 compile-pages
    2222 uri-path-prefix
    23  markdown-program)
     23 markdown-program
     24 link-shortcuts)
    2425
    2526(import chicken scheme files data-structures extras srfi-1 ports srfi-13 utils)
     
    7374(define uri-path-prefix (make-parameter ""))
    7475(define markdown-program (make-parameter "markdown"))
     76(define link-shortcuts (make-parameter '()))
    7577
    7678(define translators (make-parameter '()))
     
    144146(define (print-error error)
    145147  (with-output-to-port (current-error-port)
    146     (cut print error)))
     148    (cut print "ERROR: " error)))
    147149
    148150(define (die error exit-code)
     
    158160      (begin
    159161        (print-error "no hyde.scm found")
    160         (and die-when-missing? (exit 1)))))
     162       
     163        (if die-when-missing?
     164            (exit 1)
     165            (begin (newline) #f)))))
    161166
    162167(define (create-directory-verbose name)
     
    425430                   (translators)))
    426431
     432(define +shortcut-link+
     433  (irregex `(seq (submatch (+ (~ #\:))) #\: (submatch (+ any)))))
     434
     435(define (shortcut->link-tag tag attrs)
     436  (let* ((m (irregex-match +shortcut-link+ (car attrs)))
     437         (uri (cond ((and m (irregex-match-substring m 1)) =>
     438                     (lambda (alias)
     439                       (let ((uri (alist-ref (string->symbol alias)
     440                                             (link-shortcuts))))
     441                         (if uri
     442                             (string-append uri (irregex-match-substring m 2))
     443                             (error 'shortcut->link-tag
     444                                    (format "invalid alias: ~S" alias))))))
     445                    (else (car attrs)))))
     446                                                     
     447    (list (if (absolute-uri? (uri-reference uri))
     448              'link
     449              'int-link)
     450          uri
     451          (cdr attrs))))
     452
    427453(define (translate/svnwiki)
    428454  (let* ((doc (svnwiki->sxml (current-input-port)))
     455         (doc (pre-post-order* doc `((int-link . ,shortcut->link-tag)
     456                                     ,@alist-conv-rules*)))
    429457         (rules (multidoc-html-transformation-rules doc))
    430458         (rules (append (butlast rules)
Note: See TracChangeset for help on using the changeset viewer.