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