163 |
(dolist (topic (gnus-current-topics topic)) |
(dolist (topic (gnus-current-topics topic)) |
164 |
(gnus-topic-fold t)) |
(gnus-topic-fold t)) |
165 |
(gnus-topic-goto-topic topic)) |
(gnus-topic-goto-topic topic)) |
166 |
|
|
167 |
(defun gnus-current-topic () |
(defun gnus-current-topic () |
168 |
"Return the name of the current topic." |
"Return the name of the current topic." |
169 |
(let ((result |
(let ((result |
233 |
;; Add this group to the list of visible groups. |
;; Add this group to the list of visible groups. |
234 |
(push (or entry group) visible-groups))) |
(push (or entry group) visible-groups))) |
235 |
(setq visible-groups (nreverse visible-groups)) |
(setq visible-groups (nreverse visible-groups)) |
236 |
(when recursive |
(when recursive |
237 |
(if (eq recursive t) |
(if (eq recursive t) |
238 |
(setq recursive (cdr (gnus-topic-find-topology topic)))) |
(setq recursive (cdr (gnus-topic-find-topology topic)))) |
239 |
(mapcar (lambda (topic-topology) |
(mapcar (lambda (topic-topology) |
240 |
(setq visible-groups |
(setq visible-groups |
241 |
(nconc visible-groups |
(nconc visible-groups |
242 |
(gnus-topic-find-groups |
(gnus-topic-find-groups |
243 |
(caar topic-topology) |
(caar topic-topology) |
244 |
level all lowest topic-topology)))) |
level all lowest topic-topology)))) |
245 |
(cdr recursive))) |
(cdr recursive))) |
246 |
visible-groups)) |
visible-groups)) |
1146 |
(gnus-group-list-groups) |
(gnus-group-list-groups) |
1147 |
(gnus-topic-goto-topic topic)) |
(gnus-topic-goto-topic topic)) |
1148 |
|
|
1149 |
;; FIXME: |
;; FIXME: |
1150 |
;; 1. When the marked groups are overlapped with the process |
;; 1. When the marked groups are overlapped with the process |
1151 |
;; region, the behavior of move or remove is not right. |
;; region, the behavior of move or remove is not right. |
1152 |
;; 2. Can't process on several marked groups with a same name, |
;; 2. Can't process on several marked groups with a same name, |
1153 |
;; because gnus-group-marked only keeps one copy. |
;; because gnus-group-marked only keeps one copy. |
1154 |
|
|
1155 |
(defun gnus-topic-move-group (n topic &optional copyp) |
(defun gnus-topic-move-group (n topic &optional copyp) |
1158 |
(interactive |
(interactive |
1159 |
(list current-prefix-arg |
(list current-prefix-arg |
1160 |
(completing-read "Move to topic: " gnus-topic-alist nil t))) |
(completing-read "Move to topic: " gnus-topic-alist nil t))) |
1161 |
(let ((use-marked (and (not n) (not (gnus-region-active-p)) |
(let ((use-marked (and (not n) (not (gnus-region-active-p)) |
1162 |
gnus-group-marked t)) |
gnus-group-marked t)) |
1163 |
(groups (gnus-group-process-prefix n)) |
(groups (gnus-group-process-prefix n)) |
1164 |
(topicl (assoc topic gnus-topic-alist)) |
(topicl (assoc topic gnus-topic-alist)) |
1185 |
(defun gnus-topic-remove-group (&optional n) |
(defun gnus-topic-remove-group (&optional n) |
1186 |
"Remove the current group from the topic." |
"Remove the current group from the topic." |
1187 |
(interactive "P") |
(interactive "P") |
1188 |
(let ((use-marked (and (not n) (not (gnus-region-active-p)) |
(let ((use-marked (and (not n) (not (gnus-region-active-p)) |
1189 |
gnus-group-marked t)) |
gnus-group-marked t)) |
1190 |
(groups (gnus-group-process-prefix n))) |
(groups (gnus-group-process-prefix n))) |
1191 |
(mapcar |
(mapcar |
1283 |
(when (gnus-current-topic) |
(when (gnus-current-topic) |
1284 |
(gnus-topic-goto-topic (gnus-current-topic)) |
(gnus-topic-goto-topic (gnus-current-topic)) |
1285 |
(if permanent |
(if permanent |
1286 |
(setcar (cddr |
(setcar (cddr |
1287 |
(cadr |
(cadr |
1288 |
(gnus-topic-find-topology (gnus-current-topic)))) |
(gnus-topic-find-topology (gnus-current-topic)))) |
1289 |
'hidden)) |
'hidden)) |
1296 |
(when (gnus-group-topic-p) |
(when (gnus-group-topic-p) |
1297 |
(if (not permanent) |
(if (not permanent) |
1298 |
(gnus-topic-remove-topic t nil) |
(gnus-topic-remove-topic t nil) |
1299 |
(let ((topic |
(let ((topic |
1300 |
(gnus-topic-find-topology |
(gnus-topic-find-topology |
1301 |
(completing-read "Show topic: " gnus-topic-alist nil t)))) |
(completing-read "Show topic: " gnus-topic-alist nil t)))) |
1302 |
(setcar (cddr (cadr topic)) nil) |
(setcar (cddr (cadr topic)) nil) |
1303 |
(setcar (cdr (cadr topic)) 'visible) |
(setcar (cdr (cadr topic)) 'visible) |
1312 |
(if (not topic) |
(if (not topic) |
1313 |
(call-interactively 'gnus-group-mark-group) |
(call-interactively 'gnus-group-mark-group) |
1314 |
(save-excursion |
(save-excursion |
1315 |
(let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil |
(let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil |
1316 |
recursive))) |
recursive))) |
1317 |
(while groups |
(while groups |
1318 |
(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) |
(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) |
1416 |
(gnus-topic-kill-group) |
(gnus-topic-kill-group) |
1417 |
(push (cdar gnus-topic-killed-topics) gnus-topic-alist) |
(push (cdar gnus-topic-killed-topics) gnus-topic-alist) |
1418 |
(gnus-topic-create-topic |
(gnus-topic-create-topic |
1419 |
topic parent nil (cdaar gnus-topic-killed-topics)) |
topic parent nil (cdar (car gnus-topic-killed-topics))) |
1420 |
(pop gnus-topic-killed-topics) |
(pop gnus-topic-killed-topics) |
1421 |
(or (gnus-topic-goto-topic topic) |
(or (gnus-topic-goto-topic topic) |
1422 |
(gnus-topic-goto-topic parent)))))) |
(gnus-topic-goto-topic parent)))))) |
1435 |
(push (cdar gnus-topic-killed-topics) gnus-topic-alist) |
(push (cdar gnus-topic-killed-topics) gnus-topic-alist) |
1436 |
(gnus-topic-create-topic |
(gnus-topic-create-topic |
1437 |
topic grandparent (gnus-topic-next-topic parent) |
topic grandparent (gnus-topic-next-topic parent) |
1438 |
(cdaar gnus-topic-killed-topics)) |
(cdar (car gnus-topic-killed-topics))) |
1439 |
(pop gnus-topic-killed-topics) |
(pop gnus-topic-killed-topics) |
1440 |
(gnus-topic-goto-topic topic)))) |
(gnus-topic-goto-topic topic)))) |
1441 |
|
|
1558 |
(mapcar `(lambda (top) |
(mapcar `(lambda (top) |
1559 |
(gnus-topic-sort-topics-1 top ,reverse)) |
(gnus-topic-sort-topics-1 top ,reverse)) |
1560 |
(sort (cdr top) |
(sort (cdr top) |
1561 |
'(lambda (t1 t2) |
'(lambda (t1 t2) |
1562 |
(string-lessp (caar t1) (caar t2))))))) |
(string-lessp (caar t1) (caar t2))))))) |
1563 |
(setcdr top (if reverse (reverse subtop) subtop)))) |
(setcdr top (if reverse (reverse subtop) subtop)))) |
1564 |
top) |
top) |
1565 |
|
|
1566 |
(defun gnus-topic-sort-topics (&optional topic reverse) |
(defun gnus-topic-sort-topics (&optional topic reverse) |
1567 |
"Sort topics in TOPIC alphabeticaly by topic name. |
"Sort topics in TOPIC alphabetically by topic name. |
1568 |
If REVERSE, reverse the sorting order." |
If REVERSE, reverse the sorting order." |
1569 |
(interactive |
(interactive |
1570 |
(list (completing-read "Sort topics in : " gnus-topic-alist nil t |
(list (completing-read "Sort topics in : " gnus-topic-alist nil t |
1571 |
(gnus-current-topic)) |
(gnus-current-topic)) |
1572 |
current-prefix-arg)) |
current-prefix-arg)) |
1573 |
(let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) |
(let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) |
1579 |
|
|
1580 |
(defun gnus-topic-move (current to) |
(defun gnus-topic-move (current to) |
1581 |
"Move the CURRENT topic to TO." |
"Move the CURRENT topic to TO." |
1582 |
(interactive |
(interactive |
1583 |
(list |
(list |
1584 |
(gnus-group-topic-name) |
(gnus-group-topic-name) |
1585 |
(completing-read "Move to topic: " gnus-topic-alist nil t))) |
(completing-read "Move to topic: " gnus-topic-alist nil t))) |
1586 |
(unless (and current to) |
(unless (and current to) |
1613 |
;; Add the group to the topic. |
;; Add the group to the topic. |
1614 |
(nconc (assoc topic gnus-topic-alist) (list newsgroup)) |
(nconc (assoc topic gnus-topic-alist) (list newsgroup)) |
1615 |
(throw 'end t)))))) |
(throw 'end t)))))) |
1616 |
|
|
1617 |
(provide 'gnus-topic) |
(provide 'gnus-topic) |
1618 |
|
|
1619 |
;;; gnus-topic.el ends here |
;;; gnus-topic.el ends here |