1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
1 |
;;; mew-sort.el --- Sorting messages for Mew
|
2 |
||
3 |
;; Author: Takashi P.KATOH <p-katoh@shiratori.riec.tohoku.ac.jp>
|
|
4 |
;; Kazu Yamamoto <Kazu@Mew.org>
|
|
5 |
;; Created: Feb 6, 1996
|
|
6 |
||
7 |
;;; Code:
|
|
8 |
||
9 |
(require 'mew) |
|
10 |
||
11 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
12 |
;;;
|
|
13 |
;;; Sort variety
|
|
14 |
;;;
|
|
15 |
||
16 |
(defvar mew-sort-switch |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
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) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
22 |
("postnum" mew-sort-key-postnum mew-sort-number))) |
23 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
24 |
(defun mew-sort-key-text (key folder msg) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
25 |
(mew-subject-simplify key nil 'no-replace)) |
26 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
27 |
(defun mew-sort-key-ml (key folder msg) |
28 |
(mew-subject-simplify2 key)) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
29 |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
30 |
(defun mew-sort-key-mlnum (key folder msg) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
31 |
(let (mlname mlnum) |
32 |
(cond |
|
33 |
((string-match "^\\([[(][^])]+\\)[: ]+\\([0-9]+\\)[])]" key) |
|
34 |
(setq mlname (match-string 1 key)) |
|
35 |
(setq mlnum (match-string 2 key))) |
|
36 |
((string-match "^[0-9]+$" key) |
|
37 |
(setq mlname "") |
|
38 |
(setq mlnum (match-string 0 key))) |
|
39 |
(t |
|
40 |
(setq mlname "") |
|
41 |
(setq mlnum "0"))) |
|
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
42 |
(concat mlname (format "\000%010d" (string-to-number mlnum))))) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
43 |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
44 |
(defun mew-sort-key-date (key folder msg) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
45 |
(if (string= key "") |
1.1.2
by Tatsuya Kinoshita
Import upstream version 5.0.53 |
46 |
(let ((time (mew-file-get-time (mew-expand-msg folder msg)))) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
47 |
(mew-time-ctz-to-sortkey time)) |
48 |
(mew-time-rfc-to-sortkey key))) |
|
49 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
50 |
(defun mew-sort-key-num (key folder msg) |
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
51 |
(string-to-number key)) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
52 |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
53 |
(defun mew-sort-key-postnum (key folder msg) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
54 |
(if (string-match "[0-9]+$" key) |
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
55 |
(string-to-number (match-string 0 key)) |
56 |
(string-to-number key))) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
57 |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
58 |
(defun mew-sort-key (x) (cdr x)) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
59 |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
60 |
(defun mew-sort-string (x y) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
61 |
(or (string= (mew-sort-key x) (mew-sort-key y)) |
62 |
(string< (mew-sort-key x) (mew-sort-key y)))) |
|
63 |
||
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
64 |
(defun mew-sort-number (x y) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
65 |
(<= (mew-sort-key x) (mew-sort-key y))) |
66 |
||
67 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
68 |
;;;
|
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
69 |
;;;
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
70 |
;;;
|
71 |
||
72 |
(defvar mew-sort-line nil) |
|
73 |
||
74 |
(defun mew-sort-index (x) (car x)) |
|
75 |
||
76 |
(defun mew-sort-insert (line msg) |
|
77 |
(insert line) |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
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)) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
95 |
|
96 |
;; If not found, returns nil.
|
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
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) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
264 |
(mew-elet |
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
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 |
;;;
|
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
352 |
|
353 |
(defun mew-summary-sort (&optional arg) |
|
354 |
"Sort messages and list them up again.
|
|
355 |
If called with '\\[universal-argument]', sort the region.
|
|
356 |
After sorting, the cursor moves onto the beginning of the buffer
|
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
357 |
or the region. "
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
358 |
(interactive "P") |
359 |
(mew-summary-only |
|
360 |
(mew-summary-local-only |
|
361 |
(mew-summary-not-in-queue |
|
362 |
(mew-summary-not-in-draft |
|
363 |
(mew-summary-with-mewl |
|
364 |
(when (mew-summary-exclusive-p) |
|
365 |
(let ((folder (mew-summary-folder-name))) |
|
366 |
(if (null folder) |
|
367 |
(message "No message") |
|
368 |
(if (mew-mark-active-p) (setq arg t)) |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
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 |
|
3
by Tatsuya Kinoshita
* bin/incm.c: Fix a format string bug which causes crashes from environment |
399 |
(progn |
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
400 |
(mew-erase-buffer) |
401 |
(mew-elet |
|
1.2.5
by Tatsuya Kinoshita
Import upstream version 7.0.50~0.20100105 |
402 |
(insert (with-current-buffer buf (buffer-substring beg end))) |
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
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 |
||
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
419 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
420 |
;;;
|
|
421 |
;;; Packing
|
|
422 |
;;;
|
|
423 |
||
424 |
(defun mew-summary-pack-rename (src dst) |
|
425 |
(mew-elet |
|
1.1.2
by Tatsuya Kinoshita
Import upstream version 5.0.53 |
426 |
(rename-file (mew-msg-get-filename src) (mew-msg-new-filename dst)) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
427 |
(mew-refile-change src dst) |
428 |
(when (re-search-forward (mew-regex-sumsyn-msg src) nil t) |
|
429 |
(mew-syntax-change-message-number2 dst) |
|
430 |
(forward-line)))) |
|
431 |
||
1.2.1
by Tatsuya Kinoshita
Import upstream version 5.1.52~0.20061031 |
432 |
(defun mew-summary-pack (&optional force) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
433 |
"Pack messages and list them up again.
|
434 |
After packing, the cursor stays in the current message.
|
|
435 |
If this command is used in a remote folder,
|
|
436 |
local cache messages are packed."
|
|
1.2.1
by Tatsuya Kinoshita
Import upstream version 5.1.52~0.20061031 |
437 |
(interactive "P") |
438 |
(if (not force) |
|
439 |
(message (mew-substitute-for-summary |
|
440 |
"Pack breaks search index, so pack was obsoleted. Type '\\[universal-argument]\\[mew-summary-pack]' to force pack.")) |
|
441 |
(mew-summary-only |
|
442 |
(mew-summary-local-only |
|
443 |
(mew-summary-not-in-queue |
|
444 |
(mew-summary-not-in-draft |
|
445 |
(when (mew-summary-exclusive-p) |
|
446 |
(let ((folder (mew-summary-folder-name))) |
|
447 |
(cond |
|
448 |
((null folder) |
|
449 |
(message "No message")) |
|
450 |
((or (not mew-ask-pack) (y-or-n-p (format "Pack %s? " folder))) |
|
451 |
(mew-summary-pack-body folder))))))))))) |
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
452 |
|
453 |
(defun mew-summary-pack-body (folder) |
|
454 |
(let* ((dir (mew-expand-folder folder)) |
|
455 |
(default-directory dir) |
|
456 |
(n 1) |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
457 |
msgs src dst) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
458 |
;;
|
459 |
(mew-summary-reset) |
|
460 |
(mew-summary-retrieve-gap folder) |
|
461 |
;;
|
|
462 |
(message "Packing %s..." folder) |
|
463 |
(mew-summary-lock t "Packing") |
|
464 |
(condition-case nil |
|
465 |
(progn |
|
466 |
(setq msgs (mew-dir-messages ".")) |
|
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
467 |
(setq msgs (mapcar 'string-to-number msgs)) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
468 |
(setq msgs (sort msgs '<)) ;; sort is inevitable |
469 |
;; the cursor stays the current position.
|
|
470 |
(save-excursion |
|
471 |
(goto-char (point-min)) |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
472 |
(dolist (msg msgs) |
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
473 |
(setq src (number-to-string msg)) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
474 |
(cond |
475 |
((= msg n);; including src is a directory |
|
476 |
(setq n (1+ n))) |
|
477 |
((file-directory-p src) |
|
478 |
)
|
|
479 |
(t |
|
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
480 |
(setq dst (number-to-string n)) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
481 |
(while (file-exists-p dst) |
482 |
(setq n (1+ n)) |
|
1.1.1
by Tatsuya Kinoshita
Import upstream version 4.2.52 |
483 |
(setq dst (number-to-string n))) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
484 |
(mew-summary-pack-rename src dst) |
485 |
(setq n (1+ n)))))) |
|
486 |
(mew-summary-folder-cache-save) |
|
487 |
(set-buffer-modified-p nil) |
|
488 |
(mew-summary-unlock) |
|
489 |
(run-hooks 'mew-pack-hook) |
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
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]"))) |
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
491 |
(quit |
492 |
(set-buffer-modified-p nil) |
|
493 |
(mew-summary-unlock))))) |
|
494 |
||
495 |
(provide 'mew-sort) |
|
496 |
||
497 |
;;; Copyright Notice:
|
|
498 |
||
1.2.5
by Tatsuya Kinoshita
Import upstream version 7.0.50~0.20100105 |
499 |
;; Copyright (C) 1996-2010 Mew developing team.
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
500 |
;; All rights reserved.
|
501 |
||
502 |
;; Redistribution and use in source and binary forms, with or without
|
|
503 |
;; modification, are permitted provided that the following conditions
|
|
504 |
;; are met:
|
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
505 |
;;
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
506 |
;; 1. Redistributions of source code must retain the above copyright
|
507 |
;; notice, this list of conditions and the following disclaimer.
|
|
508 |
;; 2. Redistributions in binary form must reproduce the above copyright
|
|
509 |
;; notice, this list of conditions and the following disclaimer in the
|
|
510 |
;; documentation and/or other materials provided with the distribution.
|
|
511 |
;; 3. Neither the name of the team nor the names of its contributors
|
|
512 |
;; may be used to endorse or promote products derived from this software
|
|
513 |
;; without specific prior written permission.
|
|
1.1.12
by Tatsuya Kinoshita
Import upstream version 6.0.51~0.20080421 |
514 |
;;
|
1
by Tatsuya Kinoshita
Import upstream version 4.0.65 |
515 |
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
|
516 |
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
517 |
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
|
518 |
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
|
|
519 |
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
|
520 |
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
|
521 |
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
|
|
522 |
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
|
523 |
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
|
|
524 |
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
|
|
525 |
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
526 |
||
527 |
;;; mew-sort.el ends here
|