Removed rmail.el, rmailedit.el, rmailkwd.el, rmailmm.el, rmailmsc.el, rmailout.el, rmailsort.el, rmailsum.el.
This commit is contained in:
Bastien Guerry
parent
3a88a8258c
commit
13847f7970
7 changed files with 0 additions and 7184 deletions
4287
lisp/mail/rmail.el
4287
lisp/mail/rmail.el
File diff suppressed because it is too large
Load diff
|
|
@ -1,164 +0,0 @@
|
|||
;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
|
||||
|
||||
;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
|
||||
;; 2007, 2008, 2009 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:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'rmail)
|
||||
|
||||
(defcustom rmail-edit-mode-hook nil
|
||||
"List of functions to call when editing an RMAIL message."
|
||||
:type 'hook
|
||||
:version "21.1"
|
||||
:group 'rmail-edit)
|
||||
|
||||
(defvar rmail-old-text)
|
||||
|
||||
(defvar rmail-edit-map nil)
|
||||
(if rmail-edit-map
|
||||
nil
|
||||
;; Make a keymap that inherits text-mode-map.
|
||||
(setq rmail-edit-map (make-sparse-keymap))
|
||||
(set-keymap-parent rmail-edit-map text-mode-map)
|
||||
(define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit)
|
||||
(define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit))
|
||||
|
||||
;; Rmail Edit mode is suitable only for specially formatted data.
|
||||
(put 'rmail-edit-mode 'mode-class 'special)
|
||||
|
||||
(declare-function rmail-summary-disable "" ())
|
||||
(declare-function rmail-summary-enable "rmailsum" ())
|
||||
|
||||
(defun rmail-edit-mode ()
|
||||
"Major mode for editing the contents of an RMAIL message.
|
||||
The editing commands are the same as in Text mode, together with two commands
|
||||
to return to regular RMAIL:
|
||||
* \\[rmail-abort-edit] cancels the changes
|
||||
you have made and returns to RMAIL
|
||||
* \\[rmail-cease-edit] makes them permanent.
|
||||
This functions runs the normal hook `rmail-edit-mode-hook'.
|
||||
\\{rmail-edit-map}"
|
||||
(delay-mode-hooks (text-mode))
|
||||
(use-local-map rmail-edit-map)
|
||||
(setq major-mode 'rmail-edit-mode)
|
||||
(setq mode-name "RMAIL Edit")
|
||||
(if (boundp 'mode-line-modified)
|
||||
(setq mode-line-modified (default-value 'mode-line-modified))
|
||||
(setq mode-line-format (default-value 'mode-line-format)))
|
||||
(if (rmail-summary-exists)
|
||||
(save-excursion
|
||||
(set-buffer rmail-summary-buffer)
|
||||
(rmail-summary-disable)))
|
||||
(run-mode-hooks 'rmail-edit-mode-hook))
|
||||
|
||||
(defvar rmail-old-pruned nil)
|
||||
(put 'rmail-old-pruned 'permanent-local t)
|
||||
|
||||
(defvar rmail-edit-saved-coding-system nil)
|
||||
(put 'rmail-edit-saved-coding-system 'permanent-local t)
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-edit-current-message ()
|
||||
"Edit the contents of this message."
|
||||
(interactive)
|
||||
(make-local-variable 'rmail-old-pruned)
|
||||
(setq rmail-old-pruned (rmail-msg-is-pruned))
|
||||
(make-local-variable 'rmail-edit-saved-coding-system)
|
||||
(setq rmail-edit-saved-coding-system save-buffer-coding-system)
|
||||
(rmail-toggle-header 0)
|
||||
(rmail-edit-mode)
|
||||
;; As the local value of save-buffer-coding-system is deleted by
|
||||
;; rmail-edit-mode, we restore the original value.
|
||||
(make-local-variable 'save-buffer-coding-system)
|
||||
(setq save-buffer-coding-system rmail-edit-saved-coding-system)
|
||||
(make-local-variable 'rmail-old-text)
|
||||
(setq rmail-old-text (buffer-substring (point-min) (point-max)))
|
||||
(setq buffer-read-only nil)
|
||||
(force-mode-line-update)
|
||||
(if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit)
|
||||
(eq (key-binding "\C-c\C-]") 'rmail-abort-edit))
|
||||
(message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort")
|
||||
(message "%s" (substitute-command-keys
|
||||
"Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))
|
||||
|
||||
(defun rmail-cease-edit ()
|
||||
"Finish editing message; switch back to Rmail proper."
|
||||
(interactive)
|
||||
(if (rmail-summary-exists)
|
||||
(save-excursion
|
||||
(set-buffer rmail-summary-buffer)
|
||||
(rmail-summary-enable)))
|
||||
;; Make sure buffer ends with a newline.
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(if (/= (preceding-char) ?\n)
|
||||
(insert "\n"))
|
||||
;; Adjust the marker that points to the end of this message.
|
||||
(set-marker (aref rmail-message-vector (1+ rmail-current-message))
|
||||
(point)))
|
||||
(let ((old rmail-old-text))
|
||||
(force-mode-line-update)
|
||||
(kill-all-local-variables)
|
||||
(rmail-mode-1)
|
||||
(if (boundp 'tool-bar-map)
|
||||
(set (make-local-variable 'tool-bar-map) rmail-tool-bar-map))
|
||||
(rmail-variables)
|
||||
;; As the local value of save-buffer-coding-system is changed by
|
||||
;; rmail-variables, we restore the original value.
|
||||
(setq save-buffer-coding-system rmail-edit-saved-coding-system)
|
||||
(if (and (= (length old) (- (point-max) (point-min)))
|
||||
(string= old (buffer-substring (point-min) (point-max))))
|
||||
()
|
||||
(setq old nil)
|
||||
(rmail-set-attribute "edited" t)
|
||||
(if (boundp 'rmail-summary-vector)
|
||||
(progn
|
||||
(aset rmail-summary-vector (1- rmail-current-message) nil)
|
||||
(save-excursion
|
||||
(rmail-widen-to-current-msgbeg
|
||||
(function (lambda ()
|
||||
(forward-line 2)
|
||||
(if (looking-at "Summary-line: ")
|
||||
(let ((buffer-read-only nil))
|
||||
(delete-region (point)
|
||||
(progn (forward-line 1)
|
||||
(point))))))))))))
|
||||
(save-excursion
|
||||
(rmail-show-message)
|
||||
(rmail-toggle-header (if rmail-old-pruned 1 0))))
|
||||
(run-hooks 'rmail-mode-hook)
|
||||
(setq buffer-read-only t))
|
||||
|
||||
(defun rmail-abort-edit ()
|
||||
"Abort edit of current message; restore original contents."
|
||||
(interactive)
|
||||
(delete-region (point-min) (point-max))
|
||||
(insert rmail-old-text)
|
||||
(rmail-cease-edit)
|
||||
(rmail-highlight-headers))
|
||||
|
||||
(provide 'rmailedit)
|
||||
|
||||
;; arch-tag: 93c22709-a14a-46c1-ab91-52c3f5a0ec12
|
||||
;;; rmailedit.el ends here
|
||||
|
|
@ -1,290 +0,0 @@
|
|||
;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
|
||||
|
||||
;; Copyright (C) 1985, 1988, 1994, 2001, 2002, 2003, 2004,
|
||||
;; 2005, 2006, 2007, 2008, 2009 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:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defvar rmail-buffer)
|
||||
(defvar rmail-current-message)
|
||||
(defvar rmail-last-label)
|
||||
(defvar rmail-last-multi-labels)
|
||||
(defvar rmail-summary-vector)
|
||||
(defvar rmail-total-messages)
|
||||
|
||||
;; Global to all RMAIL 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.
|
||||
|
||||
(defvar rmail-label-obarray (make-vector 47 0))
|
||||
|
||||
;; Named list of symbols representing valid message attributes in RMAIL.
|
||||
|
||||
(defconst rmail-attributes
|
||||
(cons 'rmail-keywords
|
||||
(mapcar (function (lambda (s) (intern s rmail-label-obarray)))
|
||||
'("deleted" "answered" "filed" "forwarded" "unseen" "edited"
|
||||
"resent"))))
|
||||
|
||||
(defconst rmail-deleted-label (intern "deleted" rmail-label-obarray))
|
||||
|
||||
;; Named list of symbols representing valid message keywords in RMAIL.
|
||||
|
||||
(defvar rmail-keywords)
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-add-label (string)
|
||||
"Add LABEL to labels associated with current RMAIL message.
|
||||
Completion is performed over known labels when reading."
|
||||
(interactive (list (rmail-read-label "Add label")))
|
||||
(rmail-set-label string t))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-kill-label (string)
|
||||
"Remove LABEL from labels associated with current RMAIL message.
|
||||
Completion is performed over known labels when reading."
|
||||
(interactive (list (rmail-read-label "Remove label")))
|
||||
(rmail-set-label string nil))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-read-label (prompt)
|
||||
(with-current-buffer rmail-buffer
|
||||
(if (not rmail-keywords) (rmail-parse-file-keywords))
|
||||
(let ((result
|
||||
(completing-read (concat prompt
|
||||
(if rmail-last-label
|
||||
(concat " (default "
|
||||
(symbol-name rmail-last-label)
|
||||
"): ")
|
||||
": "))
|
||||
rmail-label-obarray
|
||||
nil
|
||||
nil)))
|
||||
(if (string= result "")
|
||||
rmail-last-label
|
||||
(setq rmail-last-label (rmail-make-label result t))))))
|
||||
|
||||
(declare-function rmail-maybe-set-message-counters "rmail" ())
|
||||
(declare-function rmail-display-labels "rmail" ())
|
||||
(declare-function rmail-msgbeg "rmail" (n))
|
||||
(declare-function rmail-set-message-deleted-p "rmail" (n state))
|
||||
(declare-function rmail-message-labels-p "rmail" (msg labels))
|
||||
(declare-function rmail-show-message "rmail" (&optional n no-summary))
|
||||
(declare-function mail-comma-list-regexp "mail-utils" (labels))
|
||||
(declare-function mail-parse-comma-list "mail-utils.el" ())
|
||||
|
||||
(defun rmail-set-label (l state &optional n)
|
||||
(with-current-buffer rmail-buffer
|
||||
(rmail-maybe-set-message-counters)
|
||||
(if (not n) (setq n rmail-current-message))
|
||||
(aset rmail-summary-vector (1- n) nil)
|
||||
(let* ((attribute (rmail-attribute-p l))
|
||||
(keyword (and (not attribute)
|
||||
(or (rmail-keyword-p l)
|
||||
(rmail-install-keyword l))))
|
||||
(label (or attribute keyword)))
|
||||
(if label
|
||||
(let ((omax (- (buffer-size) (point-max)))
|
||||
(omin (- (buffer-size) (point-min)))
|
||||
(buffer-read-only nil)
|
||||
(case-fold-search t))
|
||||
(unwind-protect
|
||||
(save-excursion
|
||||
(widen)
|
||||
(goto-char (rmail-msgbeg n))
|
||||
(forward-line 1)
|
||||
(if (not (looking-at "[01],"))
|
||||
nil
|
||||
(let ((start (1+ (point)))
|
||||
(bound))
|
||||
(narrow-to-region (point) (progn (end-of-line) (point)))
|
||||
(setq bound (point-max))
|
||||
(search-backward ",," nil t)
|
||||
(if attribute
|
||||
(setq bound (1+ (point)))
|
||||
(setq start (1+ (point))))
|
||||
(goto-char start)
|
||||
; (while (re-search-forward "[ \t]*,[ \t]*" nil t)
|
||||
; (replace-match ","))
|
||||
; (goto-char start)
|
||||
(if (re-search-forward
|
||||
(concat ", " (rmail-quote-label-name label) ",")
|
||||
bound
|
||||
'move)
|
||||
(if (not state) (replace-match ","))
|
||||
(if state (insert " " (symbol-name label) ",")))
|
||||
(if (eq label rmail-deleted-label)
|
||||
(rmail-set-message-deleted-p n state)))))
|
||||
(narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))
|
||||
(if (= n rmail-current-message) (rmail-display-labels))))))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; Motion on messages with keywords.
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-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: ")
|
||||
(rmail-next-labeled-message (- n) labels))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-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: ")
|
||||
(if (string= labels "")
|
||||
(setq labels rmail-last-multi-labels))
|
||||
(or labels
|
||||
(error "No labels to find have been specified previously"))
|
||||
(set-buffer rmail-buffer)
|
||||
(setq rmail-last-multi-labels labels)
|
||||
(rmail-maybe-set-message-counters)
|
||||
(let ((lastwin rmail-current-message)
|
||||
(current rmail-current-message)
|
||||
(regexp (concat ", ?\\("
|
||||
(mail-comma-list-regexp labels)
|
||||
"\\),")))
|
||||
(save-restriction
|
||||
(widen)
|
||||
(while (and (> n 0) (< current rmail-total-messages))
|
||||
(setq current (1+ current))
|
||||
(if (rmail-message-labels-p current regexp)
|
||||
(setq lastwin current n (1- n))))
|
||||
(while (and (< n 0) (> current 1))
|
||||
(setq current (1- current))
|
||||
(if (rmail-message-labels-p current regexp)
|
||||
(setq lastwin current n (1+ n)))))
|
||||
(rmail-show-message lastwin)
|
||||
(if (< n 0)
|
||||
(message "No previous message with labels %s" labels))
|
||||
(if (> n 0)
|
||||
(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 option.
|
||||
(defun rmail-keywords ()
|
||||
(or rmail-keywords (rmail-parse-file-keywords)))
|
||||
|
||||
;; 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)))))))))
|
||||
|
||||
;; 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)
|
||||
(let ((keyword (rmail-make-label word t))
|
||||
(keywords (rmail-keywords)))
|
||||
(if (not (or (rmail-attribute-p keyword)
|
||||
(rmail-keyword-p keyword)))
|
||||
(let ((omin (- (buffer-size) (point-min)))
|
||||
(omax (- (buffer-size) (point-max))))
|
||||
(unwind-protect
|
||||
(save-excursion
|
||||
(widen)
|
||||
(goto-char 1)
|
||||
(let ((case-fold-search t)
|
||||
(buffer-read-only nil))
|
||||
(or (search-forward "\nLabels:" nil t)
|
||||
(progn
|
||||
(end-of-line)
|
||||
(insert "\nLabels:")))
|
||||
(delete-region (point) (progn (end-of-line) (point)))
|
||||
(setcdr keywords (cons keyword (cdr keywords)))
|
||||
(while (setq keywords (cdr keywords))
|
||||
(insert (symbol-name (car keywords)) ","))
|
||||
(delete-char -1)))
|
||||
(narrow-to-region (- (buffer-size) omin)
|
||||
(- (buffer-size) omax)))))
|
||||
keyword))
|
||||
|
||||
;; arch-tag: b26b3392-99ca-4e1d-933a-dab59b04e9a8
|
||||
;;; rmailkwd.el ends here
|
||||
|
|
@ -1,67 +0,0 @@
|
|||
;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader
|
||||
|
||||
;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005,
|
||||
;; 2006, 2007, 2008, 2009 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:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defvar rmail-current-message)
|
||||
(defvar rmail-inbox-list)
|
||||
|
||||
(declare-function rmail-parse-file-inboxes "rmail" ())
|
||||
(declare-function rmail-show-message "rmail" (&optional n no-summary))
|
||||
|
||||
;;;###autoload
|
||||
(defun set-rmail-inbox-list (file-name)
|
||||
"Set the inbox list of the current RMAIL file to FILE-NAME.
|
||||
You can specify one file name, or several names separated by commas.
|
||||
If FILE-NAME is empty, remove any existing inbox list."
|
||||
(interactive "sSet mailbox list to (comma-separated list of filenames): ")
|
||||
|
||||
(unless (eq major-mode 'rmail-mode)
|
||||
(error "set-rmail-inbox-list works only for an Rmail file"))
|
||||
|
||||
(save-excursion
|
||||
(let ((names (rmail-parse-file-inboxes))
|
||||
(standard-output nil))
|
||||
(if (or (not names)
|
||||
(y-or-n-p (concat "Replace "
|
||||
(mapconcat 'identity names ", ")
|
||||
"? ")))
|
||||
(let ((buffer-read-only nil))
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(search-forward "\n\^_")
|
||||
(re-search-backward "^Mail" nil t)
|
||||
(forward-line 0)
|
||||
(if (looking-at "Mail:")
|
||||
(delete-region (point)
|
||||
(progn (forward-line 1)
|
||||
(point))))
|
||||
(if (not (string= file-name ""))
|
||||
(insert-before-markers "Mail: " file-name "\n"))))))
|
||||
(setq rmail-inbox-list (rmail-parse-file-inboxes))
|
||||
(rmail-show-message rmail-current-message))
|
||||
|
||||
;; arch-tag: 74ed1d50-2c25-4cbd-b5ae-d29ed8aba6e4
|
||||
;;; rmailmsc.el ends here
|
||||
|
|
@ -1,420 +0,0 @@
|
|||
;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
|
||||
|
||||
;; Copyright (C) 1985, 1987, 1993, 1994, 2001, 2002, 2003, 2004,
|
||||
;; 2005, 2006, 2007, 2008, 2009 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:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'rmail)
|
||||
(provide 'rmailout)
|
||||
|
||||
;;;###autoload
|
||||
(defcustom rmail-output-file-alist nil
|
||||
"*Alist matching regexps to suggested output Rmail files.
|
||||
This is a list of elements of the form (REGEXP . NAME-EXP).
|
||||
The suggestion is taken if REGEXP matches anywhere in the message buffer.
|
||||
NAME-EXP may be a string constant giving the file name to use,
|
||||
or more generally it may be any kind of expression that returns
|
||||
a file name as a string."
|
||||
:type '(repeat (cons regexp
|
||||
(choice :value ""
|
||||
(string :tag "File Name")
|
||||
sexp)))
|
||||
:group 'rmail-output)
|
||||
|
||||
(defun rmail-output-read-rmail-file-name ()
|
||||
"Read the file name to use for `rmail-output-to-rmail-file'.
|
||||
Set `rmail-default-rmail-file' to this name as well as returning it."
|
||||
(let ((default-file
|
||||
(let (answer tail)
|
||||
(setq tail rmail-output-file-alist)
|
||||
;; Suggest a file based on a pattern match.
|
||||
(while (and tail (not answer))
|
||||
(save-excursion
|
||||
(set-buffer rmail-buffer)
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward (car (car tail)) nil t)
|
||||
(setq answer (eval (cdr (car tail)))))
|
||||
(setq tail (cdr tail))))
|
||||
;; If no suggestions, use same file as last time.
|
||||
(expand-file-name (or answer rmail-default-rmail-file)))))
|
||||
(let ((read-file
|
||||
(expand-file-name
|
||||
(read-file-name
|
||||
(concat "Output message to Rmail file (default "
|
||||
(file-name-nondirectory default-file)
|
||||
"): ")
|
||||
(file-name-directory default-file)
|
||||
(abbreviate-file-name default-file))
|
||||
(file-name-directory default-file))))
|
||||
;; If the user enters just a directory,
|
||||
;; use the name within that directory chosen by the default.
|
||||
(setq rmail-default-rmail-file
|
||||
(if (file-directory-p read-file)
|
||||
(expand-file-name (file-name-nondirectory default-file)
|
||||
read-file)
|
||||
read-file)))))
|
||||
|
||||
(defun rmail-output-read-file-name ()
|
||||
"Read the file name to use for `rmail-output'.
|
||||
Set `rmail-default-file' to this name as well as returning it."
|
||||
(let ((default-file
|
||||
(let (answer tail)
|
||||
(setq tail rmail-output-file-alist)
|
||||
;; Suggest a file based on a pattern match.
|
||||
(while (and tail (not answer))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward (car (car tail)) nil t)
|
||||
(setq answer (eval (cdr (car tail)))))
|
||||
(setq tail (cdr tail))))
|
||||
;; If no suggestion, use same file as last time.
|
||||
(or answer rmail-default-file))))
|
||||
(let ((read-file
|
||||
(expand-file-name
|
||||
(read-file-name
|
||||
(concat "Output message to Unix mail file (default "
|
||||
(file-name-nondirectory default-file)
|
||||
"): ")
|
||||
(file-name-directory default-file)
|
||||
(abbreviate-file-name default-file))
|
||||
(file-name-directory default-file))))
|
||||
(setq rmail-default-file
|
||||
(if (file-directory-p read-file)
|
||||
(expand-file-name (file-name-nondirectory default-file)
|
||||
read-file)
|
||||
(expand-file-name
|
||||
(or read-file (file-name-nondirectory default-file))
|
||||
(file-name-directory default-file)))))))
|
||||
|
||||
(declare-function rmail-update-summary "rmailsum" (&rest ignore))
|
||||
|
||||
;;; There are functions elsewhere in Emacs that use this function;
|
||||
;;; look at them before you change the calling method.
|
||||
;;;###autoload
|
||||
(defun rmail-output-to-rmail-file (file-name &optional count stay)
|
||||
"Append the current message to an Rmail file named FILE-NAME.
|
||||
If the file does not exist, ask if it should be created.
|
||||
If file is being visited, the message is appended to the Emacs
|
||||
buffer visiting that file.
|
||||
If the file exists and is not an Rmail file, the message is
|
||||
appended in inbox format, the same way `rmail-output' does it.
|
||||
|
||||
The default file name comes from `rmail-default-rmail-file',
|
||||
which is updated to the name you use in this command.
|
||||
|
||||
A prefix argument COUNT says to output that many consecutive messages,
|
||||
starting with the current one. Deleted messages are skipped and don't count.
|
||||
|
||||
If the optional argument STAY is non-nil, then leave the last filed
|
||||
message up instead of moving forward to the next non-deleted message."
|
||||
(interactive
|
||||
(list (rmail-output-read-rmail-file-name)
|
||||
(prefix-numeric-value current-prefix-arg)))
|
||||
(or count (setq count 1))
|
||||
(setq file-name
|
||||
(expand-file-name file-name
|
||||
(file-name-directory rmail-default-rmail-file)))
|
||||
(if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name)))
|
||||
(rmail-output file-name count)
|
||||
(rmail-maybe-set-message-counters)
|
||||
(setq file-name (abbreviate-file-name file-name))
|
||||
(or (find-buffer-visiting file-name)
|
||||
(file-exists-p file-name)
|
||||
(if (yes-or-no-p
|
||||
(concat "\"" file-name "\" does not exist, create it? "))
|
||||
(let ((file-buffer (create-file-buffer file-name)))
|
||||
(save-excursion
|
||||
(set-buffer file-buffer)
|
||||
(rmail-insert-rmail-file-header)
|
||||
(let ((require-final-newline nil)
|
||||
(coding-system-for-write
|
||||
(or rmail-file-coding-system
|
||||
'emacs-mule-unix)))
|
||||
(write-region (point-min) (point-max) file-name t 1)))
|
||||
(kill-buffer file-buffer))
|
||||
(error "Output file does not exist")))
|
||||
(while (> count 0)
|
||||
(let (redelete)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-buffer rmail-buffer)
|
||||
;; Temporarily turn off Deleted attribute.
|
||||
;; Do this outside the save-restriction, since it would
|
||||
;; shift the place in the buffer where the visible text starts.
|
||||
(if (rmail-message-deleted-p rmail-current-message)
|
||||
(progn (setq redelete t)
|
||||
(rmail-set-attribute "deleted" nil)))
|
||||
(save-restriction
|
||||
(widen)
|
||||
;; Decide whether to append to a file or to an Emacs buffer.
|
||||
(save-excursion
|
||||
(let ((buf (find-buffer-visiting file-name))
|
||||
(cur (current-buffer))
|
||||
(beg (1+ (rmail-msgbeg rmail-current-message)))
|
||||
(end (1+ (rmail-msgend rmail-current-message)))
|
||||
(coding-system-for-write
|
||||
(or rmail-file-coding-system
|
||||
'emacs-mule-unix)))
|
||||
(if (not buf)
|
||||
;; Output to a file.
|
||||
(if rmail-fields-not-to-output
|
||||
;; Delete some fields while we output.
|
||||
(let ((obuf (current-buffer)))
|
||||
(set-buffer (get-buffer-create " rmail-out-temp"))
|
||||
(insert-buffer-substring obuf beg end)
|
||||
(rmail-delete-unwanted-fields)
|
||||
(append-to-file (point-min) (point-max) file-name)
|
||||
(set-buffer obuf)
|
||||
(kill-buffer (get-buffer " rmail-out-temp")))
|
||||
(append-to-file beg end file-name))
|
||||
(if (eq buf (current-buffer))
|
||||
(error "Can't output message to same file it's already in"))
|
||||
;; File has been visited, in buffer BUF.
|
||||
(set-buffer buf)
|
||||
(let ((buffer-read-only nil)
|
||||
(msg (and (boundp 'rmail-current-message)
|
||||
rmail-current-message)))
|
||||
;; If MSG is non-nil, buffer is in RMAIL mode.
|
||||
(if msg
|
||||
(progn
|
||||
;; Turn on auto save mode, if it's off in this
|
||||
;; buffer but enabled by default.
|
||||
(and (not buffer-auto-save-file-name)
|
||||
auto-save-default
|
||||
(auto-save-mode t))
|
||||
(rmail-maybe-set-message-counters)
|
||||
(widen)
|
||||
(narrow-to-region (point-max) (point-max))
|
||||
(insert-buffer-substring cur beg end)
|
||||
(goto-char (point-min))
|
||||
(widen)
|
||||
(search-backward "\n\^_")
|
||||
(narrow-to-region (point) (point-max))
|
||||
(rmail-delete-unwanted-fields)
|
||||
(rmail-count-new-messages t)
|
||||
(if (rmail-summary-exists)
|
||||
(rmail-select-summary
|
||||
(rmail-update-summary)))
|
||||
(rmail-show-message msg))
|
||||
;; Output file not in rmail mode => just insert at the end.
|
||||
(narrow-to-region (point-min) (1+ (buffer-size)))
|
||||
(goto-char (point-max))
|
||||
(insert-buffer-substring cur beg end)
|
||||
(rmail-delete-unwanted-fields)))))))
|
||||
(rmail-set-attribute "filed" t))
|
||||
(if redelete (rmail-set-attribute "deleted" t))))
|
||||
(setq count (1- count))
|
||||
(if rmail-delete-after-output
|
||||
(unless
|
||||
(if (and (= count 0) stay)
|
||||
(rmail-delete-message)
|
||||
(rmail-delete-forward))
|
||||
(setq count 0))
|
||||
(if (> count 0)
|
||||
(unless
|
||||
(if (not stay) (rmail-next-undeleted-message 1))
|
||||
(setq count 0)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defcustom rmail-fields-not-to-output nil
|
||||
"*Regexp describing fields to exclude when outputting a message to a file."
|
||||
:type '(choice (const :tag "None" nil)
|
||||
regexp)
|
||||
:group 'rmail-output)
|
||||
|
||||
;; Delete from the buffer header fields we don't want output.
|
||||
;; NOT-RMAIL if t means this buffer does not have the full header
|
||||
;; and *** EOOH *** that a message in an Rmail file has.
|
||||
(defun rmail-delete-unwanted-fields (&optional not-rmail)
|
||||
(if rmail-fields-not-to-output
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
;; Find the end of the header.
|
||||
(if (and (or not-rmail (search-forward "\n*** EOOH ***\n" nil t))
|
||||
(search-forward "\n\n" nil t))
|
||||
(let ((end (point-marker)))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward rmail-fields-not-to-output end t)
|
||||
(beginning-of-line)
|
||||
(delete-region (point)
|
||||
(progn (forward-line 1) (point)))))))))
|
||||
|
||||
;;; There are functions elsewhere in Emacs that use this function;
|
||||
;;; look at them before you change the calling method.
|
||||
;;;###autoload
|
||||
(defun rmail-output (file-name &optional count noattribute from-gnus)
|
||||
"Append this message to system-inbox-format mail file named FILE-NAME.
|
||||
A prefix argument COUNT says to output that many consecutive messages,
|
||||
starting with the current one. Deleted messages are skipped and don't count.
|
||||
When called from lisp code, COUNT may be omitted and defaults to 1.
|
||||
|
||||
If the pruned message header is shown on the current message, then
|
||||
messages will be appended with pruned headers; otherwise, messages
|
||||
will be appended with their original headers.
|
||||
|
||||
The default file name comes from `rmail-default-file',
|
||||
which is updated to the name you use in this command.
|
||||
|
||||
The optional third argument NOATTRIBUTE, if non-nil, says not
|
||||
to set the `filed' attribute, and not to display a message.
|
||||
|
||||
The optional fourth argument FROM-GNUS is set when called from GNUS."
|
||||
(interactive
|
||||
(list (rmail-output-read-file-name)
|
||||
(prefix-numeric-value current-prefix-arg)))
|
||||
(or count (setq count 1))
|
||||
(setq file-name
|
||||
(expand-file-name file-name
|
||||
(and rmail-default-file
|
||||
(file-name-directory rmail-default-file))))
|
||||
(if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
|
||||
(rmail-output-to-rmail-file file-name count)
|
||||
(set-buffer rmail-buffer)
|
||||
(let ((orig-count count)
|
||||
(rmailbuf (current-buffer))
|
||||
(case-fold-search t)
|
||||
(tembuf (get-buffer-create " rmail-output"))
|
||||
(original-headers-p
|
||||
(and (not from-gnus)
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
|
||||
(goto-char (point-min))
|
||||
(forward-line 1)
|
||||
(= (following-char) ?0)))))
|
||||
header-beginning
|
||||
mail-from mime-version content-type)
|
||||
(while (> count 0)
|
||||
;; Preserve the Mail-From and MIME-Version fields
|
||||
;; even if they have been pruned.
|
||||
(or from-gnus
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (rmail-msgbeg rmail-current-message))
|
||||
(setq header-beginning (point))
|
||||
(search-forward "\n*** EOOH ***\n")
|
||||
(narrow-to-region header-beginning (point))
|
||||
(setq mail-from (mail-fetch-field "Mail-From"))
|
||||
(unless rmail-enable-mime
|
||||
(setq mime-version (mail-fetch-field "MIME-Version")
|
||||
content-type (mail-fetch-field "Content-type"))))))
|
||||
(save-excursion
|
||||
(set-buffer tembuf)
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring rmailbuf)
|
||||
(when rmail-enable-mime
|
||||
(if original-headers-p
|
||||
(delete-region (goto-char (point-min))
|
||||
(if (search-forward "\n*** EOOH ***\n")
|
||||
(match-end 0)))
|
||||
(goto-char (point-min))
|
||||
(forward-line 2)
|
||||
(delete-region (point-min)(point))
|
||||
(search-forward "\n*** EOOH ***\n")
|
||||
(delete-region (match-beginning 0)
|
||||
(if (search-forward "\n\n")
|
||||
(1- (match-end 0)))))
|
||||
(setq buffer-file-coding-system (or rmail-file-coding-system
|
||||
'raw-text)))
|
||||
(rmail-delete-unwanted-fields t)
|
||||
(or (bolp) (insert "\n"))
|
||||
(goto-char (point-min))
|
||||
(if mail-from
|
||||
(insert mail-from "\n")
|
||||
(insert "From "
|
||||
(mail-strip-quoted-names (or (mail-fetch-field "from")
|
||||
(mail-fetch-field "really-from")
|
||||
(mail-fetch-field "sender")
|
||||
"unknown"))
|
||||
" " (current-time-string) "\n"))
|
||||
(when mime-version
|
||||
(insert "MIME-Version: " mime-version)
|
||||
;; Some malformed MIME messages set content-type to nil.
|
||||
(when content-type
|
||||
(insert "\nContent-type: " content-type "\n")))
|
||||
;; ``Quote'' "\nFrom " as "\n>From "
|
||||
;; (note that this isn't really quoting, as there is no requirement
|
||||
;; that "\n[>]+From " be quoted in the same transparent way.)
|
||||
(let ((case-fold-search nil))
|
||||
(while (search-forward "\nFrom " nil t)
|
||||
(forward-char -5)
|
||||
(insert ?>)))
|
||||
(write-region (point-min) (point-max) file-name t
|
||||
(if noattribute 'nomsg)))
|
||||
(or noattribute
|
||||
(if (equal major-mode 'rmail-mode)
|
||||
(rmail-set-attribute "filed" t)))
|
||||
(setq count (1- count))
|
||||
(or from-gnus
|
||||
(let ((next-message-p
|
||||
(if rmail-delete-after-output
|
||||
(rmail-delete-forward)
|
||||
(if (> count 0)
|
||||
(rmail-next-undeleted-message 1))))
|
||||
(num-appended (- orig-count count)))
|
||||
(if (and next-message-p original-headers-p)
|
||||
(rmail-toggle-header))
|
||||
(if (and (> count 0) (not next-message-p))
|
||||
(progn
|
||||
(error "%s"
|
||||
(save-excursion
|
||||
(set-buffer rmailbuf)
|
||||
(format "Only %d message%s appended" num-appended
|
||||
(if (= num-appended 1) "" "s"))))
|
||||
(setq count 0))))))
|
||||
(kill-buffer tembuf))))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-output-body-to-file (file-name)
|
||||
"Write this message body to the file FILE-NAME.
|
||||
FILE-NAME defaults, interactively, from the Subject field of the message."
|
||||
(interactive
|
||||
(let ((default-file
|
||||
(or (mail-fetch-field "Subject")
|
||||
rmail-default-body-file)))
|
||||
(list (setq rmail-default-body-file
|
||||
(read-file-name
|
||||
"Output message body to file: "
|
||||
(and default-file (file-name-directory default-file))
|
||||
default-file
|
||||
nil default-file)))))
|
||||
(setq file-name
|
||||
(expand-file-name file-name
|
||||
(and rmail-default-body-file
|
||||
(file-name-directory rmail-default-body-file))))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward "\n\n")
|
||||
(and (file-exists-p file-name)
|
||||
(not (y-or-n-p (format "File %s exists; overwrite? " file-name)))
|
||||
(error "Operation aborted"))
|
||||
(write-region (point) (point-max) file-name)
|
||||
(if (equal major-mode 'rmail-mode)
|
||||
(rmail-set-attribute "stored" t)))
|
||||
(if rmail-delete-after-output
|
||||
(rmail-delete-forward)))
|
||||
|
||||
;; arch-tag: 447117c6-1a9a-4b88-aa43-3101b043e3a4
|
||||
;;; rmailout.el ends here
|
||||
|
|
@ -1,250 +0,0 @@
|
|||
;;; rmailsort.el --- Rmail: sort messages
|
||||
|
||||
;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004,
|
||||
;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
|
||||
;; 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:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'sort)
|
||||
|
||||
;; For rmail-select-summary
|
||||
(require 'rmail)
|
||||
|
||||
(autoload 'timezone-make-date-sortable "timezone")
|
||||
|
||||
;; Sorting messages in Rmail buffer
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-sort-by-date (reverse)
|
||||
"Sort messages of current Rmail file by date.
|
||||
If prefix argument REVERSE is non-nil, sort them in reverse order."
|
||||
(interactive "P")
|
||||
(rmail-sort-messages reverse
|
||||
(function
|
||||
(lambda (msg)
|
||||
(rmail-make-date-sortable
|
||||
(rmail-fetch-field msg "Date"))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-sort-by-subject (reverse)
|
||||
"Sort messages of current Rmail file by subject.
|
||||
If prefix argument REVERSE is non-nil, sort them in reverse order."
|
||||
(interactive "P")
|
||||
(rmail-sort-messages reverse
|
||||
(function
|
||||
(lambda (msg)
|
||||
(let ((key (or (rmail-fetch-field msg "Subject") ""))
|
||||
(case-fold-search t))
|
||||
;; Remove `Re:'
|
||||
(if (string-match "^\\(re:[ \t]*\\)*" key)
|
||||
(substring key (match-end 0))
|
||||
key))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-sort-by-author (reverse)
|
||||
"Sort messages of current Rmail file by author.
|
||||
If prefix argument REVERSE is non-nil, sort them in reverse order."
|
||||
(interactive "P")
|
||||
(rmail-sort-messages reverse
|
||||
(function
|
||||
(lambda (msg)
|
||||
(downcase ;Canonical name
|
||||
(mail-strip-quoted-names
|
||||
(or (rmail-fetch-field msg "From")
|
||||
(rmail-fetch-field msg "Sender") "")))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-sort-by-recipient (reverse)
|
||||
"Sort messages of current Rmail file by recipient.
|
||||
If prefix argument REVERSE is non-nil, sort them in reverse order."
|
||||
(interactive "P")
|
||||
(rmail-sort-messages reverse
|
||||
(function
|
||||
(lambda (msg)
|
||||
(downcase ;Canonical name
|
||||
(mail-strip-quoted-names
|
||||
(or (rmail-fetch-field msg "To")
|
||||
(rmail-fetch-field msg "Apparently-To") "")
|
||||
))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-sort-by-correspondent (reverse)
|
||||
"Sort messages of current Rmail file by other correspondent.
|
||||
If prefix argument REVERSE is non-nil, sort them in reverse order."
|
||||
(interactive "P")
|
||||
(rmail-sort-messages reverse
|
||||
(function
|
||||
(lambda (msg)
|
||||
(rmail-select-correspondent
|
||||
msg
|
||||
'("From" "Sender" "To" "Apparently-To"))))))
|
||||
|
||||
(defun rmail-select-correspondent (msg fields)
|
||||
(let ((ans ""))
|
||||
(while (and fields (string= ans ""))
|
||||
(setq ans
|
||||
(rmail-dont-reply-to
|
||||
(mail-strip-quoted-names
|
||||
(or (rmail-fetch-field msg (car fields)) ""))))
|
||||
(setq fields (cdr fields)))
|
||||
ans))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-sort-by-lines (reverse)
|
||||
"Sort messages of current Rmail file by number of lines.
|
||||
If prefix argument REVERSE is non-nil, sort them in reverse order."
|
||||
(interactive "P")
|
||||
(rmail-sort-messages reverse
|
||||
(function
|
||||
(lambda (msg)
|
||||
(count-lines (rmail-msgbeg msg)
|
||||
(rmail-msgend msg))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun rmail-sort-by-labels (reverse labels)
|
||||
"Sort messages of current Rmail file by labels.
|
||||
If prefix argument REVERSE is non-nil, sort them in reverse order.
|
||||
KEYWORDS is a comma-separated list of labels."
|
||||
(interactive "P\nsSort by labels: ")
|
||||
(or (string-match "[^ \t]" labels)
|
||||
(error "No labels specified"))
|
||||
(setq labels (concat (substring labels (match-beginning 0)) ","))
|
||||
(let (labelvec)
|
||||
(while (string-match "[ \t]*,[ \t]*" labels)
|
||||
(setq labelvec (cons
|
||||
(concat ", ?\\("
|
||||
(substring labels 0 (match-beginning 0))
|
||||
"\\),")
|
||||
labelvec))
|
||||
(setq labels (substring labels (match-end 0))))
|
||||
(setq labelvec (apply 'vector (nreverse labelvec)))
|
||||
(rmail-sort-messages reverse
|
||||
(function
|
||||
(lambda (msg)
|
||||
(let ((n 0))
|
||||
(while (and (< n (length labelvec))
|
||||
(not (rmail-message-labels-p
|
||||
msg (aref labelvec n))))
|
||||
(setq n (1+ n)))
|
||||
n))))))
|
||||
|
||||
;; Basic functions
|
||||
(declare-function rmail-update-summary "rmailsum" (&rest ignore))
|
||||
|
||||
(defun rmail-sort-messages (reverse keyfun)
|
||||
"Sort messages of current Rmail file.
|
||||
If 1st argument REVERSE is non-nil, sort them in reverse order.
|
||||
2nd argument KEYFUN is called with a message number, and should return a key."
|
||||
(save-current-buffer
|
||||
;; If we are in a summary buffer, operate on the Rmail buffer.
|
||||
(if (eq major-mode 'rmail-summary-mode)
|
||||
(set-buffer rmail-buffer))
|
||||
(let ((buffer-read-only nil)
|
||||
(point-offset (- (point) (point-min)))
|
||||
(predicate nil) ;< or string-lessp
|
||||
(sort-lists nil))
|
||||
(message "Finding sort keys...")
|
||||
(widen)
|
||||
(let ((msgnum 1))
|
||||
(while (>= rmail-total-messages msgnum)
|
||||
(setq sort-lists
|
||||
(cons (list (funcall keyfun msgnum) ;Make sorting key
|
||||
(eq rmail-current-message msgnum) ;True if current
|
||||
(aref rmail-message-vector msgnum)
|
||||
(aref rmail-message-vector (1+ msgnum)))
|
||||
sort-lists))
|
||||
(if (zerop (% msgnum 10))
|
||||
(message "Finding sort keys...%d" msgnum))
|
||||
(setq msgnum (1+ msgnum))))
|
||||
(or reverse (setq sort-lists (nreverse sort-lists)))
|
||||
;; Decide predicate: < or string-lessp
|
||||
(if (numberp (car (car sort-lists))) ;Is a key numeric?
|
||||
(setq predicate (function <))
|
||||
(setq predicate (function string-lessp)))
|
||||
(setq sort-lists
|
||||
(sort sort-lists
|
||||
(function
|
||||
(lambda (a b)
|
||||
(funcall predicate (car a) (car b))))))
|
||||
(if reverse (setq sort-lists (nreverse sort-lists)))
|
||||
;; Now we enter critical region. So, keyboard quit is disabled.
|
||||
(message "Reordering messages...")
|
||||
(let ((inhibit-quit t) ;Inhibit quit
|
||||
(current-message nil)
|
||||
(msgnum 1)
|
||||
(msginfo nil))
|
||||
;; There's little hope that we can easily undo after that.
|
||||
(buffer-disable-undo (current-buffer))
|
||||
(goto-char (rmail-msgbeg 1))
|
||||
;; To force update of all markers.
|
||||
(insert-before-markers ?Z)
|
||||
(backward-char 1)
|
||||
;; Now reorder messages.
|
||||
(while sort-lists
|
||||
(setq msginfo (car sort-lists))
|
||||
;; Swap two messages.
|
||||
(insert-buffer-substring
|
||||
(current-buffer) (nth 2 msginfo) (nth 3 msginfo))
|
||||
(delete-region (nth 2 msginfo) (nth 3 msginfo))
|
||||
;; Is current message?
|
||||
(if (nth 1 msginfo)
|
||||
(setq current-message msgnum))
|
||||
(setq sort-lists (cdr sort-lists))
|
||||
(if (zerop (% msgnum 10))
|
||||
(message "Reordering messages...%d" msgnum))
|
||||
(setq msgnum (1+ msgnum)))
|
||||
;; Delete the garbage inserted before.
|
||||
(delete-char 1)
|
||||
(setq quit-flag nil)
|
||||
(buffer-enable-undo)
|
||||
(rmail-set-message-counters)
|
||||
(rmail-show-message current-message)
|
||||
(goto-char (+ point-offset (point-min)))
|
||||
(if (rmail-summary-exists)
|
||||
(rmail-select-summary
|
||||
(rmail-update-summary)))))))
|
||||
|
||||
(defun rmail-fetch-field (msg field)
|
||||
"Return the value of the header FIELD of MSG.
|
||||
Arguments are MSG and FIELD."
|
||||
(save-restriction
|
||||
(widen)
|
||||
(let ((next (rmail-msgend msg)))
|
||||
(goto-char (rmail-msgbeg msg))
|
||||
(narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t)
|
||||
(point)
|
||||
(forward-line 1)
|
||||
(point))
|
||||
(progn (search-forward "\n\n" nil t) (point)))
|
||||
(mail-fetch-field field))))
|
||||
|
||||
(defun rmail-make-date-sortable (date)
|
||||
"Make DATE sortable using the function string-lessp."
|
||||
;; Assume the default time zone is GMT.
|
||||
(timezone-make-date-sortable date "GMT" "GMT"))
|
||||
|
||||
(provide 'rmailsort)
|
||||
|
||||
;; arch-tag: 0d90896b-0c35-46ac-b240-38be5ada2360
|
||||
;;; rmailsort.el ends here
|
||||
File diff suppressed because it is too large
Load diff
Loading…
Add table
Reference in a new issue