Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-topic.el @ 118:7d55a9ba150c r20-1b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents fe104dbd9147
children cca96a509cfe
comparison
equal deleted inserted replaced
117:578fd4947a72 118:7d55a9ba150c
251 (setq prev (caaar parentt) 251 (setq prev (caaar parentt)
252 parentt (cdr parentt))) 252 parentt (cdr parentt)))
253 (if previous 253 (if previous
254 prev 254 prev
255 (caaadr parentt)))) 255 (caaadr parentt))))
256
257 (defun gnus-topic-forward-topic (num)
258 "Go to the next topic on the same level as the current one."
259 (let* ((topic (gnus-current-topic))
260 (way (if (< num 0) 'gnus-topic-previous-topic
261 'gnus-topic-next-topic))
262 (num (abs num)))
263 (while (and (not (zerop num))
264 (setq topic (funcall way topic)))
265 (when (gnus-topic-goto-topic topic)
266 (decf num)))
267 (unless (zerop num)
268 (goto-char (point-max)))
269 num))
256 270
257 (defun gnus-topic-find-topology (topic &optional topology level remove) 271 (defun gnus-topic-find-topology (topic &optional topology level remove)
258 "Return the topology of TOPIC." 272 "Return the topology of TOPIC."
259 (unless topology 273 (unless topology
260 (setq topology gnus-topic-topology) 274 (setq topology gnus-topic-topology)
555 (setq g (cdr (member group (reverse groups)))) 569 (setq g (cdr (member group (reverse groups))))
556 (while (and g unfound) 570 (while (and g unfound)
557 (when (gnus-group-goto-group (pop g) t) 571 (when (gnus-group-goto-group (pop g) t)
558 (forward-line 1) 572 (forward-line 1)
559 (setq unfound nil))) 573 (setq unfound nil)))
560 (when unfound 574 (when (and unfound
561 (gnus-topic-goto-topic topic) 575 (not (gnus-topic-goto-missing-topic topic)))
562 (forward-line 1))))) 576 (gnus-topic-insert-topic-line
577 topic t t (car (gnus-topic-find-topology topic)) nil 0)))))
578
579 (defun gnus-topic-goto-missing-topic (topic)
580 (if (gnus-topic-goto-topic topic)
581 (forward-line 1)
582 ;; Topic not displayed.
583 (let* ((top (gnus-topic-find-topology
584 (gnus-topic-parent-topic topic)))
585 (tp (reverse (cddr top))))
586 (while (not (equal (caaar tp) topic))
587 (setq tp (cdr tp)))
588 (pop tp)
589 (while (and tp
590 (not (gnus-topic-goto-topic (caaar tp))))
591 (pop tp))
592 (if tp
593 (gnus-topic-forward-topic 1)
594 (gnus-topic-goto-missing-topic (caadr top))))
595 nil))
563 596
564 (defun gnus-topic-update-topic-line (topic-name &optional reads) 597 (defun gnus-topic-update-topic-line (topic-name &optional reads)
565 (let* ((top (gnus-topic-find-topology topic-name)) 598 (let* ((top (gnus-topic-find-topology topic-name))
566 (type (cadr top)) 599 (type (cadr top))
567 (children (cddr top)) 600 (children (cddr top))