comparison lisp/net/newst-treeview.el @ 95901:b4bd9957663d

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