Mercurial > emacs
view lisp/mail/pmailkwd.el @ 99191:e295f1ce302e
*** empty log message ***
author | Martin Rudalics <rudalics@gmx.at> |
---|---|
date | Tue, 28 Oct 2008 17:57:09 +0000 |
parents | 72564311fb7b |
children | f525c6b7ac64 |
line wrap: on
line source
;;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. ;;; 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. (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'.") ;; External library declarations. (declare-function mail-comma-list-regexp "mail-utils" (labels)) (declare-function mail-parse-comma-list "mail-utils" ()) (declare-function pmail-desc-add-keyword "pmaildesc" (keyword n)) (declare-function pmail-desc-get-end "pmaildesc" (n)) (declare-function pmail-desc-get-keywords "pmaildesc" (n)) (declare-function pmail-desc-get-start "pmaildesc" (n)) (declare-function pmail-desc-remove-keyword "pmaildesc" (keyword n)) (declare-function pmail-display-labels "pmail" ()) (declare-function pmail-message-labels-p "pmail" (msg labels)) (declare-function pmail-msgbeg "pmail" (n)) (declare-function pmail-set-attribute "pmail" (attr state &optional msgnum)) (declare-function pmail-show-message "pmail" (&optional n no-summary)) (declare-function pmail-summary-exists "pmail" ()) (declare-function pmail-summary-update "pmailsum" (n)) ;;;; 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))) (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-exists) (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))))) (provide 'pmailkwd) ;; Local Variables: ;; change-log-default-name: "ChangeLog.pmail" ;; End: ;; arch-tag: 1149979c-8e47-4333-9629-cf3dc887a6a7 ;;; pmailkwd.el ends here