[Emacs-diffs] Changes to rmailkwd.el.annotation

[Paul Michael Reilly]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Paul Michael Reilly <pmr>       08/08/18 05:21:39

Index: rmailkwd.el.annotation
===================================================================
RCS file: rmailkwd.el.annotation
diff -N rmailkwd.el.annotation
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ rmailkwd.el.annotation      18 Aug 2008 05:21:38 -0000      1.1
@@ -0,0 +1,290 @@
+1.14         (pj       15-Jul-01): ;;; rmailkwd.el --- part of the "RMAIL" 
mail reader for Emacs
+1.3          (eric     30-May-92): 
+1.17         (ttn      06-Aug-05): ;; Copyright (C) 1985, 1988, 1994, 2001, 
2002, 2003, 2004,
+1.23         (miles    08-Jan-08): ;;   2005, 2006, 2007, 2008 Free Software 
Foundation, Inc.
+1.6          (eric     22-Jul-92): 
+1.4          (eric     16-Jul-92): ;; Maintainer: FSF
+1.5          (eric     17-Jul-92): ;; Keywords: mail
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; This file is part of GNU Emacs.
+1.1          (jla      31-Oct-89): 
+1.25         (gm       06-May-08): ;; GNU Emacs is free software: you can 
redistribute it and/or modify
+1.1          (jla      31-Oct-89): ;; it under the terms of the GNU General 
Public License as published by
+1.25         (gm       06-May-08): ;; the Free Software Foundation, either 
version 3 of the License, or
+1.25         (gm       06-May-08): ;; (at your option) any later version.
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; GNU Emacs is distributed in the hope 
that it will be useful,
+1.1          (jla      31-Oct-89): ;; but WITHOUT ANY WARRANTY; without even 
the implied warranty of
+1.1          (jla      31-Oct-89): ;; MERCHANTABILITY or FITNESS FOR A 
PARTICULAR PURPOSE.  See the
+1.1          (jla      31-Oct-89): ;; GNU General Public License for more 
details.
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; You should have received a copy of the 
GNU General Public License
+1.25         (gm       06-May-08): ;; along with GNU Emacs.  If not, see 
<http://www.gnu.org/licenses/>.
+1.14         (pj       15-Jul-01): 
+1.14         (pj       15-Jul-01): ;;; Commentary:
+1.1          (jla      31-Oct-89): 
+1.4          (eric     16-Jul-92): ;;; Code:
+1.1          (jla      31-Oct-89): 
+1.18         (lektu    29-Aug-05): (defvar rmail-buffer)
+1.18         (lektu    29-Aug-05): (defvar rmail-current-message)
+1.18         (lektu    29-Aug-05): (defvar rmail-last-label)
+1.18         (lektu    29-Aug-05): (defvar rmail-last-multi-labels)
+1.18         (lektu    29-Aug-05): (defvar rmail-summary-vector)
+1.18         (lektu    29-Aug-05): (defvar rmail-total-messages)
+1.18         (lektu    29-Aug-05): 
+1.1          (jla      31-Oct-89): ;; Global to all RMAIL buffers.  It exists 
primarily for the sake of
+1.1          (jla      31-Oct-89): ;; completion.  It is better to use strings 
with the label functions
+1.1          (jla      31-Oct-89): ;; and let them worry about making the 
label.
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): (defvar rmail-label-obarray (make-vector 47 
0))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; Named list of symbols representing valid 
message attributes in RMAIL.
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): (defconst rmail-attributes
+1.1          (jla      31-Oct-89):   (cons 'rmail-keywords
+1.9          (kwzh     21-Apr-95):     (mapcar (function (lambda (s) (intern s 
rmail-label-obarray)))
+1.9          (kwzh     21-Apr-95):             '("deleted" "answered" "filed" 
"forwarded" "unseen" "edited"
+1.9          (kwzh     21-Apr-95):               "resent"))))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): (defconst rmail-deleted-label (intern 
"deleted" rmail-label-obarray))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; Named list of symbols representing valid 
message keywords in RMAIL.
+1.1          (jla      31-Oct-89): 
+1.11         (rms      22-Sep-96): (defvar rmail-keywords)
+1.1          (jla      31-Oct-89): 
+1.12         (rms      27-Sep-96): ;;;###autoload
+1.1          (jla      31-Oct-89): (defun rmail-add-label (string)
+1.1          (jla      31-Oct-89):   "Add LABEL to labels associated with 
current RMAIL message.
+1.1          (jla      31-Oct-89): Completion is performed over known labels 
when reading."
+1.1          (jla      31-Oct-89):   (interactive (list (rmail-read-label "Add 
label")))
+1.1          (jla      31-Oct-89):   (rmail-set-label string t))
+1.1          (jla      31-Oct-89): 
+1.12         (rms      27-Sep-96): ;;;###autoload
+1.1          (jla      31-Oct-89): (defun rmail-kill-label (string)
+1.1          (jla      31-Oct-89):   "Remove LABEL from labels associated with 
current RMAIL message.
+1.1          (jla      31-Oct-89): Completion is performed over known labels 
when reading."
+1.1          (jla      31-Oct-89):   (interactive (list (rmail-read-label 
"Remove label")))
+1.1          (jla      31-Oct-89):   (rmail-set-label string nil))
+1.1          (jla      31-Oct-89): 
+1.12         (rms      27-Sep-96): ;;;###autoload
+1.1          (jla      31-Oct-89): (defun rmail-read-label (prompt)
+1.13         (gerd     08-May-01):   (with-current-buffer rmail-buffer
+1.13         (gerd     08-May-01):     (if (not rmail-keywords) 
(rmail-parse-file-keywords))
+1.13         (gerd     08-May-01):     (let ((result
+1.13         (gerd     08-May-01):        (completing-read (concat prompt
+1.13         (gerd     08-May-01):                                 (if 
rmail-last-label
+1.13         (gerd     08-May-01):                                     (concat 
" (default "
+1.13         (gerd     08-May-01):                                             
(symbol-name rmail-last-label)
+1.13         (gerd     08-May-01):                                             
"): ")
+1.13         (gerd     08-May-01):                                   ": "))
+1.13         (gerd     08-May-01):                         rmail-label-obarray
+1.13         (gerd     08-May-01):                         nil
+1.13         (gerd     08-May-01):                         nil)))
+1.13         (gerd     08-May-01):       (if (string= result "")
+1.13         (gerd     08-May-01):       rmail-last-label
+1.13         (gerd     08-May-01):     (setq rmail-last-label 
(rmail-make-label result t))))))
+1.1          (jla      31-Oct-89): 
+1.22         (dann     27-Nov-07): (declare-function 
rmail-maybe-set-message-counters "rmail" ())
+1.22         (dann     27-Nov-07): (declare-function rmail-display-labels 
"rmail" ())
+1.22         (dann     27-Nov-07): (declare-function rmail-msgbeg "rmail" (n))
+1.22         (dann     27-Nov-07): (declare-function 
rmail-set-message-deleted-p "rmail" (n state))
+1.22         (dann     27-Nov-07): (declare-function rmail-message-labels-p 
"rmail" (msg labels))
+1.22         (dann     27-Nov-07): (declare-function rmail-show-message 
"rmail" (&optional n no-summary))
+1.22         (dann     27-Nov-07): (declare-function mail-comma-list-regexp 
"mail-utils" (labels))
+1.22         (dann     27-Nov-07): (declare-function mail-parse-comma-list 
"mail-utils.el" ())
+1.22         (dann     27-Nov-07): 
+1.1          (jla      31-Oct-89): (defun rmail-set-label (l state &optional n)
+1.13         (gerd     08-May-01):   (with-current-buffer rmail-buffer
+1.13         (gerd     08-May-01):     (rmail-maybe-set-message-counters)
+1.13         (gerd     08-May-01):     (if (not n) (setq n 
rmail-current-message))
+1.13         (gerd     08-May-01):     (aset rmail-summary-vector (1- n) nil)
+1.13         (gerd     08-May-01):     (let* ((attribute (rmail-attribute-p l))
+1.13         (gerd     08-May-01):        (keyword (and (not attribute)
+1.13         (gerd     08-May-01):                      (or (rmail-keyword-p l)
+1.13         (gerd     08-May-01):                          
(rmail-install-keyword l))))
+1.13         (gerd     08-May-01):        (label (or attribute keyword)))
+1.13         (gerd     08-May-01):       (if label
+1.13         (gerd     08-May-01):       (let ((omax (- (buffer-size) 
(point-max)))
+1.13         (gerd     08-May-01):             (omin (- (buffer-size) 
(point-min)))
+1.13         (gerd     08-May-01):             (buffer-read-only nil)
+1.13         (gerd     08-May-01):             (case-fold-search t))
+1.13         (gerd     08-May-01):         (unwind-protect
+1.13         (gerd     08-May-01):             (save-excursion
+1.13         (gerd     08-May-01):               (widen)
+1.13         (gerd     08-May-01):               (goto-char (rmail-msgbeg n))
+1.13         (gerd     08-May-01):               (forward-line 1)
+1.13         (gerd     08-May-01):               (if (not (looking-at "[01],"))
+1.13         (gerd     08-May-01):                   nil
+1.13         (gerd     08-May-01):                 (let ((start (1+ (point)))
+1.13         (gerd     08-May-01):                       (bound))
+1.13         (gerd     08-May-01):                   (narrow-to-region (point) 
(progn (end-of-line) (point)))
+1.13         (gerd     08-May-01):                   (setq bound (point-max))
+1.13         (gerd     08-May-01):                   (search-backward ",," nil 
t)
+1.13         (gerd     08-May-01):                   (if attribute
+1.13         (gerd     08-May-01):                       (setq bound (1+ 
(point)))
+1.13         (gerd     08-May-01):                     (setq start (1+ 
(point))))
+1.13         (gerd     08-May-01):                   (goto-char start)
+1.13         (gerd     08-May-01): ;                 (while (re-search-forward 
"[ \t]*,[ \t]*" nil t)
+1.13         (gerd     08-May-01): ;                   (replace-match ","))
+1.13         (gerd     08-May-01): ;                 (goto-char start)
+1.13         (gerd     08-May-01):                   (if (re-search-forward
+1.1          (jla      31-Oct-89):                        (concat ", " 
(rmail-quote-label-name label) ",")
+1.1          (jla      31-Oct-89):                        bound
+1.1          (jla      31-Oct-89):                        'move)
+1.13         (gerd     08-May-01):                       (if (not state) 
(replace-match ","))
+1.13         (gerd     08-May-01):                     (if state (insert " " 
(symbol-name label) ",")))
+1.13         (gerd     08-May-01):                   (if (eq label 
rmail-deleted-label)
+1.13         (gerd     08-May-01):                       
(rmail-set-message-deleted-p n state)))))
+1.13         (gerd     08-May-01):           (narrow-to-region (- 
(buffer-size) omin) (- (buffer-size) omax))
+1.13         (gerd     08-May-01):           (if (= n rmail-current-message) 
(rmail-display-labels))))))))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; Commented functions aren't used by RMAIL 
but might be nice for user
+1.1          (jla      31-Oct-89): ;; packages that do stuff with RMAIL.  Note 
that rmail-message-labels-p
+1.2          (jimb     23-Feb-91): ;; is in rmail.el now.
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;(defun rmail-message-label-p (label 
&optional n)
+1.1          (jla      31-Oct-89): ;  "Returns symbol if LABEL (attribute or 
keyword) on NTH or current message."
+1.7          (kwzh     01-Apr-94): ;  (rmail-message-labels-p (or n 
rmail-current-message) (regexp-quote label)))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;(defun rmail-parse-message-labels 
(&optional n)
+1.1          (jla      31-Oct-89): ;  "Returns labels associated with NTH or 
current RMAIL message.
+1.7          (kwzh     01-Apr-94): ;The result is a list of two lists of 
strings.  The first is the
+1.7          (kwzh     01-Apr-94): ;message attributes and the second is the 
message keywords."
+1.7          (kwzh     01-Apr-94): ;  (let (atts keys)
+1.7          (kwzh     01-Apr-94): ;    (save-restriction
+1.7          (kwzh     01-Apr-94): ;      (widen)
+1.7          (kwzh     01-Apr-94): ;      (goto-char (rmail-msgbeg (or n 
rmail-current-message)))
+1.7          (kwzh     01-Apr-94): ;      (forward-line 1)
+1.7          (kwzh     01-Apr-94): ;      (or (looking-at "[01],") (error 
"Malformed label line"))
+1.7          (kwzh     01-Apr-94): ;      (forward-char 2)
+1.7          (kwzh     01-Apr-94): ;      (while (looking-at "[ \t]*\\([^ 
\t\n,]+\\),")
+1.7          (kwzh     01-Apr-94): ;   (setq atts (cons (buffer-substring 
(match-beginning 1) (match-end 1))
+1.7          (kwzh     01-Apr-94): ;                     atts))
+1.7          (kwzh     01-Apr-94): ;   (goto-char (match-end 0)))
+1.7          (kwzh     01-Apr-94): ;      (or (looking-at ",") (error 
"Malformed label line"))
+1.7          (kwzh     01-Apr-94): ;      (forward-char 1)
+1.7          (kwzh     01-Apr-94): ;      (while (looking-at "[ \t]*\\([^ 
\t\n,]+\\),")
+1.7          (kwzh     01-Apr-94): ;   (setq keys (cons (buffer-substring 
(match-beginning 1) (match-end 1))
+1.7          (kwzh     01-Apr-94): ;                    keys))
+1.7          (kwzh     01-Apr-94): ;   (goto-char (match-end 0)))
+1.7          (kwzh     01-Apr-94): ;      (or (looking-at "[ \t]*$") (error 
"Malformed label line"))
+1.7          (kwzh     01-Apr-94): ;      (list (nreverse atts) (nreverse 
keys)))))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): (defun rmail-attribute-p (s)
+1.1          (jla      31-Oct-89):   (let ((symbol (rmail-make-label s)))
+1.1          (jla      31-Oct-89):     (if (memq symbol (cdr 
rmail-attributes)) symbol)))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): (defun rmail-keyword-p (s)
+1.1          (jla      31-Oct-89):   (let ((symbol (rmail-make-label s)))
+1.1          (jla      31-Oct-89):     (if (memq symbol (cdr 
(rmail-keywords))) symbol)))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): (defun rmail-make-label (s &optional forcep)
+1.1          (jla      31-Oct-89):   (cond ((symbolp s) s)
+1.1          (jla      31-Oct-89):     (forcep (intern (downcase s) 
rmail-label-obarray))
+1.1          (jla      31-Oct-89):     (t  (intern-soft (downcase s) 
rmail-label-obarray))))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): (defun rmail-force-make-label (s)
+1.1          (jla      31-Oct-89):   (intern (downcase s) rmail-label-obarray))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): (defun rmail-quote-label-name (label)
+1.1          (jla      31-Oct-89):   (regexp-quote (symbol-name 
(rmail-make-label label t))))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; Motion on messages with keywords.
+1.1          (jla      31-Oct-89): 
+1.12         (rms      27-Sep-96): ;;;###autoload
+1.2          (jimb     23-Feb-91): (defun rmail-previous-labeled-message (n 
labels)
+1.2          (jimb     23-Feb-91):   "Show previous message with one of the 
labels LABELS.
+1.2          (jimb     23-Feb-91): LABELS should be a comma-separated list of 
label names.
+1.2          (jimb     23-Feb-91): If LABELS is empty, the last set of labels 
specified is used.
+1.1          (jla      31-Oct-89): With prefix argument N moves backward N 
messages with these labels."
+1.1          (jla      31-Oct-89):   (interactive "p\nsMove to previous msg 
with labels: ")
+1.2          (jimb     23-Feb-91):   (rmail-next-labeled-message (- n) labels))
+1.1          (jla      31-Oct-89): 
+1.12         (rms      27-Sep-96): ;;;###autoload
+1.1          (jla      31-Oct-89): (defun rmail-next-labeled-message (n labels)
+1.2          (jimb     23-Feb-91):   "Show next message with one of the labels 
LABELS.
+1.2          (jimb     23-Feb-91): LABELS should be a comma-separated list of 
label names.
+1.2          (jimb     23-Feb-91): If LABELS is empty, the last set of labels 
specified is used.
+1.1          (jla      31-Oct-89): With prefix argument N moves forward N 
messages with these labels."
+1.1          (jla      31-Oct-89):   (interactive "p\nsMove to next msg with 
labels: ")
+1.1          (jla      31-Oct-89):   (if (string= labels "")
+1.1          (jla      31-Oct-89):       (setq labels rmail-last-multi-labels))
+1.1          (jla      31-Oct-89):   (or labels
+1.1          (jla      31-Oct-89):       (error "No labels to find have been 
specified previously"))
+1.13         (gerd     08-May-01):   (set-buffer rmail-buffer)
+1.1          (jla      31-Oct-89):   (setq rmail-last-multi-labels labels)
+1.1          (jla      31-Oct-89):   (rmail-maybe-set-message-counters)
+1.1          (jla      31-Oct-89):   (let ((lastwin rmail-current-message)
+1.1          (jla      31-Oct-89):     (current rmail-current-message)
+1.1          (jla      31-Oct-89):     (regexp (concat ", ?\\("
+1.1          (jla      31-Oct-89):                     (mail-comma-list-regexp 
labels)
+1.1          (jla      31-Oct-89):                     "\\),")))
+1.1          (jla      31-Oct-89):     (save-restriction
+1.1          (jla      31-Oct-89):       (widen)
+1.1          (jla      31-Oct-89):       (while (and (> n 0) (< current 
rmail-total-messages))
+1.1          (jla      31-Oct-89):     (setq current (1+ current))
+1.1          (jla      31-Oct-89):     (if (rmail-message-labels-p current 
regexp)
+1.1          (jla      31-Oct-89):         (setq lastwin current n (1- n))))
+1.1          (jla      31-Oct-89):       (while (and (< n 0) (> current 1))
+1.1          (jla      31-Oct-89):     (setq current (1- current))
+1.1          (jla      31-Oct-89):     (if (rmail-message-labels-p current 
regexp)
+1.1          (jla      31-Oct-89):         (setq lastwin current n (1+ n)))))
+1.1          (jla      31-Oct-89):     (rmail-show-message lastwin)
+1.1          (jla      31-Oct-89):     (if (< n 0)
+1.1          (jla      31-Oct-89):     (message "No previous message with 
labels %s" labels))
+1.1          (jla      31-Oct-89):     (if (> n 0)
+1.1          (jla      31-Oct-89):     (message "No following message with 
labels %s" labels))))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;;; Manipulate the file's Labels option.
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; Return a list of symbols for all
+1.1          (jla      31-Oct-89): ;; the keywords (labels) recorded in this 
file's Labels option.
+1.1          (jla      31-Oct-89): (defun rmail-keywords ()
+1.1          (jla      31-Oct-89):   (or rmail-keywords 
(rmail-parse-file-keywords)))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; Set rmail-keywords to a list of symbols 
for all
+1.1          (jla      31-Oct-89): ;; the keywords (labels) recorded in this 
file's Labels option.
+1.1          (jla      31-Oct-89): (defun rmail-parse-file-keywords ()
+1.1          (jla      31-Oct-89):   (save-restriction
+1.1          (jla      31-Oct-89):     (save-excursion
+1.1          (jla      31-Oct-89):       (widen)
+1.1          (jla      31-Oct-89):       (goto-char 1)
+1.1          (jla      31-Oct-89):       (setq rmail-keywords
+1.1          (jla      31-Oct-89):         (if (search-forward "\nLabels:" 
(rmail-msgbeg 1) t)
+1.1          (jla      31-Oct-89):             (progn
+1.1          (jla      31-Oct-89):               (narrow-to-region (point) 
(progn (end-of-line) (point)))
+1.1          (jla      31-Oct-89):               (goto-char (point-min))
+1.1          (jla      31-Oct-89):               (cons 'rmail-keywords
+1.1          (jla      31-Oct-89):                     (mapcar 
'rmail-force-make-label
+1.1          (jla      31-Oct-89):                             
(mail-parse-comma-list)))))))))
+1.1          (jla      31-Oct-89): 
+1.1          (jla      31-Oct-89): ;; Add WORD to the list in the file's 
Labels option.
+1.1          (jla      31-Oct-89): ;; Any keyword used for the first time 
needs this done.
+1.1          (jla      31-Oct-89): (defun rmail-install-keyword (word)
+1.1          (jla      31-Oct-89):   (let ((keyword (rmail-make-label word t))
+1.1          (jla      31-Oct-89):     (keywords (rmail-keywords)))
+1.1          (jla      31-Oct-89):     (if (not (or (rmail-attribute-p keyword)
+1.1          (jla      31-Oct-89):              (rmail-keyword-p keyword)))
+1.1          (jla      31-Oct-89):     (let ((omin (- (buffer-size) 
(point-min)))
+1.1          (jla      31-Oct-89):           (omax (- (buffer-size) 
(point-max))))
+1.1          (jla      31-Oct-89):       (unwind-protect
+1.1          (jla      31-Oct-89):           (save-excursion
+1.1          (jla      31-Oct-89):             (widen)
+1.1          (jla      31-Oct-89):             (goto-char 1)
+1.1          (jla      31-Oct-89):             (let ((case-fold-search t)
+1.1          (jla      31-Oct-89):                   (buffer-read-only nil))
+1.1          (jla      31-Oct-89):               (or (search-forward 
"\nLabels:" nil t)
+1.1          (jla      31-Oct-89):                   (progn
+1.1          (jla      31-Oct-89):                     (end-of-line)
+1.1          (jla      31-Oct-89):                     (insert "\nLabels:")))
+1.1          (jla      31-Oct-89):               (delete-region (point) (progn 
(end-of-line) (point)))
+1.1          (jla      31-Oct-89):               (setcdr keywords (cons 
keyword (cdr keywords)))
+1.1          (jla      31-Oct-89):               (while (setq keywords (cdr 
keywords))
+1.1          (jla      31-Oct-89):                 (insert (symbol-name (car 
keywords)) ","))
+1.1          (jla      31-Oct-89):               (delete-char -1)))
+1.1          (jla      31-Oct-89):         (narrow-to-region (- (buffer-size) 
omin)
+1.1          (jla      31-Oct-89):                           (- (buffer-size) 
omax)))))
+1.1          (jla      31-Oct-89):     keyword))
+1.3          (eric     30-May-92): 
+1.24         (monnier  10-Apr-08): ;; arch-tag: 
b26b3392-99ca-4e1d-933a-dab59b04e9a8
+1.3          (eric     30-May-92): ;;; rmailkwd.el ends here