1 ;;; newst-treeview.el --- Treeview frontend for newsticker.
3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
5 ;; Author: Ulf Jasper <ulf.jasper@web.de>
6 ;; Filename: newst-treeview.el
7 ;; URL: http://www.nongnu.org/newsticker
9 ;; Keywords: News, RSS, Atom
10 ;; Time-stamp: "31. Oktober 2008, 20:44:46 (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 ;; ======================================================================
34 ;; ======================================================================
39 ;; ======================================================================
41 (require 'newsticker-reader "newst-reader")
43 (require 'tree-widget)
46 ;; ======================================================================
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."
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'."
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'."
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."
127 :group 'newsticker-treeview)
129 (defvar newsticker-groups
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\")
141 (defcustom newsticker-groups-filename
142 "~/.newsticker-groups"
143 "Name of the newsticker groups settings file."
145 :group 'newsticker-treeview)
147 ;; ======================================================================
148 ;;; internal variables
149 ;; ======================================================================
150 (defvar newsticker--treeview-windows nil)
151 (defvar newsticker--treeview-buffers nil)
152 (defvar newsticker--treeview-current-feed nil)
153 (defvar newsticker--treeview-current-vfeed nil)
154 (defvar newsticker--treeview-list-show-feed nil)
155 (defvar newsticker--saved-window-config nil)
156 (defvar newsticker--selection-overlay nil
157 "Highlight the selected tree node.")
158 (defvar newsticker--tree-selection-overlay nil
159 "Highlight the selected list item.")
160 (defvar newsticker--frame nil "Special frame for newsticker windows.")
161 (defvar newsticker--treeview-list-sort-order 'sort-by-time)
162 (defvar newsticker--treeview-current-node-id nil)
163 (defvar newsticker--treeview-current-tree nil)
164 (defvar newsticker--treeview-feed-tree nil)
165 (defvar newsticker--treeview-vfeed-tree nil)
167 ;; maps for the clickable portions
168 (defvar newsticker--treeview-url-keymap
169 (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
170 (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
171 (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
172 (define-key map "\n" 'newsticker-treeview-browse-url)
173 (define-key map "\C-m" 'newsticker-treeview-browse-url)
174 (define-key map [(control return)] 'newsticker-handle-url)
176 "Key map for click-able headings in the newsticker treeview buffers.")
179 ;; ======================================================================
181 ;; ======================================================================
182 (defsubst newsticker--treeview-tree-buffer ()
183 "Return the tree buffer of the newsticker treeview."
184 (nth 0 newsticker--treeview-buffers))
185 (defsubst newsticker--treeview-list-buffer ()
186 "Return the list buffer of the newsticker treeview."
187 (nth 1 newsticker--treeview-buffers))
188 (defsubst newsticker--treeview-item-buffer ()
189 "Return the item buffer of the newsticker treeview."
190 (nth 2 newsticker--treeview-buffers))
191 (defsubst newsticker--treeview-tree-window ()
192 "Return the tree window of the newsticker treeview."
193 (nth 0 newsticker--treeview-windows))
194 (defsubst newsticker--treeview-list-window ()
195 "Return the list window of the newsticker treeview."
196 (nth 1 newsticker--treeview-windows))
197 (defsubst newsticker--treeview-item-window ()
198 "Return the item window of the newsticker treeview."
199 (nth 2 newsticker--treeview-windows))
201 ;; ======================================================================
202 ;;; utility functions
203 ;; ======================================================================
204 (defun newsticker--treeview-get-id (parent i)
205 "Create an id for a newsticker treeview node.
206 PARENT is the node's parent, I is an integer."
207 ;;(message "newsticker--treeview-get-id %s"
208 ;; (format "%s-%d" (widget-get parent :nt-id) i))
209 (format "%s-%d" (widget-get parent :nt-id) i))
211 (defun newsticker--treeview-ids-eq (id1 id2)
212 "Return non-nil if ids ID1 and ID2 are equal."
213 ;;(message "%s/%s" (or id1 -1) (or id2 -1))
214 (and id1 id2 (string= id1 id2)))
216 (defun newsticker--treeview-nodes-eq (node1 node2)
217 "Compare treeview nodes NODE1 and NODE2 for equality.
218 Nodes are equal if the have the same newsticker-id. Note that
219 during re-tagging and collapsing/expanding nodes change, while
220 their id stays constant."
221 (let ((id1 (widget-get node1 :nt-id))
222 (id2 (widget-get node2 :nt-id)))
223 ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
224 ;; (or id1 -1) (or id2 -1))
225 (or (newsticker--treeview-ids-eq id1 id2)
226 (string= (widget-get node1 :tag) (widget-get node2 :tag)))))
228 (defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
229 "Recursivly search node for feed FEED-NAME starting from STARTNODE."
230 ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
231 (if (string= feed-name (or (widget-get startnode :nt-feed)
232 (widget-get startnode :nt-vfeed)))
233 (throw 'found startnode)
234 (let ((children (widget-get startnode :children)))
236 (newsticker--treeview-do-get-node-of-feed feed-name w)))))
238 (defun newsticker--treeview-get-node-of-feed (feed-name)
239 "Return node for feed FEED-NAME in newsticker treeview tree."
241 (newsticker--treeview-do-get-node-of-feed feed-name
242 newsticker--treeview-feed-tree)
243 (newsticker--treeview-do-get-node-of-feed feed-name
244 newsticker--treeview-vfeed-tree)))
246 (defun newsticker--treeview-do-get-node (id startnode)
247 "Recursivly search node with ID starting from STARTNODE."
248 (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
249 (throw 'found startnode)
250 (let ((children (widget-get startnode :children)))
252 (newsticker--treeview-do-get-node id w)))))
254 (defun newsticker--treeview-get-node (id)
255 "Return node with ID in newsticker treeview tree."
257 (newsticker--treeview-do-get-node id newsticker--treeview-feed-tree)
258 (newsticker--treeview-do-get-node id newsticker--treeview-vfeed-tree)))
260 (defun newsticker--treeview-get-current-node ()
261 "Return current node in newsticker treeview tree."
262 (newsticker--treeview-get-node newsticker--treeview-current-node-id))
264 ;; ======================================================================
266 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
267 (declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
269 (defun newsticker--treeview-render-text (start end)
270 "Render text between markers START and END."
271 (if newsticker-html-renderer
272 (condition-case error-data
274 (set-marker-insertion-type end t)
275 ;; check whether it is necessary to call html renderer
276 ;; (regexp inspired by htmlr.el)
278 (when (re-search-forward
279 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
280 ;; (message "%s" (newsticker--title item))
281 (let ((w3m-fill-column (if newsticker-use-full-width
283 (w3-maximum-line-length
284 (if newsticker-use-full-width nil fill-column)))
286 (funcall newsticker-html-renderer start end)))
287 ;;(cond ((eq newsticker-html-renderer 'w3m-region)
288 ;; (add-text-properties start end (list 'keymap
289 ;; w3m-minor-mode-map)))
290 ;;((eq newsticker-html-renderer 'w3-region)
291 ;;(add-text-properties start end (list 'keymap w3-mode-map))))
292 (if (eq newsticker-html-renderer 'w3m-region)
293 (w3m-toggle-inline-images t))
296 (message "Error: HTML rendering failed: %s, %s"
297 (car error-data) (cdr error-data))
301 ;; ======================================================================
303 ;; ======================================================================
304 (defun newsticker--treeview-list-add-item (item feed &optional show-feed)
305 "Add news ITEM for FEED to newsticker treeview list window.
306 If string SHOW-FEED is non-nil it is shown in the item string."
307 (setq newsticker--treeview-list-show-feed show-feed)
309 (set-buffer (newsticker--treeview-list-buffer))
310 (let* ((inhibit-read-only t)
312 (goto-char (point-max))
313 (setq pos1 (point-marker))
315 (insert (propertize " " 'display '(space :align-to 2)))
316 (insert (if show-feed
319 (format "%-10s" (newsticker--real-feed-name
322 (propertize " " 'display '(space :align-to 12)))
324 (insert (format-time-string "%d.%m.%y, %H:%M"
325 (newsticker--time item)))
326 (insert (propertize " " 'display
327 (list 'space :align-to (if show-feed 28 18))))
328 (setq pos2 (point-marker))
329 (insert (newsticker--title item))
331 (newsticker--treeview-render-text pos2 (point-marker))
333 (while (search-forward "\n" nil t)
335 (let ((map (make-sparse-keymap)))
336 (define-key map [mouse-1] 'newsticker-treeview-tree-click)
337 (define-key map "\n" 'newsticker-treeview-show-item)
338 (define-key map "\C-m" 'newsticker-treeview-show-item)
339 (add-text-properties pos1 (point-max)
342 :nt-link (newsticker--link item)
343 'mouse-face 'highlight
345 'help-echo (buffer-substring pos2
349 (defun newsticker--treeview-list-clear ()
350 "Clear the newsticker treeview list window."
352 (set-buffer (newsticker--treeview-list-buffer))
353 (let ((inhibit-read-only t))
355 (kill-all-local-variables)
358 (defun newsticker--treeview-list-items-with-age-callback (widget
361 "Fill newsticker treeview list window with items of certain age.
362 This is a callback function for the treeview nodes.
363 Argument WIDGET is the calling treeview widget.
364 Argument CHANGED-WIDGET is the widget that actually has changed.
365 Optional argument AGES is the list of ages that are to be shown."
366 (newsticker--treeview-list-clear)
367 (widget-put widget :nt-selected t)
368 (apply 'newsticker--treeview-list-items-with-age ages))
370 (defun newsticker--treeview-list-items-with-age (&rest ages)
371 "Actually fill newsticker treeview list window with items of certain age.
372 AGES is the list of ages that are to be shown."
374 (let ((feed-name-symbol (intern (car feed))))
376 (when (memq (newsticker--age item) ages)
377 (newsticker--treeview-list-add-item
378 item feed-name-symbol t)))
379 (newsticker--treeview-list-sort-items
380 (cdr (newsticker--cache-get-feed feed-name-symbol))))))
381 (append newsticker-url-list-defaults newsticker-url-list))
382 (newsticker--treeview-list-update nil))
384 (defun newsticker--treeview-list-new-items (widget changed-widget
386 "Fill newsticker treeview list window with new items.
387 This is a callback function for the treeview nodes.
388 Argument WIDGET is the calling treeview widget.
389 Argument CHANGED-WIDGET is the widget that actually has changed.
390 Optional argument EVENT is the mouse event that triggered this action."
391 (newsticker--treeview-list-items-with-age-callback widget changed-widget
393 (newsticker--treeview-item-show-text
395 "This is a virtual feed containing all new items"))
397 (defun newsticker--treeview-list-immortal-items (widget changed-widget
399 "Fill newsticker treeview list window with immortal items.
400 This is a callback function for the treeview nodes.
401 Argument WIDGET is the calling treeview widget.
402 Argument CHANGED-WIDGET is the widget that actually has changed.
403 Optional argument EVENT is the mouse event that triggered this action."
404 (newsticker--treeview-list-items-with-age-callback widget changed-widget
406 (newsticker--treeview-item-show-text
408 "This is a virtual feed containing all immortal items."))
410 (defun newsticker--treeview-list-obsolete-items (widget changed-widget
412 "Fill newsticker treeview list window with obsolete items.
413 This is a callback function for the treeview nodes.
414 Argument WIDGET is the calling treeview widget.
415 Argument CHANGED-WIDGET is the widget that actually has changed.
416 Optional argument EVENT is the mouse event that triggered this action."
417 (newsticker--treeview-list-items-with-age-callback widget changed-widget
419 (newsticker--treeview-item-show-text
421 "This is a virtual feed containing all obsolete items."))
423 (defun newsticker--treeview-list-all-items (widget changed-widget
425 "Fill newsticker treeview list window with all items.
426 This is a callback function for the treeview nodes.
427 Argument WIDGET is the calling treeview widget.
428 Argument CHANGED-WIDGET is the widget that actually has changed.
429 Optional argument EVENT is the mouse event that triggered this action."
430 (newsticker--treeview-list-items-with-age-callback widget changed-widget
433 (newsticker--treeview-item-show-text
435 "This is a virtual feed containing all items."))
437 (defun newsticker--treeview-list-items-v (vfeed-name)
438 "List items for virtual feed VFEED-NAME."
440 (cond ((string-match "\\*new\\*" vfeed-name)
441 (newsticker--treeview-list-items-with-age 'new))
442 ((string-match "\\*immortal\\*" vfeed-name)
443 (newsticker--treeview-list-items-with-age 'immortal))
444 ((string-match "\\*old\\*" vfeed-name)
445 (newsticker--treeview-list-items-with-age 'old nil)))
446 (newsticker--treeview-list-update nil)
449 (defun newsticker--treeview-list-items (feed-name)
450 "List items for feed FEED-NAME."
452 (if (newsticker--treeview-virtual-feed-p feed-name)
453 (newsticker--treeview-list-items-v feed-name)
455 (if (eq (newsticker--age item) 'feed)
456 (newsticker--treeview-item-show item (intern feed-name))
457 (newsticker--treeview-list-add-item item
458 (intern feed-name))))
459 (newsticker--treeview-list-sort-items
460 (cdr (newsticker--cache-get-feed (intern feed-name)))))
461 (newsticker--treeview-list-update nil))))
463 (defun newsticker--treeview-list-feed-items (widget changed-widget
465 "Callback function for listing feed items.
466 Argument WIDGET is the calling treeview widget.
467 Argument CHANGED-WIDGET is the widget that actually has changed.
468 Optional argument EVENT is the mouse event that triggered this action."
469 (newsticker--treeview-list-clear)
470 (widget-put widget :nt-selected t)
471 (let ((feed-name (widget-get widget :nt-feed))
472 (vfeed-name (widget-get widget :nt-vfeed)))
474 (newsticker--treeview-list-items feed-name)
475 (newsticker--treeview-list-items-v vfeed-name))))
477 (defun newsticker--treeview-list-compare-item-by-age (item1 item2)
478 "Compare two news items ITEM1 and ITEM2 wrt age."
480 (let ((age1 (newsticker--age item1))
481 (age2 (newsticker--age item2)))
482 (cond ((eq age1 'new)
485 (cond ((eq age2 'new)
492 (cond ((eq age2 'new)
503 (defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
504 "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
505 (newsticker--treeview-list-compare-item-by-age item2 item1))
507 (defun newsticker--treeview-list-compare-item-by-time (item1 item2)
508 "Compare two news items ITEM1 and ITEM2 wrt time values."
509 (newsticker--cache-item-compare-by-time item1 item2))
511 (defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
512 "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
513 (newsticker--cache-item-compare-by-time item2 item1))
515 (defun newsticker--treeview-list-compare-item-by-title (item1 item2)
516 "Compare two news items ITEM1 and ITEM2 wrt title."
517 (newsticker--cache-item-compare-by-title item1 item2))
519 (defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
520 "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
521 (newsticker--cache-item-compare-by-title item2 item1))
523 (defun newsticker--treeview-list-sort-items (items)
524 "Return sorted copy of list ITEMS.
525 The sort function is chosen according to the value of
526 `newsticker--treeview-list-sort-order'."
528 (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
529 'newsticker--treeview-list-compare-item-by-age)
530 ((eq newsticker--treeview-list-sort-order
531 'sort-by-age-reverse)
532 'newsticker--treeview-list-compare-item-by-age-reverse)
533 ((eq newsticker--treeview-list-sort-order 'sort-by-time)
534 'newsticker--treeview-list-compare-item-by-time)
535 ((eq newsticker--treeview-list-sort-order
536 'sort-by-time-reverse)
537 'newsticker--treeview-list-compare-item-by-time-reverse)
538 ((eq newsticker--treeview-list-sort-order 'sort-by-title)
539 'newsticker--treeview-list-compare-item-by-title)
540 ((eq newsticker--treeview-list-sort-order
541 'sort-by-title-reverse)
542 'newsticker--treeview-list-compare-item-by-title-reverse)
544 'newsticker--treeview-list-compare-item-by-title))))
545 (sort (copy-sequence items) sort-fun)))
547 (defun newsticker--treeview-list-update-faces ()
548 "Update faces in the treeview list buffer."
551 (set-buffer (newsticker--treeview-list-buffer))
552 (let ((inhibit-read-only t))
553 (goto-char (point-min))
555 (let* ((pos (save-excursion (end-of-line) (point)))
556 (item (get-text-property (point) :nt-item))
557 (age (newsticker--age item))
558 (selected (get-text-property (point) :nt-selected))
559 (face (cond ((eq age 'new)
560 'newsticker-treeview-new-face)
562 'newsticker-treeview-old-face)
564 'newsticker-treeview-immortal-face)
566 'newsticker-treeview-obsolete-face)
569 (put-text-property (point) pos 'face face)
571 (move-overlay newsticker--selection-overlay (point)
572 (1+ pos) ;include newline
574 (if selected (setq pos-sel (point)))
576 (beginning-of-line))))) ;; FIXME!?
578 (if (window-live-p (newsticker--treeview-list-window))
579 (set-window-point (newsticker--treeview-list-window) pos-sel)))))
581 (defun newsticker--treeview-list-clear-highlight ()
582 "Clear the highlight in the treeview list buffer."
584 (set-buffer (newsticker--treeview-list-buffer))
585 (let ((inhibit-read-only t))
586 (put-text-property (point-min) (point-max) :nt-selected nil))
587 (newsticker--treeview-list-update-faces)))
589 (defun newsticker--treeview-list-update-highlight ()
590 "Update the highlight in the treeview list buffer."
591 (newsticker--treeview-list-clear-highlight)
594 (set-buffer (newsticker--treeview-list-buffer))
595 (let ((inhibit-read-only t))
596 (put-text-property (save-excursion (beginning-of-line) (point))
597 (save-excursion (end-of-line) (point))
599 (newsticker--treeview-list-update-faces))))
601 (defun newsticker--treeview-list-highlight-start ()
602 "Return position of selection in treeview list buffer."
604 (set-buffer (newsticker--treeview-list-buffer))
605 (goto-char (point-min))
606 (next-single-property-change (point) :nt-selected)))
608 (defun newsticker--treeview-list-update (clear-buffer)
609 "Update the faces and highlight in the treeview list buffer.
610 If CLEAR-BUFFER is non-nil the list buffer is completely erased."
612 (if (window-live-p (newsticker--treeview-list-window))
613 (set-window-buffer (newsticker--treeview-list-window)
614 (newsticker--treeview-list-buffer)))
615 (set-buffer (newsticker--treeview-list-buffer))
617 (let ((inhibit-read-only t))
619 (newsticker-treeview-list-mode)
620 (newsticker--treeview-list-update-faces)
621 (goto-char (point-min))))
623 (defvar newsticker-treeview-list-sort-button-map
624 (let ((map (make-sparse-keymap)))
625 (define-key map [header-line mouse-1]
626 'newsticker--treeview-list-sort-by-column)
627 (define-key map [header-line mouse-2]
628 'newsticker--treeview-list-sort-by-column)
630 "Local keymap for newsticker treeview list window sort buttons.")
632 (defun newsticker--treeview-list-sort-by-column (&optional event)
633 "Sort the newsticker list window buffer by the column clicked on.
634 Optional argument EVENT is the mouse event that triggered this action."
635 (interactive (list last-input-event))
636 (if event (mouse-select-window event))
637 (let* ((pos (event-start event))
638 (obj (posn-object pos))
640 (get-text-property (cdr obj) 'sort-order (car obj))
641 (get-text-property (posn-point pos) 'sort-order))))
642 (setq newsticker--treeview-list-sort-order
643 (cond ((eq sort-order 'sort-by-age)
644 (if (eq newsticker--treeview-list-sort-order 'sort-by-age)
647 ((eq sort-order 'sort-by-time)
648 (if (eq newsticker--treeview-list-sort-order 'sort-by-time)
649 'sort-by-time-reverse
651 ((eq sort-order 'sort-by-title)
652 (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
653 'sort-by-title-reverse
655 (newsticker-treeview-update)))
657 (defun newsticker-treeview-list-make-sort-button (name sort-order)
658 "Create propertized string for headerline button.
659 NAME is the button text, SORT-ORDER is the associated sort order
661 (let ((face (if (string-match (symbol-name sort-order)
663 newsticker--treeview-list-sort-order))
667 'sort-order sort-order
668 'help-echo (concat "Sort by " name)
669 'mouse-face 'highlight
671 'keymap newsticker-treeview-list-sort-button-map)))
673 ;; ======================================================================
675 ;; ======================================================================
676 (defun newsticker--treeview-item-show-text (title description)
677 "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
679 (set-buffer (newsticker--treeview-item-buffer))
680 (when (fboundp 'w3m-process-stop)
681 (w3m-process-stop (current-buffer)))
682 (let ((inhibit-read-only t))
684 (kill-all-local-variables)
687 (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
688 (insert "\n\n" description)
689 (when newsticker-justification
690 (fill-region (point-min) (point-max) newsticker-justification))
691 (newsticker-treeview-mode)
692 (goto-char (point-min)))))
694 (defun newsticker--treeview-item-show (item feed)
695 "Show news ITEM coming from FEED in treeview item buffer."
697 (set-buffer (newsticker--treeview-item-buffer))
698 (when (fboundp 'w3m-process-stop)
699 (w3m-process-stop (current-buffer)))
700 (let ((inhibit-read-only t)
701 (is-rendered-HTML nil)
703 (marker1 (make-marker))
704 (marker2 (make-marker)))
706 (kill-all-local-variables)
709 (when (and item feed)
710 (let ((wwidth (1- (window-width (newsticker--treeview-item-window)))))
711 (if newsticker-use-full-width
712 (set (make-local-variable 'fill-column) wwidth))
713 (set (make-local-variable 'fill-column) (min fill-column
715 (let ((desc (newsticker--desc item)))
716 (insert "\n" (or desc "[No Description]")))
717 (set-marker marker1 (1+ (point-min)))
718 (set-marker marker2 (point-max))
719 (setq is-rendered-HTML (newsticker--treeview-render-text marker1
721 (when (and newsticker-justification
722 (not is-rendered-HTML))
723 (fill-region marker1 marker2 newsticker-justification))
725 (newsticker-treeview-mode)
726 (goto-char (point-min))
727 ;; insert logo at top
728 (let* ((newsticker-enable-logo-manipulations nil)
729 (img (newsticker--image-read feed nil)))
730 (if (and (display-images-p) img)
731 (newsticker--insert-image img (car item))
732 (insert (newsticker--real-feed-name feed))))
733 (add-text-properties (point-min) (point)
734 (list 'face 'newsticker-feed-face
735 'mouse-face 'highlight
736 'help-echo "Visit in web browser."
737 :nt-link (newsticker--link item)
738 'keymap newsticker--treeview-url-keymap))
744 (insert (newsticker--title item) "\n")
745 (set-marker marker1 pos)
746 (set-marker marker2 (point))
747 (newsticker--treeview-render-text marker1 marker2)
748 (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
752 (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
753 (set-marker marker2 (point))
754 (when newsticker-justification
755 (fill-region marker1 marker2 newsticker-justification))
757 (add-text-properties marker1 (1- (point))
758 (list 'mouse-face 'highlight
759 'help-echo "Visit in web browser."
760 :nt-link (newsticker--link item)
761 'keymap newsticker--treeview-url-keymap))
762 (insert (format-time-string newsticker-date-format
763 (newsticker--time item)))
767 ;; insert enclosures and rest at bottom
768 (goto-char (point-max))
771 (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
772 (put-text-property pos (point) 'face 'newsticker-enclosure-face)
775 (newsticker--print-extra-elements item newsticker--treeview-url-keymap)
776 (put-text-property pos (point) 'face 'newsticker-extra-face)
777 (goto-char (point-min)))))
778 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
780 (memq (newsticker--age item) '(new obsolete)))
781 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
782 (newsticker-treeview-mark-item-old t)
783 (newsticker--treeview-list-update-faces)))
784 (if (window-live-p (newsticker--treeview-item-window))
785 (set-window-point (newsticker--treeview-item-window) 1)))
787 (defun newsticker--treeview-item-update ()
788 "Update the treeview item buffer and window."
790 (if (window-live-p (newsticker--treeview-item-window))
791 (set-window-buffer (newsticker--treeview-item-window)
792 (newsticker--treeview-item-buffer)))
793 (set-buffer (newsticker--treeview-item-buffer))
794 (let ((inhibit-read-only t))
796 (newsticker-treeview-mode)))
798 ;; ======================================================================
800 ;; ======================================================================
801 (defun newsticker--treeview-tree-expand (tree)
803 Callback function for tree widget that adds nodes for feeds and subgroups."
804 (tree-widget-set-theme "folder")
805 (let ((group (widget-get tree :nt-group))
809 (setq nt-id (newsticker--treeview-get-id tree i))
812 (let* ((g-name (car g)))
814 :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
815 :expander newsticker--treeview-tree-expand
816 :expander-p (lambda (&rest ignore) t)
820 :keep (:nt-feed :num-new :nt-id :open);; :nt-group
822 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
824 :leaf-icon newsticker--tree-widget-leaf-icon
826 :action newsticker--treeview-list-feed-items
832 (defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
834 "Expand the vfeed TREE.
835 Optional arguments CHANGED-WIDGET and EVENT are ignored."
836 (tree-widget-set-theme "folder")
837 (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
839 :action newsticker--treeview-list-new-items
840 :nt-id ,(newsticker--treeview-get-id tree 0)
842 `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
844 :action newsticker--treeview-list-immortal-items
845 :nt-id ,(newsticker--treeview-get-id tree 1)
847 `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
849 :action newsticker--treeview-list-obsolete-items
850 :nt-id ,(newsticker--treeview-get-id tree 2)
852 `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
854 :action newsticker--treeview-list-all-items
855 :nt-id ,(newsticker--treeview-get-id tree 3)
858 (defun newsticker--treeview-virtual-feed-p (feed-name)
859 "Return non-nil if FEED-NAME is a virtual feed."
860 (string-match "\\*.*\\*" feed-name))
862 (define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
863 "Icon for a tree-widget leaf node."
866 :button-face 'default)
868 (defun newsticker--treeview-tree-update ()
869 "Update treeview tree buffer and window."
871 (if (window-live-p (newsticker--treeview-tree-window))
872 (set-window-buffer (newsticker--treeview-tree-window)
873 (newsticker--treeview-tree-buffer)))
874 (set-buffer (newsticker--treeview-tree-buffer))
875 (kill-all-local-variables)
876 (let ((inhibit-read-only t))
878 (tree-widget-set-theme "folder")
879 (setq newsticker--treeview-feed-tree
880 (widget-create 'tree-widget
881 :tag (newsticker--treeview-propertize-tag
883 :expander 'newsticker--treeview-tree-expand
884 :expander-p (lambda (&rest ignore) t)
885 :leaf-icon 'newsticker--tree-widget-leaf-icon
886 :nt-group (cdr newsticker-groups)
890 (setq newsticker--treeview-vfeed-tree
891 (widget-create 'tree-widget
892 :tag (newsticker--treeview-propertize-tag
893 "Virtual Feeds" 0 "vfeeds")
894 :expander 'newsticker--treeview-tree-expand-status
895 :expander-p (lambda (&rest ignore) t)
896 :leaf-icon 'newsticker--tree-widget-leaf-icon
900 (use-local-map widget-keymap)
902 (newsticker-treeview-mode)))
904 (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
906 "Return propertized copy of string TAG.
907 Optional argument NUM-NEW is used for choosing face, other
908 arguments NT-ID, FEED, and VFEED are added as properties."
909 ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
910 (let ((face 'newsticker-treeview-face)
911 (map (make-sparse-keymap)))
912 (if (and num-new (> num-new 0))
913 (setq face 'newsticker-treeview-new-face))
914 (define-key map [mouse-1] 'newsticker-treeview-tree-click)
915 (define-key map "\n" 'newsticker-treeview-tree-do-click)
916 (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
917 (propertize tag 'face face 'keymap map
922 'mouse-face 'highlight)))
924 (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
926 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
927 Optional argument NT-ID is added to the tag's properties."
928 (let (tag (num-new 0))
930 (cond ((string= vfeed-name "new")
931 (setq num-new (newsticker--stat-num-items-total 'new))
932 (setq tag (format "New items (%d)" num-new)))
933 ((string= vfeed-name "immortal")
934 (setq num-new (newsticker--stat-num-items-total 'immortal))
935 (setq tag (format "Immortal items (%d)" num-new)))
936 ((string= vfeed-name "obsolete")
937 (setq num-new (newsticker--stat-num-items-total 'obsolete))
938 (setq tag (format "Obsolete items (%d)" num-new)))
939 ((string= vfeed-name "all")
940 (setq num-new (newsticker--stat-num-items-total))
941 (setq tag (format "All items (%d)" num-new)))))
943 (setq num-new (newsticker--stat-num-items-for-group
944 (intern feed-name) 'new 'immortal))
947 (newsticker--real-feed-name (intern feed-name))
950 (newsticker--treeview-propertize-tag tag num-new
952 feed-name vfeed-name))))
954 (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
955 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
956 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
957 (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
959 (setq result (+ result
960 (apply 'newsticker--stat-num-items (intern f-n)
962 (newsticker--group-get-feeds
963 (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
966 (defun newsticker--treeview-count-node-items (feed &optional isvirtual)
967 "Count number of relevant items for a treeview node.
968 FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
969 the feed is a virtual feed."
973 (cond ((string= feed "new")
974 (setq num-new (newsticker--stat-num-items-total 'new)))
975 ((string= feed "immortal")
976 (setq num-new (newsticker--stat-num-items-total 'immortal)))
977 ((string= feed "obsolete")
978 (setq num-new (newsticker--stat-num-items-total 'obsolete)))
979 ((string= feed "all")
980 (setq num-new (newsticker--stat-num-items-total))))
981 (setq num-new (newsticker--stat-num-items-for-group
982 (intern feed) 'new 'immortal))))
985 (defun newsticker--treeview-tree-update-tag (w &optional recursive
987 "Update tag for tree widget W.
988 If RECURSIVE is non-nil recursively update parent widgets as
989 well. Argument IGNORE is ignored. Note that this function, if
990 called recursively, makes w invalid. You should keep w's nt-id in
992 ;;(message "newsticker--treeview-tree-update-tag %s, %s" (widget-get w :tag)
994 (let* ((parent (widget-get w :parent))
995 (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
996 (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
997 (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
998 (num-new (newsticker--treeview-count-node-items (or feed vfeed)
1000 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
1001 (n (widget-get w :node)))
1004 (newsticker--treeview-tree-update-tag parent)))
1007 (widget-put n :tag tag))
1008 (widget-put w :num-new num-new)
1009 (widget-put w :tag tag)
1010 (when (marker-position (widget-get w :from))
1012 (notify (widget-get w :notify)))
1013 ;; FIXME: This moves point!!!!
1015 (set-buffer (newsticker--treeview-tree-buffer))
1016 (widget-value-set w (widget-value w)))
1019 (defun newsticker--treeview-tree-do-update-tags (widget)
1020 "Actually recursively update tags for WIDGET."
1022 (let ((children (widget-get widget :children)))
1023 (dolist (w children)
1024 (newsticker--treeview-tree-do-update-tags w))
1025 (newsticker--treeview-tree-update-tag widget))))
1027 (defun newsticker--treeview-tree-update-tags (&rest ignore)
1028 "Update all tags of all trees.
1029 Arguments IGNORE are ignored."
1030 (save-current-buffer
1031 (set-buffer (newsticker--treeview-tree-buffer))
1032 (let ((inhibit-read-only t))
1033 (newsticker--treeview-tree-do-update-tags
1034 newsticker--treeview-feed-tree)
1035 (newsticker--treeview-tree-do-update-tags
1036 newsticker--treeview-vfeed-tree))
1037 (tree-widget-set-theme "folder")))
1039 (defun newsticker--treeview-tree-update-highlight ()
1040 "Update highlight in tree buffer."
1041 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
1042 (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
1043 (setq pos (widget-get (widget-get
1044 (newsticker--treeview-get-current-node)
1046 (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
1048 (set-buffer (newsticker--treeview-tree-buffer))
1050 (move-overlay newsticker--tree-selection-overlay
1051 (save-excursion (beginning-of-line) (point))
1052 (save-excursion (end-of-line) (1+ (point)))
1054 (if (window-live-p (newsticker--treeview-tree-window))
1055 (set-window-point (newsticker--treeview-tree-window) pos)))))
1057 ;; ======================================================================
1059 ;; ======================================================================
1060 ;;(makunbound 'newsticker-treeview-tool-bar-map)
1061 (defvar newsticker-treeview-tool-bar-map
1062 (if (featurep 'xemacs)
1064 (if (boundp 'tool-bar-map)
1065 (let ((tool-bar-map (make-sparse-keymap)))
1066 (define-key tool-bar-map [newsticker-sep-1]
1067 (list 'menu-item "--double-line"))
1068 (define-key tool-bar-map [newsticker-browse-url]
1069 (list 'menu-item "newsticker-browse-url"
1070 'newsticker-browse-url
1072 :help "Browse URL for item at point"
1073 :image newsticker--browse-image))
1074 (define-key tool-bar-map [newsticker-buffer-force-update]
1075 (list 'menu-item "newsticker-treeview-update"
1076 'newsticker-treeview-update
1078 :help "Update newsticker buffer"
1079 :image newsticker--update-image
1081 (define-key tool-bar-map [newsticker-get-all-news]
1082 (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
1084 :help "Get news for all feeds"
1085 :image newsticker--get-all-image))
1086 (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
1087 (list 'menu-item "newsticker-treeview-mark-item-old"
1088 'newsticker-treeview-mark-item-old
1090 :image newsticker--mark-read-image
1091 :help "Mark current item as read"
1092 ;;:enable '(newsticker-item-not-old-p) FIXME
1094 (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
1095 (list 'menu-item "newsticker-treeview-toggle-item-immortal"
1096 'newsticker-treeview-toggle-item-immortal
1098 :image newsticker--mark-immortal-image
1099 :help "Toggle current item as immortal"
1101 ;;'(newsticker-item-not-immortal-p) FIXME
1103 (define-key tool-bar-map [newsticker-next-feed]
1104 (list 'menu-item "newsticker-treeview-next-feed"
1105 'newsticker-treeview-next-feed
1107 :help "Go to next feed"
1108 :image newsticker--next-feed-image
1110 ;;'(newsticker-next-feed-available-p) FIXME
1112 (define-key tool-bar-map [newsticker-treeview-next-item]
1113 (list 'menu-item "newsticker-treeview-next-item"
1114 'newsticker-treeview-next-item
1116 :help "Go to next item"
1117 :image newsticker--next-item-image
1119 ;;'(newsticker-next-item-available-p) FIXME
1121 (define-key tool-bar-map [newsticker-treeview-prev-item]
1122 (list 'menu-item "newsticker-treeview-prev-item"
1123 'newsticker-treeview-prev-item
1125 :help "Go to previous item"
1126 :image newsticker--previous-item-image
1128 ;;'(newsticker-previous-item-available-p) FIXME
1130 (define-key tool-bar-map [newsticker-treeview-prev-feed]
1131 (list 'menu-item "newsticker-treeview-prev-feed"
1132 'newsticker-treeview-prev-feed
1134 :help "Go to previous feed"
1135 :image newsticker--previous-feed-image
1137 ;;'(newsticker-previous-feed-available-p) FIXME
1139 ;; standard icons / actions
1140 (tool-bar-add-item "close"
1141 'newsticker-treeview-quit
1142 'newsticker-treeview-quit
1143 :help "Close newsticker")
1144 (tool-bar-add-item "preferences"
1145 'newsticker-customize
1146 'newsticker-customize
1147 :help "Customize newsticker")
1150 ;; ======================================================================
1152 ;; ======================================================================
1154 (defun newsticker-treeview-mouse-browse-url (event)
1155 "Call `browse-url' for the link of the item at which the EVENT occurred."
1158 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1159 (let ((url (get-text-property (posn-point (event-end event))
1163 (if newsticker-automatically-mark-visited-items-as-old
1164 (newsticker-treeview-mark-item-old))))))
1166 (defun newsticker-treeview-browse-url ()
1167 "Call `browse-url' for the link of the item at point."
1170 (set-buffer (newsticker--treeview-list-buffer))
1171 (let ((url (get-text-property (point) :nt-link)))
1174 (if newsticker-automatically-mark-visited-items-as-old
1175 (newsticker-treeview-mark-item-old))))))
1177 (defun newsticker--treeview-buffer-init ()
1178 "Initialize all treeview buffers."
1179 (setq newsticker--treeview-buffers nil)
1180 (add-to-list 'newsticker--treeview-buffers
1181 (get-buffer-create "*Newsticker Tree*") t)
1182 (add-to-list 'newsticker--treeview-buffers
1183 (get-buffer-create "*Newsticker List*") t)
1184 (add-to-list 'newsticker--treeview-buffers
1185 (get-buffer-create "*Newsticker Item*") t)
1187 (unless newsticker--selection-overlay
1189 (set-buffer (newsticker--treeview-list-buffer))
1190 (setq newsticker--selection-overlay (make-overlay (point-min)
1192 (overlay-put newsticker--selection-overlay 'face
1193 'newsticker-treeview-selection-face)))
1194 (unless newsticker--tree-selection-overlay
1196 (set-buffer (newsticker--treeview-tree-buffer))
1197 (setq newsticker--tree-selection-overlay (make-overlay (point-min)
1199 (overlay-put newsticker--tree-selection-overlay 'face
1200 'newsticker-treeview-selection-face)))
1202 (newsticker--treeview-tree-update)
1203 (newsticker--treeview-list-update t)
1204 (newsticker--treeview-item-update))
1206 (defun newsticker-treeview-update ()
1207 "Update all treeview buffers and windows.
1208 Note: does not update the layout."
1210 (newsticker--cache-update)
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."
1226 (newsticker-treeview-save)
1227 (setq newsticker--sentinel-callback nil)
1228 (bury-buffer "*Newsticker Tree*")
1229 (bury-buffer "*Newsticker List*")
1230 (bury-buffer "*Newsticker Item*")
1231 (set-window-configuration newsticker--saved-window-config)
1232 (when newsticker--frame
1233 (if (frame-live-p newsticker--frame)
1234 (delete-frame newsticker--frame))
1235 (setq newsticker--frame nil)))
1237 (defun newsticker-treeview-save ()
1238 "Save newsticker data including treeview settings."
1240 (newsticker--cache-save)
1242 (let ((coding-system-for-write 'utf-8)
1243 (buf (find-file-noselect newsticker-groups-filename)))
1246 (setq buffer-undo-list t)
1248 (insert ";; -*- coding: utf-8 -*-\n")
1249 (insert (prin1-to-string newsticker-groups))
1252 (defun newsticker--treeview-load ()
1253 "Load treeview settings."
1254 (let* ((coding-system-for-read 'utf-8)
1255 (buf (and (file-exists-p newsticker-groups-filename)
1256 (find-file-noselect newsticker-groups-filename))))
1259 (goto-char (point-min))
1261 (setq newsticker-groups (read buf))
1263 (message "Error while reading newsticker groups file!")
1264 (setq newsticker-groups nil))))))
1267 (defun newsticker-treeview-scroll-item ()
1268 "Scroll current item."
1270 (save-selected-window
1271 (select-window (newsticker--treeview-item-window) t)
1274 (defun newsticker-treeview-show-item ()
1275 "Show current item."
1277 (newsticker--treeview-restore-layout)
1278 (newsticker--treeview-list-update-highlight)
1280 (set-buffer (newsticker--treeview-list-buffer))
1282 (let ((item (get-text-property (point) :nt-item))
1283 (feed (get-text-property (point) :nt-feed)))
1284 (newsticker--treeview-item-show item feed)))
1285 (newsticker--treeview-tree-update-tag
1286 (newsticker--treeview-get-current-node) t)
1287 (newsticker--treeview-tree-update-highlight))
1289 (defun newsticker-treeview-next-item ()
1290 "Move to next item."
1292 (newsticker--treeview-restore-layout)
1293 (save-current-buffer
1294 (set-buffer (newsticker--treeview-list-buffer))
1295 (if (newsticker--treeview-list-highlight-start)
1299 (newsticker-treeview-show-item))
1301 (defun newsticker-treeview-prev-item ()
1302 "Move to previous item."
1304 (newsticker--treeview-restore-layout)
1305 (save-current-buffer
1306 (set-buffer (newsticker--treeview-list-buffer))
1308 (newsticker-treeview-show-item))
1310 (defun newsticker-treeview-next-new-or-immortal-item ()
1311 "Move to next new or immortal item."
1313 (newsticker--treeview-restore-layout)
1314 (newsticker--treeview-list-clear-highlight)
1316 (let ((index (newsticker-treeview-next-item)))
1318 (save-current-buffer
1319 (set-buffer (newsticker--treeview-list-buffer))
1323 (throw 'found nil)))
1324 (when (memq (newsticker--age
1325 (newsticker--treeview-get-selected-item)) '(new immortal))
1326 (newsticker-treeview-show-item)
1327 (throw 'found t))))))
1329 (defun newsticker-treeview-prev-new-or-immortal-item ()
1330 "Move to previous new or immortal item."
1332 (newsticker--treeview-restore-layout)
1333 (newsticker--treeview-list-clear-highlight)
1335 (let ((index (newsticker-treeview-next-item)))
1337 (save-current-buffer
1338 (set-buffer (newsticker--treeview-list-buffer))
1341 (throw 'found nil)))
1342 (when (memq (newsticker--age
1343 (newsticker--treeview-get-selected-item)) '(new immortal))
1344 (newsticker-treeview-show-item)
1345 (throw 'found t))))))
1347 (defun newsticker--treeview-get-selected-item ()
1348 "Return item that is currently selected in list buffer."
1350 (set-buffer (newsticker--treeview-list-buffer))
1352 (get-text-property (point) :nt-item)))
1354 (defun newsticker-treeview-mark-item-old (&optional dont-proceed)
1355 "Mark current item as old unless it is obsolete.
1356 Move to next item unless DONT-PROCEED is non-nil."
1358 (let ((item (newsticker--treeview-get-selected-item)))
1359 (unless (eq (newsticker--age item) 'obsolete)
1360 (newsticker--treeview-mark-item item 'old)))
1361 (unless dont-proceed
1362 (newsticker-treeview-next-item)))
1364 (defun newsticker-treeview-toggle-item-immortal ()
1365 "Toggle immortality of current item."
1367 (let* ((item (newsticker--treeview-get-selected-item))
1368 (new-age (if (eq (newsticker--age item) 'immortal)
1371 (newsticker--treeview-mark-item item new-age)
1372 (newsticker-treeview-next-item)))
1374 (defun newsticker--treeview-mark-item (item new-age)
1375 "Mark ITEM with NEW-AGE."
1377 (setcar (nthcdr 4 item) new-age)
1378 ;; clean up ticker FIXME
1380 (newsticker--cache-update))
1382 (defun newsticker-treeview-mark-list-items-old ()
1383 "Mark all listed items as old."
1385 (let ((current-feed (or newsticker--treeview-current-feed
1386 newsticker--treeview-current-vfeed)))
1388 (set-buffer (newsticker--treeview-list-buffer))
1389 (goto-char (point-min))
1391 (let ((item (get-text-property (point) :nt-item)))
1392 (unless (memq (newsticker--age item) '(immortal obsolete))
1393 (newsticker--treeview-mark-item item 'old)))
1395 (newsticker--treeview-tree-update-tags)
1397 (newsticker-treeview-jump current-feed))))
1399 (defun newsticker-treeview-save-item ()
1400 "Save current item."
1402 (newsticker-save-item (or newsticker--treeview-current-feed
1403 newsticker--treeview-current-vfeed)
1404 (newsticker--treeview-get-selected-item)))
1406 (defun newsticker-treeview-browse-url-item ()
1407 "Convert current item to HTML and call `browse-url' on result."
1409 (newsticker-browse-url-item (or newsticker--treeview-current-feed
1410 newsticker--treeview-current-vfeed)
1411 (newsticker--treeview-get-selected-item)))
1413 (defun newsticker--treeview-set-current-node (node)
1414 "Make NODE the current node."
1416 (set-buffer (newsticker--treeview-tree-buffer))
1417 (setq newsticker--treeview-current-node-id
1418 (widget-get node :nt-id))
1419 (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
1420 (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
1421 (newsticker--treeview-tree-update-highlight)))
1423 (defun newsticker--treeview-get-first-child (node)
1424 "Get first child of NODE."
1425 (let ((children (widget-get node :children)))
1430 (defun newsticker--treeview-get-second-child (node)
1431 "Get scond child of NODE."
1432 (let ((children (widget-get node :children)))
1434 (car (cdr children))
1437 (defun newsticker--treeview-get-last-child (node)
1438 "Get last child of NODE."
1439 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1440 (let ((children (widget-get node :children)))
1442 (car (reverse children))
1445 (defun newsticker--treeview-get-feed-vfeed (node)
1446 "Get (virtual) feed of NODE."
1447 (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
1449 (defun newsticker--treeview-get-next-sibling (node)
1450 "Get next sibling of NODE."
1451 (let ((parent (widget-get node :parent)))
1453 (let ((children (widget-get parent :children)))
1455 (if (newsticker--treeview-nodes-eq (car children) node)
1456 (throw 'found (car (cdr children))))
1457 (setq children (cdr children)))))))
1459 (defun newsticker--treeview-get-prev-sibling (node)
1460 "Get previous sibling of NODE."
1461 (let ((parent (widget-get node :parent)))
1463 (let ((children (widget-get parent :children))
1466 (if (and (newsticker--treeview-nodes-eq (car children) node)
1467 (widget-get prev :nt-id))
1468 (throw 'found prev))
1469 (setq prev (car children))
1470 (setq children (cdr children)))))))
1472 (defun newsticker--treeview-get-next-uncle (node)
1473 "Get next uncle of NODE, i.e. parent's next sibling."
1474 (let* ((parent (widget-get node :parent))
1475 (grand-parent (widget-get parent :parent)))
1477 (let ((uncles (widget-get grand-parent :children)))
1479 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1480 (throw 'found (car (cdr uncles))))
1481 (setq uncles (cdr uncles)))))))
1483 (defun newsticker--treeview-get-prev-uncle (node)
1484 "Get previous uncle of NODE, i.e. parent's previous sibling."
1485 (let* ((parent (widget-get node :parent))
1486 (grand-parent (widget-get parent :parent)))
1488 (let ((uncles (widget-get grand-parent :children))
1491 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1492 (throw 'found prev))
1493 (setq prev (car uncles))
1494 (setq uncles (cdr uncles)))))))
1496 (defun newsticker--treeview-get-other-tree ()
1498 (if (and (newsticker--treeview-get-current-node)
1499 (widget-get (newsticker--treeview-get-current-node) :nt-feed))
1500 newsticker--treeview-vfeed-tree
1501 newsticker--treeview-feed-tree))
1503 (defun newsticker--treeview-activate-node (node &optional backward)
1505 If NODE is a tree widget the node's first subnode is activated.
1506 If BACKWARD is non-nil the last subnode of the previous sibling
1508 (newsticker--treeview-set-current-node node)
1509 (save-current-buffer
1510 (set-buffer (newsticker--treeview-tree-buffer))
1511 (cond ((eq (widget-type node) 'tree-widget)
1512 (unless (widget-get node :open)
1513 (widget-put node :open nil)
1514 (widget-apply-action node))
1515 (newsticker--treeview-activate-node
1517 (newsticker--treeview-get-last-child node)
1518 (newsticker--treeview-get-second-child node))))
1520 (widget-apply-action node)))))
1522 (defun newsticker-treeview-next-feed ()
1523 "Move to next feed."
1525 (newsticker--treeview-restore-layout)
1526 (let ((cur (newsticker--treeview-get-current-node)))
1527 ;;(message "newsticker-treeview-next-feed from %s"
1528 ;; (widget-get cur :tag))
1530 (let ((new (or (newsticker--treeview-get-next-sibling cur)
1531 (newsticker--treeview-get-next-uncle cur)
1532 (newsticker--treeview-get-other-tree))))
1533 (newsticker--treeview-activate-node new))
1534 (newsticker--treeview-activate-node
1535 (car (widget-get newsticker--treeview-feed-tree :children)))))
1536 (newsticker--treeview-tree-update-highlight))
1538 (defun newsticker-treeview-prev-feed ()
1539 "Move to previous feed."
1541 (newsticker--treeview-restore-layout)
1542 (let ((cur (newsticker--treeview-get-current-node)))
1543 (message "newsticker-treeview-prev-feed from %s"
1544 (widget-get cur :tag))
1546 (let ((new (or (newsticker--treeview-get-prev-sibling cur)
1547 (newsticker--treeview-get-prev-uncle cur)
1548 (newsticker--treeview-get-other-tree))))
1549 (newsticker--treeview-activate-node new t))
1550 (newsticker--treeview-activate-node
1551 (car (widget-get newsticker--treeview-feed-tree :children)) t)))
1552 (newsticker--treeview-tree-update-highlight))
1554 (defun newsticker-treeview-next-page ()
1555 "Scroll item buffer."
1557 (save-selected-window
1558 (select-window (newsticker--treeview-item-window) t)
1562 (goto-char (point-min))))))
1565 (defun newsticker--treeview-unfold-node (feed-name)
1566 "Recursively show subtree above the node that represents FEED-NAME."
1567 (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
1569 (let* ((group-name (or (car (newsticker--group-find-group-for-feed
1571 (newsticker--group-get-parent-group
1573 (newsticker--treeview-unfold-node group-name))
1574 (setq node (newsticker--treeview-get-node-of-feed feed-name)))
1577 (set-buffer (newsticker--treeview-tree-buffer))
1578 (widget-put node :nt-selected t)
1579 (widget-apply-action node)
1580 (newsticker--treeview-set-current-node node)))))
1582 (defun newsticker-treeview-jump (feed-name)
1583 "Jump to feed FEED-NAME in newsticker treeview."
1585 (list (let ((completion-ignore-case t))
1588 (mapcar 'car (append newsticker-url-list
1589 newsticker-url-list-defaults))
1591 (newsticker--treeview-unfold-node feed-name))
1593 ;; ======================================================================
1595 ;; ======================================================================
1596 (defun newsticker--group-do-find-group-for-feed (feed-name node)
1597 "Recursively find FEED-NAME in NODE."
1598 (if (member feed-name (cdr node))
1602 (newsticker--group-do-find-group-for-feed feed-name n)))
1605 (defun newsticker--group-find-group-for-feed (feed-name)
1606 "Find group containing FEED-NAME."
1608 (newsticker--group-do-find-group-for-feed feed-name
1612 (defun newsticker--group-do-get-group (name node)
1613 "Recursively find group with NAME below NODE."
1614 (if (string= name (car node))
1618 (newsticker--group-do-get-group name n)))
1621 (defun newsticker--group-get-group (name)
1622 "Find group with NAME."
1626 (newsticker--group-do-get-group name n)))
1630 (defun newsticker--group-do-get-parent-group (name node parent)
1631 "Recursively find parent group for NAME from NODE which is a child of PARENT."
1632 (if (string= name (car node))
1633 (throw 'found parent)
1636 (newsticker--group-do-get-parent-group name n (car node))))
1639 (defun newsticker--group-get-parent-group (name)
1640 "Find parent group for group named NAME."
1644 (newsticker--group-do-get-parent-group
1645 name n (car newsticker-groups))))
1650 (defun newsticker--group-get-subgroups (group &optional recursive)
1651 "Return list of subgroups for GROUP.
1652 If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1656 (setq result (cons (car n) result))
1657 (let ((subgroups (newsticker--group-get-subgroups n recursive)))
1659 (setq result (append subgroups result))))))
1663 (defun newsticker--group-all-groups ()
1664 "Return nested list of all groups."
1665 (newsticker--group-get-subgroups newsticker-groups t))
1667 (defun newsticker--group-get-feeds (group &optional recursive)
1668 "Return list of all feeds in GROUP.
1669 If RECURSIVE is non-nil recursively get feeds of subgroups and
1670 return a nested list."
1674 (setq result (cons n result))
1676 (let ((subfeeds (newsticker--group-get-feeds n t)))
1678 (setq result (append subfeeds result)))))))
1682 (defun newsticker-group-add-group (name parent)
1683 "Add group NAME to group PARENT."
1685 (list (read-string "Group Name: ")
1686 (let ((completion-ignore-case t))
1687 (completing-read "Parent Group: " (newsticker--group-all-groups)
1689 (if (newsticker--group-get-group name)
1690 (error "Group %s exists already" name))
1691 (let ((p (if (and parent (not (string= parent "")))
1692 (newsticker--group-get-group parent)
1693 newsticker-groups)))
1695 (error "Parent %s does not exist" parent))
1696 (setcdr p (cons (list name) (cdr p))))
1697 (newsticker--treeview-tree-update))
1699 (defun newsticker-group-move-feed (name group-name &optional no-update)
1700 "Move feed NAME to group GROUP-NAME.
1701 Update teeview afterwards unless NO-UPDATE is non-nil."
1703 (let ((completion-ignore-case t))
1704 (list (completing-read "Feed Name: "
1705 (mapcar 'car newsticker-url-list)
1706 nil t newsticker--treeview-current-feed)
1707 (completing-read "Group Name: " (newsticker--group-all-groups)
1709 (let ((group (if (and group-name (not (string= group-name "")))
1710 (newsticker--group-get-group group-name)
1711 newsticker-groups)))
1713 (error "Group %s does not exist" group-name))
1714 (while (let ((old-group
1715 (newsticker--group-find-group-for-feed name)))
1717 (delete name old-group))
1719 (setcdr group (cons name (cdr group)))
1721 (newsticker--treeview-tree-update)
1722 (newsticker-treeview-update))))
1724 (defun newsticker-group-delete-group (name)
1725 "Remove group NAME."
1727 (let ((completion-ignore-case t))
1728 (list (completing-read "Group Name: " (newsticker--group-all-groups)
1730 (let* ((g (newsticker--group-get-group name))
1731 (p (or (newsticker--group-get-parent-group name)
1732 newsticker-groups)))
1734 (error "Group %s does not exist" name))
1736 (newsticker--treeview-tree-update))
1738 (defun newsticker--count-groups (group)
1739 "Recursively count number of subgroups of GROUP."
1743 (setq result (+ result (newsticker--count-groups g)))))
1747 (defun newsticker--count-grouped-feeds (group)
1748 "Recursively count number of feeds in GROUP and its subgroups."
1752 (setq result (+ result (newsticker--count-grouped-feeds g)))
1753 (setq result (1+ result))))
1757 (defun newsticker--group-remove-obsolete-feeds (group)
1758 "Recursively remove obselete feeds from GROUP."
1760 (urls (append newsticker-url-list newsticker-url-list-defaults)))
1764 (newsticker--group-remove-obsolete-feeds g)))
1766 (setq result (cons sub-groups result))))
1768 (setq result (cons g result)))))
1771 (cons (car group) (reverse result))
1774 (defun newsticker--group-manage-orphan-feeds ()
1775 "Put unmanaged feeds into `newsticker-groups'.
1776 Remove obsolete feeds as well."
1777 (unless newsticker-groups
1778 (setq newsticker-groups '("Feeds")))
1779 (let ((new-feed nil)
1780 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
1782 (unless (newsticker--group-find-group-for-feed (car f))
1784 (newsticker-group-move-feed (car f) nil t)))
1785 (append newsticker-url-list-defaults newsticker-url-list))
1786 (setq newsticker-groups
1787 (newsticker--group-remove-obsolete-feeds newsticker-groups))
1789 (not (= grouped-feeds
1790 (newsticker--count-grouped-feeds newsticker-groups))))
1791 (newsticker--treeview-tree-update))))
1793 ;; ======================================================================
1795 ;; ======================================================================
1796 (defun newsticker--treeview-create-groups-menu (group-list
1798 "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
1799 (let ((menu (make-sparse-keymap (if (stringp (car group-list))
1801 "Move to group..."))))
1804 (let ((title (if (stringp (car g))
1806 "Move to group...")))
1807 (unless (eq g excluded-group)
1808 (define-key menu (vector (intern title))
1809 (list 'menu-item title
1810 (newsticker--treeview-create-groups-menu
1811 (cdr g) excluded-group)))))))
1812 (reverse group-list))
1815 (defun newsticker--treeview-create-tree-menu (feed-name)
1816 "Create tree menu for FEED-NAME."
1817 (let ((menu (make-sparse-keymap feed-name)))
1818 (define-key menu [newsticker-treeview-mark-list-items-old]
1819 (list 'menu-item "Mark all items old"
1820 'newsticker-treeview-mark-list-items-old))
1821 (define-key menu [move]
1822 (list 'menu-item "Move to group..."
1823 (newsticker--treeview-create-groups-menu
1825 (newsticker--group-get-group feed-name))))
1828 (defvar newsticker-treeview-list-menu
1829 (let ((menu (make-sparse-keymap "Newsticker List")))
1830 (define-key menu [newsticker-treeview-mark-list-items-old]
1831 (list 'menu-item "Mark all items old"
1832 'newsticker-treeview-mark-list-items-old))
1834 "Map for newsticker tree menu.")
1836 (defvar newsticker-treeview-mode-map
1837 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
1838 (define-key map " " 'newsticker-treeview-next-page)
1839 (define-key map "a" 'newsticker-add-url)
1840 (define-key map "b" 'newsticker-treeview-browse-url-item)
1841 (define-key map "F" 'newsticker-treeview-prev-feed)
1842 (define-key map "f" 'newsticker-treeview-next-feed)
1843 (define-key map "g" 'newsticker-treeview-get-news)
1844 (define-key map "G" 'newsticker-get-all-news)
1845 (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
1846 (define-key map "j" 'newsticker-treeview-jump)
1847 (define-key map "n" 'newsticker-treeview-next-item)
1848 (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
1849 (define-key map "O" 'newsticker-treeview-mark-list-items-old)
1850 (define-key map "o" 'newsticker-treeview-mark-item-old)
1851 (define-key map "p" 'newsticker-treeview-prev-item)
1852 (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
1853 (define-key map "q" 'newsticker-treeview-quit)
1854 (define-key map "S" 'newsticker-treeview-save-item)
1855 (define-key map "s" 'newsticker-treeview-save)
1856 (define-key map "u" 'newsticker-treeview-update)
1857 (define-key map "v" 'newsticker-treeview-browse-url)
1858 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
1859 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
1860 (define-key map "\M-m" 'newsticker-group-move-feed)
1861 (define-key map "\M-a" 'newsticker-group-add-group)
1863 "Mode map for newsticker treeview.")
1865 (defun newsticker-treeview-mode ()
1866 "Major mode for Newsticker Treeview.
1867 \\{newsticker-treeview-mode-map}"
1868 (kill-all-local-variables)
1869 (use-local-map newsticker-treeview-mode-map)
1870 (setq major-mode 'newsticker-treeview-mode)
1871 (setq mode-name "Newsticker TV")
1872 (if (boundp 'tool-bar-map)
1873 (set (make-local-variable 'tool-bar-map)
1874 newsticker-treeview-tool-bar-map))
1875 (setq buffer-read-only t
1878 (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
1880 (let ((header (concat
1881 (propertize " " 'display '(space :align-to 0))
1882 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
1883 (propertize " " 'display '(space :align-to 2))
1884 (if newsticker--treeview-list-show-feed
1886 (propertize " " 'display '(space :align-to 12)))
1888 (newsticker-treeview-list-make-sort-button "Date"
1890 (if newsticker--treeview-list-show-feed
1891 (propertize " " 'display '(space :align-to 28))
1892 (propertize " " 'display '(space :align-to 18)))
1893 (newsticker-treeview-list-make-sort-button "Title"
1895 (setq header-line-format header))
1896 (define-key newsticker-treeview-list-mode-map [down-mouse-3]
1897 newsticker-treeview-list-menu))
1899 (defun newsticker-treeview-tree-click (event)
1900 "Handle click EVENT on a tag in the newsticker tree."
1902 (newsticker--treeview-restore-layout)
1904 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1905 (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
1907 (defun newsticker-treeview-tree-do-click (&optional pos event)
1908 "Actually handle click event.
1909 POS gives the position where EVENT occurred."
1911 (unless pos (setq pos (point)))
1912 (let ((pos (or pos (point)))
1913 (nt-id (get-text-property pos :nt-id))
1914 (item (get-text-property pos :nt-item)))
1916 ;; click in list buffer
1917 (newsticker-treeview-show-item))
1919 ;; click in tree buffer
1920 (let ((w (newsticker--treeview-get-node nt-id)))
1922 (newsticker--treeview-tree-update-tag w t t)
1923 (setq w (newsticker--treeview-get-node nt-id))
1924 (widget-put w :nt-selected t)
1925 (widget-apply w :action event)
1926 (newsticker--treeview-set-current-node w))))))
1927 (newsticker--treeview-tree-update-highlight))
1929 (defun newsticker--treeview-restore-layout ()
1930 "Restore treeview buffers."
1933 (let ((win (nth i newsticker--treeview-windows))
1934 (buf (nth i newsticker--treeview-buffers)))
1935 (unless (window-live-p win)
1936 (newsticker--treeview-window-init)
1937 (newsticker--treeview-buffer-init)
1939 (unless (eq (window-buffer win) buf)
1940 (set-window-buffer win buf t))))))
1942 (defun newsticker--treeview-frame-init ()
1943 "Initialize treeview frame."
1944 (when newsticker-treeview-own-frame
1945 (unless (and newsticker--frame (frame-live-p newsticker--frame))
1946 (setq newsticker--frame (make-frame '((name . "Newsticker")))))
1947 (select-frame-set-input-focus newsticker--frame)
1948 (raise-frame newsticker--frame)))
1950 (defun newsticker--treeview-window-init ()
1951 "Initialize treeview windows."
1952 (setq newsticker--saved-window-config (current-window-configuration))
1953 (setq newsticker--treeview-windows nil)
1954 (setq newsticker--treeview-buffers nil)
1955 (delete-other-windows)
1956 (split-window-horizontally newsticker-treeview-treewindow-width)
1957 (add-to-list 'newsticker--treeview-windows (selected-window) t)
1959 (split-window-vertically newsticker-treeview-listwindow-height)
1960 (add-to-list 'newsticker--treeview-windows (selected-window) t)
1962 (add-to-list 'newsticker--treeview-windows (selected-window) t)
1966 (defun newsticker-treeview ()
1967 "Start newsticker treeview."
1969 (newsticker--treeview-load)
1970 (setq newsticker--sentinel-callback 'newsticker-treeview-update)
1971 (newsticker--treeview-frame-init)
1972 (newsticker--treeview-window-init)
1973 (newsticker--treeview-buffer-init)
1974 (newsticker--group-manage-orphan-feeds)
1975 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
1976 (newsticker-start t) ;; will start only if not running
1977 (newsticker-treeview-update)
1978 (newsticker--treeview-item-show-text
1980 "Welcome to newsticker!"))
1982 (defun newsticker-treeview-get-news ()
1983 "Get news for current feed."
1985 (when newsticker--treeview-current-feed
1986 (newsticker-get-news newsticker--treeview-current-feed)))
1988 (provide 'newsticker-treeview)
1990 ;; arch-tag: 5dbaff48-1f3e-4fc6-8ebd-e966fc90d2d4
1991 ;;; newst-treeview.el ends here