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