1 ;;; newst-treeview.el --- Treeview frontend for newsticker. -*- lexical-binding:t -*-
3 ;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
5 ;; Author: Ulf Jasper <ulf.jasper@web.de>
6 ;; Filename: newst-treeview.el
8 ;; Keywords: News, RSS, Atom
11 ;; ======================================================================
13 ;; This file is part of GNU Emacs.
15 ;; GNU Emacs is free software: you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation, either version 3 of the License, or
18 ;; (at your option) any later version.
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; ======================================================================
33 ;; ======================================================================
37 ;; ======================================================================
39 (require 'newst-reader)
41 (require 'tree-widget)
44 ;; ======================================================================
46 ;; ======================================================================
47 (defgroup newsticker-treeview nil
48 "Settings for the tree view reader."
49 :group 'newsticker-reader)
51 (defface newsticker-treeview-face
52 '((((class color) (background dark)) :foreground "white")
53 (((class color) (background light)) :foreground "black"))
54 "Face for newsticker tree."
55 :group 'newsticker-treeview)
57 (defface newsticker-treeview-new-face
58 '((t :inherit newsticker-treeview-face :weight bold))
59 "Face for newsticker tree."
60 :group 'newsticker-treeview)
62 (defface newsticker-treeview-old-face
63 '((t :inherit newsticker-treeview-face))
64 "Face for newsticker tree."
65 :group 'newsticker-treeview)
67 (defface newsticker-treeview-immortal-face
68 '((default :inherit newsticker-treeview-face :slant italic)
69 (((class color) (background dark)) :foreground "orange")
70 (((class color) (background light)) :foreground "blue"))
71 "Face for newsticker tree."
72 :group 'newsticker-treeview)
74 (defface newsticker-treeview-obsolete-face
75 '((t :inherit newsticker-treeview-face :strike-through t))
76 "Face for newsticker tree."
77 :group 'newsticker-treeview)
79 (defface newsticker-treeview-selection-face
80 '((((class color) (background dark)) :background "#4444aa")
81 (((class color) (background light)) :background "#bbbbff"))
82 "Face for newsticker selection."
83 :group 'newsticker-treeview)
85 (defcustom newsticker-treeview-date-format
87 "Format for the date column in the treeview list buffer.
88 See `format-time-string' for a list of valid specifiers."
91 :group 'newsticker-treeview)
93 (defcustom newsticker-treeview-own-frame
95 "Decides whether newsticker treeview creates and uses its own frame."
97 :group 'newsticker-treeview)
99 (defcustom newsticker-treeview-treewindow-width
101 "Width of tree window in treeview layout.
102 See also `newsticker-treeview-listwindow-height'."
104 :group 'newsticker-treeview)
106 (defcustom newsticker-treeview-listwindow-height
108 "Height of list window in treeview layout.
109 See also `newsticker-treeview-treewindow-width'."
111 :group 'newsticker-treeview)
113 (defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
115 "Decides whether to automatically mark displayed items as old.
116 If t an item is marked as old as soon as it is displayed. This
117 applies to newsticker only."
119 :group 'newsticker-treeview)
121 (defvar newsticker-groups
123 "List of feed groups, used in the treeview frontend.
124 First element is a string giving the group name. Remaining
125 elements are either strings giving a feed name or lists having
126 the same structure as `newsticker-groups'. (newsticker-groups :=
127 groupdefinition, groupdefinition := groupname groupcontent*,
128 groupcontent := feedname | groupdefinition)
130 Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
133 (defcustom newsticker-groups-filename
135 "Name of the newsticker groups settings file."
136 :version "25.1" ; changed default value to nil
137 :type '(choice (const nil) string)
138 :group 'newsticker-treeview)
139 (make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
141 ;; ======================================================================
142 ;;; internal variables
143 ;; ======================================================================
144 (defvar newsticker--treeview-windows nil)
145 (defvar newsticker--treeview-buffers nil)
146 (defvar newsticker--treeview-current-feed nil
147 "Feed name of currently shown item.")
148 (defvar newsticker--treeview-current-vfeed nil)
149 (defvar newsticker--treeview-list-show-feed nil)
150 (defvar newsticker--saved-window-config nil)
151 (defvar newsticker--selection-overlay nil
152 "Highlight the selected tree node.")
153 (defvar newsticker--tree-selection-overlay nil
154 "Highlight the selected list item.")
155 (defvar newsticker--frame nil "Special frame for newsticker windows.")
156 (defvar newsticker--treeview-list-sort-order 'sort-by-time)
157 (defvar newsticker--treeview-current-node-id nil)
158 (defvar newsticker--treeview-current-tree nil)
159 (defvar newsticker--treeview-feed-tree nil)
160 (defvar newsticker--treeview-vfeed-tree nil)
162 ;; maps for the clickable portions
163 (defvar newsticker--treeview-url-keymap
164 (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
165 (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
166 (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
167 (define-key map "\n" 'newsticker-treeview-browse-url)
168 (define-key map "\C-m" 'newsticker-treeview-browse-url)
169 (define-key map [(control return)] 'newsticker-handle-url)
171 "Key map for click-able headings in the newsticker treeview buffers.")
174 ;; ======================================================================
176 ;; ======================================================================
177 (defsubst newsticker--treeview-tree-buffer ()
178 "Return the tree buffer of the newsticker treeview."
179 (nth 0 newsticker--treeview-buffers))
180 (defsubst newsticker--treeview-list-buffer ()
181 "Return the list buffer of the newsticker treeview."
182 (nth 1 newsticker--treeview-buffers))
183 (defsubst newsticker--treeview-item-buffer ()
184 "Return the item buffer of the newsticker treeview."
185 (nth 2 newsticker--treeview-buffers))
186 (defsubst newsticker--treeview-tree-window ()
187 "Return the tree window of the newsticker treeview."
188 (nth 0 newsticker--treeview-windows))
189 (defsubst newsticker--treeview-list-window ()
190 "Return the list window of the newsticker treeview."
191 (nth 1 newsticker--treeview-windows))
192 (defsubst newsticker--treeview-item-window ()
193 "Return the item window of the newsticker treeview."
194 (nth 2 newsticker--treeview-windows))
196 ;; ======================================================================
197 ;;; utility functions
198 ;; ======================================================================
199 (defun newsticker--treeview-get-id (parent i)
200 "Create an id for a newsticker treeview node.
201 PARENT is the node's parent, I is an integer."
202 ;;(message "newsticker--treeview-get-id %s"
203 ;; (format "%s-%d" (widget-get parent :nt-id) i))
204 (format "%s-%d" (widget-get parent :nt-id) i))
206 (defun newsticker--treeview-ids-eq (id1 id2)
207 "Return non-nil if ids ID1 and ID2 are equal."
208 ;;(message "%s/%s" (or id1 -1) (or id2 -1))
209 (and id1 id2 (string= id1 id2)))
211 (defun newsticker--treeview-nodes-eq (node1 node2)
212 "Compare treeview nodes NODE1 and NODE2 for equality.
213 Nodes are equal if the have the same newsticker-id. Note that
214 during re-tagging and collapsing/expanding nodes change, while
215 their id stays constant."
216 (let ((id1 (widget-get node1 :nt-id))
217 (id2 (widget-get node2 :nt-id)))
218 ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
219 ;; (or id1 -1) (or id2 -1))
220 (or (newsticker--treeview-ids-eq id1 id2)
221 (string= (widget-get node1 :nt-feed) (widget-get node2 :nt-feed)))))
223 (defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
224 "Recursively search node for feed FEED-NAME starting from STARTNODE."
225 ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
226 (if (string= feed-name (or (widget-get startnode :nt-feed)
227 (widget-get startnode :nt-vfeed)))
228 (throw 'found startnode)
229 (let ((children (widget-get startnode :children)))
231 (newsticker--treeview-do-get-node-of-feed feed-name w)))))
233 (defun newsticker--treeview-get-node-of-feed (feed-name)
234 "Return node for feed FEED-NAME in newsticker treeview tree."
236 (newsticker--treeview-do-get-node-of-feed feed-name
237 newsticker--treeview-feed-tree)
238 (newsticker--treeview-do-get-node-of-feed feed-name
239 newsticker--treeview-vfeed-tree)))
241 (defun newsticker--treeview-do-get-node-by-id (id startnode)
242 "Recursively search node with ID starting from STARTNODE."
243 (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
244 (throw 'found startnode)
245 (let ((children (widget-get startnode :children)))
247 (newsticker--treeview-do-get-node-by-id id w)))))
249 (defun newsticker--treeview-get-node-by-id (id)
250 "Return node with ID in newsticker treeview tree."
252 (newsticker--treeview-do-get-node-by-id id newsticker--treeview-feed-tree)
253 (newsticker--treeview-do-get-node-by-id id newsticker--treeview-vfeed-tree)))
255 (defun newsticker--treeview-get-current-node ()
256 "Return current node in newsticker treeview tree."
257 (newsticker--treeview-get-node-by-id newsticker--treeview-current-node-id))
259 ;; ======================================================================
261 (unless (fboundp 'declare-function) (defmacro declare-function (&rest _)))
262 (declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
263 (defvar w3m-fill-column)
264 (defvar w3-maximum-line-length)
266 (defun newsticker--treeview-render-text (start end)
267 "Render text between markers START and END."
268 (if newsticker-html-renderer
269 (condition-case error-data
270 ;; Need to save selected window in order to prevent mixing
271 ;; up contents of the item buffer. This happens with shr
272 ;; which does some smart optimizations that apparently
273 ;; interfere with our own, maybe not-so-smart, optimizations.
274 (save-selected-window
276 (set-marker-insertion-type end t)
277 ;; check whether it is necessary to call html renderer
278 ;; (regexp inspired by htmlr.el)
280 (when (re-search-forward
281 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
282 ;; (message "%s" (newsticker--title item))
283 (let ((w3m-fill-column (if newsticker-use-full-width
285 (w3-maximum-line-length
286 (if newsticker-use-full-width nil fill-column)))
287 (select-window (newsticker--treeview-item-window))
289 (funcall newsticker-html-renderer start end)))
290 ;;(cond ((eq newsticker-html-renderer 'w3m-region)
291 ;; (add-text-properties start end (list 'keymap
292 ;; w3m-minor-mode-map)))
293 ;;((eq newsticker-html-renderer 'w3-region)
294 ;;(add-text-properties start end (list 'keymap w3-mode-map))))
295 (if (eq newsticker-html-renderer 'w3m-region)
296 (w3m-toggle-inline-images t))
299 (message "Error: HTML rendering failed: %s, %s"
300 (car error-data) (cdr error-data))
304 ;; ======================================================================
306 ;; ======================================================================
307 (defun newsticker--treeview-list-add-item (item feed &optional show-feed)
308 "Add news ITEM for FEED to newsticker treeview list window.
309 If string SHOW-FEED is non-nil it is shown in the item string."
310 (setq newsticker--treeview-list-show-feed show-feed)
311 (with-current-buffer (newsticker--treeview-list-buffer)
312 (let* ((inhibit-read-only t)
314 (goto-char (point-max))
315 (setq pos1 (point-marker))
317 (insert (propertize " " 'display '(space :align-to 2)))
318 (insert (if show-feed
321 (format "%-10s" (newsticker--real-feed-name
324 (propertize " " 'display '(space :align-to 12)))
326 (insert (format-time-string newsticker-treeview-date-format
327 (newsticker--time item)))
328 (insert (propertize " " 'display
329 (list 'space :align-to (if show-feed 28 18))))
330 (setq pos2 (point-marker))
331 (insert (newsticker--title item))
333 (newsticker--treeview-render-text pos2 (point-marker))
335 (while (search-forward "\n" nil t)
337 (let ((map (make-sparse-keymap)))
338 (dolist (key'([mouse-1] [mouse-3]))
339 (define-key map key 'newsticker-treeview-tree-click))
340 (define-key map "\n" 'newsticker-treeview-show-item)
341 (define-key map "\C-m" 'newsticker-treeview-show-item)
342 (add-text-properties pos1 (point-max)
345 :nt-link (newsticker--link item)
346 'mouse-face 'highlight
348 'help-echo (buffer-substring pos2
352 (defun newsticker--treeview-list-clear ()
353 "Clear the newsticker treeview list window."
354 (with-current-buffer (newsticker--treeview-list-buffer)
355 (let ((inhibit-read-only t))
357 (kill-all-local-variables)
360 (defun newsticker--treeview-list-items-with-age-callback (widget
363 "Fill newsticker treeview list window with items of certain age.
364 This is a callback function for the treeview nodes.
365 Argument WIDGET is the calling treeview widget.
366 Argument CHANGED-WIDGET is the widget that actually has changed.
367 Optional argument AGES is the list of ages that are to be shown."
368 (newsticker--treeview-list-clear)
369 (widget-put widget :nt-selected t)
370 (apply #'newsticker--treeview-list-items-with-age ages))
372 (defun newsticker--treeview-list-items-with-age (&rest ages)
373 "Actually fill newsticker treeview list window with items of certain age.
374 AGES is the list of ages that are to be shown."
376 (let ((feed-name-symbol (intern (car feed))))
378 (when (memq (newsticker--age item) ages)
379 (newsticker--treeview-list-add-item
380 item feed-name-symbol t)))
381 (newsticker--treeview-list-sort-items
382 (cdr (newsticker--cache-get-feed feed-name-symbol))))))
383 (append newsticker-url-list-defaults newsticker-url-list))
384 (newsticker--treeview-list-update nil))
386 (defun newsticker--treeview-list-new-items (widget changed-widget
388 "Fill newsticker treeview list window with new items.
389 This is a callback function for the treeview nodes.
390 Argument WIDGET is the calling treeview widget.
391 Argument CHANGED-WIDGET is the widget that actually has changed.
392 Optional argument EVENT is the mouse event that triggered this action."
393 (newsticker--treeview-list-items-with-age-callback widget changed-widget
395 (newsticker--treeview-item-show-text
397 "This is a virtual feed containing all new items"))
399 (defun newsticker--treeview-list-immortal-items (widget changed-widget
401 "Fill newsticker treeview list window with immortal items.
402 This is a callback function for the treeview nodes.
403 Argument WIDGET is the calling treeview widget.
404 Argument CHANGED-WIDGET is the widget that actually has changed.
405 Optional argument EVENT is the mouse event that triggered this action."
406 (newsticker--treeview-list-items-with-age-callback widget changed-widget
408 (newsticker--treeview-item-show-text
410 "This is a virtual feed containing all immortal items."))
412 (defun newsticker--treeview-list-obsolete-items (widget changed-widget
414 "Fill newsticker treeview list window with obsolete items.
415 This is a callback function for the treeview nodes.
416 Argument WIDGET is the calling treeview widget.
417 Argument CHANGED-WIDGET is the widget that actually has changed.
418 Optional argument EVENT is the mouse event that triggered this action."
419 (newsticker--treeview-list-items-with-age-callback widget changed-widget
421 (newsticker--treeview-item-show-text
423 "This is a virtual feed containing all obsolete items."))
425 (defun newsticker--treeview-list-all-items (widget changed-widget
427 "Fill newsticker treeview list window with all items.
428 This is a callback function for the treeview nodes.
429 Argument WIDGET is the calling treeview widget.
430 Argument CHANGED-WIDGET is the widget that actually has changed.
431 Optional argument EVENT is the mouse event that triggered this action."
432 (newsticker--treeview-list-items-with-age-callback widget changed-widget
435 (newsticker--treeview-item-show-text
437 "This is a virtual feed containing all items."))
439 (defun newsticker--treeview-list-items-v (vfeed-name)
440 "List items for virtual feed VFEED-NAME."
442 (cond ((string-match "\\*new\\*" vfeed-name)
443 (newsticker--treeview-list-items-with-age 'new))
444 ((string-match "\\*immortal\\*" vfeed-name)
445 (newsticker--treeview-list-items-with-age 'immortal))
446 ((string-match "\\*old\\*" vfeed-name)
447 (newsticker--treeview-list-items-with-age 'old nil)))
448 (newsticker--treeview-list-update nil)
451 (defun newsticker--treeview-list-items (feed-name)
452 "List items for feed FEED-NAME."
454 (if (newsticker--treeview-virtual-feed-p feed-name)
455 (newsticker--treeview-list-items-v feed-name)
457 (if (eq (newsticker--age item) 'feed)
458 (newsticker--treeview-item-show item (intern feed-name))
459 (newsticker--treeview-list-add-item item
460 (intern feed-name))))
461 (newsticker--treeview-list-sort-items
462 (cdr (newsticker--cache-get-feed (intern feed-name)))))
463 (newsticker--treeview-list-update nil))))
465 (defun newsticker--treeview-list-feed-items (widget _changed-widget
467 "Callback function for listing feed items.
468 Argument WIDGET is the calling treeview widget.
469 Argument CHANGED-WIDGET is the widget that actually has changed.
470 Optional argument EVENT is the mouse event that triggered this action."
471 (newsticker--treeview-list-clear)
472 (widget-put widget :nt-selected t)
473 (let ((feed-name (widget-get widget :nt-feed))
474 (vfeed-name (widget-get widget :nt-vfeed)))
476 (newsticker--treeview-list-items feed-name)
477 (newsticker--treeview-list-items-v vfeed-name))))
479 (defun newsticker--treeview-list-compare-item-by-age (item1 item2)
480 "Compare two news items ITEM1 and ITEM2 wrt age."
482 (let ((age1 (newsticker--age item1))
483 (age2 (newsticker--age item2)))
484 (cond ((eq age1 'new)
487 (cond ((eq age2 'new)
494 (cond ((eq age2 'new)
505 (defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
506 "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
507 (newsticker--treeview-list-compare-item-by-age item2 item1))
509 (defun newsticker--treeview-list-compare-item-by-time (item1 item2)
510 "Compare two news items ITEM1 and ITEM2 wrt time values."
511 (newsticker--cache-item-compare-by-time item1 item2))
513 (defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
514 "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
515 (newsticker--cache-item-compare-by-time item2 item1))
517 (defun newsticker--treeview-list-compare-item-by-title (item1 item2)
518 "Compare two news items ITEM1 and ITEM2 wrt title."
519 (newsticker--cache-item-compare-by-title item1 item2))
521 (defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
522 "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
523 (newsticker--cache-item-compare-by-title item2 item1))
525 (defun newsticker--treeview-list-sort-items (items)
526 "Return sorted copy of list ITEMS.
527 The sort function is chosen according to the value of
528 `newsticker--treeview-list-sort-order'."
530 (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
531 'newsticker--treeview-list-compare-item-by-age)
532 ((eq newsticker--treeview-list-sort-order
533 'sort-by-age-reverse)
534 'newsticker--treeview-list-compare-item-by-age-reverse)
535 ((eq newsticker--treeview-list-sort-order 'sort-by-time)
536 'newsticker--treeview-list-compare-item-by-time)
537 ((eq newsticker--treeview-list-sort-order
538 'sort-by-time-reverse)
539 'newsticker--treeview-list-compare-item-by-time-reverse)
540 ((eq newsticker--treeview-list-sort-order 'sort-by-title)
541 'newsticker--treeview-list-compare-item-by-title)
542 ((eq newsticker--treeview-list-sort-order
543 'sort-by-title-reverse)
544 'newsticker--treeview-list-compare-item-by-title-reverse)
546 'newsticker--treeview-list-compare-item-by-title))))
547 (sort (copy-sequence items) sort-fun)))
549 (defun newsticker--treeview-list-update-faces ()
550 "Update faces in the treeview list buffer."
552 (with-current-buffer (newsticker--treeview-list-buffer)
554 (let ((inhibit-read-only t))
555 (goto-char (point-min))
557 (let* ((pos (point-at-eol))
558 (item (get-text-property (point) :nt-item))
559 (age (newsticker--age item))
560 (selected (get-text-property (point) :nt-selected))
561 (face (cond ((eq age 'new)
562 'newsticker-treeview-new-face)
564 'newsticker-treeview-old-face)
566 'newsticker-treeview-immortal-face)
568 'newsticker-treeview-obsolete-face)
571 (put-text-property (point) pos 'face face)
573 (move-overlay newsticker--selection-overlay (point)
574 (1+ pos) ;include newline
576 (if selected (setq pos-sel (point)))
578 (beginning-of-line)))))) ;; FIXME!?
580 (if (window-live-p (newsticker--treeview-list-window))
581 (set-window-point (newsticker--treeview-list-window) pos-sel)))))
583 (defun newsticker--treeview-list-clear-highlight ()
584 "Clear the highlight in the treeview list buffer."
585 (with-current-buffer (newsticker--treeview-list-buffer)
586 (let ((inhibit-read-only t))
587 (put-text-property (point-min) (point-max) :nt-selected nil))
588 (newsticker--treeview-list-update-faces)))
590 (defun newsticker--treeview-list-update-highlight ()
591 "Update the highlight in the treeview list buffer."
592 (newsticker--treeview-list-clear-highlight)
593 (with-current-buffer (newsticker--treeview-list-buffer)
594 (let ((inhibit-read-only t))
595 (put-text-property (point-at-bol) (point-at-eol) :nt-selected t))
596 (newsticker--treeview-list-update-faces)))
598 (defun newsticker--treeview-list-highlight-start ()
599 "Return position of selection in treeview list buffer."
600 (with-current-buffer (newsticker--treeview-list-buffer)
602 (goto-char (point-min))
603 (next-single-property-change (point) :nt-selected))))
605 (defun newsticker--treeview-list-update (clear-buffer)
606 "Update the faces and highlight in the treeview list buffer.
607 If CLEAR-BUFFER is non-nil the list buffer is completely erased."
609 (if (window-live-p (newsticker--treeview-list-window))
610 (set-window-buffer (newsticker--treeview-list-window)
611 (newsticker--treeview-list-buffer)))
612 (set-buffer (newsticker--treeview-list-buffer))
614 (let ((inhibit-read-only t))
616 (newsticker-treeview-list-mode)
617 (newsticker--treeview-list-update-faces)
618 (goto-char (point-min))))
620 (defvar newsticker-treeview-list-sort-button-map
621 (let ((map (make-sparse-keymap)))
622 (define-key map [header-line mouse-1]
623 'newsticker--treeview-list-sort-by-column)
624 (define-key map [header-line mouse-2]
625 'newsticker--treeview-list-sort-by-column)
627 "Local keymap for newsticker treeview list window sort buttons.")
629 (defun newsticker--treeview-list-sort-by-column (&optional event)
630 "Sort the newsticker list window buffer by the column clicked on.
631 Optional argument EVENT is the mouse event that triggered this action."
632 (interactive (list last-input-event))
633 (if event (mouse-select-window event))
634 (let* ((pos (event-start event))
635 (obj (posn-object pos))
637 (get-text-property (cdr obj) 'sort-order (car obj))
638 (get-text-property (posn-point pos) 'sort-order))))
639 (setq newsticker--treeview-list-sort-order
640 (cond ((eq sort-order 'sort-by-age)
641 (if (eq newsticker--treeview-list-sort-order 'sort-by-age)
644 ((eq sort-order 'sort-by-time)
645 (if (eq newsticker--treeview-list-sort-order 'sort-by-time)
646 'sort-by-time-reverse
648 ((eq sort-order 'sort-by-title)
649 (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
650 'sort-by-title-reverse
652 (newsticker-treeview-update)))
654 (defun newsticker-treeview-list-make-sort-button (name sort-order)
655 "Create propertized string for headerline button.
656 NAME is the button text, SORT-ORDER is the associated sort order
658 (let ((face (if (string-match (symbol-name sort-order)
660 newsticker--treeview-list-sort-order))
664 'sort-order sort-order
665 'help-echo (concat "Sort by " name)
666 'mouse-face 'highlight
668 'keymap newsticker-treeview-list-sort-button-map)))
670 (defun newsticker--treeview-list-select (item)
671 "Select ITEM in treeview's list buffer."
672 (newsticker--treeview-list-clear-highlight)
674 (set-buffer (newsticker--treeview-list-buffer))
675 (goto-char (point-min))
678 (let ((it (get-text-property (point) :nt-item)))
680 (newsticker--treeview-list-update-highlight)
681 (newsticker--treeview-list-update-faces)
682 (newsticker--treeview-item-show
683 item (get-text-property (point) :nt-feed))
687 (goto-char (point-min))
688 (throw 'found nil))))))
690 ;; ======================================================================
692 ;; ======================================================================
693 (defun newsticker--treeview-item-show-text (title description)
694 "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
695 (with-current-buffer (newsticker--treeview-item-buffer)
696 (when (fboundp 'w3m-process-stop)
697 (w3m-process-stop (current-buffer)))
698 (let ((inhibit-read-only t))
700 (kill-all-local-variables)
703 (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
704 (insert "\n\n" description)
705 (when newsticker-justification
706 (fill-region (point-min) (point-max) newsticker-justification))
707 (newsticker-treeview-item-mode)
708 (goto-char (point-min)))))
710 (defun newsticker--treeview-item-show (item feed-name-symbol)
711 "Show news ITEM coming from FEED-NAME-SYMBOL in treeview item buffer."
712 (setq newsticker--treeview-current-feed (symbol-name feed-name-symbol))
713 (with-current-buffer (newsticker--treeview-item-buffer)
714 (when (fboundp 'w3m-process-stop)
715 (w3m-process-stop (current-buffer)))
716 (let ((inhibit-read-only t)
717 (is-rendered-HTML nil)
719 (marker1 (make-marker))
720 (marker2 (make-marker)))
722 (kill-all-local-variables)
725 (when (and item feed-name-symbol)
726 (let ((wwidth (1- (if (window-live-p (newsticker--treeview-item-window))
727 (window-width (newsticker--treeview-item-window))
729 (if newsticker-use-full-width
730 (set (make-local-variable 'fill-column) wwidth))
731 (set (make-local-variable 'fill-column) (min fill-column
733 (let ((desc (newsticker--desc item)))
734 (insert "\n" (or desc "[No Description]")))
735 (set-marker marker1 (1+ (point-min)))
736 (set-marker marker2 (point-max))
737 (setq is-rendered-HTML (newsticker--treeview-render-text marker1
739 (when (and newsticker-justification
740 (not is-rendered-HTML))
741 (fill-region marker1 marker2 newsticker-justification))
743 (newsticker-treeview-item-mode)
744 (goto-char (point-min))
745 ;; insert logo at top
746 (let* ((newsticker-enable-logo-manipulations nil)
747 (img (newsticker--image-read feed-name-symbol nil 40)))
748 (if (and (display-images-p) img)
749 (newsticker--insert-image img (car item))
750 (insert (newsticker--real-feed-name feed-name-symbol))))
751 (add-text-properties (point-min) (point)
752 (list 'face 'newsticker-feed-face
753 'mouse-face 'highlight
754 'help-echo "Visit in web browser."
755 :nt-link (newsticker--link item)
756 'keymap newsticker--treeview-url-keymap))
762 (insert (newsticker--title item) "\n")
763 (set-marker marker1 pos)
764 (set-marker marker2 (point))
765 (newsticker--treeview-render-text marker1 marker2)
766 (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
770 (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
771 (set-marker marker2 (point))
772 (when newsticker-justification
773 (fill-region marker1 marker2 newsticker-justification))
775 (add-text-properties marker1 (1- (point))
776 (list 'mouse-face 'highlight
777 'help-echo "Visit in web browser."
778 :nt-link (newsticker--link item)
779 'keymap newsticker--treeview-url-keymap))
780 (insert (format-time-string newsticker-date-format
781 (newsticker--time item)))
785 ;; insert enclosures and rest at bottom
786 (goto-char (point-max))
789 (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
790 (put-text-property pos (point) 'face 'newsticker-enclosure-face)
793 (set-marker marker1 pos)
794 (newsticker--print-extra-elements item newsticker--treeview-url-keymap t)
795 (set-marker marker2 (point))
796 (newsticker--treeview-render-text marker1 marker2)
797 (put-text-property marker1 marker2 'face 'newsticker-extra-face)
798 (goto-char (point-min)))))
799 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
801 (memq (newsticker--age item) '(new obsolete)))
802 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
803 (newsticker-treeview-mark-item-old t)
804 (newsticker--treeview-list-update-faces)))
805 (if (window-live-p (newsticker--treeview-item-window))
806 (set-window-point (newsticker--treeview-item-window) 1)))
808 (defun newsticker--treeview-item-update ()
809 "Update the treeview item buffer and window."
811 (if (window-live-p (newsticker--treeview-item-window))
812 (set-window-buffer (newsticker--treeview-item-window)
813 (newsticker--treeview-item-buffer)))
814 (set-buffer (newsticker--treeview-item-buffer))
815 (let ((inhibit-read-only t))
817 (newsticker-treeview-item-mode)))
819 ;; ======================================================================
821 ;; ======================================================================
822 (defun newsticker--treeview-tree-expand (tree)
824 Callback function for tree widget that adds nodes for feeds and subgroups."
825 (tree-widget-set-theme "folder")
826 (let ((group (widget-get tree :nt-group))
830 (setq nt-id (newsticker--treeview-get-id tree i))
833 (let* ((g-name (car g)))
835 :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
836 :expander newsticker--treeview-tree-expand
837 :expander-p (lambda (&rest ignore) t)
841 :leaf-icon newsticker--tree-widget-leaf-icon
842 :keep (:nt-feed :num-new :nt-id :open);; :nt-group
844 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
846 :leaf-icon newsticker--tree-widget-leaf-icon
848 :action newsticker--treeview-list-feed-items
854 (defun newsticker--tree-widget-icon-create (icon)
855 "Create the ICON widget."
856 (let* ((g (widget-get (widget-get icon :node) :nt-feed))
857 (ico (and g (newsticker--icon-read (intern g)))))
860 (widget-put icon :tag-glyph ico)
861 (widget-default-create icon)
862 ;; Insert space between the icon and the node widget.
866 'display (list 'space :width tree-widget-space-width)))
867 ;; fallback: default icon
868 (widget-put icon :leaf-icon 'tree-widget-leaf-icon)
869 (tree-widget-icon-create icon))))
871 (defun newsticker--treeview-tree-expand-status (tree &optional _changed-widget
873 "Expand the vfeed TREE.
874 Optional arguments CHANGED-WIDGET and EVENT are ignored."
875 (tree-widget-set-theme "folder")
876 (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
878 :action newsticker--treeview-list-new-items
879 :nt-id ,(newsticker--treeview-get-id tree 0)
881 `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
883 :action newsticker--treeview-list-immortal-items
884 :nt-id ,(newsticker--treeview-get-id tree 1)
886 `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
888 :action newsticker--treeview-list-obsolete-items
889 :nt-id ,(newsticker--treeview-get-id tree 2)
891 `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
893 :action newsticker--treeview-list-all-items
894 :nt-id ,(newsticker--treeview-get-id tree 3)
897 (defun newsticker--treeview-virtual-feed-p (feed-name)
898 "Return non-nil if FEED-NAME is a virtual feed."
899 (string-match "\\*.*\\*" feed-name))
901 (define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
902 "Icon for a tree-widget leaf node."
905 :create 'newsticker--tree-widget-icon-create
906 :button-face 'default)
908 (defun newsticker--treeview-tree-update ()
909 "Update treeview tree buffer and window."
911 (if (window-live-p (newsticker--treeview-tree-window))
912 (set-window-buffer (newsticker--treeview-tree-window)
913 (newsticker--treeview-tree-buffer)))
914 (set-buffer (newsticker--treeview-tree-buffer))
915 (kill-all-local-variables)
916 (let ((inhibit-read-only t))
918 (tree-widget-set-theme "folder")
919 (setq newsticker--treeview-feed-tree
920 (widget-create 'tree-widget
921 :tag (newsticker--treeview-propertize-tag
923 :expander 'newsticker--treeview-tree-expand
924 :expander-p (lambda (&rest _) t)
925 :leaf-icon 'newsticker--tree-widget-leaf-icon
926 :nt-group (cdr newsticker-groups)
930 (setq newsticker--treeview-vfeed-tree
931 (widget-create 'tree-widget
932 :tag (newsticker--treeview-propertize-tag
933 "Virtual Feeds" 0 "vfeeds")
934 :expander 'newsticker--treeview-tree-expand-status
935 :expander-p (lambda (&rest _) t)
936 :leaf-icon 'newsticker--tree-widget-leaf-icon
940 (use-local-map widget-keymap)
942 (newsticker-treeview-mode)))
944 (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
946 "Return propertized copy of string TAG.
947 Optional argument NUM-NEW is used for choosing face, other
948 arguments NT-ID, FEED, and VFEED are added as properties."
949 ;;(message "newsticker--treeview-propertize-tag `%s' %s" feed nt-id)
950 (let ((face 'newsticker-treeview-face)
951 (map (make-sparse-keymap)))
952 (if (and num-new (> num-new 0))
953 (setq face 'newsticker-treeview-new-face))
954 (dolist (key '([mouse-1] [mouse-3]))
955 (define-key map key 'newsticker-treeview-tree-click))
956 (define-key map "\n" 'newsticker-treeview-tree-do-click)
957 (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
958 (propertize tag 'face face 'keymap map
963 'mouse-face 'highlight)))
965 (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
967 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
968 Optional argument NT-ID is added to the tag's properties."
969 (let (tag (num-new 0))
971 (cond ((string= vfeed-name "new")
972 (setq num-new (newsticker--stat-num-items-total 'new))
973 (setq tag (format "New items (%d)" num-new)))
974 ((string= vfeed-name "immortal")
975 (setq num-new (newsticker--stat-num-items-total 'immortal))
976 (setq tag (format "Immortal items (%d)" num-new)))
977 ((string= vfeed-name "obsolete")
978 (setq num-new (newsticker--stat-num-items-total 'obsolete))
979 (setq tag (format "Obsolete items (%d)" num-new)))
980 ((string= vfeed-name "all")
981 (setq num-new (newsticker--stat-num-items-total))
982 (setq tag (format "All items (%d)" num-new)))))
984 (setq num-new (newsticker--stat-num-items-for-group
985 (intern feed-name) 'new 'immortal))
988 (newsticker--real-feed-name (intern feed-name))
991 (newsticker--treeview-propertize-tag tag num-new
993 feed-name vfeed-name))))
995 (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
996 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
997 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
998 (let ((result (apply #'newsticker--stat-num-items feed-name-symbol ages)))
1000 (setq result (+ result
1001 (apply #'newsticker--stat-num-items (intern f-n)
1003 (newsticker--group-get-feeds
1004 (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
1007 (defun newsticker--treeview-count-node-items (feed &optional isvirtual)
1008 "Count number of relevant items for a treeview node.
1009 FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
1010 the feed is a virtual feed."
1014 (cond ((string= feed "new")
1015 (setq num-new (newsticker--stat-num-items-total 'new)))
1016 ((string= feed "immortal")
1017 (setq num-new (newsticker--stat-num-items-total 'immortal)))
1018 ((string= feed "obsolete")
1019 (setq num-new (newsticker--stat-num-items-total 'obsolete)))
1020 ((string= feed "all")
1021 (setq num-new (newsticker--stat-num-items-total))))
1022 (setq num-new (newsticker--stat-num-items-for-group
1023 (intern feed) 'new 'immortal))))
1026 (defun newsticker--treeview-tree-update-tag (w &optional recursive
1028 "Update tag for tree widget W.
1029 If RECURSIVE is non-nil recursively update parent widgets as
1030 well. Argument IGNORE is ignored. Note that this function, if
1031 called recursively, makes w invalid. You should keep w's nt-id in
1033 (let* ((parent (widget-get w :parent))
1034 (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
1035 (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
1036 (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
1037 (num-new (newsticker--treeview-count-node-items (or feed vfeed)
1039 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
1040 (n (widget-get w :node)))
1043 (newsticker--treeview-tree-update-tag parent)))
1046 (widget-put n :tag tag))
1047 (widget-put w :num-new num-new)
1048 (widget-put w :tag tag)
1049 (when (marker-position (widget-get w :from))
1051 ;; FIXME: This moves point!!!!
1052 (with-current-buffer (newsticker--treeview-tree-buffer)
1053 (widget-value-set w (widget-value w)))
1056 (defun newsticker--treeview-tree-do-update-tags (widget)
1057 "Actually recursively update tags for WIDGET."
1059 (let ((children (widget-get widget :children)))
1060 (dolist (w children)
1061 (newsticker--treeview-tree-do-update-tags w))
1062 (newsticker--treeview-tree-update-tag widget))))
1064 (defun newsticker--treeview-tree-update-tags (&rest _ignore)
1065 "Update all tags of all trees.
1066 Arguments are ignored."
1067 (save-current-buffer
1068 (set-buffer (newsticker--treeview-tree-buffer))
1069 (let ((inhibit-read-only t))
1070 (newsticker--treeview-tree-do-update-tags
1071 newsticker--treeview-feed-tree)
1072 (newsticker--treeview-tree-do-update-tags
1073 newsticker--treeview-vfeed-tree))
1074 (tree-widget-set-theme "folder")))
1076 (defun newsticker--treeview-tree-update-highlight ()
1077 "Update highlight in tree buffer."
1078 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
1079 (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
1080 (setq pos (widget-get (widget-get
1081 (newsticker--treeview-get-current-node)
1083 (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
1084 (with-current-buffer (newsticker--treeview-tree-buffer)
1086 (move-overlay newsticker--tree-selection-overlay
1087 (point-at-bol) (1+ (point-at-eol))
1089 (if (window-live-p (newsticker--treeview-tree-window))
1090 (set-window-point (newsticker--treeview-tree-window) pos)))))
1092 ;; ======================================================================
1094 ;; ======================================================================
1095 (defvar newsticker-treeview-tool-bar-map
1096 (if (featurep 'xemacs)
1098 (if (boundp 'tool-bar-map)
1099 (let ((tool-bar-map (make-sparse-keymap)))
1100 (tool-bar-add-item "newsticker/prev-feed"
1101 'newsticker-treeview-prev-feed
1102 'newsticker-treeview-prev-feed
1103 :help "Go to previous feed"
1104 ;;:enable '(newsticker-previous-feed-available-p) FIXME
1106 (tool-bar-add-item "newsticker/prev-item"
1107 'newsticker-treeview-prev-item
1108 'newsticker-treeview-prev-item
1109 :help "Go to previous item"
1110 ;;:enable '(newsticker-previous-item-available-p) FIXME
1112 (tool-bar-add-item "newsticker/next-item"
1113 'newsticker-treeview-next-item
1114 'newsticker-treeview-next-item
1116 :help "Go to next item"
1117 ;;:enable '(newsticker-next-item-available-p) FIXME
1119 (tool-bar-add-item "newsticker/next-feed"
1120 'newsticker-treeview-next-feed
1121 'newsticker-treeview-next-feed
1122 :help "Go to next feed"
1123 ;;:enable '(newsticker-next-feed-available-p) FIXME
1125 (tool-bar-add-item "newsticker/mark-immortal"
1126 'newsticker-treeview-toggle-item-immortal
1127 'newsticker-treeview-toggle-item-immortal
1128 :help "Toggle current item as immortal"
1129 ;;:enable '(newsticker-item-not-immortal-p) FIXME
1131 (tool-bar-add-item "newsticker/mark-read"
1132 'newsticker-treeview-mark-item-old
1133 'newsticker-treeview-mark-item-old
1134 :help "Mark current item as read"
1135 ;;:enable '(newsticker-item-not-old-p) FIXME
1137 (tool-bar-add-item "newsticker/get-all"
1138 'newsticker-get-all-news
1139 'newsticker-get-all-news
1140 :help "Get news for all feeds")
1141 (tool-bar-add-item "newsticker/update"
1142 'newsticker-treeview-update
1143 'newsticker-treeview-update
1144 :help "Update newsticker buffer")
1145 (tool-bar-add-item "newsticker/browse-url"
1146 'newsticker-browse-url
1147 'newsticker-browse-url
1148 :help "Browse URL for item at point")
1149 ;; standard icons / actions
1150 (define-key tool-bar-map [newsticker-sep-1]
1151 (list 'menu-item "--double-line"))
1152 (tool-bar-add-item "close"
1153 'newsticker-treeview-quit
1154 'newsticker-treeview-quit
1155 :help "Close newsticker")
1156 (tool-bar-add-item "preferences"
1157 'newsticker-customize
1158 'newsticker-customize
1159 :help "Customize newsticker")
1162 ;; ======================================================================
1164 ;; ======================================================================
1166 (defun newsticker-treeview-mouse-browse-url (event)
1167 "Call `browse-url' for the link of the item at which the EVENT occurred."
1170 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1171 (let ((url (get-text-property (posn-point (event-end event))
1175 (if newsticker-automatically-mark-visited-items-as-old
1176 (newsticker-treeview-mark-item-old))))))
1178 (defun newsticker-treeview-browse-url ()
1179 "Call `browse-url' for the link of the item at point."
1181 (with-current-buffer (newsticker--treeview-list-buffer)
1182 (let ((url (get-text-property (point) :nt-link)))
1185 (if newsticker-automatically-mark-visited-items-as-old
1186 (newsticker-treeview-mark-item-old))))))
1188 (defun newsticker--treeview-buffer-init ()
1189 "Initialize all treeview buffers."
1190 (setq newsticker--treeview-buffers nil)
1191 (add-to-list 'newsticker--treeview-buffers
1192 (get-buffer-create "*Newsticker Tree*") t)
1193 (add-to-list 'newsticker--treeview-buffers
1194 (get-buffer-create "*Newsticker List*") t)
1195 (add-to-list 'newsticker--treeview-buffers
1196 (get-buffer-create "*Newsticker Item*") t)
1198 (unless newsticker--selection-overlay
1199 (with-current-buffer (newsticker--treeview-list-buffer)
1200 (setq buffer-undo-list t)
1201 (setq newsticker--selection-overlay (make-overlay (point-min)
1203 (overlay-put newsticker--selection-overlay 'face
1204 'newsticker-treeview-selection-face)))
1205 (unless newsticker--tree-selection-overlay
1206 (with-current-buffer (newsticker--treeview-tree-buffer)
1207 (setq buffer-undo-list t)
1208 (setq newsticker--tree-selection-overlay (make-overlay (point-min)
1210 (overlay-put newsticker--tree-selection-overlay 'face
1211 'newsticker-treeview-selection-face)))
1213 (newsticker--treeview-tree-update)
1214 (newsticker--treeview-list-update t)
1215 (newsticker--treeview-item-update))
1217 (defun newsticker-treeview-update ()
1218 "Update all treeview buffers and windows.
1219 Note: does not update the layout."
1221 (let ((cur-item (newsticker--treeview-get-selected-item)))
1222 (if (newsticker--group-manage-orphan-feeds)
1223 (newsticker--treeview-tree-update))
1224 (newsticker--treeview-list-update t)
1225 (newsticker--treeview-item-update)
1226 (newsticker--treeview-tree-update-tags)
1227 (cond (newsticker--treeview-current-feed
1228 (newsticker--treeview-list-items newsticker--treeview-current-feed))
1229 (newsticker--treeview-current-vfeed
1230 (newsticker--treeview-list-items-with-age
1231 (intern newsticker--treeview-current-vfeed))))
1232 (newsticker--treeview-tree-update-highlight)
1233 (newsticker--treeview-list-update-highlight)
1234 (let ((cur-feed (or newsticker--treeview-current-feed
1235 newsticker--treeview-current-vfeed)))
1236 (if (and cur-feed cur-item)
1237 (newsticker--treeview-list-select cur-item)))))
1239 (defun newsticker-treeview-quit ()
1240 "Quit newsticker treeview."
1242 (setq newsticker--sentinel-callback nil)
1243 (bury-buffer "*Newsticker Tree*")
1244 (bury-buffer "*Newsticker List*")
1245 (bury-buffer "*Newsticker Item*")
1246 (set-window-configuration newsticker--saved-window-config)
1247 (when newsticker--frame
1248 (if (frame-live-p newsticker--frame)
1249 (delete-frame newsticker--frame))
1250 (setq newsticker--frame nil))
1251 (newsticker-treeview-save))
1253 (defun newsticker-treeview-save ()
1254 "Save treeview group settings."
1256 (let ((coding-system-for-write 'utf-8)
1257 (buf (find-file-noselect (concat newsticker-dir "/groups"))))
1259 (with-current-buffer buf
1260 (setq buffer-undo-list t)
1262 (insert ";; -*- coding: utf-8 -*-\n")
1263 (insert (prin1-to-string newsticker-groups))
1267 (defun newsticker--treeview-load ()
1268 "Load treeview settings."
1269 (let* ((coding-system-for-read 'utf-8)
1271 (or (and newsticker-groups-filename
1273 (expand-file-name newsticker-groups-filename)
1274 (expand-file-name (concat newsticker-dir "/groups"))))
1275 (file-exists-p newsticker-groups-filename)
1278 (concat "Obsolete variable `newsticker-groups-filename' "
1279 "points to existing file \"%s\".\n"
1281 newsticker-groups-filename))
1282 newsticker-groups-filename)
1283 (concat newsticker-dir "/groups")))
1284 (buf (and (file-exists-p filename)
1285 (find-file-noselect filename))))
1286 (and newsticker-groups-filename
1287 (file-exists-p newsticker-groups-filename)
1288 (y-or-n-p (format-message
1289 (concat "Delete the file \"%s\",\nto which the obsolete "
1290 "variable `newsticker-groups-filename' points ? ")
1291 newsticker-groups-filename))
1292 (delete-file newsticker-groups-filename))
1295 (goto-char (point-min))
1297 (setq newsticker-groups (read buf))
1299 (message "Error while reading newsticker groups file!")
1300 (setq newsticker-groups nil)))
1301 (kill-buffer buf))))
1304 (defun newsticker-treeview-scroll-item ()
1305 "Scroll current item."
1307 (save-selected-window
1308 (select-window (newsticker--treeview-item-window) t)
1311 (defun newsticker-treeview-show-item ()
1312 "Show current item."
1314 (newsticker--treeview-restore-layout)
1315 (newsticker--treeview-list-update-highlight)
1316 (with-current-buffer (newsticker--treeview-list-buffer)
1318 (let ((item (get-text-property (point) :nt-item))
1319 (feed (get-text-property (point) :nt-feed)))
1320 (newsticker--treeview-item-show item feed)))
1321 (newsticker--treeview-tree-update-tag
1322 (newsticker--treeview-get-current-node) t)
1323 (newsticker--treeview-tree-update-highlight))
1325 (defun newsticker-treeview-next-item ()
1326 "Move to next item."
1328 (newsticker--treeview-restore-layout)
1329 (save-current-buffer
1330 (set-buffer (newsticker--treeview-list-buffer))
1331 (if (newsticker--treeview-list-highlight-start)
1335 (newsticker-treeview-show-item))
1337 (defun newsticker-treeview-prev-item ()
1338 "Move to previous item."
1340 (newsticker--treeview-restore-layout)
1341 (save-current-buffer
1342 (set-buffer (newsticker--treeview-list-buffer))
1344 (newsticker-treeview-show-item))
1346 (defun newsticker-treeview-next-new-or-immortal-item (&optional
1349 "Move to next new or immortal item.
1350 Will move to next feed until an item is found. Will not move if
1351 optional argument CURRENT-ITEM-COUNTS is t and current item is
1352 new or immortal. Will not move from virtual to ordinary feed
1353 tree or vice versa if optional argument DONT-WRAP-TREES is non-nil."
1355 (newsticker--treeview-restore-layout)
1356 (newsticker--treeview-list-clear-highlight)
1357 (unless (catch 'found
1358 (let ((move (not current-item-counts)))
1360 (save-current-buffer
1361 (set-buffer (newsticker--treeview-list-buffer))
1362 (when move (forward-line 1)
1365 (throw 'found nil))))
1366 (when (memq (newsticker--age
1367 (newsticker--treeview-get-selected-item))
1369 (newsticker-treeview-show-item)
1372 (let ((wrap-trees (not dont-wrap-trees)))
1373 (when (or (newsticker-treeview-next-feed t)
1374 (and wrap-trees (newsticker--treeview-first-feed)))
1375 (newsticker-treeview-next-new-or-immortal-item t t)))))
1377 (defun newsticker-treeview-prev-new-or-immortal-item ()
1378 "Move to previous new or immortal item.
1379 Will move to previous feed until an item is found."
1381 (newsticker--treeview-restore-layout)
1382 (newsticker--treeview-list-clear-highlight)
1383 (unless (catch 'found
1385 (save-current-buffer
1386 (set-buffer (newsticker--treeview-list-buffer))
1390 (when (memq (newsticker--age
1391 (newsticker--treeview-get-selected-item))
1393 (newsticker-treeview-show-item)
1396 (throw 'found nil))))
1397 (when (newsticker-treeview-prev-feed t)
1398 (set-buffer (newsticker--treeview-list-buffer))
1399 (goto-char (point-max))
1400 (newsticker-treeview-prev-new-or-immortal-item))))
1402 (defun newsticker--treeview-get-selected-item ()
1403 "Return item that is currently selected in list buffer."
1404 (with-current-buffer (newsticker--treeview-list-buffer)
1406 (get-text-property (point) :nt-item)))
1408 (defun newsticker-treeview-mark-item-old (&optional dont-proceed)
1409 "Mark current item as old unless it is obsolete.
1410 Move to next item unless DONT-PROCEED is non-nil."
1412 (let ((item (newsticker--treeview-get-selected-item)))
1413 (unless (eq (newsticker--age item) 'obsolete)
1414 (newsticker--treeview-mark-item item 'old)))
1415 (unless dont-proceed
1416 (newsticker-treeview-next-item)))
1418 (defun newsticker-treeview-toggle-item-immortal ()
1419 "Toggle immortality of current item."
1421 (let* ((item (newsticker--treeview-get-selected-item))
1422 (new-age (if (eq (newsticker--age item) 'immortal)
1425 (newsticker--treeview-mark-item item new-age)
1426 (newsticker-treeview-next-item)))
1428 (defun newsticker--treeview-mark-item (item new-age)
1429 "Mark ITEM with NEW-AGE."
1431 (setcar (nthcdr 4 item) new-age)
1432 ;; clean up ticker FIXME
1434 (newsticker--cache-save-feed
1435 (newsticker--cache-get-feed (intern newsticker--treeview-current-feed)))
1436 (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree))
1438 (defun newsticker-treeview-mark-list-items-old ()
1439 "Mark all listed items as old."
1441 (let ((current-feed (or newsticker--treeview-current-feed
1442 newsticker--treeview-current-vfeed)))
1443 (with-current-buffer (newsticker--treeview-list-buffer)
1444 (goto-char (point-min))
1446 (let ((item (get-text-property (point) :nt-item)))
1447 (unless (memq (newsticker--age item) '(immortal obsolete))
1448 (newsticker--treeview-mark-item item 'old)))
1450 (newsticker--treeview-tree-update-tags)
1452 (newsticker-treeview-jump current-feed))))
1454 (defun newsticker-treeview-save-item ()
1455 "Save current item."
1457 (newsticker-save-item (or newsticker--treeview-current-feed
1458 newsticker--treeview-current-vfeed)
1459 (newsticker--treeview-get-selected-item)))
1461 (defun newsticker-treeview-browse-url-item ()
1462 "Convert current item to HTML and call `browse-url' on result."
1464 (newsticker-browse-url-item (or newsticker--treeview-current-feed
1465 newsticker--treeview-current-vfeed)
1466 (newsticker--treeview-get-selected-item)))
1468 (defun newsticker--treeview-set-current-node (node)
1469 "Make NODE the current node."
1470 (with-current-buffer (newsticker--treeview-tree-buffer)
1471 (setq newsticker--treeview-current-node-id
1472 (widget-get node :nt-id))
1473 (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
1474 (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
1475 (newsticker--treeview-tree-update-highlight)))
1477 (defun newsticker--treeview-get-first-child (node)
1478 "Get first child of NODE."
1479 (let ((children (widget-get node :children)))
1484 (defun newsticker--treeview-get-second-child (node)
1485 "Get scond child of NODE."
1486 (let ((children (widget-get node :children)))
1488 (car (cdr children))
1491 (defun newsticker--treeview-get-last-child (node)
1492 "Get last child of NODE."
1493 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1494 (let ((children (widget-get node :children)))
1496 (car (reverse children))
1499 (defun newsticker--treeview-get-feed-vfeed (node)
1500 "Get (virtual) feed of NODE."
1501 (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
1503 (defun newsticker--treeview-get-next-sibling (node)
1504 "Get next sibling of NODE."
1505 (let ((parent (widget-get node :parent)))
1507 (let ((children (widget-get parent :children)))
1509 (if (newsticker--treeview-nodes-eq (car children) node)
1510 (throw 'found (car (cdr children))))
1511 (setq children (cdr children)))))))
1513 (defun newsticker--treeview-get-prev-sibling (node)
1514 "Get previous sibling of NODE."
1515 (let ((parent (widget-get node :parent)))
1517 (let ((children (widget-get parent :children))
1520 (if (and (newsticker--treeview-nodes-eq (car children) node)
1521 (widget-get prev :nt-id))
1522 (throw 'found prev))
1523 (setq prev (car children))
1524 (setq children (cdr children)))))))
1526 (defun newsticker--treeview-get-next-uncle (node)
1527 "Get next uncle of NODE, i.e. parent's next sibling."
1528 (let* ((parent (widget-get node :parent))
1529 (grand-parent (widget-get parent :parent)))
1531 (let ((uncles (widget-get grand-parent :children)))
1533 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1534 (throw 'found (car (cdr uncles))))
1535 (setq uncles (cdr uncles)))))))
1537 (defun newsticker--treeview-get-prev-uncle (node)
1538 "Get previous uncle of NODE, i.e. parent's previous sibling."
1539 (let* ((parent (widget-get node :parent))
1540 (grand-parent (widget-get parent :parent)))
1542 (let ((uncles (widget-get grand-parent :children))
1545 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1546 (throw 'found prev))
1547 (setq prev (car uncles))
1548 (setq uncles (cdr uncles)))))))
1550 (defun newsticker--treeview-get-other-tree ()
1552 (if (and (newsticker--treeview-get-current-node)
1553 (widget-get (newsticker--treeview-get-current-node) :nt-feed))
1554 newsticker--treeview-vfeed-tree
1555 newsticker--treeview-feed-tree))
1557 (defun newsticker--treeview-activate-node (node &optional backward)
1559 If NODE is a tree widget the node's first subnode is activated.
1560 If BACKWARD is non-nil the last subnode of the previous sibling
1562 (newsticker--treeview-set-current-node node)
1563 (save-current-buffer
1564 (set-buffer (newsticker--treeview-tree-buffer))
1565 (cond ((eq (widget-type node) 'tree-widget)
1566 (unless (widget-get node :open)
1567 (widget-put node :open nil)
1568 (widget-apply-action node))
1569 (newsticker--treeview-activate-node
1571 (newsticker--treeview-get-last-child node)
1572 (newsticker--treeview-get-second-child node))))
1574 (widget-apply-action node)))))
1576 (defun newsticker--treeview-first-feed ()
1577 "Jump to the depth-first feed in the `newsticker-groups' tree."
1578 (newsticker-treeview-jump
1579 (car (reverse (newsticker--group-get-feeds newsticker-groups t)))))
1581 (defun newsticker-treeview-next-feed (&optional stay-in-tree)
1583 Optional argument STAY-IN-TREE prevents moving from real feed
1584 tree to virtual feed tree or vice versa.
1585 Return t if a new feed was activated, nil otherwise."
1587 (newsticker--treeview-restore-layout)
1588 (let ((cur (newsticker--treeview-get-current-node))
1592 (or (newsticker--treeview-get-next-sibling cur)
1593 (newsticker--treeview-get-next-uncle cur)
1594 (and (not stay-in-tree)
1595 (newsticker--treeview-get-other-tree)))
1596 (car (widget-get newsticker--treeview-feed-tree :children))))
1599 (newsticker--treeview-activate-node new)
1600 (newsticker--treeview-tree-update-highlight)
1604 (defun newsticker-treeview-prev-feed (&optional stay-in-tree)
1605 "Move to previous feed.
1606 Optional argument STAY-IN-TREE prevents moving from real feed
1607 tree to virtual feed tree or vice versa.
1608 Return t if a new feed was activated, nil otherwise."
1610 (newsticker--treeview-restore-layout)
1611 (let ((cur (newsticker--treeview-get-current-node))
1617 (or (newsticker--treeview-get-prev-sibling cur)
1618 (newsticker--treeview-get-prev-uncle cur)
1619 (and (not stay-in-tree)
1620 (newsticker--treeview-get-other-tree)))
1621 (car (widget-get newsticker--treeview-feed-tree :children))))
1624 (newsticker--treeview-activate-node new t)
1625 (newsticker--treeview-tree-update-highlight)
1630 (defun newsticker-treeview-next-page ()
1631 "Scroll item buffer."
1633 (save-selected-window
1634 (select-window (newsticker--treeview-item-window) t)
1638 (goto-char (point-min))))))
1641 (defun newsticker--treeview-unfold-node (feed-name)
1642 "Recursively show subtree above the node that represents FEED-NAME."
1643 (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
1645 (let* ((group-name (car (newsticker--group-find-parent-group
1647 (newsticker--treeview-unfold-node group-name))
1648 (setq node (newsticker--treeview-get-node-of-feed feed-name)))
1650 (with-current-buffer (newsticker--treeview-tree-buffer)
1651 (widget-put node :nt-selected t)
1652 (widget-apply-action node)
1653 (newsticker--treeview-set-current-node node)))))
1655 (defun newsticker-treeview-jump (feed-name)
1656 "Jump to feed FEED-NAME in newsticker treeview."
1658 (list (let ((completion-ignore-case t))
1661 (append '("new" "obsolete" "immortal" "all")
1662 (mapcar #'car (append newsticker-url-list
1663 newsticker-url-list-defaults)))
1665 (newsticker--treeview-unfold-node feed-name))
1667 ;; ======================================================================
1669 ;; ======================================================================
1670 (defun newsticker--group-do-find-group (feed-or-group-name parent-node node)
1671 "Recursively find FEED-OR-GROUP-NAME in PARENT-NODE or NODE."
1672 (cond ((stringp node)
1673 (when (string= feed-or-group-name node)
1674 (throw 'found parent-node)))
1676 (cond ((string= feed-or-group-name (car node))
1677 (throw 'found parent-node))
1678 ((member feed-or-group-name (cdr node))
1679 (throw 'found node))
1683 (newsticker--group-do-find-group
1684 feed-or-group-name node n)))
1687 (defun newsticker--group-find-parent-group (feed-or-group-name)
1688 "Find group containing FEED-OR-GROUP-NAME."
1691 (newsticker--group-do-find-group feed-or-group-name
1697 (defun newsticker--group-do-get-group (name node)
1698 "Recursively find group with NAME below NODE."
1699 (if (string= name (car node))
1703 (newsticker--group-do-get-group name n)))
1706 (defun newsticker--group-get-group (name)
1707 "Find group with NAME."
1711 (newsticker--group-do-get-group name n)))
1715 (defun newsticker--group-get-subgroups (group &optional recursive)
1716 "Return list of subgroups for GROUP.
1717 If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1721 (setq result (cons (car n) result))
1722 (let ((subgroups (newsticker--group-get-subgroups n recursive)))
1724 (setq result (append subgroups result))))))
1728 (defun newsticker--group-all-groups ()
1729 "Return nested list of all groups."
1730 (newsticker--group-get-subgroups newsticker-groups t))
1732 (defun newsticker--group-get-feeds (group &optional recursive)
1733 "Return list of all feeds in GROUP.
1734 If RECURSIVE is non-nil recursively get feeds of subgroups and
1735 return a nested list."
1739 (setq result (cons n result))
1741 (let ((subfeeds (newsticker--group-get-feeds n t)))
1743 (setq result (append subfeeds result)))))))
1747 (defun newsticker-group-add-group (name parent)
1748 "Add group NAME to group PARENT."
1750 (list (read-string "Name of new group: ")
1751 (let ((completion-ignore-case t))
1752 (completing-read "Name of parent group (optional): " (newsticker--group-all-groups)
1754 (if (newsticker--group-get-group name)
1755 (error "Group %s exists already" name))
1756 (let ((p (if (and parent (not (string= parent "")))
1757 (newsticker--group-get-group parent)
1758 newsticker-groups)))
1760 (error "Parent %s does not exist" parent))
1761 (setcdr p (cons (list name) (cdr p))))
1762 (newsticker--treeview-tree-update)
1763 (newsticker-treeview-jump newsticker--treeview-current-feed))
1765 (defun newsticker-group-delete-group (name)
1766 "Delete group NAME."
1768 (list (let ((completion-ignore-case t))
1769 (completing-read "Delete group: "
1770 (newsticker--group-names)
1771 nil t (car (newsticker--group-find-parent-group
1772 newsticker--treeview-current-feed))))))
1773 (let ((parent-group (newsticker--group-find-parent-group name)))
1774 (unless parent-group
1775 (error "Parent %s does not exist" parent-group))
1776 (setcdr parent-group (cl-delete-if (lambda (g)
1778 (string= name (car g))))
1779 (cdr parent-group)))
1780 (newsticker--group-manage-orphan-feeds)
1781 (newsticker--treeview-tree-update)
1782 (newsticker-treeview-update)
1783 (newsticker-treeview-jump newsticker--treeview-current-feed)))
1785 (defun newsticker--group-do-rename-group (old-name new-name)
1786 "Actually rename group OLD-NAME to NEW-NAME."
1787 (let ((parent-group (newsticker--group-find-parent-group old-name)))
1788 (unless parent-group
1789 (error "Parent of %s does not exist" old-name))
1790 (mapcar (lambda (elt)
1791 (cond ((and (listp elt)
1792 (string= old-name (car elt)))
1793 (cons new-name (cdr elt)))
1798 (defun newsticker-group-rename-group (old-name new-name)
1799 "Rename group OLD-NAME to NEW-NAME."
1801 (list (let* ((completion-ignore-case t))
1802 (completing-read "Rename group: "
1803 (newsticker--group-names)
1804 nil t (car (newsticker--group-find-parent-group
1805 newsticker--treeview-current-feed))))
1806 (read-string "Rename to: ")))
1807 (setq newsticker-groups (newsticker--group-do-rename-group old-name new-name))
1808 (newsticker--group-manage-orphan-feeds)
1809 (newsticker--treeview-tree-update)
1810 (newsticker-treeview-update)
1811 (newsticker-treeview-jump newsticker--treeview-current-feed))
1813 (defun newsticker--get-group-names (lst)
1814 "Do get the group names from LST."
1815 (delete nil (cons (car lst)
1819 (newsticker--get-group-names e))
1824 (defun newsticker--group-names ()
1825 "Get names of all newsticker groups."
1826 (newsticker--get-group-names newsticker-groups))
1828 (defun newsticker-group-move-feed (name group-name &optional no-update)
1829 "Move feed NAME to group GROUP-NAME.
1830 Update treeview afterwards unless NO-UPDATE is non-nil."
1832 (let ((completion-ignore-case t))
1833 (list (completing-read "Name of feed or group to move: "
1834 (append (mapcar #'car newsticker-url-list)
1835 (newsticker--group-names))
1836 nil t newsticker--treeview-current-feed)
1837 (completing-read "Name of new parent group: " (newsticker--group-names)
1839 (let* ((group (if (and group-name (not (string= group-name "")))
1840 (newsticker--group-get-group group-name)
1842 (moving-group-p (member name (newsticker--group-names)))
1843 (moved-thing (if moving-group-p
1844 (newsticker--group-get-group name)
1847 (error "Group %s does not exist" group-name))
1848 (while (let ((old-group
1849 (newsticker--group-find-parent-group name)))
1851 (delete moved-thing old-group))
1853 (setcdr group (cons moved-thing (cdr group)))
1855 (newsticker--treeview-tree-update)
1856 (newsticker-treeview-update)
1857 (newsticker-treeview-jump name))))
1859 (defun newsticker-group-shift-feed-down ()
1860 "Shift current feed down in its group."
1862 (newsticker--group-shift 1))
1864 (defun newsticker-group-shift-feed-up ()
1865 "Shift current feed down in its group."
1867 (newsticker--group-shift -1))
1869 (defun newsticker-group-shift-group-down ()
1870 "Shift current group down in its group."
1872 (newsticker--group-shift 1 t))
1874 (defun newsticker-group-shift-group-up ()
1875 "Shift current group down in its group."
1877 (newsticker--group-shift -1 t))
1879 (defun newsticker--group-shift (delta &optional move-group)
1880 "Shift current feed or group within its parent group.
1881 DELTA is an integer which specifies the direction and the amount
1882 of the shift. If MOVE-GROUP is nil the currently selected feed
1883 `newsticker--treeview-current-feed' is shifted, if it is t then
1884 the current feed's parent group is shifted.."
1885 (let* ((cur-feed newsticker--treeview-current-feed)
1886 (thing (if move-group
1887 (newsticker--group-find-parent-group cur-feed)
1889 (parent-group (newsticker--group-find-parent-group
1890 (if move-group (car thing) thing))))
1891 (unless parent-group
1892 (error "Group not found!"))
1893 (let* ((siblings (cdr parent-group))
1894 (pos (cl-position thing siblings :test 'equal))
1895 (tpos (+ pos delta ))
1896 (new-pos (max 0 (min (length siblings) tpos)))
1897 (beg (cl-subseq siblings 0 (min pos new-pos)))
1898 (end (cl-subseq siblings (+ 1 (max pos new-pos))))
1899 (p (elt siblings new-pos)))
1900 (when (not (= pos new-pos))
1901 (setcdr parent-group
1902 (cl-concatenate 'list
1908 (newsticker--treeview-tree-update)
1909 (newsticker-treeview-update)
1910 (newsticker-treeview-jump cur-feed)))))
1912 (defun newsticker--count-groups (group)
1913 "Recursively count number of subgroups of GROUP."
1917 (setq result (+ result (newsticker--count-groups g)))))
1921 (defun newsticker--count-grouped-feeds (group)
1922 "Recursively count number of feeds in GROUP and its subgroups."
1926 (setq result (+ result (newsticker--count-grouped-feeds g)))
1927 (setq result (1+ result))))
1931 (defun newsticker--group-remove-obsolete-feeds (group)
1932 "Recursively remove obsolete feeds from GROUP."
1934 (urls (append newsticker-url-list newsticker-url-list-defaults)))
1938 (newsticker--group-remove-obsolete-feeds g)))
1940 (setq result (cons sub-groups result))))
1942 (setq result (cons g result)))))
1945 (cons (car group) (reverse result))
1948 (defun newsticker--group-manage-orphan-feeds ()
1949 "Put unmanaged feeds into `newsticker-groups'.
1950 Remove obsolete feeds as well.
1951 Return t if groups have changed, nil otherwise."
1952 (unless newsticker-groups
1953 (setq newsticker-groups '("Feeds")))
1954 (let ((new-feed nil)
1955 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
1957 (unless (newsticker--group-find-parent-group (car f))
1959 (newsticker-group-move-feed (car f) nil t)))
1960 (append newsticker-url-list-defaults newsticker-url-list))
1961 (setq newsticker-groups
1962 (newsticker--group-remove-obsolete-feeds newsticker-groups))
1964 (not (= grouped-feeds
1965 (newsticker--count-grouped-feeds newsticker-groups))))))
1967 ;; ======================================================================
1969 ;; ======================================================================
1970 (defun newsticker--treeview-tree-open-menu (event)
1971 "Open tree menu at position of EVENT."
1972 (let* ((feed-name newsticker--treeview-current-feed)
1973 (menu (make-sparse-keymap feed-name)))
1974 (define-key menu [newsticker-treeview-mark-list-items-old]
1975 (list 'menu-item "Mark all items old"
1976 'newsticker-treeview-mark-list-items-old))
1977 (define-key menu [newsticker-treeview-get-news]
1978 (list 'menu-item (concat "Get news for " feed-name)
1979 'newsticker-treeview-get-news))
1980 (define-key menu [newsticker-get-all-news]
1981 (list 'menu-item "Get news for all feeds"
1982 'newsticker-get-all-news))
1983 (let ((choice (x-popup-menu event menu)))
1985 (funcall (car choice))))))
1987 (defvar newsticker-treeview-list-menu
1988 (let ((menu (make-sparse-keymap "Newsticker List")))
1989 (define-key menu [newsticker-treeview-mark-list-items-old]
1990 (list 'menu-item "Mark all items old"
1991 'newsticker-treeview-mark-list-items-old))
1992 (define-key menu [newsticker-treeview-mark-item-old]
1993 (list 'menu-item "Mark current item old"
1994 'newsticker-treeview-mark-item-old))
1995 (define-key menu [newsticker-treeview-toggle-item-immortal]
1996 (list 'menu-item "Mark current item immortal (toggle)"
1997 'newsticker-treeview-toggle-item-immortal))
1998 (define-key menu [newsticker-treeview-get-news]
1999 (list 'menu-item "Get news for current feed"
2000 'newsticker-treeview-get-news))
2002 "Map for newsticker list menu.")
2004 (defvar newsticker-treeview-item-menu
2005 (let ((menu (make-sparse-keymap "Newsticker Item")))
2006 (define-key menu [newsticker-treeview-mark-item-old]
2007 (list 'menu-item "Mark current item old"
2008 'newsticker-treeview-mark-item-old))
2009 (define-key menu [newsticker-treeview-toggle-item-immortal]
2010 (list 'menu-item "Mark current item immortal (toggle)"
2011 'newsticker-treeview-toggle-item-immortal))
2012 (define-key menu [newsticker-treeview-get-news]
2013 (list 'menu-item "Get news for current feed"
2014 'newsticker-treeview-get-news))
2016 "Map for newsticker item menu.")
2018 (defvar newsticker-treeview-mode-map
2019 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
2020 (define-key map " " 'newsticker-treeview-next-page)
2021 (define-key map "a" 'newsticker-add-url)
2022 (define-key map "b" 'newsticker-treeview-browse-url-item)
2023 (define-key map "F" 'newsticker-treeview-prev-feed)
2024 (define-key map "f" 'newsticker-treeview-next-feed)
2025 (define-key map "g" 'newsticker-treeview-get-news)
2026 (define-key map "G" 'newsticker-get-all-news)
2027 (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
2028 (define-key map "j" 'newsticker-treeview-jump)
2029 (define-key map "n" 'newsticker-treeview-next-item)
2030 (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
2031 (define-key map "O" 'newsticker-treeview-mark-list-items-old)
2032 (define-key map "o" 'newsticker-treeview-mark-item-old)
2033 (define-key map "p" 'newsticker-treeview-prev-item)
2034 (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
2035 (define-key map "q" 'newsticker-treeview-quit)
2036 (define-key map "S" 'newsticker-treeview-save-item)
2037 (define-key map "s" 'newsticker-treeview-save)
2038 (define-key map "u" 'newsticker-treeview-update)
2039 (define-key map "v" 'newsticker-treeview-browse-url)
2040 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
2041 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
2042 (define-key map "\M-m" 'newsticker-group-move-feed)
2043 (define-key map "\M-a" 'newsticker-group-add-group)
2044 (define-key map "\M-d" 'newsticker-group-delete-group)
2045 (define-key map "\M-r" 'newsticker-group-rename-group)
2046 (define-key map [M-down] 'newsticker-group-shift-feed-down)
2047 (define-key map [M-up] 'newsticker-group-shift-feed-up)
2048 (define-key map [M-S-down] 'newsticker-group-shift-group-down)
2049 (define-key map [M-S-up] 'newsticker-group-shift-group-up)
2051 "Mode map for newsticker treeview.")
2053 (define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV"
2054 "Major mode for Newsticker Treeview.
2055 \\{newsticker-treeview-mode-map}"
2056 (if (boundp 'tool-bar-map)
2057 (set (make-local-variable 'tool-bar-map)
2058 newsticker-treeview-tool-bar-map))
2059 (setq buffer-read-only t
2062 (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
2064 (let ((header (concat
2065 (propertize " " 'display '(space :align-to 0))
2066 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
2067 (propertize " " 'display '(space :align-to 2))
2068 (if newsticker--treeview-list-show-feed
2070 (propertize " " 'display '(space :align-to 12)))
2072 (newsticker-treeview-list-make-sort-button "Date"
2074 (if newsticker--treeview-list-show-feed
2075 (propertize " " 'display '(space :align-to 28))
2076 (propertize " " 'display '(space :align-to 18)))
2077 (newsticker-treeview-list-make-sort-button "Title"
2079 (setq header-line-format header))
2080 (define-key newsticker-treeview-list-mode-map [down-mouse-3]
2081 newsticker-treeview-list-menu))
2083 (define-derived-mode newsticker-treeview-item-mode newsticker-treeview-mode
2085 (define-key newsticker-treeview-item-mode-map [down-mouse-3]
2086 newsticker-treeview-item-menu))
2088 (defun newsticker-treeview-tree-click (event)
2089 "Handle click EVENT on a tag in the newsticker tree."
2091 (newsticker--treeview-restore-layout)
2093 (switch-to-buffer (window-buffer (posn-window (event-end event))))
2094 (newsticker-treeview-tree-do-click (posn-point (event-end event)) event)))
2096 (defun newsticker-treeview-tree-do-click (&optional pos event)
2097 "Actually handle click event.
2098 POS gives the position where EVENT occurred."
2100 (let* ((pos (or pos (point)))
2101 (nt-id (get-text-property pos :nt-id))
2102 (item (get-text-property pos :nt-item)))
2104 ;; click in list buffer
2105 (newsticker-treeview-show-item))
2107 ;; click in tree buffer
2108 (let ((w (newsticker--treeview-get-node-by-id nt-id)))
2110 (newsticker--treeview-tree-update-tag w t t)
2111 (setq w (newsticker--treeview-get-node-by-id nt-id))
2112 (widget-put w :nt-selected t)
2113 (widget-apply w :action event)
2114 (newsticker--treeview-set-current-node w)
2116 (eq 'mouse-3 (car event))
2118 (newsticker--treeview-tree-open-menu event)))))))
2119 (newsticker--treeview-tree-update-highlight))
2121 (defun newsticker--treeview-restore-layout ()
2122 "Restore treeview buffers."
2125 (let ((win (nth i newsticker--treeview-windows))
2126 (buf (nth i newsticker--treeview-buffers)))
2127 (unless (window-live-p win)
2128 (newsticker--treeview-window-init)
2129 (newsticker--treeview-buffer-init)
2131 (unless (eq (window-buffer win) buf)
2132 (set-window-buffer win buf t))))))
2134 (defun newsticker--treeview-frame-init ()
2135 "Initialize treeview frame."
2136 (when newsticker-treeview-own-frame
2137 (unless (and newsticker--frame (frame-live-p newsticker--frame))
2138 (setq newsticker--frame (make-frame '((name . "Newsticker")))))
2139 (select-frame-set-input-focus newsticker--frame)
2140 (raise-frame newsticker--frame)))
2142 (defun newsticker--treeview-window-init ()
2143 "Initialize treeview windows."
2144 (setq newsticker--saved-window-config (current-window-configuration))
2145 (setq newsticker--treeview-windows nil)
2146 (setq newsticker--treeview-buffers nil)
2147 (delete-other-windows)
2148 (split-window-right newsticker-treeview-treewindow-width)
2149 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2151 (split-window-below newsticker-treeview-listwindow-height)
2152 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2154 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2158 (defun newsticker-treeview ()
2159 "Start newsticker treeview."
2161 (newsticker--treeview-load)
2162 (setq newsticker--sentinel-callback 'newsticker-treeview-update)
2163 (newsticker--treeview-frame-init)
2164 (newsticker--treeview-window-init)
2165 (newsticker--treeview-buffer-init)
2166 (if (newsticker--group-manage-orphan-feeds)
2167 (newsticker--treeview-tree-update))
2168 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
2169 (newsticker-start t) ;; will start only if not running
2170 (newsticker-treeview-update)
2171 (newsticker--treeview-item-show-text
2173 "Welcome to newsticker!"))
2175 (defun newsticker-treeview-get-news ()
2176 "Get news for current feed."
2178 (when newsticker--treeview-current-feed
2179 (newsticker-get-news newsticker--treeview-current-feed)))
2181 (provide 'newst-treeview)
2183 ;;; newst-treeview.el ends here