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