;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
-;; Copyright (C) 1985, 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1988, 1994, 2001-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
(require 'rmail)
-;; Global to all RMAIL buffers. It exists primarily for the sake of
-;; completion. It is better to use strings with the label functions
-;; and let them worry about making the label.
+;; Global to all RMAIL buffers. It exists for the sake of completion.
+;; It is better to use strings with the label functions and let them
+;; worry about making the label.
+(defvar rmail-label-obarray (make-vector 47 0)
+ "Obarray of labels used by Rmail.
+`rmail-read-label' uses this to offer completion.")
-(defvar rmail-label-obarray (make-vector 47 0))
-
-(mapc (function (lambda (s) (intern s rmail-label-obarray)))
- '("deleted" "answered" "filed" "forwarded" "unseen" "edited"
- "resent"))
+;; Initialize with the standard labels.
+(mapc (lambda (s) (intern (cadr s) rmail-label-obarray))
+ rmail-attr-array)
(defun rmail-make-label (s)
+ "Intern string S as a downcased symbol in `rmail-label-obarray'."
(intern (downcase s) rmail-label-obarray))
\f
;;;###autoload
-(defun rmail-add-label (string)
+(defun rmail-add-label (label)
"Add LABEL to labels associated with current RMAIL message.
-Performs completion over known labels when reading."
+Completes (see `rmail-read-label') over known labels when reading.
+LABEL may be a symbol or string. Only one label is allowed."
(interactive (list (rmail-read-label "Add label")))
- (rmail-set-label string t))
+ (rmail-set-label label t))
;;;###autoload
-(defun rmail-kill-label (string)
+(defun rmail-kill-label (label)
"Remove LABEL from labels associated with current RMAIL message.
-Performs completion over known labels when reading."
+Completes (see `rmail-read-label') over known labels when reading.
+LABEL may be a symbol or string. Only one label is allowed."
(interactive (list (rmail-read-label "Remove label")))
- (rmail-set-label string nil))
+ (rmail-set-label label nil))
;;;###autoload
(defun rmail-read-label (prompt)
- (let ((result
- (completing-read (concat prompt
- (if rmail-last-label
- (concat " (default "
- (symbol-name rmail-last-label)
- "): ")
- ": "))
- rmail-label-obarray
- nil
- nil)))
+ "Read a label with completion, prompting with PROMPT.
+Completions are chosen from `rmail-label-obarray'. The default
+is `rmail-last-label', if that is non-nil. Updates `rmail-last-label'
+according to the choice made, and returns a symbol."
+ (let* ((old nil)
+ (result
+ (progn
+ ;; If the summary exists, we've already read all the
+ ;; existing labels. If not, read the ones in this message.
+ (or (eq major-mode 'rmail-summary-mode)
+ (rmail-summary-exists)
+ (and (setq old (rmail-get-keywords))
+ (mapc 'rmail-make-label (split-string old ", "))))
+ (completing-read (concat prompt
+ (if rmail-last-label
+ (concat " (default "
+ (symbol-name rmail-last-label)
+ "): ")
+ ": "))
+ rmail-label-obarray
+ nil
+ nil))))
(if (string= result "")
rmail-last-label
(setq rmail-last-label (rmail-make-label result)))))
+(declare-function rmail-summary-update-line "rmailsum" (n))
+
(defun rmail-set-label (label state &optional msg)
- "Set LABEL as present or absent according to STATE in message MSG."
+ "Set LABEL as present or absent according to STATE in message MSG.
+LABEL may be a symbol or string."
+ (or (stringp label) (setq label (symbol-name label)))
+ (if (string-match "," label)
+ (error "More than one label specified"))
(with-current-buffer rmail-buffer
(rmail-maybe-set-message-counters)
- (if (not msg) (setq msg rmail-current-message))
+ (or msg (setq msg rmail-current-message))
;; Force recalculation of summary for this message.
(aset rmail-summary-vector (1- msg) nil)
(let (attr-index)
;; If so, set it as an attribute.
(rmail-set-attribute attr-index state msg)
;; Is this keyword already present in msg's keyword list?
- (let* ((header (rmail-get-header rmail-keyword-header msg))
- (regexp (concat ", " (regexp-quote (symbol-name label)) ","))
- (present (string-match regexp (concat ", " header ","))))
+ (let* ((header (rmail-get-keywords msg))
+ (regexp (concat ", " (regexp-quote label) ","))
+ (present (not (null
+ (string-match regexp (concat ", " header ","))))))
;; If current state is not correct,
(unless (eq present state)
;; either add it or delete it.
(if state
;; Add this keyword at the end.
(if (and header (not (string= header "")))
- (concat header ", " (symbol-name label))
- (symbol-name label))
+ (concat header ", " label)
+ label)
;; Delete this keyword.
(let ((before (substring header 0
(max 0 (- (match-beginning 0) 2))))
(min (length header)
(- (match-end 0) 1)))))
(cond ((string= before "")
- after)
+ ;; If before and after both empty, delete the header.
+ (unless (string= after "")
+ after))
((string= after "")
before)
- (t (concat before ", " after)))))))))
- (if (= msg rmail-current-message)
- (rmail-display-labels)))))
+ (t (concat before ", " after))))))))))
+ (if (rmail-summary-exists)
+ (rmail-select-summary (rmail-summary-update-line msg)))
+ (if (= msg rmail-current-message)
+ (rmail-display-labels))))
\f
;; Motion on messages with keywords.
LABELS should be a comma-separated list of label names.
If LABELS is empty, the last set of labels specified is used.
With prefix argument N moves forward N messages with these labels."
+ ;; FIXME show the default in the prompt.
(interactive "p\nsMove to next msg with labels: ")
(if (string= labels "")
(setq labels rmail-last-multi-labels))
(error "No previous message with labels %s" labels)
(if (> n 0)
(error "No following message with labels %s" labels)
- (rmail-show-message lastwin)))))
+ (rmail-show-message-1 lastwin)))))
(provide 'rmailkwd)
-;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7
+;; Local Variables:
+;; generated-autoload-file: "rmail.el"
+;; End:
+
;;; rmailkwd.el ends here