[Emacs-diffs] Changes to pmailsort.el

[Paul Michael Reilly]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Paul Michael Reilly <pmr>       08/08/18 04:51:29

Index: pmailsort.el
===================================================================
RCS file: pmailsort.el
diff -N pmailsort.el
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ pmailsort.el        18 Aug 2008 04:51:28 -0000      1.1
@@ -0,0 +1,249 @@
+;;; pmailsort.el --- Pmail: sort messages
+
+;; Copyright (C) 1990, 1993, 1994, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+
+;; Author: Masanobu UMEDA <address@hidden>
+;; 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:
+
+(eval-when-compile
+  (require 'mail-utils)
+  (require 'sort)
+  (require 'pmail))
+
+(autoload 'timezone-make-date-sortable "timezone")
+
+;; Sorting messages in Pmail buffer
+
+;;;###autoload
+(defun pmail-sort-by-date (reverse)
+  "Sort messages of current Pmail file by date.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  (interactive "P")
+  (pmail-sort-messages reverse
+                      (function
+                       (lambda (msg)
+                         (pmail-make-date-sortable
+                          (pmail-fetch-field msg "Date"))))))
+
+;;;###autoload
+(defun pmail-sort-by-subject (reverse)
+  "Sort messages of current Pmail file by subject.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  (interactive "P")
+  (pmail-sort-messages reverse
+                      (function
+                       (lambda (msg)
+                         (let ((key (or (pmail-fetch-field msg "Subject") ""))
+                               (case-fold-search t))
+                           ;; Remove `Re:'
+                           (if (string-match "^\\(re:[ \t]*\\)*" key)
+                               (substring key (match-end 0))
+                             key))))))
+
+;;;###autoload
+(defun pmail-sort-by-author (reverse)
+  "Sort messages of current Pmail file by author.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  (interactive "P")
+  (pmail-sort-messages reverse
+                      (function
+                       (lambda (msg)
+                         (downcase     ;Canonical name
+                          (mail-strip-quoted-names
+                           (or (pmail-fetch-field msg "From")
+                               (pmail-fetch-field msg "Sender") "")))))))
+
+;;;###autoload
+(defun pmail-sort-by-recipient (reverse)
+  "Sort messages of current Pmail file by recipient.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  (interactive "P")
+  (pmail-sort-messages reverse
+                      (function
+                       (lambda (msg)
+                         (downcase     ;Canonical name
+                          (mail-strip-quoted-names
+                           (or (pmail-fetch-field msg "To")
+                               (pmail-fetch-field msg "Apparently-To") "")
+                           ))))))
+
+;;;###autoload
+(defun pmail-sort-by-correspondent (reverse)
+  "Sort messages of current Pmail file by other correspondent.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  (interactive "P")
+  (pmail-sort-messages reverse
+                      (function
+                       (lambda (msg)
+                         (pmail-select-correspondent
+                          msg
+                          '("From" "Sender" "To" "Apparently-To"))))))
+
+(defun pmail-select-correspondent (msg fields)
+  (let ((ans ""))
+    (while (and fields (string= ans ""))
+      (setq ans
+           (pmail-dont-reply-to
+            (mail-strip-quoted-names
+             (or (pmail-fetch-field msg (car fields)) ""))))
+      (setq fields (cdr fields)))
+    ans))
+
+;;;###autoload
+(defun pmail-sort-by-lines (reverse)
+  "Sort messages of current Pmail file by number of lines.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  (interactive "P")
+  (pmail-sort-messages reverse
+                      (function
+                       (lambda (msg)
+                         (count-lines (pmail-desc-get-start msg)
+                                      (pmail-desc-get-end msg))))))
+
+;;;###autoload
+(defun pmail-sort-by-labels (reverse labels)
+  "Sort messages of current Pmail 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)))
+    (pmail-sort-messages reverse
+                        (function
+                         (lambda (msg)
+                           (let ((n 0))
+                             (while (and (< n (length labelvec))
+                                         (not (pmail-message-labels-p
+                                               msg (aref labelvec n))))
+                               (setq n (1+ n)))
+                             n))))))
+
+;; Basic functions
+
+(declare-function pmail-update-summary "pmailsum" (&rest ignore))
+
+(defun pmail-sort-messages (reverse keyfun)
+  "Sort messages of current Pmail 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 Pmail buffer.
+    (if (eq major-mode 'pmail-summary-mode)
+       (set-buffer pmail-buffer))
+    (let ((buffer-read-only nil)
+         (point-offset (- (point) (point-min)))
+         (predicate nil)                       ;< or string-lessp
+         (sort-lists nil))
+      (message "Finding sort keys...")
+      (pmail-header-show-headers)
+      (widen)
+      (let ((msgnum 1))
+       (while (>= pmail-total-messages msgnum)
+         (setq sort-lists
+               (cons (list (funcall keyfun msgnum) ;Make sorting key
+                           (eq pmail-current-message msgnum) ;True if current
+                           (pmail-desc-get-marker-start msgnum)
+                           (pmail-desc-get-marker-end 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 (pmail-desc-get-start 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)
+        (goto-char (point-min))
+       (pmail-initialize-messages)
+       (pmail-show-message current-message)
+       (if (pmail-summary-exists)
+           (pmail-select-summary
+            (pmail-update-summary)))))))
+
+;; mbox: ready
+(defun pmail-fetch-field (msg field)
+  "Return the value of the header FIELD of MSG.
+Arguments are MSG and FIELD."
+  (save-restriction
+    (widen)
+    (narrow-to-region
+     (pmail-desc-get-start msg)
+     (pmail-desc-get-end msg))
+    (pmail-header-get-header field)))
+
+(defun pmail-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 'pmailsort)
+
+;; arch-tag: 0d90896b-0c35-46ac-b240-38be5ada2360
+;;; pmailsort.el ends here