Update copyright year to 2014 by running admin/update-copyright.
[bpt/emacs.git] / lisp / net / newst-treeview.el
CommitLineData
2900b2d8 1;;; newst-treeview.el --- Treeview frontend for newsticker.
2415d4c6 2
ba318903 3;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
2415d4c6 4
2415d4c6 5;; Author: Ulf Jasper <ulf.jasper@web.de>
2900b2d8 6;; Filename: newst-treeview.el
2415d4c6
UJ
7;; URL: http://www.nongnu.org/newsticker
8;; Created: 2007
9;; Keywords: News, RSS, Atom
bd78fa1d 10;; Package: newsticker
2415d4c6
UJ
11
12;; ======================================================================
13
68706e71
GM
14;; This file is part of GNU Emacs.
15
2415d4c6
UJ
16;; GNU Emacs is free software: you can redistribute it and/or modify
17;; it under the terms of the GNU General Public License as published by
18;; the Free Software Foundation, either version 3 of the License, or
19;; (at your option) any later version.
20
21;; GNU Emacs is distributed in the hope that it will be useful,
22;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24;; GNU General Public License for more details.
25
26;; You should have received a copy of the GNU General Public License
27;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28
29;; ======================================================================
30;;; Commentary:
31
32;; See newsticker.el
33
34;; ======================================================================
35;;; History:
5eddea0b 36;;
2415d4c6 37
2415d4c6
UJ
38;; ======================================================================
39;;; Code:
8e39154d 40(require 'newst-reader)
2415d4c6
UJ
41(require 'widget)
42(require 'tree-widget)
43(require 'wid-edit)
44
45;; ======================================================================
46;;; Customization
47;; ======================================================================
48(defgroup newsticker-treeview nil
49 "Settings for the tree view reader."
50 :group 'newsticker-reader)
51
52(defface newsticker-treeview-face
4b56d0fe
CY
53 '((((class color) (background dark)) :foreground "white")
54 (((class color) (background light)) :foreground "black"))
2415d4c6
UJ
55 "Face for newsticker tree."
56 :group 'newsticker-treeview)
57
58(defface newsticker-treeview-new-face
4b56d0fe 59 '((t :inherit newsticker-treeview-face :weight bold))
2415d4c6
UJ
60 "Face for newsticker tree."
61 :group 'newsticker-treeview)
62
63(defface newsticker-treeview-old-face
4b56d0fe 64 '((t :inherit newsticker-treeview-face))
2415d4c6
UJ
65 "Face for newsticker tree."
66 :group 'newsticker-treeview)
67
68(defface newsticker-treeview-immortal-face
4b56d0fe
CY
69 '((default :inherit newsticker-treeview-face :slant italic)
70 (((class color) (background dark)) :foreground "orange")
71 (((class color) (background light)) :foreground "blue"))
2415d4c6
UJ
72 "Face for newsticker tree."
73 :group 'newsticker-treeview)
74
75(defface newsticker-treeview-obsolete-face
4b56d0fe 76 '((t :inherit newsticker-treeview-face :strike-through t))
2415d4c6
UJ
77 "Face for newsticker tree."
78 :group 'newsticker-treeview)
79
80(defface newsticker-treeview-selection-face
4b56d0fe
CY
81 '((((class color) (background dark)) :background "#bbbbff")
82 (((class color) (background light)) :background "#bbbbff"))
2415d4c6
UJ
83 "Face for newsticker selection."
84 :group 'newsticker-treeview)
85
86(defcustom newsticker-treeview-own-frame
639fbfe1 87 nil
4367e4b2 88 "Decides whether newsticker treeview creates and uses its own frame."
2415d4c6
UJ
89 :type 'boolean
90 :group 'newsticker-treeview)
91
4367e4b2
UJ
92(defcustom newsticker-treeview-treewindow-width
93 30
94 "Width of tree window in treeview layout.
95See also `newsticker-treeview-listwindow-height'."
27cacd2d 96 :type 'integer
4367e4b2
UJ
97 :group 'newsticker-treeview)
98
99(defcustom newsticker-treeview-listwindow-height
100 10
101 "Height of list window in treeview layout.
102See also `newsticker-treeview-treewindow-width'."
27cacd2d 103 :type 'integer
4367e4b2
UJ
104 :group 'newsticker-treeview)
105
2415d4c6
UJ
106(defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
107 t
108 "Decides whether to automatically mark displayed items as old.
109If t an item is marked as old as soon as it is displayed. This
110applies to newsticker only."
111 :type 'boolean
112 :group 'newsticker-treeview)
113
114(defvar newsticker-groups
115 '("Feeds")
116 "List of feed groups, used in the treeview frontend.
883bef2d
UJ
117First element is a string giving the group name. Remaining
118elements are either strings giving a feed name or lists having
119the same structure as `newsticker-groups'. (newsticker-groups :=
120groupdefinition, groupdefinition := groupname groupcontent*,
121groupcontent := feedname | groupdefinition)
122
123Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
124\"feed3\")")
2415d4c6
UJ
125
126(defcustom newsticker-groups-filename
127 "~/.newsticker-groups"
128 "Name of the newsticker groups settings file."
129 :type 'string
130 :group 'newsticker-treeview)
59f7af81 131(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
2415d4c6
UJ
132
133;; ======================================================================
134;;; internal variables
135;; ======================================================================
136(defvar newsticker--treeview-windows nil)
137(defvar newsticker--treeview-buffers nil)
a59c6c51
UJ
138(defvar newsticker--treeview-current-feed nil
139 "Feed name of currently shown item.")
2415d4c6
UJ
140(defvar newsticker--treeview-current-vfeed nil)
141(defvar newsticker--treeview-list-show-feed nil)
142(defvar newsticker--saved-window-config nil)
2415d4c6
UJ
143(defvar newsticker--selection-overlay nil
144 "Highlight the selected tree node.")
2415d4c6
UJ
145(defvar newsticker--tree-selection-overlay nil
146 "Highlight the selected list item.")
2415d4c6
UJ
147(defvar newsticker--frame nil "Special frame for newsticker windows.")
148(defvar newsticker--treeview-list-sort-order 'sort-by-time)
149(defvar newsticker--treeview-current-node-id nil)
150(defvar newsticker--treeview-current-tree nil)
151(defvar newsticker--treeview-feed-tree nil)
152(defvar newsticker--treeview-vfeed-tree nil)
153
154;; maps for the clickable portions
155(defvar newsticker--treeview-url-keymap
156 (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
157 (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
158 (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
159 (define-key map "\n" 'newsticker-treeview-browse-url)
160 (define-key map "\C-m" 'newsticker-treeview-browse-url)
161 (define-key map [(control return)] 'newsticker-handle-url)
162 map)
163 "Key map for click-able headings in the newsticker treeview buffers.")
164
165
166;; ======================================================================
167;;; short cuts
168;; ======================================================================
169(defsubst newsticker--treeview-tree-buffer ()
170 "Return the tree buffer of the newsticker treeview."
171 (nth 0 newsticker--treeview-buffers))
172(defsubst newsticker--treeview-list-buffer ()
173 "Return the list buffer of the newsticker treeview."
174 (nth 1 newsticker--treeview-buffers))
175(defsubst newsticker--treeview-item-buffer ()
176 "Return the item buffer of the newsticker treeview."
177 (nth 2 newsticker--treeview-buffers))
178(defsubst newsticker--treeview-tree-window ()
179 "Return the tree window of the newsticker treeview."
180 (nth 0 newsticker--treeview-windows))
181(defsubst newsticker--treeview-list-window ()
182 "Return the list window of the newsticker treeview."
183 (nth 1 newsticker--treeview-windows))
184(defsubst newsticker--treeview-item-window ()
185 "Return the item window of the newsticker treeview."
186 (nth 2 newsticker--treeview-windows))
187
188;; ======================================================================
189;;; utility functions
190;; ======================================================================
191(defun newsticker--treeview-get-id (parent i)
192 "Create an id for a newsticker treeview node.
193PARENT is the node's parent, I is an integer."
194 ;;(message "newsticker--treeview-get-id %s"
195 ;; (format "%s-%d" (widget-get parent :nt-id) i))
196 (format "%s-%d" (widget-get parent :nt-id) i))
197
198(defun newsticker--treeview-ids-eq (id1 id2)
199 "Return non-nil if ids ID1 and ID2 are equal."
200 ;;(message "%s/%s" (or id1 -1) (or id2 -1))
201 (and id1 id2 (string= id1 id2)))
202
203(defun newsticker--treeview-nodes-eq (node1 node2)
204 "Compare treeview nodes NODE1 and NODE2 for equality.
205Nodes are equal if the have the same newsticker-id. Note that
206during re-tagging and collapsing/expanding nodes change, while
207their id stays constant."
208 (let ((id1 (widget-get node1 :nt-id))
209 (id2 (widget-get node2 :nt-id)))
210 ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
211 ;; (or id1 -1) (or id2 -1))
212 (or (newsticker--treeview-ids-eq id1 id2)
213 (string= (widget-get node1 :tag) (widget-get node2 :tag)))))
214
215(defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
c7015153 216 "Recursively search node for feed FEED-NAME starting from STARTNODE."
2415d4c6
UJ
217 ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
218 (if (string= feed-name (or (widget-get startnode :nt-feed)
219 (widget-get startnode :nt-vfeed)))
220 (throw 'found startnode)
221 (let ((children (widget-get startnode :children)))
222 (dolist (w children)
223 (newsticker--treeview-do-get-node-of-feed feed-name w)))))
224
225(defun newsticker--treeview-get-node-of-feed (feed-name)
226 "Return node for feed FEED-NAME in newsticker treeview tree."
227 (catch 'found
228 (newsticker--treeview-do-get-node-of-feed feed-name
229 newsticker--treeview-feed-tree)
230 (newsticker--treeview-do-get-node-of-feed feed-name
231 newsticker--treeview-vfeed-tree)))
232
233(defun newsticker--treeview-do-get-node (id startnode)
c7015153 234 "Recursively search node with ID starting from STARTNODE."
2415d4c6
UJ
235 (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
236 (throw 'found startnode)
237 (let ((children (widget-get startnode :children)))
238 (dolist (w children)
239 (newsticker--treeview-do-get-node id w)))))
240
241(defun newsticker--treeview-get-node (id)
242 "Return node with ID in newsticker treeview tree."
243 (catch 'found
244 (newsticker--treeview-do-get-node id newsticker--treeview-feed-tree)
245 (newsticker--treeview-do-get-node id newsticker--treeview-vfeed-tree)))
246
247(defun newsticker--treeview-get-current-node ()
248 "Return current node in newsticker treeview tree."
249 (newsticker--treeview-get-node newsticker--treeview-current-node-id))
250
251;; ======================================================================
252
17abdd47 253(unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
a66bb4d5
GM
254(declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
255
2415d4c6
UJ
256(defun newsticker--treeview-render-text (start end)
257 "Render text between markers START and END."
258 (if newsticker-html-renderer
259 (condition-case error-data
260 (save-excursion
261 (set-marker-insertion-type end t)
262 ;; check whether it is necessary to call html renderer
263 ;; (regexp inspired by htmlr.el)
264 (goto-char start)
265 (when (re-search-forward
266 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
267 ;; (message "%s" (newsticker--title item))
268 (let ((w3m-fill-column (if newsticker-use-full-width
269 -1 fill-column))
270 (w3-maximum-line-length
271 (if newsticker-use-full-width nil fill-column)))
272 (save-excursion
273 (funcall newsticker-html-renderer start end)))
274 ;;(cond ((eq newsticker-html-renderer 'w3m-region)
275 ;; (add-text-properties start end (list 'keymap
276 ;; w3m-minor-mode-map)))
277 ;;((eq newsticker-html-renderer 'w3-region)
278 ;;(add-text-properties start end (list 'keymap w3-mode-map))))
279 (if (eq newsticker-html-renderer 'w3m-region)
280 (w3m-toggle-inline-images t))
281 t))
282 (error
283 (message "Error: HTML rendering failed: %s, %s"
284 (car error-data) (cdr error-data))
285 nil))
286 nil))
287
288;; ======================================================================
289;;; List window
290;; ======================================================================
291(defun newsticker--treeview-list-add-item (item feed &optional show-feed)
292 "Add news ITEM for FEED to newsticker treeview list window.
293If string SHOW-FEED is non-nil it is shown in the item string."
294 (setq newsticker--treeview-list-show-feed show-feed)
9a529312 295 (with-current-buffer (newsticker--treeview-list-buffer)
2415d4c6
UJ
296 (let* ((inhibit-read-only t)
297 pos1 pos2)
298 (goto-char (point-max))
299 (setq pos1 (point-marker))
300 (insert " ")
301 (insert (propertize " " 'display '(space :align-to 2)))
302 (insert (if show-feed
303 (concat
304 (substring
305 (format "%-10s" (newsticker--real-feed-name
306 feed))
307 0 10)
308 (propertize " " 'display '(space :align-to 12)))
309 ""))
310 (insert (format-time-string "%d.%m.%y, %H:%M"
311 (newsticker--time item)))
312 (insert (propertize " " 'display
313 (list 'space :align-to (if show-feed 28 18))))
314 (setq pos2 (point-marker))
315 (insert (newsticker--title item))
316 (insert "\n")
317 (newsticker--treeview-render-text pos2 (point-marker))
318 (goto-char pos2)
319 (while (search-forward "\n" nil t)
320 (replace-match " "))
321 (let ((map (make-sparse-keymap)))
322 (define-key map [mouse-1] 'newsticker-treeview-tree-click)
323 (define-key map "\n" 'newsticker-treeview-show-item)
324 (define-key map "\C-m" 'newsticker-treeview-show-item)
325 (add-text-properties pos1 (point-max)
326 (list :nt-item item
327 :nt-feed feed
328 :nt-link (newsticker--link item)
329 'mouse-face 'highlight
330 'keymap map
639fbfe1
UJ
331 'help-echo (buffer-substring pos2
332 (point-max)))))
2415d4c6
UJ
333 (insert "\n"))))
334
335(defun newsticker--treeview-list-clear ()
336 "Clear the newsticker treeview list window."
9a529312 337 (with-current-buffer (newsticker--treeview-list-buffer)
2415d4c6
UJ
338 (let ((inhibit-read-only t))
339 (erase-buffer)
340 (kill-all-local-variables)
341 (remove-overlays))))
342
343(defun newsticker--treeview-list-items-with-age-callback (widget
344 changed-widget
345 &rest ages)
346 "Fill newsticker treeview list window with items of certain age.
347This is a callback function for the treeview nodes.
348Argument WIDGET is the calling treeview widget.
349Argument CHANGED-WIDGET is the widget that actually has changed.
350Optional argument AGES is the list of ages that are to be shown."
351 (newsticker--treeview-list-clear)
352 (widget-put widget :nt-selected t)
353 (apply 'newsticker--treeview-list-items-with-age ages))
354
355(defun newsticker--treeview-list-items-with-age (&rest ages)
356 "Actually fill newsticker treeview list window with items of certain age.
357AGES is the list of ages that are to be shown."
358 (mapc (lambda (feed)
359 (let ((feed-name-symbol (intern (car feed))))
360 (mapc (lambda (item)
361 (when (memq (newsticker--age item) ages)
362 (newsticker--treeview-list-add-item
363 item feed-name-symbol t)))
364 (newsticker--treeview-list-sort-items
365 (cdr (newsticker--cache-get-feed feed-name-symbol))))))
366 (append newsticker-url-list-defaults newsticker-url-list))
367 (newsticker--treeview-list-update nil))
368
369(defun newsticker--treeview-list-new-items (widget changed-widget
370 &optional event)
371 "Fill newsticker treeview list window with new items.
372This is a callback function for the treeview nodes.
883bef2d
UJ
373Argument WIDGET is the calling treeview widget.
374Argument CHANGED-WIDGET is the widget that actually has changed.
375Optional argument EVENT is the mouse event that triggered this action."
2415d4c6
UJ
376 (newsticker--treeview-list-items-with-age-callback widget changed-widget
377 'new)
378 (newsticker--treeview-item-show-text
379 "New items"
380 "This is a virtual feed containing all new items"))
381
382(defun newsticker--treeview-list-immortal-items (widget changed-widget
383 &optional event)
384 "Fill newsticker treeview list window with immortal items.
385This is a callback function for the treeview nodes.
883bef2d
UJ
386Argument WIDGET is the calling treeview widget.
387Argument CHANGED-WIDGET is the widget that actually has changed.
388Optional argument EVENT is the mouse event that triggered this action."
2415d4c6
UJ
389 (newsticker--treeview-list-items-with-age-callback widget changed-widget
390 'immortal)
391 (newsticker--treeview-item-show-text
392 "Immortal items"
393 "This is a virtual feed containing all immortal items."))
394
395(defun newsticker--treeview-list-obsolete-items (widget changed-widget
396 &optional event)
397 "Fill newsticker treeview list window with obsolete items.
398This is a callback function for the treeview nodes.
883bef2d
UJ
399Argument WIDGET is the calling treeview widget.
400Argument CHANGED-WIDGET is the widget that actually has changed.
401Optional argument EVENT is the mouse event that triggered this action."
2415d4c6
UJ
402 (newsticker--treeview-list-items-with-age-callback widget changed-widget
403 'obsolete)
404 (newsticker--treeview-item-show-text
405 "Obsolete items"
406 "This is a virtual feed containing all obsolete items."))
407
408(defun newsticker--treeview-list-all-items (widget changed-widget
409 &optional event)
410 "Fill newsticker treeview list window with all items.
411This is a callback function for the treeview nodes.
883bef2d
UJ
412Argument WIDGET is the calling treeview widget.
413Argument CHANGED-WIDGET is the widget that actually has changed.
414Optional argument EVENT is the mouse event that triggered this action."
2415d4c6
UJ
415 (newsticker--treeview-list-items-with-age-callback widget changed-widget
416 event 'new 'old
417 'obsolete 'immortal)
418 (newsticker--treeview-item-show-text
419 "All items"
420 "This is a virtual feed containing all items."))
421
422(defun newsticker--treeview-list-items-v (vfeed-name)
423 "List items for virtual feed VFEED-NAME."
424 (when vfeed-name
425 (cond ((string-match "\\*new\\*" vfeed-name)
426 (newsticker--treeview-list-items-with-age 'new))
427 ((string-match "\\*immortal\\*" vfeed-name)
428 (newsticker--treeview-list-items-with-age 'immortal))
429 ((string-match "\\*old\\*" vfeed-name)
430 (newsticker--treeview-list-items-with-age 'old nil)))
431 (newsticker--treeview-list-update nil)
432 ))
433
434(defun newsticker--treeview-list-items (feed-name)
435 "List items for feed FEED-NAME."
436 (when feed-name
437 (if (newsticker--treeview-virtual-feed-p feed-name)
438 (newsticker--treeview-list-items-v feed-name)
439 (mapc (lambda (item)
440 (if (eq (newsticker--age item) 'feed)
441 (newsticker--treeview-item-show item (intern feed-name))
442 (newsticker--treeview-list-add-item item
443 (intern feed-name))))
444 (newsticker--treeview-list-sort-items
445 (cdr (newsticker--cache-get-feed (intern feed-name)))))
446 (newsticker--treeview-list-update nil))))
447
448(defun newsticker--treeview-list-feed-items (widget changed-widget
449 &optional event)
450 "Callback function for listing feed items.
883bef2d
UJ
451Argument WIDGET is the calling treeview widget.
452Argument CHANGED-WIDGET is the widget that actually has changed.
453Optional argument EVENT is the mouse event that triggered this action."
2415d4c6
UJ
454 (newsticker--treeview-list-clear)
455 (widget-put widget :nt-selected t)
456 (let ((feed-name (widget-get widget :nt-feed))
457 (vfeed-name (widget-get widget :nt-vfeed)))
458 (if feed-name
459 (newsticker--treeview-list-items feed-name)
460 (newsticker--treeview-list-items-v vfeed-name))))
461
462(defun newsticker--treeview-list-compare-item-by-age (item1 item2)
463 "Compare two news items ITEM1 and ITEM2 wrt age."
464 (catch 'result
465 (let ((age1 (newsticker--age item1))
466 (age2 (newsticker--age item2)))
467 (cond ((eq age1 'new)
468 t)
469 ((eq age1 'immortal)
470 (cond ((eq age2 'new)
471 t)
472 ((eq age2 'immortal)
473 t)
474 (t
475 nil)))
476 ((eq age1 'old)
477 (cond ((eq age2 'new)
478 nil)
479 ((eq age2 'immortal)
480 nil)
481 ((eq age2 'old)
482 nil)
483 (t
484 t)))
485 (t
486 nil)))))
487
488(defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
489 "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
490 (newsticker--treeview-list-compare-item-by-age item2 item1))
491
492(defun newsticker--treeview-list-compare-item-by-time (item1 item2)
493 "Compare two news items ITEM1 and ITEM2 wrt time values."
494 (newsticker--cache-item-compare-by-time item1 item2))
495
496(defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
497 "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
498 (newsticker--cache-item-compare-by-time item2 item1))
499
500(defun newsticker--treeview-list-compare-item-by-title (item1 item2)
501 "Compare two news items ITEM1 and ITEM2 wrt title."
502 (newsticker--cache-item-compare-by-title item1 item2))
503
504(defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
505 "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
506 (newsticker--cache-item-compare-by-title item2 item1))
507
508(defun newsticker--treeview-list-sort-items (items)
509 "Return sorted copy of list ITEMS.
510The sort function is chosen according to the value of
511`newsticker--treeview-list-sort-order'."
512 (let ((sort-fun
513 (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
514 'newsticker--treeview-list-compare-item-by-age)
515 ((eq newsticker--treeview-list-sort-order
516 'sort-by-age-reverse)
517 'newsticker--treeview-list-compare-item-by-age-reverse)
518 ((eq newsticker--treeview-list-sort-order 'sort-by-time)
519 'newsticker--treeview-list-compare-item-by-time)
520 ((eq newsticker--treeview-list-sort-order
521 'sort-by-time-reverse)
522 'newsticker--treeview-list-compare-item-by-time-reverse)
523 ((eq newsticker--treeview-list-sort-order 'sort-by-title)
524 'newsticker--treeview-list-compare-item-by-title)
525 ((eq newsticker--treeview-list-sort-order
526 'sort-by-title-reverse)
527 'newsticker--treeview-list-compare-item-by-title-reverse)
528 (t
529 'newsticker--treeview-list-compare-item-by-title))))
530 (sort (copy-sequence items) sort-fun)))
531
532(defun newsticker--treeview-list-update-faces ()
533 "Update faces in the treeview list buffer."
534 (let (pos-sel)
9a529312 535 (with-current-buffer (newsticker--treeview-list-buffer)
2d84f804
GM
536 (save-excursion
537 (let ((inhibit-read-only t))
538 (goto-char (point-min))
539 (while (not (eobp))
540 (let* ((pos (point-at-eol))
541 (item (get-text-property (point) :nt-item))
542 (age (newsticker--age item))
543 (selected (get-text-property (point) :nt-selected))
544 (face (cond ((eq age 'new)
545 'newsticker-treeview-new-face)
546 ((eq age 'old)
547 'newsticker-treeview-old-face)
548 ((eq age 'immortal)
549 'newsticker-treeview-immortal-face)
550 ((eq age 'obsolete)
551 'newsticker-treeview-obsolete-face)
552 (t
553 'bold))))
554 (put-text-property (point) pos 'face face)
555 (if selected
556 (move-overlay newsticker--selection-overlay (point)
557 (1+ pos) ;include newline
558 (current-buffer)))
559 (if selected (setq pos-sel (point)))
560 (forward-line 1)
561 (beginning-of-line)))))) ;; FIXME!?
2415d4c6 562 (when pos-sel
c9aafaaf
UJ
563 (if (window-live-p (newsticker--treeview-list-window))
564 (set-window-point (newsticker--treeview-list-window) pos-sel)))))
2415d4c6
UJ
565
566(defun newsticker--treeview-list-clear-highlight ()
567 "Clear the highlight in the treeview list buffer."
9a529312 568 (with-current-buffer (newsticker--treeview-list-buffer)
2415d4c6
UJ
569 (let ((inhibit-read-only t))
570 (put-text-property (point-min) (point-max) :nt-selected nil))
571 (newsticker--treeview-list-update-faces)))
572
573(defun newsticker--treeview-list-update-highlight ()
574 "Update the highlight in the treeview list buffer."
575 (newsticker--treeview-list-clear-highlight)
576 (let (pos num-lines)
9a529312 577 (with-current-buffer (newsticker--treeview-list-buffer)
2415d4c6 578 (let ((inhibit-read-only t))
2d84f804 579 (put-text-property (point-at-bol) (point-at-eol) :nt-selected t))
2415d4c6
UJ
580 (newsticker--treeview-list-update-faces))))
581
582(defun newsticker--treeview-list-highlight-start ()
583 "Return position of selection in treeview list buffer."
9a529312 584 (with-current-buffer (newsticker--treeview-list-buffer)
0c74a301
UJ
585 (save-excursion
586 (goto-char (point-min))
587 (next-single-property-change (point) :nt-selected))))
2415d4c6
UJ
588
589(defun newsticker--treeview-list-update (clear-buffer)
590 "Update the faces and highlight in the treeview list buffer.
591If CLEAR-BUFFER is non-nil the list buffer is completely erased."
592 (save-excursion
c9aafaaf
UJ
593 (if (window-live-p (newsticker--treeview-list-window))
594 (set-window-buffer (newsticker--treeview-list-window)
595 (newsticker--treeview-list-buffer)))
2415d4c6
UJ
596 (set-buffer (newsticker--treeview-list-buffer))
597 (if clear-buffer
598 (let ((inhibit-read-only t))
599 (erase-buffer)))
600 (newsticker-treeview-list-mode)
601 (newsticker--treeview-list-update-faces)
602 (goto-char (point-min))))
603
2415d4c6
UJ
604(defvar newsticker-treeview-list-sort-button-map
605 (let ((map (make-sparse-keymap)))
606 (define-key map [header-line mouse-1]
607 'newsticker--treeview-list-sort-by-column)
608 (define-key map [header-line mouse-2]
609 'newsticker--treeview-list-sort-by-column)
610 map)
611 "Local keymap for newsticker treeview list window sort buttons.")
612
883bef2d 613(defun newsticker--treeview-list-sort-by-column (&optional event)
2415d4c6 614 "Sort the newsticker list window buffer by the column clicked on.
883bef2d 615Optional argument EVENT is the mouse event that triggered this action."
2415d4c6 616 (interactive (list last-input-event))
4fe0d68e
UJ
617 (if event (mouse-select-window event))
618 (let* ((pos (event-start event))
2415d4c6
UJ
619 (obj (posn-object pos))
620 (sort-order (if obj
621 (get-text-property (cdr obj) 'sort-order (car obj))
622 (get-text-property (posn-point pos) 'sort-order))))
623 (setq newsticker--treeview-list-sort-order
624 (cond ((eq sort-order 'sort-by-age)
625 (if (eq newsticker--treeview-list-sort-order 'sort-by-age)
626 'sort-by-age-reverse
627 'sort-by-age))
628 ((eq sort-order 'sort-by-time)
629 (if (eq newsticker--treeview-list-sort-order 'sort-by-time)
630 'sort-by-time-reverse
631 'sort-by-time))
632 ((eq sort-order 'sort-by-title)
633 (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
634 'sort-by-title-reverse
635 'sort-by-title))))
636 (newsticker-treeview-update)))
637
638(defun newsticker-treeview-list-make-sort-button (name sort-order)
639 "Create propertized string for headerline button.
640NAME is the button text, SORT-ORDER is the associated sort order
641for the button."
642 (let ((face (if (string-match (symbol-name sort-order)
643 (symbol-name
644 newsticker--treeview-list-sort-order))
645 'bold
646 'header-line)))
647 (propertize name
648 'sort-order sort-order
649 'help-echo (concat "Sort by " name)
650 'mouse-face 'highlight
651 'face face
652 'keymap newsticker-treeview-list-sort-button-map)))
653
0c74a301
UJ
654(defun newsticker--treeview-list-select (item)
655 "Select ITEM in treeview's list buffer."
656 (newsticker--treeview-list-clear-highlight)
657 (let (pos num-lines)
658 (save-current-buffer
659 (set-buffer (newsticker--treeview-list-buffer))
660 (goto-char (point-min))
661 (catch 'found
662 (while t
663 (let ((it (get-text-property (point) :nt-item)))
664 (when (eq it item)
665 (newsticker--treeview-list-update-highlight)
666 (newsticker--treeview-list-update-faces)
667 (newsticker--treeview-item-show
668 item (get-text-property (point) :nt-feed))
669 (throw 'found t)))
670 (forward-line 1)
671 (when (eobp)
672 (goto-char (point-min))
673 (throw 'found nil)))))))
674
2415d4c6
UJ
675;; ======================================================================
676;;; item window
677;; ======================================================================
678(defun newsticker--treeview-item-show-text (title description)
679 "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
9a529312 680 (with-current-buffer (newsticker--treeview-item-buffer)
2415d4c6
UJ
681 (when (fboundp 'w3m-process-stop)
682 (w3m-process-stop (current-buffer)))
683 (let ((inhibit-read-only t))
684 (erase-buffer)
685 (kill-all-local-variables)
686 (remove-overlays)
687 (insert title)
688 (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
689 (insert "\n\n" description)
690 (when newsticker-justification
691 (fill-region (point-min) (point-max) newsticker-justification))
0c74a301 692 (newsticker-treeview-item-mode)
2415d4c6
UJ
693 (goto-char (point-min)))))
694
a59c6c51
UJ
695(defun newsticker--treeview-item-show (item feed-name-symbol)
696 "Show news ITEM coming from FEED-NAME-SYMBOL in treeview item buffer."
697 (setq newsticker--treeview-current-feed (symbol-name feed-name-symbol))
9a529312 698 (with-current-buffer (newsticker--treeview-item-buffer)
2415d4c6
UJ
699 (when (fboundp 'w3m-process-stop)
700 (w3m-process-stop (current-buffer)))
701 (let ((inhibit-read-only t)
702 (is-rendered-HTML nil)
703 pos
704 (marker1 (make-marker))
705 (marker2 (make-marker)))
706 (erase-buffer)
707 (kill-all-local-variables)
708 (remove-overlays)
709
a59c6c51 710 (when (and item feed-name-symbol)
2415d4c6
UJ
711 (let ((wwidth (1- (window-width (newsticker--treeview-item-window)))))
712 (if newsticker-use-full-width
713 (set (make-local-variable 'fill-column) wwidth))
714 (set (make-local-variable 'fill-column) (min fill-column
715 wwidth)))
716 (let ((desc (newsticker--desc item)))
717 (insert "\n" (or desc "[No Description]")))
718 (set-marker marker1 (1+ (point-min)))
719 (set-marker marker2 (point-max))
720 (setq is-rendered-HTML (newsticker--treeview-render-text marker1
721 marker2))
722 (when (and newsticker-justification
723 (not is-rendered-HTML))
724 (fill-region marker1 marker2 newsticker-justification))
5eddea0b 725
0c74a301 726 (newsticker-treeview-item-mode)
2415d4c6
UJ
727 (goto-char (point-min))
728 ;; insert logo at top
729 (let* ((newsticker-enable-logo-manipulations nil)
a59c6c51 730 (img (newsticker--image-read feed-name-symbol nil)))
2415d4c6
UJ
731 (if (and (display-images-p) img)
732 (newsticker--insert-image img (car item))
a59c6c51 733 (insert (newsticker--real-feed-name feed-name-symbol))))
2415d4c6
UJ
734 (add-text-properties (point-min) (point)
735 (list 'face 'newsticker-feed-face
736 'mouse-face 'highlight
737 'help-echo "Visit in web browser."
738 :nt-link (newsticker--link item)
739 'keymap newsticker--treeview-url-keymap))
740 (setq pos (point))
5eddea0b 741
2415d4c6
UJ
742 (insert "\n\n")
743 ;; insert title
744 (setq pos (point))
745 (insert (newsticker--title item) "\n")
746 (set-marker marker1 pos)
747 (set-marker marker2 (point))
748 (newsticker--treeview-render-text marker1 marker2)
749 (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
750 (goto-char marker2)
751 (delete-char -1)
752 (insert "\n")
753 (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
754 (set-marker marker2 (point))
755 (when newsticker-justification
756 (fill-region marker1 marker2 newsticker-justification))
757 (goto-char marker2)
758 (add-text-properties marker1 (1- (point))
759 (list 'mouse-face 'highlight
760 'help-echo "Visit in web browser."
761 :nt-link (newsticker--link item)
762 'keymap newsticker--treeview-url-keymap))
763 (insert (format-time-string newsticker-date-format
764 (newsticker--time item)))
765 (insert "\n")
766 (setq pos (point))
767 (insert "\n")
768 ;; insert enclosures and rest at bottom
769 (goto-char (point-max))
770 (insert "\n\n")
771 (setq pos (point))
772 (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
773 (put-text-property pos (point) 'face 'newsticker-enclosure-face)
774 (setq pos (point))
775 (insert "\n")
776 (newsticker--print-extra-elements item newsticker--treeview-url-keymap)
777 (put-text-property pos (point) 'face 'newsticker-extra-face)
778 (goto-char (point-min)))))
779 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
780 item
781 (memq (newsticker--age item) '(new obsolete)))
782 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
783 (newsticker-treeview-mark-item-old t)
784 (newsticker--treeview-list-update-faces)))
c9aafaaf
UJ
785 (if (window-live-p (newsticker--treeview-item-window))
786 (set-window-point (newsticker--treeview-item-window) 1)))
2415d4c6
UJ
787
788(defun newsticker--treeview-item-update ()
789 "Update the treeview item buffer and window."
790 (save-excursion
c9aafaaf
UJ
791 (if (window-live-p (newsticker--treeview-item-window))
792 (set-window-buffer (newsticker--treeview-item-window)
793 (newsticker--treeview-item-buffer)))
2415d4c6
UJ
794 (set-buffer (newsticker--treeview-item-buffer))
795 (let ((inhibit-read-only t))
796 (erase-buffer))
0c74a301 797 (newsticker-treeview-item-mode)))
2415d4c6
UJ
798
799;; ======================================================================
800;;; Tree window
801;; ======================================================================
802(defun newsticker--treeview-tree-expand (tree)
803 "Expand TREE.
804Callback function for tree widget that adds nodes for feeds and subgroups."
2415d4c6
UJ
805 (tree-widget-set-theme "folder")
806 (let ((group (widget-get tree :nt-group))
807 (i 0)
808 (nt-id ""))
809 (mapcar (lambda (g)
810 (setq nt-id (newsticker--treeview-get-id tree i))
811 (setq i (1+ i))
812 (if (listp g)
813 (let* ((g-name (car g)))
814 `(tree-widget
815 :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
816 :expander newsticker--treeview-tree-expand
817 :expander-p (lambda (&rest ignore) t)
818 :nt-group ,(cdr g)
819 :nt-feed ,g-name
820 :nt-id ,nt-id
821 :keep (:nt-feed :num-new :nt-id :open);; :nt-group
822 :open nil))
823 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
824 `(item :tag ,tag
825 :leaf-icon newsticker--tree-widget-leaf-icon
826 :nt-feed ,g
827 :action newsticker--treeview-list-feed-items
828 :nt-id ,nt-id
829 :keep (:nt-id)
830 :open t))))
831 group)))
832
833(defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
834 event)
835 "Expand the vfeed TREE.
836Optional arguments CHANGED-WIDGET and EVENT are ignored."
837 (tree-widget-set-theme "folder")
838 (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
839 :nt-vfeed "new"
840 :action newsticker--treeview-list-new-items
841 :nt-id ,(newsticker--treeview-get-id tree 0)
842 :keep (:nt-id))
843 `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
844 :nt-vfeed "immortal"
845 :action newsticker--treeview-list-immortal-items
846 :nt-id ,(newsticker--treeview-get-id tree 1)
847 :keep (:nt-id))
848 `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
849 :nt-vfeed "obsolete"
850 :action newsticker--treeview-list-obsolete-items
851 :nt-id ,(newsticker--treeview-get-id tree 2)
852 :keep (:nt-id))
853 `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
854 :nt-vfeed "all"
855 :action newsticker--treeview-list-all-items
856 :nt-id ,(newsticker--treeview-get-id tree 3)
857 :keep (:nt-id))))
858
859(defun newsticker--treeview-virtual-feed-p (feed-name)
860 "Return non-nil if FEED-NAME is a virtual feed."
861 (string-match "\\*.*\\*" feed-name))
862
863(define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
864 "Icon for a tree-widget leaf node."
865 :tag "O"
866 :glyph-name "leaf"
867 :button-face 'default)
868
869(defun newsticker--treeview-tree-update ()
870 "Update treeview tree buffer and window."
871 (save-excursion
c9aafaaf
UJ
872 (if (window-live-p (newsticker--treeview-tree-window))
873 (set-window-buffer (newsticker--treeview-tree-window)
874 (newsticker--treeview-tree-buffer)))
2415d4c6
UJ
875 (set-buffer (newsticker--treeview-tree-buffer))
876 (kill-all-local-variables)
877 (let ((inhibit-read-only t))
878 (erase-buffer)
879 (tree-widget-set-theme "folder")
880 (setq newsticker--treeview-feed-tree
881 (widget-create 'tree-widget
882 :tag (newsticker--treeview-propertize-tag
883 "Feeds" 0 "feeds")
884 :expander 'newsticker--treeview-tree-expand
885 :expander-p (lambda (&rest ignore) t)
886 :leaf-icon 'newsticker--tree-widget-leaf-icon
887 :nt-group (cdr newsticker-groups)
888 :nt-id "feeds"
889 :keep '(:nt-id)
890 :open t))
891 (setq newsticker--treeview-vfeed-tree
892 (widget-create 'tree-widget
893 :tag (newsticker--treeview-propertize-tag
894 "Virtual Feeds" 0 "vfeeds")
895 :expander 'newsticker--treeview-tree-expand-status
896 :expander-p (lambda (&rest ignore) t)
897 :leaf-icon 'newsticker--tree-widget-leaf-icon
898 :nt-id "vfeeds"
899 :keep '(:nt-id)
900 :open t))
901 (use-local-map widget-keymap)
902 (widget-setup))
903 (newsticker-treeview-mode)))
904
905(defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
906 vfeed)
907 "Return propertized copy of string TAG.
908Optional argument NUM-NEW is used for choosing face, other
909arguments NT-ID, FEED, and VFEED are added as properties."
910 ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
911 (let ((face 'newsticker-treeview-face)
912 (map (make-sparse-keymap)))
913 (if (and num-new (> num-new 0))
914 (setq face 'newsticker-treeview-new-face))
915 (define-key map [mouse-1] 'newsticker-treeview-tree-click)
916 (define-key map "\n" 'newsticker-treeview-tree-do-click)
917 (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
918 (propertize tag 'face face 'keymap map
919 :nt-id nt-id
920 :nt-feed feed
921 :nt-vfeed vfeed
639fbfe1 922 'help-echo tag
2415d4c6
UJ
923 'mouse-face 'highlight)))
924
925(defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
926 &optional nt-id)
927 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
928Optional argument NT-ID is added to the tag's properties."
929 (let (tag (num-new 0))
930 (cond (vfeed-name
931 (cond ((string= vfeed-name "new")
932 (setq num-new (newsticker--stat-num-items-total 'new))
933 (setq tag (format "New items (%d)" num-new)))
934 ((string= vfeed-name "immortal")
935 (setq num-new (newsticker--stat-num-items-total 'immortal))
936 (setq tag (format "Immortal items (%d)" num-new)))
937 ((string= vfeed-name "obsolete")
938 (setq num-new (newsticker--stat-num-items-total 'obsolete))
939 (setq tag (format "Obsolete items (%d)" num-new)))
940 ((string= vfeed-name "all")
941 (setq num-new (newsticker--stat-num-items-total))
942 (setq tag (format "All items (%d)" num-new)))))
943 (feed-name
944 (setq num-new (newsticker--stat-num-items-for-group
945 (intern feed-name) 'new 'immortal))
946 (setq tag
947 (format "%s (%d)"
948 (newsticker--real-feed-name (intern feed-name))
949 num-new))))
950 (if tag
951 (newsticker--treeview-propertize-tag tag num-new
952 nt-id
953 feed-name vfeed-name))))
954
955(defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
956 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
957 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
958 (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
959 (mapc (lambda (f-n)
960 (setq result (+ result
961 (apply 'newsticker--stat-num-items (intern f-n)
962 ages))))
963 (newsticker--group-get-feeds
964 (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
965 result))
966
967(defun newsticker--treeview-count-node-items (feed &optional isvirtual)
968 "Count number of relevant items for a treeview node.
969FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
970the feed is a virtual feed."
971 (let* ((num-new 0))
972 (if feed
973 (if isvirtual
974 (cond ((string= feed "new")
975 (setq num-new (newsticker--stat-num-items-total 'new)))
976 ((string= feed "immortal")
977 (setq num-new (newsticker--stat-num-items-total 'immortal)))
978 ((string= feed "obsolete")
979 (setq num-new (newsticker--stat-num-items-total 'obsolete)))
980 ((string= feed "all")
981 (setq num-new (newsticker--stat-num-items-total))))
982 (setq num-new (newsticker--stat-num-items-for-group
983 (intern feed) 'new 'immortal))))
984 num-new))
985
986(defun newsticker--treeview-tree-update-tag (w &optional recursive
987 &rest ignore)
988 "Update tag for tree widget W.
989If RECURSIVE is non-nil recursively update parent widgets as
990well. Argument IGNORE is ignored. Note that this function, if
991called recursively, makes w invalid. You should keep w's nt-id in
992that case."
2415d4c6
UJ
993 (let* ((parent (widget-get w :parent))
994 (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
995 (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
996 (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
997 (num-new (newsticker--treeview-count-node-items (or feed vfeed)
998 vfeed))
999 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
1000 (n (widget-get w :node)))
1001 (if parent
1002 (if recursive
1003 (newsticker--treeview-tree-update-tag parent)))
1004 (when tag
1005 (when n
1006 (widget-put n :tag tag))
1007 (widget-put w :num-new num-new)
1008 (widget-put w :tag tag)
1009 (when (marker-position (widget-get w :from))
1010 (let ((p (point))
1011 (notify (widget-get w :notify)))
1012 ;; FIXME: This moves point!!!!
9a529312 1013 (with-current-buffer (newsticker--treeview-tree-buffer)
2415d4c6
UJ
1014 (widget-value-set w (widget-value w)))
1015 (goto-char p))))))
a66bb4d5 1016
2415d4c6
UJ
1017(defun newsticker--treeview-tree-do-update-tags (widget)
1018 "Actually recursively update tags for WIDGET."
1019 (save-excursion
1020 (let ((children (widget-get widget :children)))
1021 (dolist (w children)
1022 (newsticker--treeview-tree-do-update-tags w))
1023 (newsticker--treeview-tree-update-tag widget))))
1024
1025(defun newsticker--treeview-tree-update-tags (&rest ignore)
1026 "Update all tags of all trees.
1027Arguments IGNORE are ignored."
1028 (save-current-buffer
1029 (set-buffer (newsticker--treeview-tree-buffer))
1030 (let ((inhibit-read-only t))
1031 (newsticker--treeview-tree-do-update-tags
1032 newsticker--treeview-feed-tree)
1033 (newsticker--treeview-tree-do-update-tags
1034 newsticker--treeview-vfeed-tree))
1035 (tree-widget-set-theme "folder")))
1036
1037(defun newsticker--treeview-tree-update-highlight ()
1038 "Update highlight in tree buffer."
1039 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
1040 (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
1041 (setq pos (widget-get (widget-get
1042 (newsticker--treeview-get-current-node)
1043 :parent) :from)))
1044 (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
9a529312 1045 (with-current-buffer (newsticker--treeview-tree-buffer)
2415d4c6
UJ
1046 (goto-char pos)
1047 (move-overlay newsticker--tree-selection-overlay
2d84f804 1048 (point-at-bol) (1+ (point-at-eol))
2415d4c6 1049 (current-buffer)))
c9aafaaf
UJ
1050 (if (window-live-p (newsticker--treeview-tree-window))
1051 (set-window-point (newsticker--treeview-tree-window) pos)))))
2415d4c6
UJ
1052
1053;; ======================================================================
1054;;; Toolbar
1055;; ======================================================================
2415d4c6
UJ
1056(defvar newsticker-treeview-tool-bar-map
1057 (if (featurep 'xemacs)
1058 nil
a66bb4d5
GM
1059 (if (boundp 'tool-bar-map)
1060 (let ((tool-bar-map (make-sparse-keymap)))
42c7e61e
UJ
1061 (tool-bar-add-item "newsticker/prev-feed"
1062 'newsticker-treeview-prev-feed
1063 'newsticker-treeview-prev-feed
1064 :help "Go to previous feed"
1065 ;;:enable '(newsticker-previous-feed-available-p) FIXME
1066 )
1067 (tool-bar-add-item "newsticker/prev-item"
1068 'newsticker-treeview-prev-item
1069 'newsticker-treeview-prev-item
1070 :help "Go to previous item"
1071 ;;:enable '(newsticker-previous-item-available-p) FIXME
1072 )
1073 (tool-bar-add-item "newsticker/next-item"
1074 'newsticker-treeview-next-item
1075 'newsticker-treeview-next-item
1076 :visible t
1077 :help "Go to next item"
1078 ;;:enable '(newsticker-next-item-available-p) FIXME
1079 )
1080 (tool-bar-add-item "newsticker/next-feed"
1081 'newsticker-treeview-next-feed
1082 'newsticker-treeview-next-feed
1083 :help "Go to next feed"
1084 ;;:enable '(newsticker-next-feed-available-p) FIXME
1085 )
1086 (tool-bar-add-item "newsticker/mark-immortal"
1087 'newsticker-treeview-toggle-item-immortal
1088 'newsticker-treeview-toggle-item-immortal
1089 :help "Toggle current item as immortal"
1090 ;;:enable '(newsticker-item-not-immortal-p) FIXME
1091 )
1092 (tool-bar-add-item "newsticker/mark-read"
1093 'newsticker-treeview-mark-item-old
1094 'newsticker-treeview-mark-item-old
1095 :help "Mark current item as read"
1096 ;;:enable '(newsticker-item-not-old-p) FIXME
1097 )
1098 (tool-bar-add-item "newsticker/get-all"
1099 'newsticker-get-all-news
1100 'newsticker-get-all-news
1101 :help "Get news for all feeds")
1102 (tool-bar-add-item "newsticker/update"
1103 'newsticker-treeview-update
1104 'newsticker-treeview-update
1105 :help "Update newsticker buffer")
1106 (tool-bar-add-item "newsticker/browse-url"
1107 'newsticker-browse-url
1108 'newsticker-browse-url
1109 :help "Browse URL for item at point")
1110 ;; standard icons / actions
a66bb4d5
GM
1111 (define-key tool-bar-map [newsticker-sep-1]
1112 (list 'menu-item "--double-line"))
a66bb4d5
GM
1113 (tool-bar-add-item "close"
1114 'newsticker-treeview-quit
1115 'newsticker-treeview-quit
1116 :help "Close newsticker")
1117 (tool-bar-add-item "preferences"
1118 'newsticker-customize
1119 'newsticker-customize
1120 :help "Customize newsticker")
1121 tool-bar-map))))
2415d4c6
UJ
1122
1123;; ======================================================================
1124;;; actions
1125;; ======================================================================
1126
1127(defun newsticker-treeview-mouse-browse-url (event)
1128 "Call `browse-url' for the link of the item at which the EVENT occurred."
1129 (interactive "e")
1130 (save-excursion
1131 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1132 (let ((url (get-text-property (posn-point (event-end event))
1133 :nt-link)))
1134 (when url
1135 (browse-url url)
1136 (if newsticker-automatically-mark-visited-items-as-old
1137 (newsticker-treeview-mark-item-old))))))
1138
1139(defun newsticker-treeview-browse-url ()
1140 "Call `browse-url' for the link of the item at point."
1141 (interactive)
9a529312 1142 (with-current-buffer (newsticker--treeview-list-buffer)
2415d4c6
UJ
1143 (let ((url (get-text-property (point) :nt-link)))
1144 (when url
1145 (browse-url url)
1146 (if newsticker-automatically-mark-visited-items-as-old
1147 (newsticker-treeview-mark-item-old))))))
1148
1149(defun newsticker--treeview-buffer-init ()
1150 "Initialize all treeview buffers."
1151 (setq newsticker--treeview-buffers nil)
1152 (add-to-list 'newsticker--treeview-buffers
1153 (get-buffer-create "*Newsticker Tree*") t)
1154 (add-to-list 'newsticker--treeview-buffers
1155 (get-buffer-create "*Newsticker List*") t)
1156 (add-to-list 'newsticker--treeview-buffers
1157 (get-buffer-create "*Newsticker Item*") t)
1158
1159 (unless newsticker--selection-overlay
9a529312 1160 (with-current-buffer (newsticker--treeview-list-buffer)
2415d4c6
UJ
1161 (setq newsticker--selection-overlay (make-overlay (point-min)
1162 (point-max)))
1163 (overlay-put newsticker--selection-overlay 'face
1164 'newsticker-treeview-selection-face)))
1165 (unless newsticker--tree-selection-overlay
9a529312 1166 (with-current-buffer (newsticker--treeview-tree-buffer)
2415d4c6
UJ
1167 (setq newsticker--tree-selection-overlay (make-overlay (point-min)
1168 (point-max)))
1169 (overlay-put newsticker--tree-selection-overlay 'face
1170 'newsticker-treeview-selection-face)))
1171
1172 (newsticker--treeview-tree-update)
1173 (newsticker--treeview-list-update t)
1174 (newsticker--treeview-item-update))
1175
1176(defun newsticker-treeview-update ()
c9aafaaf
UJ
1177 "Update all treeview buffers and windows.
1178Note: does not update the layout."
2415d4c6 1179 (interactive)
0c74a301 1180 (let ((cur-item (newsticker--treeview-get-selected-item)))
dba0634a
UJ
1181 (if (newsticker--group-manage-orphan-feeds)
1182 (newsticker--treeview-tree-update))
0c74a301
UJ
1183 (newsticker--treeview-list-update t)
1184 (newsticker--treeview-item-update)
1185 (newsticker--treeview-tree-update-tags)
1186 (cond (newsticker--treeview-current-feed
1187 (newsticker--treeview-list-items newsticker--treeview-current-feed))
1188 (newsticker--treeview-current-vfeed
1189 (newsticker--treeview-list-items-with-age
1190 (intern newsticker--treeview-current-vfeed))))
1191 (newsticker--treeview-tree-update-highlight)
1192 (newsticker--treeview-list-update-highlight)
1193 (let ((cur-feed (or newsticker--treeview-current-feed
1194 newsticker--treeview-current-vfeed)))
1195 (if (and cur-feed cur-item)
1196 (newsticker--treeview-list-select cur-item)))))
2415d4c6
UJ
1197
1198(defun newsticker-treeview-quit ()
1199 "Quit newsticker treeview."
1200 (interactive)
2415d4c6 1201 (setq newsticker--sentinel-callback nil)
2415d4c6
UJ
1202 (bury-buffer "*Newsticker Tree*")
1203 (bury-buffer "*Newsticker List*")
1204 (bury-buffer "*Newsticker Item*")
1205 (set-window-configuration newsticker--saved-window-config)
1206 (when newsticker--frame
1207 (if (frame-live-p newsticker--frame)
1208 (delete-frame newsticker--frame))
77a01f9b
UJ
1209 (setq newsticker--frame nil))
1210 (newsticker-treeview-save))
2415d4c6
UJ
1211
1212(defun newsticker-treeview-save ()
1213 "Save newsticker data including treeview settings."
1214 (interactive)
9a529312
SM
1215 (let ((coding-system-for-write 'utf-8)
1216 (buf (find-file-noselect (concat newsticker-dir "/groups"))))
1217 (when buf
1218 (with-current-buffer buf
2415d4c6
UJ
1219 (setq buffer-undo-list t)
1220 (erase-buffer)
1221 (insert ";; -*- coding: utf-8 -*-\n")
1222 (insert (prin1-to-string newsticker-groups))
908e900d
UJ
1223 (save-buffer)
1224 (kill-buffer)))))
2415d4c6
UJ
1225
1226(defun newsticker--treeview-load ()
1227 "Load treeview settings."
1228 (let* ((coding-system-for-read 'utf-8)
a59c6c51
UJ
1229 (filename
1230 (or (and (file-exists-p newsticker-groups-filename)
1231 (y-or-n-p
1232 (format "Old newsticker groups (%s) file exists. Read it? "
1233 newsticker-groups-filename))
1234 newsticker-groups-filename)
1235 (concat newsticker-dir "/groups")))
77a01f9b
UJ
1236 (buf (and (file-exists-p filename)
1237 (find-file-noselect filename))))
12272241
JB
1238 (and (file-exists-p newsticker-groups-filename)
1239 (y-or-n-p (format "Delete old newsticker groups file? "))
1240 (delete-file newsticker-groups-filename))
2415d4c6
UJ
1241 (when buf
1242 (set-buffer buf)
1243 (goto-char (point-min))
1244 (condition-case nil
1245 (setq newsticker-groups (read buf))
1246 (error
1247 (message "Error while reading newsticker groups file!")
908e900d
UJ
1248 (setq newsticker-groups nil)))
1249 (kill-buffer buf))))
2415d4c6
UJ
1250
1251
1252(defun newsticker-treeview-scroll-item ()
1253 "Scroll current item."
1254 (interactive)
1255 (save-selected-window
1256 (select-window (newsticker--treeview-item-window) t)
1257 (scroll-up 1)))
1258
1259(defun newsticker-treeview-show-item ()
1260 "Show current item."
1261 (interactive)
c9aafaaf 1262 (newsticker--treeview-restore-layout)
2415d4c6 1263 (newsticker--treeview-list-update-highlight)
9a529312 1264 (with-current-buffer (newsticker--treeview-list-buffer)
2415d4c6
UJ
1265 (beginning-of-line)
1266 (let ((item (get-text-property (point) :nt-item))
1267 (feed (get-text-property (point) :nt-feed)))
1268 (newsticker--treeview-item-show item feed)))
1269 (newsticker--treeview-tree-update-tag
1270 (newsticker--treeview-get-current-node) t)
1271 (newsticker--treeview-tree-update-highlight))
1272
1273(defun newsticker-treeview-next-item ()
1274 "Move to next item."
1275 (interactive)
c9aafaaf 1276 (newsticker--treeview-restore-layout)
2415d4c6
UJ
1277 (save-current-buffer
1278 (set-buffer (newsticker--treeview-list-buffer))
1279 (if (newsticker--treeview-list-highlight-start)
1280 (forward-line 1))
1281 (if (eobp)
1282 (forward-line -1)))
1283 (newsticker-treeview-show-item))
1284
1285(defun newsticker-treeview-prev-item ()
1286 "Move to previous item."
1287 (interactive)
c9aafaaf 1288 (newsticker--treeview-restore-layout)
2415d4c6
UJ
1289 (save-current-buffer
1290 (set-buffer (newsticker--treeview-list-buffer))
1291 (forward-line -1))
1292 (newsticker-treeview-show-item))
1293
a8c98868 1294(defun newsticker-treeview-next-new-or-immortal-item (&optional
201af049
UJ
1295 current-item-counts
1296 dont-wrap-trees)
a8c98868
UJ
1297 "Move to next new or immortal item.
1298Will move to next feed until an item is found. Will not move if
1299optional argument CURRENT-ITEM-COUNTS is t and current item is
0c74a301
UJ
1300new or immortal. Will not move from virtual to ordinary feed
1301tree or vice versa if optional argument DONT-WRAP-TREES is non-nil."
2415d4c6 1302 (interactive)
c9aafaaf 1303 (newsticker--treeview-restore-layout)
2415d4c6 1304 (newsticker--treeview-list-clear-highlight)
a8c98868
UJ
1305 (unless (catch 'found
1306 (let ((move (not current-item-counts)))
1307 (while t
1308 (save-current-buffer
1309 (set-buffer (newsticker--treeview-list-buffer))
1310 (when move (forward-line 1)
1311 (when (eobp)
1312 (forward-line -1)
1313 (throw 'found nil))))
1314 (when (memq (newsticker--age
1315 (newsticker--treeview-get-selected-item))
1316 '(new immortal))
1317 (newsticker-treeview-show-item)
1318 (throw 'found t))
1319 (setq move t))))
201af049
UJ
1320 (let ((wrap-trees (not dont-wrap-trees)))
1321 (when (or (newsticker-treeview-next-feed t)
1322 (and wrap-trees (newsticker--treeview-first-feed)))
1323 (newsticker-treeview-next-new-or-immortal-item t t)))))
2415d4c6
UJ
1324
1325(defun newsticker-treeview-prev-new-or-immortal-item ()
a8c98868
UJ
1326 "Move to previous new or immortal item.
1327Will move to previous feed until an item is found."
2415d4c6 1328 (interactive)
c9aafaaf 1329 (newsticker--treeview-restore-layout)
2415d4c6 1330 (newsticker--treeview-list-clear-highlight)
a8c98868
UJ
1331 (unless (catch 'found
1332 (while t
1333 (save-current-buffer
1334 (set-buffer (newsticker--treeview-list-buffer))
1335 (when (bobp)
1336 (throw 'found nil))
1337 (forward-line -1))
1338 (when (memq (newsticker--age
1339 (newsticker--treeview-get-selected-item))
1340 '(new immortal))
1341 (newsticker-treeview-show-item)
1342 (throw 'found t))
1343 (when (bobp)
1344 (throw 'found nil))))
1345 (when (newsticker-treeview-prev-feed t)
1346 (set-buffer (newsticker--treeview-list-buffer))
1347 (goto-char (point-max))
1348 (newsticker-treeview-prev-new-or-immortal-item))))
2415d4c6
UJ
1349
1350(defun newsticker--treeview-get-selected-item ()
1351 "Return item that is currently selected in list buffer."
9a529312 1352 (with-current-buffer (newsticker--treeview-list-buffer)
2415d4c6
UJ
1353 (beginning-of-line)
1354 (get-text-property (point) :nt-item)))
1355
1356(defun newsticker-treeview-mark-item-old (&optional dont-proceed)
1357 "Mark current item as old unless it is obsolete.
1358Move to next item unless DONT-PROCEED is non-nil."
1359 (interactive)
1360 (let ((item (newsticker--treeview-get-selected-item)))
1361 (unless (eq (newsticker--age item) 'obsolete)
1362 (newsticker--treeview-mark-item item 'old)))
1363 (unless dont-proceed
1364 (newsticker-treeview-next-item)))
1365
1366(defun newsticker-treeview-toggle-item-immortal ()
1367 "Toggle immortality of current item."
1368 (interactive)
1369 (let* ((item (newsticker--treeview-get-selected-item))
1370 (new-age (if (eq (newsticker--age item) 'immortal)
1371 'old
1372 'immortal)))
1373 (newsticker--treeview-mark-item item new-age)
1374 (newsticker-treeview-next-item)))
1375
1376(defun newsticker--treeview-mark-item (item new-age)
1377 "Mark ITEM with NEW-AGE."
1378 (when item
1379 (setcar (nthcdr 4 item) new-age)
1380 ;; clean up ticker FIXME
c9aafaaf 1381 )
a59c6c51
UJ
1382 (newsticker--cache-save-feed
1383 (newsticker--cache-get-feed (intern newsticker--treeview-current-feed)))
1384 (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree))
2415d4c6
UJ
1385
1386(defun newsticker-treeview-mark-list-items-old ()
1387 "Mark all listed items as old."
1388 (interactive)
1389 (let ((current-feed (or newsticker--treeview-current-feed
1390 newsticker--treeview-current-vfeed)))
9a529312 1391 (with-current-buffer (newsticker--treeview-list-buffer)
2415d4c6
UJ
1392 (goto-char (point-min))
1393 (while (not (eobp))
1394 (let ((item (get-text-property (point) :nt-item)))
1395 (unless (memq (newsticker--age item) '(immortal obsolete))
1396 (newsticker--treeview-mark-item item 'old)))
1397 (forward-line 1)))
1398 (newsticker--treeview-tree-update-tags)
1399 (if current-feed
1400 (newsticker-treeview-jump current-feed))))
1401
1402(defun newsticker-treeview-save-item ()
1403 "Save current item."
1404 (interactive)
1405 (newsticker-save-item (or newsticker--treeview-current-feed
1406 newsticker--treeview-current-vfeed)
1407 (newsticker--treeview-get-selected-item)))
1408
4367e4b2
UJ
1409(defun newsticker-treeview-browse-url-item ()
1410 "Convert current item to HTML and call `browse-url' on result."
1411 (interactive)
1412 (newsticker-browse-url-item (or newsticker--treeview-current-feed
1413 newsticker--treeview-current-vfeed)
1414 (newsticker--treeview-get-selected-item)))
1415
2415d4c6
UJ
1416(defun newsticker--treeview-set-current-node (node)
1417 "Make NODE the current node."
9a529312 1418 (with-current-buffer (newsticker--treeview-tree-buffer)
2415d4c6
UJ
1419 (setq newsticker--treeview-current-node-id
1420 (widget-get node :nt-id))
1421 (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
1422 (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
2415d4c6
UJ
1423 (newsticker--treeview-tree-update-highlight)))
1424
1425(defun newsticker--treeview-get-first-child (node)
1426 "Get first child of NODE."
1427 (let ((children (widget-get node :children)))
1428 (if children
1429 (car children)
1430 nil)))
1431
1432(defun newsticker--treeview-get-second-child (node)
1433 "Get scond child of NODE."
1434 (let ((children (widget-get node :children)))
1435 (if children
1436 (car (cdr children))
1437 nil)))
1438
1439(defun newsticker--treeview-get-last-child (node)
1440 "Get last child of NODE."
1441 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1442 (let ((children (widget-get node :children)))
1443 (if children
1444 (car (reverse children))
1445 nil)))
1446
1447(defun newsticker--treeview-get-feed-vfeed (node)
1448 "Get (virtual) feed of NODE."
1449 (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
1450
1451(defun newsticker--treeview-get-next-sibling (node)
1452 "Get next sibling of NODE."
1453 (let ((parent (widget-get node :parent)))
1454 (catch 'found
1455 (let ((children (widget-get parent :children)))
1456 (while children
1457 (if (newsticker--treeview-nodes-eq (car children) node)
1458 (throw 'found (car (cdr children))))
1459 (setq children (cdr children)))))))
1460
1461(defun newsticker--treeview-get-prev-sibling (node)
1462 "Get previous sibling of NODE."
1463 (let ((parent (widget-get node :parent)))
1464 (catch 'found
1465 (let ((children (widget-get parent :children))
1466 (prev nil))
1467 (while children
1468 (if (and (newsticker--treeview-nodes-eq (car children) node)
1469 (widget-get prev :nt-id))
1470 (throw 'found prev))
1471 (setq prev (car children))
1472 (setq children (cdr children)))))))
1473
1474(defun newsticker--treeview-get-next-uncle (node)
1475 "Get next uncle of NODE, i.e. parent's next sibling."
1476 (let* ((parent (widget-get node :parent))
1477 (grand-parent (widget-get parent :parent)))
1478 (catch 'found
1479 (let ((uncles (widget-get grand-parent :children)))
1480 (while uncles
1481 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1482 (throw 'found (car (cdr uncles))))
1483 (setq uncles (cdr uncles)))))))
1484
1485(defun newsticker--treeview-get-prev-uncle (node)
1486 "Get previous uncle of NODE, i.e. parent's previous sibling."
1487 (let* ((parent (widget-get node :parent))
1488 (grand-parent (widget-get parent :parent)))
1489 (catch 'found
1490 (let ((uncles (widget-get grand-parent :children))
1491 (prev nil))
1492 (while uncles
1493 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1494 (throw 'found prev))
1495 (setq prev (car uncles))
1496 (setq uncles (cdr uncles)))))))
1497
1498(defun newsticker--treeview-get-other-tree ()
1499 "Get other tree."
1500 (if (and (newsticker--treeview-get-current-node)
1501 (widget-get (newsticker--treeview-get-current-node) :nt-feed))
1502 newsticker--treeview-vfeed-tree
1503 newsticker--treeview-feed-tree))
1504
1505(defun newsticker--treeview-activate-node (node &optional backward)
1506 "Activate NODE.
1507If NODE is a tree widget the node's first subnode is activated.
1508If BACKWARD is non-nil the last subnode of the previous sibling
1509is activated."
1510 (newsticker--treeview-set-current-node node)
1511 (save-current-buffer
1512 (set-buffer (newsticker--treeview-tree-buffer))
1513 (cond ((eq (widget-type node) 'tree-widget)
1514 (unless (widget-get node :open)
1515 (widget-put node :open nil)
1516 (widget-apply-action node))
1517 (newsticker--treeview-activate-node
1518 (if backward
1519 (newsticker--treeview-get-last-child node)
1520 (newsticker--treeview-get-second-child node))))
1521 (node
1522 (widget-apply-action node)))))
1523
80016d6e 1524(defun newsticker--treeview-first-feed ()
0c74a301 1525 "Jump to the depth-first feed in the `newsticker-groups' tree."
80016d6e
UJ
1526 (newsticker-treeview-jump
1527 (car (reverse (newsticker--group-get-feeds newsticker-groups t)))))
1528
a8c98868
UJ
1529(defun newsticker-treeview-next-feed (&optional stay-in-tree)
1530 "Move to next feed.
1531Optional argument STAY-IN-TREE prevents moving from real feed
1532tree to virtual feed tree or vice versa.
1533Return t if a new feed was activated, nil otherwise."
2415d4c6 1534 (interactive)
c9aafaaf 1535 (newsticker--treeview-restore-layout)
a8c98868
UJ
1536 (let ((cur (newsticker--treeview-get-current-node))
1537 (new nil))
80016d6e
UJ
1538 (setq new
1539 (if cur
1540 (or (newsticker--treeview-get-next-sibling cur)
1541 (newsticker--treeview-get-next-uncle cur)
1542 (and (not stay-in-tree)
1543 (newsticker--treeview-get-other-tree)))
1544 (car (widget-get newsticker--treeview-feed-tree :children))))
1545 (if new
1546 (progn
1547 (newsticker--treeview-activate-node new)
1548 (newsticker--treeview-tree-update-highlight)
1549 (not (eq new cur)))
a8c98868 1550 nil)))
2415d4c6 1551
a8c98868
UJ
1552(defun newsticker-treeview-prev-feed (&optional stay-in-tree)
1553 "Move to previous feed.
1554Optional argument STAY-IN-TREE prevents moving from real feed
1555tree to virtual feed tree or vice versa.
1556Return t if a new feed was activated, nil otherwise."
2415d4c6 1557 (interactive)
c9aafaaf 1558 (newsticker--treeview-restore-layout)
a8c98868
UJ
1559 (let ((cur (newsticker--treeview-get-current-node))
1560 (new nil))
2415d4c6 1561 (if cur
a8c98868
UJ
1562 (progn
1563 (setq new
1564 (if cur
1565 (or (newsticker--treeview-get-prev-sibling cur)
1566 (newsticker--treeview-get-prev-uncle cur)
1567 (and (not stay-in-tree)
1568 (newsticker--treeview-get-other-tree)))
1569 (car (widget-get newsticker--treeview-feed-tree :children))))
1570 (if new
1571 (progn
1572 (newsticker--treeview-activate-node new t)
1573 (newsticker--treeview-tree-update-highlight)
1574 (not (eq new cur)))
1575 nil))
1576 nil)))
12272241 1577
2415d4c6
UJ
1578(defun newsticker-treeview-next-page ()
1579 "Scroll item buffer."
1580 (interactive)
1581 (save-selected-window
1582 (select-window (newsticker--treeview-item-window) t)
1583 (condition-case nil
1584 (scroll-up nil)
1585 (error
1586 (goto-char (point-min))))))
1587
1588
1589(defun newsticker--treeview-unfold-node (feed-name)
1590 "Recursively show subtree above the node that represents FEED-NAME."
1591 (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
1592 (unless node
1593 (let* ((group-name (or (car (newsticker--group-find-group-for-feed
1594 feed-name))
1595 (newsticker--group-get-parent-group
1596 feed-name))))
1597 (newsticker--treeview-unfold-node group-name))
1598 (setq node (newsticker--treeview-get-node-of-feed feed-name)))
1599 (when node
9a529312 1600 (with-current-buffer (newsticker--treeview-tree-buffer)
2415d4c6
UJ
1601 (widget-put node :nt-selected t)
1602 (widget-apply-action node)
1603 (newsticker--treeview-set-current-node node)))))
1604
1605(defun newsticker-treeview-jump (feed-name)
1606 "Jump to feed FEED-NAME in newsticker treeview."
1607 (interactive
1608 (list (let ((completion-ignore-case t))
2415d4c6
UJ
1609 (completing-read
1610 "Jump to feed: "
b0f439fc
UJ
1611 (append '("new" "obsolete" "immortal" "all")
1612 (mapcar 'car (append newsticker-url-list
1613 newsticker-url-list-defaults)))
1614 nil t))))
2415d4c6
UJ
1615 (newsticker--treeview-unfold-node feed-name))
1616
1617;; ======================================================================
1618;;; Groups
1619;; ======================================================================
1620(defun newsticker--group-do-find-group-for-feed (feed-name node)
1621 "Recursively find FEED-NAME in NODE."
1622 (if (member feed-name (cdr node))
1623 (throw 'found node)
1624 (mapc (lambda (n)
1625 (if (listp n)
1626 (newsticker--group-do-find-group-for-feed feed-name n)))
1627 (cdr node))))
1628
1629(defun newsticker--group-find-group-for-feed (feed-name)
1630 "Find group containing FEED-NAME."
1631 (catch 'found
1632 (newsticker--group-do-find-group-for-feed feed-name
1633 newsticker-groups)
1634 nil))
1635
1636(defun newsticker--group-do-get-group (name node)
1637 "Recursively find group with NAME below NODE."
1638 (if (string= name (car node))
1639 (throw 'found node)
1640 (mapc (lambda (n)
1641 (if (listp n)
1642 (newsticker--group-do-get-group name n)))
1643 (cdr node))))
1644
1645(defun newsticker--group-get-group (name)
1646 "Find group with NAME."
1647 (catch 'found
1648 (mapc (lambda (n)
1649 (if (listp n)
1650 (newsticker--group-do-get-group name n)))
1651 newsticker-groups)
1652 nil))
1653
1654(defun newsticker--group-do-get-parent-group (name node parent)
1655 "Recursively find parent group for NAME from NODE which is a child of PARENT."
1656 (if (string= name (car node))
1657 (throw 'found parent)
1658 (mapc (lambda (n)
1659 (if (listp n)
1660 (newsticker--group-do-get-parent-group name n (car node))))
1661 (cdr node))))
1662
1663(defun newsticker--group-get-parent-group (name)
1664 "Find parent group for group named NAME."
1665 (catch 'found
1666 (mapc (lambda (n)
1667 (if (listp n)
1668 (newsticker--group-do-get-parent-group
1669 name n (car newsticker-groups))))
1670 newsticker-groups)
1671 nil))
1672
1673
1674(defun newsticker--group-get-subgroups (group &optional recursive)
1675 "Return list of subgroups for GROUP.
1676If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1677 (let ((result nil))
1678 (mapc (lambda (n)
1679 (when (listp n)
1680 (setq result (cons (car n) result))
1681 (let ((subgroups (newsticker--group-get-subgroups n recursive)))
1682 (when subgroups
1683 (setq result (append subgroups result))))))
1684 group)
1685 result))
1686
1687(defun newsticker--group-all-groups ()
1688 "Return nested list of all groups."
1689 (newsticker--group-get-subgroups newsticker-groups t))
1690
1691(defun newsticker--group-get-feeds (group &optional recursive)
1692 "Return list of all feeds in GROUP.
1693If RECURSIVE is non-nil recursively get feeds of subgroups and
1694return a nested list."
1695 (let ((result nil))
1696 (mapc (lambda (n)
1697 (if (not (listp n))
1698 (setq result (cons n result))
1699 (if recursive
1700 (let ((subfeeds (newsticker--group-get-feeds n t)))
1701 (when subfeeds
1702 (setq result (append subfeeds result)))))))
80016d6e 1703 (cdr group))
2415d4c6
UJ
1704 result))
1705
1706(defun newsticker-group-add-group (name parent)
1707 "Add group NAME to group PARENT."
1708 (interactive
1709 (list (read-string "Group Name: ")
1710 (let ((completion-ignore-case t))
2415d4c6
UJ
1711 (completing-read "Parent Group: " (newsticker--group-all-groups)
1712 nil t))))
2415d4c6
UJ
1713 (if (newsticker--group-get-group name)
1714 (error "Group %s exists already" name))
1715 (let ((p (if (and parent (not (string= parent "")))
1716 (newsticker--group-get-group parent)
1717 newsticker-groups)))
1718 (unless p
1719 (error "Parent %s does not exist" parent))
1720 (setcdr p (cons (list name) (cdr p))))
1721 (newsticker--treeview-tree-update))
1722
1723(defun newsticker-group-move-feed (name group-name &optional no-update)
1724 "Move feed NAME to group GROUP-NAME.
204f3953 1725Update treeview afterwards unless NO-UPDATE is non-nil."
2415d4c6
UJ
1726 (interactive
1727 (let ((completion-ignore-case t))
2415d4c6
UJ
1728 (list (completing-read "Feed Name: "
1729 (mapcar 'car newsticker-url-list)
1730 nil t newsticker--treeview-current-feed)
1731 (completing-read "Group Name: " (newsticker--group-all-groups)
1732 nil t))))
2415d4c6
UJ
1733 (let ((group (if (and group-name (not (string= group-name "")))
1734 (newsticker--group-get-group group-name)
1735 newsticker-groups)))
1736 (unless group
1737 (error "Group %s does not exist" group-name))
1738 (while (let ((old-group
1739 (newsticker--group-find-group-for-feed name)))
1740 (when old-group
1741 (delete name old-group))
1742 old-group))
1743 (setcdr group (cons name (cdr group)))
1744 (unless no-update
1745 (newsticker--treeview-tree-update)
1746 (newsticker-treeview-update))))
1747
1748(defun newsticker-group-delete-group (name)
1749 "Remove group NAME."
1750 (interactive
1751 (let ((completion-ignore-case t))
2415d4c6
UJ
1752 (list (completing-read "Group Name: " (newsticker--group-all-groups)
1753 nil t))))
2415d4c6
UJ
1754 (let* ((g (newsticker--group-get-group name))
1755 (p (or (newsticker--group-get-parent-group name)
1756 newsticker-groups)))
1757 (unless g
1758 (error "Group %s does not exist" name))
1759 (delete g p))
1760 (newsticker--treeview-tree-update))
1761
1762(defun newsticker--count-groups (group)
1763 "Recursively count number of subgroups of GROUP."
1764 (let ((result 1))
1765 (mapc (lambda (g)
1766 (if (listp g)
1767 (setq result (+ result (newsticker--count-groups g)))))
1768 (cdr group))
1769 result))
1770
1771(defun newsticker--count-grouped-feeds (group)
1772 "Recursively count number of feeds in GROUP and its subgroups."
1773 (let ((result 0))
1774 (mapc (lambda (g)
1775 (if (listp g)
1776 (setq result (+ result (newsticker--count-grouped-feeds g)))
1777 (setq result (1+ result))))
1778 (cdr group))
1779 result))
1780
1781(defun newsticker--group-remove-obsolete-feeds (group)
e1dbe924 1782 "Recursively remove obsolete feeds from GROUP."
2415d4c6
UJ
1783 (let ((result nil)
1784 (urls (append newsticker-url-list newsticker-url-list-defaults)))
1785 (mapc (lambda (g)
1786 (if (listp g)
1787 (let ((sub-groups
1788 (newsticker--group-remove-obsolete-feeds g)))
1789 (if sub-groups
1790 (setq result (cons sub-groups result))))
1791 (if (assoc g urls)
1792 (setq result (cons g result)))))
1793 (cdr group))
1794 (if result
1795 (cons (car group) (reverse result))
1796 result)))
1797
1798(defun newsticker--group-manage-orphan-feeds ()
1799 "Put unmanaged feeds into `newsticker-groups'.
dba0634a
UJ
1800Remove obsolete feeds as well.
1801Return t if groups have changed, nil otherwise."
574ec565
UJ
1802 (unless newsticker-groups
1803 (setq newsticker-groups '("Feeds")))
2415d4c6
UJ
1804 (let ((new-feed nil)
1805 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
1806 (mapc (lambda (f)
1807 (unless (newsticker--group-find-group-for-feed (car f))
1808 (setq new-feed t)
1809 (newsticker-group-move-feed (car f) nil t)))
1810 (append newsticker-url-list-defaults newsticker-url-list))
1811 (setq newsticker-groups
1812 (newsticker--group-remove-obsolete-feeds newsticker-groups))
dba0634a
UJ
1813 (or new-feed
1814 (not (= grouped-feeds
1815 (newsticker--count-grouped-feeds newsticker-groups))))))
2415d4c6
UJ
1816
1817;; ======================================================================
1818;;; Modes
1819;; ======================================================================
1820(defun newsticker--treeview-create-groups-menu (group-list
1821 excluded-group)
1822 "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
1823 (let ((menu (make-sparse-keymap (if (stringp (car group-list))
1824 (car group-list)
1825 "Move to group..."))))
1826 (mapc (lambda (g)
1827 (when (listp g)
1828 (let ((title (if (stringp (car g))
1829 (car g)
1830 "Move to group...")))
1831 (unless (eq g excluded-group)
1832 (define-key menu (vector (intern title))
1833 (list 'menu-item title
1834 (newsticker--treeview-create-groups-menu
1835 (cdr g) excluded-group)))))))
1836 (reverse group-list))
1837 menu))
1838
1839(defun newsticker--treeview-create-tree-menu (feed-name)
1840 "Create tree menu for FEED-NAME."
1841 (let ((menu (make-sparse-keymap feed-name)))
1842 (define-key menu [newsticker-treeview-mark-list-items-old]
1843 (list 'menu-item "Mark all items old"
1844 'newsticker-treeview-mark-list-items-old))
1845 (define-key menu [move]
1846 (list 'menu-item "Move to group..."
1847 (newsticker--treeview-create-groups-menu
1848 newsticker-groups
1849 (newsticker--group-get-group feed-name))))
1850 menu))
1851
2415d4c6
UJ
1852(defvar newsticker-treeview-list-menu
1853 (let ((menu (make-sparse-keymap "Newsticker List")))
1854 (define-key menu [newsticker-treeview-mark-list-items-old]
1855 (list 'menu-item "Mark all items old"
1856 'newsticker-treeview-mark-list-items-old))
0c74a301
UJ
1857 (define-key menu [newsticker-treeview-mark-item-old]
1858 (list 'menu-item "Mark current item old"
1859 'newsticker-treeview-mark-item-old))
1860 (define-key menu [newsticker-treeview-toggle-item-immortal]
1861 (list 'menu-item "Mark current item immortal (toggle)"
1862 'newsticker-treeview-toggle-item-immortal))
1863 (define-key menu [newsticker-treeview-get-news]
1864 (list 'menu-item "Get news for current feed"
1865 'newsticker-treeview-get-news))
2415d4c6 1866 menu)
0c74a301
UJ
1867 "Map for newsticker list menu.")
1868
1869(defvar newsticker-treeview-item-menu
1870 (let ((menu (make-sparse-keymap "Newsticker Item")))
1871 (define-key menu [newsticker-treeview-mark-item-old]
1872 (list 'menu-item "Mark current item old"
1873 'newsticker-treeview-mark-item-old))
1874 (define-key menu [newsticker-treeview-toggle-item-immortal]
1875 (list 'menu-item "Mark current item immortal (toggle)"
1876 'newsticker-treeview-toggle-item-immortal))
1877 (define-key menu [newsticker-treeview-get-news]
1878 (list 'menu-item "Get news for current feed"
1879 'newsticker-treeview-get-news))
1880 menu)
1881 "Map for newsticker item menu.")
2415d4c6 1882
2415d4c6
UJ
1883(defvar newsticker-treeview-mode-map
1884 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
1885 (define-key map " " 'newsticker-treeview-next-page)
1886 (define-key map "a" 'newsticker-add-url)
4367e4b2 1887 (define-key map "b" 'newsticker-treeview-browse-url-item)
2415d4c6
UJ
1888 (define-key map "F" 'newsticker-treeview-prev-feed)
1889 (define-key map "f" 'newsticker-treeview-next-feed)
1890 (define-key map "g" 'newsticker-treeview-get-news)
1891 (define-key map "G" 'newsticker-get-all-news)
1892 (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
1893 (define-key map "j" 'newsticker-treeview-jump)
1894 (define-key map "n" 'newsticker-treeview-next-item)
1895 (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
1896 (define-key map "O" 'newsticker-treeview-mark-list-items-old)
1897 (define-key map "o" 'newsticker-treeview-mark-item-old)
1898 (define-key map "p" 'newsticker-treeview-prev-item)
1899 (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
1900 (define-key map "q" 'newsticker-treeview-quit)
1901 (define-key map "S" 'newsticker-treeview-save-item)
1902 (define-key map "s" 'newsticker-treeview-save)
1903 (define-key map "u" 'newsticker-treeview-update)
1904 (define-key map "v" 'newsticker-treeview-browse-url)
1905 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
1906 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
1907 (define-key map "\M-m" 'newsticker-group-move-feed)
1908 (define-key map "\M-a" 'newsticker-group-add-group)
1909 map)
1910 "Mode map for newsticker treeview.")
1911
1b3b87df 1912(define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV"
2415d4c6
UJ
1913 "Major mode for Newsticker Treeview.
1914\\{newsticker-treeview-mode-map}"
a66bb4d5
GM
1915 (if (boundp 'tool-bar-map)
1916 (set (make-local-variable 'tool-bar-map)
1917 newsticker-treeview-tool-bar-map))
2415d4c6
UJ
1918 (setq buffer-read-only t
1919 truncate-lines t))
1920
2415d4c6
UJ
1921(define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
1922 "Item List"
1923 (let ((header (concat
1924 (propertize " " 'display '(space :align-to 0))
1925 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
1926 (propertize " " 'display '(space :align-to 2))
1927 (if newsticker--treeview-list-show-feed
1928 (concat "Feed"
1929 (propertize " " 'display '(space :align-to 12)))
1930 "")
1931 (newsticker-treeview-list-make-sort-button "Date"
1932 'sort-by-time)
1933 (if newsticker--treeview-list-show-feed
1934 (propertize " " 'display '(space :align-to 28))
1935 (propertize " " 'display '(space :align-to 18)))
1936 (newsticker-treeview-list-make-sort-button "Title"
1937 'sort-by-title))))
1938 (setq header-line-format header))
1939 (define-key newsticker-treeview-list-mode-map [down-mouse-3]
1940 newsticker-treeview-list-menu))
1941
0c74a301
UJ
1942(define-derived-mode newsticker-treeview-item-mode newsticker-treeview-mode
1943 "Item"
1944 (define-key newsticker-treeview-item-mode-map [down-mouse-3]
1945 newsticker-treeview-item-menu))
1946
2415d4c6
UJ
1947(defun newsticker-treeview-tree-click (event)
1948 "Handle click EVENT on a tag in the newsticker tree."
1949 (interactive "e")
c9aafaaf 1950 (newsticker--treeview-restore-layout)
2415d4c6
UJ
1951 (save-excursion
1952 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1953 (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
1954
1955(defun newsticker-treeview-tree-do-click (&optional pos event)
1956 "Actually handle click event.
1957POS gives the position where EVENT occurred."
1958 (interactive)
a59c6c51
UJ
1959 (let* ((pos (or pos (point)))
1960 (nt-id (get-text-property pos :nt-id))
1961 (item (get-text-property pos :nt-item)))
2415d4c6
UJ
1962 (cond (item
1963 ;; click in list buffer
1964 (newsticker-treeview-show-item))
1965 (t
1966 ;; click in tree buffer
1967 (let ((w (newsticker--treeview-get-node nt-id)))
1968 (when w
1969 (newsticker--treeview-tree-update-tag w t t)
1970 (setq w (newsticker--treeview-get-node nt-id))
1971 (widget-put w :nt-selected t)
1972 (widget-apply w :action event)
1973 (newsticker--treeview-set-current-node w))))))
1974 (newsticker--treeview-tree-update-highlight))
1975
c9aafaaf 1976(defun newsticker--treeview-restore-layout ()
2415d4c6
UJ
1977 "Restore treeview buffers."
1978 (catch 'error
1979 (dotimes (i 3)
1980 (let ((win (nth i newsticker--treeview-windows))
1981 (buf (nth i newsticker--treeview-buffers)))
1982 (unless (window-live-p win)
1983 (newsticker--treeview-window-init)
1984 (newsticker--treeview-buffer-init)
1985 (throw 'error t))
1986 (unless (eq (window-buffer win) buf)
1987 (set-window-buffer win buf t))))))
1988
1989(defun newsticker--treeview-frame-init ()
1990 "Initialize treeview frame."
1991 (when newsticker-treeview-own-frame
1992 (unless (and newsticker--frame (frame-live-p newsticker--frame))
1993 (setq newsticker--frame (make-frame '((name . "Newsticker")))))
1994 (select-frame-set-input-focus newsticker--frame)
1995 (raise-frame newsticker--frame)))
1996
1997(defun newsticker--treeview-window-init ()
1998 "Initialize treeview windows."
1999 (setq newsticker--saved-window-config (current-window-configuration))
2000 (setq newsticker--treeview-windows nil)
2001 (setq newsticker--treeview-buffers nil)
2002 (delete-other-windows)
2d197ffb 2003 (split-window-right newsticker-treeview-treewindow-width)
2415d4c6
UJ
2004 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2005 (other-window 1)
2d197ffb 2006 (split-window-below newsticker-treeview-listwindow-height)
2415d4c6
UJ
2007 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2008 (other-window 1)
2009 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2010 (other-window 1))
2011
4da498eb 2012;;;###autoload
2415d4c6
UJ
2013(defun newsticker-treeview ()
2014 "Start newsticker treeview."
2015 (interactive)
2016 (newsticker--treeview-load)
2017 (setq newsticker--sentinel-callback 'newsticker-treeview-update)
2018 (newsticker--treeview-frame-init)
2019 (newsticker--treeview-window-init)
2020 (newsticker--treeview-buffer-init)
dba0634a
UJ
2021 (if (newsticker--group-manage-orphan-feeds)
2022 (newsticker--treeview-tree-update))
2415d4c6
UJ
2023 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
2024 (newsticker-start t) ;; will start only if not running
2025 (newsticker-treeview-update)
2026 (newsticker--treeview-item-show-text
2027 "Newsticker"
2028 "Welcome to newsticker!"))
2029
2030(defun newsticker-treeview-get-news ()
2031 "Get news for current feed."
2032 (interactive)
2033 (when newsticker--treeview-current-feed
2034 (newsticker-get-news newsticker--treeview-current-feed)))
5eddea0b 2035
8e39154d 2036(provide 'newst-treeview)
2415d4c6 2037
2900b2d8 2038;;; newst-treeview.el ends here