Mercurial > emacs

comparison lisp/mail/rmailkwd.el @ 37612:15fa3a1c6e88

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(rmail-read-label): Be sure to work in the Rmail buffer. (rmail-set-label, rmail-next-labeled-message): Likewise.
author Gerd Moellmann <gerd@gnu.org>
date Tue, 08 May 2001 11:17:55 +0000
parents 22d0a2f6a374
children 253f761ad37b
comparison
equal deleted inserted replaced
37611:73f25c014d5c 37612:15fa3a1c6e88
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
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
58 (interactive (list (rmail-read-label "Remove label"))) 58 (interactive (list (rmail-read-label "Remove label")))
59 (rmail-set-label string nil)) 59 (rmail-set-label string nil))
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
124 ;; is in rmail.el now. 126 ;; is in rmail.el now.
125 127
190 (interactive "p\nsMove to next msg with labels: ") 192 (interactive "p\nsMove to next msg with labels: ")
191 (if (string= labels "") 193 (if (string= 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)
198 (current rmail-current-message) 201 (current rmail-current-message)
199 (regexp (concat ", ?\\(" 202 (regexp (concat ", ?\\("