Artifact aa92a72dd6f3d197ac7320457edbba64e2f525c8:


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 31 2c 20 4d 61 74 74 68 65 77 20  7-2011, Matthew 
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20  Welland..;; .;; 
0030: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73   This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20   made available 
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50  under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72  L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65  .;;  greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69  e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20  ng file COPYING 
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20  for details..;; 
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61  .;;  This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64  m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52   WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65  RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c  ven the.;;  impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20  ied warranty of 
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20  MERCHANTABILITY 
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41  or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20   PARTICULAR.;;  
0140: 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 73 74 6d  PURPOSE...;; stm
0150: 6c 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 68  l is a list of h
0160: 74 6d 6c 20 73 74 72 69 6e 67 73 0a 0a 28 64 65  tml strings..(de
0170: 63 6c 61 72 65 20 28 75 6e 69 74 20 73 74 6d 6c  clare (unit stml
0180: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65  )).(declare (use
0190: 73 20 6d 69 73 63 2d 73 74 6d 6c 29 29 0a 28 72  s misc-stml)).(r
01a0: 65 71 75 69 72 65 2d 65 78 74 65 6e 73 69 6f 6e  equire-extension
01b0: 20 72 65 67 65 78 29 0a 0a 3b 3b 20 65 78 74 72   regex)..;; extr
01c0: 61 63 74 20 76 61 72 69 6f 75 73 20 74 6f 6b 65  act various toke
01d0: 6e 73 20 66 72 6f 6d 20 74 68 65 20 70 61 72 61  ns from the para
01e0: 6d 65 74 65 72 20 6c 69 73 74 0a 3b 3b 20 20 20  meter list.;;   
01f0: 27 6b 65 79 20 76 61 6c 20 3d 3e 20 70 75 74 20  'key val => put 
0200: 69 6e 20 74 68 65 20 70 61 72 61 6d 73 20 6c 69  in the params li
0210: 73 74 0a 3b 3b 20 20 20 73 74 72 69 6e 67 73 20  st.;;   strings 
0220: 20 3d 3e 20 6d 61 69 6e 74 61 69 6e 20 6f 72 64   => maintain ord
0230: 65 72 20 61 6e 64 20 61 64 64 20 74 6f 20 74 68  er and add to th
0240: 65 20 64 61 74 61 6c 69 73 74 20 3c 3c 3d 3d 20  e datalist <<== 
0250: 49 4d 50 4f 52 54 41 4e 54 0a 28 64 65 66 69 6e  IMPORTANT.(defin
0260: 65 20 28 73 3a 65 78 74 72 61 63 74 20 69 6e 6c  e (s:extract inl
0270: 73 74 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f  st).  (if (null?
0280: 20 69 6e 6c 73 74 29 20 69 6e 6c 73 74 0a 20 20   inlst) inlst.  
0290: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28      (let loop ((
02a0: 64 61 74 61 20 27 28 29 29 0a 20 20 20 20 20 20  data '()).      
02b0: 20 20 20 20 20 20 20 20 20 20 20 28 70 61 72 61             (para
02c0: 6d 73 20 27 28 29 29 0a 20 20 20 20 20 20 20 20  ms '()).        
02d0: 20 20 20 20 20 20 20 20 20 28 68 65 61 64 20 28           (head (
02e0: 63 61 72 20 69 6e 6c 73 74 29 29 0a 20 20 20 20  car inlst)).    
02f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 61               (ta
0300: 69 6c 20 28 63 64 72 20 69 6e 6c 73 74 29 29 29  il (cdr inlst)))
0310: 0a 20 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69  .        ;; (pri
0320: 6e 74 20 22 68 65 61 64 3d 22 20 68 65 61 64 20  nt "head=" head 
0330: 22 20 74 61 69 6c 3d 22 20 74 61 69 6c 29 0a 20  " tail=" tail). 
0340: 20 20 20 20 20 20 20 28 63 6f 6e 64 20 0a 20 20         (cond .  
0350: 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 74         ((null? t
0360: 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 28  ail).          (
0370: 69 66 20 28 73 79 6d 62 6f 6c 3f 20 68 65 61 64  if (symbol? head
0380: 29 20 3b 3b 20 74 68 65 20 6c 61 73 74 20 69 74  ) ;; the last it
0390: 65 6d 20 69 73 20 61 20 70 61 72 61 6d 20 2d 20  em is a param - 
03a0: 62 6f 72 6b 65 64 0a 20 20 20 20 20 20 20 20 20  borked.         
03b0: 20 20 20 20 20 28 73 3a 6c 6f 67 20 22 45 52 52       (s:log "ERR
03c0: 4f 52 3a 20 70 61 72 61 6d 20 77 69 74 68 20 6e  OR: param with n
03d0: 6f 20 76 61 6c 75 65 22 29 29 0a 20 20 20 20 20  o value")).     
03e0: 20 20 20 20 20 28 6c 69 73 74 20 28 61 70 70 65       (list (appe
03f0: 6e 64 20 64 61 74 61 20 28 6c 69 73 74 20 28 73  nd data (list (s
0400: 3a 61 6e 79 2d 3e 73 74 72 69 6e 67 20 68 65 61  :any->string hea
0410: 64 29 29 29 20 70 61 72 61 6d 73 29 29 0a 20 20  d))) params)).  
0420: 20 20 20 20 20 20 20 28 28 6f 72 20 28 73 74 72         ((or (str
0430: 69 6e 67 3f 20 68 65 61 64 29 28 6c 69 73 74 3f  ing? head)(list?
0440: 20 68 65 61 64 29 28 6e 75 6d 62 65 72 3f 20 68   head)(number? h
0450: 65 61 64 29 29 0a 20 20 20 20 20 20 20 20 20 20  ead)).          
0460: 28 6c 6f 6f 70 20 28 61 70 70 65 6e 64 20 64 61  (loop (append da
0470: 74 61 20 28 6c 69 73 74 20 20 28 73 3a 61 6e 79  ta (list  (s:any
0480: 2d 3e 73 74 72 69 6e 67 20 68 65 61 64 29 29 29  ->string head)))
0490: 20 70 61 72 61 6d 73 20 28 63 61 72 20 74 61 69   params (car tai
04a0: 6c 29 20 20 20 28 63 64 72 20 74 61 69 6c 29 29  l)   (cdr tail))
04b0: 29 0a 20 20 20 20 20 20 20 20 20 28 28 73 79 6d  ).         ((sym
04c0: 62 6f 6c 3f 20 68 65 61 64 29 0a 20 20 20 20 20  bol? head).     
04d0: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 2d       (let ((new-
04e0: 70 61 72 61 6d 73 20 28 63 6f 6e 73 20 28 6c 69  params (cons (li
04f0: 73 74 20 68 65 61 64 20 28 63 61 72 20 74 61 69  st head (car tai
0500: 6c 29 29 20 70 61 72 61 6d 73 29 29 0a 20 20 20  l)) params)).   
0510: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65               (ne
0520: 77 2d 74 61 69 6c 20 20 28 63 64 72 20 74 61 69  w-tail  (cdr tai
0530: 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20  l))).           
0540: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6e 65 77 2d   (if (null? new-
0550: 74 61 69 6c 29 20 3b 3b 20 77 65 20 61 72 65 20  tail) ;; we are 
0560: 64 6f 6e 65 2c 20 6e 6f 20 6d 6f 72 65 20 70 61  done, no more pa
0570: 72 61 6d 73 20 65 74 63 2e 0a 20 20 20 20 20 20  rams etc..      
0580: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20            (list 
0590: 64 61 74 61 20 6e 65 77 2d 70 61 72 61 6d 73 29  data new-params)
05a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
05b0: 20 28 6c 6f 6f 70 20 64 61 74 61 20 6e 65 77 2d   (loop data new-
05c0: 70 61 72 61 6d 73 20 28 63 61 72 20 6e 65 77 2d  params (car new-
05d0: 74 61 69 6c 29 28 63 64 72 20 6e 65 77 2d 74 61  tail)(cdr new-ta
05e0: 69 6c 29 29 29 29 29 0a 20 20 20 20 20 20 20 20  il))))).        
05f0: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20   (else.         
0600: 20 28 73 3a 6c 6f 67 20 22 57 41 52 4e 49 4e 47   (s:log "WARNING
0610: 3a 20 4d 61 6c 66 6f 72 6d 65 64 20 69 6e 70 75  : Malformed inpu
0620: 74 2c 20 79 6f 75 20 68 61 76 65 20 62 72 6f 6b  t, you have brok
0630: 65 6e 20 73 74 6d 6c 2c 20 72 65 6d 65 6d 62 65  en stml, remembe
0640: 72 20 74 68 61 74 20 61 6c 6c 20 73 74 6d 6c 20  r that all stml 
0650: 63 61 6c 6c 73 20 73 68 6f 75 6c 64 20 72 65 74  calls should ret
0660: 75 72 6e 20 61 20 72 65 73 75 6c 74 20 28 6e 75  urn a result (nu
0670: 6c 6c 20 6c 69 73 74 20 6f 72 20 65 6d 70 74 79  ll list or empty
0680: 20 73 74 72 69 6e 67 20 69 73 20 6f 6b 29 3a 5c   string is ok):\
0690: 6e 20 20 68 65 61 64 3d 22 20 68 65 61 64 20 0a  n  head=" head .
06a0: 09 20 20 20 20 20 20 20 20 20 20 22 5c 6e 20 20  .          "\n  
06b0: 74 61 69 6c 3d 22 20 74 61 69 6c 20 0a 20 20 20  tail=" tail .   
06c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22                 "
06d0: 5c 6e 20 20 69 6e 6c 73 74 3d 22 20 69 6e 6c 73  \n  inlst=" inls
06e0: 74 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  t .             
06f0: 20 20 20 20 20 22 5c 6e 20 20 70 61 72 61 6d 73       "\n  params
0700: 3d 22 20 70 61 72 61 6d 73 29 0a 09 20 20 28 69  =" params)..  (i
0710: 66 20 28 6e 75 6c 6c 3f 20 74 61 69 6c 29 0a 09  f (null? tail)..
0720: 20 20 20 20 20 20 28 6c 69 73 74 20 64 61 74 61        (list data
0730: 20 70 61 72 61 6d 73 29 0a 09 20 20 20 20 20 20   params)..      
0740: 28 6c 6f 6f 70 20 64 61 74 61 20 70 61 72 61 6d  (loop data param
0750: 73 20 28 63 61 72 20 74 61 69 6c 29 28 63 64 72  s (car tail)(cdr
0760: 20 74 61 69 6c 29 29 29 29 29 29 29 29 0a 0a 3b   tail))))))))..;
0770: 3b 20 6d 6f 73 74 20 74 61 67 73 20 63 61 6e 20  ; most tags can 
0780: 62 65 20 68 61 6e 64 6c 65 64 20 62 79 20 74 68  be handled by th
0790: 69 73 20 72 6f 75 74 69 6e 65 0a 28 64 65 66 69  is routine.(defi
07a0: 6e 65 20 28 73 3a 63 6f 6d 6d 6f 6e 2d 74 61 67  ne (s:common-tag
07b0: 20 74 61 67 6e 61 6d 65 20 61 72 67 73 29 0a 20   tagname args). 
07c0: 20 28 6c 65 74 2a 20 28 28 69 6e 70 75 74 73 20   (let* ((inputs 
07d0: 28 73 3a 65 78 74 72 61 63 74 20 61 72 67 73 29  (s:extract args)
07e0: 29 0a 20 20 20 20 20 20 20 20 20 28 64 61 74 61  ).         (data
07f0: 20 20 20 28 63 61 72 20 69 6e 70 75 74 73 29 29     (car inputs))
0800: 0a 20 20 20 20 20 20 20 20 20 28 70 61 72 61 6d  .         (param
0810: 73 20 28 73 3a 70 72 6f 63 65 73 73 2d 70 61 72  s (s:process-par
0820: 61 6d 73 20 28 63 61 64 72 20 69 6e 70 75 74 73  ams (cadr inputs
0830: 29 29 29 29 0a 20 20 20 20 28 6c 69 73 74 20 28  )))).    (list (
0840: 63 6f 6e 63 20 22 3c 22 20 74 61 67 6e 61 6d 65  conc "<" tagname
0850: 20 70 61 72 61 6d 73 20 22 3e 22 29 0a 20 20 20   params ">").   
0860: 20 20 20 20 20 20 20 64 61 74 61 0a 20 20 20 20         data.    
0870: 20 20 20 20 20 20 28 63 6f 6e 63 20 22 3c 2f 22        (conc "</"
0880: 20 74 61 67 6e 61 6d 65 20 22 3e 22 29 29 29 29   tagname ">"))))
0890: 0a 0a 3b 3b 20 53 75 67 67 65 73 74 69 6f 6e 3a  ..;; Suggestion:
08a0: 20 6f 72 64 65 72 20 74 68 65 73 65 20 61 6c 70   order these alp
08b0: 68 61 62 65 74 69 63 61 6c 6c 79 0a 28 64 65 66  habetically.(def
08c0: 69 6e 65 20 28 73 3a 61 20 20 20 20 20 20 2e 20  ine (s:a      . 
08d0: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
08e0: 74 61 67 20 22 41 22 20 20 20 20 20 20 61 72 67  tag "A"      arg
08f0: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 62  s)).(define (s:b
0900: 20 20 20 20 20 20 2e 20 61 72 67 73 29 20 28 73        . args) (s
0910: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 42 22 20  :common-tag "B" 
0920: 20 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66       args)).(def
0930: 69 6e 65 20 28 73 3a 75 20 20 20 20 20 20 2e 20  ine (s:u      . 
0940: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0950: 74 61 67 20 22 55 22 20 20 20 20 20 20 61 72 67  tag "U"      arg
0960: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 62  s)).(define (s:b
0970: 69 67 20 20 20 20 2e 20 61 72 67 73 29 20 28 73  ig    . args) (s
0980: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 42 49 47  :common-tag "BIG
0990: 22 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66  "    args)).(def
09a0: 69 6e 65 20 28 73 3a 62 6f 64 79 20 20 20 2e 20  ine (s:body   . 
09b0: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
09c0: 74 61 67 20 22 42 4f 44 59 22 20 20 20 61 72 67  tag "BODY"   arg
09d0: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 63  s)).(define (s:c
09e0: 65 6e 74 65 72 20 2e 20 61 72 67 73 29 20 28 73  enter . args) (s
09f0: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 43 45 4e  :common-tag "CEN
0a00: 54 45 52 22 20 61 72 67 73 29 29 0a 28 64 65 66  TER" args)).(def
0a10: 69 6e 65 20 28 73 3a 63 6f 64 65 20 20 20 2e 20  ine (s:code   . 
0a20: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0a30: 74 61 67 20 22 43 4f 44 45 22 20 20 20 61 72 67  tag "CODE"   arg
0a40: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 64  s)).(define (s:d
0a50: 69 76 20 20 20 20 2e 20 61 72 67 73 29 20 28 73  iv    . args) (s
0a60: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 44 49 56  :common-tag "DIV
0a70: 22 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66  "    args)).(def
0a80: 69 6e 65 20 28 73 3a 68 31 20 20 20 20 20 2e 20  ine (s:h1     . 
0a90: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0aa0: 74 61 67 20 22 48 31 22 20 20 20 20 20 61 72 67  tag "H1"     arg
0ab0: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 68  s)).(define (s:h
0ac0: 32 20 20 20 20 20 2e 20 61 72 67 73 29 20 28 73  2     . args) (s
0ad0: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 48 32 22  :common-tag "H2"
0ae0: 20 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66       args)).(def
0af0: 69 6e 65 20 28 73 3a 68 33 20 20 20 20 20 2e 20  ine (s:h3     . 
0b00: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0b10: 74 61 67 20 22 48 33 22 20 20 20 20 20 61 72 67  tag "H3"     arg
0b20: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 68  s)).(define (s:h
0b30: 34 20 20 20 20 20 2e 20 61 72 67 73 29 20 28 73  4     . args) (s
0b40: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 48 34 22  :common-tag "H4"
0b50: 20 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66       args)).(def
0b60: 69 6e 65 20 28 73 3a 68 35 20 20 20 20 20 2e 20  ine (s:h5     . 
0b70: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0b80: 74 61 67 20 22 48 35 22 20 20 20 20 20 61 72 67  tag "H5"     arg
0b90: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 68  s)).(define (s:h
0ba0: 65 61 64 20 20 20 2e 20 61 72 67 73 29 20 28 73  ead   . args) (s
0bb0: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 48 45 41  :common-tag "HEA
0bc0: 44 22 20 20 20 61 72 67 73 29 29 0a 28 64 65 66  D"   args)).(def
0bd0: 69 6e 65 20 28 73 3a 68 74 6d 6c 20 20 20 2e 20  ine (s:html   . 
0be0: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0bf0: 74 61 67 20 22 48 54 4d 4c 22 20 20 20 61 72 67  tag "HTML"   arg
0c00: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 69  s)).(define (s:i
0c10: 20 20 20 20 20 20 2e 20 61 72 67 73 29 20 28 73        . args) (s
0c20: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 49 22 20  :common-tag "I" 
0c30: 20 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66       args)).(def
0c40: 69 6e 65 20 28 73 3a 69 6d 67 20 20 20 20 2e 20  ine (s:img    . 
0c50: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0c60: 74 61 67 20 22 49 4d 47 22 20 20 20 20 61 72 67  tag "IMG"    arg
0c70: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 69  s)).(define (s:i
0c80: 6e 70 75 74 20 20 2e 20 61 72 67 73 29 20 28 73  nput  . args) (s
0c90: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 49 4e 50  :common-tag "INP
0ca0: 55 54 22 20 20 61 72 67 73 29 29 0a 28 64 65 66  UT"  args)).(def
0cb0: 69 6e 65 20 28 73 3a 6c 69 6e 6b 20 20 20 2e 20  ine (s:link   . 
0cc0: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0cd0: 74 61 67 20 22 4c 49 4e 4b 22 20 20 20 61 72 67  tag "LINK"   arg
0ce0: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 70  s)).(define (s:p
0cf0: 20 20 20 20 20 20 2e 20 61 72 67 73 29 20 28 73        . args) (s
0d00: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 50 22 20  :common-tag "P" 
0d10: 20 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66       args)).(def
0d20: 69 6e 65 20 28 73 3a 73 74 72 6f 6e 67 20 2e 20  ine (s:strong . 
0d30: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0d40: 74 61 67 20 22 53 54 52 4f 4e 47 22 20 61 72 67  tag "STRONG" arg
0d50: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 74  s)).(define (s:t
0d60: 61 62 6c 65 20 20 2e 20 61 72 67 73 29 20 28 73  able  . args) (s
0d70: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 54 41 42  :common-tag "TAB
0d80: 4c 45 22 20 20 61 72 67 73 29 29 0a 28 64 65 66  LE"  args)).(def
0d90: 69 6e 65 20 28 73 3a 74 64 20 20 20 20 20 2e 20  ine (s:td     . 
0da0: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0db0: 74 61 67 20 22 54 44 22 20 20 20 20 20 61 72 67  tag "TD"     arg
0dc0: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 74  s)).(define (s:t
0dd0: 69 74 6c 65 20 20 2e 20 61 72 67 73 29 20 28 73  itle  . args) (s
0de0: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 54 49 54  :common-tag "TIT
0df0: 4c 45 22 20 20 61 72 67 73 29 29 0a 28 64 65 66  LE"  args)).(def
0e00: 69 6e 65 20 28 73 3a 74 72 20 20 20 20 20 2e 20  ine (s:tr     . 
0e10: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0e20: 74 61 67 20 22 54 52 22 20 20 20 20 20 61 72 67  tag "TR"     arg
0e30: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 73  s)).(define (s:s
0e40: 6d 61 6c 6c 20 20 2e 20 61 72 67 73 29 20 28 73  mall  . args) (s
0e50: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 53 4d 41  :common-tag "SMA
0e60: 4c 4c 22 20 20 61 72 67 73 29 29 0a 28 64 65 66  LL"  args)).(def
0e70: 69 6e 65 20 28 73 3a 71 75 6f 74 65 20 20 2e 20  ine (s:quote  . 
0e80: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0e90: 74 61 67 20 22 51 55 4f 54 45 22 20 20 61 72 67  tag "QUOTE"  arg
0ea0: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 68  s)).(define (s:h
0eb0: 72 20 20 20 20 20 2e 20 61 72 67 73 29 20 28 73  r     . args) (s
0ec0: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 48 52 22  :common-tag "HR"
0ed0: 20 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66       args)).(def
0ee0: 69 6e 65 20 28 73 3a 6c 69 20 20 20 20 20 2e 20  ine (s:li     . 
0ef0: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0f00: 74 61 67 20 22 4c 49 22 20 20 20 20 20 61 72 67  tag "LI"     arg
0f10: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 75  s)).(define (s:u
0f20: 6c 20 20 20 20 20 2e 20 61 72 67 73 29 20 28 73  l     . args) (s
0f30: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 55 4c 22  :common-tag "UL"
0f40: 20 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66       args)).(def
0f50: 69 6e 65 20 28 73 3a 6f 6c 20 20 20 20 20 2e 20  ine (s:ol     . 
0f60: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0f70: 74 61 67 20 22 4f 4c 22 20 20 20 20 20 61 72 67  tag "OL"     arg
0f80: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 64  s)).(define (s:d
0f90: 6c 20 20 20 20 20 2e 20 61 72 67 73 29 20 28 73  l     . args) (s
0fa0: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 44 4c 22  :common-tag "DL"
0fb0: 20 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66       args)).(def
0fc0: 69 6e 65 20 28 73 3a 64 74 20 20 20 20 20 2e 20  ine (s:dt     . 
0fd0: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
0fe0: 74 61 67 20 22 44 54 22 20 20 20 20 20 61 72 67  tag "DT"     arg
0ff0: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 64  s)).(define (s:d
1000: 64 20 20 20 20 20 2e 20 61 72 67 73 29 20 28 73  d     . args) (s
1010: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 44 44 22  :common-tag "DD"
1020: 20 20 20 20 20 61 72 67 73 29 29 0a 28 64 65 66       args)).(def
1030: 69 6e 65 20 28 73 3a 70 72 65 20 20 20 20 2e 20  ine (s:pre    . 
1040: 61 72 67 73 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d  args) (s:common-
1050: 74 61 67 20 22 50 52 45 22 20 20 20 20 61 72 67  tag "PRE"    arg
1060: 73 29 29 0a 28 64 65 66 69 6e 65 20 28 73 3a 73  s)).(define (s:s
1070: 70 61 6e 20 20 20 2e 20 61 72 67 73 29 20 28 73  pan   . args) (s
1080: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22 53 50 41  :common-tag "SPA
1090: 4e 22 20 20 20 61 72 67 73 29 29 0a 0a 28 64 65  N"   args))..(de
10a0: 66 69 6e 65 20 28 73 3a 64 62 6c 71 75 6f 74 65  fine (s:dblquote
10b0: 20 20 2e 20 61 72 67 73 29 0a 20 20 28 6c 65 74    . args).  (let
10c0: 2a 20 28 28 69 6e 70 75 74 73 20 28 73 3a 65 78  * ((inputs (s:ex
10d0: 74 72 61 63 74 20 61 72 67 73 29 29 0a 20 20 20  tract args)).   
10e0: 20 20 20 20 20 20 28 64 61 74 61 20 20 20 28 63        (data   (c
10f0: 61 61 72 20 69 6e 70 75 74 73 29 29 0a 20 20 20  aar inputs)).   
1100: 20 20 20 20 20 20 28 70 61 72 61 6d 73 20 28 73        (params (s
1110: 3a 70 72 6f 63 65 73 73 2d 70 61 72 61 6d 73 20  :process-params 
1120: 28 63 61 64 72 20 69 6e 70 75 74 73 29 29 29 29  (cadr inputs))))
1130: 0a 20 20 20 20 28 63 6f 6e 63 20 22 26 71 75 6f  .    (conc "&quo
1140: 74 3b 22 20 64 61 74 61 20 22 26 71 75 6f 74 3b  t;" data "&quot;
1150: 22 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73  ")))..(define (s
1160: 3a 62 72 20 20 20 20 20 2e 20 61 72 67 73 29 20  :br     . args) 
1170: 22 3c 42 52 3e 22 29 20 3b 3b 20 20 54 48 49 53  "<BR>") ;;  THIS
1180: 20 4d 41 59 20 4e 4f 54 20 57 4f 52 4b 21 21 21   MAY NOT WORK!!!
1190: 21 20 42 52 20 43 41 4e 20 28 4d 49 53 54 41 4b  ! BR CAN (MISTAK
11a0: 45 4e 4c 59 29 20 47 45 54 20 50 41 52 41 4d 20  ENLY) GET PARAM 
11b0: 54 45 58 54 0a 3b 3b 20 28 64 65 66 69 6e 65 20  TEXT.;; (define 
11c0: 28 73 3a 62 72 20 20 20 20 20 2e 20 61 72 67 73  (s:br     . args
11d0: 29 20 28 73 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20  ) (s:common-tag 
11e0: 22 42 52 22 20 20 20 20 20 61 72 67 73 29 29 0a  "BR"     args)).
11f0: 28 64 65 66 69 6e 65 20 28 73 3a 66 6f 6e 74 20  (define (s:font 
1200: 20 20 2e 20 61 72 67 73 29 20 28 73 3a 63 6f 6d    . args) (s:com
1210: 6d 6f 6e 2d 74 61 67 20 22 46 4f 4e 54 22 20 20  mon-tag "FONT"  
1220: 20 61 72 67 73 29 29 0a 28 64 65 66 69 6e 65 20   args)).(define 
1230: 28 73 3a 65 72 72 2d 66 6f 6e 74 20 2e 20 61 72  (s:err-font . ar
1240: 67 73 29 0a 20 20 28 73 3a 62 20 28 73 3a 66 6f  gs).  (s:b (s:fo
1250: 6e 74 20 27 63 6f 6c 6f 72 20 22 72 65 64 22 20  nt 'color "red" 
1260: 61 72 67 73 29 29 29 0a 0a 28 64 65 66 69 6e 65  args)))..(define
1270: 20 28 73 3a 63 6f 6d 6d 65 6e 74 20 2e 20 61 72   (s:comment . ar
1280: 67 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 6e  gs).  (let* ((in
1290: 70 75 74 73 20 28 73 3a 65 78 74 72 61 63 74 20  puts (s:extract 
12a0: 61 72 67 73 29 29 0a 20 20 20 20 20 20 20 20 20  args)).         
12b0: 28 64 61 74 61 20 20 20 28 63 61 72 20 69 6e 70  (data   (car inp
12c0: 75 74 73 29 29 0a 20 20 20 20 20 20 20 20 20 28  uts)).         (
12d0: 70 61 72 61 6d 73 20 28 73 3a 70 72 6f 63 65 73  params (s:proces
12e0: 73 2d 70 61 72 61 6d 73 20 28 63 61 64 72 20 69  s-params (cadr i
12f0: 6e 70 75 74 73 29 29 29 29 0a 20 20 20 20 28 6c  nputs)))).    (l
1300: 69 73 74 20 22 3c 21 2d 2d 22 20 64 61 74 61 20  ist "<!--" data 
1310: 22 2d 2d 3e 22 29 29 29 0a 0a 28 64 65 66 69 6e  "-->")))..(defin
1320: 65 20 28 73 3a 6e 75 6c 6c 20 20 20 2e 20 61 72  e (s:null   . ar
1330: 67 73 29 20 3b 3b 20 6e 6f 70 0a 20 20 28 6c 65  gs) ;; nop.  (le
1340: 74 2a 20 28 28 69 6e 70 75 74 73 20 28 73 3a 65  t* ((inputs (s:e
1350: 78 74 72 61 63 74 20 61 72 67 73 29 29 0a 20 20  xtract args)).  
1360: 20 20 20 20 20 20 20 28 64 61 74 61 20 20 20 28         (data   (
1370: 63 61 72 20 69 6e 70 75 74 73 29 29 0a 20 20 20  car inputs)).   
1380: 20 20 20 20 20 20 28 70 61 72 61 6d 73 20 28 73        (params (s
1390: 3a 70 72 6f 63 65 73 73 2d 70 61 72 61 6d 73 20  :process-params 
13a0: 28 63 61 64 72 20 69 6e 70 75 74 73 29 29 29 29  (cadr inputs))))
13b0: 0a 20 20 20 20 28 6c 69 73 74 20 64 61 74 61 29  .    (list data)
13c0: 29 29 0a 0a 3b 3b 20 70 75 74 73 20 61 20 6e 69  ))..;; puts a ni
13d0: 63 65 20 62 6f 78 20 61 72 6f 75 6e 64 20 61 20  ce box around a 
13e0: 63 68 75 6e 6b 20 6f 66 20 73 74 75 66 66 0a 28  chunk of stuff.(
13f0: 64 65 66 69 6e 65 20 28 73 3a 66 69 65 6c 64 73  define (s:fields
1400: 65 74 20 6c 65 67 65 6e 64 20 2e 20 61 72 67 73  et legend . args
1410: 29 0a 20 20 28 6c 69 73 74 20 22 3c 46 49 45 4c  ).  (list "<FIEL
1420: 44 53 45 54 3e 3c 4c 45 47 45 4e 44 3e 22 20 6c  DSET><LEGEND>" l
1430: 65 67 65 6e 64 20 22 3c 2f 4c 45 47 45 4e 44 3e  egend "</LEGEND>
1440: 22 20 61 72 67 73 20 22 3c 2f 46 49 45 4c 44 53  " args "</FIELDS
1450: 45 54 3e 22 29 29 0a 0a 3b 3b 20 67 69 76 65 6e  ET>"))..;; given
1460: 20 61 20 73 74 72 69 6e 67 20 72 65 74 75 72 6e   a string return
1470: 20 74 68 65 20 73 74 72 69 6e 67 20 69 66 20 69   the string if i
1480: 74 20 69 73 20 6e 6f 6e 2d 77 68 69 74 65 20 73  t is non-white s
1490: 70 61 63 65 20 6f 72 20 26 6e 62 73 70 3b 20 6f  pace or &nbsp; o
14a0: 74 68 65 72 77 69 73 65 0a 28 64 65 66 69 6e 65  therwise.(define
14b0: 20 28 73 3a 6e 62 73 70 20 73 74 72 29 0a 20 20   (s:nbsp str).  
14c0: 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63  (if (string-matc
14d0: 68 20 22 5e 5c 5c 73 2a 24 22 20 73 74 72 29 0a  h "^\\s*$" str).
14e0: 20 20 20 20 20 20 22 26 6e 62 73 70 3b 22 0a 20        "&nbsp;". 
14f0: 20 20 20 20 20 73 74 72 29 29 0a 0a 3b 3b 20 55       str))..;; U
1500: 53 45 20 27 70 61 67 65 5f 6f 76 65 72 72 69 64  SE 'page_overrid
1510: 65 20 74 6f 20 6f 76 65 72 72 69 64 65 20 61 20  e to override a 
1520: 6c 69 6e 6b 74 6f 20 70 61 67 65 20 66 72 6f 6d  linkto page from
1530: 20 61 20 62 75 74 74 6f 6e 0a 28 64 65 66 69 6e   a button.(defin
1540: 65 20 28 73 3a 66 6f 72 6d 20 20 20 2e 20 61 72  e (s:form   . ar
1550: 67 73 29 0a 20 20 3b 3b 20 63 72 65 61 74 65 20  gs).  ;; create 
1560: 61 20 6c 69 6e 6b 20 66 6f 72 20 63 61 6c 6c 69  a link for calli
1570: 6e 67 20 62 61 63 6b 20 69 6e 74 6f 20 74 68 65  ng back into the
1580: 20 63 75 72 72 65 6e 74 20 70 61 67 65 20 61 6e   current page an
1590: 64 20 63 61 6c 6c 69 6e 67 20 61 20 73 70 65 63  d calling a spec
15a0: 69 66 69 65 64 20 0a 20 20 3b 3b 20 66 75 6e 63  ified .  ;; func
15b0: 74 69 6f 6e 0a 20 20 28 6c 65 74 2a 20 28 28 61  tion.  (let* ((a
15c0: 63 74 69 6f 6e 20 20 20 20 20 28 6c 65 74 20 28  ction     (let (
15d0: 28 76 20 28 73 3a 66 69 6e 64 2d 70 61 72 61 6d  (v (s:find-param
15e0: 20 27 61 63 74 69 6f 6e 20 61 72 67 73 29 29 29   'action args)))
15f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
1600: 20 20 20 20 20 20 20 20 28 69 66 20 76 20 76 20          (if v v 
1610: 22 64 65 66 61 75 6c 74 22 29 29 29 0a 09 20 28  "default"))).. (
1620: 69 64 20 20 20 20 20 20 20 20 20 28 6c 65 74 20  id         (let 
1630: 28 28 69 20 28 73 3a 66 69 6e 64 2d 70 61 72 61  ((i (s:find-para
1640: 6d 20 27 69 64 20 61 72 67 73 29 29 29 0a 09 09  m 'id args)))...
1650: 20 20 20 20 20 20 20 28 69 66 20 69 20 69 20 23         (if i i #
1660: 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 70  f))).         (p
1670: 61 67 65 20 20 20 20 20 20 20 28 6c 65 74 20 28  age       (let (
1680: 28 70 20 28 73 64 61 74 2d 67 65 74 2d 70 61 67  (p (sdat-get-pag
1690: 65 20 73 3a 73 65 73 73 69 6f 6e 29 29 29 0a 20  e s:session))). 
16a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
16b0: 20 20 20 20 20 20 28 69 66 20 70 20 70 20 22 68        (if p p "h
16c0: 6f 6d 65 22 29 29 29 0a 09 20 3b 3b 20 28 6c 69  ome"))).. ;; (li
16d0: 6e 6b 20 20 20 20 20 20 20 28 73 65 73 73 69 6f  nk       (sessio
16e0: 6e 3a 6c 69 6e 6b 2d 74 6f 20 73 3a 73 65 73 73  n:link-to s:sess
16f0: 69 6f 6e 20 70 61 67 65 20 28 69 66 20 69 64 0a  ion page (if id.
1700: 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20           ;;     
1710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1730: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73              (lis
1740: 74 20 27 61 63 74 69 6f 6e 20 61 63 74 69 6f 6e  t 'action action
1750: 20 27 69 64 20 69 64 29 0a 20 20 20 20 20 20 20   'id id).       
1760: 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20    ;;            
1770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1790: 20 20 20 20 20 28 6c 69 73 74 20 27 61 63 74 69       (list 'acti
17a0: 6f 6e 20 61 63 74 69 6f 6e 29 29 29 29 29 0a 09  on action)))))..
17b0: 20 28 6c 69 6e 6b 20 20 20 20 20 20 20 28 69 66   (link       (if
17c0: 20 28 73 74 72 69 6e 67 3d 3f 20 28 73 75 62 73   (string=? (subs
17d0: 74 72 69 6e 67 20 61 63 74 69 6f 6e 20 30 20 35  tring action 0 5
17e0: 29 20 22 68 74 74 70 3a 22 29 20 3b 3b 20 69 66  ) "http:") ;; if
17f0: 20 66 69 72 73 74 20 70 61 72 74 20 6f 66 20 73   first part of s
1800: 74 72 69 6e 67 20 69 73 20 68 74 74 70 3a 0a 09  tring is http:..
1810: 20 20 20 20 20 20 20 20 09 20 61 63 74 69 6f 6e          . action
1820: 0a 09 20 20 20 20 20 20 20 20 09 20 28 73 65 73  ..        . (ses
1830: 73 69 6f 6e 3a 6c 69 6e 6b 2d 74 6f 20 73 3a 73  sion:link-to s:s
1840: 65 73 73 69 6f 6e 20 0a 09 20 20 20 20 20 20 20  ession ..       
1850: 20 09 09 09 20 20 70 61 67 65 20 0a 09 20 20 20   ...  page ..   
1860: 20 20 20 20 20 09 09 09 20 20 28 69 66 20 69 64       ...  (if id
1870: 0a 09 20 20 20 20 20 20 20 20 09 09 09 20 20 20  ..        ...   
1880: 20 20 20 28 6c 69 73 74 20 27 61 63 74 69 6f 6e     (list 'action
1890: 20 61 63 74 69 6f 6e 20 27 69 64 20 69 64 29 0a   action 'id id).
18a0: 09 20 20 20 20 20 20 20 20 09 09 09 20 20 20 20  .        ...    
18b0: 20 20 28 6c 69 73 74 20 27 61 63 74 69 6f 6e 20    (list 'action 
18c0: 61 63 74 69 6f 6e 29 29 29 29 29 29 0a 20 20 20  action)))))).   
18d0: 20 3b 3b 20 28 73 63 72 69 70 74 20 20 20 20 20   ;; (script     
18e0: 28 73 6c 6f 74 2d 72 65 66 20 73 3a 73 65 73 73  (slot-ref s:sess
18f0: 69 6f 6e 20 27 73 63 72 69 70 74 29 29 0a 20 20  ion 'script)).  
1900: 20 20 3b 3b 20 28 61 63 74 69 6f 6e 2d 73 74 72    ;; (action-str
1910: 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 20   (string-append 
1920: 73 63 72 69 70 74 20 22 2f 22 20 70 61 67 65 20  script "/" page 
1930: 22 3f 61 63 74 69 6f 6e 3d 22 20 61 63 74 69 6f  "?action=" actio
1940: 6e 29 29 29 0a 20 20 20 20 28 73 3a 63 6f 6d 6d  n))).    (s:comm
1950: 6f 6e 2d 74 61 67 20 22 46 4f 52 4d 22 20 28 61  on-tag "FORM" (a
1960: 70 70 65 6e 64 20 28 73 3a 72 65 6d 6f 76 65 2d  ppend (s:remove-
1970: 70 61 72 61 6d 2d 6d 61 74 63 68 69 6e 67 20 28  param-matching (
1980: 73 3a 72 65 6d 6f 76 65 2d 70 61 72 61 6d 2d 6d  s:remove-param-m
1990: 61 74 63 68 69 6e 67 20 61 72 67 73 20 27 61 63  atching args 'ac
19a0: 74 69 6f 6e 29 20 27 69 64 29 0a 20 20 20 20 20  tion) 'id).     
19b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
19c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73              (lis
19d0: 74 20 27 61 63 74 69 6f 6e 20 6c 69 6e 6b 29 29  t 'action link))
19e0: 29 29 29 0a 0a 3b 3b 20 6c 6f 6f 6b 20 75 70 20  )))..;; look up 
19f0: 74 68 65 20 76 61 72 69 61 62 6c 65 20 6e 61 6d  the variable nam
1a00: 65 20 28 76 69 61 20 74 68 65 20 27 6e 61 6d 65  e (via the 'name
1a10: 20 74 61 67 29 20 74 68 65 6e 20 69 6e 6a 65 63   tag) then injec
1a20: 74 20 74 68 65 20 76 61 6c 75 65 20 66 72 6f 6d  t the value from
1a30: 20 74 68 65 20 73 65 73 73 69 6f 6e 20 76 61 72   the session var
1a40: 0a 3b 3b 20 72 65 70 6c 61 63 69 6e 67 20 74 68  .;; replacing th
1a50: 65 20 27 76 61 6c 75 65 20 76 61 6c 75 65 20 69  e 'value value i
1a60: 66 20 69 74 20 69 73 20 61 6c 72 65 61 64 79 20  f it is already 
1a70: 74 68 65 72 65 2c 20 61 64 64 69 6e 67 20 69 74  there, adding it
1a80: 20 69 66 20 69 74 20 69 73 20 6e 6f 74 2e 0a 28   if it is not..(
1a90: 64 65 66 69 6e 65 20 28 73 3a 70 72 65 73 65 72  define (s:preser
1aa0: 76 65 20 74 61 67 20 61 72 67 73 29 0a 20 20 28  ve tag args).  (
1ab0: 6c 65 74 2a 20 28 28 76 61 72 2d 6e 61 6d 65 20  let* ((var-name 
1ac0: 28 73 3a 66 69 6e 64 2d 70 61 72 61 6d 20 27 6e  (s:find-param 'n
1ad0: 61 6d 65 20 61 72 67 73 29 29 20 3b 3b 20 6e 61  ame args)) ;; na
1ae0: 6d 65 3d 27 76 61 72 6e 61 6d 65 27 0a 09 20 28  me='varname'.. (
1af0: 76 61 6c 75 65 20 20 20 20 28 6c 65 74 20 28 28  value    (let ((
1b00: 76 20 28 73 3a 67 65 74 20 76 61 72 2d 6e 61 6d  v (s:get var-nam
1b10: 65 29 29 29 0a 09 09 20 20 20 20 20 28 69 66 20  e)))...     (if 
1b20: 76 20 76 20 23 66 29 29 29 0a 09 20 28 6e 65 77  v v #f))).. (new
1b30: 61 72 67 73 20 20 28 61 70 70 65 6e 64 20 28 73  args  (append (s
1b40: 3a 72 65 6d 6f 76 65 2d 70 61 72 61 6d 2d 6d 61  :remove-param-ma
1b50: 74 63 68 69 6e 67 20 61 72 67 73 20 27 76 61 6c  tching args 'val
1b60: 75 65 29 20 28 69 66 20 76 61 6c 75 65 20 28 6c  ue) (if value (l
1b70: 69 73 74 20 27 76 61 6c 75 65 20 76 61 6c 75 65  ist 'value value
1b80: 29 20 27 28 29 29 29 29 29 0a 20 20 20 20 28 73  ) '())))).    (s
1b90: 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 74 61 67 20  :common-tag tag 
1ba0: 6e 65 77 61 72 67 73 29 29 29 0a 0a 28 64 65 66  newargs)))..(def
1bb0: 69 6e 65 20 28 73 3a 69 6e 70 75 74 2d 70 72 65  ine (s:input-pre
1bc0: 73 65 72 76 65 20 20 2e 20 61 72 67 73 29 0a 20  serve  . args). 
1bd0: 20 28 73 3a 70 72 65 73 65 72 76 65 20 22 49 4e   (s:preserve "IN
1be0: 50 55 54 22 20 61 72 67 73 29 29 0a 0a 3b 3b 20  PUT" args))..;; 
1bf0: 74 65 78 74 20 61 72 65 61 73 20 61 72 65 20 64  text areas are d
1c00: 6f 6e 65 20 61 20 6c 69 74 74 6c 65 20 64 69 66  one a little dif
1c10: 66 65 72 65 6e 74 6c 79 2e 20 54 68 65 20 76 61  ferently. The va
1c20: 6c 75 65 20 69 73 20 73 74 6f 72 65 64 20 62 65  lue is stored be
1c30: 74 77 65 65 6e 20 74 68 65 20 74 61 67 73 20 3c  tween the tags <
1c40: 74 65 78 74 61 72 65 61 20 2e 2e 2e 3e 74 68 65  textarea ...>the
1c50: 20 76 61 6c 75 65 20 67 6f 65 73 20 68 65 72 65   value goes here
1c60: 3c 2f 74 65 78 74 61 72 65 61 3e 0a 28 64 65 66  </textarea>.(def
1c70: 69 6e 65 20 28 73 3a 74 65 78 74 61 72 65 61 2d  ine (s:textarea-
1c80: 70 72 65 73 65 72 76 65 20 2e 20 61 72 67 73 29  preserve . args)
1c90: 0a 20 20 28 6c 65 74 2a 20 28 28 76 61 72 2d 6e  .  (let* ((var-n
1ca0: 61 6d 65 20 28 73 3a 66 69 6e 64 2d 70 61 72 61  ame (s:find-para
1cb0: 6d 20 27 6e 61 6d 65 20 61 72 67 73 29 29 0a 09  m 'name args))..
1cc0: 20 28 76 61 6c 75 65 20 20 20 20 28 6c 65 74 20   (value    (let 
1cd0: 28 28 76 20 28 73 3a 67 65 74 20 76 61 72 2d 6e  ((v (s:get var-n
1ce0: 61 6d 65 29 29 29 0a 09 09 20 20 20 20 20 28 69  ame)))...     (i
1cf0: 66 20 76 20 76 20 23 66 29 29 29 29 0a 20 20 20  f v v #f)))).   
1d00: 20 28 73 3a 63 6f 6d 6d 6f 6e 2d 74 61 67 20 22   (s:common-tag "
1d10: 54 45 58 54 41 52 45 41 22 20 28 69 66 20 76 61  TEXTAREA" (if va
1d20: 6c 75 65 20 28 63 6f 6e 73 20 76 61 6c 75 65 20  lue (cons value 
1d30: 61 72 67 73 29 20 61 72 67 73 29 29 29 29 0a 0a  args) args))))..
1d40: 28 64 65 66 69 6e 65 20 28 73 3a 6f 70 74 69 6f  (define (s:optio
1d50: 6e 20 64 61 74 29 0a 20 20 28 6c 65 74 20 28 28  n dat).  (let ((
1d60: 6c 65 6e 20 20 20 20 20 20 28 6c 65 6e 67 74 68  len      (length
1d70: 20 64 61 74 29 29 29 0a 20 20 20 20 28 63 6f 6e   dat))).    (con
1d80: 64 0a 20 20 20 20 20 28 28 65 71 3f 20 6c 65 6e  d.     ((eq? len
1d90: 20 31 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28   1).      (let (
1da0: 28 69 74 65 6d 20 28 63 61 72 20 64 61 74 29 29  (item (car dat))
1db0: 29 0a 09 28 73 3a 6f 70 74 69 6f 6e 20 28 6c 69  )..(s:option (li
1dc0: 73 74 20 69 74 65 6d 20 69 74 65 6d 20 69 74 65  st item item ite
1dd0: 6d 29 29 29 29 0a 20 20 20 20 20 28 28 65 71 3f  m)))).     ((eq?
1de0: 20 6c 65 6e 20 32 29 0a 20 20 20 20 20 20 28 73   len 2).      (s
1df0: 3a 6f 70 74 69 6f 6e 20 28 61 70 70 65 6e 64 20  :option (append 
1e00: 64 61 74 20 28 6c 69 73 74 20 28 63 61 72 20 64  dat (list (car d
1e10: 61 74 29 29 29 29 29 0a 20 20 20 20 20 28 65 6c  at))))).     (el
1e20: 73 65 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28  se.      (let ((
1e30: 6c 61 62 65 6c 20 20 20 20 28 63 61 72 20 64 61  label    (car da
1e40: 74 29 29 0a 09 20 20 20 20 28 76 61 6c 75 65 20  t))..    (value 
1e50: 20 20 20 28 63 61 64 72 20 64 61 74 29 29 0a 09     (cadr dat))..
1e60: 20 20 20 20 28 64 69 73 70 76 61 6c 20 20 28 63      (dispval  (c
1e70: 61 64 64 72 20 64 61 74 29 29 0a 09 20 20 20 20  addr dat))..    
1e80: 28 73 65 6c 65 63 74 65 64 20 28 69 66 20 28 3e  (selected (if (>
1e90: 20 6c 65 6e 20 33 29 28 63 61 64 64 64 72 20 64   len 3)(cadddr d
1ea0: 61 74 29 20 23 66 29 29 29 0a 09 28 6c 69 73 74  at) #f)))..(list
1eb0: 20 28 63 6f 6e 63 20 22 3c 4f 50 54 49 4f 4e 20   (conc "<OPTION 
1ec0: 22 20 0a 09 09 20 20 20 20 28 69 66 20 73 65 6c  " ...    (if sel
1ed0: 65 63 74 65 64 20 22 20 73 65 6c 65 63 74 65 64  ected " selected
1ee0: 20 22 20 22 22 29 0a 09 09 20 20 20 20 22 6c 61   " "")...    "la
1ef0: 62 65 6c 3d 5c 22 22 20 6c 61 62 65 6c 0a 09 09  bel=\"" label...
1f00: 20 20 20 20 22 5c 22 20 76 61 6c 75 65 3d 5c 22      "\" value=\"
1f10: 22 20 76 61 6c 75 65 0a 09 09 20 20 20 20 22 5c  " value...    "\
1f20: 22 3e 22 20 64 69 73 70 76 61 6c 20 22 3c 2f 4f  ">" dispval "</O
1f30: 50 54 49 4f 4e 3e 22 29 29 29 29 29 29 29 0a 0a  PTION>")))))))..
1f40: 3b 3b 20 63 61 6c 6c 20 6f 6e 6c 79 20 77 69 74  ;; call only wit
1f50: 68 20 28 6c 61 62 65 6c 20 28 6c 61 62 65 6c 20  h (label (label 
1f60: 76 61 6c 75 65 20 64 69 73 70 76 61 6c 20 5b 23  value dispval [#
1f70: 74 5d 29 20 2e 2e 2e 29 0a 3b 3b 20 4e 42 2f 2f  t]) ...).;; NB//
1f80: 20 73 61 64 6c 79 20 74 68 69 73 20 62 6c 6f 63   sadly this bloc
1f90: 6b 20 69 73 20 72 65 64 75 6e 64 61 6e 74 6c 79  k is redundantly
1fa0: 20 61 6c 6d 6f 73 74 20 69 64 65 6e 74 69 63 61   almost identica
1fb0: 6c 20 74 6f 20 74 68 65 20 73 3a 73 65 6c 65 63  l to the s:selec
1fc0: 74 0a 3b 3b 20 66 69 78 20 74 68 61 74 20 6c 61  t.;; fix that la
1fd0: 74 65 72 20 2e 2e 2e 0a 28 64 65 66 69 6e 65 20  ter ....(define 
1fe0: 28 73 3a 6f 70 74 67 72 6f 75 70 20 64 61 74 29  (s:optgroup dat)
1ff0: 0a 20 20 28 6c 65 74 20 28 28 6c 61 62 65 6c 20  .  (let ((label 
2000: 28 63 61 72 20 64 61 74 29 29 0a 09 28 72 65 6d  (car dat))..(rem
2010: 20 20 20 28 63 64 72 20 64 61 74 29 29 29 0a 20     (cdr dat))). 
2020: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65     (if (null? re
2030: 6d 29 0a 09 28 73 3a 63 6f 6d 6d 6f 6e 2d 74 61  m)..(s:common-ta
2040: 67 20 22 4f 50 54 47 52 4f 55 50 22 20 27 6c 61  g "OPTGROUP" 'la
2050: 62 65 6c 20 6c 61 62 65 6c 29 0a 09 28 6c 65 74  bel label)..(let
2060: 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72   loop ((hed (car
2070: 20 72 65 6d 29 29 0a 09 09 20 20 20 28 74 61 6c   rem))...   (tal
2080: 20 28 63 64 72 20 72 65 6d 29 29 0a 09 09 20 20   (cdr rem))...  
2090: 20 28 72 65 73 20 28 6c 69 73 74 20 28 63 6f 6e   (res (list (con
20a0: 63 20 22 3c 4f 50 54 47 52 4f 55 50 20 6c 61 62  c "<OPTGROUP lab
20b0: 65 6c 3d 22 20 6c 61 62 65 6c 29 29 29 29 0a 09  el=" label))))..
20c0: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 68 65 64    ;; (print "hed
20d0: 3a 20 22 20 68 65 64 20 22 20 74 61 6c 3a 20 22  : " hed " tal: "
20e0: 20 74 61 6c 20 22 20 72 65 73 3a 20 22 20 72 65   tal " res: " re
20f0: 73 29 0a 09 20 20 28 6c 65 74 20 28 28 6e 65 77  s)..  (let ((new
2100: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69   (append res (li
2110: 73 74 20 28 69 66 20 28 6c 69 73 74 3f 20 28 63  st (if (list? (c
2120: 61 64 72 20 68 65 64 29 29 0a 09 09 09 09 09 20  adr hed))...... 
2130: 20 20 28 73 3a 6f 70 74 67 72 6f 75 70 20 68 65    (s:optgroup he
2140: 64 29 0a 09 09 09 09 09 20 20 20 28 73 3a 6f 70  d)......   (s:op
2150: 74 69 6f 6e 20 68 65 64 29 29 29 29 29 29 0a 09  tion hed))))))..
2160: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74      (if (null? t
2170: 61 6c 29 0a 09 09 28 61 70 70 65 6e 64 20 6e 65  al)...(append ne
2180: 77 20 28 6c 69 73 74 20 22 3c 2f 4f 50 54 47 52  w (list "</OPTGR
2190: 4f 55 50 3e 22 29 29 0a 09 09 28 6c 6f 6f 70 20  OUP>"))...(loop 
21a0: 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61  (car tal)(cdr ta
21b0: 6c 29 20 6e 65 77 29 29 29 29 29 29 29 0a 20 20  l) new))))))).  
21c0: 20 20 0a 3b 3b 20 69 74 65 6d 73 20 69 73 20 61    .;; items is a
21d0: 20 68 69 65 72 61 72 63 68 69 61 6c 20 61 6c 69   hierarchial ali
21e0: 73 74 0a 3b 3b 20 28 20 28 6c 61 62 65 6c 31 20  st.;; ( (label1 
21f0: 76 61 6c 75 65 31 20 64 69 73 70 76 61 6c 31 20  value1 dispval1 
2200: 23 74 29 20 3b 3b 20 3c 3d 3d 20 74 68 69 73 20  #t) ;; <== this 
2210: 6f 6e 65 20 69 73 20 73 65 6c 65 63 74 65 64 0a  one is selected.
2220: 3b 3b 20 20 20 28 6c 61 62 65 6c 32 20 28 6c 61  ;;   (label2 (la
2230: 62 65 6c 33 20 76 61 6c 75 65 32 20 64 69 73 70  bel3 value2 disp
2240: 76 61 6c 32 29 0a 3b 3b 20 20 20 20 20 20 20 20  val2).;;        
2250: 20 20 20 28 6c 61 62 65 6c 34 20 76 61 6c 75 65     (label4 value
2260: 33 20 64 69 73 70 76 61 6c 33 29 29 29 0a 3b 3b  3 dispval3))).;;
2270: 20 20 20 20 20 0a 3b 3b 20 20 72 65 71 75 69 72       .;;  requir
2280: 65 64 20 61 72 67 20 69 73 20 27 6e 61 6d 65 0a  ed arg is 'name.
2290: 28 64 65 66 69 6e 65 20 28 73 3a 73 65 6c 65 63  (define (s:selec
22a0: 74 20 69 74 65 6d 73 20 2e 20 61 72 67 73 29 0a  t items . args).
22b0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 69 74 65    (if (null? ite
22c0: 6d 73 29 0a 20 20 20 20 20 20 28 73 3a 63 6f 6d  ms).      (s:com
22d0: 6d 6f 6e 2d 74 61 67 20 22 53 45 4c 45 43 54 22  mon-tag "SELECT"
22e0: 20 61 72 67 73 29 0a 20 20 20 20 20 20 28 6c 65   args).      (le
22f0: 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61  t loop ((hed (ca
2300: 72 20 69 74 65 6d 73 29 29 0a 09 09 20 28 74 61  r items))... (ta
2310: 6c 20 28 63 64 72 20 69 74 65 6d 73 29 29 0a 09  l (cdr items))..
2320: 09 20 28 72 65 73 20 27 28 29 29 29 0a 09 3b 3b  . (res '()))..;;
2330: 20 28 70 72 69 6e 74 20 22 68 65 64 3a 20 22 20   (print "hed: " 
2340: 68 65 64 20 22 20 74 61 6c 3a 20 22 20 74 61 6c  hed " tal: " tal
2350: 20 22 20 72 65 73 3a 20 22 20 72 65 73 29 0a 09   " res: " res)..
2360: 28 6c 65 74 20 28 28 6e 65 77 20 28 61 70 70 65  (let ((new (appe
2370: 6e 64 20 72 65 73 20 28 6c 69 73 74 20 28 69 66  nd res (list (if
2380: 20 28 61 6e 64 20 28 3e 20 28 6c 65 6e 67 74 68   (and (> (length
2390: 20 68 65 64 29 20 31 29 0a 09 09 09 09 09 20 20   hed) 1)......  
23a0: 20 20 20 20 28 6c 69 73 74 3f 20 28 63 61 64 72      (list? (cadr
23b0: 20 68 65 64 29 29 29 0a 09 09 09 09 09 20 28 73   hed)))...... (s
23c0: 3a 6f 70 74 67 72 6f 75 70 20 68 65 64 29 0a 09  :optgroup hed)..
23d0: 09 09 09 09 20 28 73 3a 6f 70 74 69 6f 6e 20 68  .... (s:option h
23e0: 65 64 29 29 29 29 29 29 0a 09 20 20 28 69 66 20  ed))))))..  (if 
23f0: 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 20 20 20  (null? tal)..   
2400: 20 20 20 28 73 3a 63 6f 6d 6d 6f 6e 2d 74 61 67     (s:common-tag
2410: 20 22 53 45 4c 45 43 54 22 20 28 63 6f 6e 73 20   "SELECT" (cons 
2420: 6e 65 77 20 61 72 67 73 29 29 0a 09 20 20 20 20  new args))..    
2430: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c    (loop (car tal
2440: 29 28 63 64 72 20 74 61 6c 29 20 6e 65 77 29 29  )(cdr tal) new))
2450: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73  ))))..(define (s
2460: 3a 63 6f 6c 6f 72 20 20 2e 20 61 72 67 73 29 0a  :color  . args).
2470: 20 20 22 23 30 30 66 66 30 30 22 29 0a 0a 28 64    "#00ff00")..(d
2480: 65 66 69 6e 65 20 28 73 3a 70 72 69 6e 74 20 69  efine (s:print i
2490: 6e 64 65 6e 74 20 69 6e 6c 73 74 29 0a 20 20 28  ndent inlst).  (
24a0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a  map (lambda (x).
24b0: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 20 0a           (cond .
24c0: 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 20 28            ((or (
24d0: 73 74 72 69 6e 67 3f 20 78 29 28 73 79 6d 62 6f  string? x)(symbo
24e0: 6c 3f 20 78 29 29 0a 20 20 20 20 20 20 20 20 20  l? x)).         
24f0: 20 20 28 70 72 69 6e 74 20 28 63 6f 6e 63 20 28    (print (conc (
2500: 6d 61 6b 65 2d 73 74 72 69 6e 67 20 28 2a 20 69  make-string (* i
2510: 6e 64 65 6e 74 20 32 29 20 23 5c 20 29 20 28 61  ndent 2) #\ ) (a
2520: 6e 79 2d 3e 73 74 72 69 6e 67 20 78 29 29 29 29  ny->string x))))
2530: 0a 20 20 20 20 20 20 20 20 20 20 28 28 6c 69 73  .          ((lis
2540: 74 3f 20 78 29 0a 20 20 20 20 20 20 20 20 20 20  t? x).          
2550: 20 28 73 3a 70 72 69 6e 74 20 28 2b 20 69 6e 64   (s:print (+ ind
2560: 65 6e 74 20 31 29 20 78 29 29 0a 20 20 20 20 20  ent 1) x)).     
2570: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20       (else.     
2580: 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20        ;; (print 
2590: 22 45 52 52 4f 52 3a 20 42 61 64 20 69 6e 70 75  "ERROR: Bad inpu
25a0: 74 20 30 31 22 29 20 3b 3b 20 77 68 79 20 64 6f  t 01") ;; why do
25b0: 20 61 6e 79 74 68 69 6e 67 20 77 69 74 68 20 6a   anything with j
25c0: 75 6e 6b 3f 0a 20 20 20 20 20 20 20 20 20 20 20  unk?.           
25d0: 29 29 29 0a 20 20 20 20 20 20 20 69 6e 6c 73 74  ))).       inlst
25e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 3a 63  ))..(define (s:c
25f0: 67 69 2d 6f 75 74 20 69 6e 6c 73 74 29 0a 20 20  gi-out inlst).  
2600: 28 73 3a 6f 75 74 70 75 74 20 28 63 75 72 72 65  (s:output (curre
2610: 6e 74 2d 6f 75 74 70 75 74 2d 70 6f 72 74 29 20  nt-output-port) 
2620: 69 6e 6c 73 74 29 29 0a 0a 28 64 65 66 69 6e 65  inlst))..(define
2630: 20 28 73 3a 6f 75 74 70 75 74 20 70 6f 72 74 20   (s:output port 
2640: 69 6e 6c 73 74 29 0a 20 20 28 6d 61 70 20 28 6c  inlst).  (map (l
2650: 61 6d 62 64 61 20 28 78 29 0a 09 20 28 63 6f 6e  ambda (x).. (con
2660: 64 20 0a 09 20 20 28 28 73 74 72 69 6e 67 3f 20  d ..  ((string? 
2670: 78 29 20 28 70 72 69 6e 74 20 78 29 29 20 3b 3b  x) (print x)) ;;
2680: 20 28 70 72 69 6e 74 20 78 29 29 0a 09 20 20 28   (print x))..  (
2690: 28 73 79 6d 62 6f 6c 3f 20 78 29 20 28 70 72 69  (symbol? x) (pri
26a0: 6e 74 20 78 29 29 20 3b 3b 20 28 70 72 69 6e 74  nt x)) ;; (print
26b0: 20 78 29 29 0a 09 20 20 28 28 6c 69 73 74 3f 20   x))..  ((list? 
26c0: 78 29 20 20 20 28 73 3a 6f 75 74 70 75 74 20 70  x)   (s:output p
26d0: 6f 72 74 20 78 29 29 0a 09 20 20 28 65 6c 73 65  ort x))..  (else
26e0: 0a 09 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22  ..   ;; (print "
26f0: 45 52 52 4f 52 3a 20 42 61 64 20 69 6e 70 75 74  ERROR: Bad input
2700: 20 30 32 22 29 20 3b 3b 20 77 68 79 20 64 6f 20   02") ;; why do 
2710: 61 6e 79 74 68 69 6e 67 3f 20 64 6f 6e 27 74 20  anything? don't 
2720: 6f 75 74 70 75 74 20 6a 75 6e 6b 2e 0a 09 20 20  output junk...  
2730: 20 29 29 29 0a 20 20 20 20 20 20 20 69 6e 6c 73   ))).       inls
2740: 74 29 29 0a 3b 20 20 28 69 66 20 28 3e 20 28 6c  t)).;  (if (> (l
2750: 65 6e 67 74 68 20 69 6e 6c 73 74 29 20 32 29 0a  ength inlst) 2).
2760: 3b 20 20 20 20 20 20 28 70 72 69 6e 74 29 29 29  ;      (print)))
2770: 0a 0a 28 64 65 66 69 6e 65 20 28 73 3a 6f 75 74  ..(define (s:out
2780: 70 75 74 2d 6e 65 77 20 70 6f 72 74 20 69 6e 6c  put-new port inl
2790: 73 74 29 0a 20 20 28 77 69 74 68 2d 6f 75 74 70  st).  (with-outp
27a0: 75 74 2d 74 6f 2d 70 6f 72 74 20 70 6f 72 74 0a  ut-to-port port.
27b0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29        (lambda ()
27c0: 0a 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28  ..(map (lambda (
27d0: 78 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 64  x)..       (cond
27e0: 20 0a 09 09 28 28 73 74 72 69 6e 67 3f 20 78 29   ...((string? x)
27f0: 20 28 70 72 69 6e 74 20 78 29 29 0a 09 09 28 28   (print x))...((
2800: 73 79 6d 62 6f 6c 3f 20 78 29 20 28 70 72 69 6e  symbol? x) (prin
2810: 74 20 78 29 29 0a 09 09 28 28 6c 69 73 74 3f 20  t x))...((list? 
2820: 78 29 20 20 20 28 73 3a 6f 75 74 70 75 74 20 70  x)   (s:output p
2830: 6f 72 74 20 78 29 29 0a 09 09 28 65 6c 73 65 0a  ort x))...(else.
2840: 09 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 45 52  .. ;; (print "ER
2850: 52 4f 52 3a 20 42 61 64 20 69 6e 70 75 74 20 30  ROR: Bad input 0
2860: 33 22 29 0a 20 20 20 20 20 29 29 29 0a 09 20 20  3").     )))..  
2870: 20 20 20 69 6e 6c 73 74 29 29 29 29 0a 20 20 20     inlst)))).   
2880: 20 20 20 20 20 20 20 20 0a                               .