Overview
Comment:Added utility to rollup pages
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | selfcontained
Files: files | file ages | folders
SHA1: 136be142e491f488e07bd453eb70cfa7dc191d8b
User & Date: matt on 2013-05-18 21:13:34
Other Links: branch diff | manifest | tags
Context
2013-05-19
07:01
Self contained approach now working check-in: 2da502548b user: matt tags: selfcontained
2013-05-18
21:13
Added utility to rollup pages check-in: 136be142e4 user: matt tags: selfcontained
19:00
Updated stmlrun to require-library stml check-in: 632ed21f6c user: matt tags: selfcontained
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added rollup-pages.scm version [6207d17268]. 

































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

(use regex posix srfi-69 srfi-1)

(define extract-rx (regexp "pages\\/(.*)_(view|ctrl).scm"))

(let* ((views  (glob "pages/*_view.scm"))
       (ctrls  (glob "pages/*_ctrl.scm"))
       (all    (append views ctrls))
       (lookup (make-hash-table))
       (pages  (delete-duplicates
		(map (lambda (x)
		       (let* ((res  (string-match extract-rx x))
			      (page (cadr res))
			      (type (caddr res)))
			 (hash-table-set! lookup (conc page "_" type) #t)
			 (cadr res)))
		     all))))
       (if (null? all)(begin (print "No page files matching pages/*_(view|ctrl).scm")(exit)))
  (print "Pages: " pages)
  (with-output-to-file "all_pages.scm"
    (lambda ()
      (for-each (lambda (page)
		  (print "(define (pages:" page ")")
		  (if (hash-table-ref/default lookup (conc page "_view") #f)
		      (print "(include \"pages/" page "_view.scm\")"))
		  (if (hash-table-ref/default lookup (conc page "_ctrl") #f)
		      (print "(include \"pages/" page "_ctrl.scm\")"))
		  (print ")\n"))
		pages))))