[Emacs-diffs] Changes to pmailkwd.el

[Paul Michael Reilly]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Paul Michael Reilly <pmr>       08/08/18 04:51:29

Index: pmailkwd.el
===================================================================
RCS file: pmailkwd.el
diff -N pmailkwd.el
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ pmailkwd.el 18 Aug 2008 04:51:28 -0000      1.1
@@ -0,0 +1,227 @@
+;;; pmailkwd.el --- part of the "PMAIL" mail reader for Emacs
+
+;; Copyright (C) 1985, 1988, 1994, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This library manages keywords (labels).  Labels are stored in the
+;; variable `pmail-keywords'.
+
+;;; Code:
+
+(defvar pmail-buffer)
+(defvar pmail-current-message)
+(defvar pmail-last-label)
+(defvar pmail-last-multi-labels)
+(defvar pmail-summary-vector)
+(defvar pmail-total-messages)
+
+;; Global to all PMAIL 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.
+
+(provide 'pmailkwd)
+
+(eval-when-compile
+  (require 'mail-utils))
+
+;; Named list of symbols representing valid message attributes in PMAIL.
+
+(defconst pmail-attributes
+  '(deleted answered filed forwarded unseen edited resent)
+  "Keywords with defined semantics used to label messages.
+These have a well-defined meaning to the PMAIL system.")
+
+(defconst pmail-deleted-label 'deleted)
+
+;; Named list of symbols representing valid message keywords in PMAIL.
+
+(defvar pmail-keywords nil
+  "Keywords used to label messages.
+These are all user-defined, unlike `pmail-attributes'.")
+
+;;;; Low-level functions.
+
+(defun pmail-attribute-p (s)
+  "Non-nil if S is a known attribute.
+See `pmail-attributes'."
+  (let ((symbol (pmail-make-label s)))
+    (memq symbol pmail-attributes)))
+
+(defun pmail-keyword-p (s)
+  "Non-nil if S is a known keyword for this Pmail file.
+See `pmail-keywords'."
+  (let ((symbol (pmail-make-label s)))
+    (memq symbol pmail-keywords)))
+
+(defun pmail-make-label (s &optional forcep)
+  (cond ((symbolp s) s)
+       (forcep (intern (downcase s)))
+       (t  (intern-soft (downcase s)))))
+
+(defun pmail-quote-label-name (label)
+  (regexp-quote (symbol-name (pmail-make-label label t))))
+
+;;;###autoload
+(defun pmail-register-keywords (words)
+  "Add the strings in WORDS to `pmail-keywords'."
+  (dolist (word words)
+    (pmail-register-keyword word)))
+
+(defun pmail-register-keyword (word)
+  "Append the string WORD to `pmail-keywords',
+unless it already is a keyword or an attribute."
+  (let ((keyword (pmail-make-label word t)))
+    (unless (or (pmail-attribute-p keyword)
+               (pmail-keyword-p keyword))
+      (setq pmail-keywords (cons keyword pmail-keywords)))))
+
+;;;; Adding and removing message keywords.
+
+;;;###autoload
+(defun pmail-add-label (string)
+  "Add LABEL to labels associated with current PMAIL message."
+  (interactive (list (pmail-read-label "Add label")))
+  (pmail-set-label (pmail-make-label string) t)
+  (pmail-display-labels))
+
+;;;###autoload
+(defun pmail-kill-label (string)
+  "Remove LABEL from labels associated with current PMAIL message."
+  (interactive (list (pmail-read-label "Remove label" t)))
+  (pmail-set-label (pmail-make-label string) nil))
+
+;;;###autoload
+(defun pmail-read-label (prompt &optional existing)
+  "Ask for a label using PROMPT.
+If EXISTING is non-nil, ask for one of the labels of the current
+message."
+  (when (= pmail-total-messages 0)
+    (error "No messages in this file"))
+  (with-current-buffer pmail-buffer
+    (let ((result (if existing
+                     (let* ((keywords (pmail-desc-get-keywords
+                                       pmail-current-message))
+                            (last (symbol-name pmail-last-label))
+                            (default (if (member last keywords)
+                                         last
+                                       (car keywords))))
+                       (unless keywords
+                         (error "No labels for the current message"))
+                       (completing-read
+                        (concat prompt " (default " default "): ")
+                        keywords nil t nil nil default))
+                   (let ((default (symbol-name pmail-last-label)))
+                     (completing-read
+                      (concat prompt (if pmail-last-label
+                                         (concat " (default " default "): ")
+                                       ": "))
+                      (mapcar 'list pmail-keywords)
+                      nil nil nil nil default)))))
+      (setq pmail-last-label (pmail-make-label result t))
+      ;; return the string, not the symbol
+      result)))
+
+(declare-function pmail-maybe-set-message-counters "pmail" ())
+(declare-function pmail-display-labels "pmail" ())
+(declare-function pmail-msgbeg "pmail" (n))
+(declare-function pmail-set-message-deleted-p "pmail" (n state))
+(declare-function pmail-message-labels-p "pmail" (msg labels))
+(declare-function pmail-show-message "pmail" (&optional n no-summary))
+(declare-function mail-comma-list-regexp "mail-utils" (labels))
+(declare-function mail-parse-comma-list "mail-utils.el" ())
+
+(defun pmail-set-label (l state &optional n)
+  "Add or remove label L in message N.
+The label L is added when STATE is non-nil, otherwise it is
+removed.  If N is nil then use the current Pmail message.  The
+current buffer, possibly narrowed, displays a message."
+  (if (= pmail-total-messages 0)
+      (error "No messages in this file"))
+  (with-current-buffer pmail-buffer
+    (if (not n) (setq n pmail-current-message))
+    (save-restriction
+      (widen)
+      (narrow-to-region (pmail-desc-get-start n) (pmail-desc-get-end n))
+      ;; FIXME: we should move all string-using functions to symbols!
+      (let ((str (symbol-name l)))
+       (if (pmail-attribute-p l)
+           (pmail-set-attribute str state n)
+         ;; Make sure the keyword is registered.
+         (pmail-register-keyword l)
+         (if state
+             (pmail-desc-add-keyword str n)
+           (pmail-desc-remove-keyword str n))))))
+  (pmail-display-labels)
+  ;; Deal with the summary buffer.
+  (when pmail-summary-buffer
+    (pmail-summary-update n)))
+
+;; Motion on messages with keywords.
+
+;;;###autoload
+(defun pmail-previous-labeled-message (n labels)
+  "Show previous message with one of the labels LABELS.
+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 backward N messages with these labels."
+  (interactive "p\nsMove to previous msg with labels: ")
+  (pmail-next-labeled-message (- n) labels))
+
+;;;###autoload
+(defun pmail-next-labeled-message (n labels)
+  "Show next message with one of the labels LABELS.
+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."
+  (interactive "p\nsMove to next msg with labels: ")
+  (when (string= labels "")
+    (setq labels pmail-last-multi-labels))
+  (unless labels
+    (error "No labels to find have been specified previously"))
+  (with-current-buffer pmail-buffer
+    (setq pmail-last-multi-labels labels)
+    (let ((lastwin pmail-current-message)
+         (current pmail-current-message)
+         (regexp (concat ", ?\\("
+                         (mail-comma-list-regexp labels)
+                         "\\),")))
+      (save-restriction
+       (widen)
+       (while (and (> n 0) (< current pmail-total-messages))
+         (setq current (1+ current))
+         (when (pmail-message-labels-p current regexp)
+           (setq lastwin current n (1- n))))
+       (while (and (< n 0) (> current 1))
+         (setq current (1- current))
+         (when (pmail-message-labels-p current regexp)
+           (setq lastwin current n (1+ n)))))
+      (pmail-show-message lastwin)
+      (when (< n 0)
+       (message "No previous message with labels %s" labels))
+      (when (> n 0)
+       (message "No following message with labels %s" labels)))))
+
+;; arch-tag: b26b3392-99ca-4e1d-933a-dab59b04e9a8
+;;; pmailkwd.el ends here