Artifact
b24bc2e231cdea5d2ea184988eb849f99a6ca36f:
0000: 28 75 73 65 20 72 65 67 65 78 20 70 6f 73 69 78 (use regex posix
0010: 20 73 72 66 69 2d 36 39 20 73 72 66 69 2d 31 29 srfi-69 srfi-1)
0020: 0a 0a 28 64 65 66 69 6e 65 20 65 78 74 72 61 63 ..(define extrac
0030: 74 2d 72 78 20 28 72 65 67 65 78 70 20 22 70 61 t-rx (regexp "pa
0040: 67 65 73 5c 5c 2f 28 2e 2a 29 5f 28 76 69 65 77 ges\\/(.*)_(view
0050: 7c 63 74 72 6c 29 2e 73 63 6d 22 29 29 0a 0a 28 |ctrl).scm"))..(
0060: 64 65 66 69 6e 65 20 28 70 72 69 6e 74 2d 70 61 define (print-pa
0070: 67 65 2d 77 72 61 70 70 65 72 20 6c 6f 6f 6b 75 ge-wrapper looku
0080: 70 20 70 61 67 65 29 0a 20 20 28 70 72 69 6e 74 p page). (print
0090: 20 22 28 64 65 66 69 6e 65 20 28 70 61 67 65 73 "(define (pages
00a0: 3a 22 20 70 61 67 65 20 22 20 73 65 73 73 69 6f :" page " sessio
00b0: 6e 20 64 62 20 73 68 61 72 65 64 29 22 29 0a 20 n db shared)").
00c0: 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 (if (hash-table
00d0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6c 6f 6f -ref/default loo
00e0: 6b 75 70 20 28 63 6f 6e 63 20 70 61 67 65 20 22 kup (conc page "
00f0: 5f 63 74 72 6c 22 29 20 23 66 29 0a 20 20 20 20 _ctrl") #f).
0100: 20 20 28 70 72 69 6e 74 20 22 28 69 6e 63 6c 75 (print "(inclu
0110: 64 65 20 5c 22 70 61 67 65 73 2f 22 20 70 61 67 de \"pages/" pag
0120: 65 20 22 5f 63 74 72 6c 2e 73 63 6d 5c 22 29 22 e "_ctrl.scm\")"
0130: 29 29 0a 20 20 28 69 66 20 28 68 61 73 68 2d 74 )). (if (hash-t
0140: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
0150: 20 6c 6f 6f 6b 75 70 20 28 63 6f 6e 63 20 70 61 lookup (conc pa
0160: 67 65 20 22 5f 76 69 65 77 22 29 20 23 66 29 0a ge "_view") #f).
0170: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 28 69 (print "(i
0180: 6e 63 6c 75 64 65 20 5c 22 70 61 67 65 73 2f 22 nclude \"pages/"
0190: 20 70 61 67 65 20 22 5f 76 69 65 77 2e 73 63 6d page "_view.scm
01a0: 5c 22 29 22 29 29 0a 20 20 28 70 72 69 6e 74 20 \")")). (print
01b0: 22 29 5c 6e 22 29 29 0a 0a 28 6c 65 74 2a 20 28 ")\n"))..(let* (
01c0: 28 76 69 65 77 73 20 20 28 67 6c 6f 62 20 22 70 (views (glob "p
01d0: 61 67 65 73 2f 2a 5f 76 69 65 77 2e 73 63 6d 22 ages/*_view.scm"
01e0: 29 29 0a 20 20 20 20 20 20 20 28 63 74 72 6c 73 )). (ctrls
01f0: 20 20 28 67 6c 6f 62 20 22 70 61 67 65 73 2f 2a (glob "pages/*
0200: 5f 63 74 72 6c 2e 73 63 6d 22 29 29 0a 20 20 20 _ctrl.scm")).
0210: 20 20 20 20 28 61 6c 6c 20 20 20 20 28 61 70 70 (all (app
0220: 65 6e 64 20 76 69 65 77 73 20 63 74 72 6c 73 29 end views ctrls)
0230: 29 0a 20 20 20 20 20 20 20 28 6c 6f 6f 6b 75 70 ). (lookup
0240: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0250: 65 29 29 0a 20 20 20 20 20 20 20 28 70 61 67 65 e)). (page
0260: 73 20 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 s (delete-dupli
0270: 63 61 74 65 73 0a 09 09 28 6d 61 70 20 28 6c 61 cates...(map (la
0280: 6d 62 64 61 20 28 78 29 0a 09 09 20 20 20 20 20 mbda (x)...
0290: 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 28 (let* ((res (
02a0: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 65 78 74 string-match ext
02b0: 72 61 63 74 2d 72 78 20 78 29 29 0a 09 09 09 20 ract-rx x))....
02c0: 20 20 20 20 20 28 70 61 67 65 20 28 63 61 64 72 (page (cadr
02d0: 20 72 65 73 29 29 0a 09 09 09 20 20 20 20 20 20 res))....
02e0: 28 74 79 70 65 20 28 63 61 64 64 72 20 72 65 73 (type (caddr res
02f0: 29 29 29 0a 09 09 09 20 28 68 61 73 68 2d 74 61 ))).... (hash-ta
0300: 62 6c 65 2d 73 65 74 21 20 6c 6f 6f 6b 75 70 20 ble-set! lookup
0310: 28 63 6f 6e 63 20 70 61 67 65 20 22 5f 22 20 74 (conc page "_" t
0320: 79 70 65 29 20 23 74 29 0a 09 09 09 20 28 63 61 ype) #t).... (ca
0330: 64 72 20 72 65 73 29 29 29 0a 09 09 20 20 20 20 dr res)))...
0340: 20 61 6c 6c 29 29 29 29 0a 20 20 28 69 66 20 28 all)))). (if (
0350: 6e 75 6c 6c 3f 20 61 6c 6c 29 28 62 65 67 69 6e null? all)(begin
0360: 20 28 70 72 69 6e 74 20 22 4e 6f 20 70 61 67 65 (print "No page
0370: 20 66 69 6c 65 73 20 6d 61 74 63 68 69 6e 67 20 files matching
0380: 70 61 67 65 73 2f 2a 5f 28 76 69 65 77 7c 63 74 pages/*_(view|ct
0390: 72 6c 29 2e 73 63 6d 22 29 28 65 78 69 74 29 29 rl).scm")(exit))
03a0: 29 0a 20 20 28 70 72 69 6e 74 20 22 50 61 67 65 ). (print "Page
03b0: 73 3a 20 22 20 70 61 67 65 73 29 0a 20 20 3b 3b s: " pages). ;;
03c0: 20 66 69 72 73 74 20 74 68 65 20 69 6e 64 69 76 first the indiv
03d0: 69 64 75 61 6c 20 72 6f 6c 6c 75 70 20 77 72 61 idual rollup wra
03e0: 70 70 65 72 73 20 28 75 73 65 64 20 62 79 20 74 ppers (used by t
03f0: 68 65 20 64 79 6e 61 6d 69 63 20 6c 6f 61 64 29 he dynamic load)
0400: 0a 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 . (for-each .
0410: 20 28 6c 61 6d 62 64 61 20 28 70 61 67 65 29 0a (lambda (page).
0420: 20 20 20 20 20 28 6c 65 74 20 28 28 70 61 67 65 (let ((page
0430: 66 69 6c 65 20 20 28 63 6f 6e 63 20 22 70 61 67 file (conc "pag
0440: 65 73 2f 22 20 70 61 67 65 20 22 2e 73 63 6d 22 es/" page ".scm"
0450: 29 29 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e ))). (prin
0460: 74 20 22 70 61 67 65 20 22 20 70 61 67 65 20 22 t "page " page "
0470: 20 22 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 "). (if (
0480: 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 not (file-exists
0490: 3f 20 70 61 67 65 66 69 6c 65 29 29 0a 09 20 20 ? pagefile))..
04a0: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 77 (begin.. (w
04b0: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
04c0: 6c 65 20 70 61 67 65 66 69 6c 65 0a 09 20 20 20 le pagefile..
04d0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 (lambda ()..
04e0: 09 20 28 70 72 69 6e 74 2d 70 61 67 65 2d 77 72 . (print-page-wr
04f0: 61 70 70 65 72 20 6c 6f 6f 6b 75 70 20 70 61 67 apper lookup pag
0500: 65 29 29 29 0a 09 20 20 20 20 20 28 70 72 69 6e e))).. (prin
0510: 74 20 22 20 63 72 65 61 74 65 64 22 29 29 0a 09 t " created"))..
0520: 20 20 20 28 70 72 69 6e 74 20 22 20 61 6c 72 65 (print " alre
0530: 61 64 79 20 63 72 65 61 74 65 64 22 29 29 29 29 ady created"))))
0540: 0a 20 20 20 70 61 67 65 73 29 0a 20 20 3b 3b 20 . pages). ;;
0550: 74 68 65 6e 20 74 68 65 20 6d 6f 6e 6f 6c 69 74 then the monolit
0560: 68 69 63 20 72 6f 6c 6c 75 70 20 77 72 61 70 70 hic rollup wrapp
0570: 65 72 20 28 75 73 65 64 20 69 6e 20 63 6f 6d 70 er (used in comp
0580: 69 6c 69 6e 67 20 74 68 65 20 73 69 6e 67 6c 65 iling the single
0590: 2d 65 78 65 63 75 74 61 62 6c 65 29 0a 20 20 28 -executable). (
05a0: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
05b0: 69 6c 65 20 22 61 6c 6c 5f 70 61 67 65 73 2e 73 ile "all_pages.s
05c0: 63 6d 22 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 cm". (lambda
05d0: 28 29 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 61 (). (for-ea
05e0: 63 68 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ch. (lambd
05f0: 61 20 28 70 61 67 65 29 0a 09 20 28 70 72 69 6e a (page).. (prin
0600: 74 2d 70 61 67 65 2d 77 72 61 70 70 65 72 20 6c t-page-wrapper l
0610: 6f 6f 6b 75 70 20 70 61 67 65 29 29 0a 20 20 20 ookup page)).
0620: 20 20 20 20 70 61 67 65 73 29 29 29 29 0a 0a 0a pages))))...
0630: 20 20