Artifact
35570c8549c5f8956196b42c418fa268d6081cad
File
html/parser.fs
— part of check-in
[79711085be]
at
2019-03-14 22:14:13
on branch trunk
— Improvement on g+ import, limiter for chat text
(user:
bernd
size: 8571)
0000: 5c 20 48 54 4d 4c 20 70 61 72 73 65 72 20 66 6f \ HTML parser fo
0010: 72 20 73 69 6d 70 6c 65 20 48 54 4d 4c 0a 0a 5c r simple HTML..\
0020: 20 43 6f 70 79 72 69 67 68 74 20 28 43 29 20 32 Copyright (C) 2
0030: 30 31 36 20 20 20 42 65 72 6e 64 20 50 61 79 73 016 Bernd Pays
0040: 61 6e 0a 0a 5c 20 54 68 69 73 20 70 72 6f 67 72 an..\ This progr
0050: 61 6d 20 69 73 20 66 72 65 65 20 73 6f 66 74 77 am is free softw
0060: 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 64 are: you can red
0070: 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e 64 istribute it and
0080: 2f 6f 72 20 6d 6f 64 69 66 79 0a 5c 20 69 74 20 /or modify.\ it
0090: 75 6e 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 under the terms
00a0: 6f 66 20 74 68 65 20 47 4e 55 20 41 66 66 65 72 of the GNU Affer
00b0: 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 o General Public
00c0: 20 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c License as publ
00d0: 69 73 68 65 64 20 62 79 0a 5c 20 74 68 65 20 46 ished by.\ the F
00e0: 72 65 65 20 53 6f 66 74 77 61 72 65 20 46 6f 75 ree Software Fou
00f0: 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 65 72 20 ndation, either
0100: 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 74 68 65 version 3 of the
0110: 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a 5c 20 28 License, or.\ (
0120: 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 20 at your option)
0130: 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 6f any later versio
0140: 6e 2e 0a 0a 5c 20 54 68 69 73 20 70 72 6f 67 72 n...\ This progr
0150: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
0160: 64 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74 68 d in the hope th
0170: 61 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75 73 at it will be us
0180: 65 66 75 6c 2c 0a 5c 20 62 75 74 20 57 49 54 48 eful,.\ but WITH
0190: 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 OUT ANY WARRANTY
01a0: 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 ; without even t
01b0: 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72 61 he implied warra
01c0: 6e 74 79 20 6f 66 0a 5c 20 4d 45 52 43 48 41 4e nty of.\ MERCHAN
01d0: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
01e0: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
01f0: 55 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 ULAR PURPOSE. S
0200: 65 65 20 74 68 65 0a 5c 20 47 4e 55 20 41 66 66 ee the.\ GNU Aff
0210: 65 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c ero General Publ
0220: 69 63 20 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d ic License for m
0230: 6f 72 65 20 64 65 74 61 69 6c 73 2e 0a 0a 5c 20 ore details...\
0240: 59 6f 75 20 73 68 6f 75 6c 64 20 68 61 76 65 20 You should have
0250: 72 65 63 65 69 76 65 64 20 61 20 63 6f 70 79 20 received a copy
0260: 6f 66 20 74 68 65 20 47 4e 55 20 41 66 66 65 72 of the GNU Affer
0270: 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 o General Public
0280: 20 4c 69 63 65 6e 73 65 0a 5c 20 61 6c 6f 6e 67 License.\ along
0290: 20 77 69 74 68 20 74 68 69 73 20 70 72 6f 67 72 with this progr
02a0: 61 6d 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 am. If not, see
02b0: 20 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 <http://www.gnu
02c0: 2e 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e .org/licenses/>.
02d0: 0a 0a 44 65 66 65 72 20 68 72 65 66 2d 72 65 70 ..Defer href-rep
02e0: 6c 61 63 65 20 28 20 61 64 64 72 20 75 20 2d 2d lace ( addr u --
02f0: 20 29 20 27 20 74 79 70 65 20 69 73 20 68 72 65 ) ' type is hre
0300: 66 2d 72 65 70 6c 61 63 65 0a 0a 73 22 20 55 6e f-replace..s" Un
0310: 6b 6e 6f 77 6e 20 48 54 4d 4c 20 63 68 61 72 61 known HTML chara
0320: 63 74 65 72 22 20 65 78 63 65 70 74 69 6f 6e 20 cter" exception
0330: 43 6f 6e 73 74 61 6e 74 20 68 74 6d 6c 2d 63 68 Constant html-ch
0340: 61 72 2d 74 68 72 6f 77 0a 73 22 20 55 6e 6b 6e ar-throw.s" Unkn
0350: 6f 77 6e 20 48 54 4d 4c 20 74 61 67 22 20 65 78 own HTML tag" ex
0360: 63 65 70 74 69 6f 6e 20 43 6f 6e 73 74 61 6e 74 ception Constant
0370: 20 68 74 6d 6c 2d 74 68 72 6f 77 0a 0a 73 63 6f html-throw..sco
0380: 70 65 3a 20 68 74 6d 6c 2d 63 68 61 72 73 0a 27 pe: html-chars.'
0390: 26 27 20 63 6f 6e 73 74 61 6e 74 20 61 6d 70 0a &' constant amp.
03a0: 27 3c 27 20 63 6f 6e 73 74 61 6e 74 20 6c 74 0a '<' constant lt.
03b0: 27 3e 27 20 63 6f 6e 73 74 61 6e 74 20 67 74 0a '>' constant gt.
03c0: 27 22 27 20 63 6f 6e 73 74 61 6e 74 20 71 75 6f '"' constant quo
03d0: 74 0a 27 27 27 20 63 6f 6e 73 74 61 6e 74 20 61 t.''' constant a
03e0: 70 6f 73 20 5c 20 66 6f 72 20 58 4d 4c 0a 24 41 pos \ for XML.$A
03f0: 30 20 63 6f 6e 73 74 61 6e 74 20 6e 62 73 70 0a 0 constant nbsp.
0400: 7d 73 63 6f 70 65 0a 0a 24 31 30 20 73 74 61 63 }scope..$10 stac
0410: 6b 3a 20 6f 2d 73 74 61 63 6b 0a 0a 3a 20 73 63 k: o-stack..: sc
0420: 61 6e 2d 76 61 6c 73 20 28 20 77 69 64 20 2d 2d an-vals ( wid --
0430: 20 29 20 74 6f 20 63 6f 6e 66 69 67 2d 77 6c 0a ) to config-wl.
0440: 20 20 20 20 42 45 47 49 4e 20 20 27 3d 27 20 70 BEGIN '=' p
0450: 61 72 73 65 20 62 6c 20 73 6b 69 70 20 64 75 70 arse bl skip dup
0460: 20 20 57 48 49 4c 45 20 20 32 3e 72 0a 09 20 20 WHILE 2>r..
0470: 20 20 70 61 72 73 65 2d 6e 61 6d 65 20 63 6f 6e parse-name con
0480: 66 69 67 2d 72 65 63 6f 67 6e 69 7a 65 72 20 72 fig-recognizer r
0490: 65 63 6f 67 6e 69 7a 65 20 32 72 3e 20 65 76 61 ecognize 2r> eva
04a0: 6c 2d 63 6f 6e 66 69 67 0a 20 20 20 20 52 45 50 l-config. REP
04b0: 45 41 54 20 20 32 64 72 6f 70 20 3b 0a 0a 56 61 EAT 2drop ;..Va
04c0: 72 69 61 62 6c 65 20 6c 69 73 74 2d 63 6c 61 73 riable list-clas
04d0: 73 24 0a 56 61 72 69 61 62 6c 65 20 62 72 24 0a s$.Variable br$.
04e0: 24 31 30 20 73 74 61 63 6b 3a 20 6c 69 73 74 2d $10 stack: list-
04f0: 73 74 61 63 6b 0a 0a 73 63 6f 70 65 3a 20 68 74 stack..scope: ht
0500: 6d 6c 2d 74 61 67 73 0a 3a 20 62 20 20 2e 22 20 ml-tags.: b ."
0510: 2a 2a 22 20 32 64 72 6f 70 20 3b 0a 3a 20 2f 62 **" 2drop ;.: /b
0520: 20 32 64 72 6f 70 0a 20 20 20 20 32 64 75 70 20 2drop. 2dup
0530: 73 22 20 3c 62 3e 22 20 73 74 72 69 6e 67 2d 70 s" <b>" string-p
0540: 72 65 66 69 78 3f 20 49 46 20 20 33 20 2f 73 74 refix? IF 3 /st
0550: 72 69 6e 67 20 20 45 4c 53 45 20 20 2e 22 20 2a ring ELSE ." *
0560: 2a 22 20 20 54 48 45 4e 20 3b 0a 3a 20 69 20 20 *" THEN ;.: i
0570: 27 5f 27 20 65 6d 69 74 20 32 64 72 6f 70 20 3b '_' emit 2drop ;
0580: 0a 3a 20 2f 69 20 32 64 72 6f 70 0a 20 20 20 20 .: /i 2drop.
0590: 32 64 75 70 20 73 22 20 3c 69 3e 22 20 73 74 72 2dup s" <i>" str
05a0: 69 6e 67 2d 70 72 65 66 69 78 3f 20 49 46 20 20 ing-prefix? IF
05b0: 33 20 2f 73 74 72 69 6e 67 20 20 45 4c 53 45 20 3 /string ELSE
05c0: 20 27 5f 27 20 65 6d 69 74 20 20 54 48 45 4e 20 '_' emit THEN
05d0: 3b 0a 3a 20 64 65 6c 20 2e 22 20 7e 7e 22 20 32 ;.: del ." ~~" 2
05e0: 64 72 6f 70 20 3b 0a 3a 20 2f 64 65 6c 20 2e 22 drop ;.: /del ."
05f0: 20 7e 7e 22 20 32 64 72 6f 70 20 3b 0a 3a 20 75 ~~" 2drop ;.: u
0600: 20 2e 22 20 5f 5f 22 20 32 64 72 6f 70 20 3b 20 ." __" 2drop ;
0610: 5c 20 6e 6f 74 20 74 68 65 20 63 6f 6d 6d 6f 6e \ not the common
0620: 20 6d 61 72 6b 64 6f 77 6e 2c 20 74 68 6f 75 67 markdown, thoug
0630: 68 0a 3a 20 2f 75 20 2e 22 20 5f 5f 22 20 32 64 h.: /u ." __" 2d
0640: 72 6f 70 20 3b 0a 0a 3a 20 6f 6c 20 32 64 72 6f rop ;..: ol 2dro
0650: 70 0a 20 20 20 20 6c 69 73 74 2d 63 6c 61 73 73 p. list-class
0660: 24 20 40 20 6c 69 73 74 2d 73 74 61 63 6b 20 3e $ @ list-stack >
0670: 73 74 61 63 6b 0a 20 20 20 20 6c 69 73 74 2d 63 stack. list-c
0680: 6c 61 73 73 24 20 24 40 20 32 64 75 70 20 62 6c lass$ $@ 2dup bl
0690: 20 73 6b 69 70 20 6e 69 70 20 2d 0a 20 20 20 20 skip nip -.
06a0: 6c 69 73 74 2d 63 6c 61 73 73 24 20 6f 66 66 20 list-class$ off
06b0: 6c 69 73 74 2d 63 6c 61 73 73 24 20 24 21 0a 20 list-class$ $!.
06c0: 20 20 20 73 22 20 20 20 31 2e 20 22 20 6c 69 73 s" 1. " lis
06d0: 74 2d 63 6c 61 73 73 24 20 24 2b 21 20 3b 0a 3a t-class$ $+! ;.:
06e0: 20 2f 6f 6c 20 32 64 72 6f 70 20 63 72 0a 20 20 /ol 2drop cr.
06f0: 20 20 6c 69 73 74 2d 63 6c 61 73 73 24 20 24 66 list-class$ $f
0700: 72 65 65 20 6c 69 73 74 2d 73 74 61 63 6b 20 73 ree list-stack s
0710: 74 61 63 6b 3e 20 6c 69 73 74 2d 63 6c 61 73 73 tack> list-class
0720: 24 20 21 0a 20 20 20 20 6c 69 73 74 2d 63 6c 61 $ !. list-cla
0730: 73 73 24 20 24 40 6c 65 6e 20 30 3d 20 49 46 20 ss$ $@len 0= IF
0740: 20 63 72 20 20 54 48 45 4e 20 3b 0a 3a 20 75 6c cr THEN ;.: ul
0750: 20 32 64 72 6f 70 0a 20 20 20 20 6c 69 73 74 2d 2drop. list-
0760: 63 6c 61 73 73 24 20 40 20 6c 69 73 74 2d 73 74 class$ @ list-st
0770: 61 63 6b 20 3e 73 74 61 63 6b 0a 20 20 20 20 6c ack >stack. l
0780: 69 73 74 2d 63 6c 61 73 73 24 20 24 40 20 32 64 ist-class$ $@ 2d
0790: 75 70 20 62 6c 20 73 6b 69 70 20 6e 69 70 20 2d up bl skip nip -
07a0: 0a 20 20 20 20 6c 69 73 74 2d 63 6c 61 73 73 24 . list-class$
07b0: 20 6f 66 66 20 6c 69 73 74 2d 63 6c 61 73 73 24 off list-class$
07c0: 20 24 21 0a 20 20 20 20 73 22 20 20 20 2a 20 22 $!. s" * "
07d0: 20 6c 69 73 74 2d 63 6c 61 73 73 24 20 24 2b 21 list-class$ $+!
07e0: 20 3b 0a 3a 20 2f 75 6c 20 32 64 72 6f 70 20 63 ;.: /ul 2drop c
07f0: 72 0a 20 20 20 20 6c 69 73 74 2d 63 6c 61 73 73 r. list-class
0800: 24 20 24 66 72 65 65 20 6c 69 73 74 2d 73 74 61 $ $free list-sta
0810: 63 6b 20 73 74 61 63 6b 3e 20 6c 69 73 74 2d 63 ck stack> list-c
0820: 6c 61 73 73 24 20 21 0a 20 20 20 20 6c 69 73 74 lass$ !. list
0830: 2d 63 6c 61 73 73 24 20 24 40 6c 65 6e 20 30 3d -class$ $@len 0=
0840: 20 49 46 20 20 63 72 20 20 54 48 45 4e 20 3b 0a IF cr THEN ;.
0850: 3a 20 6c 69 20 32 64 72 6f 70 0a 20 20 20 20 63 : li 2drop. c
0860: 72 20 6c 69 73 74 2d 63 6c 61 73 73 24 20 24 40 r list-class$ $@
0870: 20 32 20 73 61 66 65 2f 73 74 72 69 6e 67 20 74 2 safe/string t
0880: 79 70 65 20 3b 0a 3a 20 2f 6c 69 20 32 64 72 6f ype ;.: /li 2dro
0890: 70 20 3b 0a 3a 20 68 31 20 32 64 72 6f 70 20 2e p ;.: h1 2drop .
08a0: 22 20 23 20 22 20 3b 0a 3a 20 2f 68 31 20 32 64 " # " ;.: /h1 2d
08b0: 72 6f 70 20 2e 22 20 20 23 22 20 63 72 20 63 72 rop ." #" cr cr
08c0: 20 3b 0a 3a 20 68 32 20 32 64 72 6f 70 20 63 72 ;.: h2 2drop cr
08d0: 20 2e 22 20 23 23 20 22 20 3b 0a 3a 20 2f 68 32 ." ## " ;.: /h2
08e0: 20 32 64 72 6f 70 20 2e 22 20 20 23 23 22 20 63 2drop ." ##" c
08f0: 72 20 63 72 20 3b 0a 3a 20 68 33 20 32 64 72 6f r cr ;.: h3 2dro
0900: 70 20 63 72 20 2e 22 20 23 23 23 20 22 20 3b 0a p cr ." ### " ;.
0910: 3a 20 2f 68 33 20 32 64 72 6f 70 20 2e 22 20 20 : /h3 2drop ."
0920: 23 23 23 22 20 63 72 20 63 72 20 3b 0a 0a 3a 20 ###" cr cr ;..:
0930: 62 6c 6f 63 6b 71 75 6f 74 65 20 32 64 72 6f 70 blockquote 2drop
0940: 0a 20 20 20 20 62 72 24 20 24 40 6c 65 6e 20 30 . br$ $@len 0
0950: 3d 20 49 46 20 20 22 5c 5c 5c 6e 22 20 20 62 72 = IF "\\\n" br
0960: 24 20 24 21 20 20 54 48 45 4e 0a 20 20 20 20 22 $ $! THEN. "
0970: 3e 20 22 20 62 72 24 20 24 2b 21 20 62 72 24 20 > " br$ $+! br$
0980: 24 40 20 31 20 2f 73 74 72 69 6e 67 20 74 79 70 $@ 1 /string typ
0990: 65 20 3b 0a 3a 20 2f 62 6c 6f 63 6b 71 75 6f 74 e ;.: /blockquot
09a0: 65 20 32 64 72 6f 70 0a 20 20 20 20 62 72 24 20 e 2drop. br$
09b0: 24 40 6c 65 6e 20 34 20 75 3e 20 49 46 20 20 62 $@len 4 u> IF b
09c0: 72 24 20 32 20 32 20 24 64 65 6c 20 20 45 4c 53 r$ 2 2 $del ELS
09d0: 45 20 20 62 72 24 20 24 66 72 65 65 20 20 54 48 E br$ $free TH
09e0: 45 4e 20 20 63 72 20 63 72 20 3b 0a 0a 6f 62 6a EN cr cr ;..obj
09f0: 65 63 74 20 63 6c 61 73 73 7b 20 61 2d 70 61 72 ect class{ a-par
0a00: 61 6d 73 0a 20 20 20 20 66 69 65 6c 64 3a 20 68 ams. field: h
0a10: 72 65 66 24 0a 20 20 20 20 66 69 65 6c 64 3a 20 ref$. field:
0a20: 72 65 6c 24 0a 20 20 20 20 66 69 65 6c 64 3a 20 rel$. field:
0a30: 63 6c 61 73 73 24 0a 20 20 20 20 66 69 65 6c 64 class$. field
0a40: 3a 20 73 74 79 6c 65 24 0a 20 20 20 20 66 69 65 : style$. fie
0a50: 6c 64 3a 20 69 6d 61 67 65 61 6e 63 68 6f 72 24 ld: imageanchor$
0a60: 0a 20 20 20 20 66 69 65 6c 64 3a 20 74 61 72 67 . field: targ
0a70: 65 74 24 0a 20 20 20 20 66 69 65 6c 64 3a 20 6a et$. field: j
0a80: 73 6c 6f 67 24 0a 20 20 20 20 66 69 65 6c 64 3a slog$. field:
0a90: 20 64 69 72 24 0a 20 20 20 20 66 69 65 6c 64 3a dir$. field:
0aa0: 20 6f 69 64 24 0a 20 20 20 20 66 69 65 6c 64 3a oid$. field:
0ab0: 20 74 79 70 65 24 0a 20 20 20 20 3a 20 64 69 73 type$. : dis
0ac0: 70 6f 73 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 pose ( -- ).
0ad0: 68 72 65 66 24 20 24 66 72 65 65 0a 20 20 20 20 href$ $free.
0ae0: 72 65 6c 24 20 24 66 72 65 65 0a 20 20 20 20 63 rel$ $free. c
0af0: 6c 61 73 73 24 20 24 66 72 65 65 0a 20 20 20 20 lass$ $free.
0b00: 73 74 79 6c 65 24 20 24 66 72 65 65 0a 20 20 20 style$ $free.
0b10: 20 69 6d 61 67 65 61 6e 63 68 6f 72 24 20 24 66 imageanchor$ $f
0b20: 72 65 65 0a 20 20 20 20 74 61 72 67 65 74 24 20 ree. target$
0b30: 24 66 72 65 65 0a 20 20 20 20 6a 73 6c 6f 67 24 $free. jslog$
0b40: 20 24 66 72 65 65 0a 20 20 20 20 64 69 72 24 20 $free. dir$
0b50: 24 66 72 65 65 0a 20 20 20 20 6f 69 64 24 20 24 $free. oid$ $
0b60: 66 72 65 65 0a 20 20 20 20 74 79 70 65 24 20 24 free. type$ $
0b70: 66 72 65 65 0a 20 20 20 20 64 69 73 70 6f 73 65 free. dispose
0b80: 20 3b 0a 7d 63 6c 61 73 73 0a 0a 3a 20 61 20 28 ;.}class..: a (
0b90: 20 2d 2d 20 29 0a 20 20 20 20 61 2d 70 61 72 61 -- ). a-para
0ba0: 6d 73 2d 63 6c 61 73 73 20 6e 65 77 20 3e 6f 20 ms-class new >o
0bb0: 72 3e 20 6f 2d 73 74 61 63 6b 20 3e 73 74 61 63 r> o-stack >stac
0bc0: 6b 0a 20 20 20 20 5b 3a 20 5b 27 5d 20 61 2d 70 k. [: ['] a-p
0bd0: 61 72 61 6d 73 20 3e 62 6f 64 79 20 73 63 61 6e arams >body scan
0be0: 2d 76 61 6c 73 20 3b 5d 20 65 78 65 63 75 74 65 -vals ;] execute
0bf0: 2d 70 61 72 73 69 6e 67 0a 20 20 20 20 61 2d 70 -parsing. a-p
0c00: 61 72 61 6d 73 3a 63 6c 61 73 73 24 20 24 40 20 arams:class$ $@
0c10: 73 22 20 6f 74 2d 68 61 73 68 74 61 67 22 20 73 s" ot-hashtag" s
0c20: 74 72 69 6e 67 2d 70 72 65 66 69 78 3f 20 30 3d tring-prefix? 0=
0c30: 20 49 46 0a 09 27 5b 27 20 65 6d 69 74 0a 20 20 IF..'[' emit.
0c40: 20 20 54 48 45 4e 20 3b 0a 3a 20 2f 61 20 32 64 THEN ;.: /a 2d
0c50: 72 6f 70 0a 20 20 20 20 61 2d 70 61 72 61 6d 73 rop. a-params
0c60: 3a 63 6c 61 73 73 24 20 24 40 20 73 22 20 6f 74 :class$ $@ s" ot
0c70: 2d 68 61 73 68 74 61 67 22 20 73 74 72 69 6e 67 -hashtag" string
0c80: 2d 70 72 65 66 69 78 3f 20 30 3d 20 49 46 0a 09 -prefix? 0= IF..
0c90: 2e 22 20 5d 28 22 20 61 2d 70 61 72 61 6d 73 3a ." ](" a-params:
0ca0: 68 72 65 66 24 20 24 40 20 68 72 65 66 2d 72 65 href$ $@ href-re
0cb0: 70 6c 61 63 65 20 27 29 27 20 65 6d 69 74 0a 20 place ')' emit.
0cc0: 20 20 20 54 48 45 4e 20 61 2d 70 61 72 61 6d 73 THEN a-params
0cd0: 3a 64 69 73 70 6f 73 65 20 6f 2d 73 74 61 63 6b :dispose o-stack
0ce0: 20 73 74 61 63 6b 3e 20 3e 72 20 6f 3e 20 3b 0a stack> >r o> ;.
0cf0: 0a 6f 62 6a 65 63 74 20 63 6c 61 73 73 7b 20 69 .object class{ i
0d00: 6d 67 2d 70 61 72 61 6d 73 0a 20 20 20 20 66 69 mg-params. fi
0d10: 65 6c 64 3a 20 73 72 63 24 0a 20 20 20 20 66 69 eld: src$. fi
0d20: 65 6c 64 3a 20 61 6c 74 24 0a 20 20 20 20 66 69 eld: alt$. fi
0d30: 65 6c 64 3a 20 62 6f 72 64 65 72 24 0a 20 20 20 eld: border$.
0d40: 20 66 69 65 6c 64 3a 20 68 65 69 67 68 74 24 0a field: height$.
0d50: 20 20 20 20 66 69 65 6c 64 3a 20 77 69 64 74 68 field: width
0d60: 24 0a 20 20 20 20 66 69 65 6c 64 3a 20 63 6c 61 $. field: cla
0d70: 73 73 24 0a 20 20 20 20 66 69 65 6c 64 3a 20 73 ss$. field: s
0d80: 74 79 6c 65 24 0a 20 20 20 20 3a 20 64 69 73 70 tyle$. : disp
0d90: 6f 73 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 73 ose ( -- ). s
0da0: 72 63 24 20 24 66 72 65 65 0a 20 20 20 20 61 6c rc$ $free. al
0db0: 74 24 20 24 66 72 65 65 0a 20 20 20 20 62 6f 72 t$ $free. bor
0dc0: 64 65 72 24 20 24 66 72 65 65 0a 20 20 20 20 68 der$ $free. h
0dd0: 65 69 67 68 74 24 20 24 66 72 65 65 0a 20 20 20 eight$ $free.
0de0: 20 77 69 64 74 68 24 20 24 66 72 65 65 0a 20 20 width$ $free.
0df0: 20 20 63 6c 61 73 73 24 20 24 66 72 65 65 0a 20 class$ $free.
0e00: 20 20 20 73 74 79 6c 65 24 20 24 66 72 65 65 0a style$ $free.
0e10: 20 20 20 20 64 69 73 70 6f 73 65 20 3b 0a 7d 63 dispose ;.}c
0e20: 6c 61 73 73 0a 0a 3a 20 69 6d 67 20 28 20 2d 2d lass..: img ( --
0e30: 20 29 0a 20 20 20 20 61 2d 70 61 72 61 6d 73 2d ). a-params-
0e40: 63 6c 61 73 73 20 6e 65 77 20 3e 6f 20 72 3e 20 class new >o r>
0e50: 6f 2d 73 74 61 63 6b 20 3e 73 74 61 63 6b 0a 20 o-stack >stack.
0e60: 20 20 20 27 2f 27 20 2d 73 6b 69 70 20 5b 3a 20 '/' -skip [:
0e70: 5b 27 5d 20 69 6d 67 2d 70 61 72 61 6d 73 20 3e ['] img-params >
0e80: 62 6f 64 79 20 73 63 61 6e 2d 76 61 6c 73 20 3b body scan-vals ;
0e90: 5d 20 65 78 65 63 75 74 65 2d 70 61 72 73 69 6e ] execute-parsin
0ea0: 67 0a 20 20 20 20 2e 22 20 21 5b 22 20 69 6d 67 g. ." ![" img
0eb0: 2d 70 61 72 61 6d 73 3a 61 6c 74 24 20 24 40 20 -params:alt$ $@
0ec0: 74 79 70 65 0a 20 20 20 20 2e 22 20 5d 28 22 20 type. ." ]("
0ed0: 69 6d 67 2d 70 61 72 61 6d 73 3a 73 72 63 24 20 img-params:src$
0ee0: 24 40 20 62 61 73 65 6e 61 6d 65 20 74 79 70 65 $@ basename type
0ef0: 20 27 29 27 20 65 6d 69 74 0a 20 20 20 20 69 6d ')' emit. im
0f00: 67 2d 70 61 72 61 6d 73 3a 73 72 63 24 20 24 40 g-params:src$ $@
0f10: 20 62 61 73 65 6e 61 6d 65 20 66 69 6c 65 2d 73 basename file-s
0f20: 74 61 74 75 73 20 6e 69 70 20 6e 6f 2d 66 69 6c tatus nip no-fil
0f30: 65 23 20 3d 20 49 46 0a 09 5b 3a 20 2e 22 20 63 e# = IF..[: ." c
0f40: 75 72 6c 20 27 22 20 69 6d 67 2d 70 61 72 61 6d url '" img-param
0f50: 73 3a 73 72 63 24 20 24 2e 20 2e 22 20 27 20 2d s:src$ $. ." ' -
0f60: 73 20 2d 53 20 2d 2d 6f 75 74 70 75 74 20 22 0a s -S --output ".
0f70: 09 20 20 20 20 69 6d 67 2d 70 61 72 61 6d 73 3a . img-params:
0f80: 73 72 63 24 20 24 40 20 62 61 73 65 6e 61 6d 65 src$ $@ basename
0f90: 20 74 79 70 65 20 3b 5d 20 24 74 6d 70 20 73 79 type ;] $tmp sy
0fa0: 73 74 65 6d 0a 20 20 20 20 54 48 45 4e 0a 20 20 stem. THEN.
0fb0: 20 20 69 6d 67 2d 70 61 72 61 6d 73 3a 64 69 73 img-params:dis
0fc0: 70 6f 73 65 20 6f 2d 73 74 61 63 6b 20 73 74 61 pose o-stack sta
0fd0: 63 6b 3e 20 3e 72 20 6f 3e 20 3b 0a 3a 20 73 70 ck> >r o> ;.: sp
0fe0: 61 6e 20 28 20 2d 2d 20 29 0a 20 20 20 20 61 2d an ( -- ). a-
0ff0: 70 61 72 61 6d 73 2d 63 6c 61 73 73 20 6e 65 77 params-class new
1000: 20 3e 6f 20 72 3e 20 6f 2d 73 74 61 63 6b 20 3e >o r> o-stack >
1010: 73 74 61 63 6b 0a 20 20 20 20 5b 3a 20 5b 27 5d stack. [: [']
1020: 20 61 2d 70 61 72 61 6d 73 20 3e 62 6f 64 79 20 a-params >body
1030: 73 63 61 6e 2d 76 61 6c 73 20 3b 5d 20 65 78 65 scan-vals ;] exe
1040: 63 75 74 65 2d 70 61 72 73 69 6e 67 20 3b 0a 3a cute-parsing ;.:
1050: 20 2f 73 70 61 6e 20 32 64 72 6f 70 0a 20 20 20 /span 2drop.
1060: 20 61 2d 70 61 72 61 6d 73 3a 64 69 73 70 6f 73 a-params:dispos
1070: 65 20 6f 2d 73 74 61 63 6b 20 73 74 61 63 6b 3e e o-stack stack>
1080: 20 3e 72 20 6f 3e 20 3b 0a 73 79 6e 6f 6e 79 6d >r o> ;.synonym
1090: 20 64 69 76 20 73 70 61 6e 0a 3a 20 2f 64 69 76 div span.: /div
10a0: 20 2f 73 70 61 6e 20 63 72 20 3b 0a 73 79 6e 6f /span cr ;.syno
10b0: 6e 79 6d 20 70 20 64 69 76 0a 3a 20 2f 70 20 2f nym p div.: /p /
10c0: 64 69 76 20 63 72 20 3b 0a 73 79 6e 6f 6e 79 6d div cr ;.synonym
10d0: 20 73 74 79 6c 65 20 73 70 61 6e 0a 73 79 6e 6f style span.syno
10e0: 6e 79 6d 20 2f 73 74 79 6c 65 20 2f 73 70 61 6e nym /style /span
10f0: 0a 0a 6f 62 6a 65 63 74 20 63 6c 61 73 73 7b 20 ..object class{
1100: 74 61 62 6c 65 2d 70 61 72 61 6d 73 0a 20 20 20 table-params.
1110: 20 66 69 65 6c 64 3a 20 61 6c 69 67 6e 24 0a 20 field: align$.
1120: 20 20 20 66 69 65 6c 64 3a 20 63 65 6c 6c 70 61 field: cellpa
1130: 64 64 69 6e 67 24 0a 20 20 20 20 66 69 65 6c 64 dding$. field
1140: 3a 20 63 65 6c 6c 73 70 61 63 69 6e 67 24 0a 20 : cellspacing$.
1150: 20 20 20 66 69 65 6c 64 3a 20 63 6c 61 73 73 24 field: class$
1160: 0a 20 20 20 20 66 69 65 6c 64 3a 20 73 74 79 6c . field: styl
1170: 65 24 0a 20 20 20 20 3a 20 64 69 73 70 6f 73 65 e$. : dispose
1180: 20 28 20 2d 2d 20 29 0a 20 20 20 20 61 6c 69 67 ( -- ). alig
1190: 6e 24 20 24 66 72 65 65 0a 20 20 20 20 63 65 6c n$ $free. cel
11a0: 6c 70 61 64 64 69 6e 67 24 20 24 66 72 65 65 0a lpadding$ $free.
11b0: 20 20 20 20 63 65 6c 6c 73 70 61 63 69 6e 67 24 cellspacing$
11c0: 20 24 66 72 65 65 0a 20 20 20 20 63 6c 61 73 73 $free. class
11d0: 24 20 24 66 72 65 65 0a 20 20 20 20 73 74 79 6c $ $free. styl
11e0: 65 24 20 24 66 72 65 65 0a 20 20 20 20 64 69 73 e$ $free. dis
11f0: 70 6f 73 65 20 3b 0a 7d 63 6c 61 73 73 0a 0a 3a pose ;.}class..:
1200: 20 74 72 20 28 20 2d 2d 20 29 0a 20 20 20 20 74 tr ( -- ). t
1210: 61 62 6c 65 2d 70 61 72 61 6d 73 2d 63 6c 61 73 able-params-clas
1220: 73 20 6e 65 77 20 3e 6f 20 72 3e 20 6f 2d 73 74 s new >o r> o-st
1230: 61 63 6b 20 3e 73 74 61 63 6b 0a 20 20 20 20 5b ack >stack. [
1240: 3a 20 5b 27 5d 20 74 61 62 6c 65 2d 70 61 72 61 : ['] table-para
1250: 6d 73 20 3e 62 6f 64 79 20 73 63 61 6e 2d 76 61 ms >body scan-va
1260: 6c 73 20 3b 5d 20 65 78 65 63 75 74 65 2d 70 61 ls ;] execute-pa
1270: 72 73 69 6e 67 0a 3b 0a 3a 20 74 61 62 6c 65 20 rsing.;.: table
1280: 28 20 2d 2d 20 29 20 63 72 20 74 72 20 3b 0a 3a ( -- ) cr tr ;.:
1290: 20 2f 74 61 62 6c 65 20 32 64 72 6f 70 20 63 72 /table 2drop cr
12a0: 0a 20 20 20 20 74 61 62 6c 65 2d 70 61 72 61 6d . table-param
12b0: 73 3a 64 69 73 70 6f 73 65 20 6f 2d 73 74 61 63 s:dispose o-stac
12c0: 6b 20 73 74 61 63 6b 3e 20 3e 72 20 6f 3e 20 3b k stack> >r o> ;
12d0: 0a 73 79 6e 6f 6e 79 6d 20 74 62 6f 64 79 20 74 .synonym tbody t
12e0: 61 62 6c 65 0a 69 6e 20 66 6f 72 74 68 20 3a 20 able.in forth :
12f0: 3c 65 78 74 72 61 2d 73 70 61 63 65 20 28 20 2d <extra-space ( -
1300: 2d 20 29 0a 20 20 20 20 73 70 61 63 65 20 74 61 - ). space ta
1310: 62 6c 65 2d 70 61 72 61 6d 73 3a 73 74 79 6c 65 ble-params:style
1320: 24 20 24 40 0a 20 20 20 20 32 64 75 70 20 73 22 $ $@. 2dup s"
1330: 20 63 65 6e 74 65 72 22 20 73 65 61 72 63 68 20 center" search
1340: 6e 69 70 20 6e 69 70 20 20 49 46 20 20 32 64 72 nip nip IF 2dr
1350: 6f 70 20 73 70 61 63 65 20 20 45 4c 53 45 0a 09 op space ELSE..
1360: 73 22 20 72 69 67 68 74 22 20 73 65 61 72 63 68 s" right" search
1370: 20 6e 69 70 20 6e 69 70 20 20 49 46 20 73 70 61 nip nip IF spa
1380: 63 65 20 20 54 48 45 4e 20 20 54 48 45 4e 20 3b ce THEN THEN ;
1390: 0a 69 6e 20 66 6f 72 74 68 20 3a 20 65 78 74 72 .in forth : extr
13a0: 61 2d 73 70 61 63 65 3e 20 28 20 2d 2d 20 29 0a a-space> ( -- ).
13b0: 20 20 20 20 73 70 61 63 65 20 74 61 62 6c 65 2d space table-
13c0: 70 61 72 61 6d 73 3a 73 74 79 6c 65 24 20 24 40 params:style$ $@
13d0: 0a 20 20 20 20 32 64 75 70 20 73 22 20 63 65 6e . 2dup s" cen
13e0: 74 65 72 22 20 73 65 61 72 63 68 20 6e 69 70 20 ter" search nip
13f0: 6e 69 70 20 20 49 46 20 20 32 64 72 6f 70 20 73 nip IF 2drop s
1400: 70 61 63 65 20 20 45 4c 53 45 0a 09 73 22 20 6c pace ELSE..s" l
1410: 65 66 74 22 20 73 65 61 72 63 68 20 6e 69 70 20 eft" search nip
1420: 6e 69 70 20 20 49 46 20 73 70 61 63 65 20 20 54 nip IF space T
1430: 48 45 4e 20 20 54 48 45 4e 20 3b 0a 3a 20 74 68 HEN THEN ;.: th
1440: 20 74 61 62 6c 65 20 27 7c 27 20 65 6d 69 74 20 table '|' emit
1450: 3c 65 78 74 72 61 2d 73 70 61 63 65 20 3b 0a 3a <extra-space ;.:
1460: 20 74 64 20 74 61 62 6c 65 20 27 7c 27 20 65 6d td table '|' em
1470: 69 74 20 3c 65 78 74 72 61 2d 73 70 61 63 65 20 it <extra-space
1480: 3b 0a 73 79 6e 6f 6e 79 6d 20 2f 74 62 6f 64 79 ;.synonym /tbody
1490: 20 2f 74 61 62 6c 65 0a 3a 20 2f 74 68 20 32 64 /table.: /th 2d
14a0: 72 6f 70 20 65 78 74 72 61 2d 73 70 61 63 65 3e rop extra-space>
14b0: 20 27 7c 27 20 65 6d 69 74 0a 20 20 20 20 74 61 '|' emit. ta
14c0: 62 6c 65 2d 70 61 72 61 6d 73 3a 64 69 73 70 6f ble-params:dispo
14d0: 73 65 20 6f 2d 73 74 61 63 6b 20 73 74 61 63 6b se o-stack stack
14e0: 3e 20 3e 72 20 6f 3e 20 3b 0a 3a 20 2f 74 72 20 > >r o> ;.: /tr
14f0: 32 64 72 6f 70 20 27 7c 27 20 65 6d 69 74 0a 20 2drop '|' emit.
1500: 20 20 20 74 61 62 6c 65 2d 70 61 72 61 6d 73 3a table-params:
1510: 64 69 73 70 6f 73 65 20 6f 2d 73 74 61 63 6b 20 dispose o-stack
1520: 73 74 61 63 6b 3e 20 3e 72 20 6f 3e 20 3b 0a 3a stack> >r o> ;.:
1530: 20 2f 74 64 20 32 64 72 6f 70 20 65 78 74 72 61 /td 2drop extra
1540: 2d 73 70 61 63 65 3e 0a 20 20 20 20 74 61 62 6c -space>. tabl
1550: 65 2d 70 61 72 61 6d 73 3a 64 69 73 70 6f 73 65 e-params:dispose
1560: 20 6f 2d 73 74 61 63 6b 20 73 74 61 63 6b 3e 20 o-stack stack>
1570: 3e 72 20 6f 3e 20 3b 0a 0a 3a 20 62 72 20 32 64 >r o> ;..: br 2d
1580: 72 6f 70 20 62 72 24 20 40 20 49 46 20 20 62 72 rop br$ @ IF br
1590: 24 20 24 2e 20 20 45 4c 53 45 20 20 63 72 20 20 $ $. ELSE cr
15a0: 54 48 45 4e 20 3b 0a 7d 73 63 6f 70 65 0a 0a 3a THEN ;.}scope..:
15b0: 20 75 6e 2d 68 74 6d 6c 20 28 20 61 64 64 72 20 un-html ( addr
15c0: 75 20 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 49 u -- ). dup I
15d0: 46 0a 09 6f 76 65 72 20 63 40 20 27 23 27 20 3d F..over c@ '#' =
15e0: 20 49 46 0a 09 20 20 20 20 6f 76 65 72 20 31 2b IF.. over 1+
15f0: 20 63 40 20 27 78 27 20 3d 20 49 46 20 20 32 20 c@ 'x' = IF 2
1600: 2f 73 74 72 69 6e 67 20 24 31 30 20 20 45 4c 53 /string $10 ELS
1610: 45 20 20 23 31 30 20 20 54 48 45 4e 20 20 3e 72 E #10 THEN >r
1620: 0a 09 20 20 20 20 32 64 75 70 20 5b 27 5d 20 73 .. 2dup ['] s
1630: 3e 6e 75 6d 62 65 72 3f 20 72 3e 20 62 61 73 65 >number? r> base
1640: 2d 65 78 65 63 75 74 65 0a 09 20 20 20 20 49 46 -execute.. IF
1650: 20 20 64 72 6f 70 20 65 6d 69 74 20 32 64 72 6f drop emit 2dro
1660: 70 20 20 45 58 49 54 20 20 54 48 45 4e 0a 09 54 p EXIT THEN..T
1670: 48 45 4e 0a 09 32 64 75 70 20 5b 27 5d 20 68 74 HEN..2dup ['] ht
1680: 6d 6c 2d 63 68 61 72 73 20 3e 62 6f 64 79 20 66 ml-chars >body f
1690: 69 6e 64 2d 6e 61 6d 65 2d 69 6e 20 3f 64 75 70 ind-name-in ?dup
16a0: 2d 49 46 0a 09 20 20 20 20 6e 61 6d 65 3e 69 6e -IF.. name>in
16b0: 74 20 65 78 65 63 75 74 65 20 78 65 6d 69 74 20 t execute xemit
16c0: 20 32 64 72 6f 70 20 20 45 58 49 54 0a 09 54 48 2drop EXIT..TH
16d0: 45 4e 20 20 73 6f 75 72 63 65 20 74 79 70 65 20 EN source type
16e0: 63 72 20 68 74 6d 6c 2d 63 68 61 72 2d 74 68 72 cr html-char-thr
16f0: 6f 77 20 74 68 72 6f 77 0a 20 20 20 20 45 4c 53 ow throw. ELS
1700: 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b E 2drop THEN ;
1710: 0a 0a 24 31 30 30 20 62 75 66 66 65 72 3a 20 65 ..$100 buffer: e
1720: 73 63 61 70 65 2d 63 68 61 72 73 0a 27 5c 27 20 scape-chars.'\'
1730: 65 73 63 61 70 65 2d 63 68 61 72 73 20 27 2a 27 escape-chars '*'
1740: 20 2b 20 63 21 0a 27 5c 27 20 65 73 63 61 70 65 + c!.'\' escape
1750: 2d 63 68 61 72 73 20 27 5f 27 20 2b 20 63 21 0a -chars '_' + c!.
1760: 27 5c 27 20 65 73 63 61 70 65 2d 63 68 61 72 73 '\' escape-chars
1770: 20 27 5c 27 20 2b 20 63 21 0a 27 5c 27 20 65 73 '\' + c!.'\' es
1780: 63 61 70 65 2d 63 68 61 72 73 20 27 7e 27 20 2b cape-chars '~' +
1790: 20 63 21 0a 27 5c 27 20 65 73 63 61 70 65 2d 63 c!.'\' escape-c
17a0: 68 61 72 73 20 27 5b 27 20 2b 20 63 21 0a 27 5c hars '[' + c!.'\
17b0: 27 20 65 73 63 61 70 65 2d 63 68 61 72 73 20 27 ' escape-chars '
17c0: 5d 27 20 2b 20 63 21 0a 27 5c 27 20 65 73 63 61 ]' + c!.'\' esca
17d0: 70 65 2d 63 68 61 72 73 20 27 60 27 20 2b 20 63 pe-chars '`' + c
17e0: 21 0a 0a 3a 20 74 79 70 65 2d 65 73 63 27 64 20 !..: type-esc'd
17f0: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 ( addr u -- ).
1800: 20 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 49 20 bounds ?DO..I
1810: 63 40 20 64 75 70 20 65 73 63 61 70 65 2d 63 68 c@ dup escape-ch
1820: 61 72 73 20 2b 20 63 40 20 3f 64 75 70 2d 49 46 ars + c@ ?dup-IF
1830: 20 20 65 6d 69 74 20 20 54 48 45 4e 20 20 65 6d emit THEN em
1840: 69 74 0a 20 20 20 20 4c 4f 4f 50 20 3b 0a 0a 3a it. LOOP ;..:
1850: 20 74 79 70 65 2d 6e 6f 6c 66 20 28 20 61 64 64 type-nolf ( add
1860: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 42 45 47 r u -- ). BEG
1870: 49 4e 20 20 23 6c 66 20 24 73 70 6c 69 74 20 20 IN #lf $split
1880: 64 75 70 20 57 48 49 4c 45 20 20 32 73 77 61 70 dup WHILE 2swap
1890: 20 64 75 70 20 49 46 20 74 79 70 65 2d 65 73 63 dup IF type-esc
18a0: 27 64 20 73 70 61 63 65 20 45 4c 53 45 20 32 64 'd space ELSE 2d
18b0: 72 6f 70 20 54 48 45 4e 0a 20 20 20 20 52 45 50 rop THEN. REP
18c0: 45 41 54 0a 20 20 20 20 32 64 72 6f 70 20 74 79 EAT. 2drop ty
18d0: 70 65 2d 65 73 63 27 64 20 3b 0a 0a 3a 20 68 74 pe-esc'd ;..: ht
18e0: 6d 6c 2d 75 6e 65 73 63 61 70 65 20 28 20 61 64 ml-unescape ( ad
18f0: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 42 45 dr u -- ). BE
1900: 47 49 4e 20 20 27 26 27 20 24 73 70 6c 69 74 20 GIN '&' $split
1910: 64 75 70 20 20 57 48 49 4c 45 20 20 32 73 77 61 dup WHILE 2swa
1920: 70 20 74 79 70 65 2d 6e 6f 6c 66 0a 09 20 20 20 p type-nolf..
1930: 20 27 3b 27 20 24 73 70 6c 69 74 20 32 73 77 61 ';' $split 2swa
1940: 70 20 75 6e 2d 68 74 6d 6c 0a 20 20 20 20 52 45 p un-html. RE
1950: 50 45 41 54 20 20 32 64 72 6f 70 20 74 79 70 65 PEAT 2drop type
1960: 2d 6e 6f 6c 66 20 3b 0a 0a 3a 20 74 79 70 65 2d -nolf ;..: type-
1970: 6e 6f 6c 66 27 20 28 20 61 64 64 72 20 75 20 2d nolf' ( addr u -
1980: 2d 20 29 0a 20 20 20 20 42 45 47 49 4e 20 20 23 - ). BEGIN #
1990: 6c 66 20 24 73 70 6c 69 74 20 20 64 75 70 20 57 lf $split dup W
19a0: 48 49 4c 45 20 20 32 73 77 61 70 20 64 75 70 20 HILE 2swap dup
19b0: 49 46 20 74 79 70 65 20 73 70 61 63 65 20 45 4c IF type space EL
19c0: 53 45 20 32 64 72 6f 70 20 54 48 45 4e 0a 20 20 SE 2drop THEN.
19d0: 20 20 52 45 50 45 41 54 0a 20 20 20 20 32 64 72 REPEAT. 2dr
19e0: 6f 70 20 74 79 70 65 20 3b 0a 0a 3a 20 68 74 6d op type ;..: htm
19f0: 6c 2d 75 6e 65 73 63 61 70 65 27 20 28 20 61 64 l-unescape' ( ad
1a00: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 42 45 dr u -- ). BE
1a10: 47 49 4e 20 20 27 26 27 20 24 73 70 6c 69 74 20 GIN '&' $split
1a20: 64 75 70 20 20 57 48 49 4c 45 20 20 32 73 77 61 dup WHILE 2swa
1a30: 70 20 74 79 70 65 2d 6e 6f 6c 66 27 0a 09 20 20 p type-nolf'..
1a40: 20 20 27 3b 27 20 24 73 70 6c 69 74 20 32 73 77 ';' $split 2sw
1a50: 61 70 20 75 6e 2d 68 74 6d 6c 0a 20 20 20 20 52 ap un-html. R
1a60: 45 50 45 41 54 20 20 32 64 72 6f 70 20 74 79 70 EPEAT 2drop typ
1a70: 65 2d 6e 6f 6c 66 27 20 3b 0a 0a 3a 20 68 74 6d e-nolf' ;..: htm
1a80: 6c 2d 74 61 67 20 28 20 61 64 64 72 20 75 20 2d l-tag ( addr u -
1a90: 2d 20 29 0a 20 20 20 20 62 6c 20 24 73 70 6c 69 - ). bl $spli
1aa0: 74 20 32 73 77 61 70 20 5b 27 5d 20 68 74 6d 6c t 2swap ['] html
1ab0: 2d 74 61 67 73 20 3e 62 6f 64 79 20 66 69 6e 64 -tags >body find
1ac0: 2d 6e 61 6d 65 2d 69 6e 20 3f 64 75 70 2d 49 46 -name-in ?dup-IF
1ad0: 0a 09 6e 61 6d 65 3e 69 6e 74 20 65 78 65 63 75 ..name>int execu
1ae0: 74 65 0a 20 20 20 20 45 4c 53 45 20 20 68 74 6d te. ELSE htm
1af0: 6c 2d 74 68 72 6f 77 20 74 68 72 6f 77 20 20 54 l-throw throw T
1b00: 48 45 4e 20 3b 0a 0a 5c 20 70 6f 73 74 2d 70 72 HEN ;..\ post-pr
1b10: 6f 63 65 73 73 20 74 6f 20 63 6c 65 61 6e 75 70 ocess to cleanup
1b20: 0a 0a 3a 20 70 72 6f 63 65 73 73 2d 70 61 74 74 ..: process-patt
1b30: 65 72 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 ern ( addr u --
1b40: 61 64 64 72 27 20 75 27 20 29 0a 20 20 20 20 32 addr' u' ). 2
1b50: 64 75 70 20 22 5f 2a 2a 5f 22 20 20 20 20 20 73 dup "_**_" s
1b60: 74 72 69 6e 67 2d 70 72 65 66 69 78 3f 20 49 46 tring-prefix? IF
1b70: 20 20 34 20 73 61 66 65 2f 73 74 72 69 6e 67 20 4 safe/string
1b80: 2e 22 20 2a 2a 22 20 20 45 58 49 54 20 20 54 48 ." **" EXIT TH
1b90: 45 4e 0a 20 20 20 20 32 64 75 70 20 22 2a 2a 2b EN. 2dup "**+
1ba0: 2b 2b 20 22 20 20 20 73 74 72 69 6e 67 2d 70 72 ++ " string-pr
1bb0: 65 66 69 78 3f 20 49 46 20 20 36 20 73 61 66 65 efix? IF 6 safe
1bc0: 2f 73 74 72 69 6e 67 20 2e 22 20 23 20 22 20 20 /string ." # "
1bd0: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 32 EXIT THEN. 2
1be0: 64 75 70 20 22 20 2b 2b 2b 2a 2a 5c 6e 22 20 32 dup " +++**\n" 2
1bf0: 20 70 69 63 6b 20 36 20 3d 20 2b 20 73 74 72 69 pick 6 = + stri
1c00: 6e 67 2d 70 72 65 66 69 78 3f 20 49 46 0a 09 2e ng-prefix? IF...
1c10: 22 20 20 23 22 20 64 75 70 20 36 20 3c 3e 20 49 " #" dup 6 <> I
1c20: 46 20 20 63 72 20 20 54 48 45 4e 20 20 37 20 73 F cr THEN 7 s
1c30: 61 66 65 2f 73 74 72 69 6e 67 0a 20 20 20 20 45 afe/string. E
1c40: 4c 53 45 0a 09 64 75 70 20 32 20 75 3e 3d 20 49 LSE..dup 2 u>= I
1c50: 46 20 20 32 64 75 70 20 23 6c 66 20 73 6b 69 70 F 2dup #lf skip
1c60: 20 6e 69 70 20 6f 76 65 72 20 73 77 61 70 20 2d nip over swap -
1c70: 20 3e 72 0a 09 20 20 20 20 72 40 20 31 20 3d 20 >r.. r@ 1 =
1c80: 49 46 20 20 27 5c 27 20 65 6d 69 74 20 20 54 48 IF '\' emit TH
1c90: 45 4e 0a 09 20 20 20 20 6f 76 65 72 20 72 40 20 EN.. over r@
1ca0: 74 79 70 65 20 72 3e 20 73 61 66 65 2f 73 74 72 type r> safe/str
1cb0: 69 6e 67 20 20 54 48 45 4e 0a 20 20 20 20 54 48 ing THEN. TH
1cc0: 45 4e 0a 20 20 20 20 64 75 70 20 49 46 20 20 6f EN. dup IF o
1cd0: 76 65 72 20 63 40 20 65 6d 69 74 20 31 20 73 61 ver c@ emit 1 sa
1ce0: 66 65 2f 73 74 72 69 6e 67 20 20 54 48 45 4e 20 fe/string THEN
1cf0: 3b 0a 3a 20 70 72 6f 63 65 73 73 2d 70 61 74 74 ;.: process-patt
1d00: 65 72 6e 73 20 28 20 61 64 64 72 20 75 20 2d 2d erns ( addr u --
1d10: 20 29 0a 20 20 20 20 42 45 47 49 4e 20 20 70 72 ). BEGIN pr
1d20: 6f 63 65 73 73 2d 70 61 74 74 65 72 6e 20 20 64 ocess-pattern d
1d30: 75 70 20 30 3c 3d 20 20 55 4e 54 49 4c 20 20 32 up 0<= UNTIL 2
1d40: 64 72 6f 70 20 3b 0a 0a 56 61 72 69 61 62 6c 65 drop ;..Variable
1d50: 20 68 74 6d 6c 24 0a 0a 3a 20 68 74 6d 6c 2d 75 html$..: html-u
1d60: 6e 74 61 67 20 28 20 61 64 64 72 20 75 20 2d 2d ntag ( addr u --
1d70: 20 29 20 63 6f 6e 66 69 67 2d 77 6c 20 3e 72 20 ) config-wl >r
1d80: 20 68 74 6d 6c 24 20 24 66 72 65 65 0a 20 20 20 html$ $free.
1d90: 20 5b 3a 20 42 45 47 49 4e 20 20 27 3c 27 20 24 [: BEGIN '<' $
1da0: 73 70 6c 69 74 20 64 75 70 20 20 57 48 49 4c 45 split dup WHILE
1db0: 20 20 32 73 77 61 70 20 68 74 6d 6c 2d 75 6e 65 2swap html-une
1dc0: 73 63 61 70 65 0a 09 09 27 3e 27 20 24 73 70 6c scape...'>' $spl
1dd0: 69 74 20 32 73 77 61 70 20 68 74 6d 6c 2d 74 61 it 2swap html-ta
1de0: 67 0a 09 52 45 50 45 41 54 20 20 32 64 72 6f 70 g..REPEAT 2drop
1df0: 20 68 74 6d 6c 2d 75 6e 65 73 63 61 70 65 20 3b html-unescape ;
1e00: 5d 20 68 74 6d 6c 24 20 24 65 78 65 63 0a 20 20 ] html$ $exec.
1e10: 20 20 72 3e 20 74 6f 20 63 6f 6e 66 69 67 2d 77 r> to config-w
1e20: 6c 20 68 74 6d 6c 24 20 24 40 20 70 72 6f 63 65 l html$ $@ proce
1e30: 73 73 2d 70 61 74 74 65 72 6e 73 20 3b 0a 0a 3a ss-patterns ;..:
1e40: 20 68 74 6d 6c 3e 74 65 78 74 20 28 20 61 64 64 html>text ( add
1e50: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 42 45 47 r u -- ). BEG
1e60: 49 4e 20 20 27 3c 27 20 24 73 70 6c 69 74 20 64 IN '<' $split d
1e70: 75 70 20 20 57 48 49 4c 45 20 20 32 73 77 61 70 up WHILE 2swap
1e80: 20 68 74 6d 6c 2d 75 6e 65 73 63 61 70 65 27 0a html-unescape'.
1e90: 09 20 20 20 20 27 3e 27 20 24 73 70 6c 69 74 20 . '>' $split
1ea0: 32 73 77 61 70 20 22 62 72 22 20 73 74 72 3d 20 2swap "br" str=
1eb0: 49 46 20 20 73 70 61 63 65 20 20 54 48 45 4e 0a IF space THEN.
1ec0: 20 20 20 20 52 45 50 45 41 54 20 20 32 64 72 6f REPEAT 2dro
1ed0: 70 20 68 74 6d 6c 2d 75 6e 65 73 63 61 70 65 27 p html-unescape'
1ee0: 20 3b 0a 0a 5b 49 46 44 45 46 5d 20 65 6e 74 72 ;..[IFDEF] entr
1ef0: 69 65 73 5b 5d 0a 20 20 20 20 3a 20 2e 75 6e 2d ies[]. : .un-
1f00: 68 74 6d 6c 73 0a 09 65 6e 74 72 69 65 73 5b 5d htmls..entries[]
1f10: 20 24 5b 5d 23 20 30 20 3f 44 4f 20 69 20 65 6e $[]# 0 ?DO i en
1f20: 74 72 69 65 73 5b 5d 20 24 5b 5d 20 40 20 2e 67 tries[] $[] @ .g
1f30: 2b 3a 63 6f 6d 6d 65 6e 74 73 3a 63 6f 6e 74 65 +:comments:conte
1f40: 6e 74 24 0a 09 20 20 20 20 32 64 75 70 20 74 79 nt$.. 2dup ty
1f50: 70 65 20 63 72 0a 09 20 20 20 20 2e 22 20 3d 3d pe cr.. ." ==
1f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 22 20 =============="
1fa0: 63 72 0a 09 20 20 20 20 68 74 6d 6c 2d 75 6e 74 cr.. html-unt
1fb0: 61 67 20 63 72 0a 09 20 20 20 20 2e 22 20 2d 2d ag cr.. ." --
1fc0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
1fd0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
1fe0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
1ff0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 22 20 --------------"
2000: 63 72 0a 09 4c 4f 4f 50 20 3b 0a 5b 54 48 45 4e cr..LOOP ;.[THEN
2010: 5d 0a 0a 5c 5c 5c 0a 4c 6f 63 61 6c 20 56 61 72 ]..\\\.Local Var
2020: 69 61 62 6c 65 73 3a 0a 66 6f 72 74 68 2d 6c 6f iables:.forth-lo
2030: 63 61 6c 2d 77 6f 72 64 73 3a 0a 20 20 20 20 28 cal-words:. (
2040: 0a 20 20 20 20 20 28 28 22 63 6c 61 73 73 7b 22 . (("class{"
2050: 29 20 64 65 66 69 6e 69 74 69 6f 6e 2d 73 74 61 ) definition-sta
2060: 72 74 65 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d rter (font-lock-
2070: 6b 65 79 77 6f 72 64 2d 66 61 63 65 20 2e 20 31 keyword-face . 1
2080: 29 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d ). "[ \t\n]
2090: 22 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c " t name (font-l
20a0: 6f 63 6b 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d ock-function-nam
20b0: 65 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 20 e-face . 3)).
20c0: 20 20 28 28 22 7d 63 6c 61 73 73 22 29 20 64 65 (("}class") de
20d0: 66 69 6e 69 74 69 6f 6e 2d 65 6e 64 65 72 20 28 finition-ender (
20e0: 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 79 77 6f 72 font-lock-keywor
20f0: 64 2d 66 61 63 65 20 2e 20 31 29 29 0a 20 20 20 d-face . 1)).
2100: 20 29 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d 69 ).forth-local-i
2110: 6e 64 65 6e 74 2d 77 6f 72 64 73 3a 0a 20 20 20 ndent-words:.
2120: 20 28 0a 20 20 20 20 20 28 28 22 63 6c 61 73 73 (. (("class
2130: 7b 22 29 20 28 30 20 2e 20 32 29 20 28 30 20 2e {") (0 . 2) (0 .
2140: 20 32 29 29 0a 20 20 20 20 20 28 28 22 7d 63 6c 2)). (("}cl
2150: 61 73 73 22 29 20 28 2d 32 20 2e 20 30 29 20 28 ass") (-2 . 0) (
2160: 30 20 2e 20 2d 32 29 29 0a 20 20 20 20 29 0a 45 0 . -2)). ).E
2170: 6e 64 3a 0a 5b 54 48 45 4e 5d 0a nd:.[THEN].