🚀 go-pugleaf

not grouping... not ordering... SORTING, by god!!

Many thanks to Mark Leisher for figuring out the summary-magic
that I was missing.

  C-C C-S C-D:	 sort VM folder by date
  C-C C-S C-S:	 sort VM folder by subject
  C-C C-S C-A:	 sort VM folder by author
  C-C C-S C-R:	 sort VM folder by recipient
  C-C C-S C-L:	 sort VM folder by lines
  C-C C-S ?:	 one-line sort help

With a prefix argument, sorts backwards.

Sorting by date requires Masanobu Umeda's "timezone.el" package.
But the last version of that that he posted has a bug; I am
including a fixed version in the next message.

Note that: sorting is kind of slow.

	-- Jamie

---------- slice 'n' dice ----------------------------------- file: vm-sort.el
;;; -*- Mode:Emacs-Lisp -*-

;;; Sorting VM messages; based on rmailsort.el (c) 1990 by Masanobu Umeda.
;;; This requires VM version 5.31 or newer.
;;; To sort by date, you need Umeda's "timezone.el" package as well.
;;;
;;; created 6 nov 90 by Jamie Zawinski <jwz@lucid.com>;
;;; modified 4 dec 90 by jwz.
;;; modified 2 may 91 by mleisher@nmsu.edu (Mark Leisher)
;;; modified 3 may 91 by jwz.

