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