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