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