diff options
Diffstat (limited to 'lisp/mail/mbox-trunk-annotations/rmailsort.el.annotation')
| -rw-r--r-- | lisp/mail/mbox-trunk-annotations/rmailsort.el.annotation | 250 |
1 files changed, 250 insertions, 0 deletions
diff --git a/lisp/mail/mbox-trunk-annotations/rmailsort.el.annotation b/lisp/mail/mbox-trunk-annotations/rmailsort.el.annotation new file mode 100644 index 00000000000..96601607f03 --- /dev/null +++ b/lisp/mail/mbox-trunk-annotations/rmailsort.el.annotation @@ -0,0 +1,250 @@ +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 |