55 |
|
|
56 |
(defvar rmail-keywords) |
(defvar rmail-keywords) |
57 |
|
|
58 |
|
;;;; Low-level functions. |
59 |
|
|
60 |
|
;; Return a list of symbols for all the keywords (labels) recorded in |
61 |
|
;; this file's Labels. |
62 |
|
(defun rmail-keywords () |
63 |
|
"Return a list of all known keywords." |
64 |
|
(or rmail-keywords (rmail-keyword-init))) |
65 |
|
|
66 |
|
(defun rmail-keyword-init () |
67 |
|
"Initialize the variable `rmail-keywords' to hold no keywords. |
68 |
|
The value is actually (nil), since (cdr rmail-keywords) is the |
69 |
|
actual list of keywords." |
70 |
|
(setq rmail-keywords (cons 'rmail-keywords nil))) |
71 |
|
|
72 |
|
(defun rmail-attribute-p (s) |
73 |
|
(let ((symbol (rmail-make-label s))) |
74 |
|
(if (memq symbol (cdr rmail-attributes)) symbol))) |
75 |
|
|
76 |
|
(defun rmail-keyword-p (s) |
77 |
|
"Non-nil if S is a known keyword for this Rmail file." |
78 |
|
(let ((symbol (rmail-make-label s))) |
79 |
|
(if (memq symbol (cdr (rmail-keywords))) symbol))) |
80 |
|
|
81 |
|
(defun rmail-make-label (s &optional forcep) |
82 |
|
(cond ((symbolp s) s) |
83 |
|
(forcep (intern (downcase s) rmail-label-obarray)) |
84 |
|
(t (intern-soft (downcase s) rmail-label-obarray)))) |
85 |
|
|
86 |
|
;;; (defun rmail-force-make-label (s) |
87 |
|
;;; (intern (downcase s) rmail-label-obarray)) |
88 |
|
|
89 |
|
(defun rmail-quote-label-name (label) |
90 |
|
(regexp-quote (symbol-name (rmail-make-label label t)))) |
91 |
|
|
92 |
|
;;;###autoload |
93 |
|
(defun rmail-keyword-register-keywords (keyword-list) |
94 |
|
"Add the strings in KEYWORD-LIST to `rmail-keywords'. |
95 |
|
Return a list of the keywords newly added (those that were |
96 |
|
not already known)." |
97 |
|
(delq nil (mapcar 'rmail-install-keyword keyword-list))) |
98 |
|
|
99 |
|
;;; mbox: ready |
100 |
|
;; Add WORD to the list in the file's Labels option. |
101 |
|
;; Any keyword used for the first time needs this done. |
102 |
|
(defun rmail-install-keyword (word) |
103 |
|
"Append WORD to the global list of keywords. Ignore duplicates. |
104 |
|
Return WORD if it is a new entry, nil otherwise." |
105 |
|
(let ((keyword (rmail-make-label word t)) |
106 |
|
(keywords (rmail-keywords))) |
107 |
|
(if (not (or (rmail-attribute-p keyword) |
108 |
|
(rmail-keyword-p keyword))) |
109 |
|
(progn |
110 |
|
(setcdr keywords (cons keyword (cdr keywords))) |
111 |
|
keyword)))) |
112 |
|
|
113 |
|
;;;; Adding and removing message keywords. |
114 |
|
|
115 |
;;;###autoload |
;;;###autoload |
116 |
(defun rmail-add-label (string) |
(defun rmail-add-label (string) |
117 |
"Add LABEL to labels associated with current RMAIL message. |
"Add LABEL to labels associated with current RMAIL message. |
130 |
;;; mbox: ready to define and execute test |
;;; mbox: ready to define and execute test |
131 |
;;;###autoload |
;;;###autoload |
132 |
(defun rmail-read-label (prompt) |
(defun rmail-read-label (prompt) |
133 |
|
(if (= rmail-total-messages 0) |
134 |
|
(error "No messages in this file")) |
135 |
(with-current-buffer rmail-buffer |
(with-current-buffer rmail-buffer |
136 |
(let ((result |
(let ((result |
137 |
(completing-read (concat prompt |
(completing-read (concat prompt |
152 |
"Add (STATE is non-nil) or remove (STATE is nil) label L in message N. |
"Add (STATE is non-nil) or remove (STATE is nil) label L in message N. |
153 |
If N is nil then use the current Rmail message. The current buffer, |
If N is nil then use the current Rmail message. The current buffer, |
154 |
possibly narrowed, displays a message." |
possibly narrowed, displays a message." |
155 |
|
(if (= rmail-total-messages 0) |
156 |
|
(error "No messages in this file")) |
157 |
(with-current-buffer rmail-buffer |
(with-current-buffer rmail-buffer |
158 |
(if (not n) (setq n rmail-current-message)) |
(if (not n) (setq n rmail-current-message)) |
159 |
|
|
160 |
;; Make message N the curent message. |
;; Make message N the current message. |
161 |
(save-restriction |
(save-restriction |
162 |
(widen) |
(widen) |
163 |
(narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n)) |
(narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n)) |
183 |
(rmail-desc-remove-keyword keyword n))))))) |
(rmail-desc-remove-keyword keyword n))))))) |
184 |
|
|
185 |
|
|
|
;; Commented functions aren't used by RMAIL but might be nice for user |
|
|
;; packages that do stuff with RMAIL. Note that rmail-message-labels-p |
|
|
;; is in rmail.el now. |
|
|
|
|
|
;(defun rmail-message-label-p (label &optional n) |
|
|
; "Returns symbol if LABEL (attribute or keyword) on NTH or current message." |
|
|
; (rmail-message-labels-p (or n rmail-current-message) (regexp-quote label))) |
|
|
|
|
|
;(defun rmail-parse-message-labels (&optional n) |
|
|
; "Returns labels associated with NTH or current RMAIL message. |
|
|
;The result is a list of two lists of strings. The first is the |
|
|
;message attributes and the second is the message keywords." |
|
|
; (let (atts keys) |
|
|
; (save-restriction |
|
|
; (widen) |
|
|
; (goto-char (rmail-msgbeg (or n rmail-current-message))) |
|
|
; (forward-line 1) |
|
|
; (or (looking-at "[01],") (error "Malformed label line")) |
|
|
; (forward-char 2) |
|
|
; (while (looking-at "[ \t]*\\([^ \t\n,]+\\),") |
|
|
; (setq atts (cons (buffer-substring (match-beginning 1) (match-end 1)) |
|
|
; atts)) |
|
|
; (goto-char (match-end 0))) |
|
|
; (or (looking-at ",") (error "Malformed label line")) |
|
|
; (forward-char 1) |
|
|
; (while (looking-at "[ \t]*\\([^ \t\n,]+\\),") |
|
|
; (setq keys (cons (buffer-substring (match-beginning 1) (match-end 1)) |
|
|
; keys)) |
|
|
; (goto-char (match-end 0))) |
|
|
; (or (looking-at "[ \t]*$") (error "Malformed label line")) |
|
|
; (list (nreverse atts) (nreverse keys))))) |
|
|
|
|
|
(defun rmail-attribute-p (s) |
|
|
(let ((symbol (rmail-make-label s))) |
|
|
(if (memq symbol (cdr rmail-attributes)) symbol))) |
|
|
|
|
|
(defun rmail-keyword-p (s) |
|
|
(let ((symbol (rmail-make-label s))) |
|
|
(if (memq symbol (cdr (rmail-keywords))) symbol))) |
|
|
|
|
|
(defun rmail-make-label (s &optional forcep) |
|
|
(cond ((symbolp s) s) |
|
|
(forcep (intern (downcase s) rmail-label-obarray)) |
|
|
(t (intern-soft (downcase s) rmail-label-obarray)))) |
|
|
|
|
|
(defun rmail-force-make-label (s) |
|
|
(intern (downcase s) rmail-label-obarray)) |
|
|
|
|
|
(defun rmail-quote-label-name (label) |
|
|
(regexp-quote (symbol-name (rmail-make-label label t)))) |
|
|
|
|
186 |
;; Motion on messages with keywords. |
;; Motion on messages with keywords. |
187 |
|
|
188 |
;;;###autoload |
;;;###autoload |
228 |
(message "No previous message with labels %s" labels)) |
(message "No previous message with labels %s" labels)) |
229 |
(if (> n 0) |
(if (> n 0) |
230 |
(message "No following message with labels %s" labels)))) |
(message "No following message with labels %s" labels)))) |
|
|
|
|
;;;; Manipulate the file's Labels option. |
|
|
|
|
|
;; Return a list of symbols for all the keywords (labels) recorded in |
|
|
;; this file's Labels. |
|
|
(defun rmail-keywords () |
|
|
"Return a list of all known keywords." |
|
|
(or rmail-keywords (rmail-keyword-init))) |
|
|
|
|
|
(defun rmail-keyword-init () |
|
|
"Initialize the variable `rmail-keywords' to an empty list." |
|
|
(setq rmail-keywords (cons 'rmail-keywords nil))) |
|
|
|
|
|
;;;###autoload |
|
|
(defun rmail-keyword-register-keywords (keyword-list) |
|
|
"Add the strings in KEYWORD-LIST to `rmail-keywords'. |
|
|
If a symbol already exists, then ignore that string. |
|
|
Return a list of the keywords added." |
|
|
(delq nil (mapcar 'rmail-install-keyword keyword-list))) |
|
|
|
|
|
;;; mbox: deprecated |
|
|
;; Set rmail-keywords to a list of symbols for all |
|
|
;; the keywords (labels) recorded in this file's Labels option. |
|
|
(defun rmail-parse-file-keywords () |
|
|
(save-restriction |
|
|
(save-excursion |
|
|
(widen) |
|
|
(goto-char 1) |
|
|
(setq rmail-keywords |
|
|
(if (search-forward "\nLabels:" (rmail-msgbeg 1) t) |
|
|
(progn |
|
|
(narrow-to-region (point) (progn (end-of-line) (point))) |
|
|
(goto-char (point-min)) |
|
|
(cons 'rmail-keywords |
|
|
(mapcar 'rmail-force-make-label |
|
|
(mail-parse-comma-list))))))))) |
|
|
|
|
|
;;; mbox: ready |
|
|
;; Add WORD to the list in the file's Labels option. |
|
|
;; Any keyword used for the first time needs this done. |
|
|
(defun rmail-install-keyword (word) |
|
|
"Append WORD to the global list of keywords. Ignore duplicates. |
|
|
Return WORD if it is a new entry, nil otherwise." |
|
|
(let ((keyword (rmail-make-label word t)) |
|
|
(keywords (rmail-keywords))) |
|
|
(if (not (or (rmail-attribute-p keyword) |
|
|
(rmail-keyword-p keyword))) |
|
|
(progn |
|
|
(setcdr keywords (cons keyword (cdr keywords))) |
|
|
keyword)))) |
|
231 |
|
|
232 |
;;; rmailkwd.el ends here |
;;; rmailkwd.el ends here |