1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
|
;;;
;;; cmail-thread.el - thread related functions
;;;
;;; $Author: tmp $
;;; created at: Fri Jul 14 10:21:00 JST 1995
;;; $Modified: Toshihiko Ueki <toshi@he.kobelcosys.co.jp>
;;; modified at: Sat Nov 23 23:23:23 JST 1997
;;;
;;; Copyright (C) 1992-1996 Yukihiro Matsumoto.
;; This file is not part of GNU Emacs but obeys its copyright notice.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
(provide 'cmail-thread)
(eval-when-compile (require 'cl))
(defun cmail-build-thread ()
"$B%+%l%s%H%U%)%k%@$N%9%l%C%I%G!<%?$r:n@.$9$k(B.
$B4{$K%9%l%C%I%G!<%?$,B8:_$7$F$$$l$P$=$l$rJV$9(B."
(save-excursion
(cmail-get-folder)
(if (null *cmail-thread-data)
(let (data)
(save-excursion
(cmail-get-header nil t)
(while (not (eobp))
(setq data
(cmail-th-add data
(string-to-int
(buffer-substring (point)
(progn
(forward-line 1)
(point))))))))
(setq *cmail-thread-data data)))
*cmail-thread-data))
(defun cmail-th-message-id (page)
"$B;XDj$7$?%Z!<%8HV9f$N%a%$%k$N%a%C%;!<%8(BID$B$rJV$9(B."
(save-excursion
(cmail-get-folder)
(cmail-n-page page)
(let ((str (cmail-get-field-values "Message-ID")))
(and str
(string-match "<[^\033 >]+>" str)
(substring str (match-beginning 0) (match-end 0))))))
(defun cmail-th-parent (page)
"In-Reply-To:$B$,$"$l$P!"$=$3$+$i85%a%$%k$N%a%C%;!<%8(BID$B$rF@(B, $B$^$?(B,
In-Reply-To:$B$,$J$/(BReferences:$B$,$"$l$P(B, $B$=$N:G8e$N%a%C%;!<%8(BID$B$r(B
$B85%a%$%k$N%a%C%;!<%8(BID$B$H$7$FJV$9(B."
(save-excursion
(let (str res)
(cmail-get-folder)
(cmail-n-page page)
(setq str (cmail-get-field-values "In-Reply-To"))
(and str
(string-match "<[^\033 >]+>" str)
(setq res (substring str (match-beginning 0)
(match-end 0))))
(if res
nil
(setq str (cmail-get-field-values "References"))
(if str
(let ((buf (get-buffer-create " *cmail-th-parent*")))
(unwind-protect
(progn
(set-buffer buf)
(erase-buffer)
(insert str)
(goto-char (point-max))
(if (search-backward "<" nil t)
(and
(looking-at "<[^\033 >]+>")
(setq res (buffer-substring (match-beginning 0)
(match-end 0))))))
(kill-buffer buf)))))
res)))
(defun cmail-th-find (mid)
"$B;XDj$5$l$?%a%C%;!<%8(BID$B$r;}$D%a%$%k$N%Z!<%8HV9f$rJV$9(B."
(save-excursion
(cmail-get-header)
(cmail-build-thread)
(cmail-get-folder)
(nth 1 (assoc mid *cmail-thread-data))))
(defun cmail-th-level (page)
"$B%9%l%C%I$N?<$5$rJV$9(B."
(save-excursion
(cmail-get-folder)
(if (null *cmail-thread-data)
0
(let ((mid (cmail-th-message-id page)))
(nth 2 (assoc mid *cmail-thread-data))))))
(defun cmail-th-add (data page)
"$B%9%l%C%I%G!<%?$K;XDj$7$?%Z!<%8HV9f$N%a%$%k$rDI2C(B."
(let ((mid (cmail-th-message-id page)))
(if (> page 0)
(let* ((pmid (cmail-th-parent page))
(newlevel 0)
(p (member (assoc pmid data) data))
ptr level)
(if (and pmid p)
(progn
(setq newlevel (1+ (nth 2 (car p))))
(while p
(setq ptr (cdr p))
(setq level (nth 2 (car ptr)))
(if (and ptr (>= level newlevel))
(setq p ptr)
(setcdr p nil)
(setq p nil)))))
(append data (list (list mid page newlevel)) ptr))
data)))
(defun cmail-th-append (folder page)
"$B;XDj$7$?%U%)%k%@$N%9%l%C%I%G!<%?$K;XDj$7$?%Z!<%8HV9f$N%a%$%k$rDI2C(B."
(save-excursion
(let ((cmail-current-folder folder))
(cmail-get-folder folder)
(if *cmail-thread-data
(setq *cmail-thread-data (cmail-th-add *cmail-thread-data page)))
)))
(defun cmail-th-insert-summary ()
"$B%+%l%s%H%U%)%k%@$N%9%l%C%I2=$5$l$?%5%^%j$r:n@.$9$k(B."
(let (p page (data (cmail-build-thread)) done)
(goto-char (point-min))
(while data
(setq done nil)
(setq p (car data))
(setq page (format "^%d " (nth 1 p)))
(while (null done)
(cond
((or (re-search-forward page nil t)
(re-search-backward page nil t))
(setq done t))
(t
(save-excursion ;rebuild thread-data
(cmail-get-folder)
(setq *cmail-thread-data nil))
(setq page (format "^%d " (cmail-th-find (nth 0 p)))))))
(cmail-insert-summary (nth 2 p))
(setq data (cdr data))))
)
(defun cmail-toggle-thread ()
"$B%9%l%C%II=<($r9T$&$+$I$&$+$r%H%0%k$5$;$k(B."
(interactive)
(cmail-get-folder)
(setq *cmail-disp-thread (not *cmail-disp-thread))
(cmail-make-summary))
(defun cmail-toggle-thread-ignore-limit ()
"$B%9%l%C%II=<($G(Blimit$B$r;HMQ$9$k$+$I$&$+$r%H%0%k$5$;$k(B."
(interactive)
(setq cmail-thread-ignore-limit (not cmail-thread-ignore-limit)))
(defun cmail-thread-p ()
"$B%9%l%C%II=<($r9T$&$+$I$&$+$rD4$Y$k(B."
(save-excursion
(cmail-get-folder)
*cmail-disp-thread))
;;; page to mid ryouhou no check
(defun cmail-th-remove (page)
"$B;XDj$7$?%Z!<%8HV9f$N%a%$%k$r%9%l%C%I%G!<%?$+$i:o=|$9$k(B."
(save-excursion
(cmail-get-folder)
(if *cmail-thread-data
(let ((mid (cmail-th-message-id page)))
(setq *cmail-thread-data
(delete-if '(lambda (data) (= page (nth 1 data)))
*cmail-thread-data))))))
(defun cmail-refer-article ()
"Read article specified by message-id around point."
(interactive)
(search-forward ">" nil t) ;Move point to end of "<....>".
(if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
(let ((mid (buffer-substring (match-beginning 1) (match-end 1))))
(cmail-refer-article-mid mid))
(cmail-error-resource 'refer-article-1)))
(defun cmail-refer-article-mid (mid)
"Show parent article which has specific message-id."
(let (page)
(setq page (cmail-th-find mid))
(cmail-select-buffer *cmail-summary-buffer)
(cond
((null mid)
(cmail-error-resource 'refer-article-1))
((null page)
(error (cmail-format-resource 'refer-article-mid-2 cmail-current-folder mid)))
((null (cmail-goto-index page))
(cmail-error-resource1 'refer-article-3 page))
(t
(cmail-show-contents page)))))
(defun cmail-refer-parent-article ()
"Refer parent article."
(interactive)
(let* ((page (cmail-get-page-number-from-summary))
(mid (cmail-th-parent page)))
(cmail-refer-article-mid mid)))
(defun cmail-check-display-thread (folder)
"Check if display as threaded summary when specified folder is opened."
(if (and (stringp cmail-thread-ignored-folder-regexp)
(string-match cmail-thread-ignored-folder-regexp folder))
nil
(or (and (stringp cmail-thread-folder-regexp)
(string-match cmail-thread-folder-regexp folder))
cmail-display-thread)))
(defun cmail-mark-thread (&optional arg)
"$B%+!<%=%k0LCV$N%a!<%k$,4^$^$l$k%9%l%C%IA4BN$r%^!<%/$9$k(B.
\\[universal-argument] $B$rIU$1$k$H(B, $B%+!<%=%k0LCV$N%a!<%k$r%9%l%C%I$N%H%C%W$H$_$J$9(B.
\\[universal-argument] \\[universal-argument] $B$rIU$1$k$H(BHOLD$B$K$9$k(B."
(interactive "p")
(if (not (cmail-thread-p))
(cmail-mark-mail 1)
(save-excursion
(set-buffer *cmail-summary-buffer)
(let ((buffer-read-only nil) ; $B%P%C%U%!$r=q$-49$(2DG=$K(B
(page (cmail-get-page-number-from-summary))
(loop (not (or (= arg 4) (= arg 256))))
msgid family)
(while loop
(setq msgid (cmail-th-parent page))
(and (setq loop (cmail-th-find msgid))
(setq family (cons msgid family)
page loop)))
(or family
;; $B$$$-$J$j%9%l%C%I$NF,$@$C$?(B
(save-excursion
(cmail-get-folder)
(cmail-n-page page)
(setq family (cons
(let ((str (cmail-get-field-values "Message-ID")))
(and str
(string-match "<[^\033 >]+>" str)
(substring str (match-beginning 0) (match-end 0))))
nil))))
(cmail-goto-index page)
(setq loop t)
(while loop
(cond
((= arg 16)
(cmail-put-mark page "H" "H"))
((or (= arg 64) (= arg 256))
(cmail-put-mark page "D" "D"))
(t
(cmail-fixcp) ; $B%+!<%=%k$r%^!<%/0LCV$K(B
(forward-char -1) ; 980525-SNAP $B0J9_(B
(delete-char 1) ; $B0lC6%^!<%/$r>C$7$F(B...
(insert-string "^"))) ; $B%^!<%/$rIU$1$k!#(B
(forward-line 1)
(save-excursion
(if (eq (save-excursion (point-max)) (point))
(setq loop nil) ; $B$b$&%a!<%k$,$J$$(B
(setq page (cmail-get-page-number-from-summary))
(cmail-get-folder)
(cmail-n-page page)
(setq msgid (cmail-get-field-values "In-Reply-To"))
(and msgid
;; In-Reply-To $B$K$O!"M>7W$JJ8;zNs$,IU$$$F$$$k$3$H$,$"$k(B
(string-match "<[^\033 >]+>" msgid)
(setq msgid (substring
msgid (match-beginning 0) (match-end 0))))
(or (member msgid family)
(let (family-p)
;; In-Reply-To $B$G8+$D$+$i$J$$$N$G!"(BReferences $B$rD4$Y$k(B
(setq family-p
(catch 'found
(dolist (msgid (cmail-get-references-list))
(and (member msgid family)
(throw 'found t))))) ; $B0lB2$@$C$?(B
(or family-p (setq loop nil)))) ; $B0lB2$G$O$J$+$C$?(B
(and loop
(setq msgid (cmail-get-field-values "Message-ID"))
(or (member msgid family)
;; $B$^$@(B family $B$KEPO?$7$F$$$J$+$C$?$N$G!"EPO?$9$k(B
(setq family (cons msgid family)))))
) ; save-excursion (*cmail-summary-buffer $B$KLa$k(B)
) ; while-loop
))
(cmail-fixcp)))
(defun cmail-th-mark-delete (&optional topstart)
"$B%+!<%=%k0LCV$N%a!<%k$,4^$^$l$k%9%l%C%IA4BN$K>C0u$r2!$9(B.
\\[universal-argument] $B$rIU$1$k$H(B, $B%+!<%=%k0LCV$N%a!<%k$r%9%l%C%I$N%H%C%W$H$_$J$9(B."
(interactive "P")
(if (cmail-thread-p)
(cmail-mark-thread (if topstart 256 64))
(save-excursion
(cmail-mark-delete 1))
(cmail-fixcp)))
(defun cmail-get-references-list ()
"References:$B$G<($5$l$k%a%C%;!<%8(BID$B72$r%j%9%H$K$7$FJV$9(B."
;; $B$"$i$+$8$a!"(B(cmail-get-folder) (cmail-n-page n) $B$r<B9T$7$F$*$/I,MW$"$j(B
(let ((str (cmail-get-field-values "References")) alist)
(and str
(string-match "" "") ; match-end $B$r%/%j%"(B
(while (string-match "<[^\033 >]+>" str (match-end 0))
(setq alist
(cons (substring str (match-beginning 0) (match-end 0))
alist))))
alist)) ; References: $B$,$J$+$C$?$i(B nil
|
