🚀 go-pugleaf

More from this corner of Troy.  I didn't care for either of the
gnus-user.el methods of moving groups; mucking about with point and
mark and/or interfering with my kill-ring just don't thrill me.  I
think I've taken a somewhat different approach that some people might
like.  The group before or after which to place the moved group is
read with a completing-read and an optional argument to the command
will move the group to be the first or last group of the subscribed
groups.  The move-group-after function moves only to the end of the
unsubscribed groups, such that those people who might also be using my 
gnus-reorder-newsrc code will not make it overwork because of a
subscribed group at the end, but will still get it sorted if it is an
unsubscribed group.

The only thing that concerns me is that I only changed the .newsrc and
the gnus-newsrc-assoc; I have no cluse as to whether I should change
the hashtables, too.  Masanobu, do the hashtables need to be modified
too?  I've used this for a paltry 10 or so group moves and it seems to
be fine, but I'd still like to know whether the hashtables are okay to
be left alone.

One other thing: could anyone who actually finds anything I've posted
to be even marginally useful please drop me a line?  I won't bother
wasting bandwidth if no one cares about this stuff.

Dave
-------------------- Cut -------------------- Line --------------------
(define-key gnus-Group-mode-map "M" 'gnus-Group-move-group-before)
(defun gnus-Group-move-group-before (first)
  "Move current newsgroup to precede a named newsgroup.  Prefix argument means
move group to be first in list of groups."
  (interactive "P")
  (let ((group (gnus-Group-group-name)))
    (if first (gnus-move-group group (car (car gnus-newsrc-assoc)))
      (gnus-move-group group (completing-read
                              (format "Move %s to precede newsgroup: " group)
                              gnus-newsrc-assoc nil t))))
  (gnus-Group-list-groups gnus-have-all-newsgroups))

(define-key gnus-Group-mode-map "m" 'gnus-Group-move-group-after)
(defun gnus-Group-move-group-after (last)
  "Move current newsgroup to follow a named newsgroup.  Prefix argument
means make it follow the last subscribed group."
  (interactive "P")
  (let ((group (gnus-Group-group-name)))
    (if last (gnus-move-group
               group
               (save-excursion
                 (set-buffer (get-file-buffer gnus-current-startup-file))
                 (goto-char (point-max))
                 (re-search-backward "^.*: " nil t)
                 (buffer-substring (point) (progn (skip-chars-forward "^:")
                                                  (point)))) t)
      (gnus-move-group group (completing-read
                              (format "Move %s to follow newsgroup: " group)
                              gnus-newsrc-assoc nil t) t)))
  (gnus-Group-list-groups gnus-have-all-newsgroups))

(defun gnus-move-group (group position &optional follows)
  "Move GROUP to precede POSITION; both are newsgroup name strings.
Optional argument FOLLOWS means to place GROUP after POSITION rather
than before."
  (let* ((move-data (assoc group gnus-newsrc-assoc))
         (recv-data (assoc position gnus-newsrc-assoc))
         (tail (memq recv-data gnus-newsrc-assoc)))
    (if (or (eq move-data recv-data) (eq move-data nil) (eq recv-data nil))
        (error "gnus-move-group: arguments must be different newsgroups.")
      (save-excursion
        (set-buffer (get-file-buffer gnus-current-startup-file))
        (goto-char (point-min))
        (forward-line 1)
        (re-search-forward (regexp-quote group) nil t)
        (beginning-of-line)
        (let* ((beg (point))
               (move (buffer-substring beg (progn (forward-line 1) (point)))))
          (delete-region beg (point))
          (goto-char (point-min))
          (re-search-forward (regexp-quote position) nil t)
          (beginning-of-line)
          (if follows (forward-line 1))
          (insert move)))
      (setq gnus-newsrc-assoc (delq move-data gnus-newsrc-assoc))
      (if follows (setcdr tail (cons move-data (cdr tail)))
        ;; this is a bit kludgy, but it works.
        (setcdr tail (cons move-data (cons recv-data (cdr tail))))
        (setq gnus-newsrc-assoc (delq recv-data gnus-newsrc-assoc))
        (setq tail (memq move-data gnus-newsrc-assoc))
        (setcdr tail (cons recv-data (cdr tail)))))))
--
      tale@rpitsmts.bitnet, tale%mts@itsgw.rpi.edu, tale@pawl.rpi.edu