mcgrath@paris.Berkeley.EDU (Roland McGrath) (03/20/89)
The following Lisp code implements a GNUS newsgroup kill ring.
I think this way of moving newsgroups around will come very naturally to
Emacs users. You can use C-k and C-w to kill groups and C-y to yank them.
There is also a kill-ring browser, on C-c C-k, wherein you can pick any
group in the kill-ring to yank.
You should make gnus-kill-ring-check-exit your gnus-Exit-gnus-hook in case
you forget about groups in the kill ring.
I would like this to be included in the next GNUS release,
but that is up to Masanobu. (If it is included, gnus-kill-ring-check-exit
should be called in gnus-Group-exit.)
;; GNUS kill ring
;; by Roland McGrath
;; Send any problems to roland@wheaties.ai.mit.edu.
(defvar gnus-kill-ring nil
"List of newsgroups killed by \\[gnus-Group-kill-group].
Each element is a list (ASSOC . LINE), where ASSOC is the element
of gnus-newsrc-assoc for that group, and LINE is the line from
gnus-startup-file for that group.")
(defvar gnus-number-killed 0
"Number of newsgroups killed simultaneously or in quick succession.
They will all be yanked at once, in the order killed.")
(defun gnus-Group-kill-group (&optional arg)
"Kill the newsgroup on the line containing point.
With prefix argument, kill that many newsgroups."
(interactive "P")
(save-excursion
(let* ((buffer-read-only nil)
begin)
(beginning-of-line)
(setq begin (point))
(if arg
(progn
(setq gnus-number-killed arg)
(while (> arg 0)
(setq arg (1- arg))
(setq gnus-kill-ring
(cons (gnus-kill-assoc (gnus-Group-group-name))
gnus-kill-ring))
(and gnus-kill-ring-buffer (buffer-name gnus-kill-ring-buffer)
(progn
(set-buffer gnus-kill-ring-buffer)
(let ((buffer-read-only nil))
(save-excursion
(goto-char (point-max))
(insert (car (car (car gnus-kill-ring))))))
(set-buffer gnus-Group-buffer)))
(forward-line)
(and (eobp)
(signal 'end-of-buffer nil))
))
(progn
(setq gnus-kill-ring (cons (gnus-kill-assoc (gnus-Group-group-name))
gnus-kill-ring))
(forward-line)
(setq gnus-number-killed
(if (eq last-command 'gnus-Group-kill-group)
(1+ gnus-number-killed)
1))
(and gnus-kill-ring-buffer (buffer-name gnus-kill-ring-buffer)
(progn
(set-buffer gnus-kill-ring-buffer)
(let ((buffer-read-only nil))
(save-excursion
(goto-char (point-max))
(insert (car (car (car gnus-kill-ring))) "\n")
))
(set-buffer gnus-Group-buffer)))
)
)
(delete-region begin (point))
))
(search-forward ":")
)
(defun gnus-kill-assoc (group)
"Return a list (ASSOC . LINE), to be an element of gnus-kill-ring,
where ASSOC is the element of gnus-newsrc-assoc for GROUP, and
LINE is the line from gnus-startup-file for LINE. ASSOC is removed
from gnus-newsrc-assoc and LINE is removed from gnus-startup-file ."
(let ((newsrc gnus-newsrc-assoc)
begin
line)
(while (and newsrc (not (equal group (car (car newsrc)))))
(setq newsrc (cdr newsrc)))
(and (null newsrc)
(error "Can't find %s in gnus-newsrc-assoc!" group))
(setq newsrc (car newsrc))
(setq gnus-newsrc-assoc (delq newsrc gnus-newsrc-assoc))
(save-excursion
(set-buffer (find-file-noselect gnus-startup-file))
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote group) "[:!]"))
(setq begin (match-beginning 0))
(goto-char begin)
(forward-line)
(setq line (buffer-substring begin (point)))
(delete-region begin (point))
)
(cons newsrc line)
))
(defun gnus-Group-kill-region (begin end)
"Kill all newsgroups on lines between point and mark."
(interactive "r")
(let ((lines 0))
(goto-char end)
(search-forward "\n")
(setq end (point))
(goto-char begin)
(while (search-forward "\n" end t)
(setq lines (1+ lines)))
(and (<= lines 1)
(setq lines nil))
(goto-char begin)
(gnus-Group-kill-group lines)
))
(defun gnus-Group-yank ()
"Yank the last newsgroup killed with \\[gnus-Group-kill-group],
inserting it before the newsgroup on the line containing point."
(interactive)
(let ((buffer-read-only nil)
(here-name (gnus-Group-group-name))
(newsrc (cons nil gnus-newsrc-assoc))
(newsrc-buffer (find-file-noselect gnus-startup-file))
(newsgroup-buffer (current-buffer))
assoc krb-point krb-begin krb-end)
(and (null gnus-kill-ring)
(error "Newsgroup kill ring is empty."))
;; Find the elt of gnus-newsrc-assoc whose car
;; matches the group on the line containing point.
(while (and newsrc (not (equal here-name (car (car newsrc)))))
(setq newsrc (cdr newsrc)))
(and (null newsrc)
(error "Can't find the current newsgroup in gnus-newsrc-assoc!!"))
;; Take the yanked groups out of the kill-ring and put
;; them back into gnus-newsrc-assoc and gnus-startup-file.
(beginning-of-line)
(push-mark) ; Set mark after the last one yanked.
(set-buffer newsrc-buffer)
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote here-name) "[:!]"))
(beginning-of-line)
(and gnus-kill-ring-buffer (buffer-name gnus-kill-ring-buffer)
(save-excursion
(set-buffer gnus-kill-ring-buffer)
(setq krb-point (point))
(goto-char (point-min))
(search-forward (concat (car (car (car gnus-kill-ring))) "\n"))
(forward-line -1)
(setq krb-begin (point)
krb-end krb-begin)
))
(while (> gnus-number-killed 0)
(setq gnus-number-killed (1- gnus-number-killed))
(setq assoc (car gnus-kill-ring))
(setq gnus-kill-ring (cdr gnus-kill-ring))
(setcdr newsrc (cons (car newsrc) (cdr newsrc)))
(setcar newsrc (car assoc))
(insert (cdr assoc))
(forward-line -1)
(set-buffer newsgroup-buffer)
(insert (gnus-newsgroup-line (car assoc)))
(forward-line -1)
(and krb-point
(setq krb-end (+ krb-end (1+ (length (car (car assoc)))))))
(set-buffer newsrc-buffer)
)
(setq gnus-number-killed 1)
(and krb-point
(if gnus-kill-ring
(progn
(set-buffer gnus-kill-ring-buffer)
(let ((buffer-read-only nil))
(delete-region krb-begin krb-end)
(goto-char krb-point)
))
(kill-buffer gnus-kill-ring-buffer)
(setq gnus-kill-ring-buffer nil)
(and gnus-kill-ring-one-window
(delete-other-windows))
))
(set-buffer newsgroup-buffer)
(search-forward ":")
))
(defun gnus-newsgroup-line (info)
"Return a line for the *Newsgroup* buffer from INFO,
an element of gnus-newsrc-assoc ."
(let* ((name (car info))
(unread (nth 1 (gnus-gethash name gnus-unread-hashtb)))
(fmt "%s%s%5d: %s\n"))
(format fmt
;; Subscribed or not.
(if (nth 1 info) " " "U")
;; Has new news?
(if (and (> unread 0)
(>= 0 (- unread
(length (cdr (assoc name gnus-marked-assoc))))))
"*" " ")
;; Number of unread articles.
unread
;; Newsgroup name.
name)))
(defvar gnus-kill-ring-map nil
"Keymap gnus-kill-ring-mode.")
(or gnus-kill-ring-map
(progn
(setq gnus-kill-ring-map (make-keymap))
(suppress-keymap gnus-kill-ring-map t)
(define-key gnus-kill-ring-map " " 'next-line)
(define-key gnus-kill-ring-map "\177" 'previous-line)
(define-key gnus-kill-ring-map "\C-n" 'next-line)
(define-key gnus-kill-ring-map "\C-p" 'previous-line)
(define-key gnus-kill-ring-map "n" 'next-line)
(define-key gnus-kill-ring-map "p" 'previous-line)
(define-key gnus-kill-ring-map "N" 'next-line)
(define-key gnus-kill-ring-map "P" 'previous-line)
(define-key gnus-kill-ring-map "y" 'gnus-kill-ring-yank)
(define-key gnus-kill-ring-map "Y" 'gnus-kill-ring-yank)
))
(defvar gnus-kill-ring-one-window nil
"Non-nil if there was only one window when
\\[gnus-browse-kill-ring] was called.")
(defvar gnus-kill-ring-calling-window nil
"Window from which \\[gnus-browse-kill-ring] was called.")
(defvar gnus-kill-ring-buffer nil
"The GNUS Newsgroup Kill Ring buffer.")
(defun gnus-kill-ring-yank ()
"Put the newsgroup on the line containing point in the
Newsgroups buffer before the line containing that buffer's point."
(interactive)
(let ((buffer-read-only nil)
begin line group)
(beginning-of-line)
(setq begin (point))
(setq line (count-lines (point-min) begin))
(forward-line)
(setq group (buffer-substring begin (1- (point))))
(or (equal (car (car (car gnus-kill-ring))) group)
(let ((assoc gnus-kill-ring))
(while (> line 0)
(setq line (1- line))
(setq assoc (cdr assoc)))
(setq assoc (car assoc))
(setq gnus-kill-ring (cons assoc (delq assoc gnus-kill-ring)))
))
(setq gnus-number-killed 1)
(set-buffer gnus-Group-buffer)
(gnus-Group-yank)
(and gnus-kill-ring-buffer
(progn
(and gnus-kill-ring-one-window
(delete-window))
(select-window gnus-kill-ring-calling-window)
))
))
(defun gnus-browse-kill-ring ()
"Browse the GNUS newsgroup kill ring in another buffer.
The keys C-y, y, and Y will yank the newsgroup on the current
line into the Newsgroups buffer."
(interactive)
(or gnus-kill-ring
(error "Newsgroup kill ring is empty."))
(gnus-kill-ring-prepare)
(setq gnus-kill-ring-one-window (one-window-p)
gnus-kill-ring-calling-window (selected-window))
(switch-to-buffer-other-window gnus-kill-ring-buffer)
(goto-char (point-min))
)
(defun gnus-kill-ring-prepare ()
"Prepare the GNUS Newsgroup Kill Ring buffer."
(or (and gnus-kill-ring-buffer (buffer-name gnus-kill-ring-buffer))
(setq gnus-kill-ring-buffer
(get-buffer-create "*Newsgroup Kill Ring*")))
(save-excursion
(set-buffer gnus-kill-ring-buffer)
(setq buffer-read-only nil)
(erase-buffer)
(kill-all-local-variables)
(setq major-mode 'gnus-browse-kill-ring
mode-name "GNUS Kill Ring"
buffer-read-only t)
(use-local-map gnus-kill-ring-map)
(let ((ring gnus-kill-ring)
(buffer-read-only nil))
(while (car ring)
(insert (car (car (car ring))) ?\n)
(setq ring (cdr ring))
))
))
(defun gnus-kill-ring-check-exit ()
"Check if the GNUS Newsgroup kill ring has any entries.
If it does, ask the user what to do."
(and gnus-kill-ring
(if (y-or-n-p "Browse newsgroup kill ring entries? ")
(gnus-browse-kill-ring)
(if (yes-or-no-p "Unsubscribe all newsgroups in the kill ring? ")
(setq gnus-kill-ring nil)
(keyboard-quit)))))
(define-key gnus-Group-mode-map "\C-k" 'gnus-Group-kill-group)
(define-key gnus-Group-mode-map "\C-w" 'gnus-Group-kill-region)
(define-key gnus-Group-mode-map "\C-y" 'gnus-Group-yank)
(define-key gnus-Group-mode-map "\C-c\C-k" 'gnus-browse-kill-ring)
--
Roland McGrath
Free Software Foundation, Inc.
roland@wheaties.ai.mit.edu, mit-eddie!wheaties.ai.mit.edu!roland