1 ;;; pmailkwd.el --- part of the "PMAIL" mail reader for Emacs
3 ;; Copyright (C) 1985, 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009 Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
30 ;; Global to all PMAIL buffers. It exists primarily for the sake of
31 ;; completion. It is better to use strings with the label functions
32 ;; and let them worry about making the label.
34 (defvar pmail-label-obarray
(make-vector 47 0))
36 (mapc (function (lambda (s) (intern s pmail-label-obarray
)))
37 '("deleted" "answered" "filed" "forwarded" "unseen" "edited"
40 (defun pmail-make-label (s)
41 (intern (downcase s
) pmail-label-obarray
))
44 (defun pmail-add-label (string)
45 "Add LABEL to labels associated with current PMAIL message.
46 Performs completion over known labels when reading."
47 (interactive (list (pmail-read-label "Add label")))
48 (pmail-set-label string t
))
51 (defun pmail-kill-label (string)
52 "Remove LABEL from labels associated with current PMAIL message.
53 Performs completion over known labels when reading."
54 (interactive (list (pmail-read-label "Remove label")))
55 (pmail-set-label string nil
))
58 (defun pmail-read-label (prompt)
60 (completing-read (concat prompt
63 (symbol-name pmail-last-label
)
69 (if (string= result
"")
71 (setq pmail-last-label
(pmail-make-label result
)))))
73 (defun pmail-set-label (label state
&optional msg
)
74 "Set LABEL as present or absent according to STATE in message MSG."
75 (with-current-buffer pmail-buffer
76 (pmail-maybe-set-message-counters)
77 (if (not msg
) (setq msg pmail-current-message
))
78 ;; Force recalculation of summary for this message.
79 (aset pmail-summary-vector
(1- msg
) nil
)
81 ;; Is this label an attribute?
82 (dotimes (i (length pmail-attr-array
))
83 (if (string= (cadr (aref pmail-attr-array i
)) label
)
86 ;; If so, set it as an attribute.
87 (pmail-set-attribute attr-index state msg
)
88 ;; Is this keyword already present in msg's keyword list?
89 (let* ((header (pmail-get-header pmail-keyword-header msg
))
90 (regexp (concat ", " (regexp-quote (symbol-name label
)) ","))
91 (present (string-match regexp
(concat ", " header
","))))
92 ;; If current state is not correct,
93 (unless (eq present state
)
94 ;; either add it or delete it.
96 pmail-keyword-header msg
98 ;; Add this keyword at the end.
99 (if (and header
(not (string= header
"")))
100 (concat header
", " (symbol-name label
))
102 ;; Delete this keyword.
103 (let ((before (substring header
0
104 (max 0 (- (match-beginning 0) 2))))
105 (after (substring header
107 (- (match-end 0) 1)))))
108 (cond ((string= before
"")
112 (t (concat before
", " after
)))))))))
113 (if (= msg pmail-current-message
)
114 (pmail-display-labels)))))
116 ;; Motion on messages with keywords.
119 (defun pmail-previous-labeled-message (n labels
)
120 "Show previous message with one of the labels LABELS.
121 LABELS should be a comma-separated list of label names.
122 If LABELS is empty, the last set of labels specified is used.
123 With prefix argument N moves backward N messages with these labels."
124 (interactive "p\nsMove to previous msg with labels: ")
125 (pmail-next-labeled-message (- n
) labels
))
127 (declare-function mail-comma-list-regexp
"mail-utils" (labels))
130 (defun pmail-next-labeled-message (n labels
)
131 "Show next message with one of the labels LABELS.
132 LABELS should be a comma-separated list of label names.
133 If LABELS is empty, the last set of labels specified is used.
134 With prefix argument N moves forward N messages with these labels."
135 (interactive "p\nsMove to next msg with labels: ")
136 (if (string= labels
"")
137 (setq labels pmail-last-multi-labels
))
139 (error "No labels to find have been specified previously"))
140 (set-buffer pmail-buffer
)
141 (setq pmail-last-multi-labels labels
)
142 (pmail-maybe-set-message-counters)
143 (let ((lastwin pmail-current-message
)
144 (current pmail-current-message
)
145 (regexp (concat ", ?\\("
146 (mail-comma-list-regexp labels
)
148 (while (and (> n
0) (< current pmail-total-messages
))
149 (setq current
(1+ current
))
150 (if (string-match regexp
(pmail-get-labels current
))
151 (setq lastwin current n
(1- n
))))
152 (while (and (< n
0) (> current
1))
153 (setq current
(1- current
))
154 (if (string-match regexp
(pmail-get-labels current
))
155 (setq lastwin current n
(1+ n
))))
157 (error "No previous message with labels %s" labels
)
159 (error "No following message with labels %s" labels
)
160 (pmail-show-message lastwin
)))))
165 ;; change-log-default-name: "ChangeLog.pmail"
168 ;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7
169 ;;; pmailkwd.el ends here