X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/013da4a5b6da69cf6ff3758f5392fe5ac8d9214c..ff98122692e5f21e3dd91d2513c7b1897b6e7ac9:/lisp/mail/rmailkwd.el diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index 37875bf16f..693fbc6842 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -1,6 +1,6 @@ -;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs. +;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs -;; Copyright (C) 1985, 1988, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1988, 1994, 2001 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail @@ -22,6 +22,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: ;; Global to all RMAIL buffers. It exists primarily for the sake of @@ -44,77 +46,82 @@ (defvar rmail-keywords) +;;;###autoload (defun rmail-add-label (string) "Add LABEL to labels associated with current RMAIL message. Completion is performed over known labels when reading." (interactive (list (rmail-read-label "Add label"))) (rmail-set-label string t)) +;;;###autoload (defun rmail-kill-label (string) "Remove LABEL from labels associated with current RMAIL message. Completion is performed over known labels when reading." (interactive (list (rmail-read-label "Remove label"))) (rmail-set-label string nil)) +;;;###autoload (defun rmail-read-label (prompt) - (if (not rmail-keywords) (rmail-parse-file-keywords)) - (let ((result - (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 t))))) + (with-current-buffer rmail-buffer + (if (not rmail-keywords) (rmail-parse-file-keywords)) + (let ((result + (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 t)))))) (defun rmail-set-label (l state &optional n) - (rmail-maybe-set-message-counters) - (if (not n) (setq n rmail-current-message)) - (aset rmail-summary-vector (1- n) nil) - (let* ((attribute (rmail-attribute-p l)) - (keyword (and (not attribute) - (or (rmail-keyword-p l) - (rmail-install-keyword l)))) - (label (or attribute keyword))) - (if label - (let ((omax (- (buffer-size) (point-max))) - (omin (- (buffer-size) (point-min))) - (buffer-read-only nil) - (case-fold-search t)) - (unwind-protect - (save-excursion - (widen) - (goto-char (rmail-msgbeg n)) - (forward-line 1) - (if (not (looking-at "[01],")) - nil - (let ((start (1+ (point))) - (bound)) - (narrow-to-region (point) (progn (end-of-line) (point))) - (setq bound (point-max)) - (search-backward ",," nil t) - (if attribute - (setq bound (1+ (point))) - (setq start (1+ (point)))) - (goto-char start) -; (while (re-search-forward "[ \t]*,[ \t]*" nil t) -; (replace-match ",")) -; (goto-char start) - (if (re-search-forward + (with-current-buffer rmail-buffer + (rmail-maybe-set-message-counters) + (if (not n) (setq n rmail-current-message)) + (aset rmail-summary-vector (1- n) nil) + (let* ((attribute (rmail-attribute-p l)) + (keyword (and (not attribute) + (or (rmail-keyword-p l) + (rmail-install-keyword l)))) + (label (or attribute keyword))) + (if label + (let ((omax (- (buffer-size) (point-max))) + (omin (- (buffer-size) (point-min))) + (buffer-read-only nil) + (case-fold-search t)) + (unwind-protect + (save-excursion + (widen) + (goto-char (rmail-msgbeg n)) + (forward-line 1) + (if (not (looking-at "[01],")) + nil + (let ((start (1+ (point))) + (bound)) + (narrow-to-region (point) (progn (end-of-line) (point))) + (setq bound (point-max)) + (search-backward ",," nil t) + (if attribute + (setq bound (1+ (point))) + (setq start (1+ (point)))) + (goto-char start) +; (while (re-search-forward "[ \t]*,[ \t]*" nil t) +; (replace-match ",")) +; (goto-char start) + (if (re-search-forward (concat ", " (rmail-quote-label-name label) ",") bound 'move) - (if (not state) (replace-match ",")) - (if state (insert " " (symbol-name label) ","))) - (if (eq label rmail-deleted-label) - (rmail-set-message-deleted-p n state))))) - (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)) - (if (= n rmail-current-message) (rmail-display-labels))))))) + (if (not state) (replace-match ",")) + (if state (insert " " (symbol-name label) ","))) + (if (eq label rmail-deleted-label) + (rmail-set-message-deleted-p n state))))) + (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)) + (if (= n rmail-current-message) (rmail-display-labels)))))))) ;; 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 @@ -169,6 +176,7 @@ Completion is performed over known labels when reading." ;; Motion on messages with keywords. +;;;###autoload (defun rmail-previous-labeled-message (n labels) "Show previous message with one of the labels LABELS. LABELS should be a comma-separated list of label names. @@ -177,6 +185,7 @@ With prefix argument N moves backward N messages with these labels." (interactive "p\nsMove to previous msg with labels: ") (rmail-next-labeled-message (- n) labels)) +;;;###autoload (defun rmail-next-labeled-message (n labels) "Show next message with one of the labels LABELS. LABELS should be a comma-separated list of label names. @@ -187,6 +196,7 @@ With prefix argument N moves forward N messages with these labels." (setq labels rmail-last-multi-labels)) (or labels (error "No labels to find have been specified previously")) + (set-buffer rmail-buffer) (setq rmail-last-multi-labels labels) (rmail-maybe-set-message-counters) (let ((lastwin rmail-current-message)