diff options
| -rw-r--r-- | lisp/mail/rmailsort.el | 125 |
1 files changed, 64 insertions, 61 deletions
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el index d0d8eae0d5e..d23433c056e 100644 --- a/lisp/mail/rmailsort.el +++ b/lisp/mail/rmailsort.el | |||
| @@ -3,7 +3,7 @@ | |||
| 3 | ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> | 5 | ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> |
| 6 | ;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/rmailsort.el,v 1.14 1993/05/26 20:28:11 rms Exp rms $ | 6 | ;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/rmailsort.el,v 1.15 1993/06/22 05:55:41 rms Exp rms $ |
| 7 | ;; Keywords: mail | 7 | ;; Keywords: mail |
| 8 | 8 | ||
| 9 | ;; This file is part of GNU Emacs. | 9 | ;; This file is part of GNU Emacs. |
| @@ -115,66 +115,69 @@ If prefix argument REVERSE is non-nil, sort them in reverse order." | |||
| 115 | "Sort messages of current Rmail file. | 115 | "Sort messages of current Rmail file. |
| 116 | If 1st argument REVERSE is non-nil, sort them in reverse order. | 116 | If 1st argument REVERSE is non-nil, sort them in reverse order. |
| 117 | 2nd argument KEYFUN is called with a message number, and should return a key." | 117 | 2nd argument KEYFUN is called with a message number, and should return a key." |
| 118 | (let ((buffer-read-only nil) | 118 | (save-excursion |
| 119 | (predicate nil) ;< or string-lessp | 119 | ;; If we are in a summary buffer, operate on the Rmail buffer. |
| 120 | (sort-lists nil)) | 120 | (if (eq major-mode 'rmail-summary-mode) |
| 121 | (message "Finding sort keys...") | 121 | (set-buffer rmail-buffer)) |
| 122 | (widen) | 122 | (let ((buffer-read-only nil) |
| 123 | (let ((msgnum 1)) | 123 | (predicate nil) ;< or string-lessp |
| 124 | (while (>= rmail-total-messages msgnum) | 124 | (sort-lists nil)) |
| 125 | (setq sort-lists | 125 | (message "Finding sort keys...") |
| 126 | (cons (list (funcall keyfun msgnum) ;Make sorting key | 126 | (widen) |
| 127 | (eq rmail-current-message msgnum) ;True if current | 127 | (let ((msgnum 1)) |
| 128 | (aref rmail-message-vector msgnum) | 128 | (while (>= rmail-total-messages msgnum) |
| 129 | (aref rmail-message-vector (1+ msgnum))) | 129 | (setq sort-lists |
| 130 | sort-lists)) | 130 | (cons (list (funcall keyfun msgnum) ;Make sorting key |
| 131 | (if (zerop (% msgnum 10)) | 131 | (eq rmail-current-message msgnum) ;True if current |
| 132 | (message "Finding sort keys...%d" msgnum)) | 132 | (aref rmail-message-vector msgnum) |
| 133 | (setq msgnum (1+ msgnum)))) | 133 | (aref rmail-message-vector (1+ msgnum))) |
| 134 | (or reverse (setq sort-lists (nreverse sort-lists))) | 134 | sort-lists)) |
| 135 | ;; Decide predicate: < or string-lessp | 135 | (if (zerop (% msgnum 10)) |
| 136 | (if (numberp (car (car sort-lists))) ;Is a key numeric? | 136 | (message "Finding sort keys...%d" msgnum)) |
| 137 | (setq predicate (function <)) | 137 | (setq msgnum (1+ msgnum)))) |
| 138 | (setq predicate (function string-lessp))) | 138 | (or reverse (setq sort-lists (nreverse sort-lists))) |
| 139 | (setq sort-lists | 139 | ;; Decide predicate: < or string-lessp |
| 140 | (sort sort-lists | 140 | (if (numberp (car (car sort-lists))) ;Is a key numeric? |
| 141 | (function | 141 | (setq predicate (function <)) |
| 142 | (lambda (a b) | 142 | (setq predicate (function string-lessp))) |
| 143 | (funcall predicate (car a) (car b)))))) | 143 | (setq sort-lists |
| 144 | (if reverse (setq sort-lists (nreverse sort-lists))) | 144 | (sort sort-lists |
| 145 | ;; Now we enter critical region. So, keyboard quit is disabled. | 145 | (function |
| 146 | (message "Reordering messages...") | 146 | (lambda (a b) |
| 147 | (let ((inhibit-quit t) ;Inhibit quit | 147 | (funcall predicate (car a) (car b)))))) |
| 148 | (current-message nil) | 148 | (if reverse (setq sort-lists (nreverse sort-lists))) |
| 149 | (msgnum 1) | 149 | ;; Now we enter critical region. So, keyboard quit is disabled. |
| 150 | (msginfo nil)) | 150 | (message "Reordering messages...") |
| 151 | ;; There's little hope that we can easily undo after that. | 151 | (let ((inhibit-quit t) ;Inhibit quit |
| 152 | (buffer-flush-undo (current-buffer)) | 152 | (current-message nil) |
| 153 | (goto-char (rmail-msgbeg 1)) | 153 | (msgnum 1) |
| 154 | ;; To force update of all markers. | 154 | (msginfo nil)) |
| 155 | (insert-before-markers ?Z) | 155 | ;; There's little hope that we can easily undo after that. |
| 156 | (backward-char 1) | 156 | (buffer-flush-undo (current-buffer)) |
| 157 | ;; Now reorder messages. | 157 | (goto-char (rmail-msgbeg 1)) |
| 158 | (while sort-lists | 158 | ;; To force update of all markers. |
| 159 | (setq msginfo (car sort-lists)) | 159 | (insert-before-markers ?Z) |
| 160 | ;; Swap two messages. | 160 | (backward-char 1) |
| 161 | (insert-buffer-substring | 161 | ;; Now reorder messages. |
| 162 | (current-buffer) (nth 2 msginfo) (nth 3 msginfo)) | 162 | (while sort-lists |
| 163 | (delete-region (nth 2 msginfo) (nth 3 msginfo)) | 163 | (setq msginfo (car sort-lists)) |
| 164 | ;; Is current message? | 164 | ;; Swap two messages. |
| 165 | (if (nth 1 msginfo) | 165 | (insert-buffer-substring |
| 166 | (setq current-message msgnum)) | 166 | (current-buffer) (nth 2 msginfo) (nth 3 msginfo)) |
| 167 | (setq sort-lists (cdr sort-lists)) | 167 | (delete-region (nth 2 msginfo) (nth 3 msginfo)) |
| 168 | (if (zerop (% msgnum 10)) | 168 | ;; Is current message? |
| 169 | (message "Reordering messages...%d" msgnum)) | 169 | (if (nth 1 msginfo) |
| 170 | (setq msgnum (1+ msgnum))) | 170 | (setq current-message msgnum)) |
| 171 | ;; Delete the garbage inserted before. | 171 | (setq sort-lists (cdr sort-lists)) |
| 172 | (delete-char 1) | 172 | (if (zerop (% msgnum 10)) |
| 173 | (setq quit-flag nil) | 173 | (message "Reordering messages...%d" msgnum)) |
| 174 | (buffer-enable-undo) | 174 | (setq msgnum (1+ msgnum))) |
| 175 | (rmail-set-message-counters) | 175 | ;; Delete the garbage inserted before. |
| 176 | (rmail-show-message current-message)) | 176 | (delete-char 1) |
| 177 | )) | 177 | (setq quit-flag nil) |
| 178 | (buffer-enable-undo) | ||
| 179 | (rmail-set-message-counters) | ||
| 180 | (rmail-show-message current-message))))) | ||
| 178 | 181 | ||
| 179 | (defun rmail-fetch-field (msg field) | 182 | (defun rmail-fetch-field (msg field) |
| 180 | "Return the value of the header FIELD of MSG. | 183 | "Return the value of the header FIELD of MSG. |