/[emacs]/emacs/lisp/mail/rmailkwd.el
ViewVC logotype

Diff of /emacs/lisp/mail/rmailkwd.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.14.10.2 by pmr, Tue Feb 18 16:28:30 2003 UTC revision 1.14.10.3 by rms, Mon Sep 20 16:28:13 2004 UTC
# Line 55  Line 55 
55    
56  (defvar rmail-keywords)  (defvar rmail-keywords)
57    
58    ;;;; Low-level functions.
59    
60    ;; Return a list of symbols for all the keywords (labels) recorded in
61    ;; this file's Labels.
62    (defun rmail-keywords ()
63      "Return a list of all known keywords."
64      (or rmail-keywords (rmail-keyword-init)))
65    
66    (defun rmail-keyword-init ()
67      "Initialize the variable `rmail-keywords' to hold no keywords.
68    The value is actually (nil), since (cdr rmail-keywords) is the
69    actual list of keywords."
70      (setq rmail-keywords (cons 'rmail-keywords nil)))
71    
72    (defun rmail-attribute-p (s)
73      (let ((symbol (rmail-make-label s)))
74        (if (memq symbol (cdr rmail-attributes)) symbol)))
75    
76    (defun rmail-keyword-p (s)
77      "Non-nil if S is a known keyword for this Rmail file."
78      (let ((symbol (rmail-make-label s)))
79        (if (memq symbol (cdr (rmail-keywords))) symbol)))
80    
81    (defun rmail-make-label (s &optional forcep)
82      (cond ((symbolp s) s)
83            (forcep (intern (downcase s) rmail-label-obarray))
84            (t  (intern-soft (downcase s) rmail-label-obarray))))
85    
86    ;;; (defun rmail-force-make-label (s)
87    ;;;   (intern (downcase s) rmail-label-obarray))
88    
89    (defun rmail-quote-label-name (label)
90      (regexp-quote (symbol-name (rmail-make-label label t))))
91    
92    ;;;###autoload
93    (defun rmail-keyword-register-keywords (keyword-list)
94      "Add the strings in KEYWORD-LIST to `rmail-keywords'.
95    Return a list of the keywords newly added (those that were
96    not already known)."
97      (delq nil (mapcar 'rmail-install-keyword keyword-list)))
98    
99    ;;; mbox: ready
100    ;; Add WORD to the list in the file's Labels option.
101    ;; Any keyword used for the first time needs this done.
102    (defun rmail-install-keyword (word)
103      "Append WORD to the global list of keywords.  Ignore duplicates.
104    Return WORD if it is a new entry, nil otherwise."
105      (let ((keyword (rmail-make-label word t))
106            (keywords (rmail-keywords)))
107        (if (not (or (rmail-attribute-p keyword)
108                     (rmail-keyword-p keyword)))
109            (progn
110              (setcdr keywords (cons keyword (cdr keywords)))
111              keyword))))
112    
113    ;;;; Adding and removing message keywords.
114    
115  ;;;###autoload  ;;;###autoload
116  (defun rmail-add-label (string)  (defun rmail-add-label (string)
117    "Add LABEL to labels associated with current RMAIL message.    "Add LABEL to labels associated with current RMAIL message.
# Line 73  Completion is performed over known label Line 130  Completion is performed over known label
130  ;;; mbox: ready to define and execute test  ;;; mbox: ready to define and execute test
131  ;;;###autoload  ;;;###autoload
132  (defun rmail-read-label (prompt)  (defun rmail-read-label (prompt)
133      (if (= rmail-total-messages 0)
134          (error "No messages in this file"))
135    (with-current-buffer rmail-buffer    (with-current-buffer rmail-buffer
136      (let ((result      (let ((result
137             (completing-read (concat prompt             (completing-read (concat prompt
# Line 93  Completion is performed over known label Line 152  Completion is performed over known label
152    "Add (STATE is non-nil) or remove (STATE is nil) label L in message N.    "Add (STATE is non-nil) or remove (STATE is nil) label L in message N.
153  If N is nil then use the current Rmail message.  The current buffer,  If N is nil then use the current Rmail message.  The current buffer,
154  possibly narrowed, displays a message."  possibly narrowed, displays a message."
155      (if (= rmail-total-messages 0)
156          (error "No messages in this file"))
157    (with-current-buffer rmail-buffer    (with-current-buffer rmail-buffer
158      (if (not n) (setq n rmail-current-message))      (if (not n) (setq n rmail-current-message))
159    
160      ;; Make message N the curent message.      ;; Make message N the current message.
161      (save-restriction      (save-restriction
162        (widen)        (widen)
163        (narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n))        (narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n))
# Line 122  possibly narrowed, displays a message." Line 183  possibly narrowed, displays a message."
183              (rmail-desc-remove-keyword keyword n)))))))              (rmail-desc-remove-keyword keyword n)))))))
184                            
185    
 ;; 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  
 ;; is in rmail.el now.  
   
 ;(defun rmail-message-label-p (label &optional n)  
 ;  "Returns symbol if LABEL (attribute or keyword) on NTH or current message."  
 ;  (rmail-message-labels-p (or n rmail-current-message) (regexp-quote label)))  
   
 ;(defun rmail-parse-message-labels (&optional n)  
 ;  "Returns labels associated with NTH or current RMAIL message.  
 ;The result is a list of two lists of strings.  The first is the  
 ;message attributes and the second is the message keywords."  
 ;  (let (atts keys)  
 ;    (save-restriction  
 ;      (widen)  
 ;      (goto-char (rmail-msgbeg (or n rmail-current-message)))  
 ;      (forward-line 1)  
 ;      (or (looking-at "[01],") (error "Malformed label line"))  
 ;      (forward-char 2)  
 ;      (while (looking-at "[ \t]*\\([^ \t\n,]+\\),")  
 ;       (setq atts (cons (buffer-substring (match-beginning 1) (match-end 1))  
 ;                         atts))  
 ;       (goto-char (match-end 0)))  
 ;      (or (looking-at ",") (error "Malformed label line"))  
 ;      (forward-char 1)  
 ;      (while (looking-at "[ \t]*\\([^ \t\n,]+\\),")  
 ;       (setq keys (cons (buffer-substring (match-beginning 1) (match-end 1))  
 ;                        keys))  
 ;       (goto-char (match-end 0)))  
 ;      (or (looking-at "[ \t]*$") (error "Malformed label line"))  
 ;      (list (nreverse atts) (nreverse keys)))))  
   
 (defun rmail-attribute-p (s)  
   (let ((symbol (rmail-make-label s)))  
     (if (memq symbol (cdr rmail-attributes)) symbol)))  
   
 (defun rmail-keyword-p (s)  
   (let ((symbol (rmail-make-label s)))  
     (if (memq symbol (cdr (rmail-keywords))) symbol)))  
   
 (defun rmail-make-label (s &optional forcep)  
   (cond ((symbolp s) s)  
         (forcep (intern (downcase s) rmail-label-obarray))  
         (t  (intern-soft (downcase s) rmail-label-obarray))))  
   
 (defun rmail-force-make-label (s)  
   (intern (downcase s) rmail-label-obarray))  
   
 (defun rmail-quote-label-name (label)  
   (regexp-quote (symbol-name (rmail-make-label label t))))  
   
186  ;; Motion on messages with keywords.  ;; Motion on messages with keywords.
187    
188  ;;;###autoload  ;;;###autoload
# Line 218  With prefix argument N moves forward N m Line 228  With prefix argument N moves forward N m
228          (message "No previous message with labels %s" labels))          (message "No previous message with labels %s" labels))
229      (if (> n 0)      (if (> n 0)
230          (message "No following message with labels %s" labels))))          (message "No following message with labels %s" labels))))
   
 ;;;; Manipulate the file's Labels option.  
   
 ;; Return a list of symbols for all the keywords (labels) recorded in  
 ;; this file's Labels.  
 (defun rmail-keywords ()  
   "Return a list of all known keywords."  
   (or rmail-keywords (rmail-keyword-init)))  
   
 (defun rmail-keyword-init ()  
   "Initialize the variable `rmail-keywords' to an empty list."  
   (setq rmail-keywords (cons 'rmail-keywords nil)))  
   
 ;;;###autoload  
 (defun rmail-keyword-register-keywords (keyword-list)  
   "Add the strings in KEYWORD-LIST to `rmail-keywords'.  
 If a symbol already exists, then ignore that string.  
 Return a list of the keywords added."  
   (delq nil (mapcar 'rmail-install-keyword keyword-list)))  
   
 ;;; mbox: deprecated  
 ;; Set rmail-keywords to a list of symbols for all  
 ;; the keywords (labels) recorded in this file's Labels option.  
 (defun rmail-parse-file-keywords ()  
   (save-restriction  
     (save-excursion  
       (widen)  
       (goto-char 1)  
       (setq rmail-keywords  
             (if (search-forward "\nLabels:" (rmail-msgbeg 1) t)  
                 (progn  
                   (narrow-to-region (point) (progn (end-of-line) (point)))  
                   (goto-char (point-min))  
                   (cons 'rmail-keywords  
                         (mapcar 'rmail-force-make-label  
                                 (mail-parse-comma-list)))))))))  
   
 ;;; mbox: ready  
 ;; Add WORD to the list in the file's Labels option.  
 ;; Any keyword used for the first time needs this done.  
 (defun rmail-install-keyword (word)  
   "Append WORD to the global list of keywords.  Ignore duplicates.  
 Return WORD if it is a new entry, nil otherwise."  
   (let ((keyword (rmail-make-label word t))  
         (keywords (rmail-keywords)))  
     (if (not (or (rmail-attribute-p keyword)  
                  (rmail-keyword-p keyword)))  
         (progn  
           (setcdr keywords (cons keyword (cdr keywords)))  
           keyword))))  
231    
232  ;;; rmailkwd.el ends here  ;;; rmailkwd.el ends here

Legend:
Removed from v.1.14.10.2  
changed lines
  Added in v.1.14.10.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26