1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-05 07:01:11 -08:00

Rmail/mbox merge abandoned. Remove stale files.

This commit is contained in:
Paul Reilly 2008-09-15 20:40:23 +00:00
parent 84a056f85e
commit 133fc7dcdb
6 changed files with 0 additions and 5477 deletions

File diff suppressed because it is too large Load diff

View file

@ -1,164 +0,0 @@
1.25 (pj 15-Jul-01): ;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
1.3 (eric 30-May-92):
1.40 (gm 12-Jun-08): ;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
1.40 (gm 12-Jun-08): ;; 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.39 (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.39 (gm 06-May-08): ;; the Free Software Foundation, either version 3 of the License, or
1.39 (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.39 (gm 06-May-08): ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
1.25 (pj 15-Jul-01):
1.25 (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.1 (jla 31-Oct-89): (require 'rmail)
1.1 (jla 31-Oct-89):
1.23 (gerd 07-May-01): (defcustom rmail-edit-mode-hook nil
1.23 (gerd 07-May-01): "List of functions to call when editing an RMAIL message."
1.23 (gerd 07-May-01): :type 'hook
1.24 (gerd 07-May-01): :version "21.1"
1.23 (gerd 07-May-01): :group 'rmail-edit)
1.23 (gerd 07-May-01):
1.18 (kwzh 08-Apr-98): (defvar rmail-old-text)
1.18 (kwzh 08-Apr-98):
1.1 (jla 31-Oct-89): (defvar rmail-edit-map nil)
1.1 (jla 31-Oct-89): (if rmail-edit-map
1.1 (jla 31-Oct-89): nil
1.7 (rms 20-Jul-93): ;; Make a keymap that inherits text-mode-map.
1.18 (kwzh 08-Apr-98): (setq rmail-edit-map (make-sparse-keymap))
1.18 (kwzh 08-Apr-98): (set-keymap-parent rmail-edit-map text-mode-map)
1.1 (jla 31-Oct-89): (define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit)
1.1 (jla 31-Oct-89): (define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit))
1.1 (jla 31-Oct-89):
1.1 (jla 31-Oct-89): ;; Rmail Edit mode is suitable only for specially formatted data.
1.1 (jla 31-Oct-89): (put 'rmail-edit-mode 'mode-class 'special)
1.1 (jla 31-Oct-89):
1.36 (dann 25-Nov-07): (declare-function rmail-summary-disable "" ())
1.36 (dann 25-Nov-07): (declare-function rmail-summary-enable "rmailsum" ())
1.36 (dann 25-Nov-07):
1.1 (jla 31-Oct-89): (defun rmail-edit-mode ()
1.1 (jla 31-Oct-89): "Major mode for editing the contents of an RMAIL message.
1.1 (jla 31-Oct-89): The editing commands are the same as in Text mode, together with two commands
1.1 (jla 31-Oct-89): to return to regular RMAIL:
1.23 (gerd 07-May-01): * \\[rmail-abort-edit] cancels the changes
1.1 (jla 31-Oct-89): you have made and returns to RMAIL
1.23 (gerd 07-May-01): * \\[rmail-cease-edit] makes them permanent.
1.23 (gerd 07-May-01): This functions runs the normal hook `rmail-edit-mode-hook'.
1.1 (jla 31-Oct-89): \\{rmail-edit-map}"
1.29 (lute 14-Jun-05): (delay-mode-hooks (text-mode))
1.1 (jla 31-Oct-89): (use-local-map rmail-edit-map)
1.1 (jla 31-Oct-89): (setq major-mode 'rmail-edit-mode)
1.1 (jla 31-Oct-89): (setq mode-name "RMAIL Edit")
1.1 (jla 31-Oct-89): (if (boundp 'mode-line-modified)
1.1 (jla 31-Oct-89): (setq mode-line-modified (default-value 'mode-line-modified))
1.1 (jla 31-Oct-89): (setq mode-line-format (default-value 'mode-line-format)))
1.9 (kwzh 07-Apr-94): (if (rmail-summary-exists)
1.10 (kwzh 07-Apr-94): (save-excursion
1.10 (kwzh 07-Apr-94): (set-buffer rmail-summary-buffer)
1.10 (kwzh 07-Apr-94): (rmail-summary-disable)))
1.28 (lute 26-May-05): (run-mode-hooks 'rmail-edit-mode-hook))
1.1 (jla 31-Oct-89):
1.20 (rms 27-May-98): (defvar rmail-old-pruned nil)
1.20 (rms 27-May-98): (put 'rmail-old-pruned 'permanent-local t)
1.20 (rms 27-May-98):
1.21 (rms 13-Jul-98): (defvar rmail-edit-saved-coding-system nil)
1.21 (rms 13-Jul-98): (put 'rmail-edit-saved-coding-system 'permanent-local t)
1.21 (rms 13-Jul-98):
1.17 (rms 27-Sep-96): ;;;###autoload
1.1 (jla 31-Oct-89): (defun rmail-edit-current-message ()
1.1 (jla 31-Oct-89): "Edit the contents of this message."
1.1 (jla 31-Oct-89): (interactive)
1.20 (rms 27-May-98): (make-local-variable 'rmail-old-pruned)
1.20 (rms 27-May-98): (setq rmail-old-pruned (rmail-msg-is-pruned))
1.21 (rms 13-Jul-98): (make-local-variable 'rmail-edit-saved-coding-system)
1.21 (rms 13-Jul-98): (setq rmail-edit-saved-coding-system save-buffer-coding-system)
1.20 (rms 27-May-98): (rmail-toggle-header 0)
1.1 (jla 31-Oct-89): (rmail-edit-mode)
1.21 (rms 13-Jul-98): ;; As the local value of save-buffer-coding-system is deleted by
1.21 (rms 13-Jul-98): ;; rmail-edit-mode, we restore the original value.
1.21 (rms 13-Jul-98): (make-local-variable 'save-buffer-coding-system)
1.21 (rms 13-Jul-98): (setq save-buffer-coding-system rmail-edit-saved-coding-system)
1.1 (jla 31-Oct-89): (make-local-variable 'rmail-old-text)
1.1 (jla 31-Oct-89): (setq rmail-old-text (buffer-substring (point-min) (point-max)))
1.1 (jla 31-Oct-89): (setq buffer-read-only nil)
1.14 (kwzh 25-Apr-95): (force-mode-line-update)
1.1 (jla 31-Oct-89): (if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit)
1.1 (jla 31-Oct-89): (eq (key-binding "\C-c\C-]") 'rmail-abort-edit))
1.1 (jla 31-Oct-89): (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort")
1.16 (kwzh 25-Jan-96): (message "%s" (substitute-command-keys
1.20 (rms 27-May-98): "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))
1.1 (jla 31-Oct-89):
1.1 (jla 31-Oct-89): (defun rmail-cease-edit ()
1.1 (jla 31-Oct-89): "Finish editing message; switch back to Rmail proper."
1.1 (jla 31-Oct-89): (interactive)
1.9 (kwzh 07-Apr-94): (if (rmail-summary-exists)
1.10 (kwzh 07-Apr-94): (save-excursion
1.10 (kwzh 07-Apr-94): (set-buffer rmail-summary-buffer)
1.10 (kwzh 07-Apr-94): (rmail-summary-enable)))
1.1 (jla 31-Oct-89): ;; Make sure buffer ends with a newline.
1.1 (jla 31-Oct-89): (save-excursion
1.1 (jla 31-Oct-89): (goto-char (point-max))
1.1 (jla 31-Oct-89): (if (/= (preceding-char) ?\n)
1.1 (jla 31-Oct-89): (insert "\n"))
1.1 (jla 31-Oct-89): ;; Adjust the marker that points to the end of this message.
1.1 (jla 31-Oct-89): (set-marker (aref rmail-message-vector (1+ rmail-current-message))
1.1 (jla 31-Oct-89): (point)))
1.1 (jla 31-Oct-89): (let ((old rmail-old-text))
1.14 (kwzh 25-Apr-95): (force-mode-line-update)
1.18 (kwzh 08-Apr-98): (kill-all-local-variables)
1.1 (jla 31-Oct-89): (rmail-mode-1)
1.40 (gm 12-Jun-08): (if (boundp 'tool-bar-map)
1.40 (gm 12-Jun-08): (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map))
1.18 (kwzh 08-Apr-98): (rmail-variables)
1.21 (rms 13-Jul-98): ;; As the local value of save-buffer-coding-system is changed by
1.21 (rms 13-Jul-98): ;; rmail-variables, we restore the original value.
1.21 (rms 13-Jul-98): (setq save-buffer-coding-system rmail-edit-saved-coding-system)
1.1 (jla 31-Oct-89): (if (and (= (length old) (- (point-max) (point-min)))
1.1 (jla 31-Oct-89): (string= old (buffer-substring (point-min) (point-max))))
1.1 (jla 31-Oct-89): ()
1.1 (jla 31-Oct-89): (setq old nil)
1.1 (jla 31-Oct-89): (rmail-set-attribute "edited" t)
1.1 (jla 31-Oct-89): (if (boundp 'rmail-summary-vector)
1.1 (jla 31-Oct-89): (progn
1.1 (jla 31-Oct-89): (aset rmail-summary-vector (1- rmail-current-message) nil)
1.1 (jla 31-Oct-89): (save-excursion
1.1 (jla 31-Oct-89): (rmail-widen-to-current-msgbeg
1.19 (rms 01-May-98): (function (lambda ()
1.1 (jla 31-Oct-89): (forward-line 2)
1.1 (jla 31-Oct-89): (if (looking-at "Summary-line: ")
1.1 (jla 31-Oct-89): (let ((buffer-read-only nil))
1.1 (jla 31-Oct-89): (delete-region (point)
1.1 (jla 31-Oct-89): (progn (forward-line 1)
1.19 (rms 01-May-98): (point))))))))))))
1.19 (rms 01-May-98): (save-excursion
1.20 (rms 27-May-98): (rmail-show-message)
1.20 (rms 27-May-98): (rmail-toggle-header (if rmail-old-pruned 1 0))))
1.22 (gerd 18-Nov-99): (run-hooks 'rmail-mode-hook)
1.1 (jla 31-Oct-89): (setq buffer-read-only t))
1.1 (jla 31-Oct-89):
1.1 (jla 31-Oct-89): (defun rmail-abort-edit ()
1.1 (jla 31-Oct-89): "Abort edit of current message; restore original contents."
1.1 (jla 31-Oct-89): (interactive)
1.1 (jla 31-Oct-89): (delete-region (point-min) (point-max))
1.1 (jla 31-Oct-89): (insert rmail-old-text)
1.13 (rms 09-Aug-94): (rmail-cease-edit)
1.13 (rms 09-Aug-94): (rmail-highlight-headers))
1.1 (jla 31-Oct-89):
1.26 (rost 15-Nov-02): (provide 'rmailedit)
1.26 (rost 15-Nov-02):
1.38 (monnier 10-Apr-08): ;; arch-tag: 93c22709-a14a-46c1-ab91-52c3f5a0ec12
1.3 (eric 30-May-92): ;;; rmailedit.el ends here

View file

@ -1,290 +0,0 @@
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

View file

@ -1,67 +0,0 @@
1.2 (eric 30-May-92): ;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader
1.2 (eric 30-May-92):
1.18 (gm 09-Dec-06): ;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005,
1.22 (miles 08-Jan-08): ;; 2006, 2007, 2008 Free Software Foundation, Inc.
1.5 (eric 22-Jul-92):
1.3 (eric 16-Jul-92): ;; Maintainer: FSF
1.4 (eric 17-Jul-92): ;; Keywords: mail
1.1 (jimb 31-Oct-89):
1.1 (jimb 31-Oct-89): ;; This file is part of GNU Emacs.
1.1 (jimb 31-Oct-89):
1.24 (gm 06-May-08): ;; GNU Emacs is free software: you can redistribute it and/or modify
1.1 (jimb 31-Oct-89): ;; it under the terms of the GNU General Public License as published by
1.24 (gm 06-May-08): ;; the Free Software Foundation, either version 3 of the License, or
1.24 (gm 06-May-08): ;; (at your option) any later version.
1.1 (jimb 31-Oct-89):
1.1 (jimb 31-Oct-89): ;; GNU Emacs is distributed in the hope that it will be useful,
1.1 (jimb 31-Oct-89): ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1.1 (jimb 31-Oct-89): ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1.1 (jimb 31-Oct-89): ;; GNU General Public License for more details.
1.1 (jimb 31-Oct-89):
1.1 (jimb 31-Oct-89): ;; You should have received a copy of the GNU General Public License
1.24 (gm 06-May-08): ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
1.1 (jimb 31-Oct-89):
1.12 (pj 15-Jul-01): ;;; Commentary:
1.12 (pj 15-Jul-01):
1.6 (eric 17-Mar-93): ;;; Code:
1.1 (jimb 31-Oct-89):
1.16 (lektu 29-Aug-05): (defvar rmail-current-message)
1.16 (lektu 29-Aug-05): (defvar rmail-inbox-list)
1.16 (lektu 29-Aug-05):
1.21 (dann 25-Nov-07): (declare-function rmail-parse-file-inboxes "rmail" ())
1.21 (dann 25-Nov-07): (declare-function rmail-show-message "rmail" (&optional n no-summary))
1.21 (dann 25-Nov-07):
1.10 (rms 27-Sep-96): ;;;###autoload
1.1 (jimb 31-Oct-89): (defun set-rmail-inbox-list (file-name)
1.1 (jimb 31-Oct-89): "Set the inbox list of the current RMAIL file to FILE-NAME.
1.8 (rms 06-Sep-94): You can specify one file name, or several names separated by commas.
1.8 (rms 06-Sep-94): If FILE-NAME is empty, remove any existing inbox list."
1.1 (jimb 31-Oct-89): (interactive "sSet mailbox list to (comma-separated list of filenames): ")
1.11 (rms 08-Aug-98):
1.11 (rms 08-Aug-98): (unless (eq major-mode 'rmail-mode)
1.11 (rms 08-Aug-98): (error "set-rmail-inbox-list works only for an Rmail file"))
1.11 (rms 08-Aug-98):
1.1 (jimb 31-Oct-89): (save-excursion
1.1 (jimb 31-Oct-89): (let ((names (rmail-parse-file-inboxes))
1.1 (jimb 31-Oct-89): (standard-output nil))
1.1 (jimb 31-Oct-89): (if (or (not names)
1.1 (jimb 31-Oct-89): (y-or-n-p (concat "Replace "
1.1 (jimb 31-Oct-89): (mapconcat 'identity names ", ")
1.1 (jimb 31-Oct-89): "? ")))
1.1 (jimb 31-Oct-89): (let ((buffer-read-only nil))
1.1 (jimb 31-Oct-89): (widen)
1.1 (jimb 31-Oct-89): (goto-char (point-min))
1.1 (jimb 31-Oct-89): (search-forward "\n\^_")
1.1 (jimb 31-Oct-89): (re-search-backward "^Mail" nil t)
1.1 (jimb 31-Oct-89): (forward-line 0)
1.1 (jimb 31-Oct-89): (if (looking-at "Mail:")
1.1 (jimb 31-Oct-89): (delete-region (point)
1.1 (jimb 31-Oct-89): (progn (forward-line 1)
1.1 (jimb 31-Oct-89): (point))))
1.1 (jimb 31-Oct-89): (if (not (string= file-name ""))
1.7 (rms 18-Jun-94): (insert-before-markers "Mail: " file-name "\n"))))))
1.1 (jimb 31-Oct-89): (setq rmail-inbox-list (rmail-parse-file-inboxes))
1.1 (jimb 31-Oct-89): (rmail-show-message rmail-current-message))
1.2 (eric 30-May-92):
1.23 (monnier 10-Apr-08): ;; arch-tag: 74ed1d50-2c25-4cbd-b5ae-d29ed8aba6e4
1.2 (eric 30-May-92): ;;; rmailmsc.el ends here

View file

@ -1,420 +0,0 @@
1.65 (pj 15-Jul-01): ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
1.4 (eric 30-May-92):
1.69 (ttn 06-Aug-05): ;; Copyright (C) 1985, 1987, 1993, 1994, 2001, 2002, 2003, 2004,
1.79 (miles 08-Jan-08): ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
1.9 (eric 22-Jul-92):
1.6 (eric 15-Jul-92): ;; Maintainer: FSF
1.8 (eric 17-Jul-92): ;; Keywords: mail
1.1 (root 22-May-90):
1.1 (root 22-May-90): ;; This file is part of GNU Emacs.
1.1 (root 22-May-90):
1.81 (gm 06-May-08): ;; GNU Emacs is free software: you can redistribute it and/or modify
1.1 (root 22-May-90): ;; it under the terms of the GNU General Public License as published by
1.81 (gm 06-May-08): ;; the Free Software Foundation, either version 3 of the License, or
1.81 (gm 06-May-08): ;; (at your option) any later version.
1.1 (root 22-May-90):
1.1 (root 22-May-90): ;; GNU Emacs is distributed in the hope that it will be useful,
1.1 (root 22-May-90): ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1.1 (root 22-May-90): ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1.1 (root 22-May-90): ;; GNU General Public License for more details.
1.1 (root 22-May-90):
1.1 (root 22-May-90): ;; You should have received a copy of the GNU General Public License
1.81 (gm 06-May-08): ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
1.65 (pj 15-Jul-01):
1.65 (pj 15-Jul-01): ;;; Commentary:
1.1 (root 22-May-90):
1.6 (eric 15-Jul-92): ;;; Code:
1.1 (root 22-May-90):
1.30 (kwzh 09-Feb-94): (require 'rmail)
1.59 (rms 04-Jan-99): (provide 'rmailout)
1.30 (kwzh 09-Feb-94):
1.44 (rms 14-Sep-96): ;;;###autoload
1.49 (rms 03-May-97): (defcustom rmail-output-file-alist nil
1.2 (rms 24-Dec-90): "*Alist matching regexps to suggested output Rmail files.
1.16 (rms 09-Jul-93): This is a list of elements of the form (REGEXP . NAME-EXP).
1.21 (roland 14-Oct-93): The suggestion is taken if REGEXP matches anywhere in the message buffer.
1.16 (rms 09-Jul-93): NAME-EXP may be a string constant giving the file name to use,
1.16 (rms 09-Jul-93): or more generally it may be any kind of expression that returns
1.49 (rms 03-May-97): a file name as a string."
1.49 (rms 03-May-97): :type '(repeat (cons regexp
1.49 (rms 03-May-97): (choice :value ""
1.49 (rms 03-May-97): (string :tag "File Name")
1.49 (rms 03-May-97): sexp)))
1.49 (rms 03-May-97): :group 'rmail-output)
1.2 (rms 24-Dec-90):
1.59 (rms 04-Jan-99): (defun rmail-output-read-rmail-file-name ()
1.59 (rms 04-Jan-99): "Read the file name to use for `rmail-output-to-rmail-file'.
1.59 (rms 04-Jan-99): Set `rmail-default-rmail-file' to this name as well as returning it."
1.59 (rms 04-Jan-99): (let ((default-file
1.59 (rms 04-Jan-99): (let (answer tail)
1.59 (rms 04-Jan-99): (setq tail rmail-output-file-alist)
1.59 (rms 04-Jan-99): ;; Suggest a file based on a pattern match.
1.59 (rms 04-Jan-99): (while (and tail (not answer))
1.59 (rms 04-Jan-99): (save-excursion
1.63 (gerd 08-May-01): (set-buffer rmail-buffer)
1.59 (rms 04-Jan-99): (goto-char (point-min))
1.59 (rms 04-Jan-99): (if (re-search-forward (car (car tail)) nil t)
1.59 (rms 04-Jan-99): (setq answer (eval (cdr (car tail)))))
1.59 (rms 04-Jan-99): (setq tail (cdr tail))))
1.59 (rms 04-Jan-99): ;; If no suggestions, use same file as last time.
1.59 (rms 04-Jan-99): (expand-file-name (or answer rmail-default-rmail-file)))))
1.59 (rms 04-Jan-99): (let ((read-file
1.59 (rms 04-Jan-99): (expand-file-name
1.59 (rms 04-Jan-99): (read-file-name
1.70 (rfrancoi 24-Sep-05): (concat "Output message to Rmail file (default "
1.59 (rms 04-Jan-99): (file-name-nondirectory default-file)
1.70 (rfrancoi 24-Sep-05): "): ")
1.59 (rms 04-Jan-99): (file-name-directory default-file)
1.59 (rms 04-Jan-99): (abbreviate-file-name default-file))
1.59 (rms 04-Jan-99): (file-name-directory default-file))))
1.59 (rms 04-Jan-99): ;; If the user enters just a directory,
1.59 (rms 04-Jan-99): ;; use the name within that directory chosen by the default.
1.59 (rms 04-Jan-99): (setq rmail-default-rmail-file
1.59 (rms 04-Jan-99): (if (file-directory-p read-file)
1.59 (rms 04-Jan-99): (expand-file-name (file-name-nondirectory default-file)
1.59 (rms 04-Jan-99): read-file)
1.59 (rms 04-Jan-99): read-file)))))
1.59 (rms 04-Jan-99):
1.59 (rms 04-Jan-99): (defun rmail-output-read-file-name ()
1.59 (rms 04-Jan-99): "Read the file name to use for `rmail-output'.
1.59 (rms 04-Jan-99): Set `rmail-default-file' to this name as well as returning it."
1.59 (rms 04-Jan-99): (let ((default-file
1.59 (rms 04-Jan-99): (let (answer tail)
1.59 (rms 04-Jan-99): (setq tail rmail-output-file-alist)
1.59 (rms 04-Jan-99): ;; Suggest a file based on a pattern match.
1.59 (rms 04-Jan-99): (while (and tail (not answer))
1.59 (rms 04-Jan-99): (save-excursion
1.59 (rms 04-Jan-99): (goto-char (point-min))
1.59 (rms 04-Jan-99): (if (re-search-forward (car (car tail)) nil t)
1.59 (rms 04-Jan-99): (setq answer (eval (cdr (car tail)))))
1.59 (rms 04-Jan-99): (setq tail (cdr tail))))
1.59 (rms 04-Jan-99): ;; If no suggestion, use same file as last time.
1.59 (rms 04-Jan-99): (or answer rmail-default-file))))
1.59 (rms 04-Jan-99): (let ((read-file
1.59 (rms 04-Jan-99): (expand-file-name
1.59 (rms 04-Jan-99): (read-file-name
1.70 (rfrancoi 24-Sep-05): (concat "Output message to Unix mail file (default "
1.59 (rms 04-Jan-99): (file-name-nondirectory default-file)
1.70 (rfrancoi 24-Sep-05): "): ")
1.59 (rms 04-Jan-99): (file-name-directory default-file)
1.59 (rms 04-Jan-99): (abbreviate-file-name default-file))
1.59 (rms 04-Jan-99): (file-name-directory default-file))))
1.59 (rms 04-Jan-99): (setq rmail-default-file
1.59 (rms 04-Jan-99): (if (file-directory-p read-file)
1.59 (rms 04-Jan-99): (expand-file-name (file-name-nondirectory default-file)
1.59 (rms 04-Jan-99): read-file)
1.59 (rms 04-Jan-99): (expand-file-name
1.59 (rms 04-Jan-99): (or read-file (file-name-nondirectory default-file))
1.59 (rms 04-Jan-99): (file-name-directory default-file)))))))
1.59 (rms 04-Jan-99):
1.77 (dann 25-Nov-07): (declare-function rmail-update-summary "rmailsum" (&rest ignore))
1.77 (dann 25-Nov-07):
1.55 (rms 16-Aug-98): ;;; There are functions elsewhere in Emacs that use this function;
1.55 (rms 16-Aug-98): ;;; look at them before you change the calling method.
1.45 (rms 27-Sep-96): ;;;###autoload
1.61 (fx 24-May-00): (defun rmail-output-to-rmail-file (file-name &optional count stay)
1.1 (root 22-May-90): "Append the current message to an Rmail file named FILE-NAME.
1.1 (root 22-May-90): If the file does not exist, ask if it should be created.
1.1 (root 22-May-90): If file is being visited, the message is appended to the Emacs
1.1 (root 22-May-90): buffer visiting that file.
1.50 (rms 20-Sep-97): If the file exists and is not an Rmail file, the message is
1.50 (rms 20-Sep-97): appended in inbox format, the same way `rmail-output' does it.
1.16 (rms 09-Jul-93):
1.37 (rms 05-May-94): The default file name comes from `rmail-default-rmail-file',
1.28 (rms 15-Jan-94): which is updated to the name you use in this command.
1.28 (rms 15-Jan-94):
1.71 (eliz 04-Nov-05): A prefix argument COUNT says to output that many consecutive messages,
1.61 (fx 24-May-00): starting with the current one. Deleted messages are skipped and don't count.
1.61 (fx 24-May-00):
1.71 (eliz 04-Nov-05): If the optional argument STAY is non-nil, then leave the last filed
1.71 (eliz 04-Nov-05): message up instead of moving forward to the next non-deleted message."
1.13 (rms 11-Jun-93): (interactive
1.59 (rms 04-Jan-99): (list (rmail-output-read-rmail-file-name)
1.59 (rms 04-Jan-99): (prefix-numeric-value current-prefix-arg)))
1.11 (jimb 14-Feb-93): (or count (setq count 1))
1.3 (jimb 01-Mar-91): (setq file-name
1.3 (jimb 01-Mar-91): (expand-file-name file-name
1.27 (rms 15-Jan-94): (file-name-directory rmail-default-rmail-file)))
1.42 (rms 21-Sep-95): (if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name)))
1.16 (rms 09-Jul-93): (rmail-output file-name count)
1.16 (rms 09-Jul-93): (rmail-maybe-set-message-counters)
1.16 (rms 09-Jul-93): (setq file-name (abbreviate-file-name file-name))
1.47 (rms 30-Mar-97): (or (find-buffer-visiting file-name)
1.16 (rms 09-Jul-93): (file-exists-p file-name)
1.16 (rms 09-Jul-93): (if (yes-or-no-p
1.16 (rms 09-Jul-93): (concat "\"" file-name "\" does not exist, create it? "))
1.16 (rms 09-Jul-93): (let ((file-buffer (create-file-buffer file-name)))
1.1 (root 22-May-90): (save-excursion
1.16 (rms 09-Jul-93): (set-buffer file-buffer)
1.16 (rms 09-Jul-93): (rmail-insert-rmail-file-header)
1.62 (eliz 11-Mar-01): (let ((require-final-newline nil)
1.62 (eliz 11-Mar-01): (coding-system-for-write
1.62 (eliz 11-Mar-01): (or rmail-file-coding-system
1.62 (eliz 11-Mar-01): 'emacs-mule-unix)))
1.16 (rms 09-Jul-93): (write-region (point-min) (point-max) file-name t 1)))
1.16 (rms 09-Jul-93): (kill-buffer file-buffer))
1.16 (rms 09-Jul-93): (error "Output file does not exist")))
1.16 (rms 09-Jul-93): (while (> count 0)
1.16 (rms 09-Jul-93): (let (redelete)
1.16 (rms 09-Jul-93): (unwind-protect
1.16 (rms 09-Jul-93): (progn
1.63 (gerd 08-May-01): (set-buffer rmail-buffer)
1.24 (rms 23-Dec-93): ;; Temporarily turn off Deleted attribute.
1.24 (rms 23-Dec-93): ;; Do this outside the save-restriction, since it would
1.24 (rms 23-Dec-93): ;; shift the place in the buffer where the visible text starts.
1.24 (rms 23-Dec-93): (if (rmail-message-deleted-p rmail-current-message)
1.24 (rms 23-Dec-93): (progn (setq redelete t)
1.24 (rms 23-Dec-93): (rmail-set-attribute "deleted" nil)))
1.16 (rms 09-Jul-93): (save-restriction
1.16 (rms 09-Jul-93): (widen)
1.16 (rms 09-Jul-93): ;; Decide whether to append to a file or to an Emacs buffer.
1.16 (rms 09-Jul-93): (save-excursion
1.47 (rms 30-Mar-97): (let ((buf (find-buffer-visiting file-name))
1.16 (rms 09-Jul-93): (cur (current-buffer))
1.16 (rms 09-Jul-93): (beg (1+ (rmail-msgbeg rmail-current-message)))
1.52 (rms 27-May-98): (end (1+ (rmail-msgend rmail-current-message)))
1.52 (rms 27-May-98): (coding-system-for-write
1.52 (rms 27-May-98): (or rmail-file-coding-system
1.52 (rms 27-May-98): 'emacs-mule-unix)))
1.16 (rms 09-Jul-93): (if (not buf)
1.40 (rms 17-Nov-94): ;; Output to a file.
1.40 (rms 17-Nov-94): (if rmail-fields-not-to-output
1.40 (rms 17-Nov-94): ;; Delete some fields while we output.
1.40 (rms 17-Nov-94): (let ((obuf (current-buffer)))
1.40 (rms 17-Nov-94): (set-buffer (get-buffer-create " rmail-out-temp"))
1.40 (rms 17-Nov-94): (insert-buffer-substring obuf beg end)
1.40 (rms 17-Nov-94): (rmail-delete-unwanted-fields)
1.40 (rms 17-Nov-94): (append-to-file (point-min) (point-max) file-name)
1.40 (rms 17-Nov-94): (set-buffer obuf)
1.40 (rms 17-Nov-94): (kill-buffer (get-buffer " rmail-out-temp")))
1.40 (rms 17-Nov-94): (append-to-file beg end file-name))
1.16 (rms 09-Jul-93): (if (eq buf (current-buffer))
1.16 (rms 09-Jul-93): (error "Can't output message to same file it's already in"))
1.16 (rms 09-Jul-93): ;; File has been visited, in buffer BUF.
1.16 (rms 09-Jul-93): (set-buffer buf)
1.16 (rms 09-Jul-93): (let ((buffer-read-only nil)
1.16 (rms 09-Jul-93): (msg (and (boundp 'rmail-current-message)
1.16 (rms 09-Jul-93): rmail-current-message)))
1.16 (rms 09-Jul-93): ;; If MSG is non-nil, buffer is in RMAIL mode.
1.16 (rms 09-Jul-93): (if msg
1.16 (rms 09-Jul-93): (progn
1.25 (rms 24-Dec-93): ;; Turn on auto save mode, if it's off in this
1.25 (rms 24-Dec-93): ;; buffer but enabled by default.
1.25 (rms 24-Dec-93): (and (not buffer-auto-save-file-name)
1.25 (rms 24-Dec-93): auto-save-default
1.25 (rms 24-Dec-93): (auto-save-mode t))
1.16 (rms 09-Jul-93): (rmail-maybe-set-message-counters)
1.16 (rms 09-Jul-93): (widen)
1.16 (rms 09-Jul-93): (narrow-to-region (point-max) (point-max))
1.16 (rms 09-Jul-93): (insert-buffer-substring cur beg end)
1.16 (rms 09-Jul-93): (goto-char (point-min))
1.16 (rms 09-Jul-93): (widen)
1.16 (rms 09-Jul-93): (search-backward "\n\^_")
1.16 (rms 09-Jul-93): (narrow-to-region (point) (point-max))
1.40 (rms 17-Nov-94): (rmail-delete-unwanted-fields)
1.16 (rms 09-Jul-93): (rmail-count-new-messages t)
1.24 (rms 23-Dec-93): (if (rmail-summary-exists)
1.24 (rms 23-Dec-93): (rmail-select-summary
1.24 (rms 23-Dec-93): (rmail-update-summary)))
1.16 (rms 09-Jul-93): (rmail-show-message msg))
1.52 (rms 27-May-98): ;; Output file not in rmail mode => just insert at the end.
1.52 (rms 27-May-98): (narrow-to-region (point-min) (1+ (buffer-size)))
1.52 (rms 27-May-98): (goto-char (point-max))
1.52 (rms 27-May-98): (insert-buffer-substring cur beg end)
1.52 (rms 27-May-98): (rmail-delete-unwanted-fields)))))))
1.16 (rms 09-Jul-93): (rmail-set-attribute "filed" t))
1.16 (rms 09-Jul-93): (if redelete (rmail-set-attribute "deleted" t))))
1.16 (rms 09-Jul-93): (setq count (1- count))
1.16 (rms 09-Jul-93): (if rmail-delete-after-output
1.66 (pot 04-Feb-03): (unless
1.61 (fx 24-May-00): (if (and (= count 0) stay)
1.61 (fx 24-May-00): (rmail-delete-message)
1.61 (fx 24-May-00): (rmail-delete-forward))
1.61 (fx 24-May-00): (setq count 0))
1.16 (rms 09-Jul-93): (if (> count 0)
1.66 (pot 04-Feb-03): (unless
1.61 (fx 24-May-00): (if (not stay) (rmail-next-undeleted-message 1))
1.61 (fx 24-May-00): (setq count 0)))))))
1.16 (rms 09-Jul-93):
1.45 (rms 27-Sep-96): ;;;###autoload
1.49 (rms 03-May-97): (defcustom rmail-fields-not-to-output nil
1.49 (rms 03-May-97): "*Regexp describing fields to exclude when outputting a message to a file."
1.49 (rms 03-May-97): :type '(choice (const :tag "None" nil)
1.49 (rms 03-May-97): regexp)
1.49 (rms 03-May-97): :group 'rmail-output)
1.40 (rms 17-Nov-94):
1.40 (rms 17-Nov-94): ;; Delete from the buffer header fields we don't want output.
1.40 (rms 17-Nov-94): ;; NOT-RMAIL if t means this buffer does not have the full header
1.40 (rms 17-Nov-94): ;; and *** EOOH *** that a message in an Rmail file has.
1.40 (rms 17-Nov-94): (defun rmail-delete-unwanted-fields (&optional not-rmail)
1.66 (pot 04-Feb-03): (if rmail-fields-not-to-output
1.40 (rms 17-Nov-94): (save-excursion
1.40 (rms 17-Nov-94): (goto-char (point-min))
1.40 (rms 17-Nov-94): ;; Find the end of the header.
1.40 (rms 17-Nov-94): (if (and (or not-rmail (search-forward "\n*** EOOH ***\n" nil t))
1.40 (rms 17-Nov-94): (search-forward "\n\n" nil t))
1.40 (rms 17-Nov-94): (let ((end (point-marker)))
1.40 (rms 17-Nov-94): (goto-char (point-min))
1.40 (rms 17-Nov-94): (while (re-search-forward rmail-fields-not-to-output end t)
1.40 (rms 17-Nov-94): (beginning-of-line)
1.40 (rms 17-Nov-94): (delete-region (point)
1.40 (rms 17-Nov-94): (progn (forward-line 1) (point)))))))))
1.40 (rms 17-Nov-94):
1.55 (rms 16-Aug-98): ;;; There are functions elsewhere in Emacs that use this function;
1.55 (rms 16-Aug-98): ;;; look at them before you change the calling method.
1.45 (rms 27-Sep-96): ;;;###autoload
1.22 (rms 15-Nov-93): (defun rmail-output (file-name &optional count noattribute from-gnus)
1.32 (rms 03-Apr-94): "Append this message to system-inbox-format mail file named FILE-NAME.
1.71 (eliz 04-Nov-05): A prefix argument COUNT says to output that many consecutive messages,
1.11 (jimb 14-Feb-93): starting with the current one. Deleted messages are skipped and don't count.
1.71 (eliz 04-Nov-05): When called from lisp code, COUNT may be omitted and defaults to 1.
1.19 (rms 25-Jul-93):
1.20 (rms 09-Oct-93): If the pruned message header is shown on the current message, then
1.20 (rms 09-Oct-93): messages will be appended with pruned headers; otherwise, messages
1.20 (rms 09-Oct-93): will be appended with their original headers.
1.28 (rms 15-Jan-94):
1.38 (rms 19-May-94): The default file name comes from `rmail-default-file',
1.28 (rms 15-Jan-94): which is updated to the name you use in this command.
1.20 (rms 09-Oct-93):
1.19 (rms 25-Jul-93): The optional third argument NOATTRIBUTE, if non-nil, says not
1.22 (rms 15-Nov-93): to set the `filed' attribute, and not to display a message.
1.22 (rms 15-Nov-93):
1.22 (rms 15-Nov-93): The optional fourth argument FROM-GNUS is set when called from GNUS."
1.1 (root 22-May-90): (interactive
1.59 (rms 04-Jan-99): (list (rmail-output-read-file-name)
1.59 (rms 04-Jan-99): (prefix-numeric-value current-prefix-arg)))
1.11 (jimb 14-Feb-93): (or count (setq count 1))
1.3 (jimb 01-Mar-91): (setq file-name
1.3 (jimb 01-Mar-91): (expand-file-name file-name
1.27 (rms 15-Jan-94): (and rmail-default-file
1.27 (rms 15-Jan-94): (file-name-directory rmail-default-file))))
1.42 (rms 21-Sep-95): (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
1.16 (rms 09-Jul-93): (rmail-output-to-rmail-file file-name count)
1.63 (gerd 08-May-01): (set-buffer rmail-buffer)
1.20 (rms 09-Oct-93): (let ((orig-count count)
1.20 (rms 09-Oct-93): (rmailbuf (current-buffer))
1.20 (rms 09-Oct-93): (case-fold-search t)
1.20 (rms 09-Oct-93): (tembuf (get-buffer-create " rmail-output"))
1.20 (rms 09-Oct-93): (original-headers-p
1.22 (rms 15-Nov-93): (and (not from-gnus)
1.66 (pot 04-Feb-03): (save-excursion
1.22 (rms 15-Nov-93): (save-restriction
1.22 (rms 15-Nov-93): (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
1.22 (rms 15-Nov-93): (goto-char (point-min))
1.22 (rms 15-Nov-93): (forward-line 1)
1.22 (rms 15-Nov-93): (= (following-char) ?0)))))
1.20 (rms 09-Oct-93): header-beginning
1.66 (pot 04-Feb-03): mail-from mime-version content-type)
1.20 (rms 09-Oct-93): (while (> count 0)
1.55 (rms 16-Aug-98): ;; Preserve the Mail-From and MIME-Version fields
1.55 (rms 16-Aug-98): ;; even if they have been pruned.
1.22 (rms 15-Nov-93): (or from-gnus
1.55 (rms 16-Aug-98): (save-excursion
1.55 (rms 16-Aug-98): (save-restriction
1.55 (rms 16-Aug-98): (widen)
1.55 (rms 16-Aug-98): (goto-char (rmail-msgbeg rmail-current-message))
1.55 (rms 16-Aug-98): (setq header-beginning (point))
1.55 (rms 16-Aug-98): (search-forward "\n*** EOOH ***\n")
1.55 (rms 16-Aug-98): (narrow-to-region header-beginning (point))
1.66 (pot 04-Feb-03): (setq mail-from (mail-fetch-field "Mail-From"))
1.66 (pot 04-Feb-03): (unless rmail-enable-mime
1.66 (pot 04-Feb-03): (setq mime-version (mail-fetch-field "MIME-Version")
1.66 (pot 04-Feb-03): content-type (mail-fetch-field "Content-type"))))))
1.16 (rms 09-Jul-93): (save-excursion
1.16 (rms 09-Jul-93): (set-buffer tembuf)
1.16 (rms 09-Jul-93): (erase-buffer)
1.16 (rms 09-Jul-93): (insert-buffer-substring rmailbuf)
1.64 (gerd 06-Jul-01): (when rmail-enable-mime
1.64 (gerd 06-Jul-01): (if original-headers-p
1.64 (gerd 06-Jul-01): (delete-region (goto-char (point-min))
1.64 (gerd 06-Jul-01): (if (search-forward "\n*** EOOH ***\n")
1.64 (gerd 06-Jul-01): (match-end 0)))
1.64 (gerd 06-Jul-01): (goto-char (point-min))
1.64 (gerd 06-Jul-01): (forward-line 2)
1.64 (gerd 06-Jul-01): (delete-region (point-min)(point))
1.64 (gerd 06-Jul-01): (search-forward "\n*** EOOH ***\n")
1.64 (gerd 06-Jul-01): (delete-region (match-beginning 0)
1.64 (gerd 06-Jul-01): (if (search-forward "\n\n")
1.64 (gerd 06-Jul-01): (1- (match-end 0)))))
1.64 (gerd 06-Jul-01): (setq buffer-file-coding-system (or rmail-file-coding-system
1.64 (gerd 06-Jul-01): 'raw-text)))
1.40 (rms 17-Nov-94): (rmail-delete-unwanted-fields t)
1.56 (rms 21-Oct-98): (or (bolp) (insert "\n"))
1.16 (rms 09-Jul-93): (goto-char (point-min))
1.20 (rms 09-Oct-93): (if mail-from
1.20 (rms 09-Oct-93): (insert mail-from "\n")
1.20 (rms 09-Oct-93): (insert "From "
1.20 (rms 09-Oct-93): (mail-strip-quoted-names (or (mail-fetch-field "from")
1.20 (rms 09-Oct-93): (mail-fetch-field "really-from")
1.20 (rms 09-Oct-93): (mail-fetch-field "sender")
1.20 (rms 09-Oct-93): "unknown"))
1.20 (rms 09-Oct-93): " " (current-time-string) "\n"))
1.72 (eliz 21-Jan-06): (when mime-version
1.72 (eliz 21-Jan-06): (insert "MIME-Version: " mime-version)
1.72 (eliz 21-Jan-06): ;; Some malformed MIME messages set content-type to nil.
1.72 (eliz 21-Jan-06): (when content-type
1.72 (eliz 21-Jan-06): (insert "\nContent-type: " content-type "\n")))
1.16 (rms 09-Jul-93): ;; ``Quote'' "\nFrom " as "\n>From "
1.16 (rms 09-Jul-93): ;; (note that this isn't really quoting, as there is no requirement
1.16 (rms 09-Jul-93): ;; that "\n[>]+From " be quoted in the same transparent way.)
1.41 (kwzh 02-Dec-94): (let ((case-fold-search nil))
1.41 (kwzh 02-Dec-94): (while (search-forward "\nFrom " nil t)
1.41 (kwzh 02-Dec-94): (forward-char -5)
1.41 (kwzh 02-Dec-94): (insert ?>)))
1.19 (rms 25-Jul-93): (write-region (point-min) (point-max) file-name t
1.19 (rms 25-Jul-93): (if noattribute 'nomsg)))
1.20 (rms 09-Oct-93): (or noattribute
1.20 (rms 09-Oct-93): (if (equal major-mode 'rmail-mode)
1.20 (rms 09-Oct-93): (rmail-set-attribute "filed" t)))
1.20 (rms 09-Oct-93): (setq count (1- count))
1.22 (rms 15-Nov-93): (or from-gnus
1.22 (rms 15-Nov-93): (let ((next-message-p
1.22 (rms 15-Nov-93): (if rmail-delete-after-output
1.22 (rms 15-Nov-93): (rmail-delete-forward)
1.22 (rms 15-Nov-93): (if (> count 0)
1.22 (rms 15-Nov-93): (rmail-next-undeleted-message 1))))
1.22 (rms 15-Nov-93): (num-appended (- orig-count count)))
1.22 (rms 15-Nov-93): (if (and next-message-p original-headers-p)
1.22 (rms 15-Nov-93): (rmail-toggle-header))
1.22 (rms 15-Nov-93): (if (and (> count 0) (not next-message-p))
1.66 (pot 04-Feb-03): (progn
1.78 (deego 06-Dec-07): (error "%s"
1.22 (rms 15-Nov-93): (save-excursion
1.22 (rms 15-Nov-93): (set-buffer rmailbuf)
1.22 (rms 15-Nov-93): (format "Only %d message%s appended" num-appended
1.22 (rms 15-Nov-93): (if (= num-appended 1) "" "s"))))
1.22 (rms 15-Nov-93): (setq count 0))))))
1.20 (rms 09-Oct-93): (kill-buffer tembuf))))
1.4 (eric 30-May-92):
1.46 (rms 30-Mar-97): ;;;###autoload
1.48 (rms 05-Apr-97): (defun rmail-output-body-to-file (file-name)
1.46 (rms 30-Mar-97): "Write this message body to the file FILE-NAME.
1.46 (rms 30-Mar-97): FILE-NAME defaults, interactively, from the Subject field of the message."
1.46 (rms 30-Mar-97): (interactive
1.46 (rms 30-Mar-97): (let ((default-file
1.51 (rms 23-May-98): (or (mail-fetch-field "Subject")
1.51 (rms 23-May-98): rmail-default-body-file)))
1.51 (rms 23-May-98): (list (setq rmail-default-body-file
1.51 (rms 23-May-98): (read-file-name
1.51 (rms 23-May-98): "Output message body to file: "
1.51 (rms 23-May-98): (and default-file (file-name-directory default-file))
1.51 (rms 23-May-98): default-file
1.51 (rms 23-May-98): nil default-file)))))
1.51 (rms 23-May-98): (setq file-name
1.51 (rms 23-May-98): (expand-file-name file-name
1.51 (rms 23-May-98): (and rmail-default-body-file
1.51 (rms 23-May-98): (file-name-directory rmail-default-body-file))))
1.46 (rms 30-Mar-97): (save-excursion
1.46 (rms 30-Mar-97): (goto-char (point-min))
1.46 (rms 30-Mar-97): (search-forward "\n\n")
1.48 (rms 05-Apr-97): (and (file-exists-p file-name)
1.74 (lektu 13-Nov-06): (not (y-or-n-p (format "File %s exists; overwrite? " file-name)))
1.48 (rms 05-Apr-97): (error "Operation aborted"))
1.46 (rms 30-Mar-97): (write-region (point) (point-max) file-name)
1.46 (rms 30-Mar-97): (if (equal major-mode 'rmail-mode)
1.46 (rms 30-Mar-97): (rmail-set-attribute "stored" t)))
1.46 (rms 30-Mar-97): (if rmail-delete-after-output
1.46 (rms 30-Mar-97): (rmail-delete-forward)))
1.46 (rms 30-Mar-97):
1.80 (monnier 10-Apr-08): ;; arch-tag: 447117c6-1a9a-4b88-aa43-3101b043e3a4
1.4 (eric 30-May-92): ;;; rmailout.el ends here

View file

@ -1,250 +0,0 @@
1.28 (pj 15-Jul-01): ;;; rmailsort.el --- Rmail: sort messages
1.7 (eric 30-May-92):
1.32 (ttn 06-Aug-05): ;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004,
1.37 (miles 08-Jan-08): ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
1.11 (eric 22-Jul-92):
1.14 (rms 26-May-93): ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
1.26 (rms 10-Feb-97): ;; Maintainer: FSF
1.10 (eric 17-Jul-92): ;; Keywords: mail
1.9 (eric 16-Jul-92):
1.8 (rms 14-Jul-92): ;; This file is part of GNU Emacs.
1.1 (rms 10-Sep-90):
1.39 (gm 06-May-08): ;; GNU Emacs is free software: you can redistribute it and/or modify
1.8 (rms 14-Jul-92): ;; it under the terms of the GNU General Public License as published by
1.39 (gm 06-May-08): ;; the Free Software Foundation, either version 3 of the License, or
1.39 (gm 06-May-08): ;; (at your option) any later version.
1.1 (rms 10-Sep-90):
1.1 (rms 10-Sep-90): ;; GNU Emacs is distributed in the hope that it will be useful,
1.8 (rms 14-Jul-92): ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
1.8 (rms 14-Jul-92): ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1.8 (rms 14-Jul-92): ;; GNU General Public License for more details.
1.8 (rms 14-Jul-92):
1.8 (rms 14-Jul-92): ;; You should have received a copy of the GNU General Public License
1.39 (gm 06-May-08): ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
1.28 (pj 15-Jul-01):
1.28 (pj 15-Jul-01): ;;; Commentary:
1.1 (rms 10-Sep-90):
1.9 (eric 16-Jul-92): ;;; Code:
1.1 (rms 10-Sep-90):
1.1 (rms 10-Sep-90): (require 'sort)
1.24 (kwzh 20-Jan-96):
1.24 (kwzh 20-Jan-96): ;; For rmail-select-summary
1.24 (kwzh 20-Jan-96): (require 'rmail)
1.1 (rms 10-Sep-90):
1.14 (rms 26-May-93): (autoload 'timezone-make-date-sortable "timezone")
1.14 (rms 26-May-93):
1.14 (rms 26-May-93): ;; Sorting messages in Rmail buffer
1.14 (rms 26-May-93):
1.25 (rms 27-Sep-96): ;;;###autoload
1.1 (rms 10-Sep-90): (defun rmail-sort-by-date (reverse)
1.1 (rms 10-Sep-90): "Sort messages of current Rmail file by date.
1.1 (rms 10-Sep-90): If prefix argument REVERSE is non-nil, sort them in reverse order."
1.1 (rms 10-Sep-90): (interactive "P")
1.1 (rms 10-Sep-90): (rmail-sort-messages reverse
1.1 (rms 10-Sep-90): (function
1.1 (rms 10-Sep-90): (lambda (msg)
1.14 (rms 26-May-93): (rmail-make-date-sortable
1.1 (rms 10-Sep-90): (rmail-fetch-field msg "Date"))))))
1.1 (rms 10-Sep-90):
1.25 (rms 27-Sep-96): ;;;###autoload
1.1 (rms 10-Sep-90): (defun rmail-sort-by-subject (reverse)
1.1 (rms 10-Sep-90): "Sort messages of current Rmail file by subject.
1.1 (rms 10-Sep-90): If prefix argument REVERSE is non-nil, sort them in reverse order."
1.1 (rms 10-Sep-90): (interactive "P")
1.1 (rms 10-Sep-90): (rmail-sort-messages reverse
1.1 (rms 10-Sep-90): (function
1.1 (rms 10-Sep-90): (lambda (msg)
1.1 (rms 10-Sep-90): (let ((key (or (rmail-fetch-field msg "Subject") ""))
1.1 (rms 10-Sep-90): (case-fold-search t))
1.1 (rms 10-Sep-90): ;; Remove `Re:'
1.18 (kwzh 23-Mar-94): (if (string-match "^\\(re:[ \t]*\\)*" key)
1.18 (kwzh 23-Mar-94): (substring key (match-end 0))
1.18 (kwzh 23-Mar-94): key))))))
1.1 (rms 10-Sep-90):
1.25 (rms 27-Sep-96): ;;;###autoload
1.1 (rms 10-Sep-90): (defun rmail-sort-by-author (reverse)
1.1 (rms 10-Sep-90): "Sort messages of current Rmail file by author.
1.1 (rms 10-Sep-90): If prefix argument REVERSE is non-nil, sort them in reverse order."
1.1 (rms 10-Sep-90): (interactive "P")
1.1 (rms 10-Sep-90): (rmail-sort-messages reverse
1.1 (rms 10-Sep-90): (function
1.1 (rms 10-Sep-90): (lambda (msg)
1.14 (rms 26-May-93): (downcase ;Canonical name
1.14 (rms 26-May-93): (mail-strip-quoted-names
1.14 (rms 26-May-93): (or (rmail-fetch-field msg "From")
1.14 (rms 26-May-93): (rmail-fetch-field msg "Sender") "")))))))
1.1 (rms 10-Sep-90):
1.25 (rms 27-Sep-96): ;;;###autoload
1.1 (rms 10-Sep-90): (defun rmail-sort-by-recipient (reverse)
1.1 (rms 10-Sep-90): "Sort messages of current Rmail file by recipient.
1.1 (rms 10-Sep-90): If prefix argument REVERSE is non-nil, sort them in reverse order."
1.1 (rms 10-Sep-90): (interactive "P")
1.1 (rms 10-Sep-90): (rmail-sort-messages reverse
1.1 (rms 10-Sep-90): (function
1.1 (rms 10-Sep-90): (lambda (msg)
1.14 (rms 26-May-93): (downcase ;Canonical name
1.14 (rms 26-May-93): (mail-strip-quoted-names
1.14 (rms 26-May-93): (or (rmail-fetch-field msg "To")
1.14 (rms 26-May-93): (rmail-fetch-field msg "Apparently-To") "")
1.14 (rms 26-May-93): ))))))
1.1 (rms 10-Sep-90):
1.25 (rms 27-Sep-96): ;;;###autoload
1.3 (rms 03-Dec-90): (defun rmail-sort-by-correspondent (reverse)
1.3 (rms 03-Dec-90): "Sort messages of current Rmail file by other correspondent.
1.3 (rms 03-Dec-90): If prefix argument REVERSE is non-nil, sort them in reverse order."
1.3 (rms 03-Dec-90): (interactive "P")
1.3 (rms 03-Dec-90): (rmail-sort-messages reverse
1.3 (rms 03-Dec-90): (function
1.3 (rms 03-Dec-90): (lambda (msg)
1.3 (rms 03-Dec-90): (rmail-select-correspondent
1.3 (rms 03-Dec-90): msg
1.3 (rms 03-Dec-90): '("From" "Sender" "To" "Apparently-To"))))))
1.3 (rms 03-Dec-90):
1.3 (rms 03-Dec-90): (defun rmail-select-correspondent (msg fields)
1.3 (rms 03-Dec-90): (let ((ans ""))
1.14 (rms 26-May-93): (while (and fields (string= ans ""))
1.14 (rms 26-May-93): (setq ans
1.14 (rms 26-May-93): (rmail-dont-reply-to
1.14 (rms 26-May-93): (mail-strip-quoted-names
1.14 (rms 26-May-93): (or (rmail-fetch-field msg (car fields)) ""))))
1.14 (rms 26-May-93): (setq fields (cdr fields)))
1.14 (rms 26-May-93): ans))
1.4 (rms 27-Dec-90):
1.25 (rms 27-Sep-96): ;;;###autoload
1.14 (rms 26-May-93): (defun rmail-sort-by-lines (reverse)
1.15 (rms 22-Jun-93): "Sort messages of current Rmail file by number of lines.
1.4 (rms 27-Dec-90): If prefix argument REVERSE is non-nil, sort them in reverse order."
1.4 (rms 27-Dec-90): (interactive "P")
1.4 (rms 27-Dec-90): (rmail-sort-messages reverse
1.4 (rms 27-Dec-90): (function
1.4 (rms 27-Dec-90): (lambda (msg)
1.17 (kwzh 12-Mar-94): (count-lines (rmail-msgbeg msg)
1.17 (kwzh 12-Mar-94): (rmail-msgend msg))))))
1.21 (kwzh 07-Apr-94):
1.25 (rms 27-Sep-96): ;;;###autoload
1.27 (gerd 07-May-01): (defun rmail-sort-by-labels (reverse labels)
1.21 (kwzh 07-Apr-94): "Sort messages of current Rmail file by labels.
1.21 (kwzh 07-Apr-94): If prefix argument REVERSE is non-nil, sort them in reverse order.
1.21 (kwzh 07-Apr-94): KEYWORDS is a comma-separated list of labels."
1.21 (kwzh 07-Apr-94): (interactive "P\nsSort by labels: ")
1.21 (kwzh 07-Apr-94): (or (string-match "[^ \t]" labels)
1.21 (kwzh 07-Apr-94): (error "No labels specified"))
1.21 (kwzh 07-Apr-94): (setq labels (concat (substring labels (match-beginning 0)) ","))
1.21 (kwzh 07-Apr-94): (let (labelvec)
1.21 (kwzh 07-Apr-94): (while (string-match "[ \t]*,[ \t]*" labels)
1.29 (lektu 04-Feb-03): (setq labelvec (cons
1.21 (kwzh 07-Apr-94): (concat ", ?\\("
1.21 (kwzh 07-Apr-94): (substring labels 0 (match-beginning 0))
1.21 (kwzh 07-Apr-94): "\\),")
1.21 (kwzh 07-Apr-94): labelvec))
1.21 (kwzh 07-Apr-94): (setq labels (substring labels (match-end 0))))
1.21 (kwzh 07-Apr-94): (setq labelvec (apply 'vector (nreverse labelvec)))
1.21 (kwzh 07-Apr-94): (rmail-sort-messages reverse
1.21 (kwzh 07-Apr-94): (function
1.21 (kwzh 07-Apr-94): (lambda (msg)
1.21 (kwzh 07-Apr-94): (let ((n 0))
1.21 (kwzh 07-Apr-94): (while (and (< n (length labelvec))
1.21 (kwzh 07-Apr-94): (not (rmail-message-labels-p
1.21 (kwzh 07-Apr-94): msg (aref labelvec n))))
1.21 (kwzh 07-Apr-94): (setq n (1+ n)))
1.21 (kwzh 07-Apr-94): n))))))
1.14 (rms 26-May-93):
1.14 (rms 26-May-93): ;; Basic functions
1.36 (dann 25-Nov-07): (declare-function rmail-update-summary "rmailsum" (&rest ignore))
1.1 (rms 10-Sep-90):
1.14 (rms 26-May-93): (defun rmail-sort-messages (reverse keyfun)
1.1 (rms 10-Sep-90): "Sort messages of current Rmail file.
1.14 (rms 26-May-93): If 1st argument REVERSE is non-nil, sort them in reverse order.
1.14 (rms 26-May-93): 2nd argument KEYFUN is called with a message number, and should return a key."
1.26 (rms 10-Feb-97): (save-current-buffer
1.16 (rms 24-Nov-93): ;; If we are in a summary buffer, operate on the Rmail buffer.
1.16 (rms 24-Nov-93): (if (eq major-mode 'rmail-summary-mode)
1.16 (rms 24-Nov-93): (set-buffer rmail-buffer))
1.16 (rms 24-Nov-93): (let ((buffer-read-only nil)
1.26 (rms 10-Feb-97): (point-offset (- (point) (point-min)))
1.16 (rms 24-Nov-93): (predicate nil) ;< or string-lessp
1.16 (rms 24-Nov-93): (sort-lists nil))
1.16 (rms 24-Nov-93): (message "Finding sort keys...")
1.16 (rms 24-Nov-93): (widen)
1.16 (rms 24-Nov-93): (let ((msgnum 1))
1.16 (rms 24-Nov-93): (while (>= rmail-total-messages msgnum)
1.16 (rms 24-Nov-93): (setq sort-lists
1.16 (rms 24-Nov-93): (cons (list (funcall keyfun msgnum) ;Make sorting key
1.16 (rms 24-Nov-93): (eq rmail-current-message msgnum) ;True if current
1.16 (rms 24-Nov-93): (aref rmail-message-vector msgnum)
1.16 (rms 24-Nov-93): (aref rmail-message-vector (1+ msgnum)))
1.16 (rms 24-Nov-93): sort-lists))
1.16 (rms 24-Nov-93): (if (zerop (% msgnum 10))
1.16 (rms 24-Nov-93): (message "Finding sort keys...%d" msgnum))
1.16 (rms 24-Nov-93): (setq msgnum (1+ msgnum))))
1.16 (rms 24-Nov-93): (or reverse (setq sort-lists (nreverse sort-lists)))
1.16 (rms 24-Nov-93): ;; Decide predicate: < or string-lessp
1.16 (rms 24-Nov-93): (if (numberp (car (car sort-lists))) ;Is a key numeric?
1.16 (rms 24-Nov-93): (setq predicate (function <))
1.16 (rms 24-Nov-93): (setq predicate (function string-lessp)))
1.16 (rms 24-Nov-93): (setq sort-lists
1.16 (rms 24-Nov-93): (sort sort-lists
1.16 (rms 24-Nov-93): (function
1.16 (rms 24-Nov-93): (lambda (a b)
1.16 (rms 24-Nov-93): (funcall predicate (car a) (car b))))))
1.16 (rms 24-Nov-93): (if reverse (setq sort-lists (nreverse sort-lists)))
1.16 (rms 24-Nov-93): ;; Now we enter critical region. So, keyboard quit is disabled.
1.16 (rms 24-Nov-93): (message "Reordering messages...")
1.16 (rms 24-Nov-93): (let ((inhibit-quit t) ;Inhibit quit
1.16 (rms 24-Nov-93): (current-message nil)
1.16 (rms 24-Nov-93): (msgnum 1)
1.16 (rms 24-Nov-93): (msginfo nil))
1.16 (rms 24-Nov-93): ;; There's little hope that we can easily undo after that.
1.20 (kwzh 30-Mar-94): (buffer-disable-undo (current-buffer))
1.16 (rms 24-Nov-93): (goto-char (rmail-msgbeg 1))
1.16 (rms 24-Nov-93): ;; To force update of all markers.
1.16 (rms 24-Nov-93): (insert-before-markers ?Z)
1.16 (rms 24-Nov-93): (backward-char 1)
1.16 (rms 24-Nov-93): ;; Now reorder messages.
1.16 (rms 24-Nov-93): (while sort-lists
1.16 (rms 24-Nov-93): (setq msginfo (car sort-lists))
1.16 (rms 24-Nov-93): ;; Swap two messages.
1.16 (rms 24-Nov-93): (insert-buffer-substring
1.16 (rms 24-Nov-93): (current-buffer) (nth 2 msginfo) (nth 3 msginfo))
1.16 (rms 24-Nov-93): (delete-region (nth 2 msginfo) (nth 3 msginfo))
1.16 (rms 24-Nov-93): ;; Is current message?
1.16 (rms 24-Nov-93): (if (nth 1 msginfo)
1.16 (rms 24-Nov-93): (setq current-message msgnum))
1.16 (rms 24-Nov-93): (setq sort-lists (cdr sort-lists))
1.16 (rms 24-Nov-93): (if (zerop (% msgnum 10))
1.16 (rms 24-Nov-93): (message "Reordering messages...%d" msgnum))
1.16 (rms 24-Nov-93): (setq msgnum (1+ msgnum)))
1.16 (rms 24-Nov-93): ;; Delete the garbage inserted before.
1.16 (rms 24-Nov-93): (delete-char 1)
1.16 (rms 24-Nov-93): (setq quit-flag nil)
1.16 (rms 24-Nov-93): (buffer-enable-undo)
1.16 (rms 24-Nov-93): (rmail-set-message-counters)
1.19 (kwzh 30-Mar-94): (rmail-show-message current-message)
1.26 (rms 10-Feb-97): (goto-char (+ point-offset (point-min)))
1.19 (kwzh 30-Mar-94): (if (rmail-summary-exists)
1.19 (kwzh 30-Mar-94): (rmail-select-summary
1.19 (kwzh 30-Mar-94): (rmail-update-summary)))))))
1.14 (rms 26-May-93):
1.1 (rms 10-Sep-90): (defun rmail-fetch-field (msg field)
1.14 (rms 26-May-93): "Return the value of the header FIELD of MSG.
1.1 (rms 10-Sep-90): Arguments are MSG and FIELD."
1.14 (rms 26-May-93): (save-restriction
1.14 (rms 26-May-93): (widen)
1.14 (rms 26-May-93): (let ((next (rmail-msgend msg)))
1.1 (rms 10-Sep-90): (goto-char (rmail-msgbeg msg))
1.1 (rms 10-Sep-90): (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t)
1.1 (rms 10-Sep-90): (point)
1.1 (rms 10-Sep-90): (forward-line 1)
1.1 (rms 10-Sep-90): (point))
1.1 (rms 10-Sep-90): (progn (search-forward "\n\n" nil t) (point)))
1.1 (rms 10-Sep-90): (mail-fetch-field field))))
1.1 (rms 10-Sep-90):
1.14 (rms 26-May-93): (defun rmail-make-date-sortable (date)
1.14 (rms 26-May-93): "Make DATE sortable using the function string-lessp."
1.14 (rms 26-May-93): ;; Assume the default time zone is GMT.
1.14 (rms 26-May-93): (timezone-make-date-sortable date "GMT" "GMT"))
1.6 (jimb 16-Mar-92):
1.6 (jimb 16-Mar-92): (provide 'rmailsort)
1.7 (eric 30-May-92):
1.38 (monnier 10-Apr-08): ;; arch-tag: 0d90896b-0c35-46ac-b240-38be5ada2360
1.7 (eric 30-May-92): ;;; rmailsort.el ends here