;;; Code:
-(require 'gnus-load)
+(require 'gnus)
(require 'gnus-group)
(require 'gnus-start)
-(require 'gnus)
(defvar gnus-topic-mode nil
"Minor mode for Gnus group buffers.")
(if (member group gnus-zombie-list) 8 9)))
(and
unread ; nil means that the group is dead.
- (<= clevel level)
+ (<= clevel level)
(>= clevel lowest) ; Is inside the level we want.
(or all
(if (eq unread t)
;; List dead groups?
(when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
(gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
gnus-level-zombie ?Z
regexp))
(gnus-group-insert-group-line
entry (if (member entry gnus-zombie-list) 8 9)
nil (- (1+ (cdr (setq active (gnus-active entry))))
- (car active)) nil)
+ (car active))
+ nil)
;; Living groups.
(when (setq info (nth 2 entry))
(gnus-group-insert-group-line
(gnus-info-group info)
- (gnus-info-level info) (gnus-info-marks info)
+ (gnus-info-level info) (gnus-info-marks info)
(car entry) (gnus-info-method info)))))
(when (and (listp entry)
(numberp (car entry))
(while (and (zerop (forward-line 1))
(> (or (gnus-group-topic-level) (1+ level)) level)))
(delete-region beg (point))
- (setcar (cdadr (gnus-topic-find-topology topic))
- (if insert 'visible 'invisible))
- (when hide
- (setcdr (cdadr (gnus-topic-find-topology topic))
- (list hide)))
- (unless total-remove
+ ;; Do the change in this rather odd manner because it has been
+ ;; reported that some topics share parts of some lists, for some
+ ;; reason. I have been unable to determine why this is the
+ ;; case, but this hack seems to take care of things.
+ (let ((data (cadr (gnus-topic-find-topology topic))))
+ (setcdr data
+ (list (if insert 'visible 'invisible)
+ (if hide 'hide nil)
+ (cadddr data))))
+ (if total-remove
+ (setq gnus-topic-alist
+ (delq (assoc topic gnus-topic-alist) gnus-topic-alist))
(gnus-topic-insert-topic topic in-level)))))
(defun gnus-topic-insert-topic (topic &optional level)
(defun gnus-topic-fold (&optional insert)
"Remove/insert the current topic."
- (let ((topic (gnus-group-topic-name)))
+ (let ((topic (gnus-group-topic-name)))
(when topic
(save-excursion
(if (not (gnus-group-active-topic-p))
;; Insert the text.
(gnus-add-text-properties
(point)
- (prog1 (1+ (point))
+ (prog1 (1+ (point))
(eval gnus-topic-line-format-spec)
(gnus-topic-remove-excess-properties)1)
(list 'gnus-topic (intern name)
(gnus-group-goto-group group)
(gnus-group-position-point)))))
-(defun gnus-topic-goto-missing-group (group)
+(defun gnus-topic-goto-missing-group (group)
"Place point where GROUP is supposed to be inserted."
(let* ((topic (gnus-group-topic group))
(groups (cdr (assoc topic gnus-topic-alist)))
(or (save-excursion
(forward-line -1)
(gnus-topic-goto-topic (gnus-current-topic))
- (gnus-group-topic-level)) 0)) ? ))
+ (gnus-group-topic-level))
+ 0))
+ ? ))
;;; Initialization
gnus-topic-tallied-groups nil
gnus-topology-checked-p nil))
-(defun gnus-topic-check-topology ()
+(defun gnus-topic-check-topology ()
;; The first time we set the topology to whatever we have
;; gotten here, which can be rather random.
(unless gnus-topic-alist
(let ((topic-name (pop topic))
group filtered-topic)
(while (setq group (pop topic))
- (if (and (or (gnus-gethash group gnus-active-hashtb)
- (gnus-info-method (gnus-get-info group)))
- (not (gnus-gethash group gnus-killed-hashtb)))
- (push group filtered-topic)))
+ (when (and (or (gnus-gethash group gnus-active-hashtb)
+ (gnus-info-method (gnus-get-info group)))
+ (not (gnus-gethash group gnus-killed-hashtb)))
+ (push group filtered-topic)))
(push (cons topic-name (nreverse filtered-topic)) result)))
(setq gnus-topic-alist (nreverse result))))
(* gnus-topic-indent-level
(or (save-excursion
(gnus-topic-goto-topic (gnus-current-topic))
- (gnus-group-topic-level)) 0)) ? ))
+ (gnus-group-topic-level))
+ 0))
+ ? ))
(yanked (list group))
alist talist end)
;; Then we enter the yanked groups into the topics they belong
(remove-hook 'gnus-group-change-level-function
'gnus-topic-change-level)
(remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
- (setq gnus-group-prepare-function 'gnus-group-prepare-flat))
+ (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
+ (setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
(when redisplay
(gnus-group-list-groups))))
(start-topic (gnus-group-topic-name))
entry)
(mapcar
- (lambda (g)
+ (lambda (g)
(gnus-group-remove-mark g)
(when (and
(setq entry (assoc (gnus-current-topic) gnus-topic-alist))
(gnus-topic-goto-topic start-topic))
(gnus-group-list-groups)))
-(defun gnus-topic-remove-group ()
+(defun gnus-topic-remove-group (&optional arg)
"Remove the current group from the topic."
- (interactive)
- (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
- (group (gnus-group-group-name))
- (buffer-read-only nil))
- (when (and topicl group)
- (gnus-delete-line)
- (gnus-delete-first group topicl))
- (gnus-topic-update-topic)
- (gnus-group-position-point)))
+ (interactive "P")
+ (gnus-group-iterate arg
+ (lambda (group)
+ (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
+ (buffer-read-only nil))
+ (when (and topicl group)
+ (gnus-delete-line)
+ (gnus-delete-first group topicl))
+ (gnus-topic-update-topic)
+ (gnus-group-position-point)))))
(defun gnus-topic-copy-group (n topic)
"Copy the current group to a topic."
(let ((topic (gnus-group-topic-name)))
(gnus-topic-remove-topic nil t)
(push (gnus-topic-find-topology topic nil nil gnus-topic-topology)
- gnus-topic-killed-topics))
+ gnus-topic-killed-topics)
+ (gnus-topic-enter-dribble))
(gnus-group-kill-group n discard)
(gnus-topic-update-topic)))
(gnus-topic-create-topic
(caar item) (gnus-topic-parent-topic previous) previous
item)
+ (gnus-topic-enter-dribble)
(gnus-topic-goto-topic (caar item)))
(let* ((prev (gnus-group-group-name))
(gnus-topic-inhibit-change-level t)
(* gnus-topic-indent-level
(or (save-excursion
(gnus-topic-goto-topic (gnus-current-topic))
- (gnus-group-topic-level)) 0)) ? ))
+ (gnus-group-topic-level))
+ 0))
+ ? ))
yanked alist)
;; We first yank the groups the normal way...
(setq yanked (gnus-group-yank-group arg))
projects / gnus / blobdiff