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