5 (defun ew-make-anchor (column str)
6 (let ((anchor (make-symbol str)))
7 (put anchor 'anchor anchor)
8 (put anchor 'type 'ew:*anchor*)
9 (put anchor 'prev-frag anchor)
10 (put anchor 'next-frag anchor)
11 (put anchor 'column column)
12 (put anchor 'line-length 0)
15 (defun ew-terminate (anchor)
16 (let ((frag (get anchor 'prev-frag))
17 (line-length (get anchor 'column)))
18 (while (null (get frag 'line-length))
19 (put frag 'line-length line-length)
20 (setq frag (get frag 'prev-frag)))))
22 (defsubst ew-add-frag (anchor start end type)
23 (let ((frag (make-symbol (substring (symbol-name anchor) start end))))
24 (put frag 'anchor anchor)
26 (put frag 'prev-frag (get anchor 'prev-frag))
27 (put frag 'next-frag anchor)
28 (put (get anchor 'prev-frag) 'next-frag frag)
29 (put anchor 'prev-frag frag)
30 (put frag 'decode (or (get type 'decode) 'ew-decode-none))
31 (if (string-match "\r\n\\(.*\r\n\\)*" (symbol-name frag))
32 (let ((prev-line-length (+ (get anchor 'column) (match-beginning 0)))
33 (next-line-column (- (length (symbol-name frag)) (match-end 0)))
35 (while (null (get tmp 'line-length))
36 (put tmp 'line-length prev-line-length)
37 (setq tmp (get tmp 'prev-frag)))
38 (put anchor 'column next-line-column))
39 (put anchor 'column (+ (get anchor 'column) (length (symbol-name frag)))))
44 (defun ew-frag-list (anchor)
46 (tmp (get anchor 'prev-frag)))
47 (while (not (eq anchor tmp))
48 (setq res (cons tmp res)
49 tmp (get tmp 'prev-frag)))
52 (defun ew-pair-list (anchor)
55 (cons (symbol-value (get frag 'type))
57 (ew-frag-list anchor)))
59 (defun ew-search-sticked-eword (frag start)
60 (let* ((texts (symbol-name frag)) (len (length texts)))
62 (while (string-match ew-encoded-word-regexp texts start)
63 (when (and (or ew-permit-null-encoded-text
64 (< (match-beginning 3) (match-end 3)))
65 (or ew-ignore-75bytes-limit
66 (<= (- (match-end 0) (match-beginning 0)) 75))
67 (or ew-permit-sticked-comment
68 (not (= (match-beginning 0) 0))
69 (not (ew-comment-frag-p (get frag 'prev-frag))))
70 (or ew-permit-sticked-comment
71 (not (= (match-end 0) (length texts)))
72 (not (ew-comment-frag-p (get frag 'next-frag))))
73 (or ew-permit-sticked-special
74 (not (= (match-beginning 0) 0))
75 (ew-comment-frag-p (get frag 'prev-frag))
76 (not (ew-special-frag-p (get frag 'prev-frag))))
77 (or ew-permit-sticked-special
78 (not (= (match-end 0) (length texts)))
79 (ew-comment-frag-p (get frag 'next-frag))
80 (not (ew-special-frag-p (get frag 'next-frag))))
83 (setq start (1- (match-end 0))))
86 (defun ew-separate-eword (frag1 frag2 targets)
87 (while (not (eq frag1 frag2))
88 (when (and (memq (get frag1 'type) targets)
89 (ew-search-sticked-eword frag1 0)
90 (or (< 0 (match-beginning 0))
91 (< (match-end 0) (length (symbol-name frag1)))))
92 (let ((texts (symbol-name frag1))
96 (when (< 0 (match-beginning 0))
97 (setq frag (make-symbol (substring texts 0 (match-beginning 0)))
98 result (ew-rcons* result frag)))
99 (setq frag (make-symbol (substring texts (match-beginning 0) (match-end 0)))
100 result (ew-rcons* result frag))
102 (put frag 'prev-frag (cadr result))
103 (put (cadr result) 'next-frag frag)
104 (setq frag (cadr result)))
105 (put frag 'prev-frag (get frag1 'prev-frag))
106 (put (get frag1 'prev-frag) 'next-frag frag)
107 (while (ew-search-sticked-eword frag1 start)
108 (when (< start (match-beginning 0))
109 (setq frag (make-symbol (substring texts start (match-beginning 0)))
110 result (ew-rcons* result frag))
111 (put frag 'prev-frag (cadr result))
112 (put (cadr result) 'next-frag frag))
113 (setq frag (make-symbol (substring texts (match-beginning 0) (match-end 0)))
114 result (ew-rcons* result frag)
116 (put frag 'prev-frag (cadr result))
117 (put (cadr result) 'next-frag frag))
118 (when (< start (length (symbol-name frag1)))
119 (setq frag (make-symbol (substring texts start))
120 result (ew-rcons* result frag))
121 (put frag 'prev-frag (cadr result))
122 (put (cadr result) 'next-frag frag))
123 (setq frag (car result))
124 (put frag 'next-frag (get frag1 'next-frag))
125 (put (get frag1 'next-frag) 'prev-frag frag)
127 (setq frag (car result)
129 (put frag 'anchor (get frag1 'anchor))
130 (put frag 'type (get frag1 'type))
131 (put frag 'decode (get frag1 'decode))
132 (put frag 'line-length (get frag1 'line-length)))))
133 (setq frag1 (get frag1 'next-frag))))
137 (defun ew-mark-phrase (frag1 frag2)
138 (when ew-decode-sticked-encoded-word
141 (if ew-decode-quoted-encoded-word
145 (setq frag1 (get (get frag1 'prev-frag) 'next-frag)))
146 (while (not (eq frag1 frag2))
147 (setq frag2 (get frag2 'prev-frag))
148 (unless (ew-comment-frag-p frag2)
149 (put frag2 'decode 'ew-decode-phrase)))
150 (while (not (ew-token-last-frag-p
151 (setq frag2 (get frag2 'prev-frag))))
152 (unless (ew-comment-frag-p frag2)
153 (put frag2 'decode 'ew-decode-phrase))))
157 (defun ew-token-last-frag-p (frag)
158 (member (get frag 'type)
171 (defun ew-comment-frag-p (frag)
172 (member (get frag 'type)
183 (defun ew-special-frag-p (frag)
184 (member (get frag 'type)