Download
(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))
nil
(save-excursion
(gnus-summary-read-group group t t)
(let ((save-split-methods nnmail-split-methods)
(save-gnus-show-threads gnus-show-threads))
(unwind-protect
(progn
(setq gnus-show-threads nil)
(gnus-summary-sort-by-date)
(setq nnmail-split-methods
`((,(nth 1 (split-string gnus-newsgroup-name ":")) "")))
(gnus-summary-respool-article #x7ffffff (gnus-find-method-for-group
gnus-newsgroup-name)))
(setq nnmail-split-methods save-split-methods)
(setq gnus-show-threads save-gnus-show-threads))
(gnus-summary-exit)))
t)))
(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))
nil)
((>= (gnus-group-level group) gnus-level-zombie)
(gnus-message 2 "Can't respool dead group %s"
(gnus-group-decoded-name group))
nil)
(t
(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)
group)
(unless groups (error "No groups selected"))
(if (not
(or gnus-expert-user
(gnus-y-or-n-p
(format
"Do you really want to permanently resort %s? "
(if (= (length groups) 1)
(gnus-group-decoded-name (car groups))
(format "these %d groups" (length groups)))))))
n
(while (setq group (pop groups))
(gnus-group-remove-mark group)
(if (gnus-group-hardsort group)
(gnus-group-update-group-line)
(setq ret (1+ ret))))
(gnus-group-next-unread-group 1)
ret)))
(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)
(save-excursion
(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))
(gnus-group-hardsort-current)
(mapcar 'gnus-topic-update-topics-containing-group groups)))))
(provide 'gnus-hardsort)