(require 'vm)
(require 'sort)
(autoload 'timezone-make-date-sortable "timezone")

;; GNUS compatible key bindings.
(defvar vm-sort-map (make-sparse-keymap))
(define-key vm-mode-map "\C-c\C-s" vm-sort-map)
(define-key vm-sort-map "\C-d" 'vm-sort-by-date)
(define-key vm-sort-map "\C-s" 'vm-sort-by-subject)
(define-key vm-sort-map "\C-a" 'vm-sort-by-author)
(define-key vm-sort-map "\C-r" 'vm-sort-by-recipient)
(define-key vm-sort-map "\C-l" 'vm-sort-by-lines)
(define-key vm-sort-map "\C-h" 'vm-sort-help)
(define-key vm-sort-map "?"    'vm-sort-help)

(defun vm-sort-help ()
  (interactive)
  (message (substitute-command-keys "\\<vm-sort-map>\
 date: `\\[vm-sort-by-date]'; subject: `\\[vm-sort-by-subject]';\
 author: `\\[vm-sort-by-author]'; recipient: `\\[vm-sort-by-recipient]';\
 lines: `\\[vm-sort-by-lines]'.")))

(defun vm-sort-by-date (reverse)
  "Sort messages of current VM file by date.
If prefix argument REVERSE is non-nil, sort them in reverse order.
This actually changes the order of messages in the folder.
You may need to set the variable `vm-default-timezone' before running this."
  (interactive "P")
  (vm-sort-messages reverse 'vm-sortable-date-string))

(defun vm-sort-by-subject (reverse)
  "Sort messages of current VM file by subject.
If prefix argument REVERSE is non-nil, sort them in reverse order.
This actually changes the order of messages in the folder."
  (interactive "P")
  (vm-sort-messages reverse
		    (function
		      (lambda (msg)
		      (let ((key (or (vm-subject-of msg) ""))
			    (case-fold-search t))
			(downcase
			;; Remove `Re:'
			(if (string-match "^\\([ \t]*Re:[ \t]+\\)*" key)
			    (substring key (match-end 0)) key)))))))

(defun vm-sort-by-author (reverse)
  "Sort messages of current VM file by author.
If prefix argument REVERSE is non-nil, sort them in reverse order.
This actually changes the order of messages in the folder."
  (interactive "P")
  (vm-sort-messages reverse
		    (function
		      (lambda (msg)
		       (downcase
		        (mail-strip-quoted-names (or (vm-from-of msg) "")))))))

(defun vm-sort-by-recipient (reverse)
  "Sort messages of current VM file by recipient.
If prefix argument REVERSE is non-nil, sort them in reverse order.
This actually changes the order of messages in the folder."
  (interactive "P")
  (vm-sort-messages reverse
		    (function
		      (lambda (msg)
		       (downcase
		        (mail-strip-quoted-names (or (vm-to-of msg) "")))))))

(defun vm-sort-by-lines (reverse)
  "Sort messages of current VM file by number-of-lines.
If prefix argument REVERSE is non-nil, sort them in reverse order.
This actually changes the order of messages in the folder."
  (interactive "P")
  (vm-sort-messages reverse
		    (function
		      (lambda (msg)
			(let* ((ml (vm-su-line-count msg))
			       (sl (length ml)))
			  (if (< sl 8)
			      (concat (make-string (- 8 sl) ? ) ml)
			    ml))))))


(defun vm-sort-messages (reverse keyfunc)
  "Sort messages of current VM folder.
1st argument REVERSE is non-nil, sort them in reverse order.
2nd argument KEYFUNC is called with the message, and should return a key."
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (let ((buffer-read-only nil)
	(sort-lists nil)
	(buf-header-end (vm-start-of (car vm-message-list))))
    (message "Finding sort keys...")
    (widen)
    (let ((rest vm-message-list))
      (while rest
	(let ((msg (car rest)))
	  ;; make the text-of be an int offset from start-of-message (temp).
	  (vm-set-text-of msg (- (vm-text-of msg) (vm-start-of msg)))
	  (if (< (vm-text-of msg) 0) (error "badly out of synch..."))
	  (setq sort-lists
		(cons (list (funcall keyfunc msg) ;A sort key.
			    msg
			    (buffer-substring
			      (vm-start-of msg) (vm-end-of msg)))
		      sort-lists)))
	(setq rest (cdr rest))))
    (or reverse (setq sort-lists (nreverse sort-lists)))
    (message "Sorting...")
    (setq sort-lists
	  (sort sort-lists
		(function
		 (lambda (a b)
		   (string-lessp (car a) (car b))))))
    (if reverse (setq sort-lists (nreverse sort-lists)))
    (message "Reordering buffer...")
    (delete-region buf-header-end (point-max))
    (let ((new-msg-list '()))
      (while sort-lists
	(let ((body (nth 2 (car sort-lists)))
	      (msg (nth 1 (car sort-lists))))
	  (set-marker (vm-start-of msg) (point))
	  (insert body)
	  (set-marker (vm-end-of msg) (point))
	  (vm-set-text-of msg
	    (set-marker (make-marker) (+ (vm-start-of msg) (vm-text-of msg))))
	  ;; ## this debugging code can probably be removed...
	  (if (< (vm-end-of msg) (vm-text-of msg)) (error "end less than text"))
	  (if (< (vm-end-of msg) (vm-start-of msg)) (error "end less than start"))
	  (if (< (vm-text-of msg) (vm-start-of msg)) (error "text less than start"))
	  (vm-set-reverse-link-of msg new-msg-list)
	  (setq new-msg-list (cons msg new-msg-list)))
	(setq sort-lists (cdr sort-lists)))
      (let ((curr (car vm-message-pointer))
	    (last (car vm-message-pointer)))
	(setq vm-last-message-pointer new-msg-list ; cute, eh?
	      vm-message-list (nreverse new-msg-list)
	      vm-message-pointer new-msg-list)
	(if curr
	    (progn
	      (setq vm-message-pointer vm-message-list)
	      (while (not (eq (car vm-message-pointer) curr))
		(setq vm-message-pointer (cdr vm-message-pointer)))))
	(if last
	(progn
	  (setq vm-last-message-pointer vm-message-list)
	  (while (not (eq (car vm-last-message-pointer) last))
	    (setq vm-last-message-pointer (cdr vm-last-message-pointer)))))))
    (setq vm-current-grouping nil)
    (vm-build-message-list t)
    (vm-number-messages)
    (setq vm-need-summary-pointer-update t)
    (cond (vm-summary-buffer
	   (vm-do-summary)
	   (vm-update-summary-and-mode-line)))
    (vm-preview-current-message)
    ))


;;; Time stuff.  What a pain in the butt.

(defvar vm-default-timezone nil
  "*The string-name of the local timezone, \"PDT\" for example.
If this is nil, we will -try- to compute it when necessary.")

(defun vm-compute-local-timezone ()
  "Try to figure out what timezone we're in by executing `date(1)'."
  (save-excursion
    (set-buffer (get-buffer-create " *zone-hackery*"))
    (let (h1 d1 h2 d2)
      (erase-buffer)
      (shell-command-on-region 1 1 "date '+%H %w'" t)
      (goto-char 1)
      (and (looking-at "\\([0-9][0-9]?\\) \\([0-9][0-9]?\\)")
	   (setq h1 (string-to-int (buffer-substring
				    (match-beginning 1) (match-end 1))))
	   (setq d1 (string-to-int (buffer-substring
				    (match-beginning 2) (match-end 2)))))
      (erase-buffer)
      (shell-command-on-region 1 1 "date -u '+%H %w'" t)
      (goto-char 1)
      (and (looking-at "\\([0-9][0-9]?\\) \\([0-9][0-9]?\\)")
	   (setq h2 (string-to-int (buffer-substring
				    (match-beginning 1) (match-end 1))))
	   (setq d2 (string-to-int (buffer-substring
				    (match-beginning 2) (match-end 2)))))
      (kill-buffer " *zone-hackery*")
      (let ((offset (% (- h2 h1) 24)))
	(if (< offset 0)
	    (setq offset (+ 24 offset)))
	;; daylight savings time might make this be goofy:
	;; MST instead of PDT, for example.  This still works.
	(car (rassq (* 100 offset) timezone-world-timezones))))))


(defun vm-sortable-date-string (msg)
  "Make a string sortable by string-lessp of the date of the message."
  (let ((year (vm-year-of msg))
	(month (or (vm-month-of msg) "---"))
	(day (or (vm-monthday-of msg) " 0"))
	(time (or (vm-hour-of msg) "00:00:00"))
	(zone (or (vm-zone-of msg) "")))
    (if (zerop (length year)) (setq year "0000"))
    (if (= 2 (length year)) (setq year (concat "19" year)))
    (if (> (length month) 3) (setq month (substring month 0 3)))
    (if (and (= 2 (length day)) (= ?0 (aref day 0)))
	(aset day 0 32))
    (if (= 1 (length day))
	(setq day (concat " " day))
      (if (and (= 2 (length day)) (= ?0 (aref day 0)))
	  (setq day (concat " " (substring day 1)))))
    (or vm-default-timezone
	(setq vm-default-timezone (vm-compute-local-timezone)))
    (if (equal "" zone) (setq zone vm-default-timezone))
    (timezone-make-date-sortable
     (setq x (concat day " " month " " year " " time " " zone))
     "GMT" "GMT")))

;; CORRECT:
;; (timezone-make-date-sortable " 3 May 1991 17:34:45 EDT" "GMT" "GMT")  "91050321:34:45"
;; (timezone-make-date-sortable " 3 May 1991 14:38:58 PDT" "GMT" "GMT")  "91050321:38:58"

;; INCORRECT:
;; (timezone-make-date-sortable " 3 May 1991 17:34:45 EDT" "GMT" "GMT")  "91050313:34:45"
;; (timezone-make-date-sortable " 3 May 1991 14:38:58 PDT" "GMT" "GMT")  "91050307:38:58"

(provide 'vm-sort)