Changeset 25868 in project

Timestamp:

02/05/12 21:01:23 (9 years ago)

Author:

Moritz Heidkamp

Message:

hyde: use big-chicken's module-environment when possible;, adapt to the new keyword-based find-files API; slightly prettify automatic path generation; apply patch by John J Foerch which fixes issues with trailing slashes in paths (thanks!)

Location:

release/4/hyde/trunk

Files:

• hyde.meta (modified) (1 diff)
• hyde.scm (modified) (4 diffs)

release/4/hyde/trunk/hyde.meta

@@ -5 +5 @@
  (license "BSD")
  (doc-from-wiki)
- (needs filepath environments sxml-transforms doctype matchable (scss 0.3) (spiffy 4.9) colorize intarweb (uri-common 1.2) svnwiki-sxml defstruct multidoc atom rfc3339)
- (files "hyde.meta" "hyde-atom.scm" "hyde.setup" "hyde.scm" "hyde-cmd.scm" "hyde.release-info"))
+ (needs filepath environments sxml-transforms doctype matchable (scss 0.3) (spiffy 4.9) colorize intarweb (uri-common 1.2) svnwiki-sxml defstruct multidoc atom rfc3339 big-chicken))

release/4/hyde/trunk/hyde.scm

@@ -80 +80 @@
 (define current-page (make-parameter #f))
 (define pages (make-parameter '()))
-(define page-eval-env (make-parameter (environment-copy (interaction-environment) #t)))
+(define page-eval-env
+  (make-parameter
+   (environment-copy
+    (cond-expand
+     (module-environments
+      (module-environment 'big-chicken))
+     (else
+      (interaction-environment)))
+    #t)))
 
 (define-syntax define-hyde-environment 
@@ -199 +207 @@
 (define (pathify string)
   (let* ((path  (string-downcase string))
-         (path  (irregex-replace/all '(submatch (+ space)) path "-"))
-         (path  (irregex-replace/all '(submatch (+ (~ alpha #\-))) path "")))
+         (path  (irregex-replace/all '(submatch (+ (~ alpha #\- #\space))) path ""))
+         (path  (irregex-replace/all '(submatch (+ (" -"))) path "-")))
     (string-trim-both path #\-)))
 
@@ -214 +222 @@
                    path
                    (cons "" path)))
+         (path (cons (car path)
+                     (remove string-null? (cdr path))))
          (path (string-join path "/"))
          (path (if (string=? "" path) "/" path))
@@ -388 +398 @@
 
   (find-files (source-dir)
-              (conjoin (complement exclude-file?)
-                       include-file?)
-              (lambda (file _)
-                (pages (cons (classify-path file) (pages))))))
+              test: (conjoin (complement exclude-file?)
+                             include-file?)
+              action: (lambda (file _)
+                        (pages (cons (classify-path file) (pages))))))
 
 (define (compile-pages path-prefixes)