[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]


From: Craig McDaniel
Subject: gnus-hardsort.el
Date: Wed, 21 Dec 2005 15:08:43 -0500
User-agent: Gnus/5.11 (Gnus v5.11) Emacs/22.0.50 (gnu/linux)

A gnus utility to keep the articles in your mail groups sorted by date,
even after moving articles from one group to another:

;;; gnus-hardsort.el -- permanently sort group by date
;; Copyright (C) 2005 Craig McDaniel <address@hidden>

;; This file is not part of GNU Emacs, but it is distributed under
;; the same terms as 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 2, 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
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; If you prefer to view articles sorted by date, you may be annoyed
;; that articles moved from another group will appear after the
;; previously existing articles, even if the moved articles are
;; older. You can always sort your view of the articles by date, but
;; that may take a significant amount of time if there are a large
;; number of articles in the group. In addition, your default view
;; when you enter the summary buffer next time will continue to show
;; the moved articles out of order. This function permanently resorts
;; the articles in the group by date, by first sorting the articles,
;; then respooling the articles back into the same group.
;;;; Usage
;; From the *Group* buffer, M-x gnus-topic-hardsort will permanently
;; resort the articles by date. When on a topic line, all groups
;; within the topic are resorted. When not on a topic line, the
;; current group is resorted or the next n groups are resorted if a
;; numeric argument is specified.

(defun gnus-group-hardsort-1 (group)
  (let* ((active (or gnus-newsgroup-active (gnus-active group)))
         (entry (gnus-gethash group gnus-newsrc-hashtb))
         (info (nth 2 entry)))
    (if (or (not info) (not active))
        ;; There is no info on this group if it was, in fact,
        ;; killed.  Gnus stores no information on killed groups, so
        ;; there's nothing to be done.
        (gnus-summary-read-group group t t)
        (let ((save-split-methods nnmail-split-methods)
              (save-gnus-show-threads gnus-show-threads))
                (setq gnus-show-threads nil)
                (setq nnmail-split-methods 
                      `((,(nth 1 (split-string gnus-newsgroup-name ":")) "")))
                 #x7ffffff (gnus-find-method-for-group gnus-newsgroup-name)))
            (setq nnmail-split-methods save-split-methods)
            (setq gnus-show-threads save-gnus-show-threads))

(defun gnus-group-hardsort (group)
  (cond ((eq 'nnvirtual (car (gnus-find-method-for-group group)))
         (gnus-message 2 "Can't respool virtual group %s" 
                       (gnus-group-decoded-name group))
        ((>= (gnus-group-level group) gnus-level-zombie)
         (gnus-message 2 "Can't respool dead group %s"
                       (gnus-group-decoded-name group))
         (gnus-group-goto-group group)
         (gnus-group-hardsort-1 group))))

(defun gnus-group-hardsort-current (&optional n)
  "Permanently resort the current group by date. If prefix
argument N is numeric, the next N newsgroups will be permanently
resorted.  The number of newsgroups that this function was unable
to datesort is returned."
  (interactive "P")
  (let ((groups (gnus-group-process-prefix n))
        (ret 0)
    (unless groups (error "No groups selected"))
    (if (not
         (or gnus-expert-user
               "Do you really want to permanently resort %s? "
               (if (= (length groups) 1)
                   (gnus-group-decoded-name (car groups))
                 (format "these %d groups" (length groups)))))))
      (while (setq group (pop groups))
        (gnus-group-remove-mark group)
        (if (gnus-group-hardsort group)
          (setq ret (1+ ret))))
      (gnus-group-next-unread-group 1)
(defun gnus-topic-hardsort (topic)
  "Permanently resort the groups in date-sorted order"
  (interactive (list (gnus-group-topic-name)))
  (if (not topic)
      (call-interactively 'gnus-group-hardsort-current)
      (let* ((groups
             (mapcar (lambda (entry) (car (nth 2 entry)))
                     (gnus-topic-find-groups topic gnus-level-killed t
                                             nil t)))
             (buffer-read-only nil)
             (gnus-group-marked groups))
        (mapcar 'gnus-topic-update-topics-containing-group groups)))))

(provide 'gnus-hardsort)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]