« back to all changes in this revision
Viewing changes to mew-scan.el
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Tatsuya Kinoshita
- Date: 2004-06-13 01:11:33 UTC
- Revision ID: james.westby@ubuntu.com-20040613011133-yaef6kqhoimiq3lx
Tags: upstream-4.0.65
Import upstream version 4.0.65
- files added:
- alpha
- bin
- bin/w32
- contrib
- etc
- etc/etc
- info
added
removed
mew-scan.el
1
;;; mew-scan.el --- Scanning messages for Mew
2
3
;; Author: Kazu Yamamoto <Kazu@Mew.org>
4
;; Created: Oct 2, 1996
5
6
;;; Code:
7
8
(require 'mew)
9
10
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11
;;;
12
;;; Scan info
13
;;;
14
15
(defvar mew-scan-info-list '("folder" "message"))
16
;; See mew-scan-fields. 0th is fld, 1st is msg (ie num).
17
18
(mew-info-defun "mew-scan-" mew-scan-info-list)
19
20
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21
;;;
22
;;; Variables
23
;;;
24
25
(defvar mew-summary-form-size-unit '("" "k" "M" "G" "T"))
26
(defvar mew-vec [0 1 2 3 4 5 6 8 9 10 11 12 13 14 15 16 17 18 19 20]
27
"Just for test of (MEW-FOO).")
28
29
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30
;;;
31
;;; Setup
32
;;;
33
34
(defun mew-scan-setup ()
35
"Define functions (MEW-FOO) according 'mew-scan-fields-alias'."
36
(let ((n (length mew-scan-fields-alias))
37
(i 0))
38
(while (< i n)
39
(fset (intern (concat "MEW-" (nth i mew-scan-fields-alias)))
40
`(lambda () (aref mew-vec ,i)))
41
(setq i (1+ i)))))
42
43
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44
;;;
45
;;; Pre-defined functions for mew-summary-form
46
;;;
47
48
(defun mew-summary-form-mark ()
49
"A function to return a mark.
50
'mew-summary-form-mark-delete' and 'mew-summary-form-mark-review'
51
effect to this function."
52
(let ((mark-delete mew-mark-delete)
53
(mark-review mew-mark-review)
54
duplicated review id)
55
(when mew-summary-form-mark-delete
56
(if (mew-characterp mew-summary-form-mark-delete)
57
(setq mark-delete mew-summary-form-mark-delete))
58
(when (setq id (mew-idstr-get-first-id (MEW-ID)))
59
(if (member id (mew-sinfo-get-scan-id)) ;; in Summary mode
60
(setq duplicated t)
61
(mew-sinfo-set-scan-id (cons id (mew-sinfo-get-scan-id))))))
62
(when mew-summary-form-mark-review
63
(if (mew-characterp mew-summary-form-mark-review)
64
(setq mark-review mew-summary-form-mark-review))
65
(let* ((mew-header-max-depth nil)
66
(to (mew-addrstr-parse-address-list (MEW-TO)))
67
(cc (mew-addrstr-parse-address-list (MEW-CC))))
68
(setq to (nconc to cc))
69
(catch 'loop
70
(while to
71
(if (mew-is-my-address mew-regex-my-address-list (car to))
72
(throw 'loop (setq review t)))
73
(setq to (cdr to))))))
74
(cond
75
(duplicated (char-to-string mark-delete))
76
(review (char-to-string mark-review))
77
(t " "))))
78
79
(defun mew-summary-form-type ()
80
"A function to return a mark of content type."
81
(let ((ct (MEW-CT))
82
(case-fold-search t))
83
(cond
84
((mew-scan-message-invalidp) "#")
85
((mew-scan-message-truncatedp) "T")
86
((string-match "Multipart/Signed" ct) "S")
87
((string-match "Multipart/Encrypted" ct) "E")
88
((string-match "Application/X-Pkcs7-Mime" ct) "E")
89
((mew-ct-multipartp ct) "M")
90
((string-match "Message/Partial" ct) "P")
91
(t " "))))
92
93
(defun mew-summary-form-time ()
94
"A function to return a message time, HH:MM"
95
(let ((s (MEW-DATE)))
96
(if (or (string= s "")
97
(not (string-match mew-time-rfc-regex s)))
98
(setq s (mew-time-ctz-to-rfc
99
(mew-file-get-time (mew-expand-folder (MEW-FLD) (MEW-NUM))))))
100
(if (string-match mew-time-rfc-regex s)
101
(format "%02d:%02d"
102
(or (mew-time-rfc-hour) 0)
103
(or (mew-time-rfc-min) 0))
104
"00:00")))
105
106
(defun mew-summary-form-date ()
107
"A function to return a date, MM/DD."
108
(let ((s (MEW-DATE)))
109
(when (or (string= s "")
110
(not (string-match mew-time-rfc-regex s)))
111
(setq s (mew-time-ctz-to-rfc
112
(mew-file-get-time (mew-expand-folder (MEW-FLD) (MEW-NUM))))))
113
(if (string-match mew-time-rfc-regex s)
114
(format "%02d/%02d"
115
(mew-time-mon-str-to-int (mew-time-rfc-mon))
116
(mew-time-rfc-day))
117
"")))
118
119
(defun mew-summary-form-year ()
120
"A function to return a message year, YYYY"
121
(let ((s (MEW-DATE)) year)
122
(when (or (string= s "")
123
(not (string-match mew-time-rfc-regex s)))
124
(setq s (mew-time-ctz-to-rfc
125
(mew-file-get-time (mew-expand-folder (MEW-FLD) (MEW-NUM))))))
126
(if (not (string-match mew-time-rfc-regex s))
127
"0000"
128
(setq year (mew-time-rfc-year))
129
(cond
130
((< year 50)
131
(setq year (+ year 2000)))
132
((< year 100)
133
(setq year (+ year 1900))))
134
(int-to-string year))))
135
136
(defun mew-summary-form-size ()
137
"A function to return the size of the message. Should be used
138
with -4. See also 'mew-summary-form-size-0k' and 'mew-summary-form-size-huge'."
139
(let ((len-1 (1- (length mew-summary-form-size-unit)))
140
(SIZE (mew-scan-uid-size (MEW-UID)))
141
(i 0) size unit)
142
(if (and SIZE (string-match "^[0-9]+$" SIZE))
143
(setq size (string-to-int SIZE))
144
(setq size (mew-file-get-size (mew-expand-folder (MEW-FLD) (MEW-NUM)))))
145
(while (and (< i len-1) (>= size 1000))
146
(setq size (/ size 1000))
147
(setq i (1+ i)))
148
(if (and mew-summary-form-size-huge (>= size 1000))
149
"HUGE"
150
(setq unit (nth i mew-summary-form-size-unit))
151
(if (and mew-summary-form-size-0k (string= unit ""))
152
"0k"
153
(concat
154
(if (integerp size)
155
(int-to-string size)
156
(format "%.0f" size))
157
unit)))))
158
159
(defun mew-summary-form-extract-addr (addr)
160
"Extract addr according to 'mew-summary-form-extract-rule'."
161
(let* ((func (if mew-addrbook-for-summary
162
(mew-addrbook-func mew-addrbook-for-summary)))
163
(raw (or (mew-addrstr-parse-address addr) ""))
164
(rules mew-summary-form-extract-rule)
165
rule ret nickname)
166
(catch 'matched
167
(while rules
168
(setq rule (car rules))
169
(setq rules (cdr rules))
170
(cond
171
((and (eq rule 'name)
172
(or (string-match "^\"\\([^\"]+\\)\"[ \t]*<[^>]+>" addr)
173
(string-match "^\\([^<]+\\)<[^>]+>" addr)))
174
(throw 'matched (setq ret (mew-chop (match-string 1 addr)))))
175
((and (eq rule 'comment)
176
(string-match "^[^(]+(\\(.+\\))" addr))
177
(throw 'matched (setq ret (mew-chop (match-string 1 addr)))))
178
((eq rule 'address)
179
(throw 'matched (setq ret raw)))
180
((and (eq rule 'nickname)
181
;; set nickname here for efficiency
182
(or nickname
183
(setq nickname (if func (funcall func raw)))))
184
(throw 'matched (setq ret nickname)))
185
((and (stringp rule)
186
(string-match rule addr))
187
(throw 'matched (setq ret (mew-chop (match-string 1 addr))))))))
188
(or ret addr)))
189
190
(defun mew-summary-form-from ()
191
"A function to return an address.
192
If the message is destined to me AND 'mew-summary-form-from-me-prefix'
193
is a string, an address on To:, is returned. In this
194
case, 'mew-summary-form-from-me-prefix' is prepended to the address.
195
196
Otherwise, an address on From: is returned.
197
198
Address is converted by 'mew-summary-form-extract-addr'. See also
199
'mew-summary-form-extract-rule'."
200
(let* ((FROM (MEW-FROM)) (TO (MEW-TO))
201
(from (or (mew-addrstr-parse-address FROM) "")))
202
(cond
203
((string= FROM "")
204
"")
205
((and (stringp mew-summary-form-from-me-prefix)
206
(not (string= TO ""))
207
(mew-is-my-address mew-regex-my-address-list from))
208
(mew-replace-white-space
209
(concat mew-summary-form-from-me-prefix (mew-summary-form-extract-addr TO))))
210
(t
211
(mew-replace-white-space (mew-summary-form-extract-addr FROM))))))
212
213
(defun mew-summary-form-subj ()
214
"A function to return Subject:. Unnecessary white spaces are removed."
215
;; The beginning white spaces have been removed in mew-scan-header
216
;; (mew-keyval).
217
(let ((subj (MEW-SUBJ)))
218
(if (string= subj "") (setq subj mew-error-no-subject))
219
(if mew-decode-broken
220
subj
221
;; already well-formatted
222
(mew-replace-white-space subj))))
223
224
(defun mew-summary-form-body ()
225
(mew-header-sanity-check-string (MEW-BODY)))
226
227
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
228
;;;
229
;;; Scan from
230
;;;
231
232
(defun mew-get-summary-form (folder &optional column)
233
"Get summary-form from 'mew-summary-form-list',
234
'mew-summary-form-list-string-type, and 'mew-summary-form-list-list-type'.
235
'mew-summary-form-header' is prepended. If COLUMN is non-nil, the number
236
of thread indent position is returned."
237
(let (ret form col)
238
(setq ret (mew-folder-spec folder mew-summary-form-list
239
mew-summary-form-list-string-type
240
mew-summary-form-list-list-type))
241
(if ret
242
(setq form (nth 0 ret) col (nth 1 ret))
243
(setq form mew-summary-form))
244
(setq form (append mew-summary-form-header form))
245
(if column
246
(if (numberp col) col (mew-thread-column form))
247
form)))
248
249
(defun mew-thread-column (form)
250
(let ((col 0) ret ent)
251
(catch 'loop
252
(while form
253
(setq ent (car form))
254
(setq form (cdr form))
255
(cond
256
((consp ent)
257
(setq col (+ col (abs (car ent)))))
258
((stringp ent)
259
(setq col (+ col (string-width ent))))
260
((eq ent t)
261
(throw 'loop (setq ret col)))
262
(t
263
(setq col (1+ col))))))
264
(or ret mew-thread-column)))
265
266
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
267
;;;
268
;;; The engine function to call mew-summary-form-*
269
;;;
270
271
(defun mew-scan-get-piece (spec)
272
(let (func width str rightp nopad)
273
(if (stringp spec)
274
(progn
275
(setq TOTAL (+ TOTAL (string-width spec)))
276
spec)
277
(if (symbolp spec)
278
(setq width 1 func spec)
279
(setq width (nth 0 spec) func (nth 1 spec)))
280
(when (and (integerp width) (symbolp func))
281
(when (= width 0)
282
(setq width (- WIDTH TOTAL 1))
283
(unless mew-use-spc-padding
284
(setq nopad t)))
285
(if (< width 0) (setq width (abs width) rightp t))
286
(setq TOTAL (+ TOTAL width))
287
(setq func (intern-soft
288
(concat mew-summary-form-func-prefix (symbol-name func))))
289
(when (fboundp func)
290
(setq str (funcall func))
291
(if rightp
292
(if (<= (string-width str) width)
293
(format (format "%%%ds" width) str)
294
(setq TOTAL (+ (- TOTAL width) (string-width str)))
295
str) ;; width may exceed.
296
(mew-substring str width nil nopad)))))))
297
298
(defun mew-scan-get-line (mew-vec WIDTH)
299
(let* ((TOTAL 0) (fld "")
300
(line (mapconcat 'mew-scan-get-piece (mew-sinfo-get-summary-form) ""))
301
par-id my-id msg ld uid siz irt-list)
302
(setq my-id (or (mew-idstr-get-first-id (MEW-ID)) ""))
303
;; RFC 2822 says: the "In-Reply-To:" field may be used to identify
304
;; the message (or messages) to which the new message is a reply,
305
;; while the "References:" field may be used to identify a
306
;; "thread" of conversation.
307
;;
308
;; However, even if the References field exists, it may not contain
309
;; a parent's ID. So, if the In-Reply-To field contain one ID,
310
;; we use it for thread.
311
;;
312
;; (1) The In-Reply-To contains one ID, use it.
313
;; (2) The References contains one or more IDs, use the last one.
314
;; (3) The In-Reply-To contains two or more IDs, use the first one.
315
(setq par-id (or (mew-idstr-get-first-id (MEW-XREF)) ""))
316
(when (string= par-id "")
317
(setq irt-list (mew-idstr-to-id-list (MEW-IRT)))
318
(if (= (length irt-list) 1)
319
(setq par-id (car irt-list))
320
(setq par-id (or (mew-idstr-get-last-id (MEW-REF))
321
(car irt-list)
322
""))))
323
(when (mew-virtual-p)
324
(setq fld (cdr (assoc (mew-scan-get-folder mew-vec)
325
(mew-vinfo-get-lra)))))
326
(setq msg (mew-scan-get-message mew-vec))
327
(setq uid (or (mew-scan-uid-uid (MEW-UID)) ""))
328
(setq siz (or (mew-scan-uid-size (MEW-UID)) ""))
329
(setq ld (format "\r %s %s %s %s %s %s\n" fld msg my-id par-id uid siz))
330
(cons line ld)))
331
332
;; See also mew-summary-cook-region
333
(defun mew-scan-insert-line (folder vec width lmsg &optional mark-or-dst)
334
(when (get-buffer folder)
335
(save-excursion
336
(set-buffer folder)
337
(let* ((line (mew-scan-get-line vec width))
338
(opos (point))
339
(omax (point-max))
340
beg med face olen nlen mark msg)
341
(mew-elet
342
(if (null lmsg)
343
(goto-char (point-max))
344
;; a message marked with 'T'.
345
(goto-char (point-min))
346
(if (not (re-search-forward (mew-regex-sumsyn-msg lmsg) nil t))
347
(goto-char (point-max)) ;; xxx
348
(setq mark (mew-summary-get-mark))
349
(beginning-of-line)
350
(setq beg (point))
351
(forward-line)
352
;; To avoid inserting a line AFTER the cursor underline,
353
;; keep this line and make it invisible.
354
(put-text-property beg (point) 'invisible t)
355
(mew-front-nonsticky beg (1+ beg)) ;; for XEmacs
356
(forward-line -1)))
357
(setq beg (point))
358
;; To "insert" just after mew-marker-decode-syntax-end.
359
(insert (car line))
360
(setq med (point))
361
(insert (cdr line))
362
(goto-char beg)
363
(mew-front-nonsticky beg med) ;; for XEmacs
364
(cond
365
((stringp mark-or-dst) ;; xxx
366
(setq msg (mew-scan-get-message vec))
367
(mew-refile-reset msg)
368
(mew-refile-set msg (mew-split mark-or-dst ?,))
369
(mew-summary-refile-log folder mark-or-dst)
370
(mew-summary-refile-override-body mark-or-dst)
371
(mew-mark-put mew-mark-refile))
372
(mark
373
(mew-summary-mark-as mark))
374
((and mew-use-highlight-mark ;; mew-summary-form-mark
375
(setq mark (mew-summary-get-mark)) ;; duplicated, etc
376
(setq face (mew-highlight-mark-get-face mark)))
377
(put-text-property beg med 'face face))
378
((mew-characterp mark-or-dst) ;; mew-inbox-action-alist
379
(mew-summary-mark-as mark-or-dst)))
380
(if mew-use-highlight-mouse-line
381
(put-text-property
382
beg med 'mouse-face mew-highlight-mouse-line-face))
383
(forward-line)
384
(put-text-property med (1- (point)) 'invisible t)
385
;; Removing the invisible line.
386
(when lmsg
387
;; UID information will be removed. So, we need to adjust
388
;; the position.
389
(setq nlen (- (point) beg))
390
(setq beg (point))
391
(forward-line)
392
(when (> opos beg)
393
(setq olen (- (point) beg))
394
(setq opos (- opos (- olen nlen))))
395
(delete-region beg (point))))
396
(if (or (eq opos (mew-sinfo-get-start-point))
397
(/= opos omax))
398
;; move the cursor to the original position.
399
(goto-char opos))))))
400
401
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
402
;;;
403
;;; Sub-functions for Scan
404
;;;
405
406
(defun mew-scan-header (&optional draftp)
407
(let ((vec (make-vector (length mew-scan-fields) ""))
408
(lim (1- mew-scan-max-field-length))
409
i key med str n)
410
(goto-char (point-min))
411
(unless (re-search-forward mew-eoh nil t)
412
(goto-char (point-max)))
413
(save-restriction
414
(narrow-to-region (point-min) (point))
415
(goto-char (point-min))
416
(while (not (eobp))
417
(if (not (looking-at mew-keyval))
418
(forward-line)
419
(setq key (mew-capitalize (mew-match-string 1)))
420
(setq med (match-end 0))
421
;; Three lines should be enough for Summary mode.
422
(forward-line)
423
(setq i 0)
424
(while (and (< i lim) (looking-at mew-lwsp))
425
(forward-line)
426
(setq i (1+ i)))
427
(when (and (setq n (mew-member-case-equal key mew-scan-fields))
428
(string= (aref vec n) "")) ;; avoid multiple times
429
(when (member key mew-scan-decode-fields)
430
(mew-header-decode-region key med (point) draftp))
431
;; We need to keep composite properties of charset.
432
;; This must be "buffer-substring".
433
(setq str (buffer-substring med (1- (point))))
434
(aset vec n str))
435
(mew-header-goto-next))))
436
vec))
437
438
(defun mew-scan-field-to-func (key)
439
(let ((n (mew-member-case-equal key mew-scan-fields))
440
(len (length mew-scan-fields-alias))
441
ali)
442
(if (and n (< n len)) (setq ali (nth n mew-scan-fields-alias)))
443
(if (stringp ali) (symbol-function (intern-soft (concat "MEW-" ali))))))
444
445
(defun mew-scan-inbox-action (mew-vec)
446
(let ((alist mew-inbox-action-alist)
447
ent key act val val-func ret mark-or-dst regex-list)
448
(catch 'loop
449
(while alist
450
(setq ent (car alist))
451
(setq alist (cdr alist))
452
(setq key (car ent))
453
(setq val-func (mew-scan-field-to-func key))
454
(if (and val-func (functionp val-func))
455
(setq val (funcall val-func))
456
(setq val nil))
457
(when val
458
(setq ent (cdr ent))
459
(while ent
460
(setq act (car ent))
461
(setq ent (cdr ent))
462
(if (symbolp act)
463
(when (fboundp act)
464
(setq ret (funcall act val))
465
(if ret (throw 'loop nil)))
466
(when (listp act)
467
(setq mark-or-dst (car act))
468
(setq regex-list (cdr act))
469
(while regex-list
470
(if (string-match (car regex-list) val)
471
(throw 'loop (setq ret mark-or-dst)))
472
(setq regex-list (cdr regex-list)))))))))
473
ret))
474
475
(defvar mew-regex-ignore-scan-body-list
476
'("^[ \t]*$"
477
"^[ \t]*[-a-zA-Z0-9]+: "
478
"^[ \t]*[>:|#;/_}]"
479
"^[ \t]*\\w+\\(['._-]+\\w+\\)*>"
480
"^[ \t]*[[</(.]+ *snip"
481
"^ "
482
"^--"
483
"^- --"
484
"^=2D"
485
"^.*\\(:\\|;\\|/\\)[ \t]*$"
486
"^.*\\(wrote\\|writes?\\|said\\|says?\\)[^.!\n]?[ \t]*$"
487
"^[ \t]*\\(On\\|At\\) .*[^.! \t\n][ \t]*$"
488
"^[ \t]*In \\(message\\|article\\|mail\\|news\\|<\\|\"\\|\\[\\|(\\)"))
489
490
(defun mew-scan-body (mew-vec &optional draftp)
491
(forward-line)
492
(let* ((i 0) (I mew-scan-max-body-length)
493
(j 0) (J 3)
494
(ctr (MEW-CT))
495
(cte (MEW-CTE))
496
(body "")
497
(case-fold-search t)
498
textp charset cs beg skip boundary found regex)
499
(catch 'break
500
(cond
501
(draftp
502
(setq textp t)
503
(setq cs mew-cs-m17n))
504
((string= ctr "")
505
(if (mew-case-equal cte mew-b64) (throw 'break nil))
506
(setq textp t)
507
(setq cs mew-cs-autoconv))
508
(t
509
;; The following code is generic but too slow.
510
;; (setq ctl (mew-param-decode ctr))
511
;; (setq ct (mew-syntax-get-value ctl 'cap))
512
;; So, this hard coding is used.
513
(when (and (string-match "^Multipart/" ctr)
514
(string-match "boundary=\"?\\([^\"\n\t;]+\\)\"?" ctr))
515
(setq boundary (mew-match-string 1 ctr))
516
(setq boundary (concat "^--" (regexp-quote boundary)))
517
(catch 'loop
518
(while (< i I)
519
(if (looking-at boundary) (throw 'loop (setq found t)))
520
(forward-line)
521
(setq i (1+ i))))
522
(if (not found)
523
(throw 'break nil)
524
(forward-line)
525
(save-restriction
526
(narrow-to-region (point) (point-max))
527
(setq ctr (mew-header-get-value mew-ct:))
528
(setq cte (mew-addrstr-parse-value
529
(mew-header-get-value mew-cte:)))
530
(mew-header-goto-end)) ;; should be in the narrowed region
531
(unless ctr ;; not ""
532
(setq textp t)
533
(setq cs mew-cs-autoconv)
534
(throw 'break nil))))
535
(if (and cte (mew-case-equal cte mew-b64)) (throw 'break nil))
536
(when (string-match "^Text/Plain" ctr)
537
(when (string-match "charset=\"?\\([^\"\n\t;]+\\)\"?" ctr)
538
(setq charset (mew-match-string 1 ctr)))
539
;; xxx quoted-printable. not enough DB in mew-mule3.el.
540
(setq textp t)
541
(setq cs (mew-charset-to-cs charset))
542
(if (null cs) (setq cs mew-cs-autoconv)))))) ;; end of 'break
543
(when (and textp (mew-coding-system-p cs))
544
(setq i 0)
545
(while (and (not (eobp)) (< i I) (< j J))
546
(setq regex mew-regex-ignore-scan-body-list)
547
(setq skip nil)
548
(catch 'matched
549
(while regex
550
(if (looking-at (car regex))
551
(throw 'matched (setq skip t)))
552
(setq regex (cdr regex))))
553
(if skip
554
(forward-line)
555
(when (looking-at "^[ \t]+")
556
(goto-char (match-end 0)))
557
(setq beg (point))
558
(forward-line)
559
(setq body (concat body (mew-buffer-substring beg (1- (point))) " "))
560
(setq j (1+ j)))
561
(setq i (1+ i)))
562
(setq body (mew-cs-decode-string (mew-replace-white-space body) cs))
563
(aset mew-vec (1- (length mew-vec)) body))))
564
565
(defun mew-scan-width ()
566
(if (and (integerp mew-summary-scan-width)
567
(> mew-summary-scan-width 40)) ;; xxx
568
mew-summary-scan-width
569
(max mew-window-magic (window-width))))
570
571
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
572
;;;
573
;;; X-Mew-Uidl:
574
;;;
575
576
(defsubst mew-scan-uid-uid (uid)
577
(nth 0 (mew-split uid 32)))
578
579
(defsubst mew-scan-uid-size (uid)
580
(nth 1 (mew-split uid 32)))
581
582
(defun mew-header-insert-xmu (uid siz truncated)
583
(when (and (stringp uid) (stringp siz))
584
(setq siz (int-to-string (string-to-int siz))) ;; removing 0
585
(let (fields)
586
(if truncated
587
(setq fields (concat uid " 0" siz)) ;; e.g. 0500 == truncated
588
(setq fields (concat uid " " siz)))
589
(save-excursion
590
(mew-header-delete-lines (list mew-x-mew-uidl:)))
591
(mew-header-insert mew-x-mew-uidl: fields 'no-fold))))
592
593
(defun mew-scan-message-truncatedp ()
594
(let ((siz (mew-scan-uid-size (MEW-UID))))
595
(and siz (string-match "^0" siz))))
596
597
(defun mew-scan-message-invalidp ()
598
(and (MEW-NUM) (string-match "^0" (MEW-NUM))))
599
600
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
601
;;;
602
;;; Scanning a folder
603
;;;
604
605
(defun mew-summary-ls (&optional header-only goend)
606
"List this folder asynchronously.
607
608
In a LOCAL folder: messages in the local folder are scanned according
609
to the range which you specify.
610
611
In a REMOTE folder: messages in the server's folder are cached
612
according to the range which you specify. If
613
'mew-pop-header-only'/'mew-imap-header-only'/'mew-nntp-header-only' is
614
non-nil, only headers of messages are cacched. If executed with
615
'\\[universal-argument]', these variables are considered reversed."
616
(interactive "P")
617
(mew-summary-only
618
(when (mew-summary-exclusive-p)
619
(let* ((bnm (mew-summary-folder-name 'ext))
620
(case (mew-sinfo-get-case))
621
(fld (mew-sinfo-get-folder))
622
(askp mew-ask-range)
623
(directive 'scan)
624
(get-body (not header-only))
625
scanp range dir-newp)
626
(mew-summary-folder-cache-load)
627
(cond
628
((interactive-p) ;; "s"
629
(setq askp t)
630
(setq scanp t))
631
((mew-summary-folder-dir-newp) ;; "g"
632
(setq askp nil)
633
(setq scanp t)))
634
(if (mew-summary-folder-dir-newp) (setq dir-newp t))
635
(if (or (interactive-p) goend) (goto-char (point-max)))
636
(set-buffer-modified-p nil)
637
(if (not scanp)
638
(progn
639
(run-hooks 'mew-summary-ls-no-scan-hook)
640
t) ;; return value (not scanned)
641
(mew-summary-reset)
642
;;
643
(mew-sinfo-set-direction 'down)
644
(cond
645
((and (mew-folder-remotep fld)
646
(not (mew-folder-imap-queuep)))
647
(if (and dir-newp (mew-folder-imapp fld))
648
(mew-local-retrieve 'scan bnm (mew-range-update bnm))
649
(setq range (mew-input-range-remote bnm))
650
(when (eq range 'sync)
651
(setq range nil)
652
(setq directive 'sync))
653
(cond
654
((mew-folder-popp fld)
655
(if (mew-pop-header-only case)
656
(setq get-body (not get-body)))
657
(mew-pop-retrieve case directive bnm range get-body))
658
((mew-folder-imapp fld)
659
(if (mew-imap-header-only case)
660
(setq get-body (not get-body)))
661
(mew-imap-retrieve case directive bnm range get-body))
662
((mew-folder-nntpp fld)
663
(if (mew-nntp-header-only case)
664
(setq get-body (not get-body)))
665
(mew-nntp-retrieve case directive bnm range get-body)))))
666
(t ;; local
667
(setq range (mew-input-range bnm askp))
668
(if range
669
(mew-local-retrieve 'scan bnm (nth 0 range) (nth 1 range))
670
(message "range is wrong"))))
671
nil))))) ;; return value (scanned)
672
673
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
674
;;;
675
;;; Summary file cache
676
;;;
677
678
(defun mew-compare-times (t1 t2)
679
;; Is t1 newer than t2?
680
(cond
681
((null t1) nil)
682
((null t2) t) ;; do update
683
((> (nth 0 t1) (nth 0 t2)) t)
684
((= (nth 0 t1) (nth 0 t2))
685
(if (> (nth 1 t1) (nth 1 t2)) t nil)) ;; nil if equal
686
(t nil)))
687
688
(defsubst mew-summary-folder-dir-newp ()
689
(let* ((folder (mew-summary-folder-name 'ext))
690
(dir (file-chase-links (mew-expand-folder folder)))
691
(mfile (expand-file-name mew-summary-touch-file dir))
692
(t1 (mew-file-get-time mfile))
693
(cache (expand-file-name mew-summary-cache-file dir))
694
(t2 (mew-file-get-time cache)))
695
(if (and (null t1)
696
(file-directory-p dir)
697
(mew-dir-messages (mew-expand-folder dir)))
698
t
699
(mew-compare-times t1 t2))))
700
701
(defsubst mew-summary-folder-cache-newp ()
702
(let* ((folder (mew-summary-folder-name 'ext))
703
(cache (mew-expand-folder folder mew-summary-cache-file))
704
(t1 (mew-file-get-time cache))
705
(t2 (mew-sinfo-get-cache-time)))
706
(mew-compare-times t1 t2)))
707
708
(defun mew-summary-set-count-line ()
709
(let* ((ttl-line (mew-count-lines (point-min) (point-max)))
710
(mid-point (/ (buffer-size) 2))
711
(mid-marker (mew-sinfo-get-mid-marker))
712
mid-line)
713
(save-excursion
714
(goto-char mid-point)
715
(beginning-of-line)
716
(if (and (mew-thread-p) mew-use-thread-separator
717
(looking-at mew-regex-thread-separator))
718
(forward-line))
719
(setq mid-point (point))
720
(setq mid-line (mew-count-lines (point-min) (point))))
721
(mew-sinfo-set-ttl-line ttl-line)
722
(mew-sinfo-set-mid-line mid-line)
723
(unless (markerp mid-marker)
724
(setq mid-marker (make-marker))
725
(mew-sinfo-set-mid-marker mid-marker))
726
(set-marker mid-marker mid-point)))
727
728
(defun mew-summary-folder-cache-load ()
729
(let* ((folder (mew-summary-folder-name 'ext))
730
(cache (mew-expand-folder folder mew-summary-cache-file)))
731
(when (and (file-readable-p cache)
732
(mew-summary-folder-cache-newp))
733
(mew-elet
734
(mew-erase-buffer)
735
(mew-frwlet
736
mew-cs-m17n mew-cs-dummy
737
(mew-insert-file-contents cache))
738
(mew-sinfo-set-cache-time (mew-file-get-time cache))
739
(if (= (point-max) 1)
740
(setq mew-summary-buffer-raw nil)
741
(setq mew-summary-buffer-raw t))
742
(mew-mark-undo-mark mew-mark-refile 'no-msg)
743
(mew-summary-set-count-line)
744
(set-buffer-modified-p nil)))))
745
746
(defun mew-summary-folder-cache-save ()
747
(let* ((folder (mew-summary-folder-name 'ext))
748
(cache (mew-expand-folder folder mew-summary-cache-file)))
749
(when (file-writable-p cache)
750
(mew-touch-folder folder)
751
(save-restriction
752
(widen)
753
(if (mew-decode-syntax-p)
754
(let ((cbuf (current-buffer))
755
(min (point-min))
756
(max (point-max))
757
(beg (mew-decode-syntax-begin))
758
(end (mew-decode-syntax-end)))
759
(with-temp-buffer
760
(mew-insert-buffer-substring cbuf min beg)
761
(mew-insert-buffer-substring cbuf end max)
762
(mew-frwlet
763
mew-cs-dummy mew-cs-m17n
764
(write-region (point-min) (point-max) cache nil 'no-msg))))
765
;; (write-region 1 1 ...) does not update the file timestamp
766
;; but does the directory timestamp. So, we need to delete
767
;; the file to update the file timestamp.
768
(if (= (point-min) (point-max)) (mew-delete-file cache))
769
(mew-frwlet
770
mew-cs-dummy mew-cs-m17n
771
(write-region (point-min) (point-max) cache nil 'no-msg))
772
(mew-set-file-modes cache))
773
(mew-summary-set-count-line)
774
(mew-sinfo-set-cache-time (mew-file-get-time cache))))))
775
776
;; See also mew-net-folder-clean.
777
(defun mew-summary-folder-cache-clean (folder)
778
"Erase Summary mode then remove and touch the cache file."
779
(if (get-buffer folder)
780
(save-excursion
781
(set-buffer folder)
782
(mew-erase-buffer)
783
(set-buffer-modified-p nil)))
784
(let ((cfile (mew-expand-folder folder mew-summary-cache-file)))
785
(if (file-exists-p cfile)
786
(write-region "" nil cfile nil 'no-msg))))
787
788
(provide 'mew-scan)
789
790
;;; Copyright Notice:
791
792
;; Copyright (C) 1996-2003 Mew developing team.
793
;; All rights reserved.
794
795
;; Redistribution and use in source and binary forms, with or without
796
;; modification, are permitted provided that the following conditions
797
;; are met:
798
;;
799
;; 1. Redistributions of source code must retain the above copyright
800
;; notice, this list of conditions and the following disclaimer.
801
;; 2. Redistributions in binary form must reproduce the above copyright
802
;; notice, this list of conditions and the following disclaimer in the
803
;; documentation and/or other materials provided with the distribution.
804
;; 3. Neither the name of the team nor the names of its contributors
805
;; may be used to endorse or promote products derived from this software
806
;; without specific prior written permission.
807
;;
808
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
809
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
810
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
811
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
812
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
813
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
814
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
815
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
816
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
817
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
818
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
819
820
;;; mew-scan.el ends here
Loggerhead is a web-based interface for Breezy
Version: 2.0.1