Artifact
d0b51a85fd6629332516f7c8ff959aa5b494dd39:
0000: 3b 3b 20 74 77 69 6b 69 20 6d 6f 64 75 6c 65 0a ;; twiki module.
0010: 28 72 65 71 75 69 72 65 2d 65 78 74 65 6e 73 69 (require-extensi
0020: 6f 6e 20 73 69 6c 65 78 20 73 71 6c 69 74 65 33 on silex sqlite3
0030: 20 72 65 67 65 78 20 70 6f 73 69 78 29 0a 0a 28 regex posix)..(
0040: 69 6e 63 6c 75 64 65 20 22 74 77 69 6b 69 2e 6c include "twiki.l
0050: 2e 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 .scm")..(define
0060: 28 74 77 69 6b 69 3a 6f 70 65 6e 2d 64 62 20 6b (twiki:open-db k
0070: 65 79 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 66 eys). (let* ((f
0080: 6e 61 6d 65 20 20 20 28 74 77 69 6b 69 3a 6b 65 name (twiki:ke
0090: 79 73 2d 3e 66 6e 61 6d 65 20 6b 65 79 73 29 29 ys->fname keys))
00a0: 0a 09 20 28 66 65 78 69 73 74 73 20 28 66 69 6c .. (fexists (fil
00b0: 65 2d 65 78 69 73 74 73 3f 20 66 6e 61 6d 65 29 e-exists? fname)
00c0: 29 0a 09 20 28 64 62 20 28 64 62 69 3a 6f 70 65 ).. (db (dbi:ope
00d0: 6e 20 27 73 71 6c 69 74 65 33 20 27 28 28 64 62 n 'sqlite3 '((db
00e0: 6e 61 6d 65 20 2e 20 66 6e 61 6d 65 29 29 29 29 name . fname))))
00f0: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 66 ). (if (not f
0100: 65 78 69 73 74 73 29 0a 09 28 66 6f 72 2d 65 61 exists)..(for-ea
0110: 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 73 ch .. (lambda (s
0120: 71 72 79 29 0a 09 20 20 20 28 64 62 69 3a 65 78 qry).. (dbi:ex
0130: 65 63 20 64 62 20 73 71 72 79 29 29 0a 09 20 27 ec db sqry)).. '
0140: 28 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 64 ("CREATE TABLE d
0150: 61 74 73 20 20 20 20 20 28 69 64 20 49 4e 54 45 ats (id INTE
0160: 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c GER PRIMARY KEY,
0170: 6d 64 35 73 75 6d 20 54 45 58 54 2c 64 61 74 20 md5sum TEXT,dat
0180: 42 4c 4f 42 2c 74 79 70 65 20 49 4e 54 45 47 45 BLOB,type INTEGE
0190: 52 29 3b 22 0a 09 20 20 20 22 43 52 45 41 54 45 R);".. "CREATE
01a0: 20 54 41 42 4c 45 20 74 69 64 64 6c 65 72 73 20 TABLE tiddlers
01b0: 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d (id INTEGER PRIM
01c0: 41 52 59 20 4b 45 59 2c 77 69 6b 69 5f 69 64 20 ARY KEY,wiki_id
01d0: 49 4e 54 45 47 45 52 2c 6e 61 6d 65 20 54 45 58 INTEGER,name TEX
01e0: 54 2c 72 65 76 20 49 4e 54 45 47 45 52 2c 64 61 T,rev INTEGER,da
01f0: 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 63 72 65 t_id INTEGER,cre
0200: 61 74 65 64 5f 6f 6e 20 49 4e 54 45 47 45 52 2c ated_on INTEGER,
0210: 63 68 61 6e 67 65 64 5f 6f 6e 20 49 4e 54 45 47 changed_on INTEG
0220: 45 52 2c 6f 77 6e 65 72 5f 69 64 20 49 4e 54 45 ER,owner_id INTE
0230: 47 45 52 29 3b 22 0a 09 20 20 20 22 43 52 45 41 GER);".. "CREA
0240: 54 45 20 54 41 42 4c 45 20 72 65 76 73 20 20 20 TE TABLE revs
0250: 20 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 (id INTEGER PR
0260: 49 4d 41 52 59 20 4b 45 59 2c 74 61 67 20 54 45 IMARY KEY,tag TE
0270: 58 54 29 3b 22 0a 09 20 20 20 22 43 52 45 41 54 XT);".. "CREAT
0280: 45 20 54 41 42 4c 45 20 77 69 6b 69 73 20 20 20 E TABLE wikis
0290: 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 (id INTEGER PRI
02a0: 4d 41 52 59 20 4b 45 59 2c 6b 65 79 5f 6e 61 6d MARY KEY,key_nam
02b0: 65 20 54 45 58 54 2c 74 69 74 6c 65 20 54 45 58 e TEXT,title TEX
02c0: 54 2c 63 72 65 61 74 65 64 5f 6f 6e 20 49 4e 54 T,created_on INT
02d0: 45 47 45 52 29 3b 22 29 29 29 0a 20 20 20 20 28 EGER);"))). (
02e0: 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 79 sqlite3:set-busy
02f0: 2d 74 69 6d 65 6f 75 74 21 28 64 62 69 3a 64 62 -timeout!(dbi:db
0300: 2d 63 6f 6e 6e 20 64 62 29 20 31 30 30 30 30 30 -conn db) 100000
0310: 30 29 0a 20 20 20 20 64 62 29 29 0a 09 0a 28 64 0). db))...(d
0320: 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 76 69 65 efine (twiki:vie
0330: 77 29 0a 20 20 28 73 3a 64 69 76 20 27 63 6c 61 w). (s:div 'cla
0340: 73 73 20 22 6e 6f 64 65 22 0a 20 20 28 73 3a 68 ss "node". (s:h
0350: 31 20 22 54 77 69 6b 69 22 29 0a 20 20 22 54 69 1 "Twiki"). "Ti
0360: 74 6c 65 2c 20 70 69 63 74 75 72 65 73 2c 20 65 tle, pictures, e
0370: 74 63 2e 22 0a 20 20 20 28 6c 65 74 20 28 29 0a tc.". (let ().
0380: 20 20 20 20 20 22 62 6c 61 68 22 29 29 29 0a 0a "blah")))..
0390: 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a .(define (twiki:
03a0: 77 69 6b 69 20 2e 20 6b 65 79 73 29 0a 20 20 28 wiki . keys). (
03b0: 6c 65 74 20 28 28 6b 65 79 20 28 63 6f 6e 63 20 let ((key (conc
03c0: 6b 65 79 73 29 29 29 0a 20 20 20 20 28 74 77 69 keys))). (twi
03d0: 6b 69 3a 76 69 65 77 29 29 29 0a 0a 28 64 65 66 ki:view)))..(def
03e0: 69 6e 65 20 28 74 77 69 6b 69 3a 65 78 74 72 61 ine (twiki:extra
03f0: 63 74 2d 74 69 64 64 6c 65 72 73 20 64 61 74 29 ct-tiddlers dat)
0400: 0a 20 20 28 6c 65 74 2a 20 28 28 69 6e 70 20 28 . (let* ((inp (
0410: 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e open-input-strin
0420: 67 20 64 61 74 29 29 0a 09 20 28 70 72 65 76 2d g dat)).. (prev-
0430: 73 74 61 74 65 20 23 66 29 0a 09 20 28 73 74 61 state #f).. (sta
0440: 63 6b 20 20 20 20 20 20 28 6c 69 73 74 20 27 73 ck (list 's
0450: 74 61 72 74 29 29 0a 09 20 28 6c 69 6e 6b 73 20 tart)).. (links
0460: 20 20 20 20 20 27 28 29 29 0a 09 20 28 63 75 72 '()).. (cur
0470: 72 6c 6e 6b 20 20 20 20 23 66 29 29 0a 20 20 20 rlnk #f)).
0480: 20 28 6c 65 78 65 72 2d 69 6e 69 74 20 27 70 6f (lexer-init 'po
0490: 72 74 20 69 6e 70 29 0a 20 20 20 20 28 6c 65 74 rt inp). (let
04a0: 20 6c 6f 6f 70 20 28 28 74 6f 6b 65 6e 20 20 20 loop ((token
04b0: 20 20 20 20 20 20 20 28 6c 65 78 65 72 29 29 29 (lexer)))
04c0: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 6f . (let ((to
04d0: 6b 65 6e 2d 74 79 70 65 20 28 63 61 72 20 74 6f ken-type (car to
04e0: 6b 65 6e 29 29 0a 09 20 20 20 20 28 74 6f 6b 65 ken)).. (toke
04f0: 6e 2d 76 61 6c 20 20 28 63 61 64 72 20 74 6f 6b n-val (cadr tok
0500: 65 6e 29 29 0a 09 20 20 20 20 28 73 74 61 74 65 en)).. (state
0510: 20 20 20 20 20 20 28 63 61 72 20 20 73 74 61 63 (car stac
0520: 6b 29 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 k)))..(if (not (
0530: 65 71 3f 20 70 72 65 76 2d 73 74 61 74 65 20 73 eq? prev-state s
0540: 74 61 74 65 29 29 0a 09 20 20 20 20 28 62 65 67 tate)).. (beg
0550: 69 6e 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 in.. (print
0560: 20 22 73 74 61 74 65 3a 20 22 20 73 74 61 74 65 "state: " state
0570: 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 70 ).. (set! p
0580: 72 65 76 2d 73 74 61 74 65 20 73 74 61 74 65 29 rev-state state)
0590: 29 29 0a 09 28 63 61 73 65 20 74 6f 6b 65 6e 2d ))..(case token-
05a0: 74 79 70 65 0a 09 20 20 28 27 65 6e 64 2d 6f 66 type.. ('end-of
05b0: 2d 69 6e 70 75 74 20 20 20 20 20 20 20 28 70 72 -input (pr
05c0: 69 6e 74 20 22 44 6f 6e 65 22 29 28 63 6c 6f 73 int "Done")(clos
05d0: 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 69 6e 70 e-input-port inp
05e0: 29 29 0a 09 20 20 28 27 74 77 69 6b 69 6c 69 6e )).. ('twikilin
05f0: 6b 2d 73 74 61 72 74 0a 09 20 20 20 28 73 65 74 k-start.. (set
0600: 21 20 73 74 61 63 6b 20 28 63 6f 6e 73 20 27 74 ! stack (cons 't
0610: 77 69 6b 69 6c 69 6e 6b 2d 73 74 61 72 74 20 73 wikilink-start s
0620: 74 61 63 6b 29 29 0a 09 20 20 20 28 6c 6f 6f 70 tack)).. (loop
0630: 20 28 6c 65 78 65 72 29 29 29 0a 09 20 20 28 27 (lexer))).. ('
0640: 74 77 69 6b 69 6c 69 6e 6b 2d 65 6e 64 0a 09 20 twikilink-end..
0650: 20 20 28 73 65 74 21 20 6c 69 6e 6b 73 20 28 63 (set! links (c
0660: 6f 6e 73 20 63 75 72 72 6c 6e 6b 20 6c 69 6e 6b ons currlnk link
0670: 73 29 29 0a 09 20 20 20 28 73 65 74 21 20 73 74 s)).. (set! st
0680: 61 63 6b 20 28 63 64 72 20 73 74 61 63 6b 29 29 ack (cdr stack))
0690: 0a 09 20 20 20 28 6c 6f 6f 70 20 28 6c 65 78 65 .. (loop (lexe
06a0: 72 29 29 29 0a 09 20 20 28 27 74 77 69 6b 69 74 r))).. ('twikit
06b0: 65 78 74 0a 09 20 20 20 28 69 66 20 28 65 71 3f ext.. (if (eq?
06c0: 20 73 74 61 74 65 20 27 74 77 69 6b 69 6c 69 6e state 'twikilin
06d0: 6b 2d 73 74 61 72 74 29 0a 09 20 20 20 20 20 20 k-start)..
06e0: 20 28 73 65 74 21 20 63 75 72 72 6c 6e 6b 20 28 (set! currlnk (
06f0: 63 61 64 72 20 74 6f 6b 65 6e 29 29 0a 09 20 20 cadr token))..
0700: 20 20 20 20 20 28 70 72 69 6e 74 20 22 47 6f 74 (print "Got
0710: 20 22 20 74 6f 6b 65 6e 29 29 0a 09 20 20 20 28 " token)).. (
0720: 6c 6f 6f 70 20 28 6c 65 78 65 72 29 29 29 0a 09 loop (lexer)))..
0730: 20 20 28 27 61 6e 79 64 61 74 0a 09 20 20 20 28 ('anydat.. (
0740: 6c 6f 6f 70 20 28 6c 65 78 65 72 29 29 29 0a 09 loop (lexer)))..
0750: 20 20 28 65 6c 73 65 0a 09 20 20 20 28 70 72 69 (else.. (pri
0760: 6e 74 20 22 45 52 52 4f 52 3a 20 75 6e 6b 6e 6f nt "ERROR: unkno
0770: 77 6e 20 74 6f 6b 65 6e 20 22 20 74 6f 6b 65 6e wn token " token
0780: 20 22 20 6f 6e 20 6c 69 6e 65 20 22 20 28 6c 65 " on line " (le
0790: 78 65 72 2d 67 65 74 2d 6c 69 6e 65 29 29 0a 09 xer-get-line))..
07a0: 20 20 20 28 6c 6f 6f 70 20 28 6c 65 78 65 72 29 (loop (lexer)
07b0: 29 29 29 29 29 0a 20 20 20 20 6c 69 6e 6b 73 29 ))))). links)
07c0: 29 0a 20 20 20 20 20 0a ). .