« back to all changes in this revision
Viewing changes to mew-sort.el
- browse files at revision 15
- compare with another revision
- download diff
- download tarball
- view history from revision 15
- Committer: Bazaar Package Importer
- Author(s): Tatsuya Kinoshita
- Date: 2008-04-24 00:28:17 UTC
- mfrom: (1.1.12 upstream)
- Revision ID: james.westby@ubuntu.com-20080424002817-68vgq5lfqr8z0795
Tags: 6.0.51~0.20080421-1
New upstream release. (CVS trunk on 2008-04-21)
- files added:
- bin/cmew
- files removed:
- mew-md5.el
- files modified:
- 00changes
added
removed
mew-sort.el
14
14
;;;
15
15
16
16
(defvar mew-sort-switch
17
'(("text" mew-sort-key-text mew-sort-string)
18
("ml" mew-sort-key-ml mew-sort-string)
19
("mlnum" mew-sort-key-mlnum mew-sort-string)
20
("date" mew-sort-key-date mew-sort-string)
21
("num" mew-sort-key-num mew-sort-number)
17
'(("text" mew-sort-key-text mew-sort-string)
18
("ml" mew-sort-key-ml mew-sort-string)
19
("mlnum" mew-sort-key-mlnum mew-sort-string)
20
("date" mew-sort-key-date mew-sort-string)
21
("num" mew-sort-key-num mew-sort-number)
22
22
("postnum" mew-sort-key-postnum mew-sort-number)))
23
23
24
(defsubst mew-sort-key-text (key folder msg)
24
(defun mew-sort-key-text (key folder msg)
25
25
(mew-subject-simplify key nil 'no-replace))
26
26
27
(defsubst mew-sort-key-ml (key folder msg)
28
(let ((ret (mew-subject-simplify key nil 'no-replace)))
29
(if (string-match "^[[(][^])]+[])][ \t]*" ret)
30
(progn
31
(setq ret (substring ret (match-end 0)))
32
(mew-subject-simplify ret nil 'no-replace))
33
ret)))
27
(defun mew-sort-key-ml (key folder msg)
28
(mew-subject-simplify2 key))
34
29
35
(defsubst mew-sort-key-mlnum (key folder msg)
30
(defun mew-sort-key-mlnum (key folder msg)
36
31
(let (mlname mlnum)
37
32
(cond
38
33
((string-match "^\\([[(][^])]+\\)[: ]+\\([0-9]+\\)[])]" key)
46
41
(setq mlnum "0")))
47
42
(concat mlname (format "\000%010d" (string-to-number mlnum)))))
48
43
49
(defsubst mew-sort-key-date (key folder msg)
44
(defun mew-sort-key-date (key folder msg)
50
45
(if (string= key "")
51
46
(let ((time (mew-file-get-time (mew-expand-msg folder msg))))
52
47
(mew-time-ctz-to-sortkey time))
53
48
(mew-time-rfc-to-sortkey key)))
54
49
55
(defsubst mew-sort-key-num (key folder msg)
50
(defun mew-sort-key-num (key folder msg)
56
51
(string-to-number key))
57
52
58
(defsubst mew-sort-key-postnum (key folder msg)
53
(defun mew-sort-key-postnum (key folder msg)
59
54
(if (string-match "[0-9]+$" key)
60
55
(string-to-number (match-string 0 key))
61
56
(string-to-number key)))
62
57
63
(defsubst mew-sort-key (x) (cdr x))
58
(defun mew-sort-key (x) (cdr x))
64
59
65
(defsubst mew-sort-string (x y)
60
(defun mew-sort-string (x y)
66
61
(or (string= (mew-sort-key x) (mew-sort-key y))
67
62
(string< (mew-sort-key x) (mew-sort-key y))))
68
63
69
(defsubst mew-sort-number (x y)
64
(defun mew-sort-number (x y)
70
65
(<= (mew-sort-key x) (mew-sort-key y)))
71
66
72
67
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
73
68
;;;
74
;;; Sort body
69
;;;
75
70
;;;
76
71
77
72
(defvar mew-sort-line nil)
80
75
81
76
(defun mew-sort-insert (line msg)
82
77
(insert line)
83
(save-excursion
84
(forward-line -1)
85
(mew-syntax-change-message-number msg)))
78
(when msg
79
(save-excursion
80
(forward-line -1)
81
(mew-syntax-change-message-number msg))))
82
83
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
84
;;;
85
;;; Moving messages
86
;;;
87
88
(defun mew-summary-sort-move-rename (src dst pos &optional lastp)
89
(rename-file (mew-msg-get-filename src) (mew-msg-new-filename dst))
90
(mew-refile-change src dst)
91
(mew-summary-sort-move src dst pos lastp))
92
93
(defun mew-summary-sort-move-for-selection (src dst pos &optional lastp)
94
(mew-summary-sort-move src nil pos lastp))
86
95
87
96
;; If not found, returns nil.
88
(defun mew-summary-sort-rename (src dst pos &optional lastp)
89
(if (mew-debug 'sort)
90
(mew-elet
91
(insert (format "move %s to %s\n" src dst)))
97
(defun mew-summary-sort-move (src dst pos &optional lastp)
98
(mew-elet
99
(let (beg end line)
100
(cond
101
(lastp
102
(when pos
103
(goto-char pos)
104
(mew-sort-insert mew-sort-line dst)
105
nil))
106
((null pos) ;; first
107
(when (mew-summary-search-msg src)
108
(setq beg (point))
109
(forward-line)
110
(setq end (point))
111
;; We need to keep properties in Summary mode.
112
;; This must be "buffer-substring".
113
(setq mew-sort-line (buffer-substring beg end))
114
(delete-region beg end)
115
beg))
116
(t
117
(when (mew-summary-search-msg src)
118
(setq beg (point))
119
(forward-line)
120
(setq end (point))
121
(cond
122
((< pos beg)
123
;; We need to keep properties in Summary mode.
124
;; This must be "buffer-substring".
125
(setq line (buffer-substring beg end))
126
(goto-char end)
127
(delete-region beg end)
128
(save-excursion
129
(goto-char pos)
130
(mew-sort-insert line dst))
131
(point))
132
((= pos beg)
133
;; We need to keep properties in Summary mode.
134
;; This must be "buffer-substring".
135
(setq line (buffer-substring beg end))
136
(delete-region beg end)
137
(goto-char pos)
138
(mew-sort-insert line dst)
139
(point))
140
(t
141
;; We need to keep properties in Summary mode.
142
;; This must be "buffer-substring".
143
(setq line (buffer-substring beg end))
144
(goto-char pos)
145
(mew-sort-insert line dst)
146
(delete-region beg end)
147
beg))))))))
148
149
(defun mew-summary-sort-move-for-debug (src dst pos &optional lastp)
150
(mew-elet
151
(insert (format "move %s to %s\n" src dst))))
152
153
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
154
;;;
155
;;;
156
;;;
157
158
(defun mew-sort-get-range (arg)
159
(let (region beg end range rbeg rend)
160
(if arg
161
(progn
162
(setq region (mew-summary-get-region))
163
(setq beg (car region))
164
(setq end (cdr region))
165
(if (= beg end) (error "No region")))
166
(setq beg (point-min))
167
(setq end (point-max)))
168
(save-excursion
169
(goto-char beg)
170
(setq rbeg (mew-summary-message-number))
171
(goto-char end)
172
(forward-line -1)
173
(setq rend (mew-summary-message-number))
174
(forward-line)
175
(if (and rbeg rend)
176
(setq range (concat rbeg "-" rend))
177
(error "No region")))
178
(list range beg end)))
179
180
(defun mew-sort-ask-key (folder)
181
(let* ((sort-key (or (mew-alist-get-value
182
(assoc folder mew-sort-default-key-alist))
183
mew-sort-default-key))
184
key type funcs newkey)
185
(mew-set '(key type) (mew-input-sort-key sort-key))
186
(setq funcs (assoc type mew-sort-switch))
187
(setq newkey (concat (capitalize key) ":"))
188
(cons newkey (cdr funcs))))
189
190
(defun mew-sort-get-file-index (folder range key func1 func2)
191
(let* ((i 0)
192
(fld (mew-expand-folder2 folder))
193
num med value ent files idx)
194
(with-temp-buffer
195
(apply 'call-process
196
mew-prog-mewl nil t nil
197
(append (list "-b" mew-mail-path "-l" "0"
198
"-x" mew-suffix
199
"-d" key)
200
(mew-scan-mewl-src fld range)))
201
(goto-char (point-min))
202
(while (not (eobp))
203
(if (not (looking-at "^\\([0-9]+\\)[ \t]*:[ \t]*"))
204
(forward-line)
205
(setq num (mew-match-string 1))
206
(setq med (match-end 0))
207
(forward-line)
208
(mew-header-goto-next)
209
(mew-header-decode-region key med (point))
210
(setq value (mew-buffer-substring med (1- (point))))
211
(setq files (cons num files))
212
(setq ent (cons (cons i (funcall func1 value folder num)) ent))
213
(setq i (1+ i)))))
214
(setq files (vconcat (nreverse files)))
215
(setq ent (sort ent func2))
216
(setq idx (vconcat (mapcar 'mew-sort-index ent)))
217
(list files idx)))
218
219
(defun mew-sort-files (folder files idx func)
220
;;
221
;; sorted sorted
222
;; files idx -> files
223
;; 0 10 1 (was 20)
224
;; 1 20 2 (was 30)
225
;; 2 30 0 (was 10)
226
;; 31(new)
227
;;
228
;;
229
;; src dst
230
;; 10 0 (*a) 31 (*b)
231
;; 20 1 idx[0] 10 0
232
;; 30 2 idx[1] 20 1
233
;; 31 0 idx[2] 30 2
234
;; (*c)
235
;; *a: initial src is 0
236
;; *b: initial files[dst] is 31 (new tmp file)
237
;; *c: break condition, src is looped!
238
;; files[src] is 31 (new tmp file)
239
;;
240
(let* ((dir (mew-expand-folder folder))
241
(default-directory dir)
242
(len (length idx)) ;; not (length files)
243
(tmp (mew-folder-new-message folder 'num-only))
244
src dst pos)
245
(dotimes (i len)
246
(setq mew-sort-line nil)
247
(unless (= i (aref idx i))
248
(setq dst len)
249
(setq src i)
250
(setq pos (funcall func (aref files src) tmp nil))
251
(catch 'loop
252
(while t
253
(setq dst src)
254
(setq src (aref idx dst))
255
(if (= src i) (throw 'loop nil))
256
(setq pos (funcall func (aref files src) (aref files dst) pos))
257
(aset idx dst dst)))
258
(funcall func tmp (aref files dst) pos 'last)
259
(aset idx dst dst)))))
260
261
(defun mew-sort-push-mark ()
262
(unless (eobp)
263
(beginning-of-line)
92
264
(mew-elet
93
(let (beg end line)
94
(rename-file (mew-msg-get-filename src) (mew-msg-new-filename dst))
95
(mew-refile-change src dst)
96
(cond
97
(lastp
98
(when pos
99
(goto-char pos)
100
(mew-sort-insert mew-sort-line dst)
101
nil))
102
((null pos) ;; first
103
(when (mew-summary-search-msg src)
104
(setq beg (point))
105
(forward-line)
106
(setq end (point))
107
;; We need to keep properties in Summary mode.
108
;; This must be "buffer-substring".
109
(setq mew-sort-line (buffer-substring beg end))
110
(delete-region beg end)
111
beg))
112
(t
113
(when (mew-summary-search-msg src)
114
(setq beg (point))
115
(forward-line)
116
(setq end (point))
117
(cond
118
((< pos beg)
119
;; We need to keep properties in Summary mode.
120
;; This must be "buffer-substring".
121
(setq line (buffer-substring beg end))
122
(goto-char end)
123
(delete-region beg end)
124
(save-excursion
125
(goto-char pos)
126
(mew-sort-insert line dst))
127
(point))
128
((= pos beg)
129
;; We need to keep properties in Summary mode.
130
;; This must be "buffer-substring".
131
(setq line (buffer-substring beg end))
132
(delete-region beg end)
133
(goto-char pos)
134
(mew-sort-insert line dst)
135
(point))
136
(t
137
;; We need to keep properties in Summary mode.
138
;; This must be "buffer-substring".
139
(setq line (buffer-substring beg end))
140
(goto-char pos)
141
(mew-sort-insert line dst)
142
(delete-region beg end)
143
beg)))))))))
265
(put-text-property (point) (1+ (point)) 'mew-sort-orig t))))
266
267
(defun mew-sort-pop-mark ()
268
(let ((orig (next-single-property-change (point-min) 'mew-sort-orig)))
269
;; 'mew-sort-orig may start with bob.
270
(if (null orig)
271
(mew-push-mark)
272
(save-excursion
273
(goto-char orig)
274
(beginning-of-line)
275
(setq orig (point)))
276
(mew-elet
277
;; 'mew-sort-orig is copied onto the entire message
278
;; number. (window-width) is long enough to remove
279
;; it.
280
(remove-text-properties
281
orig (+ orig (window-width)) '(mew-sort-orig nil)))
282
(mew-push-mark))))
283
284
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
285
;;;
286
;;; Sort bodies
287
;;;
288
289
(defun mew-summary-sort-body (folder arg)
290
(let (key idx files range beg end func1 func2 diag)
291
;; Summary cache updates
292
(mew-summary-reset)
293
(mew-summary-retrieve-gap folder)
294
;;
295
(mew-set '(range beg end) (mew-sort-get-range arg))
296
(mew-set '(key func1 func2) (mew-sort-ask-key folder))
297
(setq diag (if arg folder (format "%s: %s" folder range)))
298
;;
299
(message "Sorting %s..." diag)
300
(mew-summary-lock t "Sorting")
301
(unwind-protect
302
(progn
303
(mew-set '(files idx) (mew-sort-get-file-index folder range key func1 func2))
304
;;
305
(mew-sort-push-mark)
306
(if arg (narrow-to-region beg end))
307
;;
308
(mew-sort-files folder files idx 'mew-summary-sort-move-rename)
309
;;
310
(goto-char (point-min))
311
(if arg (widen))
312
(mew-sort-pop-mark)
313
;;
314
(run-hooks 'mew-sort-hook)
315
(message "Sorting %s...done. Type '%s' to update ID database" diag (mew-substitute-for-summary "\\[mew-summary-make-id-index-folder]")))
316
(mew-summary-folder-cache-save)
317
(set-buffer-modified-p nil)
318
(mew-summary-unlock))))
319
320
(defun mew-summary-sort-body-for-debug (folder arg)
321
(let ((win (selected-window))
322
key idx files range func1 func2 diag)
323
(mew-set '(range beg end) (mew-sort-get-range arg))
324
(mew-set '(key func1 func2) (mew-sort-ask-key folder))
325
(setq diag (if arg folder (format "%s: %s" folder range)))
326
;;
327
(message "Sorting %s..." diag)
328
(mew-summary-lock t "Sorting")
329
(unwind-protect
330
(mew-set '(files idx) (mew-sort-get-file-index folder range key func1 func2))
331
(mew-summary-unlock))
332
(when (and files idx)
333
(mew-window-configure 'message)
334
;; message buffer
335
(mew-elet
336
(mew-erase-buffer)
337
(insert "Sort as follows:\n"))
338
;;
339
(unwind-protect
340
(progn
341
(mew-sort-files folder files idx 'mew-summary-sort-move-for-debug)
342
(message "Sorting %s...done" diag))
343
(mew-message-clear-end-of)
344
(set-buffer-modified-p nil)
345
(goto-char (point-min))
346
(select-window win)))))
347
348
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
349
;;;
350
;;; Sort command
351
;;;
144
352
145
353
(defun mew-summary-sort (&optional arg)
146
354
"Sort messages and list them up again.
147
355
If called with '\\[universal-argument]', sort the region.
148
356
After sorting, the cursor moves onto the beginning of the buffer
149
or the region.
150
151
If this command is used in a remote folder, local cache messages are
152
sorted. But if you do so, '\\<mew-summary-mode-map>\\[mew-summary-ls]' + 'sync' would not work well."
357
or the region. "
153
358
(interactive "P")
154
359
(mew-summary-only
155
360
(mew-summary-local-only
161
366
(if (null folder)
162
367
(message "No message")
163
368
(if (mew-mark-active-p) (setq arg t))
164
(mew-summary-sort-body folder arg))))))))))
165
166
(defun mew-summary-sort-body (folder arg)
167
(let ((win (selected-window))
168
key type idx files range beg end)
169
;;
170
;; Summary cache updates
171
;;
172
(mew-summary-reset)
173
(mew-summary-retrieve-gap folder)
174
;;
175
;; Determining range
176
;;
177
(let (region rbeg rend)
178
(if arg
369
(if (mew-debug 'sort)
370
(mew-summary-sort-body-for-debug folder arg)
371
(mew-summary-sort-body folder arg)))))))))))
372
373
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
374
;;;
375
;;; Sort for selection
376
;;;
377
378
(defun mew-summary-selection-by-sort-body (arg)
379
(let* ((buf (current-buffer))
380
(ofolder (mew-summary-folder-name 'ext))
381
(vfolder (mew-folder-to-selection ofolder))
382
(pfolder (mew-summary-physical-folder))
383
key idx files range beg end func1 func2 diag)
384
(mew-set '(range beg end) (mew-sort-get-range arg))
385
(mew-set '(key func1 func2) (mew-sort-ask-key ofolder))
386
(setq diag (if arg ofolder (format "%s: %s" ofolder range)))
387
;;
388
(message "Sorting %s..." diag)
389
(mew-summary-lock t "Sorting")
390
(unwind-protect
391
(mew-set '(files idx) (mew-sort-get-file-index ofolder range key func1 func2))
392
(mew-summary-unlock))
393
(when (and files idx)
394
(mew-summary-switch-to-folder vfolder)
395
(mew-vinfo-set-mode 'selection)
396
(mew-vinfo-set-physical-folder pfolder)
397
(mew-vinfo-set-original-folder ofolder)
398
(unwind-protect
179
399
(progn
180
(setq region (mew-summary-get-region))
181
(setq beg (car region))
182
(setq end (cdr region))
183
(if (= beg end) (error "No region")))
184
(setq beg (point-min))
185
(setq end (point-max)))
186
(goto-char beg)
187
(setq rbeg (mew-summary-message-number))
188
(goto-char end)
189
(forward-line -1)
190
(setq rend (mew-summary-message-number))
191
(forward-line)
192
(if (and rbeg rend)
193
(setq range (concat rbeg "-" rend))
194
(error "No region")))
195
;;
196
;; Asking a sort key after range
197
;;
198
(let* ((sort-key (or (cdr (assoc folder mew-sort-default-key-alist))
199
mew-sort-default-key))
200
(key-type (mew-input-sort-key sort-key)))
201
(setq type (cdr key-type))
202
(setq key (concat (capitalize (car key-type)) ":")))
203
;;
204
(if arg
205
(message "Sorting %s: %s..." folder range)
206
(message "Sorting %s..." folder))
207
(mew-summary-lock t "Sorting")
208
(condition-case nil
209
(progn
210
;;
211
;; Calling mewl
212
;;
213
(let* ((funcs (assoc type mew-sort-switch))
214
(func1 (nth 1 funcs))
215
(func2 (nth 2 funcs))
216
(i 0)
217
(fld (mew-expand-folder2 folder))
218
num med value ent)
219
(with-temp-buffer
220
(apply 'call-process
221
mew-prog-mewl nil t nil
222
(append (list "-b" mew-mail-path "-l" "0"
223
"-x" mew-suffix
224
"-d" key)
225
(mew-scan-mewl-src fld range)))
226
(goto-char (point-min))
227
(while (not (eobp))
228
(if (not (looking-at "^\\([0-9]+\\)[ \t]*:[ \t]*"))
229
(forward-line)
230
(setq num (mew-match-string 1))
231
(setq med (match-end 0))
232
(forward-line)
233
(mew-header-goto-next)
234
(mew-header-decode-region key med (point))
235
(setq value (mew-buffer-substring med (1- (point))))
236
(setq files (cons num files))
237
(setq ent (cons (cons i (funcall func1 value folder num)) ent))
238
(setq i (1+ i)))))
239
(setq files (vconcat (nreverse files)))
240
(setq ent (sort ent func2))
241
(setq idx (vconcat (mapcar 'mew-sort-index ent))))
242
;;
243
(when (mew-debug 'sort)
244
(mew-window-configure 'message)
245
;; message buffer
246
(mew-elet
247
(mew-erase-buffer)
248
(insert "Sort as follows:\n")))
249
(when (and (not (mew-debug 'sort)) (not (eobp)))
250
(beginning-of-line)
251
(mew-elet
252
(put-text-property (point) (1+ (point)) 'mew-sort-orig t)))
253
;;
254
(if arg (narrow-to-region beg end))
255
;;
256
;; sorted sorted
257
;; files idx -> files
258
;; 0 10 1 (was 20)
259
;; 1 20 2 (was 30)
260
;; 2 30 0 (was 10)
261
;; 31(new)
262
;;
263
;;
264
;; src dst
265
;; 10 0 (*a) 31 (*b)
266
;; 20 1 idx[0] 10 0
267
;; 30 2 idx[1] 20 1
268
;; 31 0 idx[2] 30 2
269
;; (*c)
270
;; *a: initial src is 0
271
;; *b: initial files[dst] is 31 (new tmp file)
272
;; *c: break condition, src is looped!
273
;; files[src] is 31 (new tmp file)
274
;;
275
(let* ((dir (mew-expand-folder folder))
276
(default-directory dir)
277
(len (length idx)) ;; not (length files)
278
(tmp (mew-folder-new-message folder 'num-only))
279
(i 0)
280
src dst pos)
281
(while (< i len)
282
(setq mew-sort-line nil)
283
(unless (= i (aref idx i))
284
(setq dst len)
285
(setq src i)
286
(setq pos (mew-summary-sort-rename (aref files src) tmp nil))
287
(catch 'loop
288
(while t
289
(setq dst src)
290
(setq src (aref idx dst))
291
(if (= src i) (throw 'loop nil))
292
(setq pos (mew-summary-sort-rename (aref files src) (aref files dst) pos))
293
(aset idx dst dst)))
294
(mew-summary-sort-rename tmp (aref files dst) pos 'last)
295
(aset idx dst dst))
296
(setq i (1+ i))))
297
;; The cursor moves onto point-min of the region.
298
(unless (mew-debug 'sort)
299
(goto-char (point-min)))
300
(if arg (widen))
301
;;
302
(cond
303
((mew-debug 'sort)
304
(mew-message-clear-end-of)
305
(set-buffer-modified-p nil)
306
(goto-char (point-min))
307
(select-window win))
308
(t
309
(let ((orig (next-single-property-change
310
(point-min) 'mew-sort-orig)))
311
;; 'mew-sort-orig may start with bob.
312
(if (null orig)
313
(mew-push-mark)
314
(save-excursion
315
(goto-char orig)
316
(beginning-of-line)
317
(setq orig (point)))
318
(mew-elet
319
;; 'mew-sort-orig is copied onto the entire message
320
;; number. (window-width) is long enough to remove
321
;; it.
322
(remove-text-properties
323
orig (+ orig (window-width)) '(mew-sort-orig nil)))
324
(mew-push-mark)))
325
(mew-summary-folder-cache-save)
326
(set-buffer-modified-p nil)))
327
;;
328
(mew-summary-unlock)
329
(unless (mew-debug 'sort)
330
(run-hooks 'mew-sort-hook))
331
(if arg
332
(message "Sorting %s: %s...done" folder range)
333
(message "Sorting %s...done" folder)))
334
(quit
335
(select-window win)
336
(set-buffer-modified-p nil)
337
(mew-summary-unlock)))))
338
400
(mew-erase-buffer)
401
(mew-elet
402
(insert (save-excursion (set-buffer buf) (buffer-substring beg end)))
403
(mew-sort-files ofolder files idx 'mew-summary-sort-move-for-selection)
404
(mew-summary-set-count-line)
405
(goto-char (point-min))
406
(message "Sorting %s...done" diag)))
407
(set-buffer-modified-p nil)))))
408
409
(defun mew-summary-selection-by-sort (&optional arg)
410
(interactive "P")
411
(mew-summary-only
412
(mew-summary-not-in-queue
413
(mew-summary-not-in-draft
414
(mew-summary-with-mewl
415
(when (mew-summary-exclusive-p)
416
(if (mew-mark-active-p) (setq arg t))
417
(mew-summary-selection-by-sort-body arg)))))))
418
339
419
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
340
420
;;;
341
421
;;; Packing
374
454
(let* ((dir (mew-expand-folder folder))
375
455
(default-directory dir)
376
456
(n 1)
377
msgs msg src dst)
457
msgs src dst)
378
458
;;
379
459
(mew-summary-reset)
380
460
(mew-summary-retrieve-gap folder)
389
469
;; the cursor stays the current position.
390
470
(save-excursion
391
471
(goto-char (point-min))
392
(while msgs
393
(setq msg (car msgs))
394
(setq msgs (cdr msgs))
472
(dolist (msg msgs)
395
473
(setq src (number-to-string msg))
396
474
(cond
397
475
((= msg n);; including src is a directory
409
487
(set-buffer-modified-p nil)
410
488
(mew-summary-unlock)
411
489
(run-hooks 'mew-pack-hook)
412
(message "Packing %s...done (the last is %d)" folder (1- n)))
490
(message "Packing %s...done (the last is %d). Type '%s' to update ID database" folder (1- n) (mew-substitute-for-summary "\\[mew-summary-make-id-index-folder]")))
413
491
(quit
414
492
(set-buffer-modified-p nil)
415
493
(mew-summary-unlock)))))
418
496
419
497
;;; Copyright Notice:
420
498
421
;; Copyright (C) 1996-2007 Mew developing team.
499
;; Copyright (C) 1996-2008 Mew developing team.
422
500
;; All rights reserved.
423
501
424
502
;; Redistribution and use in source and binary forms, with or without
425
503
;; modification, are permitted provided that the following conditions
426
504
;; are met:
427
;;
505
;;
428
506
;; 1. Redistributions of source code must retain the above copyright
429
507
;; notice, this list of conditions and the following disclaimer.
430
508
;; 2. Redistributions in binary form must reproduce the above copyright
433
511
;; 3. Neither the name of the team nor the names of its contributors
434
512
;; may be used to endorse or promote products derived from this software
435
513
;; without specific prior written permission.
436
;;
514
;;
437
515
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
438
516
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
439
517
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
Loggerhead is a web-based interface for Breezy
Version: 2.0.1