Artifact d4d21ad3375b808e8571dff252597814db4b6049:


0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30  ;; Copyright 200
0010: 37 2d 32 30 31 30 2c 20 4d 61 74 74 68 65 77 20  7-2010, Matthew 
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 0a 3b 3b 20 20  Welland..;;.;;  
0030: 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20  This program is 
0040: 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 75  made available u
0050: 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 4c  nder the GNU GPL
0060: 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 0a   version 2.0 or.
0070: 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 65  ;;  greater. See
0080: 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 6e   the accompanyin
0090: 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 66  g file COPYING f
00a0: 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 0a 3b  or details..;;.;
00b0: 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20  ;  This program 
00c0: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 57  is distributed W
00d0: 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41  ITHOUT ANY WARRA
00e0: 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65  NTY; without eve
00f0: 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c 69 65  n the.;;  implie
0100: 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 4d 45  d warranty of ME
0110: 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 6f 72  RCHANTABILITY or
0120: 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 20 50   FITNESS FOR A P
0130: 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 50 55  ARTICULAR.;;  PU
0140: 52 50 4f 53 45 2e 0a 0a 3b 3b 20 74 77 69 6b 69  RPOSE...;; twiki
0150: 20 6d 6f 64 75 6c 65 0a 28 72 65 71 75 69 72 65   module.(require
0160: 2d 65 78 74 65 6e 73 69 6f 6e 20 73 71 6c 69 74  -extension sqlit
0170: 65 33 20 72 65 67 65 78 20 70 6f 73 69 78 20 6d  e3 regex posix m
0180: 64 35 20 6d 65 73 73 61 67 65 2d 64 69 67 65 73  d5 message-diges
0190: 74 20 62 61 73 65 36 34 29 0a 28 69 6d 70 6f 72  t base64).(impor
01a0: 74 20 28 70 72 65 66 69 78 20 62 61 73 65 36 34  t (prefix base64
01b0: 20 62 61 73 65 36 34 3a 29 29 0a 0a 3b 3b 20 54   base64:))..;; T
01c0: 4f 44 4f 0a 3b 3b 0a 3b 3b 20 2a 20 49 6e 6c 69  ODO.;;.;; * Inli
01d0: 6e 65 20 74 69 64 64 6c 65 72 73 20 5b 69 6e 6c  ne tiddlers [inl
01e0: 69 6e 65 5b 54 69 64 64 6c 65 72 4e 61 6d 65 5d  ine[TiddlerName]
01f0: 5d 0a 3b 3b 20 2a 20 50 69 63 73 20 20 20 20 20  ].;; * Pics     
0200: 20 20 20 20 20 20 20 5b 70 69 63 20 58 20 59 5b         [pic X Y[
0210: 70 69 63 6e 61 6d 65 2e 6a 70 67 5d 5d 0a 3b 3b  picname.jpg]].;;
0220: 20 2a 20 4d 6f 76 65 20 74 77 69 6b 69 20 70 61   * Move twiki pa
0230: 72 73 69 6e 67 2f 65 78 70 61 6e 64 69 6e 67 20  rsing/expanding 
0240: 74 6f 20 6d 61 74 74 73 75 74 69 6c 73 20 61 73  to mattsutils as
0250: 20 6c 6f 61 64 61 62 6c 65 20 6d 6f 64 75 6c 65   loadable module
0260: 0a 0a 3b 3b 20 52 6f 75 74 69 6e 65 73 20 69 6e  ..;; Routines in
0270: 74 65 6e 64 65 64 20 74 6f 20 62 65 20 6f 76 65  tended to be ove
0280: 72 72 69 64 64 65 6e 20 62 79 20 65 6e 64 20 75  rridden by end u
0290: 73 65 72 73 0a 3b 3b 20 20 28 74 77 69 6b 69 3a  sers.;;  (twiki:
02a0: 61 63 63 65 73 73 20 6b 65 79 73 20 77 69 6b 69  access keys wiki
02b0: 2d 6e 61 6d 65 20 75 73 65 72 2d 69 64 29 0a 3b  -name user-id).;
02c0: 3b 20 73 65 61 72 63 68 20 74 68 65 20 63 6f 64  ; search the cod
02d0: 65 20 66 6f 72 20 22 6f 76 65 72 72 69 64 65 22  e for "override"
02e0: 20 66 6f 72 20 6d 6f 72 65 2e 0a 0a 3b 3b 20 74   for more...;; t
02f0: 77 69 6b 69 20 63 73 73 0a 3b 3b 20 3d 3d 3d 3d  wiki css.;; ====
0300: 3d 3d 3d 3d 3d 0a 3b 3b 20 42 6c 6f 63 6b 20 20  =====.;; Block  
0310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 61                ta
0320: 67 0a 3b 3b 20 2d 2d 2d 2d 2d 20 20 20 20 20 20  g.;; -----      
0330: 20 20 20 20 20 20 20 20 20 20 2d 2d 2d 0a 3b 3b            ---.;;
0340: 20 74 77 69 6b 69 20 20 20 20 20 20 20 20 20 20   twiki          
0350: 20 20 20 20 20 20 74 77 69 6b 69 0a 3b 3b 20 74        twiki.;; t
0360: 77 69 6b 69 20 62 6f 64 79 20 64 69 76 20 20 20  wiki body div   
0370: 20 20 20 20 74 77 69 6b 69 2d 6e 6f 64 65 0a 3b      twiki-node.;
0380: 3b 20 74 77 69 6b 69 20 6d 61 69 6e 20 6d 65 6e  ; twiki main men
0390: 75 20 20 20 20 20 20 74 77 69 6b 69 2d 6d 61 69  u      twiki-mai
03a0: 6e 2d 6d 65 6e 75 0a 0a 3b 3b 20 54 68 69 73 20  n-menu..;; This 
03b0: 69 73 20 74 68 65 20 63 75 72 72 65 6e 74 6c 79  is the currently
03c0: 20 73 75 70 70 6f 72 74 65 64 20 6d 65 63 68 61   supported mecha
03d0: 6e 69 73 6d 2e 20 50 6f 73 74 67 72 65 73 20 77  nism. Postgres w
03e0: 69 6c 6c 20 62 65 20 61 64 64 65 64 20 6c 61 74  ill be added lat
03f0: 65 72 20 2d 6d 72 77 2d 20 37 2f 32 36 2f 32 30  er -mrw- 7/26/20
0400: 30 39 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 74  09.;;.(define (t
0410: 77 69 6b 69 3a 6f 70 65 6e 2d 64 62 20 6b 65 79  wiki:open-db key
0420: 20 2e 20 63 72 65 61 74 65 2d 6e 6f 74 2d 6f 6b   . create-not-ok
0430: 29 0a 20 20 3b 3b 20 28 73 3a 6c 6f 67 20 22 47  ).  ;; (s:log "G
0440: 6f 74 20 74 6f 20 74 77 69 6b 69 3a 6f 70 65 6e  ot to twiki:open
0450: 2d 64 62 20 77 69 74 68 20 6b 65 79 3a 20 22 20  -db with key: " 
0460: 6b 65 79 29 0a 20 20 28 6c 65 74 2a 20 28 28 63  key).  (let* ((c
0470: 72 65 61 74 65 2d 6f 6b 20 28 69 66 20 28 6e 75  reate-ok (if (nu
0480: 6c 6c 3f 20 63 72 65 61 74 65 2d 6e 6f 74 2d 6f  ll? create-not-o
0490: 6b 29 20 23 74 20 28 63 61 72 20 63 72 65 61 74  k) #t (car creat
04a0: 65 2d 6e 6f 74 2d 6f 6b 29 29 29 0a 09 20 28 66  e-not-ok))).. (f
04b0: 64 61 74 20 20 20 20 20 20 28 74 77 69 6b 69 3a  dat      (twiki:
04c0: 6b 65 79 2d 3e 66 6e 61 6d 65 20 6b 65 79 29 29  key->fname key))
04d0: 0a 09 20 28 62 61 73 65 70 61 74 68 20 20 28 73  .. (basepath  (s
04e0: 64 61 74 2d 67 65 74 2d 74 77 69 6b 69 64 69 72  dat-get-twikidir
04f0: 20 73 3a 73 65 73 73 69 6f 6e 29 29 0a 09 20 28   s:session)).. (
0500: 66 70 61 74 68 20 20 20 20 20 28 63 61 72 20 66  fpath     (car f
0510: 64 61 74 29 29 0a 09 20 28 66 6e 61 6d 65 20 20  dat)).. (fname  
0520: 20 20 20 28 63 61 64 72 20 66 64 61 74 29 29 0a     (cadr fdat)).
0530: 09 20 28 66 75 6c 6c 64 69 72 20 20 20 28 63 6f  . (fulldir   (co
0540: 6e 63 20 62 61 73 65 70 61 74 68 20 22 2f 22 20  nc basepath "/" 
0550: 66 70 61 74 68 29 29 0a 09 20 28 66 75 6c 6c 6e  fpath)).. (fulln
0560: 61 6d 65 20 20 28 6c 65 74 20 28 28 66 6e 20 28  ame  (let ((fn (
0570: 63 6f 6e 63 20 66 75 6c 6c 64 69 72 20 22 2f 22  conc fulldir "/"
0580: 20 66 6e 61 6d 65 29 29 29 0a 09 09 20 20 20 20   fname)))...    
0590: 20 20 28 69 66 20 28 73 64 61 74 2d 67 65 74 2d    (if (sdat-get-
05a0: 64 65 62 75 67 6d 6f 64 65 20 73 3a 73 65 73 73  debugmode s:sess
05b0: 69 6f 6e 29 28 73 3a 6c 6f 67 20 22 5c 6e 74 77  ion)(s:log "\ntw
05c0: 69 6b 69 70 61 74 68 3a 20 22 20 66 6e 29 29 0a  ikipath: " fn)).
05d0: 09 09 20 20 20 20 20 20 66 6e 29 29 0a 09 20 28  ..      fn)).. (
05e0: 66 65 78 69 73 74 73 20 20 20 28 66 69 6c 65 2d  fexists   (file-
05f0: 65 78 69 73 74 73 3f 20 66 75 6c 6c 6e 61 6d 65  exists? fullname
0600: 29 29 0a 09 20 28 64 62 20 20 20 20 20 20 20 20  )).. (db        
0610: 28 69 66 20 66 65 78 69 73 74 73 20 28 64 62 69  (if fexists (dbi
0620: 3a 6f 70 65 6e 20 27 73 71 6c 69 74 65 33 20 28  :open 'sqlite3 (
0630: 6c 69 73 74 20 28 63 6f 6e 73 20 27 64 62 6e 61  list (cons 'dbna
0640: 6d 65 20 66 75 6c 6c 6e 61 6d 65 29 29 29 20 23  me fullname))) #
0650: 66 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e  f))).    (if (an
0660: 64 20 28 6e 6f 74 20 64 62 29 0a 09 20 20 20 20  d (not db)..    
0670: 20 28 6e 6f 74 20 63 72 65 61 74 65 2d 6f 6b 29   (not create-ok)
0680: 29 0a 09 28 65 78 69 74 20 31 30 30 29 0a 09 28  )..(exit 100)..(
0690: 62 65 67 69 6e 0a 09 20 20 28 69 66 20 28 6e 6f  begin..  (if (no
06a0: 74 20 66 65 78 69 73 74 73 29 0a 09 20 20 20 20  t fexists)..    
06b0: 20 20 28 62 65 67 69 6e 0a 09 09 3b 3b 20 28 70    (begin...;; (p
06c0: 72 69 6e 74 20 22 66 75 6c 6c 6e 61 6d 65 3a 20  rint "fullname: 
06d0: 22 20 66 75 6c 6c 6e 61 6d 65 29 0a 09 09 28 69  " fullname)...(i
06e0: 66 20 28 73 64 61 74 2d 67 65 74 2d 64 65 62 75  f (sdat-get-debu
06f0: 67 6d 6f 64 65 20 73 3a 73 65 73 73 69 6f 6e 29  gmode s:session)
0700: 0a 09 09 20 20 20 20 28 73 3a 6c 6f 67 20 22 5c  ...    (s:log "\
0710: 6e 63 72 65 61 74 69 6e 67 20 66 75 6c 6c 64 69  ncreating fulldi
0720: 72 3a 20 22 20 66 75 6c 6c 64 69 72 29 29 0a 09  r: " fulldir))..
0730: 09 28 74 77 69 6b 69 3a 72 65 67 69 73 74 65 72  .(twiki:register
0740: 2d 77 69 6b 69 20 6b 65 79 20 66 75 6c 6c 6e 61  -wiki key fullna
0750: 6d 65 29 0a 09 09 28 73 79 73 74 65 6d 20 28 63  me)...(system (c
0760: 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 22 20  onc "mkdir -p " 
0770: 66 75 6c 6c 64 69 72 29 29 20 3b 3b 20 63 72 65  fulldir)) ;; cre
0780: 61 74 65 20 74 68 65 20 70 61 74 68 0a 09 09 28  ate the path...(
0790: 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f  if (file-exists?
07a0: 20 66 70 61 74 68 29 0a 09 09 20 20 20 20 28 73   fpath)...    (s
07b0: 3a 6c 6f 67 20 22 4f 4b 3a 20 64 69 72 20 22 20  :log "OK: dir " 
07c0: 66 70 61 74 68 20 22 20 68 61 73 20 62 65 65 6e  fpath " has been
07d0: 20 6d 61 64 65 22 29 0a 09 09 20 20 20 20 28 73   made")...    (s
07e0: 3a 6c 6f 67 20 22 45 52 52 4f 52 3a 20 46 61 69  :log "ERROR: Fai
07f0: 6c 65 64 20 74 6f 20 6d 61 6b 65 20 74 68 65 20  led to make the 
0800: 70 61 74 68 20 66 6f 72 20 74 68 65 20 74 77 69  path for the twi
0810: 6b 69 22 29 29 0a 09 09 28 73 65 74 21 20 64 62  ki"))...(set! db
0820: 20 28 64 62 69 3a 6f 70 65 6e 20 27 73 71 6c 69   (dbi:open 'sqli
0830: 74 65 33 20 28 6c 69 73 74 20 28 63 6f 6e 73 20  te3 (list (cons 
0840: 27 64 62 6e 61 6d 65 20 66 75 6c 6c 6e 61 6d 65  'dbname fullname
0850: 29 29 29 29 0a 09 09 28 66 6f 72 2d 65 61 63 68  ))))...(for-each
0860: 20 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 73 71   ... (lambda (sq
0870: 72 79 29 0a 09 09 20 20 20 3b 3b 20 28 70 72 69  ry)...   ;; (pri
0880: 6e 74 20 73 71 72 79 29 0a 09 09 20 20 20 28 64  nt sqry)...   (d
0890: 62 69 3a 65 78 65 63 20 64 62 20 73 71 72 79 29  bi:exec db sqry)
08a0: 29 0a 09 09 20 3b 3b 20 74 79 70 65 73 3a 20 30  )... ;; types: 0
08b0: 20 74 65 78 74 2c 20 31 20 6a 70 67 2c 20 32 20   text, 1 jpg, 2 
08c0: 70 6e 67 2c 20 33 20 73 76 67 2c 20 34 20 73 70  png, 3 svg, 4 sp
08d0: 72 65 61 64 73 68 65 65 74 2c 20 35 20 61 75 64  readsheet, 5 aud
08e0: 69 6f 2c 20 36 20 76 69 64 65 6f 20 3a 3a 20 62  io, 6 video :: b
08f0: 65 74 74 65 72 20 73 70 65 63 73 20 74 6f 20 63  etter specs to c
0900: 6f 6d 65 2e 2e 2e 0a 09 09 20 28 6c 69 73 74 0a  ome...... (list.
0910: 09 09 20 20 22 43 52 45 41 54 45 20 54 41 42 4c  ..  "CREATE TABL
0920: 45 20 70 69 63 73 20 20 20 20 20 20 28 69 64 20  E pics      (id 
0930: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20  INTEGER PRIMARY 
0940: 4b 45 59 2c 6e 61 6d 65 20 54 45 58 54 2c 77 69  KEY,name TEXT,wi
0950: 6b 69 5f 69 64 20 49 4e 54 45 47 45 52 2c 64 61  ki_id INTEGER,da
0960: 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 74 68 75  t_id INTEGER,thu
0970: 6d 62 5f 64 61 74 5f 69 64 20 49 4e 54 45 47 45  mb_dat_id INTEGE
0980: 52 2c 63 72 65 61 74 65 64 5f 6f 6e 20 49 4e 54  R,created_on INT
0990: 45 47 45 52 2c 6f 77 6e 65 72 5f 69 64 20 49 4e  EGER,owner_id IN
09a0: 54 45 47 45 52 29 3b 22 0a 09 09 20 20 22 43 52  TEGER);"...  "CR
09b0: 45 41 54 45 20 54 41 42 4c 45 20 64 61 74 73 20  EATE TABLE dats 
09c0: 20 20 20 20 20 28 69 64 20 49 4e 54 45 47 45 52       (id INTEGER
09d0: 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 6d 64 35   PRIMARY KEY,md5
09e0: 73 75 6d 20 54 45 58 54 2c 64 61 74 20 42 4c 4f  sum TEXT,dat BLO
09f0: 42 2c 74 79 70 65 20 49 4e 54 45 47 45 52 29 3b  B,type INTEGER);
0a00: 22 0a 09 09 20 20 3b 3b 20 6f 6e 20 65 76 65 72  "...  ;; on ever
0a10: 79 20 6d 6f 64 69 66 69 63 61 74 69 6f 6e 20 61  y modification a
0a20: 20 6e 65 77 20 74 69 64 64 6c 65 72 73 20 65 6e   new tiddlers en
0a30: 74 72 79 20 69 73 20 63 72 65 61 74 65 64 2e 20  try is created. 
0a40: 57 68 65 6e 20 64 69 73 70 6c 61 79 69 6e 67 20  When displaying 
0a50: 74 68 65 20 74 69 64 64 6c 65 72 73 20 64 6f 3a  the tiddlers do:
0a60: 0a 09 09 20 20 3b 3b 20 20 20 20 73 65 6c 65 63  ...  ;;    selec
0a70: 74 20 77 68 65 72 65 20 63 72 65 61 74 65 64 5f  t where created_
0a80: 6f 6e 20 3c 20 73 6f 6d 65 64 61 74 65 20 6f 72  on < somedate or
0a90: 64 65 72 20 62 79 20 63 72 65 61 74 65 64 5f 6f  der by created_o
0aa0: 6e 20 64 65 73 63 20 6c 69 6d 69 74 20 31 0a 09  n desc limit 1..
0ab0: 09 20 20 22 43 52 45 41 54 45 20 54 41 42 4c 45  .  "CREATE TABLE
0ac0: 20 74 69 64 64 6c 65 72 73 20 28 69 64 20 49 4e   tiddlers (id IN
0ad0: 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45  TEGER PRIMARY KE
0ae0: 59 2c 77 69 6b 69 5f 69 64 20 49 4e 54 45 47 45  Y,wiki_id INTEGE
0af0: 52 2c 6e 61 6d 65 20 54 45 58 54 2c 72 65 76 20  R,name TEXT,rev 
0b00: 49 4e 54 45 47 45 52 2c 64 61 74 5f 69 64 20 49  INTEGER,dat_id I
0b10: 4e 54 45 47 45 52 2c 63 72 65 61 74 65 64 5f 6f  NTEGER,created_o
0b20: 6e 20 49 4e 54 45 47 45 52 2c 6f 77 6e 65 72 5f  n INTEGER,owner_
0b30: 69 64 20 49 4e 54 45 47 45 52 29 3b 22 0a 09 09  id INTEGER);"...
0b40: 20 20 3b 3b 20 72 65 76 20 61 6e 64 20 74 61 67    ;; rev and tag
0b50: 20 6f 6e 6c 79 20 75 74 69 6c 69 7a 65 64 20 77   only utilized w
0b60: 68 65 6e 20 75 73 65 72 20 73 65 74 73 20 61 20  hen user sets a 
0b70: 74 61 67 2e 20 41 6c 6c 20 72 65 73 75 6c 74 73  tag. All results
0b80: 20 66 72 6f 6d 20 61 20 73 65 6c 65 63 74 20 61   from a select a
0b90: 73 20 61 62 6f 76 65 20 66 6f 72 20 74 69 64 64  s above for tidd
0ba0: 6c 65 72 73 20 61 72 65 20 73 65 74 20 74 6f 20  lers are set to 
0bb0: 74 68 65 20 74 61 67 0a 09 09 20 20 22 43 52 45  the tag...  "CRE
0bc0: 41 54 45 20 54 41 42 4c 45 20 72 65 76 73 20 20  ATE TABLE revs  
0bd0: 20 20 20 28 69 64 20 49 4e 54 45 47 45 52 20 50     (id INTEGER P
0be0: 52 49 4d 41 52 59 20 4b 45 59 2c 74 61 67 20 54  RIMARY KEY,tag T
0bf0: 45 58 54 29 3b 22 0a 09 09 20 20 3b 3b 20 77 69  EXT);"...  ;; wi
0c00: 6b 69 73 20 69 73 20 68 65 72 65 20 66 6f 72 20  kis is here for 
0c10: 77 68 65 6e 20 70 6f 73 74 67 72 65 73 71 6c 20  when postgresql 
0c20: 73 75 70 70 6f 72 74 20 69 73 20 61 64 64 65 64  support is added
0c30: 20 6f 72 20 69 66 20 61 20 73 75 62 20 77 69 6b   or if a sub wik
0c40: 69 20 69 73 20 63 72 65 61 74 65 64 2e 20 0a 09  i is created. ..
0c50: 09 20 20 22 43 52 45 41 54 45 20 54 41 42 4c 45  .  "CREATE TABLE
0c60: 20 77 69 6b 69 73 20 20 20 20 28 69 64 20 49 4e   wikis    (id IN
0c70: 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45  TEGER PRIMARY KE
0c80: 59 2c 6e 61 6d 65 20 54 45 58 54 2c 63 72 65 61  Y,name TEXT,crea
0c90: 74 65 64 5f 6f 6e 20 49 4e 54 45 47 45 52 29 3b  ted_on INTEGER);
0ca0: 22 0a 09 09 20 20 3b 3b 20 61 63 63 65 73 73 20  "...  ;; access 
0cb0: 63 6f 6e 74 72 6f 6c 2c 20 6e 65 67 61 74 69 76  control, negativ
0cc0: 65 20 6e 75 6d 62 65 72 65 64 20 67 72 6f 75 70  e numbered group
0cd0: 73 20 61 72 65 20 70 72 69 76 61 74 65 20 67 72  s are private gr
0ce0: 6f 75 70 73 2c 20 70 6f 73 74 69 76 65 20 6e 75  oups, postive nu
0cf0: 6d 62 65 72 65 64 20 67 72 6f 75 70 73 20 61 72  mbered groups ar
0d00: 65 20 73 79 73 74 65 6d 20 67 72 6f 75 70 73 0a  e system groups.
0d10: 09 09 20 20 3b 3b 20 70 65 72 6d 69 73 73 69 6f  ..  ;; permissio
0d20: 6e 73 20 61 72 65 20 6f 6e 20 61 20 70 65 72 2d  ns are on a per-
0d30: 77 69 6b 69 20 67 72 61 6e 75 6c 61 72 69 74 79  wiki granularity
0d40: 0a 09 09 20 20 3b 3b 20 61 63 63 65 73 73 3b 20  ...  ;; access; 
0d50: 30 3d 6e 6f 6e 65 2c 31 3d 72 65 61 64 2c 32 3d  0=none,1=read,2=
0d60: 72 65 61 64 2f 77 72 69 74 65 0a 09 09 20 20 22  read/write...  "
0d70: 43 52 45 41 54 45 20 54 41 42 4c 45 20 70 65 72  CREATE TABLE per
0d80: 6d 73 20 20 20 20 28 69 64 20 49 4e 54 45 47 45  ms    (id INTEGE
0d90: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 77 69  R PRIMARY KEY,wi
0da0: 6b 69 5f 69 64 20 49 4e 54 45 47 45 52 2c 67 72  ki_id INTEGER,gr
0db0: 6f 75 70 5f 69 64 20 49 4e 54 45 47 45 52 2c 61  oup_id INTEGER,a
0dc0: 63 63 65 73 73 20 49 4e 54 45 47 45 52 29 3b 22  ccess INTEGER);"
0dd0: 0a 09 09 20 20 22 43 52 45 41 54 45 20 54 41 42  ...  "CREATE TAB
0de0: 4c 45 20 67 72 6f 75 70 73 20 20 20 28 69 64 20  LE groups   (id 
0df0: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20  INTEGER PRIMARY 
0e00: 4b 45 59 2c 6e 61 6d 65 20 54 45 58 54 29 3b 22  KEY,name TEXT);"
0e10: 0a 09 09 20 20 22 43 52 45 41 54 45 20 54 41 42  ...  "CREATE TAB
0e20: 4c 45 20 6d 65 6d 62 65 72 73 20 20 28 69 64 20  LE members  (id 
0e30: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20  INTEGER PRIMARY 
0e40: 4b 45 59 2c 70 65 72 73 6f 6e 5f 69 64 20 49 4e  KEY,person_id IN
0e50: 54 45 47 45 52 2c 67 72 6f 75 70 5f 69 64 20 49  TEGER,group_id I
0e60: 4e 54 45 47 45 52 29 3b 22 0a 09 09 20 20 3b 3b  NTEGER);"...  ;;
0e70: 20 73 65 74 75 70 20 61 6e 64 20 63 6f 6e 66 69   setup and confi
0e80: 67 75 72 61 74 69 6f 6e 20 64 61 74 61 0a 09 09  guration data...
0e90: 20 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20    "CREATE TABLE 
0ea0: 6d 65 74 61 20 20 20 20 20 28 69 64 20 49 4e 54  meta     (id INT
0eb0: 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59  EGER PRIMARY KEY
0ec0: 2c 6b 65 79 20 54 45 58 54 2c 76 61 6c 20 54 45  ,key TEXT,val TE
0ed0: 58 54 29 3b 22 0a 09 09 20 20 3b 3b 20 6e 65 65  XT);"...  ;; nee
0ee0: 64 20 74 6f 20 63 72 65 61 74 65 20 61 6e 20 65  d to create an e
0ef0: 6e 74 72 79 20 66 6f 72 20 2a 74 68 69 73 2a 20  ntry for *this* 
0f00: 74 77 69 6b 69 0a 09 09 20 20 28 63 6f 6e 63 20  twiki...  (conc 
0f10: 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 77 69 6b  "INSERT INTO wik
0f20: 69 73 20 28 69 64 2c 6e 61 6d 65 2c 63 72 65 61  is (id,name,crea
0f30: 74 65 64 5f 6f 6e 29 20 56 41 4c 55 45 53 20 28  ted_on) VALUES (
0f40: 31 2c 27 6d 61 69 6e 27 2c 22 20 28 63 75 72 72  1,'main'," (curr
0f50: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 22 29 3b  ent-seconds) ");
0f60: 22 29 29 29 0a 09 09 3b 3b 20 20 20 20 20 28 63  ")))...;;     (c
0f70: 6f 6e 63 20 22 49 4e 53 45 52 54 20 49 4e 54 4f  onc "INSERT INTO
0f80: 20 74 69 64 64 6c 65 72 73 20 28 77 69 6b 69 5f   tiddlers (wiki_
0f90: 69 64 2c 6e 61 6d 65 2c 63 72 65 61 74 65 64 5f  id,name,created_
0fa0: 6f 6e 29 20 56 41 4c 55 45 53 28 31 2c 27 4d 61  on) VALUES(1,'Ma
0fb0: 69 6e 4d 65 6e 75 27 2c 22 20 28 63 75 72 72 65  inMenu'," (curre
0fc0: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 22 29 3b 22  nt-seconds) ");"
0fd0: 29 29 29 29 29 0a 09 09 28 74 77 69 6b 69 3a 73  )))))...(twiki:s
0fe0: 61 76 65 2d 74 69 64 64 6c 65 72 20 64 62 20 22  ave-tiddler db "
0ff0: 4d 61 69 6e 4d 65 6e 75 22 20 22 5b 5b 46 69 72  MainMenu" "[[Fir
1000: 73 74 54 69 64 64 6c 65 72 5d 5d 22 20 22 22 20  stTiddler]]" "" 
1010: 31 20 31 29 29 29 0a 09 20 20 3b 3b 20 28 73 71  1 1)))..  ;; (sq
1020: 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 79 2d 74  lite3:set-busy-t
1030: 69 6d 65 6f 75 74 21 28 64 62 69 3a 64 62 2d 63  imeout!(dbi:db-c
1040: 6f 6e 6e 20 64 62 29 20 31 30 30 30 30 30 30 29  onn db) 1000000)
1050: 0a 09 20 20 64 62 29 29 29 29 0a 0a 3b 3b 3d 3d  ..  db))))..;;==
1060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10a0: 3d 3d 3d 3d 0a 3b 3b 20 74 77 69 6b 69 73 20 28  ====.;; twikis (
10b0: 64 62 20 6e 61 6d 69 6e 67 2c 20 73 71 6c 69 74  db naming, sqlit
10c0: 65 20 76 73 20 70 6f 73 74 67 72 65 73 71 6c 2c  e vs postgresql,
10d0: 20 6b 65 79 73 20 65 74 63 2e 0a 3b 3b 3d 3d 3d   keys etc..;;===
10e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
10f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1120: 3d 3d 3d 0a 0a 3b 3b 20 41 20 77 69 6b 69 20 69  ===..;; A wiki i
1130: 73 20 73 70 65 63 69 66 69 65 64 20 62 79 20 61  s specified by a
1140: 20 6c 69 73 74 20 6f 66 20 6b 65 79 73 2c 20 68   list of keys, h
1150: 65 72 65 20 77 65 20 63 6f 6e 76 65 72 74 20 74  ere we convert t
1160: 68 61 74 20 6c 69 73 74 20 74 6f 20 61 20 73 69  hat list to a si
1170: 6e 67 6c 65 20 73 74 72 69 6e 67 0a 28 64 65 66  ngle string.(def
1180: 69 6e 65 20 28 74 77 69 6b 69 3a 6b 65 79 73 2d  ine (twiki:keys-
1190: 3e 6b 65 79 20 6b 65 79 73 29 0a 20 20 28 69 66  >key keys).  (if
11a0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 6b 65 79   (not (null? key
11b0: 73 29 29 0a 20 20 20 20 20 20 28 73 74 72 69 6e  s)).      (strin
11c0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d  g-intersperse (m
11d0: 61 70 20 63 6f 6e 63 20 6b 65 79 73 29 20 22 20  ap conc keys) " 
11e0: 22 29 0a 20 20 20 20 20 20 22 20 22 29 29 0a 0a  ").      " "))..
11f0: 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 6b  (define (twiki:k
1200: 65 79 2d 3e 66 6e 61 6d 65 20 6b 65 79 29 0a 20  ey->fname key). 
1210: 20 28 6c 65 74 2a 20 28 3b 3b 20 28 6d 64 35 6b   (let* (;; (md5k
1220: 65 79 70 61 74 68 20 28 6d 64 35 3a 64 69 67 65  eypath (md5:dige
1230: 73 74 20 6b 65 79 29 29 20 3b 3b 20 28 74 77 69  st key)) ;; (twi
1240: 6b 69 3a 6b 65 79 73 2d 3e 6b 65 79 20 6b 65 79  ki:keys->key key
1250: 73 29 29 29 0a 09 20 28 6b 65 79 70 61 74 68 20  s))).. (keypath 
1260: 20 20 20 28 74 77 69 6b 69 3a 77 65 62 36 34 65     (twiki:web64e
1270: 6e 63 20 6b 65 79 29 29 0a 09 20 28 64 65 6c 74  nc key)).. (delt
1280: 61 20 20 20 20 20 20 28 71 75 6f 74 69 65 6e 74  a      (quotient
1290: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20   (string-length 
12a0: 6b 65 79 70 61 74 68 29 20 33 29 29 20 3b 3b 20  keypath) 3)) ;; 
12b0: 0a 09 20 28 70 31 20 20 20 20 20 20 20 20 20 28  .. (p1         (
12c0: 73 75 62 73 74 72 69 6e 67 20 6b 65 79 70 61 74  substring keypat
12d0: 68 20 30 20 20 20 20 20 20 20 20 20 20 20 64 65  h 0           de
12e0: 6c 74 61 29 29 20 3b 3b 20 20 30 20 20 38 29 29  lta)) ;;  0  8))
12f0: 0a 09 20 28 70 32 20 20 20 20 20 20 20 20 20 28  .. (p2         (
1300: 73 75 62 73 74 72 69 6e 67 20 6b 65 79 70 61 74  substring keypat
1310: 68 20 64 65 6c 74 61 20 20 20 20 20 20 20 28 2a  h delta       (*
1320: 20 64 65 6c 74 61 20 32 29 29 29 3b 3b 20 20 38   delta 2)));;  8
1330: 20 31 36 29 29 0a 09 20 28 70 33 20 20 20 20 20   16)).. (p3     
1340: 20 20 20 20 28 73 75 62 73 74 72 69 6e 67 20 6b      (substring k
1350: 65 79 70 61 74 68 20 28 2a 20 64 65 6c 74 61 20  eypath (* delta 
1360: 32 29 20 28 2a 20 64 65 6c 74 61 20 33 29 29 29  2) (* delta 3)))
1370: 29 20 3b 3b 20 31 36 20 32 34 29 29 0a 20 20 20  ) ;; 16 24)).   
1380: 20 28 6c 69 73 74 20 28 73 74 72 69 6e 67 2d 69   (list (string-i
1390: 6e 74 65 72 73 70 65 72 73 65 20 28 6c 69 73 74  ntersperse (list
13a0: 20 22 64 62 73 22 20 70 31 20 70 32 20 70 33 29   "dbs" p1 p2 p3)
13b0: 20 22 2f 22 29 20 6b 65 79 70 61 74 68 29 29 29   "/") keypath)))
13c0: 0a 0a 3b 3b 20 6c 6f 6f 6b 20 75 70 20 74 68 65  ..;; look up the
13d0: 20 77 69 64 20 62 61 73 65 64 20 6f 6e 20 74 68   wid based on th
13e0: 65 20 6b 65 79 73 2c 20 74 68 69 73 20 69 73 20  e keys, this is 
13f0: 75 73 65 64 20 66 6f 72 20 73 75 62 20 77 69 6b  used for sub wik
1400: 69 73 20 6f 6e 6c 79 2e 20 49 2e 65 2e 20 61 20  is only. I.e. a 
1410: 77 69 6b 69 20 69 6e 73 74 61 6e 74 69 61 74 65  wiki instantiate
1420: 64 20 69 6e 73 69 64 65 20 61 6e 6f 74 68 65 72  d inside another
1430: 20 77 69 6b 69 20 0a 3b 3b 20 67 69 76 69 6e 67   wiki .;; giving
1440: 20 61 20 73 65 70 61 72 61 74 65 20 6e 61 6d 65   a separate name
1450: 73 70 61 63 65 20 74 6f 20 61 6c 6c 20 74 68 65  space to all the
1460: 20 74 69 64 64 6c 65 72 73 0a 28 64 65 66 69 6e   tiddlers.(defin
1470: 65 20 28 74 77 69 6b 69 3a 6e 61 6d 65 2d 3e 77  e (twiki:name->w
1480: 69 64 20 64 62 20 6e 61 6d 65 29 20 0a 20 20 28  id db name) .  (
1490: 6c 65 74 20 28 28 77 69 64 20 28 64 62 69 3a 67  let ((wid (dbi:g
14a0: 65 74 2d 6f 6e 65 20 64 62 20 22 53 45 4c 45 43  et-one db "SELEC
14b0: 54 20 69 64 20 46 52 4f 4d 20 77 69 6b 69 73 20  T id FROM wikis 
14c0: 57 48 45 52 45 20 6e 61 6d 65 3d 3f 3b 22 20 6e  WHERE name=?;" n
14d0: 61 6d 65 29 29 29 0a 20 20 20 20 28 69 66 20 77  ame))).    (if w
14e0: 69 64 20 77 69 64 0a 09 28 62 65 67 69 6e 0a 09  id wid..(begin..
14f0: 20 20 28 64 62 69 3a 65 78 65 63 20 64 62 20 22    (dbi:exec db "
1500: 49 4e 53 45 52 54 20 49 4e 54 4f 20 77 69 6b 69  INSERT INTO wiki
1510: 73 20 28 6e 61 6d 65 2c 63 72 65 61 74 65 64 5f  s (name,created_
1520: 6f 6e 29 20 56 41 4c 55 45 53 28 3f 2c 3f 29 3b  on) VALUES(?,?);
1530: 22 20 6e 61 6d 65 20 28 63 75 72 72 65 6e 74 2d  " name (current-
1540: 73 65 63 6f 6e 64 73 29 29 0a 09 20 20 28 74 77  seconds))..  (tw
1550: 69 6b 69 3a 6e 61 6d 65 2d 3e 77 69 64 20 64 62  iki:name->wid db
1560: 20 6e 61 6d 65 29 29 29 29 29 0a 0a 3b 3b 3d 3d   name)))))..;;==
1570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
15a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
15b0: 3d 3d 3d 3d 0a 3b 3b 20 74 77 69 6b 69 20 72 65  ====.;; twiki re
15c0: 63 6f 72 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d  cord.;;=========
15d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
15e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
15f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b  =============..;
1610: 3b 20 6d 61 6b 65 2d 76 65 63 74 6f 72 2d 72 65  ; make-vector-re
1620: 63 6f 72 64 20 74 77 69 6b 69 20 77 69 6b 69 20  cord twiki wiki 
1630: 77 69 64 20 6e 61 6d 65 20 6b 65 79 20 64 62 68  wid name key dbh
1640: 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 74  .(define (make-t
1650: 77 69 6b 69 3a 77 69 6b 69 29 28 6d 61 6b 65 2d  wiki:wiki)(make-
1660: 76 65 63 74 6f 72 20 35 29 29 0a 28 64 65 66 69  vector 5)).(defi
1670: 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 77 69 6b 69  ne-inline (twiki
1680: 3a 77 69 6b 69 2d 67 65 74 2d 77 69 64 20 20 20  :wiki-get-wid   
1690: 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72   vec)    (vector
16a0: 2d 72 65 66 20 20 76 65 63 20 30 29 29 0a 28 64  -ref  vec 0)).(d
16b0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 77  efine-inline (tw
16c0: 69 6b 69 3a 77 69 6b 69 2d 67 65 74 2d 6e 61 6d  iki:wiki-get-nam
16d0: 65 20 20 20 76 65 63 29 20 20 20 20 28 76 65 63  e   vec)    (vec
16e0: 74 6f 72 2d 72 65 66 20 20 76 65 63 20 31 29 29  tor-ref  vec 1))
16f0: 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20  .(define-inline 
1700: 28 74 77 69 6b 69 3a 77 69 6b 69 2d 67 65 74 2d  (twiki:wiki-get-
1710: 6b 65 79 20 20 20 20 76 65 63 29 20 20 20 20 28  key    vec)    (
1720: 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20  vector-ref  vec 
1730: 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69  2)).(define-inli
1740: 6e 65 20 28 74 77 69 6b 69 3a 77 69 6b 69 2d 67  ne (twiki:wiki-g
1750: 65 74 2d 64 62 68 20 20 20 20 76 65 63 29 20 20  et-dbh    vec)  
1760: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76    (vector-ref  v
1770: 65 63 20 33 29 29 0a 28 64 65 66 69 6e 65 2d 69  ec 3)).(define-i
1780: 6e 6c 69 6e 65 20 28 74 77 69 6b 69 3a 77 69 6b  nline (twiki:wik
1790: 69 2d 67 65 74 2d 70 65 72 6d 73 20 20 76 65 63  i-get-perms  vec
17a0: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66  )    (vector-ref
17b0: 20 20 76 65 63 20 34 29 29 0a 0a 28 64 65 66 69    vec 4))..(defi
17c0: 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 77 69 6b 69  ne-inline (twiki
17d0: 3a 77 69 6b 69 2d 73 65 74 2d 77 69 64 21 20 20  :wiki-set-wid!  
17e0: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72   vec val)(vector
17f0: 2d 73 65 74 21 20 76 65 63 20 30 20 76 61 6c 29  -set! vec 0 val)
1800: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65  ).(define-inline
1810: 20 28 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74   (twiki:wiki-set
1820: 2d 6e 61 6d 65 21 20 20 76 65 63 20 76 61 6c 29  -name!  vec val)
1830: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63  (vector-set! vec
1840: 20 31 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65   1 val)).(define
1850: 2d 69 6e 6c 69 6e 65 20 28 74 77 69 6b 69 3a 77  -inline (twiki:w
1860: 69 6b 69 2d 73 65 74 2d 6b 65 79 21 20 20 20 76  iki-set-key!   v
1870: 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73  ec val)(vector-s
1880: 65 74 21 20 76 65 63 20 32 20 76 61 6c 29 29 0a  et! vec 2 val)).
1890: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28  (define-inline (
18a0: 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 2d 64  twiki:wiki-set-d
18b0: 62 68 21 20 20 20 76 65 63 20 76 61 6c 29 28 76  bh!   vec val)(v
18c0: 65 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 33  ector-set! vec 3
18d0: 20 76 61 6c 29 29 0a 28 64 65 66 69 6e 65 2d 69   val)).(define-i
18e0: 6e 6c 69 6e 65 20 28 74 77 69 6b 69 3a 77 69 6b  nline (twiki:wik
18f0: 69 2d 73 65 74 2d 70 65 72 6d 73 21 20 76 65 63  i-set-perms! vec
1900: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74   val)(vector-set
1910: 21 20 76 65 63 20 34 20 76 61 6c 29 29 0a 0a 3b  ! vec 4 val))..;
1920: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;===============
1930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1960: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 74 77 69 6b 69  =======.;; twiki
1970: 20 6d 69 73 63 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d   misc.;;========
1980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
19a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
19b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a  ==============..
19c0: 3b 3b 20 72 65 74 75 72 6e 73 20 68 65 6c 70 20  ;; returns help 
19d0: 68 74 6d 6c 0a 28 64 65 66 69 6e 65 20 28 74 77  html.(define (tw
19e0: 69 6b 69 3a 68 65 6c 70 20 73 65 63 74 69 6f 6e  iki:help section
19f0: 29 0a 20 20 28 6c 65 74 20 28 28 6d 61 69 6e 20  ).  (let ((main 
1a00: 28 74 77 69 6b 69 3a 64 69 76 20 0a 09 20 20 20  (twiki:div ..   
1a10: 20 20 20 20 27 6e 6f 64 65 20 22 74 77 69 6b 69      'node "twiki
1a20: 2d 68 65 6c 70 22 0a 09 20 20 20 20 20 20 20 28  -help"..       (
1a30: 6c 69 73 74 20 0a 09 09 28 74 77 69 6b 69 3a 68  list ...(twiki:h
1a40: 33 20 22 48 65 6c 70 20 73 74 75 66 66 22 29 0a  3 "Help stuff").
1a50: 09 09 28 74 77 69 6b 69 3a 70 72 65 20 22 0a 4c  ..(twiki:pre ".L
1a60: 69 6e 6b 20 74 6f 20 70 61 67 65 3a 20 20 20 20  ink to page:    
1a70: 20 20 5b 5b 50 61 67 65 20 54 69 74 6c 65 5d 5d    [[Page Title]]
1a80: 0a 48 65 61 64 69 6e 67 33 3a 20 20 20 20 20 20  .Heading3:      
1a90: 20 20 20 20 21 21 21 20 54 68 65 20 68 65 61 64      !!! The head
1aa0: 69 6e 67 0a 55 6e 64 65 72 6c 69 6e 65 3a 20 20  ing.Underline:  
1ab0: 20 20 20 20 20 20 20 5f 5f 75 6e 64 65 72 6c 69         __underli
1ac0: 6e 65 64 5f 5f 0a 54 61 62 6c 65 3a 20 20 20 20  ned__.Table:    
1ad0: 20 20 20 20 20 20 20 20 20 7c 20 63 65 6c 6c 31           | cell1
1ae0: 20 7c 20 63 65 6c 6c 32 20 7c 0a 4c 69 73 74 3a   | cell2 |.List:
1af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 20                # 
1b00: 69 74 65 6d 31 0a 20 20 20 20 20 20 20 20 20 20  item1.          
1b10: 20 20 20 20 20 20 20 20 20 23 23 20 69 74 65 6d           ## item
1b20: 32 0a 42 75 6c 6c 65 74 3a 20 20 20 20 20 20 20  2.Bullet:       
1b30: 20 20 20 20 20 2a 20 69 74 65 6d 31 0a 20 20 20       * item1.   
1b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1b50: 2a 2a 20 69 74 65 6d 32 0a 50 72 65 66 6f 72 6d  ** item2.Preform
1b60: 61 74 74 65 64 3a 20 20 20 20 20 20 7b 7b 7b 73  atted:      {{{s
1b70: 74 75 66 66 20 68 65 72 65 7d 7d 7d 0a 49 6e 73  tuff here}}}.Ins
1b80: 65 72 74 20 61 20 70 69 63 74 75 72 65 3a 20 20  ert a picture:  
1b90: 5b 70 69 63 5b 50 69 63 4e 61 6d 65 5d 5d 0a 4f  [pic[PicName]].O
1ba0: 72 20 77 69 74 68 20 73 69 7a 65 3a 20 20 20 20  r with size:    
1bb0: 20 20 5b 70 69 63 31 30 30 78 31 30 30 5b 50 69    [pic100x100[Pi
1bc0: 63 4e 61 6d 65 5d 5d 0a 55 70 6c 6f 61 64 20 74  cName]].Upload t
1bd0: 68 65 20 70 69 63 74 75 72 65 20 75 73 69 6e 67  he picture using
1be0: 20 74 68 65 20 5c 22 50 69 63 5c 22 20 6c 69 6e   the \"Pic\" lin
1bf0: 6b 20 66 69 72 73 74 22 29 29 29 29 29 0a 09 3b  k first")))))..;
1c00: 3b 28 63 61 73 65 20 73 65 63 74 69 6f 6e 0a 20  ;(case section. 
1c10: 20 20 20 6d 61 69 6e 29 29 0a 0a 3b 3b 3d 3d 3d     main))..;;===
1c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1c60: 3d 3d 3d 0a 3b 3b 20 74 77 69 6b 69 20 61 63 63  ===.;; twiki acc
1c70: 65 73 73 20 63 6f 6e 74 72 6f 6c 0a 3b 3b 3d 3d  ess control.;;==
1c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1cc0: 3d 3d 3d 3d 0a 0a 3b 3b 20 69 64 65 61 20 68 65  ====..;; idea he
1cd0: 72 65 20 69 73 20 66 6f 72 20 74 68 65 20 65 6e  re is for the en
1ce0: 64 20 75 73 65 72 20 74 6f 20 72 65 64 65 66 69  d user to redefi
1cf0: 6e 65 20 74 68 69 73 20 72 6f 75 74 69 6e 65 2c  ne this routine,
1d00: 0a 3b 3b 20 61 6e 64 20 63 61 6c 6c 20 74 77 69  .;; and call twi
1d10: 6b 69 3a 69 6e 74 65 72 61 6c 2d 61 63 63 65 73  ki:interal-acces
1d20: 73 20 69 66 20 64 65 73 69 72 65 64 0a 3b 3b 20  s if desired.;; 
1d30: 0a 3b 3b 20 69 66 20 6f 76 65 72 72 69 64 65 20  .;; if override 
1d40: 69 73 20 23 74 20 74 68 65 6e 20 67 69 76 65 20  is #t then give 
1d50: 61 63 63 65 73 73 20 6e 6f 20 6d 61 74 74 65 72  access no matter
1d60: 20 77 68 61 74 0a 28 64 65 66 69 6e 65 20 28 74   what.(define (t
1d70: 77 69 6b 69 3a 61 63 63 65 73 73 20 6b 65 79 73  wiki:access keys
1d80: 20 77 69 6b 69 2d 6e 61 6d 65 20 75 73 65 72 2d   wiki-name user-
1d90: 69 64 29 0a 20 20 27 28 72 20 77 29 29 0a 0a 3b  id).  '(r w))..;
1da0: 3b 20 41 64 64 20 73 75 70 70 6f 72 74 20 66 6f  ; Add support fo
1db0: 72 20 73 74 6f 72 69 6e 67 20 67 72 6f 75 70 73  r storing groups
1dc0: 2c 20 75 73 65 72 73 20 61 6e 64 20 61 63 63 65  , users and acce
1dd0: 73 73 20 69 6e 74 65 72 6e 61 6c 6c 79 0a 3b 3b  ss internally.;;
1de0: 20 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69   .(define (twiki
1df0: 3a 69 6e 74 65 72 6e 61 6c 2d 61 63 63 65 73 73  :internal-access
1e00: 20 6b 65 79 73 20 77 69 6b 69 2d 6e 61 6d 65 20   keys wiki-name 
1e10: 75 73 65 72 2d 69 64 29 0a 20 20 23 66 29 0a 0a  user-id).  #f)..
1e20: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;;==============
1e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1e60: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 74 77 69 6b  ========.;; twik
1e70: 69 20 72 65 67 69 73 74 72 79 0a 3b 3b 3d 3d 3d  i registry.;;===
1e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
1ec0: 3d 3d 3d 0a 0a 3b 3b 20 74 68 65 73 65 20 63 61  ===..;; these ca
1ed0: 6e 20 62 65 20 6f 76 65 72 72 69 64 64 65 6e 20  n be overridden 
1ee0: 62 79 20 65 6e 64 20 75 73 65 72 20 28 6a 75 73  by end user (jus
1ef0: 74 20 63 72 65 61 74 65 20 61 20 6e 65 77 20 72  t create a new r
1f00: 6f 75 74 69 6e 65 20 62 79 20 74 68 65 20 73 61  outine by the sa
1f10: 6d 65 20 6e 61 6d 65 29 0a 0a 28 64 65 66 69 6e  me name)..(defin
1f20: 65 20 28 74 77 69 6b 69 3a 6f 70 65 6e 2d 72 65  e (twiki:open-re
1f30: 67 69 73 74 72 79 29 0a 20 20 28 6c 65 74 2a 20  gistry).  (let* 
1f40: 28 28 62 61 73 65 70 61 74 68 20 20 28 73 64 61  ((basepath  (sda
1f50: 74 2d 67 65 74 2d 74 77 69 6b 69 64 69 72 20 73  t-get-twikidir s
1f60: 3a 73 65 73 73 69 6f 6e 29 29 0a 09 20 28 72 65  :session)).. (re
1f70: 67 66 69 6c 65 20 20 20 28 63 6f 6e 63 20 62 61  gfile   (conc ba
1f80: 73 65 70 61 74 68 20 22 2f 72 65 67 69 73 74 72  sepath "/registr
1f90: 79 2e 64 62 22 29 29 0a 09 20 28 72 65 67 65 78  y.db")).. (regex
1fa0: 69 73 74 73 20 28 66 69 6c 65 2d 65 78 69 73 74  ists (file-exist
1fb0: 73 3f 20 72 65 67 66 69 6c 65 29 29 0a 09 20 28  s? regfile)).. (
1fc0: 64 62 20 20 20 20 20 20 20 20 23 66 29 29 0a 20  db        #f)). 
1fd0: 20 20 20 28 69 66 20 28 73 64 61 74 2d 67 65 74     (if (sdat-get
1fe0: 2d 64 65 62 75 67 6d 6f 64 65 20 73 3a 73 65 73  -debugmode s:ses
1ff0: 73 69 6f 6e 29 0a 09 28 73 3a 6c 6f 67 20 22 72  sion)..(s:log "r
2000: 65 67 66 69 6c 65 3a 20 22 20 72 65 67 66 69 6c  egfile: " regfil
2010: 65 20 22 20 72 65 67 65 78 69 73 74 73 3a 20 22  e " regexists: "
2020: 20 72 65 67 65 78 69 73 74 73 20 22 20 64 62 3a   regexists " db:
2030: 20 22 20 64 62 29 29 0a 20 20 20 20 28 73 65 74   " db)).    (set
2040: 21 20 64 62 20 28 64 62 69 3a 6f 70 65 6e 20 27  ! db (dbi:open '
2050: 73 71 6c 69 74 65 33 20 28 6c 69 73 74 20 28 63  sqlite3 (list (c
2060: 6f 6e 73 20 27 64 62 6e 61 6d 65 20 72 65 67 66  ons 'dbname regf
2070: 69 6c 65 29 29 29 29 0a 20 20 20 20 28 69 66 20  ile)))).    (if 
2080: 72 65 67 65 78 69 73 74 73 0a 09 64 62 0a 09 28  regexists..db..(
2090: 62 65 67 69 6e 0a 09 20 20 28 66 6f 72 2d 65 61  begin..  (for-ea
20a0: 63 68 20 28 6c 61 6d 62 64 61 20 28 73 74 6d 74  ch (lambda (stmt
20b0: 29 28 64 62 69 3a 65 78 65 63 20 64 62 20 73 74  )(dbi:exec db st
20c0: 6d 74 29 29 0a 09 09 20 20 20 20 28 6c 69 73 74  mt))...    (list
20d0: 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 77   "CREATE TABLE w
20e0: 69 6b 69 73 20 28 6b 65 79 20 54 45 58 54 20 50  ikis (key TEXT P
20f0: 52 49 4d 41 52 59 20 4b 45 59 2c 70 61 74 68 20  RIMARY KEY,path 
2100: 54 45 58 54 2c 63 72 65 61 74 69 6f 6e 5f 64 61  TEXT,creation_da
2110: 74 65 20 49 4e 54 45 47 45 52 2c 63 72 65 61 74  te INTEGER,creat
2120: 6f 72 5f 69 64 20 49 4e 54 45 47 45 52 29 3b 22  or_id INTEGER);"
2130: 29 29 0a 09 20 20 64 62 29 29 29 29 0a 0a 28 64  ))..  db))))..(d
2140: 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 72 65 67  efine (twiki:reg
2150: 69 73 74 65 72 2d 77 69 6b 69 20 6b 65 79 20 70  ister-wiki key p
2160: 61 74 68 29 0a 20 20 28 6c 65 74 20 28 28 64 62  ath).  (let ((db
2170: 20 28 74 77 69 6b 69 3a 6f 70 65 6e 2d 72 65 67   (twiki:open-reg
2180: 69 73 74 72 79 29 29 29 0a 20 20 20 20 28 64 62  istry))).    (db
2190: 69 3a 65 78 65 63 20 64 62 20 0a 09 20 20 20 20  i:exec db ..    
21a0: 20 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50    "INSERT OR REP
21b0: 4c 41 43 45 20 49 4e 54 4f 20 77 69 6b 69 73 20  LACE INTO wikis 
21c0: 28 6b 65 79 2c 70 61 74 68 2c 63 72 65 61 74 69  (key,path,creati
21d0: 6f 6e 5f 64 61 74 65 2c 63 72 65 61 74 6f 72 5f  on_date,creator_
21e0: 69 64 29 20 56 41 4c 55 45 53 28 3f 2c 3f 2c 3f  id) VALUES(?,?,?
21f0: 2c 3f 29 3b 22 0a 09 20 20 20 20 20 20 6b 65 79  ,?);"..      key
2200: 20 70 61 74 68 20 28 63 75 72 72 65 6e 74 2d 73   path (current-s
2210: 65 63 6f 6e 64 73 29 20 28 74 77 69 6b 69 3a 67  econds) (twiki:g
2220: 65 74 2d 69 64 29 29 0a 20 20 20 20 28 64 62 69  et-id)).    (dbi
2230: 3a 63 6c 6f 73 65 20 64 62 29 29 29 0a 0a 3b 3b  :close db)))..;;
2240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2280: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 74 69 64 64 6c 65  ======.;; tiddle
2290: 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  rs.;;===========
22a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
22b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
22c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
22d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65  ===========..(de
22e0: 66 69 6e 65 20 74 77 69 6b 69 3a 74 69 64 64 6c  fine twiki:tiddl
22f0: 65 72 2d 73 65 6c 65 63 74 6f 72 20 22 53 45 4c  er-selector "SEL
2300: 45 43 54 20 74 2e 69 64 2c 74 2e 6e 61 6d 65 2c  ECT t.id,t.name,
2310: 74 2e 72 65 76 2c 74 2e 64 61 74 5f 69 64 2c 74  t.rev,t.dat_id,t
2320: 2e 63 72 65 61 74 65 64 5f 6f 6e 2c 74 2e 6f 77  .created_on,t.ow
2330: 6e 65 72 5f 69 64 20 46 52 4f 4d 20 74 69 64 64  ner_id FROM tidd
2340: 6c 65 72 73 20 41 53 20 74 20 49 4e 4e 45 52 20  lers AS t INNER 
2350: 4a 4f 49 4e 20 64 61 74 73 20 41 53 20 64 20 4f  JOIN dats AS d O
2360: 4e 20 74 2e 64 61 74 5f 69 64 3d 64 2e 69 64 22  N t.dat_id=d.id"
2370: 29 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69  ).(define (twiki
2380: 3a 74 69 64 64 6c 65 72 2d 6d 61 6b 65 29 28 6d  :tiddler-make)(m
2390: 61 6b 65 2d 76 65 63 74 6f 72 20 38 20 23 66 29  ake-vector 8 #f)
23a0: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65  ).(define-inline
23b0: 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d   (twiki:tiddler-
23c0: 67 65 74 2d 69 64 20 20 20 20 20 20 20 20 20 20  get-id          
23d0: 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72   vec)    (vector
23e0: 2d 72 65 66 20 20 76 65 63 20 30 29 29 0a 28 64  -ref  vec 0)).(d
23f0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 77  efine-inline (tw
2400: 69 6b 69 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d  iki:tiddler-get-
2410: 6e 61 6d 65 20 20 20 20 20 20 20 20 20 76 65 63  name         vec
2420: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66  )    (vector-ref
2430: 20 20 76 65 63 20 31 29 29 0a 28 64 65 66 69 6e    vec 1)).(defin
2440: 65 2d 69 6e 6c 69 6e 65 20 28 74 77 69 6b 69 3a  e-inline (twiki:
2450: 74 69 64 64 6c 65 72 2d 67 65 74 2d 72 65 76 20  tiddler-get-rev 
2460: 20 20 20 20 20 20 20 20 20 76 65 63 29 20 20 20           vec)   
2470: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 20 76 65   (vector-ref  ve
2480: 63 20 32 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e  c 2)).(define-in
2490: 6c 69 6e 65 20 28 74 77 69 6b 69 3a 74 69 64 64  line (twiki:tidd
24a0: 6c 65 72 2d 67 65 74 2d 64 61 74 2d 69 64 20 20  ler-get-dat-id  
24b0: 20 20 20 20 20 76 65 63 29 20 20 20 20 28 76 65       vec)    (ve
24c0: 63 74 6f 72 2d 72 65 66 20 20 76 65 63 20 33 29  ctor-ref  vec 3)
24d0: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65  ).(define-inline
24e0: 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d   (twiki:tiddler-
24f0: 67 65 74 2d 63 72 65 61 74 65 64 5f 6f 6e 20 20  get-created_on  
2500: 20 76 65 63 29 20 20 20 20 28 76 65 63 74 6f 72   vec)    (vector
2510: 2d 72 65 66 20 20 76 65 63 20 34 29 29 0a 28 64  -ref  vec 4)).(d
2520: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 77  efine-inline (tw
2530: 69 6b 69 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d  iki:tiddler-get-
2540: 6f 77 6e 65 72 5f 69 64 20 20 20 20 20 76 65 63  owner_id     vec
2550: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66  )    (vector-ref
2560: 20 20 76 65 63 20 35 29 29 0a 3b 3b 20 28 64 65    vec 5)).;; (de
2570: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 77 69  fine-inline (twi
2580: 6b 69 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d 64  ki:tiddler-get-d
2590: 61 74 2d 74 79 70 65 20 20 20 20 20 76 65 63 29  at-type     vec)
25a0: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20      (vector-ref 
25b0: 20 76 65 63 20 36 29 29 0a 0a 28 64 65 66 69 6e   vec 6))..(defin
25c0: 65 2d 69 6e 6c 69 6e 65 20 28 74 77 69 6b 69 3a  e-inline (twiki:
25d0: 74 69 64 64 6c 65 72 2d 73 65 74 2d 69 64 21 20  tiddler-set-id! 
25e0: 20 20 20 20 20 20 20 20 20 76 65 63 20 76 61 6c           vec val
25f0: 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65  )(vector-set! ve
2600: 63 20 30 20 76 61 6c 29 20 76 65 63 29 0a 28 64  c 0 val) vec).(d
2610: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 77  efine-inline (tw
2620: 69 6b 69 3a 74 69 64 64 6c 65 72 2d 73 65 74 2d  iki:tiddler-set-
2630: 6e 61 6d 65 21 20 20 20 20 20 20 20 20 76 65 63  name!        vec
2640: 20 76 61 6c 29 28 76 65 63 74 6f 72 2d 73 65 74   val)(vector-set
2650: 21 20 76 65 63 20 31 20 76 61 6c 29 20 76 65 63  ! vec 1 val) vec
2660: 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65  ).(define-inline
2670: 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d   (twiki:tiddler-
2680: 73 65 74 2d 72 65 76 21 20 20 20 20 20 20 20 20  set-rev!        
2690: 20 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72   vec val)(vector
26a0: 2d 73 65 74 21 20 76 65 63 20 32 20 76 61 6c 29  -set! vec 2 val)
26b0: 20 76 65 63 29 0a 28 64 65 66 69 6e 65 2d 69 6e   vec).(define-in
26c0: 6c 69 6e 65 20 28 74 77 69 6b 69 3a 74 69 64 64  line (twiki:tidd
26d0: 6c 65 72 2d 73 65 74 2d 64 61 74 2d 69 64 21 20  ler-set-dat-id! 
26e0: 20 20 20 20 20 76 65 63 20 76 61 6c 29 28 76 65       vec val)(ve
26f0: 63 74 6f 72 2d 73 65 74 21 20 76 65 63 20 33 20  ctor-set! vec 3 
2700: 76 61 6c 29 20 76 65 63 29 0a 28 64 65 66 69 6e  val) vec).(defin
2710: 65 2d 69 6e 6c 69 6e 65 20 28 74 77 69 6b 69 3a  e-inline (twiki:
2720: 74 69 64 64 6c 65 72 2d 73 65 74 2d 63 72 65 61  tiddler-set-crea
2730: 74 65 64 5f 6f 6e 21 20 20 76 65 63 20 76 61 6c  ted_on!  vec val
2740: 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 76 65  )(vector-set! ve
2750: 63 20 34 20 76 61 6c 29 20 76 65 63 29 0a 3b 3b  c 4 val) vec).;;
2760: 20 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20   (define-inline 
2770: 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d 73  (twiki:tiddler-s
2780: 65 74 2d 6f 77 6e 65 72 5f 69 64 21 20 20 20 20  et-owner_id!    
2790: 76 65 63 20 76 61 6c 29 28 76 65 63 74 6f 72 2d  vec val)(vector-
27a0: 73 65 74 21 20 76 65 63 20 35 20 76 61 6c 29 29  set! vec 5 val))
27b0: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ..;;============
27c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
27d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
27e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
27f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f  ==========.;; Ro
2800: 75 74 69 6e 65 73 20 66 6f 72 20 64 69 73 70 6c  utines for displ
2810: 61 79 69 6e 67 2c 20 65 64 69 74 69 6e 67 2c 20  aying, editing, 
2820: 62 72 6f 77 73 69 6e 67 20 65 74 63 2e 20 74 69  browsing etc. ti
2830: 64 64 6c 65 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d  ddlers.;;=======
2840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
2870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 09  ===============.
2880: 0a 0a 3b 3b 20 73 68 6f 75 6c 64 20 63 68 61 6e  ..;; should chan
2890: 67 65 20 74 68 69 73 20 74 6f 20 74 61 6b 65 20  ge this to take 
28a0: 61 20 74 69 64 64 6c 65 72 20 73 74 72 75 63 74  a tiddler struct
28b0: 75 72 65 3f 0a 3b 3b 20 54 68 69 73 20 69 73 20  ure?.;; This is 
28c0: 74 68 65 20 64 69 73 70 6c 61 79 20 6f 66 20 61  the display of a
28d0: 20 73 69 6e 67 6c 65 20 74 69 64 64 6c 65 72 0a   single tiddler.
28e0: 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 76  (define (twiki:v
28f0: 69 65 77 20 64 61 74 20 20 74 6b 65 79 20 77 69  iew dat  tkey wi
2900: 64 20 74 69 64 64 6c 65 72 20 77 69 6b 69 29 20  d tiddler wiki) 
2910: 3b 3b 20 63 6c 6f 73 65 2c 20 63 6c 6f 73 65 20  ;; close, close 
2920: 6f 74 68 65 72 73 2c 20 65 64 69 74 2c 20 6d 6f  others, edit, mo
2930: 72 65 0a 20 20 28 6c 65 74 20 28 28 69 73 2d 6e  re.  (let ((is-n
2940: 6f 74 2d 6d 61 69 6e 20 20 28 6e 6f 74 20 28 65  ot-main  (not (e
2950: 71 75 61 6c 3f 20 22 4d 61 69 6e 4d 65 6e 75 22  qual? "MainMenu"
2960: 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d   (twiki:tiddler-
2970: 67 65 74 2d 6e 61 6d 65 20 74 69 64 64 6c 65 72  get-name tiddler
2980: 29 29 29 29 0a 09 28 65 64 69 74 2d 61 6c 6c 6f  ))))..(edit-allo
2990: 77 65 64 20 28 6d 65 6d 62 65 72 20 27 77 20 28  wed (member 'w (
29a0: 74 77 69 6b 69 3a 77 69 6b 69 2d 67 65 74 2d 70  twiki:wiki-get-p
29b0: 65 72 6d 73 20 77 69 6b 69 29 29 29 29 0a 20 20  erms wiki)))).  
29c0: 20 20 28 73 3a 64 69 76 20 27 63 6c 61 73 73 20    (s:div 'class 
29d0: 22 74 69 64 64 6c 65 72 22 0a 09 20 20 20 28 73  "tiddler"..   (s
29e0: 3a 64 69 76 20 27 63 6c 61 73 73 20 22 74 69 64  :div 'class "tid
29f0: 64 6c 65 72 2d 6d 65 6e 75 22 0a 09 09 20 20 28  dler-menu"...  (
2a00: 69 66 20 28 65 71 75 61 6c 3f 20 22 4d 61 69 6e  if (equal? "Main
2a10: 4d 65 6e 75 22 20 28 74 77 69 6b 69 3a 74 69 64  Menu" (twiki:tid
2a20: 64 6c 65 72 2d 67 65 74 2d 6e 61 6d 65 20 74 69  dler-get-name ti
2a30: 64 64 6c 65 72 29 29 0a 09 09 20 20 20 20 20 20  ddler))...      
2a40: 28 69 66 20 65 64 69 74 2d 61 6c 6c 6f 77 65 64  (if edit-allowed
2a50: 0a 09 09 09 20 20 28 6c 69 73 74 20 28 73 3a 61  ....  (list (s:a
2a60: 20 22 65 64 69 74 22 20 27 68 72 65 66 0a 09 09   "edit" 'href...
2a70: 09 09 20 20 20 20 20 28 73 3a 6c 69 6e 6b 2d 74  ..     (s:link-t
2a80: 6f 20 28 74 77 69 6b 69 3a 67 65 74 2d 6c 69 6e  o (twiki:get-lin
2a90: 6b 2d 62 61 63 6b 2d 74 6f 2d 63 75 72 72 65 6e  k-back-to-curren
2aa0: 74 29 0a 09 09 09 09 09 09 27 65 64 69 74 5f 74  t).......'edit_t
2ab0: 69 64 64 6c 65 72 20 28 74 77 69 6b 69 3a 74 69  iddler (twiki:ti
2ac0: 64 64 6c 65 72 2d 67 65 74 2d 69 64 20 74 69 64  ddler-get-id tid
2ad0: 64 6c 65 72 29 29 29 29 0a 09 09 09 20 20 27 28  dler))))....  '(
2ae0: 29 29 0a 09 09 20 20 20 20 20 20 28 73 3a 64 69  ))...      (s:di
2af0: 76 20 27 63 6c 61 73 73 20 22 74 69 64 64 6c 65  v 'class "tiddle
2b00: 72 2d 6d 65 6e 75 2d 69 6e 74 65 72 6e 61 6c 22  r-menu-internal"
2b10: 0a 09 09 20 20 20 20 20 20 20 28 73 3a 61 20 22  ...       (s:a "
2b20: 63 6c 6f 73 65 22 20 27 68 72 65 66 20 28 73 3a  close" 'href (s:
2b30: 6c 69 6e 6b 2d 74 6f 20 28 74 77 69 6b 69 3a 67  link-to (twiki:g
2b40: 65 74 2d 6c 69 6e 6b 2d 62 61 63 6b 2d 74 6f 2d  et-link-back-to-
2b50: 63 75 72 72 65 6e 74 29 20 27 63 6c 6f 73 65 5f  current) 'close_
2b60: 74 69 64 64 6c 65 72 20 28 74 77 69 6b 69 3a 74  tiddler (twiki:t
2b70: 69 64 64 6c 65 72 2d 67 65 74 2d 69 64 20 74 69  iddler-get-id ti
2b80: 64 64 6c 65 72 29 29 29 20 22 2e 22 0a 09 09 20  ddler))) "."... 
2b90: 20 20 20 20 20 20 28 73 3a 61 20 22 63 6c 6f 73        (s:a "clos
2ba0: 65 20 6f 74 68 65 72 73 22 20 27 68 72 65 66 20  e others" 'href 
2bb0: 28 73 3a 6c 69 6e 6b 2d 74 6f 20 28 74 77 69 6b  (s:link-to (twik
2bc0: 69 3a 67 65 74 2d 6c 69 6e 6b 2d 62 61 63 6b 2d  i:get-link-back-
2bd0: 74 6f 2d 63 75 72 72 65 6e 74 29 20 27 63 6c 6f  to-current) 'clo
2be0: 73 65 5f 6f 74 68 65 72 5f 74 69 64 64 6c 65 72  se_other_tiddler
2bf0: 73 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72  s (twiki:tiddler
2c00: 2d 67 65 74 2d 69 64 20 74 69 64 64 6c 65 72 29  -get-id tiddler)
2c10: 29 29 20 22 2e 22 0a 09 09 20 20 20 20 20 20 20  )) "."...       
2c20: 28 69 66 20 65 64 69 74 2d 61 6c 6c 6f 77 65 64  (if edit-allowed
2c30: 0a 09 09 09 20 20 20 28 73 3a 61 20 22 65 64 69  ....   (s:a "edi
2c40: 74 22 20 20 27 68 72 65 66 20 28 73 3a 6c 69 6e  t"  'href (s:lin
2c50: 6b 2d 74 6f 20 28 74 77 69 6b 69 3a 67 65 74 2d  k-to (twiki:get-
2c60: 6c 69 6e 6b 2d 62 61 63 6b 2d 74 6f 2d 63 75 72  link-back-to-cur
2c70: 72 65 6e 74 29 20 27 65 64 69 74 5f 74 69 64 64  rent) 'edit_tidd
2c80: 6c 65 72 20 28 74 77 69 6b 69 3a 74 69 64 64 6c  ler (twiki:tiddl
2c90: 65 72 2d 67 65 74 2d 69 64 20 74 69 64 64 6c 65  er-get-id tiddle
2ca0: 72 29 29 29 0a 09 09 09 20 20 20 27 28 29 29 29  r)))....   '()))
2cb0: 29 29 0a 09 20 20 20 20 28 73 3a 70 20 28 74 77  ))..    (s:p (tw
2cc0: 69 6b 69 3a 64 61 74 2d 3e 68 74 6d 6c 20 64 61  iki:dat->html da
2cd0: 74 20 77 69 6b 69 29 29 29 29 29 0a 0a 28 64 65  t wiki)))))..(de
2ce0: 66 69 6e 65 20 28 74 77 69 6b 69 3a 76 69 65 77  fine (twiki:view
2cf0: 2d 74 69 64 64 6c 65 72 20 64 62 20 20 74 6b 65  -tiddler db  tke
2d00: 79 20 77 69 64 20 74 69 64 64 6c 65 72 20 77 69  y wid tiddler wi
2d10: 6b 69 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 61  ki).  (let* ((da
2d20: 74 2d 69 64 20 28 74 77 69 6b 69 3a 74 69 64 64  t-id (twiki:tidd
2d30: 6c 65 72 2d 67 65 74 2d 64 61 74 2d 69 64 20 74  ler-get-dat-id t
2d40: 69 64 64 6c 65 72 29 29 0a 09 20 28 64 61 74 20  iddler)).. (dat 
2d50: 20 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 64 61     (twiki:get-da
2d60: 74 20 64 62 20 64 61 74 2d 69 64 29 29 0a 09 20  t db dat-id)).. 
2d70: 28 74 6e 75 6d 20 20 20 28 74 77 69 6b 69 3a 74  (tnum   (twiki:t
2d80: 69 64 64 6c 65 72 2d 67 65 74 2d 69 64 20 74 69  iddler-get-id ti
2d90: 64 64 6c 65 72 29 29 29 0a 20 20 20 20 3b 3b 20  ddler))).    ;; 
2da0: 28 73 3a 6c 6f 67 20 22 74 77 69 64 3a 20 22 20  (s:log "twid: " 
2db0: 64 61 74 2d 69 64 20 22 20 64 61 74 3a 20 22 20  dat-id " dat: " 
2dc0: 64 61 74 29 0a 20 20 20 20 28 74 77 69 6b 69 3a  dat).    (twiki:
2dd0: 76 69 65 77 20 64 61 74 20 20 74 6b 65 79 20 77  view dat  tkey w
2de0: 69 64 20 74 69 64 64 6c 65 72 20 77 69 6b 69 29  id tiddler wiki)
2df0: 29 29 0a 0a 3b 3b 20 63 61 6c 6c 20 77 69 74 68  ))..;; call with
2e00: 20 70 61 72 61 6d 20 3d 3e 20 61 63 74 69 6f 6e   param => action
2e10: 2d 6e 61 6d 65 2d 6b 65 79 20 65 2e 67 2e 20 73  -name-key e.g. s
2e20: 61 76 65 2d 62 57 46 70 62 67 5f 5f 2d 61 47 56  ave-bWFpbg__-aGV
2e30: 73 62 47 38 67 62 6e 56 79 63 32 55 5f 20 28 73  sbG8gbnVyc2U_ (s
2e40: 61 76 65 20 6d 61 69 6e 20 22 68 65 6c 6c 6f 20  ave main "hello 
2e50: 6e 75 72 73 65 22 29 0a 3b 3b 20 74 68 69 73 20  nurse").;; this 
2e60: 6f 6e 65 20 69 73 20 63 61 6c 6c 65 64 20 77 68  one is called wh
2e70: 65 6e 20 61 6e 20 65 64 69 74 20 66 6f 72 6d 20  en an edit form 
2e80: 69 73 20 73 75 62 6d 69 74 74 65 64 20 28 69 2e  is submitted (i.
2e90: 65 2e 20 50 4f 53 54 29 0a 28 64 65 66 69 6e 65  e. POST).(define
2ea0: 20 28 74 77 69 6b 69 3a 61 63 74 69 6f 6e 20 70   (twiki:action p
2eb0: 61 72 61 6d 73 29 0a 20 20 28 69 66 20 28 61 6e  arams).  (if (an
2ec0: 64 20 28 6c 69 73 74 3f 20 70 61 72 61 6d 73 29  d (list? params)
2ed0: 0a 09 20 20 20 28 3e 20 28 6c 65 6e 67 74 68 20  ..   (> (length 
2ee0: 70 61 72 61 6d 73 29 20 30 29 29 0a 20 20 20 20  params) 0)).    
2ef0: 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 6c 6e 20    (let* ((cmdln 
2f00: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 63  (string-split (c
2f10: 61 72 20 70 61 72 61 6d 73 29 20 22 2d 22 29 29  ar params) "-"))
2f20: 0a 09 20 20 20 20 20 28 63 6d 64 20 20 20 28 73  ..     (cmd   (s
2f30: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 63  tring->symbol (c
2f40: 61 72 20 63 6d 64 6c 6e 29 29 29 0a 09 20 20 20  ar cmdln)))..   
2f50: 20 20 28 74 6b 65 79 20 20 28 74 77 69 6b 69 3a    (tkey  (twiki:
2f60: 77 65 62 36 34 64 65 63 20 28 63 61 64 64 72 20  web64dec (caddr 
2f70: 63 6d 64 6c 6e 29 29 29 0a 09 20 20 20 20 20 28  cmdln)))..     (
2f80: 77 69 64 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e  wid   (string->n
2f90: 75 6d 62 65 72 20 28 63 61 64 72 20 63 6d 64 6c  umber (cadr cmdl
2fa0: 6e 29 29 29 0a 09 20 20 20 20 20 28 74 64 62 20  n)))..     (tdb 
2fb0: 20 20 28 74 77 69 6b 69 3a 6f 70 65 6e 2d 64 62    (twiki:open-db
2fc0: 20 74 6b 65 79 29 29 29 0a 09 28 73 3a 6c 6f 67   tkey)))..(s:log
2fd0: 20 22 63 6d 64 6c 6e 3a 20 22 20 63 6d 64 6c 6e   "cmdln: " cmdln
2fe0: 20 22 20 63 6d 64 3a 20 22 20 63 6d 64 20 22 20   " cmd: " cmd " 
2ff0: 74 6b 65 79 3a 20 22 20 74 6b 65 79 20 22 20 77  tkey: " tkey " w
3000: 69 64 3a 20 22 20 77 69 64 29 0a 09 28 63 61 73  id: " wid)..(cas
3010: 65 20 63 6d 64 0a 09 20 20 28 28 73 61 76 65 29  e cmd..  ((save)
3020: 0a 09 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65  ..   (twiki:save
3030: 2d 63 75 72 72 2d 74 69 64 64 6c 65 72 20 74 64  -curr-tiddler td
3040: 62 20 77 69 64 29 29 0a 09 20 20 28 28 73 61 76  b wid))..  ((sav
3050: 65 70 69 63 29 0a 09 20 20 20 28 73 3a 6c 6f 67  epic)..   (s:log
3060: 20 22 74 77 69 6b 69 3a 61 63 74 69 6f 6e 20 67   "twiki:action g
3070: 6f 74 20 74 6f 20 73 61 76 65 70 69 63 22 29 0a  ot to savepic").
3080: 09 20 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d  .   (twiki:save-
3090: 70 69 63 2d 66 72 6f 6d 2d 66 6f 72 6d 20 74 64  pic-from-form td
30a0: 62 20 77 69 64 29 29 0a 09 20 20 28 28 63 61 6e  b wid))..  ((can
30b0: 63 65 6c 29 20 3b 3b 20 64 65 70 72 65 63 61 74  cel) ;; deprecat
30c0: 65 64 2e 20 55 73 65 20 61 20 6c 69 6e 6b 20 66  ed. Use a link f
30d0: 6f 72 20 74 68 69 73 20 28 69 2e 65 20 69 6e 20  or this (i.e in 
30e0: 74 68 65 20 74 77 69 6b 69 3a 74 77 69 6b 69 20  the twiki:twiki 
30f0: 70 72 6f 63 0a 09 20 20 20 28 73 3a 64 65 6c 21  proc..   (s:del!
3100: 20 28 63 6f 6e 63 20 22 43 55 52 52 45 4e 54 5f   (conc "CURRENT_
3110: 54 57 49 44 4c 45 52 5f 55 4e 44 45 52 5f 45 44  TWIDLER_UNDER_ED
3120: 49 54 3a 22 20 77 69 64 29 29 0a 09 20 20 20 29  IT:" wid))..   )
3130: 29 29 29 29 0a 0a 3b 3b 20 67 65 6e 65 72 61 74  ))))..;; generat
3140: 65 20 61 20 66 6f 72 6d 20 66 6f 72 20 65 64 69  e a form for edi
3150: 74 69 6e 67 20 61 20 74 77 69 64 64 6c 65 72 20  ting a twiddler 
3160: 74 6e 75 6d 0a 28 64 65 66 69 6e 65 20 28 74 77  tnum.(define (tw
3170: 69 6b 69 3a 65 64 69 74 2d 74 69 64 64 6c 65 72  iki:edit-tiddler
3180: 20 64 62 20 74 6b 65 79 20 77 69 64 20 74 6e 75   db tkey wid tnu
3190: 6d 29 0a 20 20 28 73 3a 6c 6f 67 20 22 74 77 69  m).  (s:log "twi
31a0: 6b 69 3a 65 64 69 74 2d 74 69 64 64 6c 65 72 3a  ki:edit-tiddler:
31b0: 20 74 6b 65 79 3d 22 20 74 6b 65 79 20 22 20 77   tkey=" tkey " w
31c0: 69 64 3a 20 22 20 77 69 64 29 0a 20 20 28 6c 65  id: " wid).  (le
31d0: 74 2a 20 28 28 65 6e 63 2d 6b 65 79 20 20 28 74  t* ((enc-key  (t
31e0: 77 69 6b 69 3a 77 65 62 36 34 65 6e 63 20 74 6b  wiki:web64enc tk
31f0: 65 79 29 29 0a 09 20 28 74 69 64 64 61 74 73 20  ey)).. (tiddats 
3200: 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64   (twiki:get-tidd
3210: 6c 65 72 73 2d 62 79 2d 6e 75 6d 20 64 62 20 77  lers-by-num db w
3220: 69 64 20 28 6c 69 73 74 20 74 6e 75 6d 29 29 29  id (list tnum)))
3230: 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f  ).    (if (null?
3240: 20 74 69 64 64 61 74 73 29 0a 09 28 6c 65 74 2a   tiddats)..(let*
3250: 20 28 28 74 69 64 20 20 20 20 30 29 0a 09 20 20   ((tid    0)..  
3260: 20 20 20 20 20 28 64 61 74 2d 69 64 20 30 29 29       (dat-id 0))
3270: 0a 09 20 20 28 73 3a 73 65 74 21 20 22 74 77 69  ..  (s:set! "twi
3280: 6b 69 5f 74 69 74 6c 65 22 20 22 22 29 0a 09 20  ki_title" "").. 
3290: 20 28 73 3a 73 65 74 21 20 22 74 77 69 6b 69 5f   (s:set! "twiki_
32a0: 62 6f 64 79 22 20 20 22 22 29 29 0a 09 28 6c 65  body"  ""))..(le
32b0: 74 2a 20 28 28 74 69 64 20 20 20 20 28 63 61 72  t* ((tid    (car
32c0: 20 74 69 64 64 61 74 73 29 29 0a 09 20 20 20 20   tiddats))..    
32d0: 20 20 20 28 64 61 74 2d 69 64 20 28 74 77 69 6b     (dat-id (twik
32e0: 69 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d 64 61  i:tiddler-get-da
32f0: 74 2d 69 64 20 74 69 64 29 29 29 0a 09 20 20 3b  t-id tid)))..  ;
3300: 3b 20 28 73 3a 6c 6f 67 20 22 74 69 64 3a 20 22  ; (s:log "tid: "
3310: 20 74 69 64 20 22 20 64 61 74 2d 69 64 3a 20 22   tid " dat-id: "
3320: 20 64 61 74 2d 69 64 29 0a 09 20 20 28 73 3a 73   dat-id)..  (s:s
3330: 65 74 21 20 22 74 77 69 6b 69 5f 74 69 74 6c 65  et! "twiki_title
3340: 22 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72  " (twiki:tiddler
3350: 2d 67 65 74 2d 6e 61 6d 65 20 74 69 64 29 29 0a  -get-name tid)).
3360: 09 20 20 28 73 3a 73 65 74 21 20 22 74 77 69 6b  .  (s:set! "twik
3370: 69 5f 62 6f 64 79 22 20 20 28 74 77 69 6b 69 3a  i_body"  (twiki:
3380: 67 65 74 2d 64 61 74 20 64 62 20 64 61 74 2d 69  get-dat db dat-i
3390: 64 29 29 29 29 0a 20 20 20 20 28 73 3a 66 6f 72  d)))).    (s:for
33a0: 6d 20 27 61 63 74 69 6f 6e 20 28 73 3a 6c 69 6e  m 'action (s:lin
33b0: 6b 2d 74 6f 20 28 74 77 69 6b 69 3a 67 65 74 2d  k-to (twiki:get-
33c0: 6c 69 6e 6b 2d 62 61 63 6b 2d 74 6f 2d 63 75 72  link-back-to-cur
33d0: 72 65 6e 74 29 0a 09 09 09 20 20 20 20 20 20 20  rent)....       
33e0: 27 61 63 74 69 6f 6e 20 28 63 6f 6e 63 20 22 74  'action (conc "t
33f0: 77 69 6b 69 2e 73 61 76 65 2d 22 20 28 6e 75 6d  wiki.save-" (num
3400: 62 65 72 2d 3e 73 74 72 69 6e 67 20 77 69 64 29  ber->string wid)
3410: 20 22 2d 22 20 65 6e 63 2d 6b 65 79 29 29 0a 09   "-" enc-key))..
3420: 20 20 20 20 27 6d 65 74 68 6f 64 20 22 70 6f 73      'method "pos
3430: 74 22 20 3b 3b 20 27 74 77 69 6b 69 6e 61 6d 65  t" ;; 'twikiname
3440: 20 74 6b 65 79 20 3b 3b 20 64 6f 6e 65 2c 20 63   tkey ;; done, c
3450: 61 6e 63 65 6c 2c 20 64 65 6c 65 74 65 0a 09 20  ancel, delete.. 
3460: 20 20 20 28 73 3a 69 6e 70 75 74 20 27 74 79 70     (s:input 'typ
3470: 65 20 22 73 75 62 6d 69 74 22 20 20 20 27 6e 61  e "submit"   'na
3480: 6d 65 20 22 66 6f 72 6d 2d 6e 61 6d 65 22 20 27  me "form-name" '
3490: 76 61 6c 75 65 20 22 73 61 76 65 22 20 27 74 77  value "save" 'tw
34a0: 69 6b 69 6e 61 6d 65 20 74 6b 65 79 29 0a 09 20  ikiname tkey).. 
34b0: 20 20 20 3b 3b 20 28 73 3a 61 20 22 64 6f 6e 65     ;; (s:a "done
34c0: 22 20 27 68 72 65 66 20 28 73 3a 6c 69 6e 6b 2d  " 'href (s:link-
34d0: 74 6f 20 28 74 77 69 6b 69 3a 67 65 74 2d 6c 69  to (twiki:get-li
34e0: 6e 6b 2d 62 61 63 6b 2d 74 6f 2d 63 75 72 72 65  nk-back-to-curre
34f0: 6e 74 29 20 27 73 61 76 65 5f 74 6d 65 6e 75 20  nt) 'save_tmenu 
3500: 74 6e 75 6d 29 29 0a 09 20 20 20 20 28 73 3a 61  tnum))..    (s:a
3510: 20 22 63 61 6e 63 65 6c 22 20 27 68 72 65 66 20   "cancel" 'href 
3520: 28 73 3a 6c 69 6e 6b 2d 74 6f 20 28 74 77 69 6b  (s:link-to (twik
3530: 69 3a 67 65 74 2d 6c 69 6e 6b 2d 62 61 63 6b 2d  i:get-link-back-
3540: 74 6f 2d 63 75 72 72 65 6e 74 29 20 27 63 61 6e  to-current) 'can
3550: 63 65 6c 5f 74 65 64 69 74 20 74 6e 75 6d 29 29  cel_tedit tnum))
3560: 20 22 2e 22 0a 09 20 20 20 20 28 73 3a 61 20 22   "."..    (s:a "
3570: 64 65 6c 65 74 65 22 20 27 68 72 65 66 20 28 73  delete" 'href (s
3580: 3a 6c 69 6e 6b 2d 74 6f 20 28 74 77 69 6b 69 3a  :link-to (twiki:
3590: 67 65 74 2d 6c 69 6e 6b 2d 62 61 63 6b 2d 74 6f  get-link-back-to
35a0: 2d 63 75 72 72 65 6e 74 29 20 27 64 65 6c 65 74  -current) 'delet
35b0: 65 5f 74 69 64 64 6c 65 72 20 74 6e 75 6d 29 29  e_tiddler tnum))
35c0: 28 73 3a 62 72 29 0a 09 20 20 20 20 28 73 3a 69  (s:br)..    (s:i
35d0: 6e 70 75 74 2d 70 72 65 73 65 72 76 65 20 27 74  nput-preserve 't
35e0: 79 70 65 20 22 74 65 78 74 22 20 27 6e 61 6d 65  ype "text" 'name
35f0: 20 22 74 77 69 6b 69 5f 74 69 74 6c 65 22 20 27   "twiki_title" '
3600: 73 69 7a 65 20 22 35 38 22 20 27 6d 61 78 6c 65  size "58" 'maxle
3610: 6e 67 74 68 20 22 31 35 30 22 29 0a 09 20 20 20  ngth "150")..   
3620: 20 28 73 3a 74 65 78 74 61 72 65 61 2d 70 72 65   (s:textarea-pre
3630: 73 65 72 76 65 20 27 74 79 70 65 20 22 74 65 78  serve 'type "tex
3640: 74 61 72 65 61 22 20 27 6e 61 6d 65 20 22 74 77  tarea" 'name "tw
3650: 69 6b 69 5f 62 6f 64 79 22 20 27 72 6f 77 73 20  iki_body" 'rows 
3660: 22 31 30 22 20 27 63 6f 6c 73 20 22 36 35 22 29  "10" 'cols "65")
3670: 0a 09 20 20 20 20 28 73 3a 70 20 22 54 61 67 73  ..    (s:p "Tags
3680: 22 20 28 73 3a 69 6e 70 75 74 2d 70 72 65 73 65  " (s:input-prese
3690: 72 76 65 20 27 74 79 70 65 20 22 74 65 78 74 22  rve 'type "text"
36a0: 20 27 6e 61 6d 65 20 22 74 77 69 6b 69 5f 74 61   'name "twiki_ta
36b0: 67 73 22 20 27 73 69 7a 65 20 22 35 35 22 20 27  gs" 'size "55" '
36c0: 6d 61 78 6c 65 6e 67 74 68 20 22 31 35 30 22 29  maxlength "150")
36d0: 29 29 29 29 0a 0a 3b 3b 20 73 61 76 65 20 61 20  ))))..;; save a 
36e0: 74 69 64 64 6c 65 72 20 74 6f 20 74 68 65 20 64  tiddler to the d
36f0: 62 20 66 6f 72 20 74 68 65 20 74 77 69 6b 69 20  b for the twiki 
3700: 74 77 69 6b 2c 20 67 65 74 74 69 6e 67 20 64 61  twik, getting da
3710: 74 61 20 66 72 6f 6d 20 74 68 65 20 49 4e 50 55  ta from the INPU
3720: 54 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69  T.(define (twiki
3730: 3a 73 61 76 65 2d 63 75 72 72 2d 74 69 64 64 6c  :save-curr-tiddl
3740: 65 72 20 74 64 62 20 77 69 64 29 0a 20 20 28 66  er tdb wid).  (f
3750: 6f 72 6d 64 61 74 3a 70 72 69 6e 74 61 6c 6c 20  ormdat:printall 
3760: 28 73 64 61 74 2d 67 65 74 2d 66 6f 72 6d 64 61  (sdat-get-formda
3770: 74 20 73 3a 73 65 73 73 69 6f 6e 29 20 73 3a 6c  t s:session) s:l
3780: 6f 67 29 0a 20 20 28 6c 65 74 2a 20 28 28 68 65  og).  (let* ((he
3790: 61 64 69 6e 67 20 28 73 3a 67 65 74 2d 69 6e 70  ading (s:get-inp
37a0: 75 74 20 27 74 77 69 6b 69 5f 74 69 74 6c 65 29  ut 'twiki_title)
37b0: 29 0a 09 20 28 62 6f 64 79 20 20 20 20 28 73 3a  ).. (body    (s:
37c0: 67 65 74 2d 69 6e 70 75 74 20 27 74 77 69 6b 69  get-input 'twiki
37d0: 5f 62 6f 64 79 29 29 0a 09 20 28 74 61 67 73 20  _body)).. (tags 
37e0: 20 20 20 28 73 3a 67 65 74 2d 69 6e 70 75 74 20     (s:get-input 
37f0: 27 74 77 69 6b 69 5f 74 61 67 73 29 29 0a 09 20  'twiki_tags)).. 
3800: 28 75 69 64 20 20 20 20 20 28 74 77 69 6b 69 3a  (uid     (twiki:
3810: 67 65 74 2d 69 64 29 29 29 0a 20 20 20 20 3b 3b  get-id))).    ;;
3820: 20 28 73 3a 6c 6f 67 20 22 74 77 69 6b 69 3a 73   (s:log "twiki:s
3830: 61 76 65 2d 63 75 72 72 2d 74 69 64 64 6c 65 72  ave-curr-tiddler
3840: 20 68 65 61 64 69 6e 67 3a 20 22 20 68 65 61 64   heading: " head
3850: 69 6e 67 20 22 20 62 6f 64 79 3a 20 22 20 62 6f  ing " body: " bo
3860: 64 79 20 22 20 74 61 67 73 3a 20 22 20 74 61 67  dy " tags: " tag
3870: 73 29 0a 20 20 20 20 28 73 3a 73 65 74 21 20 27  s).    (s:set! '
3880: 74 77 69 6b 69 5f 74 69 74 6c 65 20 68 65 61 64  twiki_title head
3890: 69 6e 67 29 0a 20 20 20 20 28 69 66 20 62 6f 64  ing).    (if bod
38a0: 79 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 65  y..(begin..  (se
38b0: 74 21 20 62 6f 64 79 20 28 73 74 72 69 6e 67 2d  t! body (string-
38c0: 63 68 6f 6d 70 20 62 6f 64 79 29 29 0a 09 20 20  chomp body))..  
38d0: 28 73 3a 73 65 74 21 20 27 74 77 69 6b 69 5f 62  (s:set! 'twiki_b
38e0: 6f 64 79 20 20 62 6f 64 79 29 29 29 0a 20 20 20  ody  body))).   
38f0: 20 28 73 3a 73 65 74 21 20 27 74 77 69 6b 69 5f   (s:set! 'twiki_
3900: 74 61 67 73 20 20 74 61 67 73 29 0a 20 20 20 20  tags  tags).    
3910: 28 73 3a 64 65 6c 21 20 28 63 6f 6e 63 20 22 43  (s:del! (conc "C
3920: 55 52 52 45 4e 54 5f 54 57 49 44 4c 45 52 5f 55  URRENT_TWIDLER_U
3930: 4e 44 45 52 5f 45 44 49 54 3a 22 20 77 69 64 29  NDER_EDIT:" wid)
3940: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 72 65 73  ).    (let ((res
3950: 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 74 69 64   (twiki:save-tid
3960: 64 6c 65 72 20 74 64 62 20 68 65 61 64 69 6e 67  dler tdb heading
3970: 20 62 6f 64 79 20 74 61 67 73 20 77 69 64 20 75   body tags wid u
3980: 69 64 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 4e  id))).      ;; N
3990: 6f 77 2c 20 72 65 70 6c 61 63 65 20 74 68 69 73  ow, replace this
39a0: 20 74 77 69 64 64 6c 65 72 20 6e 75 6d 62 65 72   twiddler number
39b0: 20 69 6e 20 74 68 65 20 76 69 65 77 20 6c 69 73   in the view lis
39c0: 74 20 77 69 74 68 20 0a 20 20 20 20 20 20 3b 3b  t with .      ;;
39d0: 20 74 68 65 20 6e 65 77 20 6e 75 6d 62 65 72 20   the new number 
39e0: 66 72 6f 6d 20 74 68 65 20 64 62 0a 20 20 20 20  from the db.    
39f0: 20 20 28 74 77 69 6b 69 3a 6e 6f 72 6d 61 6c 69    (twiki:normali
3a00: 7a 65 2d 63 75 72 72 65 6e 74 2d 74 77 69 64 64  ze-current-twidd
3a10: 6c 65 72 73 20 74 64 62 20 77 69 64 29 0a 20 20  lers tdb wid).  
3a20: 20 20 20 20 28 73 3a 64 65 6c 21 20 27 74 77 69      (s:del! 'twi
3a30: 6b 69 5f 74 69 74 6c 65 29 0a 20 20 20 20 20 20  ki_title).      
3a40: 28 73 3a 64 65 6c 21 20 27 74 77 69 6b 69 5f 62  (s:del! 'twiki_b
3a50: 6f 64 79 29 0a 20 20 20 20 20 20 28 73 3a 64 65  ody).      (s:de
3a60: 6c 21 20 27 74 77 69 6b 69 5f 74 61 67 73 29 0a  l! 'twiki_tags).
3a70: 20 20 20 20 20 20 72 65 73 29 0a 20 20 20 20 29        res).    )
3a80: 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b  )..(define (twik
3a90: 69 3a 6e 6f 72 6d 61 6c 69 7a 65 2d 63 75 72 72  i:normalize-curr
3aa0: 65 6e 74 2d 74 77 69 64 64 6c 65 72 73 20 74 64  ent-twiddlers td
3ab0: 62 20 77 69 64 29 0a 20 20 28 6c 65 74 2a 20 28  b wid).  (let* (
3ac0: 28 63 76 61 72 20 20 20 20 20 20 28 63 6f 6e 63  (cvar      (conc
3ad0: 20 22 43 55 52 52 45 4e 54 5f 54 57 49 44 4c 45   "CURRENT_TWIDLE
3ae0: 52 53 3a 22 20 77 69 64 29 29 0a 09 20 28 63 75  RS:" wid)).. (cu
3af0: 72 72 2d 73 6c 73 74 20 28 73 3a 67 65 74 20 63  rr-slst (s:get c
3b00: 76 61 72 29 29 0a 09 20 28 63 75 72 72 2d 6c 73  var)).. (curr-ls
3b10: 74 20 20 28 6d 61 70 20 73 74 72 69 6e 67 2d 3e  t  (map string->
3b20: 6e 75 6d 62 65 72 20 28 73 74 72 69 6e 67 2d 73  number (string-s
3b30: 70 6c 69 74 20 63 75 72 72 2d 73 6c 73 74 20 22  plit curr-slst "
3b40: 2c 22 29 29 29 0a 09 20 28 74 64 6c 72 73 20 20  ,"))).. (tdlrs  
3b50: 20 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69     (twiki:get-ti
3b60: 64 64 6c 65 72 73 2d 62 79 2d 6e 75 6d 20 74 64  ddlers-by-num td
3b70: 62 20 77 69 64 20 63 75 72 72 2d 6c 73 74 29 29  b wid curr-lst))
3b80: 0a 09 20 28 6e 61 6d 65 73 20 20 20 20 20 28 72  .. (names     (r
3b90: 65 6d 6f 76 65 20 28 6c 61 6d 62 64 61 20 28 74  emove (lambda (t
3ba0: 29 28 73 74 72 69 6e 67 3d 3f 20 22 4d 61 69 6e  )(string=? "Main
3bb0: 4d 65 6e 75 22 20 74 29 29 0a 09 09 09 20 20 20  Menu" t))....   
3bc0: 20 28 6d 61 70 20 74 77 69 6b 69 3a 74 69 64 64   (map twiki:tidd
3bd0: 6c 65 72 2d 67 65 74 2d 6e 61 6d 65 20 74 64 6c  ler-get-name tdl
3be0: 72 73 29 29 29 0a 09 20 28 6e 65 77 6e 75 6d 73  rs))).. (newnums
3bf0: 20 20 20 28 6d 61 70 20 74 77 69 6b 69 3a 74 69     (map twiki:ti
3c00: 64 64 6c 65 72 2d 67 65 74 2d 69 64 20 0a 09 09  ddler-get-id ...
3c10: 09 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28  . (map (lambda (
3c20: 74 6e 29 0a 09 09 09 09 28 74 77 69 6b 69 3a 67  tn).....(twiki:g
3c30: 65 74 2d 74 69 64 64 6c 65 72 2d 62 79 2d 6e 61  et-tiddler-by-na
3c40: 6d 65 20 74 64 62 20 77 69 64 20 74 6e 29 29 0a  me tdb wid tn)).
3c50: 09 09 09 20 20 20 20 20 20 6e 61 6d 65 73 29 29  ...      names))
3c60: 29 29 0a 20 20 20 20 28 73 3a 73 65 74 21 20 63  )).    (s:set! c
3c70: 76 61 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 65  var (string-inte
3c80: 72 73 70 65 72 73 65 20 28 6d 61 70 20 6e 75 6d  rsperse (map num
3c90: 62 65 72 2d 3e 73 74 72 69 6e 67 20 6e 65 77 6e  ber->string newn
3ca0: 75 6d 73 29 0a 09 09 09 09 20 20 20 20 20 22 2c  ums).....     ",
3cb0: 22 29 29 29 29 0a 20 20 20 20 0a 3b 3b 20 67 65  ")))).    .;; ge
3cc0: 6e 65 72 69 63 20 73 61 76 65 20 74 69 64 64 6c  neric save tiddl
3cd0: 65 72 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b  er.(define (twik
3ce0: 69 3a 73 61 76 65 2d 74 69 64 64 6c 65 72 20 74  i:save-tiddler t
3cf0: 64 62 20 68 65 61 64 69 6e 67 20 62 6f 64 79 20  db heading body 
3d00: 74 61 67 73 20 77 69 64 20 75 69 64 29 0a 20 20  tags wid uid).  
3d10: 20 20 28 69 66 20 28 6d 69 73 63 3a 6e 6f 6e 2d    (if (misc:non-
3d20: 7a 65 72 6f 2d 73 74 72 69 6e 67 20 68 65 61 64  zero-string head
3d30: 69 6e 67 29 0a 09 28 6c 65 74 2a 20 28 28 70 72  ing)..(let* ((pr
3d40: 65 76 2d 74 69 64 20 28 74 77 69 6b 69 3a 67 65  ev-tid (twiki:ge
3d50: 74 2d 74 69 64 64 6c 65 72 2d 62 79 2d 6e 61 6d  t-tiddler-by-nam
3d60: 65 20 74 64 62 20 77 69 64 20 68 65 61 64 69 6e  e tdb wid headin
3d70: 67 29 29 0a 09 20 20 20 20 20 20 20 28 70 72 65  g))..       (pre
3d80: 76 2d 64 61 74 2d 69 64 20 28 69 66 20 70 72 65  v-dat-id (if pre
3d90: 76 2d 74 69 64 20 0a 09 09 09 09 28 74 77 69 6b  v-tid .....(twik
3da0: 69 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d 64 61  i:tiddler-get-da
3db0: 74 2d 69 64 20 70 72 65 76 2d 74 69 64 29 0a 09  t-id prev-tid)..
3dc0: 09 09 09 2d 31 29 29 0a 09 20 20 20 20 20 20 20  ...-1))..       
3dd0: 28 64 61 74 2d 69 64 20 28 74 77 69 6b 69 3a 73  (dat-id (twiki:s
3de0: 61 76 65 2d 64 61 74 20 74 64 62 20 62 6f 64 79  ave-dat tdb body
3df0: 20 30 29 29 29 20 3b 3b 20 30 3d 74 65 78 74 0a   0))) ;; 0=text.
3e00: 09 20 20 3b 3b 20 28 73 3a 6c 6f 67 20 22 74 77  .  ;; (s:log "tw
3e10: 69 6b 69 3a 73 61 76 65 2d 74 69 64 64 6c 65 72  iki:save-tiddler
3e20: 20 64 61 74 2d 69 64 3a 20 22 20 64 61 74 2d 69   dat-id: " dat-i
3e30: 64 20 22 20 62 6f 64 79 3a 20 22 20 62 6f 64 79  d " body: " body
3e40: 29 0a 09 20 20 28 69 66 20 28 65 71 75 61 6c 3f  )..  (if (equal?
3e50: 20 70 72 65 76 2d 64 61 74 2d 69 64 20 64 61 74   prev-dat-id dat
3e60: 2d 69 64 29 20 3b 3b 20 6e 6f 20 6e 65 65 64 20  -id) ;; no need 
3e70: 74 6f 20 69 6e 73 65 72 74 20 61 20 6e 65 77 20  to insert a new 
3e80: 72 65 63 6f 72 64 20 69 66 20 74 68 65 20 64 61  record if the da
3e90: 74 20 64 69 64 6e 27 74 20 63 68 61 6e 67 65 0a  t didn't change.
3ea0: 09 20 20 20 20 20 20 23 74 0a 09 20 20 20 20 20  .      #t..     
3eb0: 20 28 64 62 69 3a 65 78 65 63 20 74 64 62 20 0a   (dbi:exec tdb .
3ec0: 09 09 09 22 49 4e 53 45 52 54 20 49 4e 54 4f 20  ..."INSERT INTO 
3ed0: 74 69 64 64 6c 65 72 73 20 28 77 69 6b 69 5f 69  tiddlers (wiki_i
3ee0: 64 2c 6e 61 6d 65 2c 64 61 74 5f 69 64 2c 63 72  d,name,dat_id,cr
3ef0: 65 61 74 65 64 5f 6f 6e 2c 6f 77 6e 65 72 5f 69  eated_on,owner_i
3f00: 64 29 20 56 41 4c 55 45 53 28 3f 2c 3f 2c 3f 2c  d) VALUES(?,?,?,
3f10: 3f 2c 3f 29 3b 22 0a 09 09 09 77 69 64 20 68 65  ?,?);"....wid he
3f20: 61 64 69 6e 67 20 64 61 74 2d 69 64 20 28 63 75  ading dat-id (cu
3f30: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 75  rrent-seconds) u
3f40: 69 64 29 29 0a 09 20 20 23 74 29 20 3b 3b 20 73  id))..  #t) ;; s
3f50: 75 63 63 65 73 73 0a 09 23 66 29 29 20 20 3b 3b  uccess..#f))  ;;
3f60: 20 6e 6f 6e 2d 73 75 63 63 65 73 73 0a 0a 3b 3b   non-success..;;
3f70: 20 74 65 78 74 3d 30 2c 20 6a 70 67 3d 31 2c 20   text=0, jpg=1, 
3f80: 70 6e 67 3d 32 0a 28 64 65 66 69 6e 65 20 28 74  png=2.(define (t
3f90: 77 69 6b 69 3a 73 61 76 65 2d 64 61 74 20 64 62  wiki:save-dat db
3fa0: 20 64 61 74 20 74 79 70 65 29 0a 20 20 28 6c 65   dat type).  (le
3fb0: 74 2a 20 28 28 6d 64 35 73 75 6d 20 28 6d 65 73  t* ((md5sum (mes
3fc0: 73 61 67 65 2d 64 69 67 65 73 74 2d 73 74 72 69  sage-digest-stri
3fd0: 6e 67 20 28 6d 64 35 2d 70 72 69 6d 69 74 69 76  ng (md5-primitiv
3fe0: 65 29 20 64 61 74 29 29 20 3b 3b 20 28 6d 64 35  e) dat)) ;; (md5
3ff0: 2d 64 69 67 65 73 74 20 64 61 74 29 29 0a 09 20  -digest dat)).. 
4000: 28 64 61 74 69 64 20 20 28 74 77 69 6b 69 3a 64  (datid  (twiki:d
4010: 61 74 2d 65 78 69 73 74 73 3f 20 64 62 20 6d 64  at-exists? db md
4020: 35 73 75 6d 20 74 79 70 65 29 29 0a 09 20 28 64  5sum type)).. (d
4030: 61 74 62 6c 6f 62 20 28 69 66 20 28 73 74 72 69  atblob (if (stri
4040: 6e 67 3f 20 64 61 74 29 0a 09 09 20 20 20 20 20  ng? dat)...     
4050: 20 28 73 74 72 69 6e 67 2d 3e 62 6c 6f 62 20 64   (string->blob d
4060: 61 74 29 0a 09 09 20 20 20 20 20 20 64 61 74 29  at)...      dat)
4070: 29 29 0a 20 20 20 20 28 69 66 20 64 61 74 69 64  )).    (if datid
4080: 0a 09 64 61 74 69 64 0a 09 28 62 65 67 69 6e 0a  ..datid..(begin.
4090: 09 20 20 28 63 61 73 65 20 74 79 70 65 0a 09 20  .  (case type.. 
40a0: 20 20 20 28 28 30 29 20 20 20 28 64 62 69 3a 65     ((0)   (dbi:e
40b0: 78 65 63 20 64 62 20 22 49 4e 53 45 52 54 20 49  xec db "INSERT I
40c0: 4e 54 4f 20 64 61 74 73 20 28 6d 64 35 73 75 6d  NTO dats (md5sum
40d0: 2c 64 61 74 2c 74 79 70 65 29 20 56 41 4c 55 45  ,dat,type) VALUE
40e0: 53 28 3f 2c 3f 2c 3f 29 3b 22 20 6d 64 35 73 75  S(?,?,?);" md5su
40f0: 6d 20 64 61 74 62 6c 6f 62 20 30 29 29 0a 09 20  m datblob 0)).. 
4100: 20 20 20 28 28 31 29 20 20 20 28 64 62 69 3a 65     ((1)   (dbi:e
4110: 78 65 63 20 64 62 20 22 49 4e 53 45 52 54 20 49  xec db "INSERT I
4120: 4e 54 4f 20 64 61 74 73 20 28 6d 64 35 73 75 6d  NTO dats (md5sum
4130: 2c 64 61 74 2c 74 79 70 65 29 20 56 41 4c 55 45  ,dat,type) VALUE
4140: 53 28 3f 2c 3f 2c 3f 29 3b 22 20 6d 64 35 73 75  S(?,?,?);" md5su
4150: 6d 20 64 61 74 62 6c 6f 62 20 31 29 29 0a 09 20  m datblob 1)).. 
4160: 20 20 20 28 65 6c 73 65 20 20 28 64 62 69 3a 65     (else  (dbi:e
4170: 78 65 63 20 64 62 20 22 49 4e 53 45 52 54 20 49  xec db "INSERT I
4180: 4e 54 4f 20 64 61 74 73 20 28 6d 64 35 73 75 6d  NTO dats (md5sum
4190: 2c 64 61 74 2c 74 79 70 65 29 20 56 41 4c 55 45  ,dat,type) VALUE
41a0: 53 28 3f 2c 3f 2c 3f 29 3b 22 20 6d 64 35 73 75  S(?,?,?);" md5su
41b0: 6d 20 64 61 74 62 6c 6f 62 20 74 79 70 65 29 29  m datblob type))
41c0: 29 0a 09 20 20 28 74 77 69 6b 69 3a 64 61 74 2d  )..  (twiki:dat-
41d0: 65 78 69 73 74 73 3f 20 64 62 20 6d 64 35 73 75  exists? db md5su
41e0: 6d 20 74 79 70 65 29 29 29 29 29 0a 20 20 20 20  m type))))).    
41f0: 20 20 20 0a 28 64 65 66 69 6e 65 20 28 74 77 69     .(define (twi
4200: 6b 69 3a 64 61 74 2d 65 78 69 73 74 73 3f 20 64  ki:dat-exists? d
4210: 62 20 6d 64 35 73 75 6d 20 74 79 70 65 29 0a 20  b md5sum type). 
4220: 20 28 64 62 69 3a 67 65 74 2d 6f 6e 65 20 64 62   (dbi:get-one db
4230: 20 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d   "SELECT id FROM
4240: 20 64 61 74 73 20 57 48 45 52 45 20 6d 64 35 73   dats WHERE md5s
4250: 75 6d 3d 3f 20 41 4e 44 20 74 79 70 65 3d 3f 3b  um=? AND type=?;
4260: 22 20 6d 64 35 73 75 6d 20 74 79 70 65 29 29 0a  " md5sum type)).
4270: 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a  .(define (twiki:
4280: 67 65 74 2d 64 61 74 20 64 62 20 69 64 29 0a 20  get-dat db id). 
4290: 20 28 69 66 20 28 61 6e 64 20 69 64 20 28 6e 75   (if (and id (nu
42a0: 6d 62 65 72 3f 20 69 64 29 29 0a 20 20 20 20 20  mber? id)).     
42b0: 20 28 69 66 20 28 3c 20 69 64 20 30 29 0a 09 20   (if (< id 0).. 
42c0: 20 22 22 0a 09 20 20 28 6c 65 74 20 28 28 72 65   ""..  (let ((re
42d0: 73 20 28 64 62 69 3a 67 65 74 2d 6f 6e 65 2d 72  s (dbi:get-one-r
42e0: 6f 77 20 64 62 20 22 53 45 4c 45 43 54 20 64 61  ow db "SELECT da
42f0: 74 2c 74 79 70 65 20 46 52 4f 4d 20 64 61 74 73  t,type FROM dats
4300: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 69 64   WHERE id=?;" id
4310: 29 29 29 0a 09 20 20 20 20 28 69 66 20 72 65 73  )))..    (if res
4320: 0a 09 09 28 63 61 73 65 20 28 76 65 63 74 6f 72  ...(case (vector
4330: 2d 72 65 66 20 72 65 73 20 31 29 0a 09 09 20 20  -ref res 1)...  
4340: 28 28 30 29 28 62 6c 6f 62 2d 3e 73 74 72 69 6e  ((0)(blob->strin
4350: 67 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65  g (vector-ref re
4360: 73 20 30 29 29 29 0a 09 09 20 20 28 65 6c 73 65  s 0)))...  (else
4370: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 73   (vector-ref res
4380: 20 30 29 29 29 0a 09 09 23 66 29 29 29 0a 20 20   0)))...#f))).  
4390: 20 20 20 20 23 66 29 29 0a 0a 28 64 65 66 69 6e      #f))..(defin
43a0: 65 20 28 74 77 69 6b 69 3a 6d 61 69 6e 74 5f 61  e (twiki:maint_a
43b0: 72 65 61 20 74 64 62 20 77 69 64 20 74 6b 65 79  rea tdb wid tkey
43c0: 20 77 69 6b 69 29 0a 20 20 28 6c 65 74 20 28 28   wiki).  (let ((
43d0: 6d 61 69 6e 74 20 28 73 3a 67 65 74 2d 70 61 72  maint (s:get-par
43e0: 61 6d 20 27 74 77 69 6b 69 5f 6d 61 69 6e 74 29  am 'twiki_maint)
43f0: 29 0a 09 28 77 72 69 74 65 2d 70 65 72 6d 20 28  )..(write-perm (
4400: 6d 65 6d 62 65 72 20 27 77 20 28 74 77 69 6b 69  member 'w (twiki
4410: 3a 77 69 6b 69 2d 67 65 74 2d 70 65 72 6d 73 20  :wiki-get-perms 
4420: 77 69 6b 69 29 29 29 29 0a 20 20 20 20 28 73 3a  wiki)))).    (s:
4430: 64 69 76 20 27 63 6c 61 73 73 20 22 74 77 69 6b  div 'class "twik
4440: 69 2d 6d 65 6e 75 2d 69 6e 74 65 72 6e 61 6c 22  i-menu-internal"
4450: 0a 20 20 20 20 20 28 69 66 20 77 72 69 74 65 2d  .     (if write-
4460: 70 65 72 6d 0a 09 20 28 6c 69 73 74 20 28 73 3a  perm.. (list (s:
4470: 61 20 22 4f 72 70 68 61 6e 73 22 20 20 27 68 72  a "Orphans"  'hr
4480: 65 66 20 28 73 3a 6c 69 6e 6b 2d 74 6f 20 28 74  ef (s:link-to (t
4490: 77 69 6b 69 3a 67 65 74 2d 6c 69 6e 6b 2d 62 61  wiki:get-link-ba
44a0: 63 6b 2d 74 6f 2d 63 75 72 72 65 6e 74 29 20 27  ck-to-current) '
44b0: 74 77 69 6b 69 5f 6d 61 69 6e 74 20 31 29 29 28  twiki_maint 1))(
44c0: 73 3a 62 72 29 0a 09 20 20 20 20 20 20 20 28 73  s:br)..       (s
44d0: 3a 61 20 22 50 69 63 73 22 20 20 20 20 20 27 68  :a "Pics"     'h
44e0: 72 65 66 20 28 73 3a 6c 69 6e 6b 2d 74 6f 20 28  ref (s:link-to (
44f0: 74 77 69 6b 69 3a 67 65 74 2d 6c 69 6e 6b 2d 62  twiki:get-link-b
4500: 61 63 6b 2d 74 6f 2d 63 75 72 72 65 6e 74 29 20  ack-to-current) 
4510: 27 74 77 69 6b 69 5f 6d 61 69 6e 74 20 32 29 29  'twiki_maint 2))
4520: 28 73 3a 62 72 29 0a 09 20 20 20 20 20 20 20 28  (s:br)..       (
4530: 73 3a 61 20 22 48 65 6c 70 22 20 20 20 20 20 27  s:a "Help"     '
4540: 68 72 65 66 20 28 73 3a 6c 69 6e 6b 2d 74 6f 20  href (s:link-to 
4550: 28 74 77 69 6b 69 3a 67 65 74 2d 6c 69 6e 6b 2d  (twiki:get-link-
4560: 62 61 63 6b 2d 74 6f 2d 63 75 72 72 65 6e 74 29  back-to-current)
4570: 20 27 74 77 69 6b 69 5f 6d 61 69 6e 74 20 34 29   'twiki_maint 4)
4580: 29 28 73 3a 62 72 29 29 0a 09 20 27 28 29 29 0a  )(s:br)).. '()).
4590: 20 20 20 20 20 28 73 3a 61 20 22 53 65 61 72 63       (s:a "Searc
45a0: 68 22 20 20 20 27 68 72 65 66 20 28 73 3a 6c 69  h"   'href (s:li
45b0: 6e 6b 2d 74 6f 20 28 74 77 69 6b 69 3a 67 65 74  nk-to (twiki:get
45c0: 2d 6c 69 6e 6b 2d 62 61 63 6b 2d 74 6f 2d 63 75  -link-back-to-cu
45d0: 72 72 65 6e 74 29 20 27 74 77 69 6b 69 5f 6d 61  rrent) 'twiki_ma
45e0: 69 6e 74 20 33 29 29 28 73 3a 62 72 29 0a 20 20  int 3))(s:br).  
45f0: 20 20 20 28 63 61 73 65 20 6d 61 69 6e 74 0a 20     (case maint. 
4600: 20 20 20 20 20 20 28 28 31 29 0a 09 28 74 77 69        ((1)..(twi
4610: 6b 69 3a 6c 69 73 74 2d 6f 72 70 68 61 6e 73 20  ki:list-orphans 
4620: 74 64 62 29 29 0a 20 20 20 20 20 20 20 28 65 6c  tdb)).       (el
4630: 73 65 0a 09 20 27 28 29 29 29 29 29 29 0a 0a 3b  se.. '())))))..;
4640: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;===============
4650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
4660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
4670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
4680: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4f 72 70 68 61  =======.;; Orpha
4690: 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ns.;;===========
46a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
46b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
46c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
46d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66  ===========.(def
46e0: 69 6e 65 20 28 74 77 69 6b 69 3a 6d 61 6b 65 2d  ine (twiki:make-
46f0: 74 69 64 64 6c 65 72 2d 6c 69 73 74 20 74 64 6c  tiddler-list tdl
4700: 72 73 20 2e 20 74 6e 75 6d 73 29 0a 20 20 28 63  rs . tnums).  (c
4710: 6f 6e 63 20 28 73 74 72 69 6e 67 2d 69 6e 74 65  onc (string-inte
4720: 72 73 70 65 72 73 65 20 0a 09 20 28 6d 61 70 20  rsperse .. (map 
4730: 63 6f 6e 63 20 28 64 65 6c 65 74 65 2d 64 75 70  conc (delete-dup
4740: 6c 69 63 61 74 65 73 0a 09 09 20 20 20 20 28 61  licates...    (a
4750: 70 70 65 6e 64 20 28 6d 61 70 20 74 77 69 6b 69  ppend (map twiki
4760: 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d 69 64 20  :tiddler-get-id 
4770: 74 64 6c 72 73 29 20 74 6e 75 6d 73 29 29 29 0a  tdlrs) tnums))).
4780: 09 20 22 2c 22 29 29 29 0a 0a 28 64 65 66 69 6e  . ",")))..(defin
4790: 65 20 28 74 77 69 6b 69 3a 67 65 74 2d 6f 72 70  e (twiki:get-orp
47a0: 68 61 6e 73 20 74 64 62 29 0a 20 20 27 28 29 29  hans tdb).  '())
47b0: 0a 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69  ..(define (twiki
47c0: 3a 6c 69 73 74 2d 6f 72 70 68 61 6e 73 20 74 64  :list-orphans td
47d0: 62 29 0a 20 20 27 28 29 29 0a 0a 3b 3b 3d 3d 3d  b).  '())..;;===
47e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
47f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
4800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
4810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
4820: 3d 3d 3d 0a 3b 3b 20 50 69 63 74 75 72 65 73 0a  ===.;; Pictures.
4830: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;;==============
4840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
4850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
4860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
4870: 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65  ========.(define
4880: 20 28 74 77 69 6b 69 3a 70 69 63 5f 6d 67 6d 74   (twiki:pic_mgmt
4890: 20 74 64 62 20 77 69 64 20 74 6b 65 79 29 0a 20   tdb wid tkey). 
48a0: 20 28 73 3a 64 69 76 20 0a 20 20 20 28 73 3a 61   (s:div .   (s:a
48b0: 20 22 41 64 64 20 70 69 63 22 20 27 68 72 65 66   "Add pic" 'href
48c0: 20 28 73 3a 6c 69 6e 6b 2d 74 6f 20 28 74 77 69   (s:link-to (twi
48d0: 6b 69 3a 67 65 74 2d 6c 69 6e 6b 2d 62 61 63 6b  ki:get-link-back
48e0: 2d 74 6f 2d 63 75 72 72 65 6e 74 29 20 27 74 77  -to-current) 'tw
48f0: 69 6b 69 5f 6d 61 69 6e 74 20 32 20 27 74 77 69  iki_maint 2 'twi
4900: 6b 69 5f 6d 61 69 6e 74 5f 61 64 64 5f 70 69 63  ki_maint_add_pic
4910: 73 20 31 29 29 28 73 3a 62 72 29 0a 20 20 20 28  s 1))(s:br).   (
4920: 69 66 20 28 73 3a 67 65 74 2d 70 61 72 61 6d 20  if (s:get-param 
4930: 22 74 77 69 6b 69 5f 6d 61 69 6e 74 5f 61 64 64  "twiki_maint_add
4940: 5f 70 69 63 73 22 29 0a 20 20 20 20 20 20 20 28  _pics").       (
4950: 73 3a 66 6f 72 6d 20 27 65 6e 63 74 79 70 65 20  s:form 'enctype 
4960: 22 6d 75 6c 74 69 70 61 72 74 2f 66 6f 72 6d 2d  "multipart/form-
4970: 64 61 74 61 22 20 3b 3b 20 27 6e 61 6d 65 20 22  data" ;; 'name "
4980: 64 6f 65 73 2d 61 2d 66 6f 72 6d 2d 68 61 76 65  does-a-form-have
4990: 2d 61 2d 6e 61 6d 65 22 0a 09 20 20 20 20 20 20  -a-name"..      
49a0: 20 28 73 3a 69 6e 70 75 74 20 27 74 79 70 65 20   (s:input 'type 
49b0: 22 66 69 6c 65 22 20 27 6e 61 6d 65 20 22 69 6e  "file" 'name "in
49c0: 70 75 74 2d 70 69 63 74 75 72 65 22 20 27 76 61  put-picture" 'va
49d0: 6c 75 65 20 22 55 70 6c 6f 61 64 20 70 69 63 22  lue "Upload pic"
49e0: 29 0a 09 20 20 20 20 20 20 20 28 73 3a 69 6e 70  )..       (s:inp
49f0: 75 74 20 27 74 79 70 65 20 22 73 75 62 6d 69 74  ut 'type "submit
4a00: 22 20 27 6e 61 6d 65 20 22 73 75 62 6d 69 74 2d  " 'name "submit-
4a10: 70 69 63 74 75 72 65 22 20 27 76 61 6c 75 65 20  picture" 'value 
4a20: 22 53 75 62 6d 69 74 22 29 0a 09 20 20 20 20 20  "Submit")..     
4a30: 20 20 27 6d 65 74 68 6f 64 20 22 70 6f 73 74 22    'method "post"
4a40: 20 0a 09 20 20 20 20 20 20 20 27 61 63 74 69 6f   ..       'actio
4a50: 6e 20 28 73 3a 6c 69 6e 6b 2d 74 6f 20 28 74 77  n (s:link-to (tw
4a60: 69 6b 69 3a 67 65 74 2d 6c 69 6e 6b 2d 62 61 63  iki:get-link-bac
4a70: 6b 2d 74 6f 2d 63 75 72 72 65 6e 74 29 20 27 61  k-to-current) 'a
4a80: 63 74 69 6f 6e 20 28 63 6f 6e 63 20 22 74 77 69  ction (conc "twi
4a90: 6b 69 2e 73 61 76 65 70 69 63 2d 22 20 28 6e 75  ki.savepic-" (nu
4aa0: 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 77 69 64  mber->string wid
4ab0: 29 20 22 2d 22 20 28 74 77 69 6b 69 3a 77 65 62  ) "-" (twiki:web
4ac0: 36 34 65 6e 63 20 74 6b 65 79 29 29 29 0a 09 20  64enc tkey))).. 
4ad0: 20 20 20 20 20 20 28 73 3a 69 6e 70 75 74 20 27        (s:input '
4ae0: 74 79 70 65 20 22 74 65 78 74 22 20 27 6e 61 6d  type "text" 'nam
4af0: 65 20 22 70 69 63 74 75 72 65 2d 6e 61 6d 65 22  e "picture-name"
4b00: 20 27 76 61 6c 75 65 20 22 22 29 29 0a 20 20 20   'value "")).   
4b10: 20 20 20 20 27 28 29 29 0a 20 20 20 28 6c 65 74      '()).   (let
4b20: 20 28 28 70 69 63 73 20 28 64 62 69 3a 67 65 74   ((pics (dbi:get
4b30: 2d 72 6f 77 73 20 74 64 62 20 22 53 45 4c 45 43  -rows tdb "SELEC
4b40: 54 20 69 64 2c 6e 61 6d 65 2c 64 61 74 5f 69 64  T id,name,dat_id
4b50: 2c 74 68 75 6d 62 5f 64 61 74 5f 69 64 20 46 52  ,thumb_dat_id FR
4b60: 4f 4d 20 70 69 63 73 20 57 48 45 52 45 20 77 69  OM pics WHERE wi
4b70: 6b 69 5f 69 64 3d 3f 3b 22 20 77 69 64 29 29 29  ki_id=?;" wid)))
4b80: 0a 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62  .     (map (lamb
4b90: 64 61 20 28 70 69 63 29 0a 09 20 20 20 20 28 73  da (pic)..    (s
4ba0: 3a 64 69 76 20 27 63 6c 61 73 73 20 22 74 69 64  :div 'class "tid
4bb0: 64 6c 65 72 74 68 75 6d 62 22 0a 09 09 20 20 20  dlerthumb"...   
4bc0: 28 73 3a 69 6d 67 20 27 74 69 74 6c 65 20 28 76  (s:img 'title (v
4bd0: 65 63 74 6f 72 2d 72 65 66 20 70 69 63 20 31 29  ector-ref pic 1)
4be0: 20 27 61 6c 74 20 28 76 65 63 74 6f 72 2d 72 65   'alt (vector-re
4bf0: 66 20 70 69 63 20 31 29 0a 09 09 20 09 20 20 3b  f pic 1)... .  ;
4c00: 3b 20 27 73 72 63 20 28 73 3a 6c 69 6e 6b 2d 74  ; 'src (s:link-t
4c10: 6f 20 22 74 77 69 6b 69 22 20 27 77 69 6b 69 5f  o "twiki" 'wiki_
4c20: 6b 65 79 20 28 74 77 69 6b 69 3a 77 65 62 36 34  key (twiki:web64
4c30: 65 6e 63 20 74 6b 65 79 29 20 27 69 6d 61 67 65  enc tkey) 'image
4c40: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 70 69    (vector-ref pi
4c50: 63 20 30 29 29 29 0a 09 09 20 09 20 20 27 73 72  c 0)))... .  'sr
4c60: 63 20 28 73 3a 6c 69 6e 6b 2d 74 6f 20 22 74 77  c (s:link-to "tw
4c70: 69 6b 69 22 20 27 77 69 6b 69 5f 6b 65 79 20 28  iki" 'wiki_key (
4c80: 63 6f 6e 63 20 28 6e 75 6d 62 65 72 2d 3e 73 74  conc (number->st
4c90: 72 69 6e 67 20 77 69 64 29 20 22 2d 22 20 28 74  ring wid) "-" (t
4ca0: 77 69 6b 69 3a 77 65 62 36 34 65 6e 63 20 74 6b  wiki:web64enc tk
4cb0: 65 79 29 29 0a 09 09 09 09 09 20 20 27 74 68 75  ey))......  'thu
4cc0: 6d 62 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20  mb  (vector-ref 
4cd0: 70 69 63 20 30 29 29 29 0a 09 09 20 20 20 3b 3b  pic 0)))...   ;;
4ce0: 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 74 77         (conc "tw
4cf0: 69 6b 69 2f 22 20 77 69 64 20 22 2f 74 68 75 6d  iki/" wid "/thum
4d00: 62 73 2f 22 20 28 76 65 63 74 6f 72 2d 72 65 66  bs/" (vector-ref
4d10: 20 70 69 63 20 30 29 29 29 29 0a 09 09 20 20 20   pic 0))))...   
4d20: 28 76 65 63 74 6f 72 2d 72 65 66 20 70 69 63 20  (vector-ref pic 
4d30: 30 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 70  0) (vector-ref p
4d40: 69 63 20 31 29 29 29 0a 09 20 20 70 69 63 73 29  ic 1)))..  pics)
4d50: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 20 28 74  )))..(define  (t
4d60: 77 69 6b 69 3a 73 61 76 65 2d 70 69 63 2d 66 72  wiki:save-pic-fr
4d70: 6f 6d 2d 66 6f 72 6d 20 74 64 62 20 77 69 64 29  om-form tdb wid)
4d80: 0a 20 20 28 6c 65 74 2a 20 28 28 70 69 63 2d 64  .  (let* ((pic-d
4d90: 61 74 20 20 28 73 3a 67 65 74 2d 69 6e 70 75 74  at  (s:get-input
4da0: 20 27 69 6e 70 75 74 2d 70 69 63 74 75 72 65 29   'input-picture)
4db0: 29 0a 09 20 28 61 6c 74 2d 6e 61 6d 65 20 28 73  ).. (alt-name (s
4dc0: 3a 67 65 74 2d 69 6e 70 75 74 20 27 70 69 63 74  :get-input 'pict
4dd0: 75 72 65 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20  ure-name))).    
4de0: 28 69 66 20 70 69 63 2d 64 61 74 0a 09 28 62 65  (if pic-dat..(be
4df0: 67 69 6e 0a 09 20 20 28 73 3a 6c 6f 67 20 22 74  gin..  (s:log "t
4e00: 77 69 6b 69 3a 73 61 76 65 2d 70 69 63 2d 66 72  wiki:save-pic-fr
4e10: 6f 6d 2d 66 6f 72 6d 20 77 69 74 68 20 70 69 63  om-form with pic
4e20: 2d 64 61 74 3d 22 20 70 69 63 2d 64 61 74 20 22  -dat=" pic-dat "
4e30: 20 61 6e 64 20 61 6c 74 2d 6e 61 6d 65 3d 22 20   and alt-name=" 
4e40: 61 6c 74 2d 6e 61 6d 65 29 0a 09 20 20 28 74 77  alt-name)..  (tw
4e50: 69 6b 69 3a 73 61 76 65 2d 70 69 63 20 74 64 62  iki:save-pic tdb
4e60: 20 70 69 63 2d 64 61 74 20 77 69 64 20 61 6c 74   pic-dat wid alt
4e70: 2d 6e 61 6d 65 29 29 0a 09 23 66 29 29 29 0a 0a  -name))..#f)))..
4e80: 3b 3b 20 67 65 74 20 70 69 63 20 69 64 20 66 6f  ;; get pic id fo
4e90: 72 20 61 20 70 69 63 20 6e 61 6d 65 2c 20 72 65  r a pic name, re
4ea0: 74 75 72 6e 73 20 74 68 65 20 6c 61 74 65 73 74  turns the latest
4eb0: 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a  .(define (twiki:
4ec0: 67 65 74 2d 70 69 63 2d 69 64 20 74 64 62 20 70  get-pic-id tdb p
4ed0: 69 63 2d 6e 61 6d 65 20 77 69 64 29 0a 20 20 28  ic-name wid).  (
4ee0: 64 62 69 3a 67 65 74 2d 6f 6e 65 20 74 64 62 20  dbi:get-one tdb 
4ef0: 22 53 45 4c 45 43 54 20 70 69 63 73 2e 69 64 20  "SELECT pics.id 
4f00: 46 52 4f 4d 20 70 69 63 73 20 57 48 45 52 45 20  FROM pics WHERE 
4f10: 70 69 63 73 2e 6e 61 6d 65 3d 3f 20 41 4e 44 20  pics.name=? AND 
4f20: 70 69 63 73 2e 77 69 6b 69 5f 69 64 3d 3f 20 4f  pics.wiki_id=? O
4f30: 52 44 45 52 20 42 59 20 70 69 63 73 2e 69 64 20  RDER BY pics.id 
4f40: 44 45 53 43 20 4c 49 4d 49 54 20 31 3b 22 20 70  DESC LIMIT 1;" p
4f50: 69 63 2d 6e 61 6d 65 20 77 69 64 29 29 0a 0a 28  ic-name wid))..(
4f60: 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 73 61  define (twiki:sa
4f70: 76 65 2d 70 69 63 20 74 64 62 20 70 69 63 2d 64  ve-pic tdb pic-d
4f80: 61 74 20 77 69 64 20 61 6c 74 29 0a 20 20 28 6c  at wid alt).  (l
4f90: 65 74 20 28 28 70 69 63 2d 6e 61 6d 65 20 28 63  et ((pic-name (c
4fa0: 61 72 20 70 69 63 2d 64 61 74 29 29 0a 09 28 70  ar pic-dat))..(p
4fb0: 69 63 2d 74 79 70 65 20 28 63 61 64 72 20 70 69  ic-type (cadr pi
4fc0: 63 2d 64 61 74 29 29 0a 09 28 70 69 63 2d 64 61  c-dat))..(pic-da
4fd0: 74 61 20 28 63 61 64 64 72 20 70 69 63 2d 64 61  ta (caddr pic-da
4fe0: 74 29 29 0a 09 3b 3b 20 49 27 6d 20 6e 6f 74 20  t))..;; I'm not 
4ff0: 74 6f 6f 20 68 61 70 70 79 20 77 69 74 68 20 74  too happy with t
5000: 68 69 73 20 73 6f 6c 75 74 69 6f 6e 20 62 75 74  his solution but
5010: 20 49 20 63 61 6e 27 74 20 73 65 65 6d 20 74 6f   I can't seem to
5020: 20 63 68 6f 6d 70 20 74 68 65 20 5c 6e 5c 64 20   chomp the \n\d 
5030: 66 72 6f 6d 20 74 68 65 20 65 6e 64 20 6f 66 20  from the end of 
5040: 74 68 65 20 73 74 72 69 6e 67 0a 09 28 61 6c 74  the string..(alt
5050: 2d 6e 61 6d 65 20 28 69 66 20 61 6c 74 20 28 73  -name (if alt (s
5060: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65  tring-substitute
5070: 20 28 72 65 67 65 78 70 20 22 5b 5e 5c 5c 77 20   (regexp "[^\\w 
5080: 5d 22 29 20 22 22 20 61 6c 74 20 23 74 29 20 23  ]") "" alt #t) #
5090: 66 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e  f))).    (if (an
50a0: 64 20 61 6c 74 2d 6e 61 6d 65 0a 09 20 20 20 20  d alt-name..    
50b0: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28   (string-match (
50c0: 72 65 67 65 78 70 20 22 5c 5c 77 2b 22 29 20 61  regexp "\\w+") a
50d0: 6c 74 2d 6e 61 6d 65 29 29 0a 09 28 73 65 74 21  lt-name))..(set!
50e0: 20 70 69 63 2d 6e 61 6d 65 20 61 6c 74 2d 6e 61   pic-name alt-na
50f0: 6d 65 29 29 0a 20 20 20 20 28 73 3a 6c 6f 67 20  me)).    (s:log 
5100: 22 61 6c 74 3a 20 22 20 61 6c 74 20 22 20 61 6c  "alt: " alt " al
5110: 74 2d 6e 61 6d 65 3a 20 22 20 61 6c 74 2d 6e 61  t-name: " alt-na
5120: 6d 65 29 0a 20 20 20 20 28 69 66 20 70 69 63 2d  me).    (if pic-
5130: 64 61 74 61 0a 09 28 6c 65 74 20 28 28 64 61 74  data..(let ((dat
5140: 2d 69 64 20 28 74 77 69 6b 69 3a 73 61 76 65 2d  -id (twiki:save-
5150: 64 61 74 20 74 64 62 20 70 69 63 2d 64 61 74 61  dat tdb pic-data
5160: 20 28 74 77 69 6b 69 3a 6d 69 6d 65 2d 3e 74 77   (twiki:mime->tw
5170: 69 6b 69 2d 74 79 70 65 20 70 69 63 2d 74 79 70  iki-type pic-typ
5180: 65 29 29 29 0a 09 20 20 20 20 20 20 28 63 72 65  e)))..      (cre
5190: 61 74 69 6f 6e 2d 74 69 6d 65 20 28 63 75 72 72  ation-time (curr
51a0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09  ent-seconds)))..
51b0: 20 20 3b 3b 20 28 74 77 69 6b 69 3a 64 65 6c 65    ;; (twiki:dele
51c0: 74 65 2d 70 69 63 2d 62 79 2d 6e 61 6d 65 20 74  te-pic-by-name t
51d0: 64 62 20 70 69 63 2d 6e 61 6d 65 29 0a 09 20 20  db pic-name)..  
51e0: 28 64 62 69 3a 65 78 65 63 20 74 64 62 20 0a 09  (dbi:exec tdb ..
51f0: 09 20 20 20 20 22 49 4e 53 45 52 54 20 49 4e 54  .    "INSERT INT
5200: 4f 20 70 69 63 73 20 28 6e 61 6d 65 2c 77 69 6b  O pics (name,wik
5210: 69 5f 69 64 2c 64 61 74 5f 69 64 2c 63 72 65 61  i_id,dat_id,crea
5220: 74 65 64 5f 6f 6e 2c 6f 77 6e 65 72 5f 69 64 29  ted_on,owner_id)
5230: 20 56 41 4c 55 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c   VALUES(?,?,?,?,
5240: 3f 29 3b 22 0a 09 09 20 20 20 20 70 69 63 2d 6e  ?);"...    pic-n
5250: 61 6d 65 20 77 69 64 20 64 61 74 2d 69 64 20 63  ame wid dat-id c
5260: 72 65 61 74 69 6f 6e 2d 74 69 6d 65 20 28 74 77  reation-time (tw
5270: 69 6b 69 3a 67 65 74 2d 69 64 29 29 0a 09 20 20  iki:get-id))..  
5280: 28 6c 65 74 20 28 28 70 69 63 2d 69 64 20 28 74  (let ((pic-id (t
5290: 77 69 6b 69 3a 67 65 74 2d 70 69 63 2d 69 64 20  wiki:get-pic-id 
52a0: 74 64 62 20 70 69 63 2d 6e 61 6d 65 20 77 69 64  tdb pic-name wid
52b0: 29 29 29 0a 09 20 20 20 20 28 74 77 69 6b 69 3a  )))..    (twiki:
52c0: 6d 61 6b 65 2d 74 68 75 6d 62 6e 61 69 6c 20 74  make-thumbnail t
52d0: 64 62 20 70 69 63 2d 69 64 20 77 69 64 29 29 0a  db pic-id wid)).
52e0: 09 20 20 23 74 29 0a 09 23 66 29 29 29 0a 0a 28  .  #t)..#f)))..(
52f0: 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 67 65  define (twiki:ge
5300: 74 2d 70 69 63 2d 64 61 74 20 74 64 62 20 77 69  t-pic-dat tdb wi
5310: 64 20 70 69 63 2d 69 64 29 0a 20 20 28 64 62 69  d pic-id).  (dbi
5320: 3a 67 65 74 2d 6f 6e 65 20 74 64 62 20 22 53 45  :get-one tdb "SE
5330: 4c 45 43 54 20 64 61 74 20 46 52 4f 4d 20 70 69  LECT dat FROM pi
5340: 63 73 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 64 61  cs INNER JOIN da
5350: 74 73 20 4f 4e 20 70 69 63 73 2e 64 61 74 5f 69  ts ON pics.dat_i
5360: 64 3d 64 61 74 73 2e 69 64 20 57 48 45 52 45 20  d=dats.id WHERE 
5370: 70 69 63 73 2e 69 64 3d 3f 20 41 4e 44 20 77 69  pics.id=? AND wi
5380: 6b 69 5f 69 64 3d 3f 3b 22 20 70 69 63 2d 69 64  ki_id=?;" pic-id
5390: 20 77 69 64 29 29 0a 0a 28 64 65 66 69 6e 65 20   wid))..(define 
53a0: 28 74 77 69 6b 69 3a 67 65 74 2d 74 68 75 6d 62  (twiki:get-thumb
53b0: 2d 64 61 74 20 74 64 62 20 77 69 64 20 70 69 63  -dat tdb wid pic
53c0: 2d 69 64 29 0a 20 20 28 64 62 69 3a 67 65 74 2d  -id).  (dbi:get-
53d0: 6f 6e 65 20 74 64 62 20 22 53 45 4c 45 43 54 20  one tdb "SELECT 
53e0: 64 61 74 20 46 52 4f 4d 20 70 69 63 73 20 49 4e  dat FROM pics IN
53f0: 4e 45 52 20 4a 4f 49 4e 20 64 61 74 73 20 4f 4e  NER JOIN dats ON
5400: 20 70 69 63 73 2e 74 68 75 6d 62 5f 64 61 74 5f   pics.thumb_dat_
5410: 69 64 3d 64 61 74 73 2e 69 64 20 57 48 45 52 45  id=dats.id WHERE
5420: 20 70 69 63 73 2e 69 64 3d 3f 20 41 4e 44 20 77   pics.id=? AND w
5430: 69 6b 69 5f 69 64 3d 3f 3b 22 20 70 69 63 2d 69  iki_id=?;" pic-i
5440: 64 20 77 69 64 29 29 0a 0a 3b 3b 20 74 68 69 73  d wid))..;; this
5450: 20 6f 6e 65 20 73 65 74 73 20 75 70 20 74 68 65   one sets up the
5460: 20 43 6f 6e 74 65 6e 74 20 74 79 70 65 2c 20 70   Content type, p
5470: 75 74 73 20 74 68 65 20 64 61 74 61 20 69 6e 74  uts the data int
5480: 6f 20 70 61 67 65 2d 64 61 74 20 61 6e 64 20 69  o page-dat and i
5490: 73 20 64 6f 6e 65 0a 28 64 65 66 69 6e 65 20 28  s done.(define (
54a0: 74 77 69 6b 69 3a 72 65 74 75 72 6e 2d 69 6d 61  twiki:return-ima
54b0: 67 65 2d 64 61 74 20 74 64 62 20 77 69 64 20 70  ge-dat tdb wid p
54c0: 69 63 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28  ic-id).  (let ((
54d0: 64 61 74 20 20 28 74 77 69 6b 69 3a 67 65 74 2d  dat  (twiki:get-
54e0: 70 69 63 2d 64 61 74 20 74 64 62 20 77 69 64 20  pic-dat tdb wid 
54f0: 70 69 63 2d 69 64 29 29 29 0a 20 20 20 20 28 73  pic-id))).    (s
5500: 3a 6c 6f 67 20 22 74 77 69 6b 69 3a 72 65 74 75  :log "twiki:retu
5510: 72 6e 2d 69 6d 61 67 65 2d 64 61 74 20 64 61 74  rn-image-dat dat
5520: 20 69 73 3a 20 22 20 64 61 74 20 22 20 6f 66 20   is: " dat " of 
5530: 73 69 7a 65 3a 20 22 20 28 69 66 20 28 62 6c 6f  size: " (if (blo
5540: 62 3f 20 64 61 74 29 28 62 6c 6f 62 2d 73 69 7a  b? dat)(blob-siz
5550: 65 20 64 61 74 29 20 22 5b 6e 6f 74 20 61 20 62  e dat) "[not a b
5560: 6c 6f 62 5d 22 29 29 0a 20 20 20 20 28 73 64 61  lob]")).    (sda
5570: 74 2d 73 65 74 2d 70 61 67 65 2d 74 79 70 65 21  t-set-page-type!
5580: 20 20 20 20 73 3a 73 65 73 73 69 6f 6e 20 27 69      s:session 'i
5590: 6d 61 67 65 29 0a 20 20 20 20 28 73 64 61 74 2d  mage).    (sdat-
55a0: 73 65 74 2d 63 6f 6e 74 65 6e 74 2d 74 79 70 65  set-content-type
55b0: 21 20 73 3a 73 65 73 73 69 6f 6e 20 22 69 6d 61  ! s:session "ima
55c0: 67 65 2f 6a 70 65 67 22 29 0a 20 20 20 20 28 73  ge/jpeg").    (s
55d0: 64 61 74 2d 73 65 74 2d 61 6c 74 2d 70 61 67 65  dat-set-alt-page
55e0: 2d 64 61 74 21 20 73 3a 73 65 73 73 69 6f 6e 20  -dat! s:session 
55f0: 64 61 74 29 29 29 0a 20 20 20 20 3b 3b 20 28 73  dat))).    ;; (s
5600: 65 73 73 69 6f 6e 3a 61 6c 74 2d 6f 75 74 20 73  ession:alt-out s
5610: 3a 73 65 73 73 69 6f 6e 29 29 29 0a 0a 3b 3b 20  :session)))..;; 
5620: 74 68 69 73 20 6f 6e 65 20 73 65 74 73 20 75 70  this one sets up
5630: 20 74 68 65 20 43 6f 6e 74 65 6e 74 20 74 79 70   the Content typ
5640: 65 2c 20 70 75 74 73 20 74 68 65 20 64 61 74 61  e, puts the data
5650: 20 69 6e 74 6f 20 70 61 67 65 2d 64 61 74 20 61   into page-dat a
5660: 6e 64 20 69 73 20 64 6f 6e 65 0a 28 64 65 66 69  nd is done.(defi
5670: 6e 65 20 28 74 77 69 6b 69 3a 72 65 74 75 72 6e  ne (twiki:return
5680: 2d 74 68 75 6d 62 2d 64 61 74 20 74 64 62 20 77  -thumb-dat tdb w
5690: 69 64 20 70 69 63 2d 69 64 29 0a 20 20 28 6c 65  id pic-id).  (le
56a0: 74 20 28 28 64 61 74 20 20 28 74 77 69 6b 69 3a  t ((dat  (twiki:
56b0: 67 65 74 2d 74 68 75 6d 62 2d 64 61 74 20 74 64  get-thumb-dat td
56c0: 62 20 77 69 64 20 70 69 63 2d 69 64 29 29 29 0a  b wid pic-id))).
56d0: 20 20 20 20 28 73 3a 6c 6f 67 20 22 74 77 69 6b      (s:log "twik
56e0: 69 3a 72 65 74 75 72 6e 2d 69 6d 61 67 65 2d 64  i:return-image-d
56f0: 61 74 20 64 61 74 20 69 73 3a 20 22 20 64 61 74  at dat is: " dat
5700: 20 22 20 6f 66 20 73 69 7a 65 3a 20 22 20 28 69   " of size: " (i
5710: 66 20 28 62 6c 6f 62 3f 20 64 61 74 29 28 62 6c  f (blob? dat)(bl
5720: 6f 62 2d 73 69 7a 65 20 64 61 74 29 20 22 5b 6e  ob-size dat) "[n
5730: 6f 74 20 61 20 62 6c 6f 62 5d 22 29 29 0a 20 20  ot a blob]")).  
5740: 20 20 28 73 64 61 74 2d 73 65 74 2d 70 61 67 65    (sdat-set-page
5750: 2d 74 79 70 65 21 20 20 20 20 73 3a 73 65 73 73  -type!    s:sess
5760: 69 6f 6e 20 27 69 6d 61 67 65 29 0a 20 20 20 20  ion 'image).    
5770: 28 73 64 61 74 2d 73 65 74 2d 63 6f 6e 74 65 6e  (sdat-set-conten
5780: 74 2d 74 79 70 65 21 20 73 3a 73 65 73 73 69 6f  t-type! s:sessio
5790: 6e 20 22 69 6d 61 67 65 2f 6a 70 65 67 22 29 0a  n "image/jpeg").
57a0: 20 20 20 20 28 73 64 61 74 2d 73 65 74 2d 61 6c      (sdat-set-al
57b0: 74 2d 70 61 67 65 2d 64 61 74 21 20 73 3a 73 65  t-page-dat! s:se
57c0: 73 73 69 6f 6e 20 64 61 74 29 29 29 0a 20 20 20  ssion dat))).   
57d0: 20 3b 3b 20 28 73 65 73 73 69 6f 6e 3a 61 6c 74   ;; (session:alt
57e0: 2d 6f 75 74 20 73 3a 73 65 73 73 69 6f 6e 29 29  -out s:session))
57f0: 29 0a 20 20 0a 28 64 65 66 69 6e 65 20 28 74 77  ).  .(define (tw
5800: 69 6b 69 3a 6d 61 6b 65 2d 74 68 75 6d 62 6e 61  iki:make-thumbna
5810: 69 6c 20 74 64 62 20 70 69 63 2d 69 64 20 77 69  il tdb pic-id wi
5820: 64 29 0a 20 20 28 6c 65 74 20 28 28 69 6e 64 61  d).  (let ((inda
5830: 74 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 70 69  t  (twiki:get-pi
5840: 63 2d 64 61 74 20 74 64 62 20 77 69 64 20 70 69  c-dat tdb wid pi
5850: 63 2d 69 64 29 29 29 0a 20 20 20 20 3b 3b 20 20  c-id))).    ;;  
5860: 20 28 6f 75 74 64 61 74 20 28 6f 70 65 6e 2d 6f   (outdat (open-o
5870: 75 74 70 75 74 2d 73 74 72 69 6e 67 29 29 29 0a  utput-string))).
5880: 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20      (let-values 
5890: 28 28 28 69 6e 70 20 6f 75 70 20 70 69 64 29 28  (((inp oup pid)(
58a0: 70 72 6f 63 65 73 73 20 22 63 6f 6e 76 65 72 74  process "convert
58b0: 22 20 28 6c 69 73 74 20 22 2d 73 69 7a 65 22 20  " (list "-size" 
58c0: 22 35 30 30 78 31 38 30 22 20 22 2d 22 20 22 2d  "500x180" "-" "-
58d0: 74 68 75 6d 62 6e 61 69 6c 22 20 22 32 35 30 78  thumbnail" "250x
58e0: 39 30 22 20 22 2d 75 6e 73 68 61 72 70 22 20 22  90" "-unsharp" "
58f0: 30 78 2e 35 22 20 22 2d 22 29 29 29 29 0a 09 09  0x.5" "-"))))...
5900: 28 77 72 69 74 65 2d 73 74 72 69 6e 67 20 28 62  (write-string (b
5910: 6c 6f 62 2d 3e 73 74 72 69 6e 67 20 69 6e 64 61  lob->string inda
5920: 74 29 20 23 66 20 6f 75 70 29 0a 09 09 28 63 6c  t) #f oup)...(cl
5930: 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 20 6f  ose-input-port o
5940: 75 70 29 0a 09 09 3b 3b 20 28 77 72 69 74 65 2d  up)...;; (write-
5950: 73 74 72 69 6e 67 20 23 66 20 69 6e 70 20 28 62  string #f inp (b
5960: 6c 6f 62 2d 3e 73 74 72 69 6e 67 20 69 6e 64 61  lob->string inda
5970: 74 29 29 0a 09 09 28 6c 65 74 20 28 28 6c 20 28  t))...(let ((l (
5980: 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66 20 69  read-string #f i
5990: 6e 70 29 29 29 0a 09 09 20 20 28 63 6c 6f 73 65  np)))...  (close
59a0: 2d 6f 75 74 70 75 74 2d 70 6f 72 74 20 69 6e 70  -output-port inp
59b0: 29 0a 09 09 20 20 3b 3b 20 28 77 72 69 74 65 2d  )...  ;; (write-
59c0: 73 74 72 69 6e 67 20 6c 20 23 66 20 6f 75 74 64  string l #f outd
59d0: 61 74 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 28  at)...  (let* ((
59e0: 6e 65 77 64 61 74 20 28 73 74 72 69 6e 67 2d 3e  newdat (string->
59f0: 62 6c 6f 62 20 6c 29 29 20 3b 3b 20 28 67 65 74  blob l)) ;; (get
5a00: 2d 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 20 6f  -output-string o
5a10: 75 74 64 61 74 29 29 29 0a 09 09 09 20 28 64 61  utdat))).... (da
5a20: 74 2d 69 64 20 28 74 77 69 6b 69 3a 73 61 76 65  t-id (twiki:save
5a30: 2d 64 61 74 20 74 64 62 20 6e 65 77 64 61 74 20  -dat tdb newdat 
5a40: 32 29 29 29 20 3b 3b 20 62 75 67 3f 0a 09 09 20  2))) ;; bug?... 
5a50: 20 20 20 28 64 62 69 3a 65 78 65 63 20 74 64 62     (dbi:exec tdb
5a60: 20 22 55 50 44 41 54 45 20 70 69 63 73 20 53 45   "UPDATE pics SE
5a70: 54 20 74 68 75 6d 62 5f 64 61 74 5f 69 64 3d 3f  T thumb_dat_id=?
5a80: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 64 61   WHERE id=?;" da
5a90: 74 2d 69 64 20 70 69 63 2d 69 64 29 0a 09 09 20  t-id pic-id)... 
5aa0: 20 20 20 64 61 74 2d 69 64 29 29 29 29 29 0a 0a     dat-id)))))..
5ab0: 3b 3b 20 6e 6f 74 20 74 65 73 74 65 64 0a 28 64  ;; not tested.(d
5ac0: 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 70 69 63  efine (twiki:pic
5ad0: 64 61 74 2d 3e 74 68 75 6d 62 64 61 74 20 70 69  dat->thumbdat pi
5ae0: 63 64 61 74 29 0a 20 20 28 6c 65 74 2d 76 61 6c  cdat).  (let-val
5af0: 75 65 73 20 28 28 28 69 6e 70 20 6f 75 70 20 70  ues (((inp oup p
5b00: 69 64 29 28 70 72 6f 63 65 73 73 20 22 63 6f 6e  id)(process "con
5b10: 76 65 72 74 22 20 3b 3b 20 28 6c 69 73 74 20 22  vert" ;; (list "
5b20: 2d 73 69 7a 65 22 20 22 35 30 30 78 31 38 30 22  -size" "500x180"
5b30: 20 22 2d 22 20 22 2d 74 68 75 6d 62 6e 61 69 6c   "-" "-thumbnail
5b40: 22 20 22 32 35 30 78 39 30 22 20 22 2d 75 6e 73  " "250x90" "-uns
5b50: 68 61 72 70 22 20 22 30 78 2e 35 22 20 22 2d 22  harp" "0x.5" "-"
5b60: 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28  )))).....      (
5b70: 6c 69 73 74 20 22 2d 73 69 7a 65 22 20 22 35 30  list "-size" "50
5b80: 30 78 31 38 30 22 20 22 2d 22 20 22 2d 74 68 75  0x180" "-" "-thu
5b90: 6d 62 6e 61 69 6c 22 20 22 32 30 30 78 37 30 22  mbnail" "200x70"
5ba0: 20 22 2d 75 6e 73 68 61 72 70 22 20 22 30 78 2e   "-unsharp" "0x.
5bb0: 35 22 20 22 2d 22 29 29 29 29 0a 09 20 20 20 20  5" "-"))))..    
5bc0: 20 20 28 77 72 69 74 65 2d 73 74 72 69 6e 67 20    (write-string 
5bd0: 28 62 6c 6f 62 2d 3e 73 74 72 69 6e 67 20 70 69  (blob->string pi
5be0: 63 64 61 74 29 20 23 66 20 6f 75 70 29 0a 09 20  cdat) #f oup).. 
5bf0: 20 20 20 20 20 28 63 6c 6f 73 65 2d 69 6e 70 75       (close-inpu
5c00: 74 2d 70 6f 72 74 20 6f 75 70 29 0a 09 20 20 20  t-port oup)..   
5c10: 20 20 20 3b 3b 20 28 77 72 69 74 65 2d 73 74 72     ;; (write-str
5c20: 69 6e 67 20 23 66 20 69 6e 70 20 28 62 6c 6f 62  ing #f inp (blob
5c30: 2d 3e 73 74 72 69 6e 67 20 69 6e 64 61 74 29 29  ->string indat))
5c40: 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c  ..      (let ((l
5c50: 20 28 72 65 61 64 2d 73 74 72 69 6e 67 20 23 66   (read-string #f
5c60: 20 69 6e 70 29 29 29 0a 09 09 28 63 6c 6f 73 65   inp)))...(close
5c70: 2d 6f 75 74 70 75 74 2d 70 6f 72 74 20 69 6e 70  -output-port inp
5c80: 29 0a 09 09 28 77 72 69 74 65 2d 73 74 72 69 6e  )...(write-strin
5c90: 67 20 6c 20 23 66 20 6f 75 70 29 0a 09 09 28 73  g l #f oup)...(s
5ca0: 74 72 69 6e 67 2d 3e 62 6c 6f 62 20 6c 29 29 29  tring->blob l)))
5cb0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b  )..(define (twik
5cc0: 69 3a 6d 69 6d 65 2d 3e 74 77 69 6b 69 2d 74 79  i:mime->twiki-ty
5cd0: 70 65 20 6d 69 6d 65 2d 74 79 70 65 29 0a 20 20  pe mime-type).  
5ce0: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73  (case (string->s
5cf0: 79 6d 62 6f 6c 20 6d 69 6d 65 2d 74 79 70 65 29  ymbol mime-type)
5d00: 0a 20 20 20 20 28 28 69 6d 61 67 65 2f 6a 70 65  .    ((image/jpe
5d10: 67 29 20 31 29 0a 20 20 20 20 28 28 69 6d 61 67  g) 1).    ((imag
5d20: 65 2f 70 6e 67 29 20 20 32 29 0a 20 20 20 20 28  e/png)  2).    (
5d30: 65 6c 73 65 20 30 29 29 29 0a 0a 3b 3b 3d 3d 3d  else 0)))..;;===
5d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5d80: 3d 3d 3d 0a 3b 3b 20 57 69 6b 69 20 73 74 75 66  ===.;; Wiki stuf
5d90: 66 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  f.;;============
5da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 63  ==========..;; c
5de0: 75 72 72 2d 74 69 64 64 6c 65 72 73 20 69 73 20  urr-tiddlers is 
5df0: 61 20 6c 69 73 74 20 6f 66 20 74 68 65 20 6e 61  a list of the na
5e00: 6d 65 73 20 6f 66 20 74 68 65 20 63 75 72 72 65  mes of the curre
5e10: 6e 74 20 74 69 64 64 6c 65 72 73 20 64 69 73 70  nt tiddlers disp
5e20: 6c 61 79 65 64 0a 3b 3b 20 74 69 64 64 6c 65 72  layed.;; tiddler
5e30: 2d 75 6e 64 65 72 2d 65 64 69 74 20 69 73 20 74  -under-edit is t
5e40: 68 65 20 74 69 64 64 6c 65 72 20 62 65 69 6e 67  he tiddler being
5e50: 20 65 64 69 74 65 64 20 28 6f 72 20 23 66 20 66   edited (or #f f
5e60: 6f 72 20 6e 6f 6e 65 29 2e 0a 28 64 65 66 69 6e  or none)..(defin
5e70: 65 20 28 74 77 69 6b 69 3a 77 69 6b 69 20 6e 61  e (twiki:wiki na
5e80: 6d 65 20 6b 65 79 73 29 0a 20 20 28 6c 65 74 20  me keys).  (let 
5e90: 28 28 70 65 72 6d 73 20 20 20 28 74 77 69 6b 69  ((perms   (twiki
5ea0: 3a 61 63 63 65 73 73 20 6e 61 6d 65 20 6b 65 79  :access name key
5eb0: 73 20 28 74 77 69 6b 69 3a 67 65 74 2d 69 64 29  s (twiki:get-id)
5ec0: 29 29 29 0a 20 20 20 20 3b 3b 20 28 73 3a 6c 6f  ))).    ;; (s:lo
5ed0: 67 20 22 74 77 69 6b 69 3a 77 69 6b 69 20 6e 61  g "twiki:wiki na
5ee0: 6d 65 3a 20 5c 22 22 20 6e 61 6d 65 20 22 5c 22  me: \"" name "\"
5ef0: 20 6b 65 79 73 3a 20 22 20 6b 65 79 73 29 0a 20   keys: " keys). 
5f00: 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20     (if (or (not 
5f10: 6e 61 6d 65 29 0a 09 20 20 20 20 28 73 74 72 69  name)..    (stri
5f20: 6e 67 3d 3f 20 6e 61 6d 65 20 22 22 29 29 20 3b  ng=? name "")) ;
5f30: 3b 20 6e 61 6d 65 20 6d 75 73 74 20 62 65 20 22  ; name must be "
5f40: 22 20 6f 72 20 23 66 20 74 6f 20 67 65 74 20 68  " or #f to get h
5f50: 65 72 65 20 61 6e 64 20 72 65 74 75 72 6e 20 61  ere and return a
5f60: 6e 20 69 6d 61 67 65 0a 09 3b 3b 20 68 61 6e 64  n image..;; hand
5f70: 6c 65 20 72 65 74 75 72 6e 69 6e 67 20 70 69 63  le returning pic
5f80: 74 75 72 65 73 2c 20 6e 6f 74 65 20 6b 65 79 73  tures, note keys
5f90: 20 61 6e 64 20 6e 61 6d 65 20 61 72 65 20 69 67   and name are ig
5fa0: 6e 6f 72 65 64 20 66 6f 72 20 74 68 65 73 65 2e  nored for these.
5fb0: 20 54 68 65 79 20 61 72 65 20 63 61 6c 6c 65 64   They are called
5fc0: 20 6f 75 74 20 69 6e 0a 09 3b 3b 20 74 68 65 20   out in..;; the 
5fd0: 74 77 69 6b 69 2f 76 69 65 77 2e 73 63 6d 20 28  twiki/view.scm (
5fe0: 74 77 69 6b 69 3a 74 77 69 6b 69 20 22 62 6c 61  twiki:twiki "bla
5ff0: 68 22 20 27 28 6e 61 64 61 20 66 6f 6f 29 29 20  h" '(nada foo)) 
6000: 63 61 6c 6c 2e 0a 09 28 6c 65 74 20 28 28 69 6d  call...(let ((im
6010: 61 67 65 20 20 20 28 73 3a 67 65 74 2d 70 61 72  age   (s:get-par
6020: 61 6d 20 22 69 6d 61 67 65 22 29 29 0a 09 20 20  am "image"))..  
6030: 20 20 20 20 28 74 68 75 6d 62 20 20 20 28 73 3a      (thumb   (s:
6040: 67 65 74 2d 70 61 72 61 6d 20 22 74 68 75 6d 62  get-param "thumb
6050: 22 29 29 29 0a 09 20 20 28 73 3a 6c 6f 67 20 22  ")))..  (s:log "
6060: 69 6d 61 67 65 3a 20 22 20 69 6d 61 67 65 20 22  image: " image "
6070: 20 74 68 75 6d 62 3a 20 22 20 74 68 75 6d 62 20   thumb: " thumb 
6080: 22 20 77 69 6b 69 5f 6b 65 79 3a 20 22 20 28 73  " wiki_key: " (s
6090: 3a 67 65 74 2d 70 61 72 61 6d 20 27 77 69 6b 69  :get-param 'wiki
60a0: 5f 6b 65 79 29 29 0a 09 20 20 28 69 66 20 28 61  _key))..  (if (a
60b0: 6e 64 20 28 6d 65 6d 62 65 72 20 27 72 20 70 65  nd (member 'r pe
60c0: 72 6d 73 29 20 69 6d 61 67 65 29 0a 09 20 20 20  rms) image)..   
60d0: 20 20 20 28 6c 65 74 2a 20 28 28 76 61 72 6c 73     (let* ((varls
60e0: 74 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20  t (string-split 
60f0: 28 73 3a 67 65 74 2d 70 61 72 61 6d 20 27 77 69  (s:get-param 'wi
6100: 6b 69 5f 6b 65 79 29 20 22 2d 22 29 29 0a 09 09  ki_key) "-"))...
6110: 20 20 20 20 20 28 74 6b 65 79 20 28 74 77 69 6b       (tkey (twik
6120: 69 3a 77 65 62 36 34 64 65 63 20 28 63 61 64 72  i:web64dec (cadr
6130: 20 76 61 72 6c 73 74 29 29 29 0a 09 09 20 20 20   varlst)))...   
6140: 20 20 28 77 69 64 20 20 28 73 74 72 69 6e 67 2d    (wid  (string-
6150: 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 20 76 61  >number (car  va
6160: 72 6c 73 74 29 29 29 0a 09 09 20 20 20 20 20 28  rlst)))...     (
6170: 74 64 62 6e 20 28 74 77 69 6b 69 3a 6f 70 65 6e  tdbn (twiki:open
6180: 2d 64 62 20 74 6b 65 79 20 23 66 29 29 29 0a 09  -db tkey #f)))..
6190: 09 28 73 3a 6c 6f 67 20 22 74 6b 65 79 3a 20 22  .(s:log "tkey: "
61a0: 20 74 6b 65 79 20 22 20 69 6d 61 67 65 20 6e 75   tkey " image nu
61b0: 6d 62 65 72 3a 20 22 20 69 6d 61 67 65 29 0a 09  mber: " image)..
61c0: 09 28 74 77 69 6b 69 3a 72 65 74 75 72 6e 2d 69  .(twiki:return-i
61d0: 6d 61 67 65 2d 64 61 74 20 74 64 62 6e 20 77 69  mage-dat tdbn wi
61e0: 64 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65  d (string->numbe
61f0: 72 20 69 6d 61 67 65 29 29 29 29 20 3b 3b 20 64  r image)))) ;; d
6200: 6f 20 6e 6f 74 20 72 65 74 75 72 6e 20 66 72 6f  o not return fro
6210: 6d 20 74 77 69 6b 69 3a 72 65 74 75 72 6e 2d 69  m twiki:return-i
6220: 6d 61 67 65 0a 09 20 20 28 69 66 20 28 61 6e 64  mage..  (if (and
6230: 20 28 6d 65 6d 62 65 72 20 27 72 20 70 65 72 6d   (member 'r perm
6240: 73 29 20 74 68 75 6d 62 29 0a 09 20 20 20 20 20  s) thumb)..     
6250: 20 28 6c 65 74 2a 20 28 28 76 61 72 6c 73 74 20   (let* ((varlst 
6260: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 73  (string-split (s
6270: 3a 67 65 74 2d 70 61 72 61 6d 20 27 77 69 6b 69  :get-param 'wiki
6280: 5f 6b 65 79 29 20 22 2d 22 29 29 0a 09 09 20 20  _key) "-"))...  
6290: 20 20 20 28 74 6b 65 79 20 20 20 28 74 77 69 6b     (tkey   (twik
62a0: 69 3a 77 65 62 36 34 64 65 63 20 28 63 61 64 72  i:web64dec (cadr
62b0: 20 76 61 72 6c 73 74 29 29 29 0a 09 09 20 20 20   varlst)))...   
62c0: 20 20 28 77 69 64 20 20 20 20 28 73 74 72 69 6e    (wid    (strin
62d0: 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 20  g->number (car  
62e0: 76 61 72 6c 73 74 29 29 29 0a 09 09 20 20 20 20  varlst)))...    
62f0: 20 28 74 64 62 6e 20 20 20 28 74 77 69 6b 69 3a   (tdbn   (twiki:
6300: 6f 70 65 6e 2d 64 62 20 74 6b 65 79 20 23 66 29  open-db tkey #f)
6310: 29 29 0a 09 09 28 73 3a 6c 6f 67 20 22 74 6b 65  ))...(s:log "tke
6320: 79 3a 20 22 20 74 6b 65 79 20 22 20 74 68 75 6d  y: " tkey " thum
6330: 62 20 6e 75 6d 62 65 72 3a 20 22 20 69 6d 61 67  b number: " imag
6340: 65 29 0a 09 09 28 74 77 69 6b 69 3a 72 65 74 75  e)...(twiki:retu
6350: 72 6e 2d 74 68 75 6d 62 2d 64 61 74 20 74 64 62  rn-thumb-dat tdb
6360: 6e 20 77 69 64 20 28 73 74 72 69 6e 67 2d 3e 6e  n wid (string->n
6370: 75 6d 62 65 72 20 74 68 75 6d 62 29 29 29 29 29  umber thumb)))))
6380: 20 3b 3b 20 64 6f 20 6e 6f 74 20 72 65 74 75 72   ;; do not retur
6390: 6e 20 66 72 6f 6d 20 74 77 69 6b 69 3a 72 65 74  n from twiki:ret
63a0: 75 72 6e 2d 69 6d 61 67 65 0a 09 28 69 66 20 28  urn-image..(if (
63b0: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 27 72 20 70  not (member 'r p
63c0: 65 72 6d 73 29 29 20 3b 3b 20 72 65 61 64 20 61  erms)) ;; read a
63d0: 63 63 65 73 73 0a 09 20 20 20 20 27 28 29 20 3b  ccess..    '() ;
63e0: 3b 20 72 65 74 75 72 6e 20 61 20 62 6c 61 6e 6b  ; return a blank
63f0: 20 73 6c 61 74 65 0a 09 20 20 20 20 28 74 77 69   slate..    (twi
6400: 6b 69 3a 64 69 73 70 6c 61 79 2d 77 69 6b 69 20  ki:display-wiki 
6410: 6e 61 6d 65 20 6b 65 79 73 20 70 65 72 6d 73 29  name keys perms)
6420: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74  ))))..(define (t
6430: 77 69 6b 69 3a 64 69 73 70 6c 61 79 2d 77 69 6b  wiki:display-wik
6440: 69 20 6e 61 6d 65 20 6b 65 79 73 20 70 65 72 6d  i name keys perm
6450: 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 77 69 6b  s).  (let* ((wik
6460: 69 64 61 74 20 20 28 6d 61 6b 65 2d 74 77 69 6b  idat  (make-twik
6470: 69 3a 77 69 6b 69 29 29 0a 09 20 28 74 6b 65 79  i:wiki)).. (tkey
6480: 20 20 20 20 20 28 74 77 69 6b 69 3a 6b 65 79 73       (twiki:keys
6490: 2d 3e 6b 65 79 20 6b 65 79 73 29 29 0a 09 20 28  ->key keys)).. (
64a0: 74 64 62 20 20 20 20 20 20 28 74 77 69 6b 69 3a  tdb      (twiki:
64b0: 6f 70 65 6e 2d 64 62 20 74 6b 65 79 29 29 0a 09  open-db tkey))..
64c0: 20 28 77 69 64 20 20 20 20 20 20 28 74 77 69 6b   (wid      (twik
64d0: 69 3a 6e 61 6d 65 2d 3e 77 69 64 20 74 64 62 20  i:name->wid tdb 
64e0: 6e 61 6d 65 29 29 0a 09 20 28 63 76 61 72 20 20  name)).. (cvar  
64f0: 20 20 20 28 63 6f 6e 63 20 22 43 55 52 52 45 4e     (conc "CURREN
6500: 54 5f 54 57 49 44 4c 45 52 53 3a 22 20 77 69 64  T_TWIDLERS:" wid
6510: 29 29 20 3b 3b 20 70 61 67 65 20 76 61 72 20 74  )) ;; page var t
6520: 6f 20 73 74 6f 72 65 20 63 75 72 72 65 6e 74 20  o store current 
6530: 74 77 69 64 64 6c 65 72 73 20 62 65 69 6e 67 20  twiddlers being 
6540: 76 69 65 77 65 64 0a 09 20 28 63 76 61 72 2d 65  viewed.. (cvar-e
6550: 64 20 20 28 63 6f 6e 63 20 22 43 55 52 52 45 4e  d  (conc "CURREN
6560: 54 5f 54 57 49 44 4c 45 52 5f 55 4e 44 45 52 5f  T_TWIDLER_UNDER_
6570: 45 44 49 54 3a 22 20 77 69 64 29 29 0a 09 20 28  EDIT:" wid)).. (
6580: 74 6e 75 6d 65 64 69 74 20 28 69 66 20 28 73 3a  tnumedit (if (s:
6590: 67 65 74 20 63 76 61 72 2d 65 64 29 20 0a 09 09  get cvar-ed) ...
65a0: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e         (string->
65b0: 6e 75 6d 62 65 72 20 28 73 3a 67 65 74 20 63 76  number (s:get cv
65c0: 61 72 2d 65 64 29 29 0a 09 09 20 20 20 20 20 20  ar-ed))...      
65d0: 20 23 66 29 29 20 3b 3b 20 23 66 20 3d 3e 20 6e   #f)) ;; #f => n
65e0: 6f 74 68 69 6e 67 20 74 6f 20 65 64 69 74 2c 20  othing to edit, 
65f0: 2d 31 20 63 72 65 61 74 65 20 61 20 6e 65 77 20  -1 create a new 
6600: 74 69 64 64 6c 65 72 0a 09 20 28 74 6e 75 6d 76  tiddler.. (tnumv
6610: 69 65 77 20 23 66 29 0a 09 20 28 6c 6d 65 6e 75  iew #f).. (lmenu
6620: 20 20 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 74      (twiki:get-t
6630: 69 64 64 6c 65 72 73 20 74 64 62 20 77 69 64 20  iddlers tdb wid 
6640: 28 6c 69 73 74 20 22 4d 61 69 6e 4d 65 6e 75 22  (list "MainMenu"
6650: 29 29 29 0a 09 20 3b 3b 20 73 74 6f 72 65 20 74  ))).. ;; store t
6660: 69 64 64 6c 65 72 73 20 66 6f 72 20 74 68 69 73  iddlers for this
6670: 20 70 61 67 65 2f 74 77 69 6b 69 20 69 6e 20 63   page/twiki in c
6680: 76 61 72 20 28 69 2e 65 2e 20 43 55 52 52 45 4e  var (i.e. CURREN
6690: 54 5f 54 57 49 44 4c 45 52 53 3a 3c 77 69 64 3e  T_TWIDLERS:<wid>
66a0: 0a 09 20 28 74 64 6c 6e 75 6d 73 20 20 28 69 66  .. (tdlnums  (if
66b0: 20 28 73 3a 67 65 74 20 63 76 61 72 29 0a 09 09   (s:get cvar)...
66c0: 20 20 20 20 20 20 20 28 6d 61 70 20 73 74 72 69         (map stri
66d0: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 74 72 69  ng->number (stri
66e0: 6e 67 2d 73 70 6c 69 74 20 28 73 3a 67 65 74 20  ng-split (s:get 
66f0: 63 76 61 72 29 20 22 2c 22 29 29 0a 09 09 20 20  cvar) ","))...  
6700: 20 20 20 20 20 27 28 29 29 29 20 3b 3b 20 6c 69       '())) ;; li
6710: 73 74 20 6f 66 20 74 69 64 64 6c 65 72 20 6e 75  st of tiddler nu
6720: 6d 62 65 72 73 0a 09 20 28 74 64 6c 72 73 20 20  mbers.. (tdlrs  
6730: 20 20 27 28 29 29 0a 09 20 28 74 65 64 69 74 65    '()).. (tedite
6740: 64 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 27  d  (if (member '
6750: 77 20 70 65 72 6d 73 29 20 23 66 20 23 74 29 29  w perms) #f #t))
6760: 20 3b 3b 20 66 6f 72 63 65 20 6e 6f 20 65 64 69   ;; force no edi
6770: 74 73 20 69 66 20 6e 6f 74 20 61 20 77 72 69 74  ts if not a writ
6780: 65 72 0a 09 20 28 65 64 69 74 2d 74 6d 65 6e 75  er.. (edit-tmenu
6790: 2d 69 64 20 28 69 66 20 28 61 6e 64 20 28 6d 65  -id (if (and (me
67a0: 6d 62 65 72 20 27 77 20 70 65 72 6d 73 29 0a 09  mber 'w perms)..
67b0: 09 09 09 20 28 73 3a 67 65 74 2d 70 61 72 61 6d  ... (s:get-param
67c0: 20 22 65 64 69 74 5f 74 6d 65 6e 75 22 29 29 0a   "edit_tmenu")).
67d0: 09 09 09 20 20 20 20 28 73 74 72 69 6e 67 2d 3e  ...    (string->
67e0: 6e 75 6d 62 65 72 20 28 73 3a 67 65 74 2d 70 61  number (s:get-pa
67f0: 72 61 6d 20 22 65 64 69 74 5f 74 6d 65 6e 75 22  ram "edit_tmenu"
6800: 29 29 0a 09 09 09 20 20 20 20 23 66 29 29 0a 09  ))....    #f))..
6810: 20 28 65 64 69 74 2d 74 69 64 64 6c 65 72 20 28   (edit-tiddler (
6820: 69 66 20 20 28 61 6e 64 20 28 6d 65 6d 62 65 72  if  (and (member
6830: 20 27 77 20 70 65 72 6d 73 29 0a 09 09 09 09 20   'w perms)..... 
6840: 28 73 3a 67 65 74 2d 70 61 72 61 6d 20 22 65 64  (s:get-param "ed
6850: 69 74 5f 74 69 64 64 6c 65 72 22 29 29 20 3b 3b  it_tiddler")) ;;
6860: 20 74 68 69 73 20 68 61 6e 64 6c 65 73 20 74 68   this handles th
6870: 65 20 22 65 64 69 74 22 20 6c 69 6e 6b 20 69 6e  e "edit" link in
6880: 20 74 68 65 20 74 69 64 64 6c 65 72 20 63 6f 6e   the tiddler con
6890: 74 72 6f 6c 20 62 61 72 0a 09 09 09 20 20 20 20  trol bar....    
68a0: 28 6c 65 74 20 28 28 74 20 28 74 77 69 6b 69 3a  (let ((t (twiki:
68b0: 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d  get-tiddlers-by-
68c0: 6e 75 6d 20 74 64 62 20 77 69 64 20 28 6c 69 73  num tdb wid (lis
68d0: 74 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65  t (string->numbe
68e0: 72 20 28 73 3a 67 65 74 2d 70 61 72 61 6d 20 22  r (s:get-param "
68f0: 65 64 69 74 5f 74 69 64 64 6c 65 72 22 29 29 29  edit_tiddler")))
6900: 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 73 3a  )))....      (s:
6910: 6c 6f 67 20 22 74 3a 20 22 20 74 29 0a 09 09 09  log "t: " t)....
6920: 20 20 20 20 20 20 28 69 66 20 74 0a 09 09 09 09        (if t.....
6930: 20 20 28 63 61 72 20 74 20 29 20 3b 3b 20 73 68    (car t ) ;; sh
6940: 6f 75 6c 64 20 62 65 20 61 20 6c 69 73 74 20 6f  ould be a list o
6950: 66 20 6f 6e 65 0a 09 09 09 09 20 20 28 74 77 69  f one.....  (twi
6960: 6b 69 3a 74 69 64 64 6c 65 72 2d 73 65 74 2d 6e  ki:tiddler-set-n
6970: 61 6d 65 21 0a 09 09 09 09 20 20 20 28 74 77 69  ame!.....   (twi
6980: 6b 69 3a 74 69 64 64 6c 65 72 2d 73 65 74 2d 69  ki:tiddler-set-i
6990: 64 21 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65  d! (twiki:tiddle
69a0: 72 2d 6d 61 6b 65 29 20 2d 31 29 20 22 4e 65 77  r-make) -1) "New
69b0: 54 69 64 64 6c 65 72 22 29 29 29 0a 09 09 09 20  Tiddler"))).... 
69c0: 20 20 20 23 66 29 29 0a 09 20 28 76 69 65 77 2d     #f)).. (view-
69d0: 74 69 64 64 6c 65 72 20 28 69 66 20 28 73 3a 67  tiddler (if (s:g
69e0: 65 74 2d 70 61 72 61 6d 20 22 76 69 65 77 5f 74  et-param "view_t
69f0: 69 64 64 6c 65 72 22 29 0a 09 09 09 20 20 20 28  iddler")....   (
6a00: 6c 65 74 2a 20 28 28 74 6e 61 6d 65 20 28 74 77  let* ((tname (tw
6a10: 69 6b 69 3a 77 65 62 36 34 64 65 63 20 28 73 3a  iki:web64dec (s:
6a20: 67 65 74 2d 70 61 72 61 6d 20 22 76 69 65 77 5f  get-param "view_
6a30: 74 69 64 64 6c 65 72 22 29 29 29 0a 09 09 09 09  tiddler"))).....
6a40: 20 20 28 74 20 20 20 20 20 28 74 77 69 6b 69 3a    (t     (twiki:
6a50: 67 65 74 2d 74 69 64 64 6c 65 72 2d 62 79 2d 6e  get-tiddler-by-n
6a60: 61 6d 65 20 74 64 62 20 77 69 64 20 74 6e 61 6d  ame tdb wid tnam
6a70: 65 29 29 29 0a 09 09 09 20 20 20 20 20 28 73 3a  e)))....     (s:
6a80: 6c 6f 67 20 22 74 3a 20 22 20 74 29 0a 09 09 09  log "t: " t)....
6a90: 20 20 20 20 20 28 69 66 20 74 0a 09 09 09 09 20       (if t..... 
6aa0: 74 20 0a 09 09 09 09 20 28 62 65 67 69 6e 0a 09  t ..... (begin..
6ab0: 09 09 09 20 20 20 28 74 77 69 6b 69 3a 73 61 76  ...   (twiki:sav
6ac0: 65 2d 74 69 64 64 6c 65 72 20 74 64 62 20 74 6e  e-tiddler tdb tn
6ad0: 61 6d 65 20 28 63 6f 6e 63 20 22 21 22 20 74 6e  ame (conc "!" tn
6ae0: 61 6d 65 29 20 22 22 20 77 69 64 20 28 74 77 69  ame) "" wid (twi
6af0: 6b 69 3a 67 65 74 2d 69 64 29 29 0a 09 09 09 09  ki:get-id)).....
6b00: 20 20 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69     (twiki:get-ti
6b10: 64 64 6c 65 72 2d 62 79 2d 6e 61 6d 65 20 74 64  ddler-by-name td
6b20: 62 20 77 69 64 20 74 6e 61 6d 65 29 29 29 29 0a  b wid tname)))).
6b30: 09 09 09 20 20 20 23 66 29 29 0a 09 20 29 20 3b  ...   #f)).. ) ;
6b40: 3b 20 69 6d 61 67 65 20 69 73 20 74 68 65 20 64  ; image is the d
6b50: 61 74 5f 69 64 2c 20 6b 65 65 70 20 69 74 20 73  at_id, keep it s
6b60: 69 6d 70 6c 65 20 73 69 6c 6c 79 2e 0a 0a 20 20  imple silly...  
6b70: 20 20 28 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65    (twiki:wiki-se
6b80: 74 2d 77 69 64 21 20 20 77 69 6b 69 64 61 74 20  t-wid!  wikidat 
6b90: 77 69 64 29 0a 20 20 20 20 28 74 77 69 6b 69 3a  wid).    (twiki:
6ba0: 77 69 6b 69 2d 73 65 74 2d 6b 65 79 21 20 20 77  wiki-set-key!  w
6bb0: 69 6b 69 64 61 74 20 74 6b 65 79 29 0a 20 20 20  ikidat tkey).   
6bc0: 20 28 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74   (twiki:wiki-set
6bd0: 2d 6e 61 6d 65 21 20 77 69 6b 69 64 61 74 20 6e  -name! wikidat n
6be0: 61 6d 65 29 0a 20 20 20 20 28 74 77 69 6b 69 3a  ame).    (twiki:
6bf0: 77 69 6b 69 2d 73 65 74 2d 64 62 68 21 20 20 77  wiki-set-dbh!  w
6c00: 69 6b 69 64 61 74 20 74 64 62 29 0a 20 20 20 20  ikidat tdb).    
6c10: 28 74 77 69 6b 69 3a 77 69 6b 69 2d 73 65 74 2d  (twiki:wiki-set-
6c20: 70 65 72 6d 73 21 20 77 69 6b 69 64 61 74 20 70  perms! wikidat p
6c30: 65 72 6d 73 29 0a 0a 20 20 20 20 3b 3b 20 28 73  erms)..    ;; (s
6c40: 3a 6c 6f 67 20 22 65 64 69 74 2d 74 6d 65 6e 75  :log "edit-tmenu
6c50: 2d 69 64 3a 20 22 20 65 64 69 74 2d 74 6d 65 6e  -id: " edit-tmen
6c60: 75 2d 69 64 20 22 20 65 64 69 74 2d 74 69 64 64  u-id " edit-tidd
6c70: 6c 65 72 3a 20 22 20 65 64 69 74 2d 74 69 64 64  ler: " edit-tidd
6c80: 6c 65 72 29 0a 0a 20 20 20 20 3b 3b 20 48 61 6e  ler)..    ;; Han
6c90: 64 6c 65 20 6f 74 68 65 72 20 55 52 49 20 63 6f  dle other URI co
6ca0: 6d 6d 61 6e 64 73 20 68 65 72 65 0a 20 20 20 20  mmands here.    
6cb0: 28 69 66 20 28 73 3a 67 65 74 2d 70 61 72 61 6d  (if (s:get-param
6cc0: 20 22 63 61 6e 63 65 6c 5f 74 65 64 69 74 22 29   "cancel_tedit")
6cd0: 20 3b 3b 20 64 6f 65 73 6e 27 74 20 6d 61 74 74   ;; doesn't matt
6ce0: 65 72 20 77 68 69 63 68 20 74 69 64 64 6c 65 72  er which tiddler
6cf0: 20 2d 20 6a 75 73 74 20 75 73 65 20 74 68 69 73   - just use this
6d00: 20 74 6f 20 63 61 6e 63 65 6c 20 61 6e 79 20 65   to cancel any e
6d10: 64 69 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28  dit..(begin..  (
6d20: 73 3a 64 65 6c 21 20 28 63 6f 6e 63 20 22 43 55  s:del! (conc "CU
6d30: 52 52 45 4e 54 5f 54 57 49 44 4c 45 52 5f 55 4e  RRENT_TWIDLER_UN
6d40: 44 45 52 5f 45 44 49 54 3a 22 20 77 69 64 29 29  DER_EDIT:" wid))
6d50: 0a 09 20 20 28 73 65 74 21 20 65 64 69 74 2d 74  ..  (set! edit-t
6d60: 69 64 64 6c 65 72 20 23 66 29 0a 09 20 20 28 73  iddler #f)..  (s
6d70: 65 74 21 20 74 6e 75 6d 65 64 69 74 20 23 66 29  et! tnumedit #f)
6d80: 0a 09 20 20 28 73 65 74 21 20 76 69 65 77 2d 74  ..  (set! view-t
6d90: 69 64 64 6c 65 72 20 23 66 29 0a 09 20 20 28 74  iddler #f)..  (t
6da0: 77 69 6b 69 3a 6e 6f 72 6d 61 6c 69 7a 65 2d 63  wiki:normalize-c
6db0: 75 72 72 65 6e 74 2d 74 77 69 64 64 6c 65 72 73  urrent-twiddlers
6dc0: 20 74 64 62 20 77 69 64 29 0a 09 20 20 28 69 66   tdb wid)..  (if
6dd0: 20 28 73 3a 67 65 74 20 63 76 61 72 29 0a 09 20   (s:get cvar).. 
6de0: 20 20 20 20 20 28 73 65 74 21 20 74 64 6c 6e 75       (set! tdlnu
6df0: 6d 73 20 28 6d 61 70 20 73 74 72 69 6e 67 2d 3e  ms (map string->
6e00: 6e 75 6d 62 65 72 20 28 73 74 72 69 6e 67 2d 73  number (string-s
6e10: 70 6c 69 74 20 28 73 3a 67 65 74 20 63 76 61 72  plit (s:get cvar
6e20: 29 20 22 2c 22 29 29 29 29 29 29 0a 20 20 20 20  ) ",")))))).    
6e30: 28 69 66 20 28 73 3a 67 65 74 2d 70 61 72 61 6d  (if (s:get-param
6e40: 20 22 64 65 6c 65 74 65 5f 74 69 64 64 6c 65 72   "delete_tiddler
6e50: 22 29 20 27 28 29 29 0a 20 20 20 20 3b 3b 20 28  ") '()).    ;; (
6e60: 74 77 69 6b 69 3a 64 65 6c 65 74 65 5f 74 69 64  twiki:delete_tid
6e70: 64 6c 65 72 20 74 64 62 20 77 69 64 20 28 73 74  dler tdb wid (st
6e80: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 3a  ring->number (s:
6e90: 67 65 74 2d 70 61 72 61 6d 20 22 64 65 6c 65 74  get-param "delet
6ea0: 65 5f 74 69 64 64 6c 65 72 22 29 29 29 29 0a 0a  e_tiddler"))))..
6eb0: 20 20 20 20 28 73 3a 73 65 74 21 20 22 54 57 49      (s:set! "TWI
6ec0: 4b 49 5f 4b 45 59 22 20 74 6b 65 79 29 20 3b 3b  KI_KEY" tkey) ;;
6ed0: 20 74 68 69 73 20 6d 65 63 68 61 6e 69 73 6d 20   this mechanism 
6ee0: 77 69 6c 6c 20 66 61 69 6c 20 66 6f 72 20 68 69  will fail for hi
6ef0: 65 72 61 72 63 68 69 61 6c 20 74 77 69 6b 69 73  erarchial twikis
6f00: 0a 20 20 20 20 3b 3b 20 6f 76 65 72 72 69 64 65  .    ;; override
6f10: 20 74 68 65 20 74 77 69 64 64 6c 65 72 20 74 6f   the twiddler to
6f20: 20 65 64 69 74 20 77 68 65 6e 20 65 64 69 74 69   edit when editi
6f30: 6e 67 20 4d 61 69 6e 4d 65 6e 75 0a 20 20 20 20  ng MainMenu.    
6f40: 28 69 66 20 65 64 69 74 2d 74 69 64 64 6c 65 72  (if edit-tiddler
6f50: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 65 74  ..(begin..  (set
6f60: 21 20 74 6e 75 6d 65 64 69 74 20 28 74 77 69 6b  ! tnumedit (twik
6f70: 69 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d 69 64  i:tiddler-get-id
6f80: 20 65 64 69 74 2d 74 69 64 64 6c 65 72 29 29 0a   edit-tiddler)).
6f90: 09 20 20 28 73 3a 73 65 74 21 20 27 74 77 69 6b  .  (s:set! 'twik
6fa0: 69 5f 74 69 74 6c 65 20 28 74 77 69 6b 69 3a 74  i_title (twiki:t
6fb0: 69 64 64 6c 65 72 2d 67 65 74 2d 6e 61 6d 65 20  iddler-get-name 
6fc0: 65 64 69 74 2d 74 69 64 64 6c 65 72 29 29 0a 09  edit-tiddler))..
6fd0: 20 20 28 73 3a 73 65 74 21 20 27 74 77 69 6b 69    (s:set! 'twiki
6fe0: 5f 62 6f 64 79 20 20 28 74 77 69 6b 69 3a 67 65  _body  (twiki:ge
6ff0: 74 2d 64 61 74 20 74 64 62 20 28 74 77 69 6b 69  t-dat tdb (twiki
7000: 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d 64 61 74  :tiddler-get-dat
7010: 2d 69 64 20 65 64 69 74 2d 74 69 64 64 6c 65 72  -id edit-tiddler
7020: 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 76 69  ))))).    (if vi
7030: 65 77 2d 74 69 64 64 6c 65 72 0a 09 28 62 65 67  ew-tiddler..(beg
7040: 69 6e 0a 09 20 20 28 73 65 74 21 20 74 6e 75 6d  in..  (set! tnum
7050: 76 69 65 77 20 28 74 77 69 6b 69 3a 74 69 64 64  view (twiki:tidd
7060: 6c 65 72 2d 67 65 74 2d 69 64 20 76 69 65 77 2d  ler-get-id view-
7070: 74 69 64 64 6c 65 72 29 29 29 29 0a 20 20 20 20  tiddler)))).    
7080: 0a 20 20 20 20 3b 3b 20 4e 4f 57 20 57 48 41 54  .    ;; NOW WHAT
7090: 20 46 4f 52 20 56 49 45 57 20 2d 20 66 69 78 20   FOR VIEW - fix 
70a0: 74 68 65 20 6c 69 6e 6b 73 2c 20 61 64 64 20 74  the links, add t
70b0: 6f 20 74 64 6c 73 74 0a 0a 0a 20 20 20 20 28 69  o tdlst...    (i
70c0: 66 20 65 64 69 74 2d 74 6d 65 6e 75 2d 69 64 20  f edit-tmenu-id 
70d0: 20 20 28 73 65 74 21 20 74 6e 75 6d 65 64 69 74    (set! tnumedit
70e0: 20 65 64 69 74 2d 74 6d 65 6e 75 2d 69 64 29 29   edit-tmenu-id))
70f0: 0a 20 20 20 20 28 69 66 20 74 6e 75 6d 65 64 69  .    (if tnumedi
7100: 74 20 28 73 65 74 21 20 74 64 6c 6e 75 6d 73 20  t (set! tdlnums 
7110: 28 63 6f 6e 73 20 74 6e 75 6d 65 64 69 74 20 74  (cons tnumedit t
7120: 64 6c 6e 75 6d 73 29 29 29 0a 20 20 20 20 28 69  dlnums))).    (i
7130: 66 20 74 6e 75 6d 76 69 65 77 20 28 73 65 74 21  f tnumview (set!
7140: 20 74 64 6c 6e 75 6d 73 20 28 63 6f 6e 73 20 74   tdlnums (cons t
7150: 6e 75 6d 76 69 65 77 20 74 64 6c 6e 75 6d 73 29  numview tdlnums)
7160: 29 29 0a 20 20 20 20 28 73 65 74 21 20 74 64 6c  )).    (set! tdl
7170: 72 73 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69  rs (twiki:get-ti
7180: 64 64 6c 65 72 73 2d 62 79 2d 6e 75 6d 20 74 64  ddlers-by-num td
7190: 62 20 77 69 64 20 74 64 6c 6e 75 6d 73 29 29 0a  b wid tdlnums)).
71a0: 0a 20 20 20 20 3b 3b 20 72 65 6d 6f 76 65 20 74  .    ;; remove t
71b0: 64 6c 72 73 20 66 72 6f 6d 20 74 68 65 20 6c 69  dlrs from the li
71c0: 73 74 20 69 66 20 63 6c 6f 73 65 5f 74 69 64 64  st if close_tidd
71d0: 6c 65 72 20 63 61 6c 6c 65 64 0a 20 20 20 20 28  ler called.    (
71e0: 69 66 20 28 73 3a 67 65 74 2d 70 61 72 61 6d 20  if (s:get-param 
71f0: 22 63 6c 6f 73 65 5f 74 69 64 64 6c 65 72 22 29  "close_tiddler")
7200: 0a 09 28 73 65 74 21 20 74 64 6c 72 73 20 28 6c  ..(set! tdlrs (l
7210: 65 74 20 28 28 74 6e 75 6d 20 28 73 74 72 69 6e  et ((tnum (strin
7220: 67 2d 3e 6e 75 6d 62 65 72 20 28 73 3a 67 65 74  g->number (s:get
7230: 2d 70 61 72 61 6d 20 22 63 6c 6f 73 65 5f 74 69  -param "close_ti
7240: 64 64 6c 65 72 22 29 29 29 29 0a 09 09 20 20 20  ddler"))))...   
7250: 20 20 20 28 72 65 6d 6f 76 65 20 28 6c 61 6d 62     (remove (lamb
7260: 64 61 20 28 74 29 0a 09 09 09 09 28 65 71 75 61  da (t).....(equa
7270: 6c 3f 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65  l? (twiki:tiddle
7280: 72 2d 67 65 74 2d 69 64 20 74 29 20 74 6e 75 6d  r-get-id t) tnum
7290: 29 29 0a 09 09 09 20 20 20 20 20 20 74 64 6c 72  ))....      tdlr
72a0: 73 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 72 65  s))))..    ;; re
72b0: 6d 6f 76 65 20 61 6c 6c 20 6f 74 68 65 72 73 20  move all others 
72c0: 69 66 20 63 6c 6f 73 65 5f 6f 74 68 65 72 5f 74  if close_other_t
72d0: 69 64 64 6c 65 72 73 20 63 61 6c 6c 65 64 0a 20  iddlers called. 
72e0: 20 20 20 28 69 66 20 28 73 3a 67 65 74 2d 70 61     (if (s:get-pa
72f0: 72 61 6d 20 22 63 6c 6f 73 65 5f 6f 74 68 65 72  ram "close_other
7300: 5f 74 69 64 64 6c 65 72 73 22 29 0a 09 28 73 65  _tiddlers")..(se
7310: 74 21 20 74 64 6c 72 73 20 28 6c 65 74 20 28 28  t! tdlrs (let ((
7320: 74 6e 75 6d 20 28 73 74 72 69 6e 67 2d 3e 6e 75  tnum (string->nu
7330: 6d 62 65 72 20 28 73 3a 67 65 74 2d 70 61 72 61  mber (s:get-para
7340: 6d 20 22 63 6c 6f 73 65 5f 6f 74 68 65 72 5f 74  m "close_other_t
7350: 69 64 64 6c 65 72 73 22 29 29 29 29 0a 09 09 20  iddlers"))))... 
7360: 20 20 20 20 20 28 72 65 6d 6f 76 65 20 28 6c 61       (remove (la
7370: 6d 62 64 61 20 28 74 29 0a 09 09 09 09 28 6e 6f  mbda (t).....(no
7380: 74 20 28 65 71 75 61 6c 3f 20 28 74 77 69 6b 69  t (equal? (twiki
7390: 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d 69 64 20  :tiddler-get-id 
73a0: 74 29 20 74 6e 75 6d 29 29 29 0a 09 09 09 20 20  t) tnum)))....  
73b0: 20 20 20 20 74 64 6c 72 73 29 29 29 29 0a 20 20      tdlrs)))).  
73c0: 20 20 0a 20 20 20 20 28 73 3a 73 65 74 21 20 63    .    (s:set! c
73d0: 76 61 72 20 28 74 77 69 6b 69 3a 6d 61 6b 65 2d  var (twiki:make-
73e0: 74 69 64 64 6c 65 72 2d 6c 69 73 74 20 74 64 6c  tiddler-list tdl
73f0: 72 73 29 29 0a 20 20 20 20 28 69 66 20 74 6e 75  rs)).    (if tnu
7400: 6d 65 64 69 74 20 0a 09 28 73 3a 73 65 74 21 20  medit ..(s:set! 
7410: 63 76 61 72 2d 65 64 20 74 6e 75 6d 65 64 69 74  cvar-ed tnumedit
7420: 29 0a 09 28 73 3a 64 65 6c 21 20 63 76 61 72 2d  )..(s:del! cvar-
7430: 65 64 29 29 0a 0a 20 20 20 20 3b 3b 20 6d 75 73  ed))..    ;; mus
7440: 74 20 68 61 76 65 20 61 20 4d 61 69 6e 4d 65 6e  t have a MainMen
7450: 75 20 74 69 64 64 6c 65 72 20 62 79 20 6e 6f 77  u tiddler by now
7460: 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20  .    (if (null? 
7470: 6c 6d 65 6e 75 29 0a 09 28 62 65 67 69 6e 0a 09  lmenu)..(begin..
7480: 20 20 28 74 77 69 6b 69 3a 73 61 76 65 2d 74 69    (twiki:save-ti
7490: 64 64 6c 65 72 20 74 64 62 20 22 4d 61 69 6e 4d  ddler tdb "MainM
74a0: 65 6e 75 22 20 22 22 20 22 22 20 77 69 64 20 28  enu" "" "" wid (
74b0: 74 77 69 6b 69 3a 67 65 74 2d 69 64 29 29 0a 09  twiki:get-id))..
74c0: 20 20 28 73 65 74 21 20 6c 6d 65 6e 75 20 28 74    (set! lmenu (t
74d0: 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72  wiki:get-tiddler
74e0: 73 20 74 64 62 20 77 69 64 20 28 6c 69 73 74 20  s tdb wid (list 
74f0: 22 4d 61 69 6e 4d 65 6e 75 22 29 29 29 29 29 0a  "MainMenu"))))).
7500: 20 20 20 20 0a 20 20 20 20 3b 3b 20 67 65 74 20      .    ;; get 
7510: 74 68 65 20 74 69 64 64 6c 65 72 73 20 66 72 6f  the tiddlers fro
7520: 6d 20 74 68 65 20 64 62 20 6e 6f 77 0a 20 20 20  m the db now.   
7530: 20 28 73 65 74 21 20 72 65 73 75 6c 74 0a 09 20   (set! result.. 
7540: 20 28 73 3a 64 69 76 20 27 63 6c 61 73 73 20 22   (s:div 'class "
7550: 74 77 69 6b 69 22 0a 09 20 20 20 3b 3b 20 66 6c  twiki"..   ;; fl
7560: 6f 61 74 20 74 6f 20 74 68 65 20 72 69 67 68 74  oat to the right
7570: 20 74 68 65 20 63 6f 6e 74 72 6f 6c 20 6d 65 6e   the control men
7580: 75 0a 09 20 20 20 28 73 3a 64 69 76 20 27 63 6c  u..   (s:div 'cl
7590: 61 73 73 20 22 74 77 69 6b 69 2d 6d 61 69 6e 2d  ass "twiki-main-
75a0: 6d 65 6e 75 22 20 28 74 77 69 6b 69 3a 6d 61 69  menu" (twiki:mai
75b0: 6e 74 5f 61 72 65 61 20 74 64 62 20 77 69 64 20  nt_area tdb wid 
75c0: 74 6b 65 79 20 77 69 6b 69 64 61 74 29 29 0a 09  tkey wikidat))..
75d0: 20 20 20 28 74 77 69 6b 69 3a 76 69 65 77 2d 74     (twiki:view-t
75e0: 69 64 64 6c 65 72 20 74 64 62 20 20 74 6b 65 79  iddler tdb  tkey
75f0: 20 77 69 64 20 28 63 61 72 20 6c 6d 65 6e 75 29   wid (car lmenu)
7600: 20 77 69 6b 69 64 61 74 29 0a 09 20 20 20 3b 3b   wikidat)..   ;;
7610: 20 74 68 69 73 20 69 73 20 70 72 6f 62 61 62 6c   this is probabl
7620: 79 20 6e 6f 74 20 6e 65 65 64 65 64 20 61 73 20  y not needed as 
7630: 74 68 65 72 65 20 69 73 20 6e 6f 20 72 65 61 73  there is no reas
7640: 6f 6e 20 74 6f 20 63 72 65 61 74 65 20 74 69 64  on to create tid
7650: 64 6c 65 72 73 20 74 68 69 73 20 77 61 79 0a 09  dlers this way..
7660: 20 20 20 3b 3b 20 28 69 66 20 28 65 71 3f 20 74     ;; (if (eq? t
7670: 6e 75 6d 65 64 69 74 20 2d 31 29 28 74 77 69 6b  numedit -1)(twik
7680: 69 3a 65 64 69 74 2d 74 69 64 64 6c 65 72 20 74  i:edit-tiddler t
7690: 64 62 20 74 6b 65 79 20 77 69 64 20 74 6e 75 6d  db tkey wid tnum
76a0: 65 64 69 74 29 20 27 28 29 29 0a 09 20 20 20 3b  edit) '())..   ;
76b0: 3b 20 69 6e 73 65 72 74 20 74 68 65 20 70 69 63  ; insert the pic
76c0: 74 75 72 65 20 65 64 69 74 6f 72 20 77 69 6e 64  ture editor wind
76d0: 6f 77 20 69 66 20 65 6e 61 62 6c 65 64 0a 09 20  ow if enabled.. 
76e0: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 73    (if (equal? (s
76f0: 3a 67 65 74 2d 70 61 72 61 6d 20 22 74 77 69 6b  :get-param "twik
7700: 69 5f 6d 61 69 6e 74 22 29 20 22 32 22 29 28 74  i_maint") "2")(t
7710: 77 69 6b 69 3a 70 69 63 5f 6d 67 6d 74 20 74 64  wiki:pic_mgmt td
7720: 62 20 77 69 64 20 74 6b 65 79 29 20 27 28 29 29  b wid tkey) '())
7730: 0a 09 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f  ..   (if (equal?
7740: 20 28 73 3a 67 65 74 2d 70 61 72 61 6d 20 22 74   (s:get-param "t
7750: 77 69 6b 69 5f 6d 61 69 6e 74 22 29 20 22 34 22  wiki_maint") "4"
7760: 29 28 74 77 69 6b 69 3a 68 65 6c 70 20 31 29 20  )(twiki:help 1) 
7770: 27 28 29 29 0a 09 20 20 20 28 69 66 20 28 6e 6f  '())..   (if (no
7780: 74 20 28 6e 75 6c 6c 3f 20 74 64 6c 72 73 29 29  t (null? tdlrs))
7790: 0a 09 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c  ..       (map (l
77a0: 61 6d 62 64 61 20 28 74 64 6c 72 29 0a 09 09 20  ambda (tdlr)... 
77b0: 20 20 20 20 20 28 6c 65 74 20 28 28 74 6e 75 6d       (let ((tnum
77c0: 20 20 28 74 77 69 6b 69 3a 74 69 64 64 6c 65 72    (twiki:tiddler
77d0: 2d 67 65 74 2d 69 64 20 74 64 6c 72 29 29 29 0a  -get-id tdlr))).
77e0: 09 09 09 28 73 3a 6c 6f 67 20 22 74 6e 75 6d 3a  ...(s:log "tnum:
77f0: 20 22 20 74 6e 75 6d 20 22 20 74 6e 75 6d 65 64   " tnum " tnumed
7800: 69 74 3a 20 22 20 74 6e 75 6d 65 64 69 74 29 0a  it: " tnumedit).
7810: 09 09 09 28 69 66 20 28 61 6e 64 20 74 6e 75 6d  ...(if (and tnum
7820: 65 64 69 74 20 28 6e 6f 74 20 74 65 64 69 74 65  edit (not tedite
7830: 64 29 20 28 65 71 75 61 6c 3f 20 74 6e 75 6d 65  d) (equal? tnume
7840: 64 69 74 20 74 6e 75 6d 29 29 0a 09 09 09 20 20  dit tnum))....  
7850: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20    (begin....    
7860: 20 20 28 73 65 74 21 20 74 65 64 69 74 65 64 20    (set! tedited 
7870: 23 74 29 20 3b 3b 20 6f 6e 6c 79 20 61 6c 6c 6f  #t) ;; only allo
7880: 77 20 65 64 69 74 69 6e 67 20 6f 6e 65 20 74 69  w editing one ti
7890: 64 64 6c 65 72 20 61 74 20 61 20 74 69 6d 65 0a  ddler at a time.
78a0: 09 09 09 20 20 20 20 20 20 28 74 77 69 6b 69 3a  ...      (twiki:
78b0: 65 64 69 74 2d 74 69 64 64 6c 65 72 20 74 64 62  edit-tiddler tdb
78c0: 20 74 6b 65 79 20 77 69 64 20 74 6e 75 6d 29 29   tkey wid tnum))
78d0: 0a 09 09 09 20 20 20 20 28 74 77 69 6b 69 3a 76  ....    (twiki:v
78e0: 69 65 77 2d 74 69 64 64 6c 65 72 20 74 64 62 20  iew-tiddler tdb 
78f0: 20 74 6b 65 79 20 77 69 64 20 74 64 6c 72 20 77   tkey wid tdlr w
7900: 69 6b 69 64 61 74 29 29 29 29 0a 09 09 20 20 20  ikidat))))...   
7910: 20 74 64 6c 72 73 29 0a 09 20 20 20 20 20 20 20   tdlrs)..       
7920: 27 28 29 29 29 29 0a 20 20 20 20 28 64 62 69 3a  '()))).    (dbi:
7930: 63 6c 6f 73 65 20 74 64 62 29 0a 20 20 20 20 72  close tdb).    r
7940: 65 73 75 6c 74 29 29 0a 0a 3b 3b 20 73 68 6f 75  esult))..;; shou
7950: 6c 64 20 64 6f 20 61 20 73 69 6e 67 6c 65 20 6d  ld do a single m
7960: 6f 72 65 20 65 66 66 69 63 69 65 6e 74 20 71 75  ore efficient qu
7970: 65 72 79 20 62 75 74 20 74 68 69 73 20 69 73 20  ery but this is 
7980: 67 6f 6f 64 20 65 6e 6f 75 67 68 0a 28 64 65 66  good enough.(def
7990: 69 6e 65 20 28 74 77 69 6b 69 3a 67 65 74 2d 74  ine (twiki:get-t
79a0: 69 64 64 6c 65 72 73 20 64 62 20 77 69 64 20 74  iddlers db wid t
79b0: 6e 61 6d 65 73 29 0a 20 20 28 61 70 70 6c 79 20  names).  (apply 
79c0: 74 77 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65  twiki:get-tiddle
79d0: 72 73 2d 62 79 2d 6e 61 6d 65 20 64 62 20 77 69  rs-by-name db wi
79e0: 64 20 74 6e 61 6d 65 73 29 29 0a 3b 3b 20 20 20  d tnames)).;;   
79f0: 28 6c 65 74 2a 20 28 28 74 64 6c 72 73 20 27 28  (let* ((tdlrs '(
7a00: 29 29 0a 3b 3b 20 09 20 3b 3b 20 28 63 6f 6e 6e  )).;; . ;; (conn
7a10: 20 20 20 28 73 64 61 74 2d 67 65 74 2d 63 6f 6e     (sdat-get-con
7a20: 6e 20 73 3a 73 65 73 73 69 6f 6e 29 29 0a 3b 3b  n s:session)).;;
7a30: 20 09 20 28 6e 61 6d 65 6c 73 74 20 28 63 6f 6e   . (namelst (con
7a40: 63 20 22 28 27 22 20 28 73 74 72 69 6e 67 2d 69  c "('" (string-i
7a50: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20  ntersperse (map 
7a60: 63 6f 6e 63 20 74 6e 61 6d 65 73 29 20 22 27 2c  conc tnames) "',
7a70: 27 22 29 20 22 27 29 22 29 29 0a 3b 3b 20 09 20  '") "')")).;; . 
7a80: 28 71 72 79 20 20 20 20 20 28 63 6f 6e 63 20 74  (qry     (conc t
7a90: 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d 73 65 6c  wiki:tiddler-sel
7aa0: 65 63 74 6f 72 20 22 20 57 48 45 52 45 20 74 2e  ector " WHERE t.
7ab0: 77 69 6b 69 5f 69 64 3d 3f 20 41 4e 44 20 74 2e  wiki_id=? AND t.
7ac0: 69 64 20 49 4e 20 22 20 6e 61 6d 65 6c 73 74 20  id IN " namelst 
7ad0: 22 3b 22 29 29 29 0a 3b 3b 20 20 20 20 20 3b 3b  ";"))).;;     ;;
7ae0: 20 28 70 72 69 6e 74 20 71 72 79 29 0a 3b 3b 20   (print qry).;; 
7af0: 20 20 20 20 28 64 62 69 3a 66 6f 72 2d 65 61 63      (dbi:for-eac
7b00: 68 2d 72 6f 77 0a 3b 3b 20 20 20 20 20 20 28 6c  h-row.;;      (l
7b10: 61 6d 62 64 61 20 28 72 6f 77 29 0a 3b 3b 20 20  ambda (row).;;  
7b20: 20 20 20 20 20 20 28 73 65 74 21 20 74 64 6c 72        (set! tdlr
7b30: 73 20 28 63 6f 6e 73 20 72 6f 77 20 74 64 6c 72  s (cons row tdlr
7b40: 73 29 29 29 0a 3b 3b 20 20 20 20 20 20 64 62 20  s))).;;      db 
7b50: 71 72 79 20 77 69 64 29 0a 3b 3b 20 20 20 20 20  qry wid).;;     
7b60: 28 72 65 76 65 72 73 65 20 74 64 6c 72 73 29 29  (reverse tdlrs))
7b70: 29 20 3b 3b 20 21 54 77 69 6b 69 5c 0a 0a 3b 3b  ) ;; !Twiki\..;;
7b80: 20 74 6c 73 74 20 69 73 20 61 20 6c 69 73 74 20   tlst is a list 
7b90: 6f 66 20 74 69 64 64 6c 65 72 20 6e 75 6d 73 0a  of tiddler nums.
7ba0: 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 67  (define (twiki:g
7bb0: 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d 6e  et-tiddlers-by-n
7bc0: 75 6d 20 64 62 20 77 69 64 20 74 6c 73 74 29 0a  um db wid tlst).
7bd0: 20 20 3b 3b 20 28 73 3a 6c 6f 67 20 22 47 6f 74    ;; (s:log "Got
7be0: 20 74 6f 20 74 77 69 6b 69 3a 67 65 74 2d 74 69   to twiki:get-ti
7bf0: 64 64 6c 65 72 73 20 77 69 74 68 20 6b 65 79 73  ddlers with keys
7c00: 3a 20 22 20 74 6c 73 74 20 22 20 61 6e 64 20 77  : " tlst " and w
7c10: 69 64 3a 20 22 20 77 69 64 29 0a 20 20 3b 3b 20  id: " wid).  ;; 
7c20: 73 65 6c 65 63 74 20 77 68 65 72 65 20 63 72 65  select where cre
7c30: 61 74 65 64 5f 6f 6e 20 3c 20 73 6f 6d 65 64 61  ated_on < someda
7c40: 74 65 20 6f 72 64 65 72 20 62 79 20 63 72 65 61  te order by crea
7c50: 74 65 64 5f 6f 6e 20 64 65 73 63 20 6c 69 6d 69  ted_on desc limi
7c60: 74 20 31 0a 20 20 28 6c 65 74 2a 20 28 28 74 64  t 1.  (let* ((td
7c70: 6c 72 73 20 27 28 29 29 0a 09 20 28 74 6c 73 74  lrs '()).. (tlst
7c80: 73 74 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 65  str (string-inte
7c90: 72 73 70 65 72 73 65 20 28 6d 61 70 20 6e 75 6d  rsperse (map num
7ca0: 62 65 72 2d 3e 73 74 72 69 6e 67 20 74 6c 73 74  ber->string tlst
7cb0: 29 20 22 2c 22 29 29 0a 09 20 28 61 6c 72 65 61  ) ",")).. (alrea
7cc0: 64 79 2d 67 6f 74 20 28 6d 61 6b 65 2d 68 61 73  dy-got (make-has
7cd0: 68 2d 74 61 62 6c 65 29 29 0a 09 20 28 71 72 79  h-table)).. (qry
7ce0: 20 20 20 20 28 63 6f 6e 63 20 74 77 69 6b 69 3a      (conc twiki:
7cf0: 74 69 64 64 6c 65 72 2d 73 65 6c 65 63 74 6f 72  tiddler-selector
7d00: 20 22 20 57 48 45 52 45 20 74 2e 77 69 6b 69 5f   " WHERE t.wiki_
7d10: 69 64 3d 3f 20 41 4e 44 20 74 2e 69 64 20 49 4e  id=? AND t.id IN
7d20: 20 28 22 20 74 6c 73 74 73 74 72 20 22 29 20 4f   (" tlststr ") O
7d30: 52 44 45 52 20 42 59 20 63 72 65 61 74 65 64 5f  RDER BY created_
7d40: 6f 6e 20 44 45 53 43 3b 22 29 29 29 0a 20 20 20  on DESC;"))).   
7d50: 20 28 64 62 69 3a 66 6f 72 2d 65 61 63 68 2d 72   (dbi:for-each-r
7d60: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20  ow.     (lambda 
7d70: 28 72 6f 77 29 0a 20 20 20 20 20 20 20 28 6c 65  (row).       (le
7d80: 74 20 28 28 74 6e 61 6d 65 20 28 74 77 69 6b 69  t ((tname (twiki
7d90: 3a 74 69 64 64 6c 65 72 2d 67 65 74 2d 6e 61 6d  :tiddler-get-nam
7da0: 65 20 72 6f 77 29 29 29 0a 09 20 28 69 66 20 28  e row))).. (if (
7db0: 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d  not (hash-table-
7dc0: 72 65 66 2f 64 65 66 61 75 6c 74 20 61 6c 72 65  ref/default alre
7dd0: 61 64 79 2d 67 6f 74 20 74 6e 61 6d 65 20 23 66  ady-got tname #f
7de0: 29 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a  ))..     (begin.
7df0: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 74 64  .       (set! td
7e00: 6c 72 73 20 28 63 6f 6e 73 20 72 6f 77 20 74 64  lrs (cons row td
7e10: 6c 72 73 29 29 0a 09 20 20 20 20 20 20 20 28 68  lrs))..       (h
7e20: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 61  ash-table-set! a
7e30: 6c 72 65 61 64 79 2d 67 6f 74 20 74 6e 61 6d 65  lready-got tname
7e40: 20 23 74 29 29 29 29 29 0a 20 20 20 20 20 64 62   #t))))).     db
7e50: 20 71 72 79 20 77 69 64 29 0a 20 20 20 20 28 69   qry wid).    (i
7e60: 66 20 28 6e 75 6c 6c 3f 20 74 64 6c 72 73 29 20  f (null? tdlrs) 
7e70: 74 64 6c 72 73 20 28 72 65 76 65 72 73 65 20 74  tdlrs (reverse t
7e80: 64 6c 72 73 29 29 29 29 20 3b 3b 20 21 54 77 69  dlrs)))) ;; !Twi
7e90: 6b 69 5c 6e 54 69 74 6c 65 2c 20 70 69 63 74 75  ki\nTitle, pictu
7ea0: 72 65 73 2c 20 65 74 63 2e 5c 6e 7b 7b 7b 5c 6e  res, etc.\n{{{\n
7eb0: 43 6f 64 65 5c 6e 7d 7d 7d 5c 6e 5b 5b 6c 69 6e  Code\n}}}\n[[lin
7ec0: 6b 73 5d 5d 5c 6e 7c 74 61 62 6c 65 7c 6f 66 7c  ks]]\n|table|of|
7ed0: 73 74 75 66 66 7c 5c 6e 7c 6d 6f 72 65 7c 73 74  stuff|\n|more|st
7ee0: 75 66 66 7c 68 65 72 65 7c 5c 6e 22 29 29 0a 0a  uff|here|\n"))..
7ef0: 3b 3b 20 77 69 64 20 3d 20 77 69 6b 69 20 69 64  ;; wid = wiki id
7f00: 0a 3b 3b 20 72 65 74 75 72 6e 73 20 61 20 6c 69  .;; returns a li
7f10: 73 74 20 6f 66 20 74 77 69 6b 69 3a 74 69 64 64  st of twiki:tidd
7f20: 6c 65 72 73 0a 28 64 65 66 69 6e 65 20 28 74 77  lers.(define (tw
7f30: 69 6b 69 3a 67 65 74 2d 74 69 64 64 6c 65 72 73  iki:get-tiddlers
7f40: 2d 62 79 2d 6e 61 6d 65 20 74 64 62 20 77 69 64  -by-name tdb wid
7f50: 20 2e 20 6e 61 6d 65 73 29 0a 20 20 28 6c 65 74   . names).  (let
7f60: 20 28 28 74 64 6c 72 73 20 27 28 29 29 29 0a 20   ((tdlrs '())). 
7f70: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61     (for-each (la
7f80: 6d 62 64 61 20 28 6e 61 6d 65 29 0a 09 09 28 6c  mbda (name)...(l
7f90: 65 74 20 28 28 74 64 6c 72 20 28 74 77 69 6b 69  et ((tdlr (twiki
7fa0: 3a 67 65 74 2d 74 69 64 64 6c 65 72 2d 62 79 2d  :get-tiddler-by-
7fb0: 6e 61 6d 65 20 74 64 62 20 77 69 64 20 6e 61 6d  name tdb wid nam
7fc0: 65 29 29 29 0a 09 09 20 20 28 69 66 20 74 64 6c  e)))...  (if tdl
7fd0: 72 20 28 73 65 74 21 20 74 64 6c 72 73 20 28 63  r (set! tdlrs (c
7fe0: 6f 6e 73 20 74 64 6c 72 20 74 64 6c 72 73 29 29  ons tdlr tdlrs))
7ff0: 29 29 29 0a 09 20 20 20 20 20 20 6e 61 6d 65 73  )))..      names
8000: 29 0a 20 20 20 20 28 72 65 76 65 72 73 65 20 74  ).    (reverse t
8010: 64 6c 72 73 29 29 29 0a 3b 3b 20 77 69 74 68 20  dlrs))).;; with 
8020: 74 68 65 20 72 69 67 68 74 20 71 75 65 72 79 20  the right query 
8030: 69 74 20 73 68 6f 75 6c 64 20 62 65 20 70 6f 73  it should be pos
8040: 73 69 62 6c 65 20 74 6f 20 64 6f 20 74 68 69 73  sible to do this
8050: 20 6d 75 63 68 20 66 61 73 74 65 72 20 61 70 70   much faster app
8060: 72 6f 61 63 68 20 66 6f 72 20 74 77 69 6b 69 3a  roach for twiki:
8070: 67 65 74 2d 74 69 64 64 6c 65 72 73 2d 62 79 2d  get-tiddlers-by-
8080: 6e 61 6d 65 0a 3b 3b 20 20 20 28 6c 65 74 20 28  name.;;   (let (
8090: 28 74 64 6c 72 73 20 27 28 29 29 0a 3b 3b 20 09  (tdlrs '()).;; .
80a0: 28 6e 61 6d 65 6c 73 74 20 28 63 6f 6e 63 20 22  (namelst (conc "
80b0: 28 27 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65  ('" (string-inte
80c0: 72 73 70 65 72 73 65 20 6e 61 6d 65 73 20 22 27  rsperse names "'
80d0: 2c 27 22 29 20 22 27 29 22 29 29 29 0a 3b 3b 20  ,'") "')"))).;; 
80e0: 20 20 20 20 28 64 62 69 3a 66 6f 72 2d 65 61 63      (dbi:for-eac
80f0: 68 2d 72 6f 77 0a 3b 3b 20 20 20 20 20 20 28 6c  h-row.;;      (l
8100: 61 6d 62 64 61 20 28 72 6f 77 29 0a 3b 3b 20 20  ambda (row).;;  
8110: 20 20 20 20 20 20 28 73 65 74 21 20 74 64 6c 72        (set! tdlr
8120: 73 20 28 63 6f 6e 73 20 72 6f 77 20 74 64 6c 72  s (cons row tdlr
8130: 73 29 29 29 0a 3b 3b 20 20 20 20 20 20 74 64 62  s))).;;      tdb
8140: 0a 3b 3b 20 20 20 20 20 20 28 63 6f 6e 63 20 74  .;;      (conc t
8150: 77 69 6b 69 3a 74 69 64 64 6c 65 72 2d 73 65 6c  wiki:tiddler-sel
8160: 65 63 74 6f 72 20 22 20 57 48 45 52 45 20 74 2e  ector " WHERE t.
8170: 77 69 6b 69 5f 69 64 3d 3f 20 41 4e 44 20 74 2e  wiki_id=? AND t.
8180: 6e 61 6d 65 20 49 4e 20 22 20 6e 61 6d 65 6c 73  name IN " namels
8190: 74 29 20 77 69 64 29 0a 3b 3b 20 20 20 20 20 28  t) wid).;;     (
81a0: 72 65 76 65 72 73 65 20 74 64 6c 72 73 29 29 29  reverse tdlrs)))
81b0: 0a 0a 3b 3b 20 67 65 74 20 74 68 65 20 74 69 64  ..;; get the tid
81c0: 64 6c 65 72 20 77 69 74 68 20 74 68 65 20 67 69  dler with the gi
81d0: 76 65 6e 20 6e 61 6d 65 20 61 6e 64 20 74 68 65  ven name and the
81e0: 20 6d 61 78 20 64 61 74 65 0a 28 64 65 66 69 6e   max date.(defin
81f0: 65 20 28 74 77 69 6b 69 3a 67 65 74 2d 74 69 64  e (twiki:get-tid
8200: 64 6c 65 72 2d 62 79 2d 6e 61 6d 65 20 74 64 62  dler-by-name tdb
8210: 20 77 69 64 20 6e 61 6d 65 29 0a 20 20 28 64 62   wid name).  (db
8220: 69 3a 67 65 74 2d 6f 6e 65 2d 72 6f 77 20 74 64  i:get-one-row td
8230: 62 20 28 63 6f 6e 63 20 74 77 69 6b 69 3a 74 69  b (conc twiki:ti
8240: 64 64 6c 65 72 2d 73 65 6c 65 63 74 6f 72 20 22  ddler-selector "
8250: 20 57 48 45 52 45 20 74 2e 77 69 6b 69 5f 69 64   WHERE t.wiki_id
8260: 3d 3f 20 41 4e 44 20 74 2e 6e 61 6d 65 3d 3f 20  =? AND t.name=? 
8270: 4f 52 44 45 52 20 42 59 20 63 72 65 61 74 65 64  ORDER BY created
8280: 5f 6f 6e 20 44 45 53 43 20 4c 49 4d 49 54 20 31  _on DESC LIMIT 1
8290: 3b 22 29 20 77 69 64 20 6e 61 6d 65 29 29 0a 0a  ;") wid name))..
82a0: 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 74  (define (twiki:t
82b0: 69 64 64 6c 65 72 2d 6e 61 6d 65 2d 3e 69 64 20  iddler-name->id 
82c0: 64 62 20 74 6e 61 6d 65 29 0a 20 20 28 64 62 69  db tname).  (dbi
82d0: 3a 67 65 74 2d 6f 6e 65 20 64 62 20 22 53 45 4c  :get-one db "SEL
82e0: 45 43 54 20 69 64 20 46 52 4f 4d 20 74 69 64 64  ECT id FROM tidd
82f0: 6c 65 72 73 20 57 48 45 52 45 20 6e 61 6d 65 3d  lers WHERE name=
8300: 3f 3b 22 20 74 6e 61 6d 65 29 29 0a 0a 3b 3b 3d  ?;" tname))..;;=
8310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
8320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
8330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
8340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
8350: 3d 3d 3d 3d 3d 0a 3b 3b 20 74 77 69 6b 69 20 74  =====.;; twiki t
8360: 65 78 74 20 66 6f 72 6d 61 74 69 6e 67 2c 20 70  ext formating, p
8370: 61 72 73 69 6e 67 20 61 6e 64 20 64 69 73 70 6c  arsing and displ
8380: 61 79 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ay.;;===========
8390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
83a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
83b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
83c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20  ===========..;; 
83d0: 74 77 69 6b 69 20 66 6f 72 6d 61 74 69 6e 67 20  twiki formating 
83e0: 72 6f 75 74 69 6e 65 73 20 28 6f 76 65 72 72 69  routines (overri
83f0: 64 65 20 74 68 65 73 65 20 74 6f 20 63 68 61 6e  de these to chan
8400: 67 65 20 79 6f 75 72 20 6c 6f 6f 6b 20 61 6e 64  ge your look and
8410: 20 66 65 65 6c 0a 28 64 65 66 69 6e 65 20 74 77   feel.(define tw
8420: 69 6b 69 3a 74 77 69 6b 69 2d 74 61 67 20 20 73  iki:twiki-tag  s
8430: 3a 62 29 0a 28 64 65 66 69 6e 65 20 74 77 69 6b  :b).(define twik
8440: 69 3a 68 33 20 20 20 20 20 20 20 20 20 73 3a 68  i:h3         s:h
8450: 33 29 0a 28 64 65 66 69 6e 65 20 74 77 69 6b 69  3).(define twiki
8460: 3a 68 32 20 20 20 20 20 20 20 20 20 73 3a 68 32  :h2         s:h2
8470: 29 0a 28 64 65 66 69 6e 65 20 74 77 69 6b 69 3a  ).(define twiki:
8480: 68 31 20 20 20 20 20 20 20 20 20 73 3a 68 31 29  h1         s:h1)
8490: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 74 77 69 6b  .;; (define twik
84a0: 69 3a 6d 61 6b 65 2d 74 6c 69 6e 6b 20 73 3a 69  i:make-tlink s:i
84b0: 29 0a 28 64 65 66 69 6e 65 20 74 77 69 6b 69 3a  ).(define twiki:
84c0: 75 6c 20 20 20 20 20 20 20 20 20 73 3a 75 6c 29  ul         s:ul)
84d0: 0a 28 64 65 66 69 6e 65 20 74 77 69 6b 69 3a 6f  .(define twiki:o
84e0: 6c 20 20 20 20 20 20 20 20 20 73 3a 6f 6c 29 0a  l         s:ol).
84f0: 28 64 65 66 69 6e 65 20 74 77 69 6b 69 3a 6c 69  (define twiki:li
8500: 20 20 20 20 20 20 20 20 20 73 3a 6c 69 29 0a 28           s:li).(
8510: 64 65 66 69 6e 65 20 74 77 69 6b 69 3a 70 72 65  define twiki:pre
8520: 20 20 20 20 20 20 20 20 73 3a 70 72 65 29 0a 28          s:pre).(
8530: 64 65 66 69 6e 65 20 74 77 69 6b 69 3a 70 20 20  define twiki:p  
8540: 20 20 20 20 20 20 20 20 73 3a 70 29 0a 28 64 65          s:p).(de
8550: 66 69 6e 65 20 74 77 69 6b 69 3a 75 20 20 20 20  fine twiki:u    
8560: 20 20 20 20 20 20 73 3a 75 29 0a 28 64 65 66 69        s:u).(defi
8570: 6e 65 20 74 77 69 6b 69 3a 74 64 20 20 20 20 20  ne twiki:td     
8580: 20 20 20 20 73 3a 74 64 29 0a 28 64 65 66 69 6e      s:td).(defin
8590: 65 20 74 77 69 6b 69 3a 74 72 20 20 20 20 20 20  e twiki:tr      
85a0: 20 20 20 73 3a 74 72 29 0a 28 64 65 66 69 6e 65     s:tr).(define
85b0: 20 74 77 69 6b 69 3a 74 61 62 6c 65 20 20 20 20   twiki:table    
85c0: 20 20 73 3a 74 61 62 6c 65 29 0a 28 64 65 66 69    s:table).(defi
85d0: 6e 65 20 74 77 69 6b 69 3a 64 69 76 20 20 20 20  ne twiki:div    
85e0: 20 20 20 20 73 3a 64 69 76 29 0a 0a 28 64 65 66      s:div)..(def
85f0: 69 6e 65 20 28 74 77 69 6b 69 3a 77 65 62 36 34  ine (twiki:web64
8600: 65 6e 63 20 73 74 72 29 0a 20 20 28 73 74 72 69  enc str).  (stri
8610: 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 3d  ng-substitute "=
8620: 22 20 22 5f 22 20 28 62 61 73 65 36 34 3a 62 61  " "_" (base64:ba
8630: 73 65 36 34 2d 65 6e 63 6f 64 65 20 73 74 72 29  se64-encode str)
8640: 20 23 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 28   #t))..(define (
8650: 74 77 69 6b 69 3a 77 65 62 36 34 64 65 63 20 73  twiki:web64dec s
8660: 74 72 29 0a 20 20 28 62 61 73 65 36 34 3a 62 61  tr).  (base64:ba
8670: 73 65 36 34 2d 64 65 63 6f 64 65 20 28 73 74 72  se64-decode (str
8680: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22  ing-substitute "
8690: 5f 22 20 22 3d 22 20 73 74 72 20 23 74 29 29 29  _" "=" str #t)))
86a0: 0a 20 20 20 20 0a 28 64 65 66 69 6e 65 20 28 74  .    .(define (t
86b0: 77 69 6b 69 3a 6d 61 6b 65 2d 74 6c 69 6e 6b 20  wiki:make-tlink 
86c0: 74 65 78 74 20 74 69 64 64 6c 65 72 6e 61 6d 65  text tiddlername
86d0: 29 0a 20 20 28 73 3a 61 20 74 65 78 74 20 27 68  ).  (s:a text 'h
86e0: 72 65 66 20 28 73 3a 6c 69 6e 6b 2d 74 6f 20 28  ref (s:link-to (
86f0: 74 77 69 6b 69 3a 67 65 74 2d 6c 69 6e 6b 2d 62  twiki:get-link-b
8700: 61 63 6b 2d 74 6f 2d 63 75 72 72 65 6e 74 29 20  ack-to-current) 
8710: 27 76 69 65 77 5f 74 69 64 64 6c 65 72 20 28 74  'view_tiddler (t
8720: 77 69 6b 69 3a 77 65 62 36 34 65 6e 63 20 74 69  wiki:web64enc ti
8730: 64 64 6c 65 72 6e 61 6d 65 29 29 29 29 0a 0a 28  ddlername))))..(
8740: 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a 70 69  define (twiki:pi
8750: 63 20 70 69 63 2d 6e 61 6d 65 20 73 69 7a 65 20  c pic-name size 
8760: 77 69 6b 69 29 0a 20 20 28 6c 65 74 2a 20 28 28  wiki).  (let* ((
8770: 74 64 62 20 20 20 20 28 74 77 69 6b 69 3a 77 69  tdb    (twiki:wi
8780: 6b 69 2d 67 65 74 2d 64 62 68 20 77 69 6b 69 29  ki-get-dbh wiki)
8790: 29 0a 09 20 28 74 6b 65 79 20 20 20 28 74 77 69  ).. (tkey   (twi
87a0: 6b 69 3a 77 69 6b 69 2d 67 65 74 2d 6b 65 79 20  ki:wiki-get-key 
87b0: 77 69 6b 69 29 29 0a 09 20 28 78 79 20 20 20 20  wiki)).. (xy    
87c0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 73   (string-split s
87d0: 69 7a 65 20 22 78 22 29 29 0a 09 20 28 70 69 63  ize "x")).. (pic
87e0: 2d 69 64 20 28 74 77 69 6b 69 3a 67 65 74 2d 70  -id (twiki:get-p
87f0: 69 63 2d 69 64 20 74 64 62 20 70 69 63 2d 6e 61  ic-id tdb pic-na
8800: 6d 65 20 28 74 77 69 6b 69 3a 77 69 6b 69 2d 67  me (twiki:wiki-g
8810: 65 74 2d 77 69 64 20 77 69 6b 69 29 29 29 0a 09  et-wid wiki)))..
8820: 20 28 69 6d 67 2d 6c 6e 6b 20 20 28 73 3a 6c 69   (img-lnk  (s:li
8830: 6e 6b 2d 74 6f 20 22 74 77 69 6b 69 22 20 27 77  nk-to "twiki" 'w
8840: 69 6b 69 5f 6b 65 79 20 28 63 6f 6e 63 20 28 6e  iki_key (conc (n
8850: 75 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 28 74  umber->string (t
8860: 77 69 6b 69 3a 77 69 6b 69 2d 67 65 74 2d 77 69  wiki:wiki-get-wi
8870: 64 20 77 69 6b 69 29 29 20 22 2d 22 20 28 74 77  d wiki)) "-" (tw
8880: 69 6b 69 3a 77 65 62 36 34 65 6e 63 20 74 6b 65  iki:web64enc tke
8890: 79 29 29 0a 09 09 09 20 20 20 20 20 20 27 69 6d  y))....      'im
88a0: 61 67 65 20 20 70 69 63 2d 69 64 29 29 29 0a 20  age  pic-id))). 
88b0: 20 20 20 28 69 66 20 28 61 6e 64 20 28 3e 20 28     (if (and (> (
88c0: 6c 65 6e 67 74 68 20 78 79 29 20 31 29 0a 09 20  length xy) 1).. 
88d0: 20 20 20 20 28 63 61 72 20 78 79 29 0a 09 20 20      (car xy)..  
88e0: 20 20 20 28 63 61 64 72 20 78 79 29 29 20 3b 3b     (cadr xy)) ;;
88f0: 20 79 65 70 2c 20 68 61 76 65 20 74 77 6f 20 6e   yep, have two n
8900: 75 6d 62 65 72 73 0a 09 28 73 3a 69 6d 67 20 27  umbers..(s:img '
8910: 74 69 74 6c 65 20 70 69 63 2d 6e 61 6d 65 20 27  title pic-name '
8920: 61 6c 74 20 70 69 63 2d 6e 61 6d 65 20 27 77 69  alt pic-name 'wi
8930: 64 74 68 20 28 63 61 72 20 78 79 29 20 27 68 65  dth (car xy) 'he
8940: 69 67 68 74 20 28 63 61 64 72 20 78 79 29 20 27  ight (cadr xy) '
8950: 73 72 63 20 69 6d 67 2d 6c 6e 6b 29 0a 09 28 73  src img-lnk)..(s
8960: 3a 69 6d 67 20 27 74 69 74 6c 65 20 70 69 63 2d  :img 'title pic-
8970: 6e 61 6d 65 20 27 61 6c 74 20 70 69 63 2d 6e 61  name 'alt pic-na
8980: 6d 65 20 27 73 72 63 20 69 6d 67 2d 6c 6e 6b 29  me 'src img-lnk)
8990: 29 29 29 0a 0a 3b 3b 20 6f 76 65 72 72 69 64 65  )))..;; override
89a0: 20 74 68 65 73 65 20 61 6c 73 6f 0a 28 64 65 66   these also.(def
89b0: 69 6e 65 20 28 74 77 69 6b 69 3a 67 65 74 2d 69  ine (twiki:get-i
89c0: 64 29 0a 20 20 28 73 3a 73 65 73 73 69 6f 6e 2d  d).  (s:session-
89d0: 76 61 72 2d 67 65 74 20 22 69 64 22 29 29 0a 0a  var-get "id"))..
89e0: 3b 3b 20 6f 76 65 72 72 69 64 65 20 74 68 69 73  ;; override this
89f0: 20 74 6f 20 73 65 74 20 6c 69 6e 6b 73 20 69 6e   to set links in
8a00: 73 69 64 65 20 77 69 6b 69 27 73 0a 28 64 65 66  side wiki's.(def
8a10: 69 6e 65 20 28 74 77 69 6b 69 3a 67 65 74 2d 6c  ine (twiki:get-l
8a20: 69 6e 6b 2d 62 61 63 6b 2d 74 6f 2d 63 75 72 72  ink-back-to-curr
8a30: 65 6e 74 29 0a 20 20 28 73 3a 63 75 72 72 65 6e  ent).  (s:curren
8a40: 74 2d 70 61 67 65 29 29 0a 0a 0a 3b 3b 20 72 65  t-page))...;; re
8a50: 67 65 78 65 73 20 61 72 65 20 6c 69 73 74 65 64  gexes are listed
8a60: 20 69 6e 20 74 68 65 20 6f 72 64 65 72 20 69 6e   in the order in
8a70: 20 77 68 69 63 68 20 74 68 65 79 20 73 68 6f 75   which they shou
8a80: 6c 64 20 62 65 20 63 68 65 63 6b 65 64 0a 0a 28  ld be checked..(
8a90: 64 65 66 69 6e 65 20 74 77 69 6b 69 3a 68 33 2d  define twiki:h3-
8aa0: 70 61 74 74 20 28 72 65 67 65 78 70 20 22 5e 21  patt (regexp "^!
8ab0: 21 21 28 2e 2a 29 24 22 29 29 0a 28 64 65 66 69  !!(.*)$")).(defi
8ac0: 6e 65 20 74 77 69 6b 69 3a 68 32 2d 70 61 74 74  ne twiki:h2-patt
8ad0: 20 28 72 65 67 65 78 70 20 22 5e 21 21 28 2e 2a   (regexp "^!!(.*
8ae0: 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20 74 77  )$")).(define tw
8af0: 69 6b 69 3a 68 31 2d 70 61 74 74 20 28 72 65 67  iki:h1-patt (reg
8b00: 65 78 70 20 22 5e 21 28 2e 2a 29 24 22 29 29 0a  exp "^!(.*)$")).
8b10: 0a 28 64 65 66 69 6e 65 20 74 77 69 6b 69 3a 74  .(define twiki:t
8b20: 6c 69 6e 6b 2d 70 61 74 74 20 20 20 20 20 28 72  link-patt     (r
8b30: 65 67 65 78 70 20 22 5e 28 2e 2a 29 5c 5c 5b 5c  egexp "^(.*)\\[\
8b40: 5c 5b 28 5b 5e 5c 5c 5b 5c 5c 5d 5d 2a 29 5c 5c  \[([^\\[\\]]*)\\
8b50: 5d 5c 5c 5d 28 2e 2a 29 24 22 29 29 0a 28 64 65  ]\\](.*)$")).(de
8b60: 66 69 6e 65 20 74 77 69 6b 69 3a 70 69 63 2d 70  fine twiki:pic-p
8b70: 61 74 74 20 20 20 20 20 20 20 28 72 65 67 65 78  att       (regex
8b80: 70 20 22 5e 28 2e 2a 29 5c 5c 5b 70 69 63 28 5b  p "^(.*)\\[pic([
8b90: 30 2d 39 25 5d 2a 78 2a 5b 30 2d 39 25 5d 2a 29  0-9%]*x*[0-9%]*)
8ba0: 5c 5c 5b 28 5b 5e 5c 5c 5b 5c 5c 5d 5d 2b 29 5c  \\[([^\\[\\]]+)\
8bb0: 5c 5d 5c 5c 5d 28 2e 2a 29 24 22 29 29 0a 28 64  \]\\](.*)$")).(d
8bc0: 65 66 69 6e 65 20 74 77 69 6b 69 3a 75 6e 64 65  efine twiki:unde
8bd0: 72 6c 69 6e 65 2d 70 61 74 74 20 28 72 65 67 65  rline-patt (rege
8be0: 78 70 20 22 5e 28 2e 2a 29 5f 5f 28 2e 2a 29 5f  xp "^(.*)__(.*)_
8bf0: 5f 28 2e 2a 29 24 22 29 29 0a 28 64 65 66 69 6e  _(.*)$")).(defin
8c00: 65 20 74 77 69 6b 69 3a 74 61 62 6c 65 2d 70 61  e twiki:table-pa
8c10: 74 74 20 20 20 20 20 28 72 65 67 65 78 70 20 22  tt     (regexp "
8c20: 5e 5c 5c 7c 28 2e 2a 29 5c 5c 7c 24 22 29 29 0a  ^\\|(.*)\\|$")).
8c30: 0a 3b 3b 20 74 68 65 73 65 20 61 72 65 20 66 6f  .;; these are fo
8c40: 72 20 6d 75 6c 74 69 2d 6c 69 6e 65 20 66 6f 72  r multi-line for
8c50: 6d 61 74 69 6e 67 0a 28 64 65 66 69 6e 65 20 74  mating.(define t
8c60: 77 69 6b 69 3a 6c 69 73 74 2d 70 61 74 74 20 20  wiki:list-patt  
8c70: 20 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 2a    (regexp "^(\\*
8c80: 2b 7c 5c 5c 23 2b 29 28 2e 2a 29 24 22 29 29 0a  +|\\#+)(.*)$")).
8c90: 28 64 65 66 69 6e 65 20 74 77 69 6b 69 3a 62 75  (define twiki:bu
8ca0: 6c 6c 65 74 2d 70 61 74 74 20 20 28 72 65 67 65  llet-patt  (rege
8cb0: 78 70 20 22 5e 28 5c 5c 2a 2b 29 28 2e 2a 29 24  xp "^(\\*+)(.*)$
8cc0: 22 29 29 0a 28 64 65 66 69 6e 65 20 74 77 69 6b  ")).(define twik
8cd0: 69 3a 6e 75 6d 62 65 72 2d 70 61 74 74 20 20 28  i:number-patt  (
8ce0: 72 65 67 65 78 70 20 22 5e 28 5c 5c 23 2b 29 28  regexp "^(\\#+)(
8cf0: 2e 2a 29 24 22 29 29 0a 28 64 65 66 69 6e 65 20  .*)$")).(define 
8d00: 74 77 69 6b 69 3a 70 72 65 66 6f 72 2d 70 61 74  twiki:prefor-pat
8d10: 74 20 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 7b  t  (regexp "^\\{
8d20: 5c 5c 7b 5c 5c 7b 24 22 29 29 0a 28 64 65 66 69  \\{\\{$")).(defi
8d30: 6e 65 20 74 77 69 6b 69 3a 70 72 65 66 6f 72 2d  ne twiki:prefor-
8d40: 65 6e 64 2d 70 61 74 74 20 28 72 65 67 65 78 70  end-patt (regexp
8d50: 20 22 5e 5c 5c 7d 5c 5c 7d 5c 5c 7d 24 22 29 29   "^\\}\\}\\}$"))
8d60: 0a 0a 3b 3b 20 72 65 67 65 78 0a 28 64 65 66 69  ..;; regex.(defi
8d70: 6e 65 20 74 3a 6d 61 74 63 68 20 20 23 66 29 0a  ne t:match  #f).
8d80: 28 64 65 66 69 6e 65 20 28 74 2d 6d 61 74 63 68  (define (t-match
8d90: 20 72 20 73 29 0a 20 20 28 6c 65 74 20 28 28 72   r s).  (let ((r
8da0: 65 73 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68  es (string-match
8db0: 20 72 20 73 29 29 29 0a 20 20 20 20 28 73 65 74   r s))).    (set
8dc0: 21 20 74 3a 6d 61 74 63 68 20 72 65 73 29 0a 20  ! t:match res). 
8dd0: 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 73 68 6f     res))..;; sho
8de0: 75 6c 64 20 73 77 69 74 63 68 20 74 6f 20 72 65  uld switch to re
8df0: 63 75 72 73 69 76 65 6c 79 20 70 72 6f 63 65 73  cursively proces
8e00: 73 69 6e 67 20 62 79 20 62 6c 6f 63 6b 3f 0a 3b  sing by block?.;
8e10: 3b 20 28 70 72 6f 63 65 73 73 2d 62 6c 6f 63 6b  ; (process-block
8e20: 20 64 61 74 29 0a 3b 3b 20 20 20 2e 2e 2e 0a 3b   dat).;;   ....;
8e30: 3b 20 20 20 28 70 72 6f 63 65 73 73 2d 62 6c 6f  ;   (process-blo
8e40: 63 6b 20 72 65 6d 64 61 74 29 0a 28 64 65 66 69  ck remdat).(defi
8e50: 6e 65 20 28 74 77 69 6b 69 3a 64 61 74 2d 3e 68  ne (twiki:dat->h
8e60: 74 6d 6c 20 64 61 74 20 77 69 6b 69 29 0a 20 20  tml dat wiki).  
8e70: 28 6c 65 74 2a 20 28 28 69 6e 70 20 20 20 20 20  (let* ((inp     
8e80: 20 20 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73     (open-input-s
8e90: 74 72 69 6e 67 20 64 61 74 29 29 0a 09 20 28 6e  tring dat)).. (n
8ea0: 65 73 74 2d 64 65 70 74 68 20 30 29 20 3b 3b 20  est-depth 0) ;; 
8eb0: 64 65 70 74 68 20 6f 66 20 6e 65 73 74 65 64 20  depth of nested 
8ec0: 6c 69 73 74 73 0a 09 20 3b 3b 20 74 6f 6b 65 6e  lists.. ;; token
8ed0: 20 28 69 2e 65 2e 20 6c 69 6e 65 29 20 68 61 6e   (i.e. line) han
8ee0: 64 6c 69 6e 67 20 73 74 75 66 66 0a 09 20 28 6e  dling stuff.. (n
8ef0: 65 78 74 2d 6c 69 6e 65 20 20 23 66 29 0a 09 20  ext-line  #f).. 
8f00: 28 70 65 65 6b 2d 6c 69 6e 65 20 20 28 6c 61 6d  (peek-line  (lam
8f10: 62 64 61 20 28 29 0a 09 09 20 20 20 20 20 20 20  bda ()...       
8f20: 6e 65 78 74 2d 6c 69 6e 65 29 29 0a 09 20 28 67  next-line)).. (g
8f30: 65 74 2d 6c 69 6e 65 20 20 20 28 6c 61 6d 62 64  et-line   (lambd
8f40: 61 20 28 29 0a 09 09 20 20 20 20 20 20 20 28 6c  a ()...       (l
8f50: 65 74 20 28 28 72 65 73 20 6e 65 78 74 2d 6c 69  et ((res next-li
8f60: 6e 65 29 29 0a 09 09 09 20 28 73 65 74 21 20 6e  ne)).... (set! n
8f70: 65 78 74 2d 6c 69 6e 65 20 28 72 65 61 64 2d 6c  ext-line (read-l
8f80: 69 6e 65 20 69 6e 70 29 29 0a 09 09 09 20 3b 3b  ine inp)).... ;;
8f90: 20 28 70 72 69 6e 74 20 22 67 65 74 2d 6c 69 6e   (print "get-lin
8fa0: 65 3a 20 70 72 65 76 3d 22 20 72 65 73 20 22 20  e: prev=" res " 
8fb0: 6e 65 78 74 3d 22 20 6e 65 78 74 2d 6c 69 6e 65  next=" next-line
8fc0: 20 22 5c 6e 22 29 0a 09 09 09 20 72 65 73 29 29   "\n").... res))
8fd0: 29 0a 09 20 28 6c 20 20 20 20 20 20 20 20 20 20  ).. (l          
8fe0: 28 67 65 74 2d 6c 69 6e 65 29 29 29 20 3b 3b 20  (get-line))) ;; 
8ff0: 64 69 73 63 61 72 64 20 74 68 65 20 23 66 20 69  discard the #f i
9000: 6e 20 6e 65 78 74 2d 6c 69 6e 65 0a 20 20 20 20  n next-line.    
9010: 28 74 77 69 6b 69 3a 72 65 61 64 2d 62 6c 6f 63  (twiki:read-bloc
9020: 6b 20 70 65 65 6b 2d 6c 69 6e 65 20 67 65 74 2d  k peek-line get-
9030: 6c 69 6e 65 20 6e 65 73 74 2d 64 65 70 74 68 20  line nest-depth 
9040: 23 66 20 77 69 6b 69 29 29 29 0a 0a 3b 3b 20 62  #f wiki)))..;; b
9050: 6c 6b 2d 74 79 70 65 20 69 73 20 23 66 20 66 6f  lk-type is #f fo
9060: 72 20 6e 6f 74 20 69 6e 20 61 20 62 6c 6f 63 6b  r not in a block
9070: 20 28 69 2e 65 2e 20 61 74 20 74 6f 70 20 6c 65   (i.e. at top le
9080: 76 65 6c 29 2c 20 27 70 72 65 20 66 6f 72 20 70  vel), 'pre for p
9090: 72 65 66 6f 72 6d 61 74 65 64 2c 20 27 75 6c 20  reformated, 'ul 
90a0: 6f 72 20 27 6f 6c 0a 3b 3b 20 63 61 6c 6c 20 77  or 'ol.;; call w
90b0: 69 74 68 20 66 69 72 73 74 20 6c 69 6e 65 20 61  ith first line a
90c0: 73 20 6c 65 67 69 74 20 64 61 74 61 0a 3b 3b 20  s legit data.;; 
90d0: 69 2e 65 2e 20 66 6f 72 20 70 72 65 66 6f 72 6d  i.e. for preform
90e0: 20 2d 20 73 6b 69 70 20 74 68 65 20 7b 7b 7b 20   - skip the {{{ 
90f0: 6c 69 6e 65 20 74 68 65 6e 20 63 61 6c 6c 20 72  line then call r
9100: 65 61 64 2d 62 6c 6f 63 6b 0a 3b 3b 20 20 20 20  ead-block.;;    
9110: 20 20 66 6f 72 20 23 20 6f 72 20 2a 20 63 61 6c    for # or * cal
9120: 6c 20 77 69 74 68 20 66 69 72 73 74 20 6c 69 6e  l with first lin
9130: 65 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69  e.(define (twiki
9140: 3a 72 65 61 64 2d 62 6c 6f 63 6b 20 70 65 65 6b  :read-block peek
9150: 2d 6c 69 6e 65 20 67 65 74 2d 6c 69 6e 65 20 6e  -line get-line n
9160: 65 73 74 2d 64 65 70 74 68 20 62 6c 6b 2d 74 79  est-depth blk-ty
9170: 70 65 20 77 69 6b 69 29 0a 20 20 28 6c 65 74 20  pe wiki).  (let 
9180: 6c 6f 6f 70 20 28 28 72 65 73 20 27 28 29 29 0a  loop ((res '()).
9190: 09 20 20 20 20 20 28 6c 20 20 20 28 70 65 65 6b  .     (l   (peek
91a0: 2d 6c 69 6e 65 29 29 29 20 3b 3b 20 73 68 6f 75  -line))) ;; shou
91b0: 6c 64 20 74 68 69 73 20 62 65 20 61 20 70 65 65  ld this be a pee
91c0: 6b 2d 6c 69 6e 65 3f 20 79 65 73 21 21 0a 20 20  k-line? yes!!.  
91d0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 74 77 69    ;; (print "twi
91e0: 6b 69 3a 72 65 61 64 2d 62 6c 6f 63 6b 20 6c 6f  ki:read-block lo
91f0: 6f 70 20 6e 65 73 74 2d 64 65 70 74 68 3d 22 6e  op nest-depth="n
9200: 65 73 74 2d 64 65 70 74 68 20 22 20 62 6c 6b 2d  est-depth " blk-
9210: 74 79 70 65 3d 22 20 62 6c 6b 2d 74 79 70 65 20  type=" blk-type 
9220: 22 20 6c 3d 22 20 6c 20 22 5c 6e 20 20 72 65 73  " l=" l "\n  res
9230: 3d 22 20 72 65 73 29 0a 20 20 20 20 28 69 66 20  =" res).    (if 
9240: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 6c 29 0a  (eof-object? l).
9250: 09 3b 3b 20 77 65 20 61 72 65 20 64 6f 6e 65 21  .;; we are done!
9260: 20 72 65 74 75 72 6e 20 74 68 65 20 6c 69 73 74   return the list
9270: 0a 09 72 65 73 0a 09 3b 3b 20 70 72 6f 63 65 73  ..res..;; proces
9280: 73 20 69 74 21 0a 09 28 63 6f 6e 64 0a 09 20 3b  s it!..(cond.. ;
9290: 3b 20 68 61 6e 64 6c 65 20 70 72 65 66 6f 72 6d  ; handle preform
92a0: 61 74 65 64 20 74 65 78 74 0a 09 20 28 28 65 71  ated text.. ((eq
92b0: 3f 20 62 6c 6b 2d 74 79 70 65 20 27 70 72 65 29  ? blk-type 'pre)
92c0: 0a 09 20 20 28 69 66 20 28 74 2d 6d 61 74 63 68  ..  (if (t-match
92d0: 20 20 74 77 69 6b 69 3a 70 72 65 66 6f 72 2d 65    twiki:prefor-e
92e0: 6e 64 2d 70 61 74 74 20 6c 29 0a 09 20 20 20 20  nd-patt l)..    
92f0: 20 20 28 62 65 67 69 6e 0a 09 09 28 67 65 74 2d    (begin...(get-
9300: 6c 69 6e 65 29 20 3b 3b 20 64 69 73 63 61 72 64  line) ;; discard
9310: 20 74 68 65 20 7d 7d 7d 0a 09 09 72 65 73 29 20   the }}}...res) 
9320: 20 20 20 20 20 20 3b 3b 20 65 6e 64 20 6f 66 20        ;; end of 
9330: 70 72 65 66 6f 72 6d 61 74 74 65 64 0a 09 20 20  preformatted..  
9340: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 3b 3b 20      (begin...;; 
9350: 28 67 65 74 2d 6c 69 6e 65 29 20 3b 3b 20 64 69  (get-line) ;; di
9360: 73 63 61 72 64 20 74 68 65 20 7b 7b 7b 0a 09 09  scard the {{{...
9370: 28 6c 6f 6f 70 20 28 61 70 70 65 6e 64 20 72 65  (loop (append re
9380: 73 20 28 6c 69 73 74 20 28 67 65 74 2d 6c 69 6e  s (list (get-lin
9390: 65 29 29 29 0a 09 09 20 20 20 20 20 20 28 70 65  e)))...      (pe
93a0: 65 6b 2d 6c 69 6e 65 29 29 29 29 29 0a 09 20 3b  ek-line))))).. ;
93b0: 3b 20 68 61 6e 64 6c 65 20 74 61 62 6c 65 73 0a  ; handle tables.
93c0: 09 20 28 28 65 71 3f 20 62 6c 6b 2d 74 79 70 65  . ((eq? blk-type
93d0: 20 27 74 61 62 6c 65 29 0a 09 20 20 28 69 66 20   'table)..  (if 
93e0: 28 74 2d 6d 61 74 63 68 20 74 77 69 6b 69 3a 74  (t-match twiki:t
93f0: 61 62 6c 65 2d 70 61 74 74 20 6c 29 0a 09 20 20  able-patt l)..  
9400: 20 20 20 20 28 6c 65 74 20 28 28 63 65 6c 73 20      (let ((cels 
9410: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28   (string-split (
9420: 63 61 64 72 20 74 3a 6d 61 74 63 68 29 20 22 7c  cadr t:match) "|
9430: 22 29 29 29 0a 09 09 28 67 65 74 2d 6c 69 6e 65  ")))...(get-line
9440: 29 0a 09 09 28 6c 6f 6f 70 20 28 61 70 70 65 6e  )...(loop (appen
9450: 64 20 72 65 73 20 28 74 77 69 6b 69 3a 74 72 20  d res (twiki:tr 
9460: 28 6d 61 70 20 74 77 69 6b 69 3a 74 64 20 0a 09  (map twiki:td ..
9470: 09 09 09 09 09 20 28 6d 61 70 20 28 6c 61 6d 62  ..... (map (lamb
9480: 64 61 20 28 78 29 28 74 77 69 6b 69 3a 6c 69 6e  da (x)(twiki:lin
9490: 65 2d 3e 68 74 6d 6c 20 78 20 23 66 20 77 69 6b  e->html x #f wik
94a0: 69 29 29 20 63 65 6c 73 29 29 29 29 0a 09 09 20  i)) cels))))... 
94b0: 20 20 20 20 20 28 67 65 74 2d 6c 69 6e 65 29 29       (get-line))
94c0: 29 0a 09 20 20 20 20 20 20 72 65 73 29 29 0a 09  )..      res))..
94d0: 20 3b 3b 20 68 61 6e 64 6c 65 20 6c 69 73 74 73   ;; handle lists
94e0: 0a 09 20 28 28 6f 72 20 28 74 2d 6d 61 74 63 68  .. ((or (t-match
94f0: 20 74 77 69 6b 69 3a 62 75 6c 6c 65 74 2d 70 61   twiki:bullet-pa
9500: 74 74 20 6c 29 20 3b 3b 20 68 61 76 65 20 2a 0a  tt l) ;; have *.
9510: 09 20 20 20 20 20 20 28 74 2d 6d 61 74 63 68 20  .      (t-match 
9520: 74 77 69 6b 69 3a 6e 75 6d 62 65 72 2d 70 61 74  twiki:number-pat
9530: 74 20 6c 29 29 0a 09 20 20 28 6c 65 74 2a 20 28  t l))..  (let* (
9540: 28 64 69 72 65 63 74 69 76 65 20 28 63 61 64 72  (directive (cadr
9550: 20 74 3a 6d 61 74 63 68 29 29 0a 09 09 20 28 6c   t:match))... (l
9560: 65 76 65 6c 6e 75 6d 20 28 73 74 72 69 6e 67 2d  evelnum (string-
9570: 6c 65 6e 67 74 68 20 64 69 72 65 63 74 69 76 65  length directive
9580: 29 29 0a 09 09 20 28 74 65 78 74 20 20 20 20 20  ))... (text     
9590: 28 74 77 69 6b 69 3a 6c 69 6e 65 2d 3e 68 74 6d  (twiki:line->htm
95a0: 6c 20 28 63 61 64 64 72 20 74 3a 6d 61 74 63 68  l (caddr t:match
95b0: 29 20 23 74 20 77 69 6b 69 29 29 0a 09 09 20 28  ) #t wiki))... (
95c0: 62 74 79 70 65 20 20 20 20 28 69 66 20 28 73 74  btype    (if (st
95d0: 72 69 6e 67 3d 3f 20 22 23 22 20 28 73 75 62 73  ring=? "#" (subs
95e0: 74 72 69 6e 67 20 64 69 72 65 63 74 69 76 65 20  tring directive 
95f0: 30 20 31 29 29 0a 09 09 09 20 20 20 20 20 20 20  0 1))....       
9600: 27 6f 6c 0a 09 09 09 20 20 20 20 20 20 20 27 75  'ol....       'u
9610: 6c 29 29 0a 09 09 20 28 66 75 6e 63 20 20 20 20  l))... (func    
9620: 20 28 69 66 20 28 65 71 3f 20 62 74 79 70 65 20   (if (eq? btype 
9630: 27 75 6c 29 0a 09 09 09 20 20 20 20 20 20 20 74  'ul)....       t
9640: 77 69 6b 69 3a 75 6c 0a 09 09 09 20 20 20 20 20  wiki:ul....     
9650: 20 20 74 77 69 6b 69 3a 6f 6c 29 29 29 0a 09 20    twiki:ol))).. 
9660: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 68 61     ;; (print "ha
9670: 6e 64 6c 69 6e 67 20 22 20 62 74 79 70 65 20 22  ndling " btype "
9680: 3a 20 6c 65 76 65 6c 6e 75 6d 3d 22 20 6c 65 76  : levelnum=" lev
9690: 65 6c 6e 75 6d 20 22 20 74 65 78 74 3d 22 20 74  elnum " text=" t
96a0: 65 78 74 20 22 20 6e 65 73 74 2d 64 65 70 74 68  ext " nest-depth
96b0: 3d 22 20 6e 65 73 74 2d 64 65 70 74 68 20 22 20  =" nest-depth " 
96c0: 62 6c 6b 2d 74 79 70 65 3d 22 20 62 6c 6b 2d 74  blk-type=" blk-t
96d0: 79 70 65 29 0a 09 20 20 20 20 28 63 6f 6e 64 0a  ype)..    (cond.
96e0: 09 20 20 20 20 20 28 28 6e 6f 74 20 62 6c 6b 2d  .     ((not blk-
96f0: 74 79 70 65 29 20 3b 3b 20 69 2e 65 20 66 69 72  type) ;; i.e fir
9700: 73 74 20 6d 65 6d 62 65 72 20 6f 66 20 74 68 65  st member of the
9710: 20 6c 69 73 74 21 0a 09 20 20 20 20 20 20 28 6c   list!..      (l
9720: 6f 6f 70 20 28 61 70 70 65 6e 64 20 72 65 73 20  oop (append res 
9730: 28 66 75 6e 63 20 28 74 77 69 6b 69 3a 72 65 61  (func (twiki:rea
9740: 64 2d 62 6c 6f 63 6b 20 70 65 65 6b 2d 6c 69 6e  d-block peek-lin
9750: 65 20 67 65 74 2d 6c 69 6e 65 20 6c 65 76 65 6c  e get-line level
9760: 6e 75 6d 20 62 74 79 70 65 20 77 69 6b 69 29 29  num btype wiki))
9770: 29 0a 09 09 20 20 20 20 28 67 65 74 2d 6c 69 6e  )...    (get-lin
9780: 65 29 29 29 0a 09 20 20 20 20 20 28 28 3e 20 6c  e)))..     ((> l
9790: 65 76 65 6c 6e 75 6d 20 6e 65 73 74 2d 64 65 70  evelnum nest-dep
97a0: 74 68 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70  th)..      (loop
97b0: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 66 75   (append res (fu
97c0: 6e 63 20 28 74 77 69 6b 69 3a 72 65 61 64 2d 62  nc (twiki:read-b
97d0: 6c 6f 63 6b 20 70 65 65 6b 2d 6c 69 6e 65 20 67  lock peek-line g
97e0: 65 74 2d 6c 69 6e 65 20 28 2b 20 6e 65 73 74 2d  et-line (+ nest-
97f0: 64 65 70 74 68 20 31 29 20 62 74 79 70 65 20 77  depth 1) btype w
9800: 69 6b 69 29 29 29 0a 09 09 20 20 20 20 28 70 65  iki)))...    (pe
9810: 65 6b 2d 6c 69 6e 65 29 29 29 0a 09 20 20 20 20  ek-line)))..    
9820: 20 28 28 3c 20 6c 65 76 65 6c 6e 75 6d 20 6e 65   ((< levelnum ne
9830: 73 74 2d 64 65 70 74 68 29 0a 09 20 20 20 20 20  st-depth)..     
9840: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 74 77   (append res (tw
9850: 69 6b 69 3a 6c 69 20 74 65 78 74 29 29 29 20 3b  iki:li text))) ;
9860: 3b 20 72 65 74 75 72 6e 20 74 68 65 20 62 75 6c  ; return the bul
9870: 6c 65 74 65 64 20 69 74 65 6d 2c 20 64 6f 6e 27  leted item, don'
9880: 74 20 67 65 74 20 74 68 65 20 6e 65 78 74 20 6c  t get the next l
9890: 69 6e 65 3f 3f 0a 09 20 20 20 20 20 28 65 6c 73  ine??..     (els
98a0: 65 0a 09 20 20 20 20 20 20 28 67 65 74 2d 6c 69  e..      (get-li
98b0: 6e 65 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70  ne)..      (loop
98c0: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 74 77   (append res (tw
98d0: 69 6b 69 3a 6c 69 20 74 65 78 74 29 29 0a 09 09  iki:li text))...
98e0: 20 20 20 20 28 70 65 65 6b 2d 6c 69 6e 65 29 29      (peek-line))
98f0: 29 29 29 29 0a 09 20 28 28 74 2d 6d 61 74 63 68  )))).. ((t-match
9900: 20 74 77 69 6b 69 3a 70 72 65 66 6f 72 2d 70 61   twiki:prefor-pa
9910: 74 74 20 6c 29 0a 09 20 20 28 67 65 74 2d 6c 69  tt l)..  (get-li
9920: 6e 65 29 20 3b 3b 20 64 69 73 63 61 72 64 20 74  ne) ;; discard t
9930: 68 65 20 7b 7b 7b 0a 09 20 20 28 6c 6f 6f 70 20  he {{{..  (loop 
9940: 28 61 70 70 65 6e 64 20 72 65 73 20 28 74 77 69  (append res (twi
9950: 6b 69 3a 70 72 65 20 28 74 77 69 6b 69 3a 72 65  ki:pre (twiki:re
9960: 61 64 2d 62 6c 6f 63 6b 20 70 65 65 6b 2d 6c 69  ad-block peek-li
9970: 6e 65 20 67 65 74 2d 6c 69 6e 65 20 6e 65 73 74  ne get-line nest
9980: 2d 64 65 70 74 68 20 27 70 72 65 20 77 69 6b 69  -depth 'pre wiki
9990: 29 29 29 0a 09 09 28 70 65 65 6b 2d 6c 69 6e 65  )))...(peek-line
99a0: 29 29 29 0a 09 20 28 28 74 2d 6d 61 74 63 68 20  ))).. ((t-match 
99b0: 74 77 69 6b 69 3a 74 61 62 6c 65 2d 70 61 74 74  twiki:table-patt
99c0: 20 6c 29 0a 09 20 20 28 67 65 74 2d 6c 69 6e 65   l)..  (get-line
99d0: 29 0a 09 20 20 28 6c 6f 6f 70 20 28 61 70 70 65  )..  (loop (appe
99e0: 6e 64 20 72 65 73 20 28 74 77 69 6b 69 3a 74 61  nd res (twiki:ta
99f0: 62 6c 65 20 27 62 6f 72 64 65 72 20 31 20 27 63  ble 'border 1 'c
9a00: 65 6c 6c 73 70 61 63 69 6e 67 20 30 20 28 74 77  ellspacing 0 (tw
9a10: 69 6b 69 3a 72 65 61 64 2d 62 6c 6f 63 6b 20 70  iki:read-block p
9a20: 65 65 6b 2d 6c 69 6e 65 20 67 65 74 2d 6c 69 6e  eek-line get-lin
9a30: 65 20 30 20 27 74 61 62 6c 65 20 77 69 6b 69 29  e 0 'table wiki)
9a40: 29 29 0a 09 09 28 70 65 65 6b 2d 6c 69 6e 65 29  ))...(peek-line)
9a50: 29 29 0a 09 20 28 65 6c 73 65 0a 09 20 20 28 67  )).. (else..  (g
9a60: 65 74 2d 6c 69 6e 65 29 0a 09 20 20 28 6c 6f 6f  et-line)..  (loo
9a70: 70 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 74  p (append res (t
9a80: 77 69 6b 69 3a 6c 69 6e 65 2d 3e 68 74 6d 6c 20  wiki:line->html 
9a90: 6c 20 23 74 20 77 69 6b 69 29 29 0a 09 09 28 70  l #t wiki))...(p
9aa0: 65 65 6b 2d 6c 69 6e 65 29 29 29 29 29 29 29 0a  eek-line))))))).
9ab0: 0a 28 64 65 66 69 6e 65 20 28 74 77 69 6b 69 3a  .(define (twiki:
9ac0: 6c 69 6e 65 2d 3e 68 74 6d 6c 20 64 61 74 20 66  line->html dat f
9ad0: 69 72 73 74 63 61 6c 6c 20 77 69 6b 69 29 0a 20  irstcall wiki). 
9ae0: 20 28 69 66 20 66 69 72 73 74 63 61 6c 6c 20 0a   (if firstcall .
9af0: 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 65 73 73        ;; process
9b00: 20 74 68 65 20 70 61 74 74 65 72 6e 73 20 74 68   the patterns th
9b10: 61 74 20 74 65 73 74 20 66 6f 72 20 62 65 67 69  at test for begi
9b20: 6e 6e 69 6e 67 20 6f 66 20 6c 69 6e 65 20 6f 6e  nning of line on
9b30: 6c 79 20 6f 6e 20 74 68 65 20 66 69 72 73 74 20  ly on the first 
9b40: 63 61 6c 6c 0a 20 20 20 20 20 20 28 63 6f 6e 64  call.      (cond
9b50: 0a 20 20 20 20 20 20 20 28 28 74 2d 6d 61 74 63  .       ((t-matc
9b60: 68 20 74 77 69 6b 69 3a 68 33 2d 70 61 74 74 20  h twiki:h3-patt 
9b70: 64 61 74 29 0a 09 28 74 77 69 6b 69 3a 68 33 20  dat)..(twiki:h3 
9b80: 28 74 77 69 6b 69 3a 6c 69 6e 65 2d 3e 68 74 6d  (twiki:line->htm
9b90: 6c 20 28 63 61 64 72 20 74 3a 6d 61 74 63 68 29  l (cadr t:match)
9ba0: 20 23 66 20 77 69 6b 69 29 29 29 0a 20 20 20 20   #f wiki))).    
9bb0: 20 20 20 28 28 74 2d 6d 61 74 63 68 20 74 77 69     ((t-match twi
9bc0: 6b 69 3a 68 32 2d 70 61 74 74 20 64 61 74 29 0a  ki:h2-patt dat).
9bd0: 09 28 74 77 69 6b 69 3a 68 32 20 28 74 77 69 6b  .(twiki:h2 (twik
9be0: 69 3a 6c 69 6e 65 2d 3e 68 74 6d 6c 20 28 63 61  i:line->html (ca
9bf0: 64 72 20 74 3a 6d 61 74 63 68 29 20 23 66 20 77  dr t:match) #f w
9c00: 69 6b 69 29 29 29 0a 20 20 20 20 20 20 20 28 28  iki))).       ((
9c10: 74 2d 6d 61 74 63 68 20 74 77 69 6b 69 3a 68 31  t-match twiki:h1
9c20: 2d 70 61 74 74 20 64 61 74 29 0a 09 28 74 77 69  -patt dat)..(twi
9c30: 6b 69 3a 68 31 20 28 74 77 69 6b 69 3a 6c 69 6e  ki:h1 (twiki:lin
9c40: 65 2d 3e 68 74 6d 6c 20 28 63 61 64 72 20 74 3a  e->html (cadr t:
9c50: 6d 61 74 63 68 29 20 23 66 20 77 69 6b 69 29 29  match) #f wiki))
9c60: 29 0a 20 20 20 20 20 20 20 3b 3b 20 77 68 79 20  ).       ;; why 
9c70: 77 61 73 20 74 68 65 20 28 73 3a 62 72 29 20 68  was the (s:br) h
9c80: 65 72 65 3f 20 74 72 79 69 6e 67 20 77 69 74 68  ere? trying with
9c90: 6f 75 74 0a 20 20 20 20 20 20 20 28 65 6c 73 65  out.       (else
9ca0: 20 28 74 77 69 6b 69 3a 6c 69 6e 65 2d 3e 68 74   (twiki:line->ht
9cb0: 6d 6c 20 64 61 74 20 23 66 20 77 69 6b 69 29 29  ml dat #f wiki))
9cc0: 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 65 6c 73  ).       ;; (els
9cd0: 65 20 20 28 61 70 70 65 6e 64 20 28 74 77 69 6b  e  (append (twik
9ce0: 69 3a 6c 69 6e 65 2d 3e 68 74 6d 6c 20 64 61 74  i:line->html dat
9cf0: 20 23 66 20 77 69 6b 69 29 28 6c 69 73 74 20 28   #f wiki)(list (
9d00: 73 3a 62 72 29 29 29 29 29 3b 3b 20 28 73 3a 70  s:br)))));; (s:p
9d10: 20 27 63 6c 61 73 73 20 22 74 69 64 64 6c 65 72   'class "tiddler
9d20: 70 61 72 22 0a 20 20 20 20 20 20 3b 3b 20 6e 6f  par".      ;; no
9d30: 74 20 66 69 72 73 74 63 61 6c 6c 20 73 6f 20 70  t firstcall so p
9d40: 72 6f 63 65 73 73 20 6f 74 68 65 72 20 70 61 74  rocess other pat
9d50: 74 65 72 6e 73 0a 20 20 20 20 20 20 28 63 6f 6e  terns.      (con
9d60: 64 0a 20 20 20 20 20 20 20 28 28 74 2d 6d 61 74  d.       ((t-mat
9d70: 63 68 20 74 77 69 6b 69 3a 74 6c 69 6e 6b 2d 70  ch twiki:tlink-p
9d80: 61 74 74 20 64 61 74 29 0a 09 28 6c 65 74 20 28  att dat)..(let (
9d90: 28 70 72 65 20 20 28 63 61 64 72 20 20 20 74 3a  (pre  (cadr   t:
9da0: 6d 61 74 63 68 29 29 0a 09 20 20 20 20 20 20 28  match))..      (
9db0: 6c 6e 6b 20 20 28 63 61 64 64 72 20 20 74 3a 6d  lnk  (caddr  t:m
9dc0: 61 74 63 68 29 29 0a 09 20 20 20 20 20 20 28 70  atch))..      (p
9dd0: 6f 73 74 20 28 63 61 64 64 64 72 20 74 3a 6d 61  ost (cadddr t:ma
9de0: 74 63 68 29 29 29 0a 09 20 20 28 6c 69 73 74 20  tch)))..  (list 
9df0: 28 74 77 69 6b 69 3a 6c 69 6e 65 2d 3e 68 74 6d  (twiki:line->htm
9e00: 6c 20 70 72 65 20 23 66 20 77 69 6b 69 29 0a 09  l pre #f wiki)..
9e10: 09 28 74 77 69 6b 69 3a 6d 61 6b 65 2d 74 6c 69  .(twiki:make-tli
9e20: 6e 6b 20 28 74 77 69 6b 69 3a 6c 69 6e 65 2d 3e  nk (twiki:line->
9e30: 68 74 6d 6c 20 6c 6e 6b 20 23 66 20 77 69 6b 69  html lnk #f wiki
9e40: 29 20 6c 6e 6b 29 20 3b 3b 20 73 70 65 63 69 61  ) lnk) ;; specia
9e50: 6c 20 68 61 6e 64 6c 69 6e 67 0a 09 09 28 74 77  l handling...(tw
9e60: 69 6b 69 3a 6c 69 6e 65 2d 3e 68 74 6d 6c 20 70  iki:line->html p
9e70: 6f 73 74 20 23 66 20 77 69 6b 69 29 29 29 29 0a  ost #f wiki)))).
9e80: 20 20 20 20 20 20 20 28 28 74 2d 6d 61 74 63 68         ((t-match
9e90: 20 74 77 69 6b 69 3a 70 69 63 2d 70 61 74 74 20   twiki:pic-patt 
9ea0: 64 61 74 29 0a 09 28 6c 65 74 20 28 28 70 72 65  dat)..(let ((pre
9eb0: 20 20 28 63 61 64 72 20 20 20 20 74 3a 6d 61 74    (cadr    t:mat
9ec0: 63 68 29 29 0a 09 20 20 20 20 20 20 28 73 69 7a  ch))..      (siz
9ed0: 65 20 28 63 61 64 64 72 20 20 20 74 3a 6d 61 74  e (caddr   t:mat
9ee0: 63 68 29 29 20 0a 09 20 20 20 20 20 20 28 70 69  ch)) ..      (pi
9ef0: 63 20 20 28 63 61 64 64 64 72 20 20 74 3a 6d 61  c  (cadddr  t:ma
9f00: 74 63 68 29 29 0a 09 20 20 20 20 20 20 28 70 6f  tch))..      (po
9f10: 73 74 20 28 6c 69 73 74 2d 72 65 66 20 74 3a 6d  st (list-ref t:m
9f20: 61 74 63 68 20 34 29 29 29 0a 09 20 20 28 6c 69  atch 4)))..  (li
9f30: 73 74 20 28 74 77 69 6b 69 3a 6c 69 6e 65 2d 3e  st (twiki:line->
9f40: 68 74 6d 6c 20 70 72 65 20 23 66 20 77 69 6b 69  html pre #f wiki
9f50: 29 0a 09 09 28 74 77 69 6b 69 3a 70 69 63 20 70  )...(twiki:pic p
9f60: 69 63 20 73 69 7a 65 20 77 69 6b 69 29 0a 09 09  ic size wiki)...
9f70: 28 74 77 69 6b 69 3a 6c 69 6e 65 2d 3e 68 74 6d  (twiki:line->htm
9f80: 6c 20 70 6f 73 74 20 23 74 20 77 69 6b 69 29 29  l post #t wiki))
9f90: 29 29 0a 20 20 20 20 20 20 20 28 28 74 2d 6d 61  )).       ((t-ma
9fa0: 74 63 68 20 74 77 69 6b 69 3a 75 6e 64 65 72 6c  tch twiki:underl
9fb0: 69 6e 65 2d 70 61 74 74 20 64 61 74 29 0a 09 28  ine-patt dat)..(
9fc0: 6c 65 74 20 28 28 70 72 65 20 20 28 63 61 64 72  let ((pre  (cadr
9fd0: 20 20 20 74 3a 6d 61 74 63 68 29 29 0a 09 20 20     t:match))..  
9fe0: 20 20 20 20 28 6c 6e 6b 20 20 28 63 61 64 64 72      (lnk  (caddr
9ff0: 20 20 74 3a 6d 61 74 63 68 29 29 0a 09 20 20 20    t:match))..   
a000: 20 20 20 28 70 6f 73 74 20 28 63 61 64 64 64 72     (post (cadddr
a010: 20 74 3a 6d 61 74 63 68 29 29 29 0a 09 20 20 28   t:match)))..  (
a020: 6c 69 73 74 20 28 74 77 69 6b 69 3a 6c 69 6e 65  list (twiki:line
a030: 2d 3e 68 74 6d 6c 20 70 72 65 20 23 66 20 77 69  ->html pre #f wi
a040: 6b 69 29 0a 09 09 28 74 77 69 6b 69 3a 75 20 28  ki)...(twiki:u (
a050: 74 77 69 6b 69 3a 6c 69 6e 65 2d 3e 68 74 6d 6c  twiki:line->html
a060: 20 6c 6e 6b 20 23 66 20 77 69 6b 69 29 29 0a 09   lnk #f wiki))..
a070: 09 28 74 77 69 6b 69 3a 6c 69 6e 65 2d 3e 68 74  .(twiki:line->ht
a080: 6d 6c 20 70 6f 73 74 20 23 66 20 77 69 6b 69 29  ml post #f wiki)
a090: 29 29 29 0a 20 20 20 20 20 20 20 28 28 74 2d 6d  ))).       ((t-m
a0a0: 61 74 63 68 20 74 77 69 6b 69 3a 74 61 62 6c 65  atch twiki:table
a0b0: 2d 70 61 74 74 20 64 61 74 29 0a 09 28 6c 65 74  -patt dat)..(let
a0c0: 20 28 28 63 65 6c 73 20 20 28 73 74 72 69 6e 67   ((cels  (string
a0d0: 2d 73 70 6c 69 74 20 28 63 61 64 72 20 74 3a 6d  -split (cadr t:m
a0e0: 61 74 63 68 29 20 22 7c 22 29 29 29 0a 09 20 20  atch) "|")))..  
a0f0: 28 74 77 69 6b 69 3a 74 72 20 28 6d 61 70 20 74  (twiki:tr (map t
a100: 77 69 6b 69 3a 74 64 20 28 74 77 69 6b 69 3a 6c  wiki:td (twiki:l
a110: 69 6e 65 2d 3e 68 74 6d 6c 20 63 65 6c 73 20 23  ine->html cels #
a120: 66 20 77 69 6b 69 29 29 29 29 29 0a 20 20 20 20  f wiki))))).    
a130: 20 20 20 28 65 6c 73 65 20 28 6c 69 73 74 20 64     (else (list d
a140: 61 74 29 29 29 29 29 0a 0a 0a 23 7c 0a 28 74 77  at)))))...#|.(tw
a150: 69 6b 69 3a 64 61 74 2d 3e 68 74 6d 6c 20 22 61  iki:dat->html "a
a160: 5c 6e 7b 7b 7b 5c 6e 62 5c 6e 63 5c 6e 64 5c 6e  \n{{{\nb\nc\nd\n
a170: 7d 7d 7d 5c 6e 21 65 5c 6e 5b 5b 66 5d 5d 5c 6e  }}}\n!e\n[[f]]\n
a180: 5b 5b 67 5d 5d 5c 6e 2a 68 22 20 77 69 6b 69 29  [[g]]\n*h" wiki)
a190: 0a 28 73 3a 6f 75 74 70 75 74 20 28 63 75 72 72  .(s:output (curr
a1a0: 65 6e 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29  ent-output-port)
a1b0: 20 28 74 77 69 6b 69 3a 64 61 74 2d 3e 68 74 6d   (twiki:dat->htm
a1c0: 6c 20 22 21 54 65 73 74 69 6e 67 20 5b 5b 6d 79  l "!Testing [[my
a1d0: 20 66 69 72 73 74 20 6c 69 6e 6b 5d 5d 5c 6e 2a   first link]]\n*
a1e0: 20 54 65 73 74 5c 6e 2a 20 46 6f 6f 5c 6e 62 6c   Test\n* Foo\nbl
a1f0: 61 68 22 20 77 69 6b 69 29 29 20 20 20 0a 28 73  ah" wiki))   .(s
a200: 3a 6f 75 74 70 75 74 20 28 63 75 72 72 65 6e 74  :output (current
a210: 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29 20 28 74  -output-port) (t
a220: 77 69 6b 69 3a 64 61 74 2d 3e 68 74 6d 6c 20 22  wiki:dat->html "
a230: 5b 5b 61 5d 5d 5c 6e 7b 7b 7b 5c 6e 62 5c 6e 20  [[a]]\n{{{\nb\n 
a240: 20 63 5c 6e 20 20 20 64 5c 6e 7d 7d 7d 5c 6e 2a   c\n   d\n}}}\n*
a250: 78 5c 6e 5b 5b 66 5d 5d 5c 6e 5b 5b 67 5d 5d 5c  x\n[[f]]\n[[g]]\
a260: 6e 2a 68 22 20 77 69 6b 69 29 29 0a 28 73 3a 6f  n*h" wiki)).(s:o
a270: 75 74 70 75 74 20 28 63 75 72 72 65 6e 74 2d 6f  utput (current-o
a280: 75 74 70 75 74 2d 70 6f 72 74 29 0a 7c 23 0a 0a  utput-port).|#..