3 (defun ew-make-anchor (column str)
4 (let ((anchor (make-symbol str)))
5 (put anchor 'anchor anchor)
6 (put anchor 'prev-frag anchor)
7 (put anchor 'next-frag anchor)
8 (put anchor 'prev-token anchor)
9 (put anchor 'next-token anchor)
10 (put anchor 'column column)
11 (put anchor 'line-length 0)
14 (defun ew-terminate (anchor)
15 (let ((frag (get anchor 'prev-frag))
16 (line-length (get anchor 'column)))
17 (while (null (get frag 'line-length))
18 (put frag 'line-length line-length)
19 (setq frag (get frag 'prev-frag)))))
21 (defun ew-tokenize-frag (anchor frag)
22 (put frag 'prev-token (get anchor 'prev-token))
23 (put frag 'next-token anchor)
24 (put (get anchor 'prev-token) 'next-token frag)
25 (put anchor 'prev-token frag)
28 (defun ew-add-frag (anchor start end type)
29 (let ((frag (make-symbol (substring (symbol-name anchor) start end))))
30 (put frag 'anchor anchor)
31 (put frag 'start start)
34 (put frag 'prev-frag (get anchor 'prev-frag))
35 (put frag 'next-frag anchor)
36 (put (get anchor 'prev-frag) 'next-frag frag)
37 (put anchor 'prev-frag frag)
38 (put frag 'decode (or (get type 'decode) 'ew-decode-none))
39 (if (string-match "\r\n\\(.*\r\n\\)*" (symbol-name frag))
40 (let ((prev-line-length (+ (get anchor 'column) (match-beginning 0)))
41 (next-line-column (- (length (symbol-name frag)) (match-end 0)))
43 (while (null (get tmp 'line-length))
44 (put tmp 'line-length prev-line-length)
45 (setq tmp (get tmp 'prev-frag)))
46 (put anchor 'column next-line-column))
47 (put anchor 'column (+ (get anchor 'column) (length (symbol-name frag)))))
50 (defun ew-add-open (anchor start end type)
51 (let ((frag (ew-add-frag anchor start end type)))
52 (put frag 'prev-open (get anchor 'prev-open))
53 (put anchor 'prev-open frag)
56 (defun ew-add-close (anchor start end type)
57 (let ((frag (ew-add-frag anchor start end type)))
58 (put frag 'pair (get anchor 'prev-open))
59 (put (get anchor 'prev-open) 'pair frag)
60 (put anchor 'prev-open (get (get frag 'pair) 'prev-open))
63 (defun ew-add-token (anchor start end type)
64 (ew-tokenize-frag anchor (ew-add-frag anchor start end type)))
66 (defun ew-add-close-token (anchor start end type)
67 (ew-tokenize-frag anchor (ew-add-close anchor start end type)))
71 (defun ew-frag-list (anchor)
73 (tmp (get anchor 'prev-frag)))
74 (while (not (eq anchor tmp))
75 (setq res (cons tmp res)
76 tmp (get tmp 'prev-frag)))
79 (defun ew-token-list (anchor)
81 (tmp (get anchor 'prev-token)))
82 (while (not (eq anchor tmp))
83 (setq res (cons tmp res)
84 tmp (get tmp 'prev-token)))
87 (defun ew-pair-list (anchor)
90 (cons (symbol-value (get frag 'type))
92 (ew-frag-list anchor)))
96 (defun ew-mark-phrase (frag1 frag2)
97 (while (not (eq frag1 frag2))
98 (unless (ew-comment-frag-p frag2)
99 (put frag2 'decode 'ew-decode-phrase))
100 (setq frag2 (get frag2 'prev-frag)))
101 (unless (ew-comment-frag-p frag2)
102 (put frag2 'decode 'ew-decode-phrase))
103 (setq frag2 (get frag2 'prev-frag))
104 (while (not (get frag2 'prev-token))
105 (unless (ew-comment-frag-p frag2)
106 (put frag2 'decode 'ew-decode-phrase))
107 (setq frag2 (get frag2 'prev-frag))))
111 (defun ew-comment-frag-p (frag)
112 (member (get frag 'type)
113 '(ew:raw-cm-begin-tok
115 ew:raw-cm-nested-begin-tok
116 ew:raw-cm-nested-end-tok
121 ew:raw-cm-qpair-tok)))
123 (defun ew-special-frag-p (frag)
124 (or (eq frag (get frag 'anchor))
125 (member (get frag 'type)
138 ew:raw-cm-end-tok))))