diff options
| -rw-r--r-- | lisp/mail/rmailkwd.el | 111 |
1 files changed, 57 insertions, 54 deletions
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index dfafab38e60..4b5d73045aa 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs. | 1 | ;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 1988, 1994 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1985, 1988, 1994, 2001 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Maintainer: FSF | 5 | ;; Maintainer: FSF |
| 6 | ;; Keywords: mail | 6 | ;; Keywords: mail |
| @@ -60,64 +60,66 @@ Completion is performed over known labels when reading." | |||
| 60 | 60 | ||
| 61 | ;;;###autoload | 61 | ;;;###autoload |
| 62 | (defun rmail-read-label (prompt) | 62 | (defun rmail-read-label (prompt) |
| 63 | (if (not rmail-keywords) (rmail-parse-file-keywords)) | 63 | (with-current-buffer rmail-buffer |
| 64 | (let ((result | 64 | (if (not rmail-keywords) (rmail-parse-file-keywords)) |
| 65 | (completing-read (concat prompt | 65 | (let ((result |
| 66 | (if rmail-last-label | 66 | (completing-read (concat prompt |
| 67 | (concat " (default " | 67 | (if rmail-last-label |
| 68 | (symbol-name rmail-last-label) | 68 | (concat " (default " |
| 69 | "): ") | 69 | (symbol-name rmail-last-label) |
| 70 | ": ")) | 70 | "): ") |
| 71 | rmail-label-obarray | 71 | ": ")) |
| 72 | nil | 72 | rmail-label-obarray |
| 73 | nil))) | 73 | nil |
| 74 | (if (string= result "") | 74 | nil))) |
| 75 | rmail-last-label | 75 | (if (string= result "") |
| 76 | (setq rmail-last-label (rmail-make-label result t))))) | 76 | rmail-last-label |
| 77 | (setq rmail-last-label (rmail-make-label result t)))))) | ||
| 77 | 78 | ||
| 78 | (defun rmail-set-label (l state &optional n) | 79 | (defun rmail-set-label (l state &optional n) |
| 79 | (rmail-maybe-set-message-counters) | 80 | (with-current-buffer rmail-buffer |
| 80 | (if (not n) (setq n rmail-current-message)) | 81 | (rmail-maybe-set-message-counters) |
| 81 | (aset rmail-summary-vector (1- n) nil) | 82 | (if (not n) (setq n rmail-current-message)) |
| 82 | (let* ((attribute (rmail-attribute-p l)) | 83 | (aset rmail-summary-vector (1- n) nil) |
| 83 | (keyword (and (not attribute) | 84 | (let* ((attribute (rmail-attribute-p l)) |
| 84 | (or (rmail-keyword-p l) | 85 | (keyword (and (not attribute) |
| 85 | (rmail-install-keyword l)))) | 86 | (or (rmail-keyword-p l) |
| 86 | (label (or attribute keyword))) | 87 | (rmail-install-keyword l)))) |
| 87 | (if label | 88 | (label (or attribute keyword))) |
| 88 | (let ((omax (- (buffer-size) (point-max))) | 89 | (if label |
| 89 | (omin (- (buffer-size) (point-min))) | 90 | (let ((omax (- (buffer-size) (point-max))) |
| 90 | (buffer-read-only nil) | 91 | (omin (- (buffer-size) (point-min))) |
| 91 | (case-fold-search t)) | 92 | (buffer-read-only nil) |
| 92 | (unwind-protect | 93 | (case-fold-search t)) |
| 93 | (save-excursion | 94 | (unwind-protect |
| 94 | (widen) | 95 | (save-excursion |
| 95 | (goto-char (rmail-msgbeg n)) | 96 | (widen) |
| 96 | (forward-line 1) | 97 | (goto-char (rmail-msgbeg n)) |
| 97 | (if (not (looking-at "[01],")) | 98 | (forward-line 1) |
| 98 | nil | 99 | (if (not (looking-at "[01],")) |
| 99 | (let ((start (1+ (point))) | 100 | nil |
| 100 | (bound)) | 101 | (let ((start (1+ (point))) |
| 101 | (narrow-to-region (point) (progn (end-of-line) (point))) | 102 | (bound)) |
| 102 | (setq bound (point-max)) | 103 | (narrow-to-region (point) (progn (end-of-line) (point))) |
| 103 | (search-backward ",," nil t) | 104 | (setq bound (point-max)) |
| 104 | (if attribute | 105 | (search-backward ",," nil t) |
| 105 | (setq bound (1+ (point))) | 106 | (if attribute |
| 106 | (setq start (1+ (point)))) | 107 | (setq bound (1+ (point))) |
| 107 | (goto-char start) | 108 | (setq start (1+ (point)))) |
| 108 | ; (while (re-search-forward "[ \t]*,[ \t]*" nil t) | 109 | (goto-char start) |
| 109 | ; (replace-match ",")) | 110 | ; (while (re-search-forward "[ \t]*,[ \t]*" nil t) |
| 110 | ; (goto-char start) | 111 | ; (replace-match ",")) |
| 111 | (if (re-search-forward | 112 | ; (goto-char start) |
| 113 | (if (re-search-forward | ||
| 112 | (concat ", " (rmail-quote-label-name label) ",") | 114 | (concat ", " (rmail-quote-label-name label) ",") |
| 113 | bound | 115 | bound |
| 114 | 'move) | 116 | 'move) |
| 115 | (if (not state) (replace-match ",")) | 117 | (if (not state) (replace-match ",")) |
| 116 | (if state (insert " " (symbol-name label) ","))) | 118 | (if state (insert " " (symbol-name label) ","))) |
| 117 | (if (eq label rmail-deleted-label) | 119 | (if (eq label rmail-deleted-label) |
| 118 | (rmail-set-message-deleted-p n state))))) | 120 | (rmail-set-message-deleted-p n state))))) |
| 119 | (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)) | 121 | (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)) |
| 120 | (if (= n rmail-current-message) (rmail-display-labels))))))) | 122 | (if (= n rmail-current-message) (rmail-display-labels)))))))) |
| 121 | 123 | ||
| 122 | ;; Commented functions aren't used by RMAIL but might be nice for user | 124 | ;; Commented functions aren't used by RMAIL but might be nice for user |
| 123 | ;; packages that do stuff with RMAIL. Note that rmail-message-labels-p | 125 | ;; packages that do stuff with RMAIL. Note that rmail-message-labels-p |
| @@ -192,6 +194,7 @@ With prefix argument N moves forward N messages with these labels." | |||
| 192 | (setq labels rmail-last-multi-labels)) | 194 | (setq labels rmail-last-multi-labels)) |
| 193 | (or labels | 195 | (or labels |
| 194 | (error "No labels to find have been specified previously")) | 196 | (error "No labels to find have been specified previously")) |
| 197 | (set-buffer rmail-buffer) | ||
| 195 | (setq rmail-last-multi-labels labels) | 198 | (setq rmail-last-multi-labels labels) |
| 196 | (rmail-maybe-set-message-counters) | 199 | (rmail-maybe-set-message-counters) |
| 197 | (let ((lastwin rmail-current-message) | 200 | (let ((lastwin rmail-current-message) |