Commits

Anonymous committed 1393a02

Initial import

  • Participants

Comments (0)

Files changed (7)

+.svn
+*.so
+*.o
+*.import.*
+hyde
+tests

File hyde-atom.scm

+(module hyde-atom (translate/atom)
+
+(import chicken scheme)
+(use hyde atom rfc3339 posix extras srfi-1)
+
+(define $ (environment-ref (page-eval-env) '$))
+(define page-path (environment-ref (page-eval-env) 'page-path))
+(define read-page (environment-ref (page-eval-env) 'read-page))
+
+(define (maybe-authors->atom-authors authors)
+  (if authors
+      (map (lambda (author)
+             (make-author name: author))
+           authors)
+      '()))
+
+(define (pages->atom-doc pages #!key
+                         (page-title (lambda (page) ($ 'title page))) 
+                         (page-date (lambda (page)
+                                      (or ($ 'updated page) ($ 'date page))))
+                         (page-type (lambda (page)
+                                      ($ 'type page)))
+                         (page-authors (lambda (page)
+                                         ($ 'authors page)))
+                         (page-date->rfc3339-string (lambda (x) x))
+                         (page->atom-content (lambda (page)
+                                               (make-content (read-page page) type: 'html))))
+
+  (unless (and ($ 'tag) ($ 'base-uri) ($ 'date))
+    (error "An atom page requires at least these page-vars to be defined"
+           '(tag base-uri date)))
+
+  (let* ((rfc3339-string->seconds 
+          (lambda (date)
+            (rfc3339->seconds (string->rfc3339 date))))
+         (page-date->seconds
+          (lambda (date)
+            (rfc3339-string->seconds (page-date->rfc3339-string date))))
+         (rfc3339-string->YYYY-MM-DD 
+          (lambda (date)
+            (time->string (seconds->utc-time (rfc3339-string->seconds date)) 
+                          "%Y-%m-%d")))
+         (page-date->YYYY-MM-DD
+          (lambda (date)
+            (rfc3339-string->YYYY-MM-DD (page-date->rfc3339-string date))))
+         (feed-authors (maybe-authors->atom-authors ($ 'authors))))
+    (make-atom-doc
+     (make-feed
+      title: (make-title ($ 'title))
+      subtitle: (make-subtitle ($ 'subtitle))
+      icon: (and ($ 'icon) (make-icon (string-append ($ 'base-uri) ($ 'icon))))
+      logo: (and ($ 'logo) (make-logo (string-append ($ 'base-uri) ($ 'logo))))
+      authors: feed-authors
+      updated: (rfc3339->string
+                (seconds->rfc3339
+                 (fold (lambda (p c)
+                         (let ((p (page-date->seconds (page-date p))))
+                           (if (and c (> c p)) c p)))
+                       #f
+                       pages)))
+      id: (format ($ 'tag) ($ 'date) "/")
+      links: (list (make-link uri: (string-append ($ 'base-uri) (or ($ 'root-path) "/"))
+                              relation: "alternate"
+                              type: 'html)
+                   (make-link uri: (string-append ($ 'base-uri) (page-path))
+                              relation: "self"
+                              type: 'atom))
+      entries: (map (lambda (p)
+                      (make-entry title: (make-title (page-title p))
+                                  published: (page-date->rfc3339-string (page-date p))
+                                  updated: (page-date->rfc3339-string (page-date p))
+                                  id: (format ($ 'tag) 
+                                              (page-date->YYYY-MM-DD (page-date p))
+                                              (page-path p))
+                                  links: (list (make-link uri: (string-append ($ 'base-uri) (page-path p)) 
+                                                          type: (or (page-type p) ($ 'entries-type))))
+                                  authors: (let ((authors (maybe-authors->atom-authors (page-authors p))))
+                                             ;; we include the feed authors for every entry in case there are 
+                                             ;; none for this entry specifically since feed readers tend to ignore
+                                             ;; feed-wide authors
+                                             (if (null? authors) feed-authors authors))
+                                  content: (page->atom-content p)))
+                    pages)))))
+
+(define (translate/atom)
+  (let ((env (page-eval-env)))
+    (for-each (lambda (binding)
+		(environment-set! env (car binding) (cadr binding)))
+	      `((make-atom-doc ,make-atom-doc) (make-author ,make-author) (make-category ,make-category)
+		(make-content ,make-content) (make-contributor ,make-contributor) (make-entry ,make-entry)
+		(make-feed ,make-feed) (make-generator ,make-generator) (make-icon ,make-icon)
+		(make-link ,make-link) (make-logo ,make-logo) (make-rights ,make-rights)
+		(make-source ,make-source) (make-subtitle ,make-subtitle) (make-summary ,make-summary)
+		(make-title ,make-title) (make-rfc3339 ,make-rfc3339) (rfc3339->string ,rfc3339->string)
+		(seconds->rfc3339 ,seconds->rfc3339) (utc-time->rfc3339 ,utc-time->rfc3339)
+		(time->rfc3339 ,time->rfc3339) (pages->atom-doc ,pages->atom-doc)))
+
+    (write-atom-doc (environment-eval (read) env))))
+
+(translators (cons (list "atom" translate/atom '(ext . atom) '(layouts))
+		   (translators)))
+
+)

File hyde-cmd.scm

+#!/usr/bin/csi -ns
+
+(use chicken-syntax hyde matchable)
+
+(define usage #<<END
+Hyde - A static website compiler
+
+Usage: hyde <options> <command>
+
+Options:
+
+-e ENV
+    The environment to execute the command in (default is "default")
+
+Commands are:
+
+hyde init
+    Initializes a site in the current directory.
+
+hyde new <page-type> [<title> ...]
+    Creates a new page with the given page type and title. The page's
+    filename will be inferred from the given title by downcasing it and
+    replacing spaces with dashes.
+
+hyde serve
+    Serves the current site with spiffy, (re-)compiling the site on
+    each request (useful for development).
+
+hyde build [<prefix> ...]
+    Builds the current site. If prefixes are given then only paths having
+    those prefixes will be built
+
+hyde
+    Compiles the current site.
+END
+)
+
+(define args (command-line-arguments))
+
+(when (and (> (length args) 1)
+           (string=? "-e" (car args)))
+
+  (hyde-environment (string->symbol (cadr args)))
+  (set! args (cddr (command-line-arguments))))
+
+(define (maybe-compile-pages #!optional (prefixes '()))
+  (if (load-hyde-file #f)
+      (compile-pages prefixes)
+      (print usage)))
+
+(match args
+  (("init")
+   (initialize-site))
+  (("new" ext . title)
+   (load-hyde-file)
+   (generate-page ext title))
+  (("serve")
+   (load-hyde-file)
+   (serve))
+  (("build" prefixes ...)
+   (maybe-compile-pages prefixes))
+  (() (maybe-compile-pages))
+  (((or "help" "-help" "--help" "usage" "-usage" "--usage"))
+   (print usage))
+  ((command _ ...)
+   (with-output-to-port (current-error-port)
+     (lambda ()
+       (print (format "Unknown command '~a'~%" command))))
+   (print usage)
+   (exit 1)))

File hyde-page-eval-env.scm

+(module hyde-page-eval-env
+
+(make-page-eval-env
+ environment-set!
+ environment-extend!
+ environment-ref
+ environment-copy
+ environment-eval
+ current-page-eval-env)
+
+(import chicken scheme)
+(use srfi-69)
+
+(define-record-type page-eval-env
+  (%make-page-eval-env bindings)
+  page-eval-env?
+  (bindings page-eval-env-bindings page-eval-env-bindings-set!))
+
+(define (make-page-eval-env)
+  (%make-page-eval-env (make-hash-table)))
+
+(define (environment-set! env name val)
+  (hash-table-set! (page-eval-env-bindings env) name val))
+
+(define environment-extend! environment-set!)
+
+(define not-found (list))
+
+(define (environment-ref env name)
+  (let ((val (hash-table-ref/default (page-eval-env-bindings env) name not-found)))
+    (if (eq? not-found val)
+        (error "Undefined page-eval-env binding" name)
+        val)))
+
+(define (environment-copy env)
+  (%make-page-eval-env (hash-table-copy (page-eval-env-bindings env))))
+
+(define current-page-eval-env
+  (make-parameter #f))
+
+(define (environment-eval exp env)
+  (parameterize ((current-page-eval-env env))
+    (eval
+     (list '##core#let
+           (hash-table-map
+            (page-eval-env-bindings env)
+            (lambda (name val)
+              (list name
+                    `(hyde-page-eval-env#environment-ref
+                      (hyde-page-eval-env#current-page-eval-env)
+                      ',name))))
+           exp))))
+
+)
+((egg "hyde.egg")
+ (synopsis "A static website compiler")
+ (author "Moritz Heidkamp")
+ (category web)
+ (license "BSD")
+ (doc-from-wiki)
+ (needs filepath sxml-transforms doctype matchable (scss 0.3) (spiffy 4.9) colorize intarweb (uri-common 1.2) svnwiki-sxml defstruct multidoc atom rfc3339))
+(module hyde
+
+(load-hyde-file
+ hyde-environment
+ hyde-environments
+ define-hyde-environment
+ initialize-site
+ generate-page
+ pathify
+ make-external-translator
+ serve
+ source-dir
+ output-dir
+ layouts-dir
+ default-layouts
+ clean-before-build
+ excluded-paths
+ default-extension
+ default-page-vars
+ page-eval-env
+ translators
+ compile-pages
+ uri-path-prefix
+ markdown-program
+ link-shortcuts
+ sxml-conversion-rules
+ ignore-page?)
+
+(import chicken scheme)
+(require-extension regex)
+(import irregex)
+
+(use files
+     data-structures
+     extras
+     srfi-1
+     ports
+     srfi-13
+     utils
+     posix
+     (rename filepath (filepath:make-relative pathname-relative-from))
+     sxml-transforms
+     doctype
+     matchable
+     scss
+     spiffy
+     srfi-18
+     colorize
+     intarweb
+     uri-common
+     svnwiki-sxml
+     defstruct
+     (rename multidoc (html-transformation-rules
+                       multidoc-html-transformation-rules)))
+
+(use hyde-page-eval-env)
+(reexport (except hyde-page-eval-env current-page-eval-env))
+
+(defstruct page source-path path (vars '()) reader writer type)
+
+(define (with-page page proc #!optional (key page))
+  (cond ((page? page) (parameterize ((current-page page)) (proc page)))
+	((string? page) (with-page (alist-ref page (pages) string=?) proc page))
+	(else (die (conc "unknown page: " key) 3))))
+
+(define (write-page page)
+  ((with-page page page-writer)))
+
+(define (read-page page #!rest layouts)
+  (with-page page
+             (lambda (page)
+               (parameterize ((current-page page))
+                 (wrap-with-layouts ((with-page page page-reader)) layouts)))))
+
+(define hyde-environment (make-parameter 'default))
+(define hyde-environments (make-parameter '(default)))
+(define source-dir (make-parameter "src"))
+(define output-dir (make-parameter "out"))
+(define layouts-dir (make-parameter "layouts"))
+(define default-layouts (make-parameter '("default.sxml")))
+(define clean-before-build (make-parameter #t))
+(define excluded-paths (make-parameter (list (irregex '(seq "~" eos)))))
+(define default-extension (make-parameter "html"))
+(define default-page-vars (make-parameter '()))
+(define uri-path-prefix (make-parameter ""))
+(define markdown-program (make-parameter "markdown"))
+(define link-shortcuts (make-parameter '()))
+(define ignore-page? (make-parameter #f))
+
+(define translators (make-parameter '()))
+(define current-page (make-parameter #f))
+(define pages (make-parameter '()))
+(define page-eval-env
+  (make-parameter (make-page-eval-env)))
+
+(define-syntax define-hyde-environment 
+  (syntax-rules ()
+    ((_ name e1 e2 ...)
+     (begin
+       (hyde-environments (cons 'name (hyde-environments)))
+       (when (eq? 'name (hyde-environment))
+         e1 e2 ...)))))
+
+(define (with-current-page-default accessor)
+  (lambda (#!optional (page (current-page)))
+    (accessor page)))
+ 
+(for-each (lambda (b)
+	    (environment-set! (page-eval-env) (car b) (cdr b)))
+	  `((read-page . ,read-page)
+	    (page-vars . ,(with-current-page-default page-vars))
+	    (page-path . ,(with-current-page-default page-path))
+	    (page-type . ,(with-current-page-default page-type))
+	    (page-source-path . ,(with-current-page-default page-source-path))
+	    (current-page . ,current-page)
+	    ($ . ,(lambda (name #!optional (page (current-page)))
+		    (alist-ref name (page-vars page))))))
+
+(define default-layout-template #<<END
+()
+`((xhtml-1.0-strict)
+  (html
+   (head
+    (title ,($ 'title)))
+   (body
+    (h1 ,($ 'title))
+    (inject ,contents))))
+END
+)
+
+(define (output-xml doc rules)
+  (SRV:send-reply (fold (lambda (rule doc)
+			  (pre-post-order* doc rule))
+			doc
+			rules)))
+
+(define (colorize-code language code)
+  (let* ((class (conc "highlight " language "-language"))
+	 (code (map (lambda (s)
+                      (handle-exceptions exn
+                        (htmlize s)
+                        (html-colorize language s)))
+                    code)))
+
+    `(pre (@ (class ,class)) (inject . ,code))))
+
+(define sxml-colorize-rules
+  `((highlight *macro* . ,(lambda (tag els)
+                            (cons 'colorize els)))
+    (colorize *preorder* . ,(lambda (tag els)
+                              (colorize-code (car els) (cdr els))))
+    ,@alist-conv-rules*))
+
+(define sxml-conversion-rules 
+  `((inject *preorder* . ,(lambda (tag sxml) sxml))
+    (shortcut . ,(lambda (tag attrs)
+                   (apply expand-link-shortcut attrs)))
+    ,@doctype-rules
+    ,@universal-conversion-rules*))
+
+(define (expand-link-shortcut alias . args)
+  (let ((uri-template (alist-ref alias (link-shortcuts))))
+    (cond ((not uri-template)
+           (error 'expand-link-shortcut
+                  (format "invalid link shortcut: ~S" alias)))
+          ((procedure? uri-template)
+           (apply uri-template args))
+          (else 
+           (apply format uri-template (map uri-encode-string args))))))
+
+(define (print-error error)
+  (with-output-to-port (current-error-port)
+    (cut print "ERROR: " error)))
+
+(define (die error exit-code)
+  (print-error error)
+  (exit exit-code))
+
+(define (load-hyde-file #!optional (die-when-missing? #t))
+  (if (file-exists? "hyde.scm")
+      (begin
+        (load "hyde.scm")
+        (unless (memq (hyde-environment) (hyde-environments))
+          (die (format "environment '~A' is not defined for this site" (hyde-environment)) 1)))
+      (begin
+        (print-error "no hyde.scm found")
+        
+        (if die-when-missing? 
+            (exit 1)
+            (begin (newline) #f)))))
+
+(define (create-directory-verbose name)
+  (print "creating " name)
+  (create-directory name #t))
+
+(define (initialize-site)
+  (unless (null? (directory))
+    (die "unable to initialize site, directory is not empty" 2))
+  
+  (create-directory-verbose (layouts-dir))
+  (create-directory-verbose (source-dir))
+  (create-directory-verbose (output-dir))
+
+  (print "creating hyde.scm")
+  (with-output-to-file "hyde.scm" (cut write '(use hyde)))
+  (let ((default-layout (make-pathname (layouts-dir) (car (default-layouts)))))
+    (print "creating " default-layout)
+    (with-output-to-file default-layout
+      (cut print default-layout-template))))
+
+(define (pathify string)
+  (let* ((path  (string-downcase string))
+         (path  (irregex-replace/all '(submatch (+ (~ alpha #\- #\space))) path ""))
+         (path  (irregex-replace/all '(submatch (+ (" -"))) path "-")))
+    (string-trim-both path #\-)))
+
+(define (generate-page ext title)
+  (let* ((title (string-intersperse title))
+         (path (pathify title))
+         (path (make-pathname (source-dir) path ext)))
+    (with-output-to-file path (cut write `((title . ,title))))
+    (print path)))
+
+(define (page-by-path path)
+  (let* ((path (if (string=? "" (car path))
+                   path
+                   (cons "" path)))
+         (path (cons (car path)
+                     (remove string-null? (cdr path))))
+         (path (string-join path "/"))
+         (path (if (string=? "" path) "/" path))
+         (page (find (lambda (page)
+                       (string=? (page-path (cdr page)) path))
+                     (pages))))
+    (and page (cdr page))))
+
+(define (send-page page)
+  (print-page-paths page)
+  (send-response body: (parameterize ((current-page page))
+                         (wrap-with-layouts (read-page page)))
+                 headers: `((content-type ,(file-extension->mime-type
+                                            (pathname-extension (page-path page)))))))
+
+(define (serve)
+  (root-path (source-dir))
+  
+  (vhost-map `((".*" . 
+                ,(lambda (continue)
+                   (with-pages
+                    (lambda () 
+                      (let* ((path (cdr (uri-path (request-uri (current-request)))))
+                             (page (page-by-path path)))
+
+                        (case (and page (page-type page))
+                          ((dynamic) (send-page page))
+
+                          ((directory) 
+                           (call/cc (lambda (break)
+                                      (for-each (lambda (index-file)
+                                                  (let* ((index-path (append path (list index-file)))
+                                                         (index-page (page-by-path index-path)))
+
+                                                    (when index-page
+                                                      (send-page index-page)
+                                                      (break index-page))))
+                                                (index-files))
+
+                                      (continue))))
+
+                          (else (continue))))))))))
+
+  (print (format "spiffy serving hyde on port ~A" (server-port)))
+  (start-server))
+
+(define (cmd name . args)
+  (receive (_ exited-normally status)
+    (process-wait (process-run name args))
+    (unless (and exited-normally (zero? status))
+      (error (format "error executing ~A ~A" name (string-intersperse args))))))
+
+(define (make-output-path path #!optional page)
+  (let ((output-file (make-pathname (output-dir) (pathname-relative-from (source-dir) path))))
+    (if page
+	(pathname-replace-extension output-file (->string (or (alist-ref 'ext (page-vars page)) (default-extension))))
+	output-file)))
+
+(define (make-access-path path #!optional page)
+  (let ((path (pathname-relative-from 
+               (output-dir) 
+               (make-output-path path page))))
+    (make-absolute-pathname 
+     (uri-path-prefix)
+     (if (string=? path ".") 
+         "/"
+         path))))
+
+(define (call-with-returning value proc)
+  (proc value)
+  value)
+
+(define (wrap-with-layout layout contents)
+  (with-input-from-source-file layout
+    (lambda (meta)
+      (match (translator-for layout)
+	((translate . translator-page-vars)
+	 (page-vars-set! (current-page) (append (page-vars (current-page)) meta translator-page-vars))
+	 (environment-set! (page-eval-env) 'contents contents)
+	 (translate))
+	(else (format "unknown layout format: ~A" layout))))))
+
+(define (wrap-with-layouts contents #!optional layouts)
+  (let* ((layouts (or layouts (alist-ref 'layouts (page-vars (current-page))) (default-layouts))))
+    (fold (cut wrap-with-layout <> <>)
+	  contents
+	  (map (cut make-pathname (layouts-dir) <>) layouts))))
+
+(define (with-input-from-source-file source-file proc)
+  (with-input-from-file source-file
+    (lambda ()
+      (proc (read)))))
+
+(define (compile-page-by-extension file translate page #!optional (env (environment-copy (page-eval-env))))
+  (with-input-from-source-file file 
+    (lambda (meta)
+      (parameterize ((current-page page) (page-eval-env env))
+	(translate)))))
+
+(define (translator-for file)
+  (and-let* ((ext (pathname-extension file))
+	     (translator (alist-ref ext (translators) string=?)))
+    (cons (lambda () 
+	    (with-output-to-string (car translator)))
+	  (cdr translator))))
+
+(define (default-page-vars-for page)
+  (append-map cdr (filter (lambda (d)
+                            (if (procedure? (car d))
+                                ((car d) page)
+                                (irregex-search (car d) (page-source-path page))))
+                          (default-page-vars))))
+
+(define (classify-path path)
+  (let* ((source-path (pathname-relative-from (source-dir) path))
+         (source-path (if (string=? "." source-path) "" source-path)))
+    (cons source-path
+	  (cond ((directory? path)
+		 (make-page type: 'directory
+			    source-path: source-path
+			    path: (make-access-path path)
+			    reader: (lambda () (directory path))
+			    writer: (lambda () (create-directory (make-output-path path) #t))))
+		((translator-for path) => 
+		 (lambda (translator)
+		   (let* ((translate (car translator))
+			  (translator-page-vars (cdr translator))
+			  (local-page-vars (or (with-input-from-file path read) '()))
+                          (page (make-page type: 'dynamic
+					   source-path: source-path
+					   vars: (append local-page-vars translator-page-vars)))
+                          (page (update-page page path: (make-access-path path page)))
+                          (page (update-page page vars: (append local-page-vars
+                                                                (default-page-vars-for page)
+                                                                translator-page-vars)))
+			  (reader (let ((contents #f))
+				    (lambda ()
+                                      (unless contents
+                                        (set! contents (compile-page-by-extension path translate page)))
+				      contents)))
+			  (writer (lambda () 
+				    (with-output-to-file (make-output-path path page)
+				      (lambda ()
+					(parameterize ((current-page page))
+					  (display (wrap-with-layouts (reader)))))))))
+		     (update-page page writer: writer reader: reader))))
+		(else (make-page type: 'static
+				 source-path: source-path
+				 path: (make-access-path path)
+				 reader: (lambda () (read-all path))
+				 writer: (lambda () (file-copy path (make-output-path path) #t))))))))
+
+(define (print-page-paths page)
+  (display (page-source-path page))
+  (print " -> " (substring (page-path page) 1)))
+
+(define (compile-page page)
+  (unless (and (ignore-page?) ((ignore-page?) page))
+    (unless (eq? 'directory (page-type page))
+      (print-page-paths page))
+    (write-page page)))
+
+(define (exclude-file? file)
+  (any (cut irregex-search <> file) (excluded-paths)))
+
+(define (with-pages thunk #!optional include-file?)
+  (parameterize ((pages '()))
+    (prepare-compilation (or include-file? (constantly #t)))
+    (thunk)))
+
+(define (prepare-compilation include-file?)
+  (pages (list (classify-path (source-dir))))
+  (environment-set! (page-eval-env) 'uri-path-prefix (uri-path-prefix))
+  (environment-set! (page-eval-env) 'pages pages)
+
+  (find-files (source-dir)
+              dotfiles: #t
+              test: (conjoin (complement exclude-file?)
+                             include-file?)
+              action: (lambda (file _)
+                        (pages (cons (classify-path file) (pages))))))
+
+(define (compile-pages path-prefixes)
+  (when (clean-before-build)
+    (print "cleaning output directory")
+    (cmd "rm" "-rf" (output-dir))
+    (create-directory (output-dir) #t))
+
+  (print "preparing compilation")
+  (with-pages
+   (lambda ()
+     (print "compiling pages")
+     (for-each (compose compile-page cdr) (reverse (pages))))
+   (and (not (null? path-prefixes))
+        (lambda (file)
+          (any (lambda (prefix)
+                 (string-prefix? prefix file))
+               path-prefixes)))))
+
+(define (translate/sxml)
+  (output-xml (map (lambda (e) (environment-eval e (page-eval-env))) (read-file))
+	      (list sxml-colorize-rules sxml-conversion-rules)))
+
+(translators (cons (list "sxml" translate/sxml) (translators)))
+
+(define-syntax make-external-translator
+  (syntax-rules ()
+    ((_ name)
+     (let ((read/write-lines
+            (lambda () (port-for-each print read-line))))
+       (lambda ()
+         (receive (in out pid err)
+                  (process* name)
+                  (with-output-to-port out read/write-lines)
+                  (close-output-port out)
+                  (with-input-from-port in read/write-lines)
+                  (close-input-port in)
+                  (close-input-port err)))))))
+
+(define translate/markdown (make-external-translator (markdown-program)))
+
+(translators (cons (list "md" translate/markdown) (translators)))
+
+(define (translate/scss)
+  (let loop ((sexp (read)))
+    (unless (eof-object? sexp)
+      (let ((scss (environment-eval sexp (page-eval-env))))
+        (scss->css (if (memq (car scss) '(css css+))
+                       scss
+                       (cons 'css+ scss))))
+      (loop (read)))))
+
+(translators (cons (list "scss" translate/scss '(ext . css) '(layouts))
+		   (translators)))
+
+(define +svnwiki-shortcut-link+ 
+  (irregex `(seq (submatch (+ (~ #\:))) #\: (submatch (+ any)))))
+
+(define (expand-link-shortcut/svnwiki tag attrs)
+  (let* ((m (irregex-match +svnwiki-shortcut-link+ (car attrs)))
+         (uri (cond ((and m (irregex-match-substring m 1)) =>
+                     (lambda (alias)
+                       (expand-link-shortcut (string->symbol alias)
+                                             (irregex-match-substring m 2))))
+                    (else (car attrs)))))
+                                                      
+    (list (if (absolute-uri? (uri-reference uri))
+              'link
+              'int-link)
+          uri
+          (cdr attrs))))
+
+(define (translate/svnwiki)
+  (let* ((doc (svnwiki->sxml (current-input-port)))
+         (doc (pre-post-order* doc `((int-link . ,expand-link-shortcut/svnwiki)
+                                     ,@alist-conv-rules*)))
+         (rules (multidoc-html-transformation-rules doc))
+         (rules (append (butlast rules)
+                        (list (cons (assq 'inject sxml-conversion-rules)
+                                    (last rules))))))
+
+    (output-xml doc (cons sxml-colorize-rules rules))))
+
+(translators (cons* (list "wiki" translate/svnwiki)
+		    (list "sw" translate/svnwiki)
+		    (translators)))
+
+)
+
+(define info '((version "0.20.0")))
+
+(compile -s -O2 -d1 hyde-page-eval-env.scm -J)
+(compile -s -O2 -d0 hyde-page-eval-env.import.scm)
+
+(compile -s -O2 -d1 hyde.scm -J)
+(compile -s -O2 -d0 hyde.import.scm)
+
+(compile -s -O2 -d1 hyde-atom.scm -J)
+(compile -s -O2 -d0 hyde-atom.import.scm)
+
+(compile -o hyde -O2 -d1 hyde-cmd.scm)
+
+(install-extension
+ 'hyde
+ '("hyde.so" "hyde.import.so"
+   "hyde-page-eval-env.so" "hyde-page-eval-env.import.so")
+ info)
+
+(install-extension
+ 'hyde-atom
+ '("hyde-atom.so" "hyde-atom.import.so")
+ info)
+
+(install-program
+ 'hyde-cmd
+ '("hyde")
+ info)