annotate lisp/mail/mbox-trunk-annotations/rmailsort.el.annotation @ 98050:edd21e1628da

*** empty log message ***

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 <[e-mail]>
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