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