Hex Artifact Content
Not logged in

Artifact e8f0a06c7efbaf235973584595ca314b0dca5d87:


0000: 3b 09 20 20 20 48 54 4d 4c 20 41 75 74 68 6f 72  ;.   HTML Author
0010: 69 6e 67 20 69 6e 20 53 58 4d 4c 20 66 6f 72 20  ing in SXML for 
0020: 6d 79 20 70 65 72 73 6f 6e 61 6c 20 57 65 62 20  my personal Web 
0030: 70 61 67 65 73 0a 3b 0a 3b 20 54 68 65 20 70 72  pages.;.; The pr
0040: 65 73 65 6e 74 20 66 69 6c 65 20 64 65 66 69 6e  esent file defin
0050: 65 73 20 73 65 76 65 72 61 6c 20 66 75 6e 63 74  es several funct
0060: 69 6f 6e 73 20 61 6e 64 20 68 69 67 68 65 72 2d  ions and higher-
0070: 6f 72 64 65 72 0a 3b 20 53 58 4d 4c 20 22 74 61  order.; SXML "ta
0080: 67 73 22 20 74 68 61 74 20 61 72 65 20 75 73 65  gs" that are use
0090: 64 20 74 6f 20 63 6f 6d 70 6f 73 65 20 48 54 4d  d to compose HTM
00a0: 4c 20 70 61 67 65 73 20 6f 6e 20 6d 79 20 77 65  L pages on my we
00b0: 62 20 73 69 74 65 2e 0a 3b 20 49 6e 20 4c 61 54  b site..; In LaT
00c0: 65 58 20 74 65 72 6d 73 2c 20 74 68 69 73 20 66  eX terms, this f
00d0: 69 6c 65 20 69 73 20 73 69 6d 69 6c 61 72 20 74  ile is similar t
00e0: 6f 20 61 72 74 69 63 6c 65 2e 63 6c 73 2e 0a 3b  o article.cls..;
00f0: 0a 3b 20 53 65 65 20 68 74 74 70 3a 2f 2f 70 6f  .; See http://po
0100: 62 6f 78 2e 63 6f 6d 2f 7e 6f 6c 65 67 2f 66 74  box.com/~oleg/ft
0110: 70 2f 53 63 68 65 6d 65 2f 78 6d 6c 2e 68 74 6d  p/Scheme/xml.htm
0120: 6c 23 58 4d 4c 2d 61 75 74 68 6f 72 69 6e 67 0a  l#XML-authoring.
0130: 3b 20 66 6f 72 20 6d 6f 72 65 20 65 78 61 6d 70  ; for more examp
0140: 6c 65 73 20 61 6e 64 20 65 78 70 6c 61 6e 61 74  les and explanat
0150: 69 6f 6e 2e 0a 3b 0a 3b 20 49 4d 50 4f 52 54 0a  ion..;.; IMPORT.
0160: 3b 20 41 70 70 72 6f 70 6f 72 69 61 74 65 20 50  ; Approporiate P
0170: 72 65 6c 75 64 65 3a 20 6d 79 65 6e 76 2e 73 63  relude: myenv.sc
0180: 6d 20 6f 72 20 6d 79 65 6e 76 2d 62 69 67 6c 6f  m or myenv-biglo
0190: 6f 2e 73 63 6d 0a 3b 20 73 72 66 69 2d 31 33 2d  o.scm.; srfi-13-
01a0: 6c 6f 63 61 6c 2e 73 63 6d 20 6f 72 20 74 68 65  local.scm or the
01b0: 20 61 70 70 72 6f 70 72 69 61 74 65 20 6e 61 74   appropriate nat
01c0: 69 76 65 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69  ive implementati
01d0: 6f 6e 20 6f 66 20 53 52 46 49 2d 31 33 0a 3b 20  on of SRFI-13.; 
01e0: 75 74 69 6c 2e 73 63 6d 0a 3b 20 53 58 4d 4c 2d  util.scm.; SXML-
01f0: 74 72 65 65 2d 74 72 61 6e 73 2e 73 63 6d 0a 3b  tree-trans.scm.;
0200: 20 53 58 4d 4c 2d 74 6f 2d 48 54 4d 4c 2e 73 63   SXML-to-HTML.sc
0210: 6d 0a 3b 20 4f 53 3a 66 69 6c 65 2d 6c 65 6e 67  m.; OS:file-leng
0220: 74 68 2c 20 75 6e 6c 65 73 73 20 69 74 20 69 73  th, unless it is
0230: 20 69 6e 63 6c 75 64 65 64 20 69 6e 74 6f 20 74   included into t
0240: 68 65 20 63 6f 72 65 20 73 79 73 74 65 6d 0a 3b  he core system.;
0250: 20 20 20 28 73 65 65 20 6d 79 65 6e 76 2d 62 69     (see myenv-bi
0260: 67 6c 6f 6f 2e 73 63 6d 20 66 6f 72 20 65 78 61  gloo.scm for exa
0270: 6d 70 6c 65 29 0a 3b 0a 3b 20 24 49 64 3a 20 53  mple).;.; $Id: S
0280: 58 4d 4c 2d 74 6f 2d 48 54 4d 4c 2d 65 78 74 2e  XML-to-HTML-ext.
0290: 73 63 6d 2c 76 20 32 2e 31 30 20 32 30 30 36 2f  scm,v 2.10 2006/
02a0: 31 32 2f 30 32 20 30 31 3a 30 39 3a 32 32 20 6f  12/02 01:09:22 o
02b0: 6c 65 67 20 45 78 70 20 6f 6c 65 67 20 24 0a 0a  leg Exp oleg $..
02c0: 3b 20 73 6b 69 70 20 74 68 65 20 6c 73 74 20 74  ; skip the lst t
02d0: 72 6f 75 67 68 20 74 68 65 20 66 69 72 73 74 20  rough the first 
02e0: 73 69 67 6e 69 66 69 63 61 6e 74 20 65 6c 65 6d  significant elem
02f0: 65 6e 74 0a 3b 20 72 65 74 75 72 6e 20 74 68 65  ent.; return the
0300: 20 74 61 69 6c 20 6f 66 20 6c 73 74 20 73 75 63   tail of lst suc
0310: 68 20 74 68 61 74 20 28 63 61 72 20 72 65 73 75  h that (car resu
0320: 6c 74 29 20 69 73 20 73 69 67 6e 69 66 69 63 61  lt) is significa
0330: 6e 74 0a 3b 20 49 6e 73 69 67 6e 69 66 69 63 61  nt.; Insignifica
0340: 6e 74 20 65 6c 65 6d 73 20 61 72 65 20 27 28 29  nt elems are '()
0350: 2c 20 23 66 2c 20 61 6e 64 20 6c 69 73 74 73 20  , #f, and lists 
0360: 6d 61 64 65 20 6f 66 20 74 68 65 6d 0a 3b 20 49  made of them.; I
0370: 66 20 61 6c 6c 20 6f 66 20 74 68 65 20 6c 69 73  f all of the lis
0380: 74 20 69 73 20 69 6e 73 69 67 6e 69 66 69 63 61  t is insignifica
0390: 6e 74 2c 20 72 65 74 75 72 6e 20 23 66 0a 28 64  nt, return #f.(d
03a0: 65 66 69 6e 65 20 28 73 69 67 6e 69 66 2d 74 61  efine (signif-ta
03b0: 69 6c 20 6c 73 74 29 0a 20 20 28 64 65 66 69 6e  il lst).  (defin
03c0: 65 20 28 73 69 67 6e 69 66 3f 20 6f 62 6a 29 0a  e (signif? obj).
03d0: 20 20 20 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e      (and (not (n
03e0: 75 6c 6c 3f 20 6f 62 6a 29 29 20 6f 62 6a 0a 09  ull? obj)) obj..
03f0: 20 28 69 66 20 28 70 61 69 72 3f 20 6f 62 6a 29   (if (pair? obj)
0400: 0a 09 20 20 20 20 20 28 6f 72 20 28 73 69 67 6e  ..     (or (sign
0410: 69 66 3f 20 28 63 61 72 20 6f 62 6a 29 29 0a 09  if? (car obj))..
0420: 09 20 28 73 69 67 6e 69 66 3f 20 28 63 64 72 20  . (signif? (cdr 
0430: 6f 62 6a 29 29 29 0a 09 20 20 20 20 20 6f 62 6a  obj)))..     obj
0440: 29 29 29 0a 20 20 28 61 6e 64 20 28 73 69 67 6e  ))).  (and (sign
0450: 69 66 3f 20 6c 73 74 29 0a 20 20 20 20 20 20 20  if? lst).       
0460: 28 61 73 73 65 72 74 20 28 70 61 69 72 3f 20 6c  (assert (pair? l
0470: 73 74 29 29 0a 20 20 20 20 20 20 20 28 69 66 20  st)).       (if 
0480: 28 73 69 67 6e 69 66 3f 20 28 63 61 72 20 6c 73  (signif? (car ls
0490: 74 29 29 20 6c 73 74 0a 09 20 20 20 28 73 69 67  t)) lst..   (sig
04a0: 6e 69 66 2d 74 61 69 6c 20 28 63 64 72 20 6c 73  nif-tail (cdr ls
04b0: 74 29 29 29 29 29 0a 0a 3b 20 50 72 6f 63 65 64  t)))))..; Proced
04c0: 75 72 65 20 6d 61 6b 65 2d 68 65 61 64 65 72 20  ure make-header 
04d0: 48 45 41 44 2d 50 41 52 4d 53 0a 3b 20 43 72 65  HEAD-PARMS.; Cre
04e0: 61 74 65 20 74 68 65 20 27 68 65 61 64 27 20 53  ate the 'head' S
04f0: 58 4d 4c 2f 48 54 4d 4c 20 74 61 67 2e 20 48 45  XML/HTML tag. HE
0500: 41 44 2d 50 41 52 4d 53 20 69 73 20 61 6e 20 61  AD-PARMS is an a
0510: 73 73 6f 63 20 6c 69 73 74 20 6f 66 0a 3b 20 28  ssoc list of.; (
0520: 68 2d 6b 65 79 20 68 2d 76 61 6c 75 65 29 2c 20  h-key h-value), 
0530: 77 68 65 72 65 20 68 2d 76 61 6c 75 65 20 69 73  where h-value is
0540: 20 61 20 74 79 70 69 63 61 6c 6c 79 20 73 74 72   a typically str
0550: 69 6e 67 3b 0a 3b 20 68 2d 6b 65 79 20 69 73 20  ing;.; h-key is 
0560: 61 20 73 79 6d 62 6f 6c 3a 0a 3b 20 74 69 74 6c  a symbol:.; titl
0570: 65 2c 20 64 65 73 63 72 69 70 74 69 6f 6e 2c 20  e, description, 
0580: 41 75 74 68 6f 72 41 64 64 72 65 73 73 2c 20 6b  AuthorAddress, k
0590: 65 79 77 6f 72 64 73 2c 0a 3b 20 44 61 74 65 2d  eywords,.; Date-
05a0: 52 65 76 69 73 69 6f 6e 2d 79 79 79 79 6d 6d 64  Revision-yyyymmd
05b0: 64 2c 20 44 61 74 65 2d 43 72 65 61 74 69 6f 6e  d, Date-Creation
05c0: 2d 79 79 79 79 6d 6d 64 64 2c 0a 3b 20 6c 6f 6e  -yyyymmdd,.; lon
05d0: 67 2d 74 69 74 6c 65 0a 3b 20 4f 6e 65 20 6f 66  g-title.; One of
05e0: 20 74 68 65 20 68 2d 6b 65 79 20 63 61 6e 20 62   the h-key can b
05f0: 65 20 4c 69 6e 6b 73 2e 0a 3b 20 49 6e 20 74 68  e Links..; In th
0600: 61 74 20 63 61 73 65 2c 20 68 2d 76 61 6c 75 65  at case, h-value
0610: 20 69 73 20 61 20 6c 69 73 74 20 6f 66 0a 3b 09   is a list of.;.
0620: 28 6c 2d 6b 65 79 20 6c 2d 68 72 65 66 20 28 61  (l-key l-href (a
0630: 74 74 72 20 76 61 6c 75 65 29 20 2e 2e 2e 29 0a  ttr value) ...).
0640: 3b 20 77 68 65 72 65 20 6c 2d 6b 65 79 20 69 73  ; where l-key is
0650: 20 6f 6e 65 20 6f 66 20 74 68 65 20 66 6f 6c 6c   one of the foll
0660: 6f 77 69 6e 67 3a 0a 3b 09 73 74 61 72 74 2c 20  owing:.;.start, 
0670: 63 6f 6e 74 65 6e 74 73 2c 20 70 72 65 76 2c 20  contents, prev, 
0680: 6e 65 78 74 2c 20 74 6f 70 2c 20 68 6f 6d 65 0a  next, top, home.
0690: 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 68  .(define (make-h
06a0: 65 61 64 65 72 20 68 65 61 64 2d 70 61 72 6d 73  eader head-parms
06b0: 29 0a 20 20 60 28 68 65 61 64 0a 20 20 20 20 28  ).  `(head.    (
06c0: 74 69 74 6c 65 20 2c 28 6c 6f 6f 6b 75 70 2d 64  title ,(lookup-d
06d0: 65 66 20 27 74 69 74 6c 65 20 68 65 61 64 2d 70  ef 'title head-p
06e0: 61 72 6d 73 29 29 0a 20 20 20 20 2c 28 6d 61 70  arms)).    ,(map
06f0: 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28  .      (lambda (
0700: 6b 65 79 29 0a 09 28 6c 65 74 20 28 28 76 61 6c  key)..(let ((val
0710: 20 28 6c 6f 6f 6b 75 70 2d 64 65 66 20 6b 65 79   (lookup-def key
0720: 20 68 65 61 64 2d 70 61 72 6d 73 20 77 61 72 6e   head-parms warn
0730: 3a 20 23 66 29 29 29 0a 09 20 20 28 61 6e 64 20  : #f)))..  (and 
0740: 76 61 6c 0a 09 20 20 20 20 20 20 20 60 28 6d 65  val..       `(me
0750: 74 61 20 28 40 20 28 6e 61 6d 65 20 2c 28 73 79  ta (@ (name ,(sy
0760: 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20 6b 65 79  mbol->string key
0770: 29 29 20 28 63 6f 6e 74 65 6e 74 20 2c 76 61 6c  )) (content ,val
0780: 29 29 29 29 29 29 0a 20 20 20 20 20 20 27 28 64  )))))).      '(d
0790: 65 73 63 72 69 70 74 69 6f 6e 20 41 75 74 68 6f  escription Autho
07a0: 72 41 64 64 72 65 73 73 20 6b 65 79 77 6f 72 64  rAddress keyword
07b0: 73 0a 09 44 61 74 65 2d 52 65 76 69 73 69 6f 6e  s..Date-Revision
07c0: 2d 79 79 79 79 6d 6d 64 64 20 44 61 74 65 2d 43  -yyyymmdd Date-C
07d0: 72 65 61 74 69 6f 6e 2d 79 79 79 79 6d 6d 64 64  reation-yyyymmdd
07e0: 29 29 0a 20 20 20 20 2c 28 6c 65 74 20 28 28 6c  )).    ,(let ((l
07f0: 69 6e 6b 73 20 28 6c 6f 6f 6b 75 70 2d 64 65 66  inks (lookup-def
0800: 20 27 4c 69 6e 6b 73 20 68 65 61 64 2d 70 61 72   'Links head-par
0810: 6d 73 20 27 28 29 29 29 29 0a 20 20 20 20 20 20  ms '()))).      
0820: 28 61 6e 64 20 28 70 61 69 72 3f 20 6c 69 6e 6b  (and (pair? link
0830: 73 29 0a 09 20 20 20 28 6d 61 70 0a 09 20 20 20  s)..   (map..   
0840: 20 28 6c 61 6d 62 64 61 20 28 6c 69 6e 6b 2d 6b   (lambda (link-k
0850: 65 79 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20  ey)..      (let 
0860: 28 28 76 61 6c 20 28 6c 6f 6f 6b 75 70 2d 64 65  ((val (lookup-de
0870: 66 20 6c 69 6e 6b 2d 6b 65 79 20 6c 69 6e 6b 73  f link-key links
0880: 20 23 66 29 29 29 0a 09 09 28 61 6e 64 20 76 61   #f)))...(and va
0890: 6c 0a 09 09 20 20 28 6c 65 74 20 28 28 76 61 6c  l...  (let ((val
08a0: 20 28 69 66 20 28 6e 6f 74 20 28 70 61 69 72 3f   (if (not (pair?
08b0: 20 76 61 6c 29 29 20 28 6c 69 73 74 20 76 61 6c   val)) (list val
08c0: 29 20 76 61 6c 29 29 29 0a 09 09 20 20 20 20 20  ) val)))...     
08d0: 60 28 6c 69 6e 6b 20 28 40 20 28 72 65 6c 20 2c  `(link (@ (rel ,
08e0: 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 69 6e 67 20  (symbol->string 
08f0: 6c 69 6e 6b 2d 6b 65 79 29 29 0a 09 09 09 20 20  link-key))....  
0900: 20 20 20 20 20 28 68 72 65 66 20 2c 28 63 61 72       (href ,(car
0910: 20 76 61 6c 29 29 0a 09 09 09 20 20 20 20 20 20   val))....      
0920: 20 2c 40 28 63 64 72 20 76 61 6c 29 29 29 29 29   ,@(cdr val)))))
0930: 29 29 0a 09 20 20 20 20 27 28 73 74 61 72 74 20  ))..    '(start 
0940: 63 6f 6e 74 65 6e 74 73 20 70 72 65 76 20 6e 65  contents prev ne
0950: 78 74 29 29 29 29 29 0a 29 0a 0a 3b 20 43 72 65  xt))))).)..; Cre
0960: 61 74 65 20 61 20 6e 61 76 69 67 61 74 69 6f 6e  ate a navigation
0970: 61 6c 20 62 61 72 2e 20 54 68 65 20 61 72 67 75  al bar. The argu
0980: 6d 65 6e 74 20 68 65 61 64 2d 70 61 72 6d 73 20  ment head-parms 
0990: 69 73 20 74 68 65 20 73 61 6d 65 0a 3b 20 61 73  is the same.; as
09a0: 20 74 68 65 20 6f 6e 65 20 70 61 73 73 65 64 20   the one passed 
09b0: 74 6f 20 6d 61 6b 65 2d 68 65 61 64 65 72 2e 20  to make-header. 
09c0: 57 65 27 72 65 20 6f 6e 6c 79 20 63 6f 6e 63 65  We're only conce
09d0: 72 6e 65 64 20 77 69 74 68 20 74 68 65 0a 3b 20  rned with the.; 
09e0: 68 2d 76 61 6c 75 65 20 4c 69 6e 6b 73 0a 28 64  h-value Links.(d
09f0: 65 66 69 6e 65 20 28 6d 61 6b 65 2d 6e 61 76 62  efine (make-navb
0a00: 61 72 20 68 65 61 64 2d 70 61 72 6d 73 29 0a 20  ar head-parms). 
0a10: 20 28 6c 65 74 20 28 28 6c 69 6e 6b 73 20 28 6c   (let ((links (l
0a20: 6f 6f 6b 75 70 2d 64 65 66 20 27 4c 69 6e 6b 73  ookup-def 'Links
0a30: 20 68 65 61 64 2d 70 61 72 6d 73 20 27 28 29 29   head-parms '())
0a40: 29 0a 09 28 6e 61 76 2d 6c 61 62 65 6c 73 20 27  )..(nav-labels '
0a50: 28 28 70 72 65 76 20 2e 20 22 70 72 65 76 69 6f  ((prev . "previo
0a60: 75 73 22 29 0a 09 09 20 20 20 20 20 20 28 6e 65  us")...      (ne
0a70: 78 74 20 2e 20 22 6e 65 78 74 22 29 0a 09 09 20  xt . "next")... 
0a80: 20 20 20 20 20 28 63 6f 6e 74 65 6e 74 73 20 2e       (contents .
0a90: 20 22 63 6f 6e 74 65 6e 74 73 22 29 0a 09 09 20   "contents")... 
0aa0: 20 20 20 20 20 28 74 6f 70 20 2e 20 22 74 6f 70       (top . "top
0ab0: 22 29 29 29 29 0a 20 20 20 20 28 61 6e 64 20 28  ")))).    (and (
0ac0: 70 61 69 72 3f 20 6c 69 6e 6b 73 29 0a 20 20 20  pair? links).   
0ad0: 20 20 20 60 28 64 69 76 20 28 40 20 28 61 6c 69     `(div (@ (ali
0ae0: 67 6e 20 22 63 65 6e 74 65 72 22 29 20 28 63 6c  gn "center") (cl
0af0: 61 73 73 20 22 6e 61 76 62 61 72 22 29 29 0a 09  ass "navbar"))..
0b00: 20 2c 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6e 61   ,(let loop ((na
0b10: 76 2d 6c 61 62 65 6c 73 20 6e 61 76 2d 6c 61 62  v-labels nav-lab
0b20: 65 6c 73 29 20 28 66 69 72 73 74 3f 20 23 74 29  els) (first? #t)
0b30: 29 0a 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c  )..    (if (null
0b40: 3f 20 6e 61 76 2d 6c 61 62 65 6c 73 29 20 27 28  ? nav-labels) '(
0b50: 29 0a 09 09 28 6c 65 74 20 28 28 76 61 6c 20 28  )...(let ((val (
0b60: 6c 6f 6f 6b 75 70 2d 64 65 66 20 28 63 61 61 72  lookup-def (caar
0b70: 20 6e 61 76 2d 6c 61 62 65 6c 73 29 20 6c 69 6e   nav-labels) lin
0b80: 6b 73 20 77 61 72 6e 3a 20 23 66 29 29 29 0a 09  ks warn: #f)))..
0b90: 09 20 20 28 69 66 20 28 6e 6f 74 20 76 61 6c 29  .  (if (not val)
0ba0: 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28  ...      (loop (
0bb0: 63 64 72 20 6e 61 76 2d 6c 61 62 65 6c 73 29 20  cdr nav-labels) 
0bc0: 66 69 72 73 74 3f 29 0a 09 09 20 20 20 20 20 20  first?)...      
0bd0: 28 63 6f 6e 73 0a 09 09 20 20 20 20 20 20 20 28  (cons...       (
0be0: 6c 69 73 74 20 22 20 22 20 28 69 66 20 66 69 72  list " " (if fir
0bf0: 73 74 3f 20 23 66 20 27 28 6e 5f 29 29 20 22 20  st? #f '(n_)) " 
0c00: 22 0a 09 09 09 20 20 20 20 20 60 28 61 20 28 40  "....     `(a (@
0c10: 20 28 68 72 65 66 20 2c 76 61 6c 29 29 20 2c 28   (href ,val)) ,(
0c20: 63 64 61 72 20 6e 61 76 2d 6c 61 62 65 6c 73 29  cdar nav-labels)
0c30: 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c 6f 6f  ))...       (loo
0c40: 70 20 28 63 64 72 20 6e 61 76 2d 6c 61 62 65 6c  p (cdr nav-label
0c50: 73 29 20 23 66 29 29 29 29 29 29 0a 09 20 28 68  s) #f)))))).. (h
0c60: 72 29 29 29 0a 29 29 0a 09 09 09 20 20 20 20 20  r))).))....     
0c70: 20 0a 0a 3b 20 43 72 65 61 74 65 20 61 20 66 6f   ..; Create a fo
0c80: 6f 74 65 72 2e 20 54 68 65 20 61 72 67 75 6d 65  oter. The argume
0c90: 6e 74 20 68 65 61 64 2d 70 61 72 6d 73 20 69 73  nt head-parms is
0ca0: 20 74 68 65 20 73 61 6d 65 0a 09 09 09 09 09 3b   the same......;
0cb0: 20 61 73 20 70 61 73 73 65 64 20 74 6f 20 6d 61   as passed to ma
0cc0: 6b 65 2d 68 65 61 64 65 72 2e 0a 28 64 65 66 69  ke-header..(defi
0cd0: 6e 65 20 28 6d 61 6b 65 2d 66 6f 6f 74 65 72 20  ne (make-footer 
0ce0: 68 65 61 64 2d 70 61 72 6d 73 29 0a 20 20 60 28  head-parms).  `(
0cf0: 28 62 72 29 0a 20 20 20 20 28 64 69 76 20 28 68  (br).    (div (h
0d00: 72 29 29 0a 20 20 20 20 28 68 33 20 22 4c 61 73  r)).    (h3 "Las
0d10: 74 20 75 70 64 61 74 65 64 20 22 0a 09 2c 28 6c  t updated "..,(l
0d20: 65 74 2a 20 28 28 64 61 74 65 2d 72 65 76 69 73  et* ((date-revis
0d30: 65 64 0a 09 09 20 20 28 6c 6f 6f 6b 75 70 2d 64  ed...  (lookup-d
0d40: 65 66 20 27 44 61 74 65 2d 52 65 76 69 73 69 6f  ef 'Date-Revisio
0d50: 6e 2d 79 79 79 79 6d 6d 64 64 20 68 65 61 64 2d  n-yyyymmdd head-
0d60: 70 61 72 6d 73 29 29 0a 09 09 28 79 65 61 72 20  parms))...(year 
0d70: 28 73 74 72 69 6e 67 2d 3e 69 6e 74 65 67 65 72  (string->integer
0d80: 20 64 61 74 65 2d 72 65 76 69 73 65 64 20 30 20   date-revised 0 
0d90: 34 29 29 0a 09 09 28 6d 6f 6e 74 68 20 28 73 74  4))...(month (st
0da0: 72 69 6e 67 2d 3e 69 6e 74 65 67 65 72 20 64 61  ring->integer da
0db0: 74 65 2d 72 65 76 69 73 65 64 20 34 20 36 29 29  te-revised 4 6))
0dc0: 0a 09 09 28 64 61 79 20 20 20 28 73 74 72 69 6e  ...(day   (strin
0dd0: 67 2d 3e 69 6e 74 65 67 65 72 20 64 61 74 65 2d  g->integer date-
0de0: 72 65 76 69 73 65 64 20 36 20 38 29 29 0a 09 09  revised 6 8))...
0df0: 28 6d 6f 6e 74 68 2d 6e 61 6d 65 0a 09 09 20 28  (month-name... (
0e00: 76 65 63 74 6f 72 2d 72 65 66 0a 09 09 20 20 27  vector-ref...  '
0e10: 23 28 22 4a 61 6e 75 61 72 79 22 20 22 46 65 62  #("January" "Feb
0e20: 72 75 61 72 79 22 20 22 4d 61 72 63 68 22 20 22  ruary" "March" "
0e30: 41 70 72 69 6c 22 20 22 4d 61 79 22 20 22 4a 75  April" "May" "Ju
0e40: 6e 65 22 0a 09 09 20 20 20 20 22 4a 75 6c 79 22  ne"...    "July"
0e50: 20 20 20 22 41 75 67 75 73 74 22 20 22 53 65 70     "August" "Sep
0e60: 74 65 6d 62 65 72 22 20 22 4f 63 74 6f 62 65 72  tember" "October
0e70: 22 20 22 4e 6f 76 65 6d 62 65 72 22 0a 09 09 20  " "November"... 
0e80: 20 20 20 22 44 65 63 65 6d 62 65 72 22 29 0a 09     "December")..
0e90: 09 20 20 28 64 65 63 20 6d 6f 6e 74 68 29 29 29  .  (dec month)))
0ea0: 29 0a 09 20 20 20 28 6c 69 73 74 20 6d 6f 6e 74  )..   (list mont
0eb0: 68 2d 6e 61 6d 65 20 22 20 22 20 64 61 79 20 22  h-name " " day "
0ec0: 2c 20 22 20 79 65 61 72 29 29 29 0a 20 20 20 20  , " year))).    
0ed0: 2c 28 6c 65 74 20 28 28 6c 69 6e 6b 73 20 28 6c  ,(let ((links (l
0ee0: 6f 6f 6b 75 70 2d 64 65 66 20 27 4c 69 6e 6b 73  ookup-def 'Links
0ef0: 20 68 65 61 64 2d 70 61 72 6d 73 20 27 28 29 29   head-parms '())
0f00: 29 29 0a 20 20 20 20 20 20 20 28 61 6e 64 20 28  )).       (and (
0f10: 70 61 69 72 3f 20 6c 69 6e 6b 73 29 0a 09 20 20  pair? links)..  
0f20: 20 20 28 6c 65 74 20 28 28 68 6f 6d 65 20 28 6c    (let ((home (l
0f30: 6f 6f 6b 75 70 2d 64 65 66 20 27 68 6f 6d 65 20  ookup-def 'home 
0f40: 6c 69 6e 6b 73 20 77 61 72 6e 3a 20 23 66 29 29  links warn: #f))
0f50: 29 0a 09 20 20 20 20 20 20 28 61 6e 64 20 68 6f  )..      (and ho
0f60: 6d 65 0a 09 09 20 20 20 60 28 70 20 22 54 68 69  me...   `(p "Thi
0f70: 73 20 73 69 74 65 27 73 20 74 6f 70 20 70 61 67  s site's top pag
0f80: 65 20 69 73 20 22 0a 09 09 20 20 20 20 20 20 20  e is "...       
0f90: 28 61 20 28 40 20 28 68 72 65 66 20 2c 68 6f 6d  (a (@ (href ,hom
0fa0: 65 29 29 20 28 73 74 72 6f 6e 67 20 2c 68 6f 6d  e)) (strong ,hom
0fb0: 65 29 29 29 29 29 29 29 0a 20 20 20 20 28 64 69  e))))))).    (di
0fc0: 76 20 0a 20 20 20 20 20 20 28 61 64 64 72 65 73  v .      (addres
0fd0: 73 20 22 6f 6c 65 67 2d 61 74 2d 70 6f 62 6f 78  s "oleg-at-pobox
0fe0: 2e 63 6f 6d 20 6f 72 20 6f 6c 65 67 2d 61 74 2d  .com or oleg-at-
0ff0: 6f 6b 6d 69 6a 2e 6f 72 67 22 0a 20 20 20 20 20  okmij.org".     
1000: 20 20 28 62 72 29 0a 20 20 20 20 20 20 20 22 59    (br).       "Y
1010: 6f 75 72 20 63 6f 6d 6d 65 6e 74 73 2c 20 70 72  our comments, pr
1020: 6f 62 6c 65 6d 20 72 65 70 6f 72 74 73 2c 20 71  oblem reports, q
1030: 75 65 73 74 69 6f 6e 73 20 61 72 65 20 76 65 72  uestions are ver
1040: 79 20 77 65 6c 63 6f 6d 65 21 22 29 29 0a 20 20  y welcome!")).  
1050: 20 20 28 70 20 28 66 6f 6e 74 20 28 40 20 28 73    (p (font (@ (s
1060: 69 7a 65 20 22 2d 32 22 29 29 20 22 43 6f 6e 76  ize "-2")) "Conv
1070: 65 72 74 65 64 20 66 72 6f 6d 20 53 58 4d 4c 20  erted from SXML 
1080: 62 79 20 53 58 4d 4c 2d 3e 48 54 4d 4c 22 29 29  by SXML->HTML"))
1090: 0a 20 20 20 20 2c 28 6c 65 74 20 28 28 72 63 73  .    ,(let ((rcs
10a0: 2d 69 64 20 28 6c 6f 6f 6b 75 70 2d 64 65 66 20  -id (lookup-def 
10b0: 27 72 63 73 2d 69 64 20 68 65 61 64 2d 70 61 72  'rcs-id head-par
10c0: 6d 73 20 23 66 29 29 29 0a 20 20 20 20 20 20 20  ms #f))).       
10d0: 28 61 6e 64 20 72 63 73 2d 69 64 20 60 28 68 34  (and rcs-id `(h4
10e0: 20 2c 72 63 73 2d 69 64 29 29 29 0a 20 20 20 20   ,rcs-id))).    
10f0: 29 29 0a 0a 3b 20 42 69 6e 64 69 6e 67 73 20 66  ))..; Bindings f
1100: 6f 72 20 74 68 65 20 70 6f 73 74 2d 6f 72 64 65  or the post-orde
1110: 72 20 66 75 6e 63 74 69 6f 6e 2c 20 77 68 69 63  r function, whic
1120: 68 20 74 72 61 76 65 72 73 65 73 20 74 68 65 20  h traverses the 
1130: 53 58 4d 4c 20 74 72 65 65 0a 3b 20 61 6e 64 20  SXML tree.; and 
1140: 63 6f 6e 76 65 72 74 73 20 69 74 20 74 6f 20 61  converts it to a
1150: 20 74 72 65 65 20 6f 66 20 66 72 61 67 6d 65 6e   tree of fragmen
1160: 74 73 0a 0a 28 64 65 66 69 6e 65 20 65 6e 74 61  ts..(define enta
1170: 67 2a 0a 20 20 28 6c 65 74 20 28 28 77 69 74 68  g*.  (let ((with
1180: 2d 6e 6c 09 3b 20 42 6c 6f 63 6b 2d 6c 65 76 65  -nl.; Block-leve
1190: 6c 20 48 54 4d 4c 20 65 6c 65 6d 65 6e 74 73 3a  l HTML elements:
11a0: 0a 09 09 09 09 3b 20 57 65 20 69 6e 73 65 72 74  .....; We insert
11b0: 20 61 20 4e 4c 20 62 65 66 6f 72 65 20 74 68 65   a NL before the
11c0: 6d 2e 0a 09 09 09 09 3b 20 4e 6f 20 4e 4c 20 69  m......; No NL i
11d0: 73 20 69 6e 73 65 72 74 65 64 20 62 65 66 6f 72  s inserted befor
11e0: 65 20 6f 72 20 61 66 74 65 72 20 61 6e 0a 09 09  e or after an...
11f0: 09 09 3b 20 69 6e 6c 69 6e 65 20 65 6c 65 6d 65  ..; inline eleme
1200: 6e 74 2e 0a 09 20 20 27 28 62 72 20 09 09 09 3b  nt...  '(br ...;
1210: 20 42 52 20 69 73 20 74 65 63 68 6e 69 63 61 6c   BR is technical
1220: 6c 79 20 69 6e 6c 69 6e 65 2c 20 62 75 74 20 77  ly inline, but w
1230: 65 0a 09 09 09 09 3b 20 74 72 65 61 74 20 69 74  e.....; treat it
1240: 20 61 73 20 62 6c 6f 63 6b 0a 09 20 20 20 20 20   as block..     
1250: 70 20 64 69 76 20 68 72 0a 09 20 20 20 20 20 68  p div hr..     h
1260: 31 20 68 32 20 68 33 20 68 33 20 68 35 20 68 36  1 h2 h3 h3 h5 h6
1270: 20 6d 65 74 61 0a 09 20 20 20 20 20 64 6c 20 75   meta..     dl u
1280: 6c 20 6f 6c 20 6c 69 20 64 74 20 64 64 20 70 72  l ol li dt dd pr
1290: 65 0a 09 20 20 20 20 20 74 61 62 6c 65 20 74 72  e..     table tr
12a0: 20 74 68 20 74 64 20 6c 69 6e 6b 20 74 69 74 6c   th td link titl
12b0: 65 20 73 63 72 69 70 74 0a 09 20 20 20 20 20 63  e script..     c
12c0: 65 6e 74 65 72 20 62 6c 6f 63 6b 71 75 6f 74 65  enter blockquote
12d0: 20 66 6f 72 6d 0a 09 20 20 20 20 20 61 64 64 72   form..     addr
12e0: 65 73 73 20 62 6f 64 79 20 74 68 65 61 64 20 74  ess body thead t
12f0: 66 6f 6f 74 20 74 62 6f 64 79 20 63 6f 6c 20 63  foot tbody col c
1300: 6f 6c 67 72 6f 75 70 29 29 29 0a 20 20 20 20 28  olgroup))).    (
1310: 6c 61 6d 62 64 61 20 28 74 61 67 20 65 6c 65 6d  lambda (tag elem
1320: 73 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28  s).      (let ((
1330: 6e 6c 3f 20 28 61 6e 64 20 28 6d 65 6d 71 20 74  nl? (and (memq t
1340: 61 67 20 77 69 74 68 2d 6e 6c 29 20 23 5c 6e 65  ag with-nl) #\ne
1350: 77 6c 69 6e 65 29 29 29 0a 09 28 69 66 20 28 61  wline)))..(if (a
1360: 6e 64 20 28 70 61 69 72 3f 20 65 6c 65 6d 73 29  nd (pair? elems)
1370: 20 28 70 61 69 72 3f 20 28 63 61 72 20 65 6c 65   (pair? (car ele
1380: 6d 73 29 29 0a 09 20 20 20 20 20 20 28 65 71 3f  ms))..      (eq?
1390: 20 27 40 20 28 63 61 61 72 20 65 6c 65 6d 73 29   '@ (caar elems)
13a0: 29 29 0a 09 20 20 28 6c 69 73 74 20 6e 6c 3f 20  ))..  (list nl? 
13b0: 23 5c 3c 20 74 61 67 20 28 63 64 61 72 20 65 6c  #\< tag (cdar el
13c0: 65 6d 73 29 20 23 5c 3e 0a 09 20 20 20 20 28 69  ems) #\>..    (i
13d0: 66 20 28 70 61 69 72 3f 20 28 63 64 72 20 65 6c  f (pair? (cdr el
13e0: 65 6d 73 29 29 0a 09 09 28 6c 69 73 74 20 28 63  ems))...(list (c
13f0: 64 72 20 65 6c 65 6d 73 29 20 22 3c 2f 22 20 74  dr elems) "</" t
1400: 61 67 20 23 5c 3e 20 6e 6c 3f 29 0a 09 09 28 6c  ag #\> nl?)...(l
1410: 69 73 74 20 22 3c 2f 22 20 74 61 67 20 23 5c 3e  ist "</" tag #\>
1420: 20 6e 6c 3f 29 29 29 0a 09 20 20 28 6c 69 73 74   nl?)))..  (list
1430: 20 6e 6c 3f 20 23 5c 3c 20 74 61 67 20 23 5c 3e   nl? #\< tag #\>
1440: 20 0a 09 20 20 20 20 28 61 6e 64 20 28 70 61 69   ..    (and (pai
1450: 72 3f 20 65 6c 65 6d 73 29 20 28 6c 69 73 74 20  r? elems) (list 
1460: 65 6c 65 6d 73 20 22 3c 2f 22 20 74 61 67 20 23  elems "</" tag #
1470: 5c 3e 20 6e 6c 3f 29 29 0a 09 20 20 20 20 29 29  \> nl?))..    ))
1480: 29 29 29 29 0a 0a 3b 20 54 68 65 20 75 6e 69 76  ))))..; The univ
1490: 65 72 73 61 6c 20 74 72 61 6e 73 66 6f 72 6d 61  ersal transforma
14a0: 74 69 6f 6e 20 66 72 6f 6d 20 53 58 4d 4c 20 74  tion from SXML t
14b0: 6f 20 48 54 4d 4c 2e 20 54 68 65 20 66 6f 6c 6c  o HTML. The foll
14c0: 6f 77 69 6e 67 20 72 75 6c 65 73 0a 3b 20 77 6f  owing rules.; wo
14d0: 72 6b 20 66 6f 72 20 65 76 65 72 79 20 48 54 4d  rk for every HTM
14e0: 4c 2c 20 70 72 65 73 65 6e 74 20 61 6e 64 20 66  L, present and f
14f0: 75 74 75 72 65 0a 28 64 65 66 69 6e 65 20 75 6e  uture.(define un
1500: 69 76 65 72 73 61 6c 2d 63 6f 6e 76 65 72 73 69  iversal-conversi
1510: 6f 6e 2d 72 75 6c 65 73 0a 20 20 60 28 28 40 0a  on-rules.  `((@.
1520: 20 20 20 20 20 20 28 28 2a 64 65 66 61 75 6c 74        ((*default
1530: 2a 20 20 20 20 20 20 20 3b 20 6c 6f 63 61 6c 20  *       ; local 
1540: 6f 76 65 72 72 69 64 65 20 66 6f 72 20 61 74 74  override for att
1550: 72 69 62 75 74 65 73 0a 20 20 20 20 20 20 20 20  ributes.        
1560: 2e 20 2c 28 6c 61 6d 62 64 61 20 28 61 74 74 72  . ,(lambda (attr
1570: 2d 6b 65 79 20 2e 20 76 61 6c 75 65 29 20 28 65  -key . value) (e
1580: 6e 61 74 74 72 20 61 74 74 72 2d 6b 65 79 20 76  nattr attr-key v
1590: 61 6c 75 65 29 29 29 29 0a 20 20 20 20 20 20 2e  alue)))).      .
15a0: 20 2c 28 6c 61 6d 62 64 61 20 28 74 72 69 67 67   ,(lambda (trigg
15b0: 65 72 20 2e 20 76 61 6c 75 65 29 20 28 63 6f 6e  er . value) (con
15c0: 73 20 27 40 20 76 61 6c 75 65 29 29 29 0a 20 20  s '@ value))).  
15d0: 20 20 28 2a 64 65 66 61 75 6c 74 2a 20 2e 20 2c    (*default* . ,
15e0: 28 6c 61 6d 62 64 61 20 28 74 61 67 20 2e 20 65  (lambda (tag . e
15f0: 6c 65 6d 73 29 20 28 65 6e 74 61 67 2a 20 74 61  lems) (entag* ta
1600: 67 20 65 6c 65 6d 73 29 29 29 0a 20 20 20 20 28  g elems))).    (
1610: 2a 74 65 78 74 2a 20 2e 20 2c 28 6c 61 6d 62 64  *text* . ,(lambd
1620: 61 20 28 74 72 69 67 67 65 72 20 73 74 72 29 20  a (trigger str) 
1630: 0a 09 09 20 28 63 6f 6e 64 20 5b 28 73 74 72 69  ... (cond [(stri
1640: 6e 67 3f 20 73 74 72 29 20 28 73 74 72 69 6e 67  ng? str) (string
1650: 2d 3e 67 6f 6f 64 48 54 4d 4c 20 73 74 72 29 5d  ->goodHTML str)]
1660: 0a 09 09 09 5b 28 62 79 74 65 76 65 63 74 6f 72  ....[(bytevector
1670: 3f 20 73 74 72 29 20 28 75 74 66 38 2d 3e 73 74  ? str) (utf8->st
1680: 72 69 6e 67 20 73 74 72 29 5d 0a 09 09 09 5b 65  ring str)]....[e
1690: 6c 73 65 20 73 74 72 5d 29 29 29 0a 20 20 20 20  lse str]))).    
16a0: 28 6e 5f 09 09 3b 20 61 20 6e 6f 6e 2d 62 72 65  (n_..; a non-bre
16b0: 61 6b 69 6e 67 20 73 70 61 63 65 0a 20 20 20 20  aking space.    
16c0: 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74 61 67   . ,(lambda (tag
16d0: 20 2e 20 65 6c 65 6d 73 29 0a 09 20 20 28 63 6f   . elems)..  (co
16e0: 6e 73 20 22 26 6e 62 73 70 3b 22 20 65 6c 65 6d  ns "&nbsp;" elem
16f0: 73 29 29 29 29 29 0a 0a 3b 20 41 20 76 61 72 69  s)))))..; A vari
1700: 61 74 69 6f 6e 20 6f 66 20 75 6e 69 76 65 72 73  ation of univers
1710: 61 6c 2d 63 6f 6e 76 65 72 73 69 6f 6e 2d 72 75  al-conversion-ru
1720: 6c 65 73 20 77 68 69 63 68 20 6b 65 65 70 73 20  les which keeps 
1730: 27 3c 27 2c 20 27 3e 27 2c 20 27 26 27 0a 3b 20  '<', '>', '&'.; 
1740: 61 6e 64 20 73 69 6d 69 6c 61 72 20 63 68 61 72  and similar char
1750: 61 63 74 65 72 73 20 69 6e 74 61 63 74 2e 20 54  acters intact. T
1760: 68 65 20 75 6e 69 76 65 72 73 61 6c 2d 70 72 6f  he universal-pro
1770: 74 65 63 74 65 64 2d 72 75 6c 65 73 20 61 72 65  tected-rules are
1780: 0a 3b 20 75 73 65 66 75 6c 20 77 68 65 6e 20 74  .; useful when t
1790: 68 65 20 74 72 65 65 20 6f 66 20 66 72 61 67 6d  he tree of fragm
17a0: 65 6e 74 73 20 68 61 73 20 74 6f 20 62 65 20 74  ents has to be t
17b0: 72 61 76 65 72 73 65 64 20 6f 6e 65 20 6d 6f 72  raversed one mor
17c0: 65 20 74 69 6d 65 2e 0a 28 64 65 66 69 6e 65 20  e time..(define 
17d0: 75 6e 69 76 65 72 73 61 6c 2d 70 72 6f 74 65 63  universal-protec
17e0: 74 65 64 2d 72 75 6c 65 73 0a 20 20 60 28 28 40  ted-rules.  `((@
17f0: 0a 20 20 20 20 20 20 28 28 2a 64 65 66 61 75 6c  .      ((*defaul
1800: 74 2a 20 20 20 20 20 20 20 3b 20 6c 6f 63 61 6c  t*       ; local
1810: 20 6f 76 65 72 72 69 64 65 20 66 6f 72 20 61 74   override for at
1820: 74 72 69 62 75 74 65 73 0a 20 20 20 20 20 20 20  tributes.       
1830: 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28 61 74 74   . ,(lambda (att
1840: 72 2d 6b 65 79 20 2e 20 76 61 6c 75 65 29 20 28  r-key . value) (
1850: 65 6e 61 74 74 72 20 61 74 74 72 2d 6b 65 79 20  enattr attr-key 
1860: 76 61 6c 75 65 29 29 29 29 0a 20 20 20 20 20 20  value)))).      
1870: 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74 72 69 67  . ,(lambda (trig
1880: 67 65 72 20 2e 20 76 61 6c 75 65 29 20 28 63 6f  ger . value) (co
1890: 6e 73 20 27 40 20 76 61 6c 75 65 29 29 29 0a 20  ns '@ value))). 
18a0: 20 20 20 28 2a 64 65 66 61 75 6c 74 2a 20 2e 20     (*default* . 
18b0: 2c 28 6c 61 6d 62 64 61 20 28 74 61 67 20 2e 20  ,(lambda (tag . 
18c0: 65 6c 65 6d 73 29 20 28 65 6e 74 61 67 20 74 61  elems) (entag ta
18d0: 67 20 65 6c 65 6d 73 29 29 29 0a 20 20 20 20 28  g elems))).    (
18e0: 2a 74 65 78 74 2a 20 2e 20 2c 28 6c 61 6d 62 64  *text* . ,(lambd
18f0: 61 20 28 74 72 69 67 67 65 72 20 73 74 72 29 20  a (trigger str) 
1900: 0a 09 09 20 73 74 72 29 29 0a 20 20 20 20 28 6e  ... str)).    (n
1910: 5f 09 09 3b 20 61 20 6e 6f 6e 2d 62 72 65 61 6b  _..; a non-break
1920: 69 6e 67 20 73 70 61 63 65 0a 20 20 20 20 20 2e  ing space.     .
1930: 20 2c 28 6c 61 6d 62 64 61 20 28 74 61 67 20 2e   ,(lambda (tag .
1940: 20 65 6c 65 6d 73 29 0a 09 20 20 28 63 6f 6e 73   elems)..  (cons
1950: 20 22 26 6e 62 73 70 3b 22 20 65 6c 65 6d 73 29   "&nbsp;" elems)
1960: 29 29 29 29 0a 0a 3b 20 54 68 65 20 66 6f 6c 6c  ))))..; The foll
1970: 6f 77 69 6e 67 20 72 75 6c 65 73 20 64 65 66 69  owing rules defi
1980: 6e 65 20 74 68 65 20 69 64 65 6e 74 69 74 79 20  ne the identity 
1990: 74 72 61 6e 73 66 6f 72 6d 61 74 69 6f 6e 0a 28  transformation.(
19a0: 64 65 66 69 6e 65 20 61 6c 69 73 74 2d 63 6f 6e  define alist-con
19b0: 76 2d 72 75 6c 65 73 0a 20 20 60 28 28 2a 64 65  v-rules.  `((*de
19c0: 66 61 75 6c 74 2a 20 2e 20 2c 28 6c 61 6d 62 64  fault* . ,(lambd
19d0: 61 20 28 74 61 67 20 2e 20 65 6c 65 6d 73 29 20  a (tag . elems) 
19e0: 28 63 6f 6e 73 20 74 61 67 20 65 6c 65 6d 73 29  (cons tag elems)
19f0: 29 29 0a 20 20 20 20 28 2a 74 65 78 74 2a 20 2e  )).    (*text* .
1a00: 20 2c 28 6c 61 6d 62 64 61 20 28 74 72 69 67 67   ,(lambda (trigg
1a10: 65 72 20 73 74 72 29 20 73 74 72 29 29 29 29 0a  er str) str)))).
1a20: 0a 0a 3b 20 46 69 6e 64 20 74 68 65 20 27 48 65  ..; Find the 'He
1a30: 61 64 65 72 27 20 6e 6f 64 65 20 77 69 74 68 69  ader' node withi
1a40: 6e 20 74 68 65 20 27 43 6f 6e 74 65 6e 74 27 20  n the 'Content' 
1a50: 53 58 4d 4c 20 65 78 70 72 65 73 73 69 6f 6e 2e  SXML expression.
1a60: 0a 3b 20 43 75 72 72 65 6e 74 6c 79 20 74 68 69  .; Currently thi
1a70: 73 20 71 75 65 72 79 20 69 73 20 65 78 65 63 75  s query is execu
1a80: 74 65 64 20 76 69 61 20 61 20 74 72 61 6e 73 66  ted via a transf
1a90: 6f 72 6d 61 74 69 6f 6e 2c 20 77 69 74 68 0a 3b  ormation, with.;
1aa0: 20 72 75 6c 65 73 20 74 68 61 74 20 64 72 6f 70   rules that drop
1ab0: 20 6f 75 74 20 65 76 65 72 79 74 68 69 6e 67 20   out everything 
1ac0: 62 75 74 20 74 68 65 20 27 48 65 61 64 65 72 27  but the 'Header'
1ad0: 20 6e 6f 64 65 2e 0a 3b 20 57 65 20 75 73 65 20   node..; We use 
1ae0: 74 68 65 20 5f 62 72 65 61 64 74 68 2d 66 69 72  the _breadth-fir
1af0: 73 74 5f 20 74 72 61 76 65 72 73 61 6c 20 6f 66  st_ traversal of
1b00: 20 74 68 65 20 43 6f 6e 74 65 6e 74 20 74 72 65   the Content tre
1b10: 65 2e 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64  e..(define (find
1b20: 2d 48 65 61 64 65 72 20 43 6f 6e 74 65 6e 74 29  -Header Content)
1b30: 0a 20 20 28 6c 65 74 72 65 63 20 0a 20 20 20 20  .  (letrec .    
1b40: 28 28 73 65 61 72 63 68 2d 72 75 6c 65 73 0a 09  ((search-rules..
1b50: 20 60 28 28 2a 64 65 66 61 75 6c 74 2a 0a 09 20   `((*default*.. 
1b60: 20 20 20 2a 70 72 65 6f 72 64 65 72 2a 0a 09 20     *preorder*.. 
1b70: 20 20 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74     . ,(lambda (t
1b80: 61 67 20 2e 20 65 6c 65 6d 73 29 0a 09 09 20 28  ag . elems)... (
1b90: 6c 65 74 20 6c 6f 6f 70 20 28 28 65 6c 65 6d 73  let loop ((elems
1ba0: 20 65 6c 65 6d 73 29 20 28 77 6f 72 6b 6c 69 73   elems) (worklis
1bb0: 74 20 27 28 29 29 29 0a 09 09 20 20 20 28 63 6f  t '()))...   (co
1bc0: 6e 64 0a 09 09 20 20 20 20 28 28 6e 75 6c 6c 3f  nd...    ((null?
1bd0: 20 65 6c 65 6d 73 29 20 0a 09 09 20 20 20 20 20   elems) ...     
1be0: 28 69 66 20 28 6e 75 6c 6c 3f 20 77 6f 72 6b 6c  (if (null? workl
1bf0: 69 73 74 29 20 27 28 29 0a 09 09 09 20 28 70 72  ist) '().... (pr
1c00: 65 2d 70 6f 73 74 2d 6f 72 64 65 72 20 77 6f 72  e-post-order wor
1c10: 6b 6c 69 73 74 20 73 65 61 72 63 68 2d 72 75 6c  klist search-rul
1c20: 65 73 29 29 29 0a 09 09 20 20 20 20 28 28 6e 6f  es)))...    ((no
1c30: 74 20 28 70 61 69 72 3f 20 28 63 61 72 20 65 6c  t (pair? (car el
1c40: 65 6d 73 29 29 29 20 28 6c 6f 6f 70 20 28 63 64  ems))) (loop (cd
1c50: 72 20 65 6c 65 6d 73 29 20 77 6f 72 6b 6c 69 73  r elems) worklis
1c60: 74 29 29 0a 09 09 20 20 20 20 28 28 65 71 3f 20  t))...    ((eq? 
1c70: 27 48 65 61 64 65 72 20 28 63 61 61 72 20 65 6c  'Header (caar el
1c80: 65 6d 73 29 29 20 28 63 61 72 20 65 6c 65 6d 73  ems)) (car elems
1c90: 29 29 20 3b 20 66 6f 75 6e 64 0a 09 09 20 20 20  )) ; found...   
1ca0: 20 28 65 6c 73 65 20 28 6c 6f 6f 70 20 28 63 64   (else (loop (cd
1cb0: 72 20 65 6c 65 6d 73 29 20 28 63 6f 6e 73 20 28  r elems) (cons (
1cc0: 63 61 72 20 65 6c 65 6d 73 29 20 77 6f 72 6b 6c  car elems) workl
1cd0: 69 73 74 29 29 29 29 29 29 29 0a 09 20 20 20 29  ist)))))))..   )
1ce0: 29 29 0a 20 20 20 20 28 6c 6f 6f 6b 75 70 2d 64  )).    (lookup-d
1cf0: 65 66 20 27 48 65 61 64 65 72 0a 09 09 28 6c 69  ef 'Header...(li
1d00: 73 74 20 28 70 72 65 2d 70 6f 73 74 2d 6f 72 64  st (pre-post-ord
1d10: 65 72 20 43 6f 6e 74 65 6e 74 20 73 65 61 72 63  er Content searc
1d20: 68 2d 72 75 6c 65 73 29 29 0a 09 09 29 29 29 0a  h-rules))...))).
1d30: 0a 0a 3b 20 54 72 61 6e 73 66 6f 72 6d 61 74 69  ..; Transformati
1d40: 6f 6e 20 72 75 6c 65 73 20 74 68 61 74 20 64 65  on rules that de
1d50: 66 69 6e 65 20 61 20 6e 75 6d 62 65 72 20 6f 66  fine a number of
1d60: 20 68 69 67 68 65 72 2d 6f 72 64 65 72 20 74 61   higher-order ta
1d70: 67 73 2c 0a 3b 20 77 68 69 63 68 20 67 69 76 65  gs,.; which give
1d80: 20 22 73 74 79 6c 65 22 20 74 6f 20 61 6c 6c 20   "style" to all 
1d90: 6d 79 20 70 61 67 65 73 2e 0a 3b 20 53 6f 6d 65  my pages..; Some
1da0: 20 6f 66 20 74 68 65 73 65 20 72 75 6c 65 73 20   of these rules 
1db0: 72 65 71 75 69 72 65 20 61 20 70 72 65 2d 70 6f  require a pre-po
1dc0: 73 74 2d 6f 72 64 65 72 20 69 74 65 72 61 74 6f  st-order iterato
1dd0: 72 0a 3b 20 53 65 65 20 78 6d 6c 2e 73 63 6d 20  r.; See xml.scm 
1de0: 6f 72 20 61 6e 79 20 6f 74 68 65 72 20 6f 66 20  or any other of 
1df0: 6d 79 20 77 65 62 20 70 61 67 65 20 6d 61 73 74  my web page mast
1e00: 65 72 20 66 69 6c 65 73 20 66 6f 72 20 61 6e 20  er files for an 
1e10: 65 78 61 6d 70 6c 65 0a 3b 20 6f 66 20 75 73 69  example.; of usi
1e20: 6e 67 20 74 68 65 73 65 20 73 74 79 6c 65 73 68  ng these stylesh
1e30: 65 65 74 20 72 75 6c 65 73 0a 0a 28 64 65 66 69  eet rules..(defi
1e40: 6e 65 20 28 67 65 6e 65 72 69 63 2d 77 65 62 2d  ne (generic-web-
1e50: 72 75 6c 65 73 20 43 6f 6e 74 65 6e 74 20 61 64  rules Content ad
1e60: 64 69 74 69 6f 6e 61 6c 2d 72 75 6c 65 73 29 0a  ditional-rules).
1e70: 20 20 28 61 70 70 65 6e 64 0a 20 20 20 61 64 64    (append.   add
1e80: 69 74 69 6f 6e 61 6c 2d 72 75 6c 65 73 0a 20 20  itional-rules.  
1e90: 20 75 6e 69 76 65 72 73 61 6c 2d 63 6f 6e 76 65   universal-conve
1ea0: 72 73 69 6f 6e 2d 72 75 6c 65 73 0a 20 20 20 60  rsion-rules.   `
1eb0: 28 28 68 74 6d 6c 3a 62 65 67 69 6e 20 0a 20 20  ((html:begin .  
1ec0: 20 20 20 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28      . ,(lambda (
1ed0: 74 61 67 20 2e 20 65 6c 65 6d 73 29 0a 09 20 20  tag . elems)..  
1ee0: 20 28 6c 69 73 74 0a 09 20 20 20 20 20 22 3c 21   (list..     "<!
1ef0: 44 4f 43 54 59 50 45 20 48 54 4d 4c 20 50 55 42  DOCTYPE HTML PUB
1f00: 4c 49 43 20 5c 22 2d 2f 2f 57 33 43 2f 2f 44 54  LIC \"-//W3C//DT
1f10: 44 20 48 54 4d 4c 20 34 2e 30 31 20 54 72 61 6e  D HTML 4.01 Tran
1f20: 73 69 74 69 6f 6e 61 6c 2f 2f 45 4e 5c 22 22 0a  sitional//EN\"".
1f30: 09 20 20 20 20 20 6e 6c 20 0a 09 20 20 20 20 20  .     nl ..     
1f40: 22 5c 22 68 74 74 70 3a 2f 2f 77 77 77 2e 77 33  "\"http://www.w3
1f50: 2e 6f 72 67 2f 54 52 2f 68 74 6d 6c 34 2f 6c 6f  .org/TR/html4/lo
1f60: 6f 73 65 2e 64 74 64 5c 22 3e 22 20 6e 6c 0a 09  ose.dtd\">" nl..
1f70: 20 20 20 20 20 22 3c 68 74 6d 6c 3e 22 20 6e 6c       "<html>" nl
1f80: 0a 09 20 20 20 20 20 65 6c 65 6d 73 0a 09 20 20  ..     elems..  
1f90: 20 20 20 22 3c 2f 68 74 6d 6c 3e 22 20 6e 6c 29     "</html>" nl)
1fa0: 29 29 0a 0a 20 20 20 20 20 28 48 65 61 64 65 72  ))..     (Header
1fb0: 0a 20 20 20 20 20 20 2a 70 72 65 6f 72 64 65 72  .      *preorder
1fc0: 2a 0a 20 20 20 20 20 20 2e 20 2c 28 6c 61 6d 62  *.      . ,(lamb
1fd0: 64 61 20 28 74 61 67 20 2e 20 68 65 61 64 65 72  da (tag . header
1fe0: 73 29 0a 09 20 20 20 28 70 6f 73 74 2d 6f 72 64  s)..   (post-ord
1ff0: 65 72 20 28 6d 61 6b 65 2d 68 65 61 64 65 72 20  er (make-header 
2000: 68 65 61 64 65 72 73 29 20 75 6e 69 76 65 72 73  headers) univers
2010: 61 6c 2d 63 6f 6e 76 65 72 73 69 6f 6e 2d 72 75  al-conversion-ru
2020: 6c 65 73 29 0a 09 20 20 20 29 29 0a 0a 20 20 20  les)..   ))..   
2030: 20 20 28 62 6f 64 79 0a 20 20 20 20 20 20 2e 20    (body.      . 
2040: 2c 28 6c 61 6d 62 64 61 20 28 74 61 67 20 2e 20  ,(lambda (tag . 
2050: 65 6c 65 6d 73 29 0a 09 20 20 20 28 6c 69 73 74  elems)..   (list
2060: 20 22 3c 62 6f 64 79 20 62 67 63 6f 6c 6f 72 3d   "<body bgcolor=
2070: 5c 22 23 46 46 46 46 46 46 5c 22 3e 22 20 6e 6c  \"#FFFFFF\">" nl
2080: 20 65 6c 65 6d 73 20 22 3c 2f 62 6f 64 79 3e 22   elems "</body>"
2090: 29 29 29 0a 0a 20 20 20 20 20 28 6e 61 76 62 61  )))..     (navba
20a0: 72 09 09 09 3b 20 46 69 6e 64 20 74 68 65 20 48  r...; Find the H
20b0: 65 61 64 65 72 20 69 6e 20 74 68 65 20 43 6f 6e  eader in the Con
20c0: 74 65 6e 74 0a 20 20 20 20 20 20 2e 20 2c 28 6c  tent.      . ,(l
20d0: 61 6d 62 64 61 20 28 74 61 67 29 09 09 3b 20 61  ambda (tag)..; a
20e0: 6e 64 20 63 72 65 61 74 65 20 74 68 65 20 6e 61  nd create the na
20f0: 76 69 67 61 74 69 6f 6e 20 62 61 72 0a 09 20 20  vigation bar..  
2100: 20 28 6c 65 74 20 28 28 68 65 61 64 65 72 2d 70   (let ((header-p
2110: 61 72 6d 73 20 28 66 69 6e 64 2d 48 65 61 64 65  arms (find-Heade
2120: 72 20 43 6f 6e 74 65 6e 74 29 29 29 0a 09 20 20  r Content)))..  
2130: 20 20 20 28 70 6f 73 74 2d 6f 72 64 65 72 20 28     (post-order (
2140: 6d 61 6b 65 2d 6e 61 76 62 61 72 20 68 65 61 64  make-navbar head
2150: 65 72 2d 70 61 72 6d 73 29 0a 09 09 09 20 75 6e  er-parms).... un
2160: 69 76 65 72 73 61 6c 2d 63 6f 6e 76 65 72 73 69  iversal-conversi
2170: 6f 6e 2d 72 75 6c 65 73 29 29 29 29 0a 20 20 20  on-rules)))).   
2180: 20 20 0a 20 20 20 20 20 28 66 6f 6f 74 65 72 09    .     (footer.
2190: 09 09 3b 20 46 69 6e 64 20 74 68 65 20 48 65 61  ..; Find the Hea
21a0: 64 65 72 20 69 6e 20 74 68 65 20 43 6f 6e 74 65  der in the Conte
21b0: 6e 74 0a 20 20 20 20 20 20 2e 20 2c 28 6c 61 6d  nt.      . ,(lam
21c0: 62 64 61 20 28 74 61 67 29 09 09 3b 20 61 6e 64  bda (tag)..; and
21d0: 20 63 72 65 61 74 65 20 74 68 65 20 66 6f 6f 74   create the foot
21e0: 65 72 20 6f 66 20 74 68 65 20 70 61 67 65 0a 09  er of the page..
21f0: 20 20 20 28 6c 65 74 20 28 28 68 65 61 64 65 72     (let ((header
2200: 2d 70 61 72 6d 73 20 28 66 69 6e 64 2d 48 65 61  -parms (find-Hea
2210: 64 65 72 20 43 6f 6e 74 65 6e 74 29 29 29 0a 09  der Content)))..
2220: 20 20 20 20 20 28 70 6f 73 74 2d 6f 72 64 65 72       (post-order
2230: 20 28 6d 61 6b 65 2d 66 6f 6f 74 65 72 20 68 65   (make-footer he
2240: 61 64 65 72 2d 70 61 72 6d 73 29 0a 09 09 09 20  ader-parms).... 
2250: 75 6e 69 76 65 72 73 61 6c 2d 63 6f 6e 76 65 72  universal-conver
2260: 73 69 6f 6e 2d 72 75 6c 65 73 29 29 29 29 0a 20  sion-rules)))). 
2270: 20 20 20 20 0a 20 20 20 20 20 28 70 61 67 65 2d      .     (page-
2280: 74 69 74 6c 65 09 09 3b 20 46 69 6e 64 20 74 68  title..; Find th
2290: 65 20 48 65 61 64 65 72 20 69 6e 20 74 68 65 20  e Header in the 
22a0: 43 6f 6e 74 65 6e 74 0a 20 20 20 20 20 20 2e 20  Content.      . 
22b0: 2c 28 6c 61 6d 62 64 61 20 28 74 61 67 29 09 09  ,(lambda (tag)..
22c0: 3b 20 61 6e 64 20 63 72 65 61 74 65 20 74 68 65  ; and create the
22d0: 20 70 61 67 65 20 74 69 74 6c 65 20 72 75 6c 65   page title rule
22e0: 0a 09 20 20 20 28 6c 65 74 20 28 28 68 65 61 64  ..   (let ((head
22f0: 65 72 2d 70 61 72 6d 73 20 28 66 69 6e 64 2d 48  er-parms (find-H
2300: 65 61 64 65 72 20 43 6f 6e 74 65 6e 74 29 29 29  eader Content)))
2310: 0a 09 20 20 20 20 20 28 6c 69 73 74 20 22 3c 68  ..     (list "<h
2320: 31 20 61 6c 69 67 6e 3d 63 65 6e 74 65 72 3e 22  1 align=center>"
2330: 20 0a 09 09 20 20 20 28 6c 6f 6f 6b 75 70 2d 64   ...   (lookup-d
2340: 65 66 20 27 6c 6f 6e 67 2d 74 69 74 6c 65 20 68  ef 'long-title h
2350: 65 61 64 65 72 2d 70 61 72 6d 73 29 20 22 3c 2f  eader-parms) "</
2360: 68 31 3e 22 20 6e 6c 29 29 29 29 0a 0a 0a 20 20  h1>" nl))))...  
2370: 20 20 20 28 53 65 63 74 69 6f 6e 09 3b 20 28 53     (Section.; (S
2380: 65 63 74 69 6f 6e 20 6c 65 76 65 6c 20 22 63 6f  ection level "co
2390: 6e 74 65 6e 74 20 2e 2e 2e 22 29 0a 20 20 20 20  ntent ...").    
23a0: 20 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74 61    . ,(lambda (ta
23b0: 67 20 6c 65 76 65 6c 20 68 65 61 64 2d 77 6f 72  g level head-wor
23c0: 64 20 2e 20 65 6c 65 6d 73 29 0a 09 20 20 20 28  d . elems)..   (
23d0: 6c 69 73 74 20 22 3c 62 72 3e 26 6e 62 73 70 3b  list "<br>&nbsp;
23e0: 3c 61 20 6e 61 6d 65 3d 5c 22 22 20 68 65 61 64  <a name=\"" head
23f0: 2d 77 6f 72 64 20 22 5c 22 3e 26 6e 62 73 70 3b  -word "\">&nbsp;
2400: 3c 2f 61 3e 22 20 6e 6c 0a 09 09 20 22 3c 68 22  </a>" nl... "<h"
2410: 20 6c 65 76 65 6c 20 22 3e 22 20 20 68 65 61 64   level ">"  head
2420: 2d 77 6f 72 64 20 65 6c 65 6d 73 20 22 3c 2f 68  -word elems "</h
2430: 22 20 6c 65 76 65 6c 20 22 3e 22 20 6e 6c 29 29  " level ">" nl))
2440: 29 0a 0a 20 20 20 20 20 28 54 4f 43 09 3b 20 52  )..     (TOC.; R
2450: 65 2d 73 63 61 6e 20 74 68 65 20 43 6f 6e 74 65  e-scan the Conte
2460: 6e 74 20 66 6f 72 20 22 53 65 63 74 69 6f 6e 22  nt for "Section"
2470: 20 74 61 67 73 20 61 6e 64 20 67 65 6e 65 72 61   tags and genera
2480: 74 65 0a 20 20 20 20 20 20 2e 20 2c 28 6c 61 6d  te.      . ,(lam
2490: 62 64 61 20 28 74 61 67 29 09 3b 20 74 68 65 20  bda (tag).; the 
24a0: 48 69 65 72 61 72 63 68 69 63 61 6c 20 54 61 62  Hierarchical Tab
24b0: 6c 65 20 6f 66 20 63 6f 6e 74 65 6e 74 73 0a 09  le of contents..
24c0: 20 20 20 28 6c 65 74 20 28 28 73 65 63 74 69 6f     (let ((sectio
24d0: 6e 73 0a 09 09 20 20 28 70 6f 73 74 2d 6f 72 64  ns...  (post-ord
24e0: 65 72 20 43 6f 6e 74 65 6e 74 0a 09 09 20 20 20  er Content...   
24f0: 20 60 28 28 53 65 63 74 69 6f 6e 09 3b 20 28 53   `((Section.; (S
2500: 65 63 74 69 6f 6e 20 6c 65 76 65 6c 20 22 63 6f  ection level "co
2510: 6e 74 65 6e 74 20 2e 2e 2e 22 29 0a 09 09 20 20  ntent ...")...  
2520: 20 20 20 20 20 28 28 2a 74 65 78 74 2a 20 2e 20       ((*text* . 
2530: 2c 28 6c 61 6d 62 64 61 20 28 74 61 67 20 73 74  ,(lambda (tag st
2540: 72 29 20 73 74 72 29 29 29 0a 09 09 20 20 20 20  r) str)))...    
2550: 20 20 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74     . ,(lambda (t
2560: 61 67 20 6c 65 76 65 6c 20 68 65 61 64 2d 77 6f  ag level head-wo
2570: 72 64 20 2e 20 65 6c 65 6d 73 29 0a 09 09 09 20  rd . elems).... 
2580: 20 20 20 28 76 65 63 74 6f 72 20 6c 65 76 65 6c     (vector level
2590: 0a 09 09 09 09 20 20 20 20 28 6c 69 73 74 20 22  .....    (list "
25a0: 3c 6c 69 3e 3c 61 20 68 72 65 66 3d 5c 22 23 22  <li><a href=\"#"
25b0: 20 68 65 61 64 2d 77 6f 72 64 0a 09 09 09 09 09   head-word......
25c0: 20 20 22 5c 22 3e 22 20 68 65 61 64 2d 77 6f 72    "\">" head-wor
25d0: 64 20 65 6c 65 6d 73 20 22 3c 2f 61 3e 22 20 6e  d elems "</a>" n
25e0: 6c 29 29 29 29 0a 09 09 20 20 20 20 20 20 28 2a  l))))...      (*
25f0: 64 65 66 61 75 6c 74 2a 0a 09 09 20 20 20 20 20  default*...     
2600: 20 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28 61 74    . ,(lambda (at
2610: 74 72 2d 6b 65 79 20 2e 20 65 6c 65 6d 73 29 20  tr-key . elems) 
2620: 65 6c 65 6d 73 29 29 0a 09 09 20 20 20 20 20 20  elems))...      
2630: 28 2a 74 65 78 74 2a 20 2e 20 2c 28 6c 61 6d 62  (*text* . ,(lamb
2640: 64 61 20 28 74 72 69 67 67 65 72 20 73 74 72 29  da (trigger str)
2650: 20 27 28 29 29 29 29 29 29 29 0a 09 20 20 20 20   '()))))))..    
2660: 20 3b 28 63 65 72 72 20 73 65 63 74 69 6f 6e 73   ;(cerr sections
2670: 29 0a 09 20 20 20 20 20 28 6c 69 73 74 20 22 3c  )..     (list "<
2680: 64 69 76 3e 22 0a 09 20 20 20 20 20 20 28 6c 65  div>"..      (le
2690: 74 20 6c 6f 6f 70 20 28 28 63 75 72 72 2d 6c 65  t loop ((curr-le
26a0: 76 65 6c 20 31 29 20 28 73 65 63 74 69 6f 6e 73  vel 1) (sections
26b0: 20 73 65 63 74 69 6f 6e 73 29 29 0a 09 20 20 20   sections))..   
26c0: 20 20 20 20 28 63 6f 6e 64 0a 09 09 28 28 6e 75      (cond...((nu
26d0: 6c 6c 3f 20 73 65 63 74 69 6f 6e 73 29 0a 09 09  ll? sections)...
26e0: 20 28 6c 65 74 20 66 69 6c 6c 20 28 28 63 75 72   (let fill ((cur
26f0: 72 2d 6c 65 76 65 6c 20 63 75 72 72 2d 6c 65 76  r-level curr-lev
2700: 65 6c 29 29 0a 09 09 20 20 20 28 69 66 20 28 3e  el))...   (if (>
2710: 20 63 75 72 72 2d 6c 65 76 65 6c 20 31 29 0a 09   curr-level 1)..
2720: 09 20 20 20 20 20 20 20 28 63 6f 6e 73 20 22 3c  .       (cons "<
2730: 2f 6f 6c 3e 22 20 28 66 69 6c 6c 20 28 64 65 63  /ol>" (fill (dec
2740: 20 63 75 72 72 2d 6c 65 76 65 6c 29 29 29 0a 09   curr-level)))..
2750: 09 20 20 20 20 20 20 20 27 28 29 29 29 29 0a 09  .       '())))..
2760: 09 28 28 6e 75 6c 6c 3f 20 28 63 61 72 20 73 65  .((null? (car se
2770: 63 74 69 6f 6e 73 29 29 20 28 6c 6f 6f 70 20 63  ctions)) (loop c
2780: 75 72 72 2d 6c 65 76 65 6c 20 28 63 64 72 20 73  urr-level (cdr s
2790: 65 63 74 69 6f 6e 73 29 29 29 0a 09 09 28 28 70  ections)))...((p
27a0: 61 69 72 3f 20 28 63 61 72 20 73 65 63 74 69 6f  air? (car sectio
27b0: 6e 73 29 29 20 28 6c 6f 6f 70 20 63 75 72 72 2d  ns)) (loop curr-
27c0: 6c 65 76 65 6c 0a 09 09 09 09 09 20 20 20 20 20  level......     
27d0: 20 28 61 70 70 65 6e 64 20 28 63 61 72 20 73 65   (append (car se
27e0: 63 74 69 6f 6e 73 29 0a 09 09 09 09 09 09 20 20  ctions).......  
27f0: 20 20 20 20 28 63 64 72 20 73 65 63 74 69 6f 6e      (cdr section
2800: 73 29 29 29 29 0a 09 09 28 28 76 65 63 74 6f 72  s))))...((vector
2810: 3f 20 28 63 61 72 20 73 65 63 74 69 6f 6e 73 29  ? (car sections)
2820: 29 0a 09 09 20 28 6c 65 74 20 28 28 6e 65 77 2d  )... (let ((new-
2830: 6c 65 76 65 6c 20 28 76 65 63 74 6f 72 2d 72 65  level (vector-re
2840: 66 20 28 63 61 72 20 73 65 63 74 69 6f 6e 73 29  f (car sections)
2850: 20 30 29 29 29 0a 09 09 20 20 20 28 63 6f 6e 64   0)))...   (cond
2860: 0a 09 09 20 20 20 20 28 28 3d 20 6e 65 77 2d 6c  ...    ((= new-l
2870: 65 76 65 6c 20 63 75 72 72 2d 6c 65 76 65 6c 29  evel curr-level)
2880: 0a 09 09 20 20 20 20 20 28 63 6f 6e 73 20 28 76  ...     (cons (v
2890: 65 63 74 6f 72 2d 72 65 66 20 28 63 61 72 20 73  ector-ref (car s
28a0: 65 63 74 69 6f 6e 73 29 20 31 29 0a 09 09 09 20  ections) 1).... 
28b0: 20 20 28 6c 6f 6f 70 20 63 75 72 72 2d 6c 65 76    (loop curr-lev
28c0: 65 6c 20 28 63 64 72 20 73 65 63 74 69 6f 6e 73  el (cdr sections
28d0: 29 29 29 29 0a 09 09 20 20 20 20 28 28 3d 20 28  ))))...    ((= (
28e0: 69 6e 63 20 6e 65 77 2d 6c 65 76 65 6c 29 20 63  inc new-level) c
28f0: 75 72 72 2d 6c 65 76 65 6c 29 0a 09 09 20 20 20  urr-level)...   
2900: 20 20 28 63 6f 6e 73 20 22 3c 2f 6f 6c 3e 22 0a    (cons "</ol>".
2910: 09 09 09 20 20 20 28 63 6f 6e 73 20 28 76 65 63  ...   (cons (vec
2920: 74 6f 72 2d 72 65 66 20 28 63 61 72 20 73 65 63  tor-ref (car sec
2930: 74 69 6f 6e 73 29 20 31 29 0a 09 09 09 09 20 28  tions) 1)..... (
2940: 6c 6f 6f 70 20 6e 65 77 2d 6c 65 76 65 6c 20 28  loop new-level (
2950: 63 64 72 20 73 65 63 74 69 6f 6e 73 29 29 29 29  cdr sections))))
2960: 29 0a 09 09 20 20 20 20 28 28 3d 20 6e 65 77 2d  )...    ((= new-
2970: 6c 65 76 65 6c 20 28 69 6e 63 20 63 75 72 72 2d  level (inc curr-
2980: 6c 65 76 65 6c 29 29 0a 09 09 20 20 20 20 20 28  level))...     (
2990: 63 6f 6e 73 20 6e 6c 20 28 63 6f 6e 73 20 22 3c  cons nl (cons "<
29a0: 6f 6c 3e 22 0a 09 09 09 20 20 20 28 63 6f 6e 73  ol>"....   (cons
29b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 28 63 61   (vector-ref (ca
29c0: 72 20 73 65 63 74 69 6f 6e 73 29 20 31 29 0a 09  r sections) 1)..
29d0: 09 09 09 20 28 6c 6f 6f 70 20 6e 65 77 2d 6c 65  ... (loop new-le
29e0: 76 65 6c 20 28 63 64 72 20 73 65 63 74 69 6f 6e  vel (cdr section
29f0: 73 29 29 29 29 29 29 0a 09 09 20 20 20 20 28 65  s))))))...    (e
2a00: 6c 73 65 20 0a 09 09 20 20 20 20 20 28 65 72 72  lse ...     (err
2a10: 6f 72 20 22 69 6e 63 6f 6e 73 69 73 74 65 6e 74  or "inconsistent
2a20: 20 6c 65 76 65 6c 73 3a 20 22 20 63 75 72 72 2d   levels: " curr-
2a30: 6c 65 76 65 6c 20 6e 65 77 2d 6c 65 76 65 6c 29  level new-level)
2a40: 29 29 29 29 0a 09 09 28 65 6c 73 65 20 22 77 72  ))))...(else "wr
2a50: 6f 6e 67 20 69 74 65 6d 3a 20 22 20 73 65 63 74  ong item: " sect
2a60: 69 6f 6e 73 29 29 29 0a 09 20 20 20 20 20 20 6e  ions)))..      n
2a70: 6c 20 22 3c 2f 64 69 76 3e 22 20 6e 6c 29 29 29  l "</div>" nl)))
2a80: 29 0a 0a 20 20 20 20 20 28 62 69 62 69 74 65 6d  )..     (bibitem
2a90: 20 2a 6d 61 63 72 6f 2a 0a 20 20 20 20 20 20 20   *macro*.       
2aa0: 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74 61 67 20  . ,(lambda (tag 
2ab0: 6c 61 62 65 6c 20 6b 65 79 20 2e 20 74 65 78 74  label key . text
2ac0: 29 0a 09 20 20 20 60 28 70 20 28 61 20 28 40 20  )..   `(p (a (@ 
2ad0: 28 6e 61 6d 65 20 2c 6b 65 79 29 29 20 22 5b 22  (name ,key)) "["
2ae0: 20 2c 6c 61 62 65 6c 20 22 5d 22 29 20 22 20 22   ,label "]") " "
2af0: 20 2c 74 65 78 74 29 29 29 0a 0a 20 20 20 20 20   ,text)))..     
2b00: 28 63 69 74 65 09 09 3b 20 6f 75 67 68 74 20 74  (cite..; ought t
2b10: 6f 20 6c 6f 63 61 74 65 20 74 68 65 20 6c 61 62  o locate the lab
2b20: 65 6c 20 61 6e 64 20 75 73 65 20 74 68 65 20 6c  el and use the l
2b30: 61 62 65 6c 21 0a 20 20 20 20 20 20 2e 20 2c 28  abel!.      . ,(
2b40: 6c 61 6d 62 64 61 20 28 74 61 67 20 6b 65 79 29  lambda (tag key)
2b50: 0a 09 20 20 20 28 6c 69 73 74 20 22 5b 3c 61 20  ..   (list "[<a 
2b60: 68 72 65 66 3d 5c 22 23 22 20 6b 65 79 20 22 5c  href=\"#" key "\
2b70: 22 3e 22 20 6b 65 79 20 22 3c 2f 61 3e 5d 22 29  ">" key "</a>]")
2b80: 29 29 0a 0a 0a 20 20 20 20 20 28 74 72 61 63 65  ))...     (trace
2b90: 09 09 3b 20 41 20 64 65 62 75 67 67 69 6e 67 20  ..; A debugging 
2ba0: 61 69 64 0a 20 20 20 20 20 20 2e 20 2c 28 6c 61  aid.      . ,(la
2bb0: 6d 62 64 61 20 28 74 61 67 20 2e 20 63 6f 6e 74  mbda (tag . cont
2bc0: 65 6e 74 29 0a 09 20 20 20 28 63 65 72 72 20 74  ent)..   (cerr t
2bd0: 61 67 20 63 6f 6e 74 65 6e 74 20 6e 6c 29 0a 09  ag content nl)..
2be0: 20 20 20 27 28 29 29 29 0a 0a 20 20 20 20 20 28     '()))..     (
2bf0: 55 52 4c 20 20 2a 6d 61 63 72 6f 2a 0a 20 20 20  URL  *macro*.   
2c00: 20 20 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74     . ,(lambda (t
2c10: 61 67 20 75 72 6c 29 0a 09 20 20 20 60 28 28 62  ag url)..   `((b
2c20: 72 29 20 22 3c 22 20 28 61 20 28 40 20 28 68 72  r) "<" (a (@ (hr
2c30: 65 66 20 2c 75 72 6c 29 29 20 2c 75 72 6c 29 20  ef ,url)) ,url) 
2c40: 22 3e 22 29 29 29 0a 0a 0a 20 20 20 20 20 28 76  ">")))...     (v
2c50: 65 72 62 61 74 69 6d 09 3b 20 73 65 74 20 6f 66  erbatim.; set of
2c60: 66 20 70 69 65 63 65 73 20 6f 66 20 63 6f 64 65  f pieces of code
2c70: 3a 20 6f 6e 65 20 6f 72 20 73 65 76 65 72 61 6c  : one or several
2c80: 20 6c 69 6e 65 73 0a 20 20 20 20 20 20 2e 20 2c   lines.      . ,
2c90: 28 6c 61 6d 62 64 61 20 28 74 61 67 20 2e 20 6c  (lambda (tag . l
2ca0: 69 6e 65 73 29 0a 09 20 20 20 28 6c 69 73 74 20  ines)..   (list 
2cb0: 22 3c 70 72 65 3e 22 0a 09 09 20 28 6d 61 70 20  "<pre>"... (map 
2cc0: 28 6c 61 6d 62 64 61 20 28 6c 69 6e 65 29 20 28  (lambda (line) (
2cd0: 6c 69 73 74 20 22 20 20 20 20 20 22 20 6c 69 6e  list "     " lin
2ce0: 65 20 6e 6c 29 29 0a 09 09 20 20 20 20 20 20 6c  e nl))...      l
2cf0: 69 6e 65 73 29 0a 09 09 20 22 3c 2f 70 72 65 3e  ines)... "</pre>
2d00: 22 29 29 29 0a 09 09 3b 20 28 6e 6f 74 65 20 2e  ")))...; (note .
2d10: 20 74 65 78 74 2d 73 74 72 69 6e 67 73 29 0a 09   text-strings)..
2d20: 09 3b 20 41 20 6e 6f 74 65 20 28 72 65 6d 61 72  .; A note (remar
2d30: 6b 29 2c 20 73 69 6d 69 6c 61 72 20 74 6f 20 61  k), similar to a
2d40: 20 66 6f 6f 74 6e 6f 74 65 0a 20 20 20 20 20 28   footnote.     (
2d50: 6e 6f 74 65 0a 20 20 20 20 20 20 2e 20 2c 28 6c  note.      . ,(l
2d60: 61 6d 62 64 61 20 28 74 61 67 20 2e 20 74 65 78  ambda (tag . tex
2d70: 74 2d 73 74 72 69 6e 67 73 29 0a 09 20 20 20 28  t-strings)..   (
2d80: 6c 69 73 74 20 22 20 3c 66 6f 6e 74 20 73 69 7a  list " <font siz
2d90: 65 3d 5c 22 2d 31 5c 22 3e 5b 22 20 74 65 78 74  e=\"-1\">[" text
2da0: 2d 73 74 72 69 6e 67 73 20 22 5d 3c 2f 66 6f 6e  -strings "]</fon
2db0: 74 3e 22 20 6e 6c 29 29 29 0a 0a 09 09 3b 20 41  t>" nl)))....; A
2dc0: 20 72 65 66 65 72 65 6e 63 65 20 74 6f 20 61 20   reference to a 
2dd0: 66 69 6c 65 0a 20 20 20 20 20 28 66 69 6c 65 72  file.     (filer
2de0: 65 66 0a 20 20 20 20 20 20 2e 20 2c 28 6c 61 6d  ef.      . ,(lam
2df0: 62 64 61 20 28 74 61 67 20 70 61 74 68 6e 61 6d  bda (tag pathnam
2e00: 65 20 2e 20 64 65 73 63 72 2d 74 65 78 74 29 0a  e . descr-text).
2e10: 09 20 20 20 28 6c 69 73 74 20 22 3c 61 20 68 72  .   (list "<a hr
2e20: 65 66 3d 5c 22 22 20 70 61 74 68 6e 61 6d 65 20  ef=\"" pathname 
2e30: 22 5c 22 3e 22 0a 09 09 20 28 63 61 72 20 28 72  "\">"... (car (r
2e40: 65 76 65 72 73 65 20 28 73 74 72 69 6e 67 2d 73  everse (string-s
2e50: 70 6c 69 74 20 70 61 74 68 6e 61 6d 65 20 23 5c  plit pathname #\
2e60: 2f 29 29 29 0a 09 09 20 22 3c 2f 61 3e 20 5b 22  /)))... "</a> ["
2e70: 20 0a 09 09 20 28 6c 65 74 20 28 28 66 69 6c 65   ... (let ((file
2e80: 2d 73 69 7a 65 20 28 4f 53 3a 66 69 6c 65 2d 6c  -size (OS:file-l
2e90: 65 6e 67 74 68 20 70 61 74 68 6e 61 6d 65 29 29  ength pathname))
2ea0: 29 0a 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20  )...   (if (not 
2eb0: 28 70 6f 73 69 74 69 76 65 3f 20 66 69 6c 65 2d  (positive? file-
2ec0: 73 69 7a 65 29 29 0a 09 09 20 20 20 20 20 20 20  size))...       
2ed0: 28 65 72 72 6f 72 20 22 46 69 6c 65 20 6e 6f 74  (error "File not
2ee0: 20 66 6f 75 6e 64 3a 20 22 20 70 61 74 68 6e 61   found: " pathna
2ef0: 6d 65 29 29 0a 09 09 20 20 20 28 63 6f 6e 64 0a  me))...   (cond.
2f00: 09 09 20 20 20 20 28 28 3c 20 66 69 6c 65 2d 73  ..    ((< file-s
2f10: 69 7a 65 20 31 30 32 34 29 20 22 26 6c 74 3b 31  ize 1024) "&lt;1
2f20: 4b 22 29 0a 09 09 20 20 20 20 28 65 6c 73 65 20  K")...    (else 
2f30: 28 6c 69 73 74 20 28 71 75 6f 74 69 65 6e 74 20  (list (quotient 
2f40: 28 2b 20 66 69 6c 65 2d 73 69 7a 65 20 31 30 32  (+ file-size 102
2f50: 33 29 20 31 30 32 34 29 20 22 4b 22 29 29 29 29  3) 1024) "K"))))
2f60: 0a 09 09 20 22 5d 3c 62 72 3e 22 0a 09 09 20 64  ... "]<br>"... d
2f70: 65 73 63 72 2d 74 65 78 74 29 29 29 0a 0a 09 09  escr-text)))....
2f80: 3b 20 41 20 72 65 66 65 72 65 6e 63 65 20 74 6f  ; A reference to
2f90: 20 61 20 70 6c 61 69 6e 2d 74 65 78 74 20 66 69   a plain-text fi
2fa0: 6c 65 20 28 61 72 74 69 63 6c 65 29 0a 20 20 20  le (article).   
2fb0: 20 20 28 74 65 78 74 72 65 66 0a 20 20 20 20 20    (textref.     
2fc0: 20 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74 61    . ,(lambda (ta
2fd0: 67 20 70 61 74 68 6e 61 6d 65 20 74 69 74 6c 65  g pathname title
2fe0: 20 2e 20 64 65 73 63 72 29 0a 09 20 20 20 20 28   . descr)..    (
2ff0: 6c 65 74 20 28 28 66 69 6c 65 2d 73 69 7a 65 20  let ((file-size 
3000: 28 4f 53 3a 66 69 6c 65 2d 6c 65 6e 67 74 68 20  (OS:file-length 
3010: 70 61 74 68 6e 61 6d 65 29 29 29 0a 09 20 20 20  pathname)))..   
3020: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 70 6f 73     (if (not (pos
3030: 69 74 69 76 65 3f 20 66 69 6c 65 2d 73 69 7a 65  itive? file-size
3040: 29 29 0a 09 09 20 20 28 65 72 72 6f 72 20 22 46  ))...  (error "F
3050: 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 3a 20 22  ile not found: "
3060: 20 70 61 74 68 6e 61 6d 65 29 29 0a 09 20 20 20   pathname))..   
3070: 20 20 20 28 6c 69 73 74 20 22 3c 61 20 68 72 65     (list "<a hre
3080: 66 3d 5c 22 22 20 70 61 74 68 6e 61 6d 65 20 22  f=\"" pathname "
3090: 5c 22 3e 22 20 74 69 74 6c 65 0a 09 09 20 20 20  \">" title...   
30a0: 20 22 3c 2f 61 3e 20 3c 66 6f 6e 74 20 73 69 7a   "</a> <font siz
30b0: 65 3d 5c 22 2d 31 5c 22 3e 5b 70 6c 61 69 6e 20  e=\"-1\">[plain 
30c0: 74 65 78 74 20 66 69 6c 65 5d 3c 2f 66 6f 6e 74  text file]</font
30d0: 3e 3c 62 72 3e 22 20 6e 6c 0a 09 09 20 20 20 20  ><br>" nl...    
30e0: 64 65 73 63 72 29 29 29 29 0a 0a 09 09 3b 20 41  descr))))....; A
30f0: 20 72 65 66 65 72 65 6e 63 65 20 74 6f 20 61 6e   reference to an
3100: 20 61 6e 63 68 6f 72 20 69 6e 20 74 68 65 20 70   anchor in the p
3110: 72 65 73 65 6e 74 20 66 69 6c 65 0a 09 09 3b 20  resent file...; 
3120: 28 6c 6f 63 61 6c 2d 72 65 66 20 74 61 72 67 65  (local-ref targe
3130: 74 20 2e 20 74 69 74 6c 65 29 0a 09 09 3b 20 49  t . title)...; I
3140: 66 20 74 69 74 6c 65 20 69 73 20 67 69 76 65 6e  f title is given
3150: 2c 20 67 65 6e 65 72 61 74 65 20 61 20 72 65 67  , generate a reg
3160: 75 6c 61 72 0a 09 09 3b 09 3c 61 20 68 72 65 66  ular...;.<a href
3170: 3d 22 23 74 61 72 67 65 74 22 3e 74 69 74 6c 65  ="#target">title
3180: 3c 2f 61 3e 0a 09 09 3b 20 4f 74 68 65 72 77 69  </a>...; Otherwi
3190: 73 65 2c 20 74 72 61 6e 73 66 6f 72 6d 20 74 68  se, transform th
31a0: 65 20 63 6f 6e 74 65 6e 74 20 73 6f 20 74 68 61  e content so tha
31b0: 74 20 61 0a 09 09 3b 20 63 6f 6e 73 74 72 75 63  t a...; construc
31c0: 74 20 74 68 61 74 20 6d 61 79 20 67 65 6e 65 72  t that may gener
31d0: 61 74 65 20 61 6e 20 61 6e 63 68 6f 72 20 27 74  ate an anchor 't
31e0: 61 72 67 65 74 27 20 28 73 75 63 68 0a 09 09 3b  arget' (such...;
31f0: 20 61 73 20 53 65 63 74 69 6f 6e 20 6f 72 20 44   as Section or D
3200: 65 73 63 72 69 70 74 69 6f 6e 2d 75 6e 69 74 29  escription-unit)
3210: 20 69 73 20 72 65 2d 77 72 69 74 74 65 6e 20 74   is re-written t
3220: 6f 20 74 68 65 0a 09 09 3b 20 74 69 74 6c 65 20  o the...; title 
3230: 53 58 4d 4c 2e 20 41 6c 6c 20 6f 74 68 65 72 20  SXML. All other 
3240: 63 6f 6e 73 74 72 75 63 74 73 20 72 65 2d 77 72  constructs re-wr
3250: 69 74 65 20 74 6f 0a 09 09 3b 20 6e 6f 74 68 69  ite to...; nothi
3260: 6e 67 2e 0a 20 20 20 20 20 28 6c 6f 63 61 6c 2d  ng..     (local-
3270: 72 65 66 0a 20 20 20 20 20 20 2a 6d 61 63 72 6f  ref.      *macro
3280: 2a 0a 20 20 20 20 20 20 2e 20 2c 28 6c 61 6d 62  *.      . ,(lamb
3290: 64 61 20 28 74 61 67 20 74 61 72 67 65 74 20 2e  da (tag target .
32a0: 20 74 69 74 6c 65 29 0a 09 20 20 20 28 6c 65 74   title)..   (let
32b0: 0a 09 20 20 20 20 20 20 20 28 28 74 69 74 6c 65  ..       ((title
32c0: 0a 09 09 20 28 69 66 20 28 70 61 69 72 3f 20 74  ... (if (pair? t
32d0: 69 74 6c 65 29 20 74 69 74 6c 65 09 3b 20 69 74  itle) title.; it
32e0: 20 69 73 20 67 69 76 65 6e 20 65 78 70 6c 69 63   is given explic
32f0: 69 74 6c 79 0a 09 09 20 20 20 20 20 28 70 72 65  itly...     (pre
3300: 2d 70 6f 73 74 2d 6f 72 64 65 72 20 43 6f 6e 74  -post-order Cont
3310: 65 6e 74 0a 09 09 20 20 20 20 20 20 20 60 28 28  ent...       `((
3320: 2a 74 65 78 74 2a 20 2e 20 2c 28 6c 61 6d 62 64  *text* . ,(lambd
3330: 61 20 28 74 72 69 67 67 65 72 20 73 74 72 29 20  a (trigger str) 
3340: 27 28 29 29 29 0a 09 09 09 20 28 2a 64 65 66 61  '())).... (*defa
3350: 75 6c 74 2a 0a 09 09 09 20 20 2e 20 2c 28 6c 61  ult*....  . ,(la
3360: 6d 62 64 61 20 28 74 61 67 20 2e 20 65 6c 65 6d  mbda (tag . elem
3370: 73 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c 65  s)....       (le
3380: 74 20 28 28 66 69 72 73 74 2d 73 69 67 6e 20 28  t ((first-sign (
3390: 73 69 67 6e 69 66 2d 74 61 69 6c 20 65 6c 65 6d  signif-tail elem
33a0: 73 29 29 29 0a 09 09 09 09 20 28 69 66 20 66 69  s)))..... (if fi
33b0: 72 73 74 2d 73 69 67 6e 0a 09 09 09 09 20 20 20  rst-sign.....   
33c0: 20 20 28 6c 65 74 20 28 28 73 65 63 6f 6e 64 2d    (let ((second-
33d0: 73 69 67 6e 0a 09 09 09 09 09 20 20 20 20 28 73  sign......    (s
33e0: 69 67 6e 69 66 2d 74 61 69 6c 20 28 63 64 72 20  ignif-tail (cdr 
33f0: 66 69 72 73 74 2d 73 69 67 6e 29 29 29 29 0a 09  first-sign))))..
3400: 09 09 09 20 20 20 20 20 20 20 28 61 73 73 65 72  ...       (asser
3410: 74 20 28 6e 6f 74 20 73 65 63 6f 6e 64 2d 73 69  t (not second-si
3420: 67 6e 29 29 0a 09 09 09 09 20 20 20 20 20 20 20  gn)).....       
3430: 28 63 61 72 20 66 69 72 73 74 2d 73 69 67 6e 29  (car first-sign)
3440: 29 0a 09 09 09 09 20 20 20 20 20 27 28 29 29 29  ).....     '()))
3450: 29 29 0a 09 09 09 20 28 44 65 73 63 72 69 70 74  )).... (Descript
3460: 69 6f 6e 2d 75 6e 69 74 0a 09 09 09 20 20 2a 70  ion-unit....  *p
3470: 72 65 6f 72 64 65 72 2a 0a 09 09 09 20 20 2e 20  reorder*....  . 
3480: 2c 28 6c 61 6d 62 64 61 20 28 74 61 67 20 6b 65  ,(lambda (tag ke
3490: 79 20 74 69 74 6c 65 20 2e 20 65 6c 65 6d 73 29  y title . elems)
34a0: 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28  ....       (if (
34b0: 65 71 75 61 6c 3f 20 6b 65 79 20 74 61 72 67 65  equal? key targe
34c0: 74 29 0a 09 09 09 09 20 20 20 28 6c 69 73 74 20  t).....   (list 
34d0: 74 69 74 6c 65 29 0a 09 09 09 09 20 20 20 27 28  title).....   '(
34e0: 29 29 29 29 29 29 29 29 29 0a 09 20 20 20 20 20  )))))))))..     
34f0: 28 61 73 73 65 72 74 20 28 70 61 69 72 3f 20 74  (assert (pair? t
3500: 69 74 6c 65 29 29 0a 09 20 20 20 20 20 28 63 65  itle))..     (ce
3510: 72 72 20 22 74 69 74 6c 65 3a 20 22 20 74 69 74  rr "title: " tit
3520: 6c 65 20 6e 6c 29 0a 09 20 20 20 20 20 60 28 61  le nl)..     `(a
3530: 20 28 40 20 28 68 72 65 66 20 23 5c 23 20 2c 74   (@ (href #\# ,t
3540: 61 72 67 65 74 29 29 20 2c 74 69 74 6c 65 29 29  arget)) ,title))
3550: 29 29 0a 0a 09 09 3b 20 55 6e 69 74 20 6f 66 20  ))....; Unit of 
3560: 61 20 64 65 73 63 72 69 70 74 69 6f 6e 20 66 6f  a description fo
3570: 72 20 61 20 70 69 65 63 65 20 6f 66 20 63 6f 64  r a piece of cod
3580: 65 0a 09 09 3b 20 28 44 65 73 63 72 69 70 74 69  e...; (Descripti
3590: 6f 6e 2d 75 6e 69 74 20 6b 65 79 20 74 69 74 6c  on-unit key titl
35a0: 65 20 2e 20 65 6c 65 6d 73 29 0a 09 09 3b 20 77  e . elems)...; w
35b0: 68 65 72 65 20 65 6c 65 6d 73 20 69 73 20 6f 6e  here elems is on
35c0: 65 20 6f 66 20 74 68 65 20 66 6f 6c 6c 6f 77 69  e of the followi
35d0: 6e 67 3a 0a 09 09 3b 20 68 65 61 64 6c 69 6e 65  ng:...; headline
35e0: 2c 20 62 6f 64 79 2c 20 70 6c 61 74 66 6f 72 6d  , body, platform
35f0: 73 2c 20 76 65 72 73 69 6f 6e 0a 20 20 20 20 20  s, version.     
3600: 28 44 65 73 63 72 69 70 74 69 6f 6e 2d 75 6e 69  (Description-uni
3610: 74 0a 20 20 20 20 20 20 28 28 68 65 61 64 6c 69  t.      ((headli
3620: 6e 65 0a 09 2e 20 2c 28 6c 61 6d 62 64 61 20 28  ne... ,(lambda (
3630: 74 61 67 20 2e 20 65 6c 65 6d 73 29 0a 09 20 20  tag . elems)..  
3640: 20 20 20 28 6c 69 73 74 20 22 3c 64 74 3e 22 20     (list "<dt>" 
3650: 65 6c 65 6d 73 20 22 3c 2f 64 74 3e 22 20 6e 6c  elems "</dt>" nl
3660: 29 29 29 0a 20 20 20 20 20 20 20 28 62 6f 64 79  ))).       (body
3670: 0a 09 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74 61  ... ,(lambda (ta
3680: 67 20 2e 20 65 6c 65 6d 73 29 0a 09 20 20 20 20  g . elems)..    
3690: 20 28 6c 69 73 74 20 22 3c 64 64 3e 22 20 65 6c   (list "<dd>" el
36a0: 65 6d 73 20 22 3c 2f 64 64 3e 22 20 6e 6c 29 29  ems "</dd>" nl))
36b0: 29 0a 20 20 20 20 20 20 20 28 70 6c 61 74 66 6f  ).       (platfo
36c0: 72 6d 73 0a 09 2e 20 2c 28 6c 61 6d 62 64 61 20  rms... ,(lambda 
36d0: 28 74 61 67 20 2e 20 65 6c 65 6d 73 29 0a 09 20  (tag . elems).. 
36e0: 20 20 20 20 28 6c 69 73 74 20 22 3c 64 74 3e 3c      (list "<dt><
36f0: 73 74 72 6f 6e 67 3e 50 6c 61 74 66 6f 72 6d 73  strong>Platforms
3700: 3c 2f 73 74 72 6f 6e 67 3e 3c 64 74 3e 3c 64 64  </strong><dt><dd
3710: 3e 22 0a 09 09 20 20 20 65 6c 65 6d 73 20 22 3c  >"...   elems "<
3720: 2f 64 64 3e 22 20 6e 6c 29 29 29 0a 20 20 20 20  /dd>" nl))).    
3730: 20 20 20 28 76 65 72 73 69 6f 6e 0a 09 2e 20 2c     (version... ,
3740: 28 6c 61 6d 62 64 61 20 28 74 61 67 20 2e 20 65  (lambda (tag . e
3750: 6c 65 6d 73 29 0a 09 20 20 20 20 20 28 6c 69 73  lems)..     (lis
3760: 74 20 22 3c 64 74 3e 3c 73 74 72 6f 6e 67 3e 56  t "<dt><strong>V
3770: 65 72 73 69 6f 6e 3c 2f 73 74 72 6f 6e 67 3e 3c  ersion</strong><
3780: 64 74 3e 3c 64 64 3e 22 0a 09 09 20 20 20 22 54  dt><dd>"...   "T
3790: 68 65 20 63 75 72 72 65 6e 74 20 76 65 72 73 69  he current versi
37a0: 6f 6e 20 69 73 20 22 20 65 6c 65 6d 73 20 22 2e  on is " elems ".
37b0: 3c 2f 64 64 3e 22 20 6e 6c 29 29 29 0a 20 20 20  </dd>" nl))).   
37c0: 20 20 20 20 28 6c 69 63 65 6e 73 65 0a 09 2e 20      (license... 
37d0: 2c 28 6c 61 6d 62 64 61 20 28 74 61 67 20 2e 20  ,(lambda (tag . 
37e0: 65 6c 65 6d 73 29 0a 09 20 20 20 20 20 28 6c 69  elems)..     (li
37f0: 73 74 20 22 3c 64 74 3e 3c 73 74 72 6f 6e 67 3e  st "<dt><strong>
3800: 4c 69 63 65 6e 73 65 3c 2f 73 74 72 6f 6e 67 3e  License</strong>
3810: 3c 64 74 3e 3c 64 64 3e 22 0a 09 09 20 20 20 65  <dt><dd>"...   e
3820: 6c 65 6d 73 20 22 3c 2f 64 64 3e 22 20 6e 6c 29  lems "</dd>" nl)
3830: 29 29 0a 20 20 20 20 20 20 20 28 72 65 66 65 72  )).       (refer
3840: 65 6e 63 65 73 0a 09 2e 20 2c 28 6c 61 6d 62 64  ences... ,(lambd
3850: 61 20 28 74 61 67 20 2e 20 65 6c 65 6d 73 29 0a  a (tag . elems).
3860: 09 20 20 20 20 20 28 6c 69 73 74 20 22 3c 64 74  .     (list "<dt
3870: 3e 3c 73 74 72 6f 6e 67 3e 52 65 66 65 72 65 6e  ><strong>Referen
3880: 63 65 73 3c 2f 73 74 72 6f 6e 67 3e 3c 64 74 3e  ces</strong><dt>
3890: 3c 64 64 3e 22 0a 09 09 20 20 20 65 6c 65 6d 73  <dd>"...   elems
38a0: 20 22 3c 2f 64 64 3e 22 20 6e 6c 29 29 29 0a 20   "</dd>" nl))). 
38b0: 20 20 20 20 20 20 28 72 65 71 75 69 72 65 73 0a        (requires.
38c0: 09 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74 61 67  .. ,(lambda (tag
38d0: 20 2e 20 65 6c 65 6d 73 29 0a 09 20 20 20 20 20   . elems)..     
38e0: 28 6c 69 73 74 20 22 3c 64 74 3e 3c 73 74 72 6f  (list "<dt><stro
38f0: 6e 67 3e 52 65 71 75 69 72 65 73 3c 2f 73 74 72  ng>Requires</str
3900: 6f 6e 67 3e 3c 64 74 3e 3c 64 64 3e 22 0a 09 09  ong><dt><dd>"...
3910: 20 20 20 65 6c 65 6d 73 20 22 3c 2f 64 64 3e 22     elems "</dd>"
3920: 20 6e 6c 29 29 29 0a 20 20 20 20 20 20 20 29 0a   nl))).       ).
3930: 20 20 20 20 20 20 2e 20 2c 28 6c 61 6d 62 64 61        . ,(lambda
3940: 20 28 74 61 67 20 6b 65 79 20 74 69 74 6c 65 20   (tag key title 
3950: 2e 20 65 6c 65 6d 73 29 0a 09 20 20 20 28 70 6f  . elems)..   (po
3960: 73 74 2d 6f 72 64 65 72 0a 09 20 20 20 20 60 28  st-order..    `(
3970: 28 61 20 28 40 20 28 6e 61 6d 65 20 2c 6b 65 79  (a (@ (name ,key
3980: 29 29 20 28 6e 5f 29 29 0a 09 20 20 20 20 20 20  )) (n_))..      
3990: 28 68 32 20 2c 74 69 74 6c 65 29 0a 09 20 20 20  (h2 ,title)..   
39a0: 20 20 20 28 64 6c 20 28 69 6e 73 65 72 74 2d 65     (dl (insert-e
39b0: 6c 65 6d 73 29 29 0a 09 20 20 20 20 20 20 29 0a  lems))..      ).
39c0: 09 20 20 20 20 60 28 2c 40 75 6e 69 76 65 72 73  .    `(,@univers
39d0: 61 6c 2d 70 72 6f 74 65 63 74 65 64 2d 72 75 6c  al-protected-rul
39e0: 65 73 0a 09 20 20 20 20 20 20 28 69 6e 73 65 72  es..      (inser
39f0: 74 2d 65 6c 65 6d 73 0a 09 20 20 20 20 20 20 20  t-elems..       
3a00: 2e 20 2c 28 6c 61 6d 62 64 61 20 28 74 61 67 29  . ,(lambda (tag)
3a10: 20 65 6c 65 6d 73 29 29 29 29 29 29 0a 29 29 29   elems)))))).)))
3a20: 0a                                               .