1 ;;; newst-treeview.el --- Treeview frontend for newsticker.
3 ;; Copyright (C) 2008-2014 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 ;; Package: newsticker
12 ;; ======================================================================
14 ;; This file is part of GNU Emacs.
16 ;; GNU Emacs is free software: you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation, either version 3 of the License, or
19 ;; (at your option) any later version.
21 ;; GNU Emacs is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; ======================================================================
34 ;; ======================================================================
38 ;; ======================================================================
40 (require 'newst-reader)
42 (require 'tree-widget)
45 ;; ======================================================================
47 ;; ======================================================================
48 (defgroup newsticker-treeview nil
49 "Settings for the tree view reader."
50 :group 'newsticker-reader)
52 (defface newsticker-treeview-face
53 '((((class color) (background dark)) :foreground "white")
54 (((class color) (background light)) :foreground "black"))
55 "Face for newsticker tree."
56 :group 'newsticker-treeview)
58 (defface newsticker-treeview-new-face
59 '((t :inherit newsticker-treeview-face :weight bold))
60 "Face for newsticker tree."
61 :group 'newsticker-treeview)
63 (defface newsticker-treeview-old-face
64 '((t :inherit newsticker-treeview-face))
65 "Face for newsticker tree."
66 :group 'newsticker-treeview)
68 (defface newsticker-treeview-immortal-face
69 '((default :inherit newsticker-treeview-face :slant italic)
70 (((class color) (background dark)) :foreground "orange")
71 (((class color) (background light)) :foreground "blue"))
72 "Face for newsticker tree."
73 :group 'newsticker-treeview)
75 (defface newsticker-treeview-obsolete-face
76 '((t :inherit newsticker-treeview-face :strike-through t))
77 "Face for newsticker tree."
78 :group 'newsticker-treeview)
80 (defface newsticker-treeview-selection-face
81 '((((class color) (background dark)) :background "#bbbbff")
82 (((class color) (background light)) :background "#bbbbff"))
83 "Face for newsticker selection."
84 :group 'newsticker-treeview)
86 (defcustom newsticker-treeview-date-format
88 "Format for the date column in the treeview list buffer.
89 See `format-time-string' for a list of valid specifiers."
92 :group 'newsticker-treeview)
94 (defcustom newsticker-treeview-own-frame
96 "Decides whether newsticker treeview creates and uses its own frame."
98 :group 'newsticker-treeview)
100 (defcustom newsticker-treeview-treewindow-width
102 "Width of tree window in treeview layout.
103 See also `newsticker-treeview-listwindow-height'."
105 :group 'newsticker-treeview)
107 (defcustom newsticker-treeview-listwindow-height
109 "Height of list window in treeview layout.
110 See also `newsticker-treeview-treewindow-width'."
112 :group 'newsticker-treeview)
114 (defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
116 "Decides whether to automatically mark displayed items as old.
117 If t an item is marked as old as soon as it is displayed. This
118 applies to newsticker only."
120 :group 'newsticker-treeview)
122 (defvar newsticker-groups
124 "List of feed groups, used in the treeview frontend.
125 First element is a string giving the group name. Remaining
126 elements are either strings giving a feed name or lists having
127 the same structure as `newsticker-groups'. (newsticker-groups :=
128 groupdefinition, groupdefinition := groupname groupcontent*,
129 groupcontent := feedname | groupdefinition)
131 Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
134 (defcustom newsticker-groups-filename
136 "Name of the newsticker groups settings file. This variable is obsolete."
137 :version "25.1" ; changed default value to nil
139 :group 'newsticker-treeview)
140 (make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
142 ;; ======================================================================
143 ;;; internal variables
144 ;; ======================================================================
145 (defvar newsticker--treeview-windows nil)
146 (defvar newsticker--treeview-buffers nil)
147 (defvar newsticker--treeview-current-feed nil
148 "Feed name of currently shown item.")
149 (defvar newsticker--treeview-current-vfeed nil)
150 (defvar newsticker--treeview-list-show-feed nil)
151 (defvar newsticker--saved-window-config nil)
152 (defvar newsticker--selection-overlay nil
153 "Highlight the selected tree node.")
154 (defvar newsticker--tree-selection-overlay nil
155 "Highlight the selected list item.")
156 (defvar newsticker--frame nil "Special frame for newsticker windows.")
157 (defvar newsticker--treeview-list-sort-order 'sort-by-time)
158 (defvar newsticker--treeview-current-node-id nil)
159 (defvar newsticker--treeview-current-tree nil)
160 (defvar newsticker--treeview-feed-tree nil)
161 (defvar newsticker--treeview-vfeed-tree nil)
163 ;; maps for the clickable portions
164 (defvar newsticker--treeview-url-keymap
165 (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
166 (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
167 (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
168 (define-key map "\n" 'newsticker-treeview-browse-url)
169 (define-key map "\C-m" 'newsticker-treeview-browse-url)
170 (define-key map [(control return)] 'newsticker-handle-url)
172 "Key map for click-able headings in the newsticker treeview buffers.")
175 ;; ======================================================================
177 ;; ======================================================================
178 (defsubst newsticker--treeview-tree-buffer ()
179 "Return the tree buffer of the newsticker treeview."
180 (nth 0 newsticker--treeview-buffers))
181 (defsubst newsticker--treeview-list-buffer ()
182 "Return the list buffer of the newsticker treeview."
183 (nth 1 newsticker--treeview-buffers))
184 (defsubst newsticker--treeview-item-buffer ()
185 "Return the item buffer of the newsticker treeview."
186 (nth 2 newsticker--treeview-buffers))
187 (defsubst newsticker--treeview-tree-window ()
188 "Return the tree window of the newsticker treeview."
189 (nth 0 newsticker--treeview-windows))
190 (defsubst newsticker--treeview-list-window ()
191 "Return the list window of the newsticker treeview."
192 (nth 1 newsticker--treeview-windows))
193 (defsubst newsticker--treeview-item-window ()
194 "Return the item window of the newsticker treeview."
195 (nth 2 newsticker--treeview-windows))
197 ;; ======================================================================
198 ;;; utility functions
199 ;; ======================================================================
200 (defun newsticker--treeview-get-id (parent i)
201 "Create an id for a newsticker treeview node.
202 PARENT is the node's parent, I is an integer."
203 ;;(message "newsticker--treeview-get-id %s"
204 ;; (format "%s-%d" (widget-get parent :nt-id) i))
205 (format "%s-%d" (widget-get parent :nt-id) i))
207 (defun newsticker--treeview-ids-eq (id1 id2)
208 "Return non-nil if ids ID1 and ID2 are equal."
209 ;;(message "%s/%s" (or id1 -1) (or id2 -1))
210 (and id1 id2 (string= id1 id2)))
212 (defun newsticker--treeview-nodes-eq (node1 node2)
213 "Compare treeview nodes NODE1 and NODE2 for equality.
214 Nodes are equal if the have the same newsticker-id. Note that
215 during re-tagging and collapsing/expanding nodes change, while
216 their id stays constant."
217 (let ((id1 (widget-get node1 :nt-id))
218 (id2 (widget-get node2 :nt-id)))
219 ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
220 ;; (or id1 -1) (or id2 -1))
221 (or (newsticker--treeview-ids-eq id1 id2)
222 (string= (widget-get node1 :tag) (widget-get node2 :tag)))))
224 (defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
225 "Recursively search node for feed FEED-NAME starting from STARTNODE."
226 ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
227 (if (string= feed-name (or (widget-get startnode :nt-feed)
228 (widget-get startnode :nt-vfeed)))
229 (throw 'found startnode)
230 (let ((children (widget-get startnode :children)))
232 (newsticker--treeview-do-get-node-of-feed feed-name w)))))
234 (defun newsticker--treeview-get-node-of-feed (feed-name)
235 "Return node for feed FEED-NAME in newsticker treeview tree."
237 (newsticker--treeview-do-get-node-of-feed feed-name
238 newsticker--treeview-feed-tree)
239 (newsticker--treeview-do-get-node-of-feed feed-name
240 newsticker--treeview-vfeed-tree)))
242 (defun newsticker--treeview-do-get-node-by-id (id startnode)
243 "Recursively search node with ID starting from STARTNODE."
244 (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
245 (throw 'found startnode)
246 (let ((children (widget-get startnode :children)))
248 (newsticker--treeview-do-get-node-by-id id w)))))
250 (defun newsticker--treeview-get-node-by-id (id)
251 "Return node with ID in newsticker treeview tree."
253 (newsticker--treeview-do-get-node-by-id id newsticker--treeview-feed-tree)
254 (newsticker--treeview-do-get-node-by-id id newsticker--treeview-vfeed-tree)))
256 (defun newsticker--treeview-get-current-node ()
257 "Return current node in newsticker treeview tree."
258 (newsticker--treeview-get-node-by-id newsticker--treeview-current-node-id))
260 ;; ======================================================================
262 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
263 (declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
265 (defun newsticker--treeview-render-text (start end)
266 "Render text between markers START and END."
267 (if newsticker-html-renderer
268 (condition-case error-data
270 (set-marker-insertion-type end t)
271 ;; check whether it is necessary to call html renderer
272 ;; (regexp inspired by htmlr.el)
274 (when (re-search-forward
275 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
276 ;; (message "%s" (newsticker--title item))
277 (let ((w3m-fill-column (if newsticker-use-full-width
279 (w3-maximum-line-length
280 (if newsticker-use-full-width nil fill-column)))
282 (funcall newsticker-html-renderer start end)))
283 ;;(cond ((eq newsticker-html-renderer 'w3m-region)
284 ;; (add-text-properties start end (list 'keymap
285 ;; w3m-minor-mode-map)))
286 ;;((eq newsticker-html-renderer 'w3-region)
287 ;;(add-text-properties start end (list 'keymap w3-mode-map))))
288 (if (eq newsticker-html-renderer 'w3m-region)
289 (w3m-toggle-inline-images t))
292 (message "Error: HTML rendering failed: %s, %s"
293 (car error-data) (cdr error-data))
297 ;; ======================================================================
299 ;; ======================================================================
300 (defun newsticker--treeview-list-add-item (item feed &optional show-feed)
301 "Add news ITEM for FEED to newsticker treeview list window.
302 If string SHOW-FEED is non-nil it is shown in the item string."
303 (setq newsticker--treeview-list-show-feed show-feed)
304 (with-current-buffer (newsticker--treeview-list-buffer)
305 (let* ((inhibit-read-only t)
307 (goto-char (point-max))
308 (setq pos1 (point-marker))
310 (insert (propertize " " 'display '(space :align-to 2)))
311 (insert (if show-feed
314 (format "%-10s" (newsticker--real-feed-name
317 (propertize " " 'display '(space :align-to 12)))
319 (insert (format-time-string newsticker-treeview-date-format
320 (newsticker--time item)))
321 (insert (propertize " " 'display
322 (list 'space :align-to (if show-feed 28 18))))
323 (setq pos2 (point-marker))
324 (insert (newsticker--title item))
326 (newsticker--treeview-render-text pos2 (point-marker))
328 (while (search-forward "\n" nil t)
330 (let ((map (make-sparse-keymap)))
331 (define-key map [mouse-1] 'newsticker-treeview-tree-click)
332 (define-key map "\n" 'newsticker-treeview-show-item)
333 (define-key map "\C-m" 'newsticker-treeview-show-item)
334 (add-text-properties pos1 (point-max)
337 :nt-link (newsticker--link item)
338 'mouse-face 'highlight
340 'help-echo (buffer-substring pos2
344 (defun newsticker--treeview-list-clear ()
345 "Clear the newsticker treeview list window."
346 (with-current-buffer (newsticker--treeview-list-buffer)
347 (let ((inhibit-read-only t))
349 (kill-all-local-variables)
352 (defun newsticker--treeview-list-items-with-age-callback (widget
355 "Fill newsticker treeview list window with items of certain age.
356 This is a callback function for the treeview nodes.
357 Argument WIDGET is the calling treeview widget.
358 Argument CHANGED-WIDGET is the widget that actually has changed.
359 Optional argument AGES is the list of ages that are to be shown."
360 (newsticker--treeview-list-clear)
361 (widget-put widget :nt-selected t)
362 (apply 'newsticker--treeview-list-items-with-age ages))
364 (defun newsticker--treeview-list-items-with-age (&rest ages)
365 "Actually fill newsticker treeview list window with items of certain age.
366 AGES is the list of ages that are to be shown."
368 (let ((feed-name-symbol (intern (car feed))))
370 (when (memq (newsticker--age item) ages)
371 (newsticker--treeview-list-add-item
372 item feed-name-symbol t)))
373 (newsticker--treeview-list-sort-items
374 (cdr (newsticker--cache-get-feed feed-name-symbol))))))
375 (append newsticker-url-list-defaults newsticker-url-list))
376 (newsticker--treeview-list-update nil))
378 (defun newsticker--treeview-list-new-items (widget changed-widget
380 "Fill newsticker treeview list window with new items.
381 This is a callback function for the treeview nodes.
382 Argument WIDGET is the calling treeview widget.
383 Argument CHANGED-WIDGET is the widget that actually has changed.
384 Optional argument EVENT is the mouse event that triggered this action."
385 (newsticker--treeview-list-items-with-age-callback widget changed-widget
387 (newsticker--treeview-item-show-text
389 "This is a virtual feed containing all new items"))
391 (defun newsticker--treeview-list-immortal-items (widget changed-widget
393 "Fill newsticker treeview list window with immortal items.
394 This is a callback function for the treeview nodes.
395 Argument WIDGET is the calling treeview widget.
396 Argument CHANGED-WIDGET is the widget that actually has changed.
397 Optional argument EVENT is the mouse event that triggered this action."
398 (newsticker--treeview-list-items-with-age-callback widget changed-widget
400 (newsticker--treeview-item-show-text
402 "This is a virtual feed containing all immortal items."))
404 (defun newsticker--treeview-list-obsolete-items (widget changed-widget
406 "Fill newsticker treeview list window with obsolete items.
407 This is a callback function for the treeview nodes.
408 Argument WIDGET is the calling treeview widget.
409 Argument CHANGED-WIDGET is the widget that actually has changed.
410 Optional argument EVENT is the mouse event that triggered this action."
411 (newsticker--treeview-list-items-with-age-callback widget changed-widget
413 (newsticker--treeview-item-show-text
415 "This is a virtual feed containing all obsolete items."))
417 (defun newsticker--treeview-list-all-items (widget changed-widget
419 "Fill newsticker treeview list window with all items.
420 This is a callback function for the treeview nodes.
421 Argument WIDGET is the calling treeview widget.
422 Argument CHANGED-WIDGET is the widget that actually has changed.
423 Optional argument EVENT is the mouse event that triggered this action."
424 (newsticker--treeview-list-items-with-age-callback widget changed-widget
427 (newsticker--treeview-item-show-text
429 "This is a virtual feed containing all items."))
431 (defun newsticker--treeview-list-items-v (vfeed-name)
432 "List items for virtual feed VFEED-NAME."
434 (cond ((string-match "\\*new\\*" vfeed-name)
435 (newsticker--treeview-list-items-with-age 'new))
436 ((string-match "\\*immortal\\*" vfeed-name)
437 (newsticker--treeview-list-items-with-age 'immortal))
438 ((string-match "\\*old\\*" vfeed-name)
439 (newsticker--treeview-list-items-with-age 'old nil)))
440 (newsticker--treeview-list-update nil)
443 (defun newsticker--treeview-list-items (feed-name)
444 "List items for feed FEED-NAME."
446 (if (newsticker--treeview-virtual-feed-p feed-name)
447 (newsticker--treeview-list-items-v feed-name)
449 (if (eq (newsticker--age item) 'feed)
450 (newsticker--treeview-item-show item (intern feed-name))
451 (newsticker--treeview-list-add-item item
452 (intern feed-name))))
453 (newsticker--treeview-list-sort-items
454 (cdr (newsticker--cache-get-feed (intern feed-name)))))
455 (newsticker--treeview-list-update nil))))
457 (defun newsticker--treeview-list-feed-items (widget changed-widget
459 "Callback function for listing feed items.
460 Argument WIDGET is the calling treeview widget.
461 Argument CHANGED-WIDGET is the widget that actually has changed.
462 Optional argument EVENT is the mouse event that triggered this action."
463 (newsticker--treeview-list-clear)
464 (widget-put widget :nt-selected t)
465 (let ((feed-name (widget-get widget :nt-feed))
466 (vfeed-name (widget-get widget :nt-vfeed)))
468 (newsticker--treeview-list-items feed-name)
469 (newsticker--treeview-list-items-v vfeed-name))))
471 (defun newsticker--treeview-list-compare-item-by-age (item1 item2)
472 "Compare two news items ITEM1 and ITEM2 wrt age."
474 (let ((age1 (newsticker--age item1))
475 (age2 (newsticker--age item2)))
476 (cond ((eq age1 'new)
479 (cond ((eq age2 'new)
486 (cond ((eq age2 'new)
497 (defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
498 "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
499 (newsticker--treeview-list-compare-item-by-age item2 item1))
501 (defun newsticker--treeview-list-compare-item-by-time (item1 item2)
502 "Compare two news items ITEM1 and ITEM2 wrt time values."
503 (newsticker--cache-item-compare-by-time item1 item2))
505 (defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
506 "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
507 (newsticker--cache-item-compare-by-time item2 item1))
509 (defun newsticker--treeview-list-compare-item-by-title (item1 item2)
510 "Compare two news items ITEM1 and ITEM2 wrt title."
511 (newsticker--cache-item-compare-by-title item1 item2))
513 (defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
514 "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
515 (newsticker--cache-item-compare-by-title item2 item1))
517 (defun newsticker--treeview-list-sort-items (items)
518 "Return sorted copy of list ITEMS.
519 The sort function is chosen according to the value of
520 `newsticker--treeview-list-sort-order'."
522 (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
523 'newsticker--treeview-list-compare-item-by-age)
524 ((eq newsticker--treeview-list-sort-order
525 'sort-by-age-reverse)
526 'newsticker--treeview-list-compare-item-by-age-reverse)
527 ((eq newsticker--treeview-list-sort-order 'sort-by-time)
528 'newsticker--treeview-list-compare-item-by-time)
529 ((eq newsticker--treeview-list-sort-order
530 'sort-by-time-reverse)
531 'newsticker--treeview-list-compare-item-by-time-reverse)
532 ((eq newsticker--treeview-list-sort-order 'sort-by-title)
533 'newsticker--treeview-list-compare-item-by-title)
534 ((eq newsticker--treeview-list-sort-order
535 'sort-by-title-reverse)
536 'newsticker--treeview-list-compare-item-by-title-reverse)
538 'newsticker--treeview-list-compare-item-by-title))))
539 (sort (copy-sequence items) sort-fun)))
541 (defun newsticker--treeview-list-update-faces ()
542 "Update faces in the treeview list buffer."
544 (with-current-buffer (newsticker--treeview-list-buffer)
546 (let ((inhibit-read-only t))
547 (goto-char (point-min))
549 (let* ((pos (point-at-eol))
550 (item (get-text-property (point) :nt-item))
551 (age (newsticker--age item))
552 (selected (get-text-property (point) :nt-selected))
553 (face (cond ((eq age 'new)
554 'newsticker-treeview-new-face)
556 'newsticker-treeview-old-face)
558 'newsticker-treeview-immortal-face)
560 'newsticker-treeview-obsolete-face)
563 (put-text-property (point) pos 'face face)
565 (move-overlay newsticker--selection-overlay (point)
566 (1+ pos) ;include newline
568 (if selected (setq pos-sel (point)))
570 (beginning-of-line)))))) ;; FIXME!?
572 (if (window-live-p (newsticker--treeview-list-window))
573 (set-window-point (newsticker--treeview-list-window) pos-sel)))))
575 (defun newsticker--treeview-list-clear-highlight ()
576 "Clear the highlight in the treeview list buffer."
577 (with-current-buffer (newsticker--treeview-list-buffer)
578 (let ((inhibit-read-only t))
579 (put-text-property (point-min) (point-max) :nt-selected nil))
580 (newsticker--treeview-list-update-faces)))
582 (defun newsticker--treeview-list-update-highlight ()
583 "Update the highlight in the treeview list buffer."
584 (newsticker--treeview-list-clear-highlight)
586 (with-current-buffer (newsticker--treeview-list-buffer)
587 (let ((inhibit-read-only t))
588 (put-text-property (point-at-bol) (point-at-eol) :nt-selected t))
589 (newsticker--treeview-list-update-faces))))
591 (defun newsticker--treeview-list-highlight-start ()
592 "Return position of selection in treeview list buffer."
593 (with-current-buffer (newsticker--treeview-list-buffer)
595 (goto-char (point-min))
596 (next-single-property-change (point) :nt-selected))))
598 (defun newsticker--treeview-list-update (clear-buffer)
599 "Update the faces and highlight in the treeview list buffer.
600 If CLEAR-BUFFER is non-nil the list buffer is completely erased."
602 (if (window-live-p (newsticker--treeview-list-window))
603 (set-window-buffer (newsticker--treeview-list-window)
604 (newsticker--treeview-list-buffer)))
605 (set-buffer (newsticker--treeview-list-buffer))
607 (let ((inhibit-read-only t))
609 (newsticker-treeview-list-mode)
610 (newsticker--treeview-list-update-faces)
611 (goto-char (point-min))))
613 (defvar newsticker-treeview-list-sort-button-map
614 (let ((map (make-sparse-keymap)))
615 (define-key map [header-line mouse-1]
616 'newsticker--treeview-list-sort-by-column)
617 (define-key map [header-line mouse-2]
618 'newsticker--treeview-list-sort-by-column)
620 "Local keymap for newsticker treeview list window sort buttons.")
622 (defun newsticker--treeview-list-sort-by-column (&optional event)
623 "Sort the newsticker list window buffer by the column clicked on.
624 Optional argument EVENT is the mouse event that triggered this action."
625 (interactive (list last-input-event))
626 (if event (mouse-select-window event))
627 (let* ((pos (event-start event))
628 (obj (posn-object pos))
630 (get-text-property (cdr obj) 'sort-order (car obj))
631 (get-text-property (posn-point pos) 'sort-order))))
632 (setq newsticker--treeview-list-sort-order
633 (cond ((eq sort-order 'sort-by-age)
634 (if (eq newsticker--treeview-list-sort-order 'sort-by-age)
637 ((eq sort-order 'sort-by-time)
638 (if (eq newsticker--treeview-list-sort-order 'sort-by-time)
639 'sort-by-time-reverse
641 ((eq sort-order 'sort-by-title)
642 (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
643 'sort-by-title-reverse
645 (newsticker-treeview-update)))
647 (defun newsticker-treeview-list-make-sort-button (name sort-order)
648 "Create propertized string for headerline button.
649 NAME is the button text, SORT-ORDER is the associated sort order
651 (let ((face (if (string-match (symbol-name sort-order)
653 newsticker--treeview-list-sort-order))
657 'sort-order sort-order
658 'help-echo (concat "Sort by " name)
659 'mouse-face 'highlight
661 'keymap newsticker-treeview-list-sort-button-map)))
663 (defun newsticker--treeview-list-select (item)
664 "Select ITEM in treeview's list buffer."
665 (newsticker--treeview-list-clear-highlight)
668 (set-buffer (newsticker--treeview-list-buffer))
669 (goto-char (point-min))
672 (let ((it (get-text-property (point) :nt-item)))
674 (newsticker--treeview-list-update-highlight)
675 (newsticker--treeview-list-update-faces)
676 (newsticker--treeview-item-show
677 item (get-text-property (point) :nt-feed))
681 (goto-char (point-min))
682 (throw 'found nil)))))))
684 ;; ======================================================================
686 ;; ======================================================================
687 (defun newsticker--treeview-item-show-text (title description)
688 "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
689 (with-current-buffer (newsticker--treeview-item-buffer)
690 (when (fboundp 'w3m-process-stop)
691 (w3m-process-stop (current-buffer)))
692 (let ((inhibit-read-only t))
694 (kill-all-local-variables)
697 (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
698 (insert "\n\n" description)
699 (when newsticker-justification
700 (fill-region (point-min) (point-max) newsticker-justification))
701 (newsticker-treeview-item-mode)
702 (goto-char (point-min)))))
704 (defun newsticker--treeview-item-show (item feed-name-symbol)
705 "Show news ITEM coming from FEED-NAME-SYMBOL in treeview item buffer."
706 (setq newsticker--treeview-current-feed (symbol-name feed-name-symbol))
707 (with-current-buffer (newsticker--treeview-item-buffer)
708 (when (fboundp 'w3m-process-stop)
709 (w3m-process-stop (current-buffer)))
710 (let ((inhibit-read-only t)
711 (is-rendered-HTML nil)
713 (marker1 (make-marker))
714 (marker2 (make-marker)))
716 (kill-all-local-variables)
719 (when (and item feed-name-symbol)
720 (let ((wwidth (1- (window-width (newsticker--treeview-item-window)))))
721 (if newsticker-use-full-width
722 (set (make-local-variable 'fill-column) wwidth))
723 (set (make-local-variable 'fill-column) (min fill-column
725 (let ((desc (newsticker--desc item)))
726 (insert "\n" (or desc "[No Description]")))
727 (set-marker marker1 (1+ (point-min)))
728 (set-marker marker2 (point-max))
729 (setq is-rendered-HTML (newsticker--treeview-render-text marker1
731 (when (and newsticker-justification
732 (not is-rendered-HTML))
733 (fill-region marker1 marker2 newsticker-justification))
735 (newsticker-treeview-item-mode)
736 (goto-char (point-min))
737 ;; insert logo at top
738 (let* ((newsticker-enable-logo-manipulations nil)
739 (img (newsticker--image-read feed-name-symbol nil 40)))
740 (if (and (display-images-p) img)
741 (newsticker--insert-image img (car item))
742 (insert (newsticker--real-feed-name feed-name-symbol))))
743 (add-text-properties (point-min) (point)
744 (list 'face 'newsticker-feed-face
745 'mouse-face 'highlight
746 'help-echo "Visit in web browser."
747 :nt-link (newsticker--link item)
748 'keymap newsticker--treeview-url-keymap))
754 (insert (newsticker--title item) "\n")
755 (set-marker marker1 pos)
756 (set-marker marker2 (point))
757 (newsticker--treeview-render-text marker1 marker2)
758 (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
762 (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
763 (set-marker marker2 (point))
764 (when newsticker-justification
765 (fill-region marker1 marker2 newsticker-justification))
767 (add-text-properties marker1 (1- (point))
768 (list 'mouse-face 'highlight
769 'help-echo "Visit in web browser."
770 :nt-link (newsticker--link item)
771 'keymap newsticker--treeview-url-keymap))
772 (insert (format-time-string newsticker-date-format
773 (newsticker--time item)))
777 ;; insert enclosures and rest at bottom
778 (goto-char (point-max))
781 (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
782 (put-text-property pos (point) 'face 'newsticker-enclosure-face)
785 (set-marker marker1 pos)
786 (newsticker--print-extra-elements item newsticker--treeview-url-keymap t)
787 (set-marker marker2 (point))
788 (newsticker--treeview-render-text marker1 marker2)
789 (put-text-property marker1 marker2 'face 'newsticker-extra-face)
790 (goto-char (point-min)))))
791 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
793 (memq (newsticker--age item) '(new obsolete)))
794 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
795 (newsticker-treeview-mark-item-old t)
796 (newsticker--treeview-list-update-faces)))
797 (if (window-live-p (newsticker--treeview-item-window))
798 (set-window-point (newsticker--treeview-item-window) 1)))
800 (defun newsticker--treeview-item-update ()
801 "Update the treeview item buffer and window."
803 (if (window-live-p (newsticker--treeview-item-window))
804 (set-window-buffer (newsticker--treeview-item-window)
805 (newsticker--treeview-item-buffer)))
806 (set-buffer (newsticker--treeview-item-buffer))
807 (let ((inhibit-read-only t))
809 (newsticker-treeview-item-mode)))
811 ;; ======================================================================
813 ;; ======================================================================
814 (defun newsticker--treeview-tree-expand (tree)
816 Callback function for tree widget that adds nodes for feeds and subgroups."
817 (tree-widget-set-theme "folder")
818 (let ((group (widget-get tree :nt-group))
822 (setq nt-id (newsticker--treeview-get-id tree i))
825 (let* ((g-name (car g)))
827 :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
828 :expander newsticker--treeview-tree-expand
829 :expander-p (lambda (&rest ignore) t)
833 :leaf-icon newsticker--tree-widget-leaf-icon
834 :keep (:nt-feed :num-new :nt-id :open);; :nt-group
836 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
838 :leaf-icon newsticker--tree-widget-leaf-icon
840 :action newsticker--treeview-list-feed-items
846 (defun newsticker--tree-widget-icon-create (icon)
847 "Create the ICON widget."
848 (let* ((g (widget-get (widget-get icon :node) :nt-feed))
849 (ico (and g (newsticker--icon-read (intern g)))))
852 (widget-put icon :tag-glyph ico)
853 (widget-default-create icon)
854 ;; Insert space between the icon and the node widget.
858 'display (list 'space :width tree-widget-space-width)))
859 ;; fallback: default icon
860 (widget-put icon :leaf-icon 'tree-widget-leaf-icon)
861 (tree-widget-icon-create icon))))
863 (defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
865 "Expand the vfeed TREE.
866 Optional arguments CHANGED-WIDGET and EVENT are ignored."
867 (tree-widget-set-theme "folder")
868 (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
870 :action newsticker--treeview-list-new-items
871 :nt-id ,(newsticker--treeview-get-id tree 0)
873 `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
875 :action newsticker--treeview-list-immortal-items
876 :nt-id ,(newsticker--treeview-get-id tree 1)
878 `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
880 :action newsticker--treeview-list-obsolete-items
881 :nt-id ,(newsticker--treeview-get-id tree 2)
883 `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
885 :action newsticker--treeview-list-all-items
886 :nt-id ,(newsticker--treeview-get-id tree 3)
889 (defun newsticker--treeview-virtual-feed-p (feed-name)
890 "Return non-nil if FEED-NAME is a virtual feed."
891 (string-match "\\*.*\\*" feed-name))
893 (define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
894 "Icon for a tree-widget leaf node."
897 :create 'newsticker--tree-widget-icon-create
898 :button-face 'default)
900 (defun newsticker--treeview-tree-update ()
901 "Update treeview tree buffer and window."
903 (if (window-live-p (newsticker--treeview-tree-window))
904 (set-window-buffer (newsticker--treeview-tree-window)
905 (newsticker--treeview-tree-buffer)))
906 (set-buffer (newsticker--treeview-tree-buffer))
907 (kill-all-local-variables)
908 (let ((inhibit-read-only t))
910 (tree-widget-set-theme "folder")
911 (setq newsticker--treeview-feed-tree
912 (widget-create 'tree-widget
913 :tag (newsticker--treeview-propertize-tag
915 :expander 'newsticker--treeview-tree-expand
916 :expander-p (lambda (&rest ignore) t)
917 :leaf-icon 'newsticker--tree-widget-leaf-icon
918 :nt-group (cdr newsticker-groups)
922 (setq newsticker--treeview-vfeed-tree
923 (widget-create 'tree-widget
924 :tag (newsticker--treeview-propertize-tag
925 "Virtual Feeds" 0 "vfeeds")
926 :expander 'newsticker--treeview-tree-expand-status
927 :expander-p (lambda (&rest ignore) t)
928 :leaf-icon 'newsticker--tree-widget-leaf-icon
932 (use-local-map widget-keymap)
934 (newsticker-treeview-mode)))
936 (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
938 "Return propertized copy of string TAG.
939 Optional argument NUM-NEW is used for choosing face, other
940 arguments NT-ID, FEED, and VFEED are added as properties."
941 ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
942 (let ((face 'newsticker-treeview-face)
943 (map (make-sparse-keymap)))
944 (if (and num-new (> num-new 0))
945 (setq face 'newsticker-treeview-new-face))
946 (define-key map [mouse-1] 'newsticker-treeview-tree-click)
947 (define-key map "\n" 'newsticker-treeview-tree-do-click)
948 (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
949 (propertize tag 'face face 'keymap map
954 'mouse-face 'highlight)))
956 (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
958 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
959 Optional argument NT-ID is added to the tag's properties."
960 (let (tag (num-new 0))
962 (cond ((string= vfeed-name "new")
963 (setq num-new (newsticker--stat-num-items-total 'new))
964 (setq tag (format "New items (%d)" num-new)))
965 ((string= vfeed-name "immortal")
966 (setq num-new (newsticker--stat-num-items-total 'immortal))
967 (setq tag (format "Immortal items (%d)" num-new)))
968 ((string= vfeed-name "obsolete")
969 (setq num-new (newsticker--stat-num-items-total 'obsolete))
970 (setq tag (format "Obsolete items (%d)" num-new)))
971 ((string= vfeed-name "all")
972 (setq num-new (newsticker--stat-num-items-total))
973 (setq tag (format "All items (%d)" num-new)))))
975 (setq num-new (newsticker--stat-num-items-for-group
976 (intern feed-name) 'new 'immortal))
979 (newsticker--real-feed-name (intern feed-name))
982 (newsticker--treeview-propertize-tag tag num-new
984 feed-name vfeed-name))))
986 (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
987 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
988 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
989 (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
991 (setq result (+ result
992 (apply 'newsticker--stat-num-items (intern f-n)
994 (newsticker--group-get-feeds
995 (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
998 (defun newsticker--treeview-count-node-items (feed &optional isvirtual)
999 "Count number of relevant items for a treeview node.
1000 FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
1001 the feed is a virtual feed."
1005 (cond ((string= feed "new")
1006 (setq num-new (newsticker--stat-num-items-total 'new)))
1007 ((string= feed "immortal")
1008 (setq num-new (newsticker--stat-num-items-total 'immortal)))
1009 ((string= feed "obsolete")
1010 (setq num-new (newsticker--stat-num-items-total 'obsolete)))
1011 ((string= feed "all")
1012 (setq num-new (newsticker--stat-num-items-total))))
1013 (setq num-new (newsticker--stat-num-items-for-group
1014 (intern feed) 'new 'immortal))))
1017 (defun newsticker--treeview-tree-update-tag (w &optional recursive
1019 "Update tag for tree widget W.
1020 If RECURSIVE is non-nil recursively update parent widgets as
1021 well. Argument IGNORE is ignored. Note that this function, if
1022 called recursively, makes w invalid. You should keep w's nt-id in
1024 (let* ((parent (widget-get w :parent))
1025 (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
1026 (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
1027 (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
1028 (num-new (newsticker--treeview-count-node-items (or feed vfeed)
1030 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
1031 (n (widget-get w :node)))
1034 (newsticker--treeview-tree-update-tag parent)))
1037 (widget-put n :tag tag))
1038 (widget-put w :num-new num-new)
1039 (widget-put w :tag tag)
1040 (when (marker-position (widget-get w :from))
1042 (notify (widget-get w :notify)))
1043 ;; FIXME: This moves point!!!!
1044 (with-current-buffer (newsticker--treeview-tree-buffer)
1045 (widget-value-set w (widget-value w)))
1048 (defun newsticker--treeview-tree-do-update-tags (widget)
1049 "Actually recursively update tags for WIDGET."
1051 (let ((children (widget-get widget :children)))
1052 (dolist (w children)
1053 (newsticker--treeview-tree-do-update-tags w))
1054 (newsticker--treeview-tree-update-tag widget))))
1056 (defun newsticker--treeview-tree-update-tags (&rest ignore)
1057 "Update all tags of all trees.
1058 Arguments IGNORE are ignored."
1059 (save-current-buffer
1060 (set-buffer (newsticker--treeview-tree-buffer))
1061 (let ((inhibit-read-only t))
1062 (newsticker--treeview-tree-do-update-tags
1063 newsticker--treeview-feed-tree)
1064 (newsticker--treeview-tree-do-update-tags
1065 newsticker--treeview-vfeed-tree))
1066 (tree-widget-set-theme "folder")))
1068 (defun newsticker--treeview-tree-update-highlight ()
1069 "Update highlight in tree buffer."
1070 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
1071 (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
1072 (setq pos (widget-get (widget-get
1073 (newsticker--treeview-get-current-node)
1075 (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
1076 (with-current-buffer (newsticker--treeview-tree-buffer)
1078 (move-overlay newsticker--tree-selection-overlay
1079 (point-at-bol) (1+ (point-at-eol))
1081 (if (window-live-p (newsticker--treeview-tree-window))
1082 (set-window-point (newsticker--treeview-tree-window) pos)))))
1084 ;; ======================================================================
1086 ;; ======================================================================
1087 (defvar newsticker-treeview-tool-bar-map
1088 (if (featurep 'xemacs)
1090 (if (boundp 'tool-bar-map)
1091 (let ((tool-bar-map (make-sparse-keymap)))
1092 (tool-bar-add-item "newsticker/prev-feed"
1093 'newsticker-treeview-prev-feed
1094 'newsticker-treeview-prev-feed
1095 :help "Go to previous feed"
1096 ;;:enable '(newsticker-previous-feed-available-p) FIXME
1098 (tool-bar-add-item "newsticker/prev-item"
1099 'newsticker-treeview-prev-item
1100 'newsticker-treeview-prev-item
1101 :help "Go to previous item"
1102 ;;:enable '(newsticker-previous-item-available-p) FIXME
1104 (tool-bar-add-item "newsticker/next-item"
1105 'newsticker-treeview-next-item
1106 'newsticker-treeview-next-item
1108 :help "Go to next item"
1109 ;;:enable '(newsticker-next-item-available-p) FIXME
1111 (tool-bar-add-item "newsticker/next-feed"
1112 'newsticker-treeview-next-feed
1113 'newsticker-treeview-next-feed
1114 :help "Go to next feed"
1115 ;;:enable '(newsticker-next-feed-available-p) FIXME
1117 (tool-bar-add-item "newsticker/mark-immortal"
1118 'newsticker-treeview-toggle-item-immortal
1119 'newsticker-treeview-toggle-item-immortal
1120 :help "Toggle current item as immortal"
1121 ;;:enable '(newsticker-item-not-immortal-p) FIXME
1123 (tool-bar-add-item "newsticker/mark-read"
1124 'newsticker-treeview-mark-item-old
1125 'newsticker-treeview-mark-item-old
1126 :help "Mark current item as read"
1127 ;;:enable '(newsticker-item-not-old-p) FIXME
1129 (tool-bar-add-item "newsticker/get-all"
1130 'newsticker-get-all-news
1131 'newsticker-get-all-news
1132 :help "Get news for all feeds")
1133 (tool-bar-add-item "newsticker/update"
1134 'newsticker-treeview-update
1135 'newsticker-treeview-update
1136 :help "Update newsticker buffer")
1137 (tool-bar-add-item "newsticker/browse-url"
1138 'newsticker-browse-url
1139 'newsticker-browse-url
1140 :help "Browse URL for item at point")
1141 ;; standard icons / actions
1142 (define-key tool-bar-map [newsticker-sep-1]
1143 (list 'menu-item "--double-line"))
1144 (tool-bar-add-item "close"
1145 'newsticker-treeview-quit
1146 'newsticker-treeview-quit
1147 :help "Close newsticker")
1148 (tool-bar-add-item "preferences"
1149 'newsticker-customize
1150 'newsticker-customize
1151 :help "Customize newsticker")
1154 ;; ======================================================================
1156 ;; ======================================================================
1158 (defun newsticker-treeview-mouse-browse-url (event)
1159 "Call `browse-url' for the link of the item at which the EVENT occurred."
1162 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1163 (let ((url (get-text-property (posn-point (event-end event))
1167 (if newsticker-automatically-mark-visited-items-as-old
1168 (newsticker-treeview-mark-item-old))))))
1170 (defun newsticker-treeview-browse-url ()
1171 "Call `browse-url' for the link of the item at point."
1173 (with-current-buffer (newsticker--treeview-list-buffer)
1174 (let ((url (get-text-property (point) :nt-link)))
1177 (if newsticker-automatically-mark-visited-items-as-old
1178 (newsticker-treeview-mark-item-old))))))
1180 (defun newsticker--treeview-buffer-init ()
1181 "Initialize all treeview buffers."
1182 (setq newsticker--treeview-buffers nil)
1183 (add-to-list 'newsticker--treeview-buffers
1184 (get-buffer-create "*Newsticker Tree*") t)
1185 (add-to-list 'newsticker--treeview-buffers
1186 (get-buffer-create "*Newsticker List*") t)
1187 (add-to-list 'newsticker--treeview-buffers
1188 (get-buffer-create "*Newsticker Item*") t)
1190 (unless newsticker--selection-overlay
1191 (with-current-buffer (newsticker--treeview-list-buffer)
1192 (setq buffer-undo-list t)
1193 (setq newsticker--selection-overlay (make-overlay (point-min)
1195 (overlay-put newsticker--selection-overlay 'face
1196 'newsticker-treeview-selection-face)))
1197 (unless newsticker--tree-selection-overlay
1198 (with-current-buffer (newsticker--treeview-tree-buffer)
1199 (setq buffer-undo-list t)
1200 (setq newsticker--tree-selection-overlay (make-overlay (point-min)
1202 (overlay-put newsticker--tree-selection-overlay 'face
1203 'newsticker-treeview-selection-face)))
1205 (newsticker--treeview-tree-update)
1206 (newsticker--treeview-list-update t)
1207 (newsticker--treeview-item-update))
1209 (defun newsticker-treeview-update ()
1210 "Update all treeview buffers and windows.
1211 Note: does not update the layout."
1213 (let ((cur-item (newsticker--treeview-get-selected-item)))
1214 (if (newsticker--group-manage-orphan-feeds)
1215 (newsticker--treeview-tree-update))
1216 (newsticker--treeview-list-update t)
1217 (newsticker--treeview-item-update)
1218 (newsticker--treeview-tree-update-tags)
1219 (cond (newsticker--treeview-current-feed
1220 (newsticker--treeview-list-items newsticker--treeview-current-feed))
1221 (newsticker--treeview-current-vfeed
1222 (newsticker--treeview-list-items-with-age
1223 (intern newsticker--treeview-current-vfeed))))
1224 (newsticker--treeview-tree-update-highlight)
1225 (newsticker--treeview-list-update-highlight)
1226 (let ((cur-feed (or newsticker--treeview-current-feed
1227 newsticker--treeview-current-vfeed)))
1228 (if (and cur-feed cur-item)
1229 (newsticker--treeview-list-select cur-item)))))
1231 (defun newsticker-treeview-quit ()
1232 "Quit newsticker treeview."
1234 (setq newsticker--sentinel-callback nil)
1235 (bury-buffer "*Newsticker Tree*")
1236 (bury-buffer "*Newsticker List*")
1237 (bury-buffer "*Newsticker Item*")
1238 (set-window-configuration newsticker--saved-window-config)
1239 (when newsticker--frame
1240 (if (frame-live-p newsticker--frame)
1241 (delete-frame newsticker--frame))
1242 (setq newsticker--frame nil))
1243 (newsticker-treeview-save))
1245 (defun newsticker-treeview-save ()
1246 "Save treeview group settings."
1248 (let ((coding-system-for-write 'utf-8)
1249 (buf (find-file-noselect (concat newsticker-dir "/groups"))))
1251 (with-current-buffer buf
1252 (setq buffer-undo-list t)
1254 (insert ";; -*- coding: utf-8 -*-\n")
1255 (insert (prin1-to-string newsticker-groups))
1259 (defun newsticker--treeview-load ()
1260 "Load treeview settings."
1261 (let* ((coding-system-for-read 'utf-8)
1263 (or (and newsticker-groups-filename
1265 (expand-file-name newsticker-groups-filename)
1266 (expand-file-name (concat newsticker-dir "/groups"))))
1267 (file-exists-p newsticker-groups-filename)
1270 (concat "Obsolete variable `newsticker-groups-filename' "
1271 "points to existing file \"%s\".\n"
1273 newsticker-groups-filename))
1274 newsticker-groups-filename)
1275 (concat newsticker-dir "/groups")))
1276 (buf (and (file-exists-p filename)
1277 (find-file-noselect filename))))
1278 (and newsticker-groups-filename
1279 (file-exists-p newsticker-groups-filename)
1281 (concat "Delete the file \"%s\",\nto which the obsolete "
1282 "variable `newsticker-groups-filename' points ? ")
1283 newsticker-groups-filename))
1284 (delete-file newsticker-groups-filename))
1287 (goto-char (point-min))
1289 (setq newsticker-groups (read buf))
1291 (message "Error while reading newsticker groups file!")
1292 (setq newsticker-groups nil)))
1293 (kill-buffer buf))))
1296 (defun newsticker-treeview-scroll-item ()
1297 "Scroll current item."
1299 (save-selected-window
1300 (select-window (newsticker--treeview-item-window) t)
1303 (defun newsticker-treeview-show-item ()
1304 "Show current item."
1306 (newsticker--treeview-restore-layout)
1307 (newsticker--treeview-list-update-highlight)
1308 (with-current-buffer (newsticker--treeview-list-buffer)
1310 (let ((item (get-text-property (point) :nt-item))
1311 (feed (get-text-property (point) :nt-feed)))
1312 (newsticker--treeview-item-show item feed)))
1313 (newsticker--treeview-tree-update-tag
1314 (newsticker--treeview-get-current-node) t)
1315 (newsticker--treeview-tree-update-highlight))
1317 (defun newsticker-treeview-next-item ()
1318 "Move to next item."
1320 (newsticker--treeview-restore-layout)
1321 (save-current-buffer
1322 (set-buffer (newsticker--treeview-list-buffer))
1323 (if (newsticker--treeview-list-highlight-start)
1327 (newsticker-treeview-show-item))
1329 (defun newsticker-treeview-prev-item ()
1330 "Move to previous item."
1332 (newsticker--treeview-restore-layout)
1333 (save-current-buffer
1334 (set-buffer (newsticker--treeview-list-buffer))
1336 (newsticker-treeview-show-item))
1338 (defun newsticker-treeview-next-new-or-immortal-item (&optional
1341 "Move to next new or immortal item.
1342 Will move to next feed until an item is found. Will not move if
1343 optional argument CURRENT-ITEM-COUNTS is t and current item is
1344 new or immortal. Will not move from virtual to ordinary feed
1345 tree or vice versa if optional argument DONT-WRAP-TREES is non-nil."
1347 (newsticker--treeview-restore-layout)
1348 (newsticker--treeview-list-clear-highlight)
1349 (unless (catch 'found
1350 (let ((move (not current-item-counts)))
1352 (save-current-buffer
1353 (set-buffer (newsticker--treeview-list-buffer))
1354 (when move (forward-line 1)
1357 (throw 'found nil))))
1358 (when (memq (newsticker--age
1359 (newsticker--treeview-get-selected-item))
1361 (newsticker-treeview-show-item)
1364 (let ((wrap-trees (not dont-wrap-trees)))
1365 (when (or (newsticker-treeview-next-feed t)
1366 (and wrap-trees (newsticker--treeview-first-feed)))
1367 (newsticker-treeview-next-new-or-immortal-item t t)))))
1369 (defun newsticker-treeview-prev-new-or-immortal-item ()
1370 "Move to previous new or immortal item.
1371 Will move to previous feed until an item is found."
1373 (newsticker--treeview-restore-layout)
1374 (newsticker--treeview-list-clear-highlight)
1375 (unless (catch 'found
1377 (save-current-buffer
1378 (set-buffer (newsticker--treeview-list-buffer))
1382 (when (memq (newsticker--age
1383 (newsticker--treeview-get-selected-item))
1385 (newsticker-treeview-show-item)
1388 (throw 'found nil))))
1389 (when (newsticker-treeview-prev-feed t)
1390 (set-buffer (newsticker--treeview-list-buffer))
1391 (goto-char (point-max))
1392 (newsticker-treeview-prev-new-or-immortal-item))))
1394 (defun newsticker--treeview-get-selected-item ()
1395 "Return item that is currently selected in list buffer."
1396 (with-current-buffer (newsticker--treeview-list-buffer)
1398 (get-text-property (point) :nt-item)))
1400 (defun newsticker-treeview-mark-item-old (&optional dont-proceed)
1401 "Mark current item as old unless it is obsolete.
1402 Move to next item unless DONT-PROCEED is non-nil."
1404 (let ((item (newsticker--treeview-get-selected-item)))
1405 (unless (eq (newsticker--age item) 'obsolete)
1406 (newsticker--treeview-mark-item item 'old)))
1407 (unless dont-proceed
1408 (newsticker-treeview-next-item)))
1410 (defun newsticker-treeview-toggle-item-immortal ()
1411 "Toggle immortality of current item."
1413 (let* ((item (newsticker--treeview-get-selected-item))
1414 (new-age (if (eq (newsticker--age item) 'immortal)
1417 (newsticker--treeview-mark-item item new-age)
1418 (newsticker-treeview-next-item)))
1420 (defun newsticker--treeview-mark-item (item new-age)
1421 "Mark ITEM with NEW-AGE."
1423 (setcar (nthcdr 4 item) new-age)
1424 ;; clean up ticker FIXME
1426 (newsticker--cache-save-feed
1427 (newsticker--cache-get-feed (intern newsticker--treeview-current-feed)))
1428 (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree))
1430 (defun newsticker-treeview-mark-list-items-old ()
1431 "Mark all listed items as old."
1433 (let ((current-feed (or newsticker--treeview-current-feed
1434 newsticker--treeview-current-vfeed)))
1435 (with-current-buffer (newsticker--treeview-list-buffer)
1436 (goto-char (point-min))
1438 (let ((item (get-text-property (point) :nt-item)))
1439 (unless (memq (newsticker--age item) '(immortal obsolete))
1440 (newsticker--treeview-mark-item item 'old)))
1442 (newsticker--treeview-tree-update-tags)
1444 (newsticker-treeview-jump current-feed))))
1446 (defun newsticker-treeview-save-item ()
1447 "Save current item."
1449 (newsticker-save-item (or newsticker--treeview-current-feed
1450 newsticker--treeview-current-vfeed)
1451 (newsticker--treeview-get-selected-item)))
1453 (defun newsticker-treeview-browse-url-item ()
1454 "Convert current item to HTML and call `browse-url' on result."
1456 (newsticker-browse-url-item (or newsticker--treeview-current-feed
1457 newsticker--treeview-current-vfeed)
1458 (newsticker--treeview-get-selected-item)))
1460 (defun newsticker--treeview-set-current-node (node)
1461 "Make NODE the current node."
1462 (with-current-buffer (newsticker--treeview-tree-buffer)
1463 (setq newsticker--treeview-current-node-id
1464 (widget-get node :nt-id))
1465 (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
1466 (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
1467 (newsticker--treeview-tree-update-highlight)))
1469 (defun newsticker--treeview-get-first-child (node)
1470 "Get first child of NODE."
1471 (let ((children (widget-get node :children)))
1476 (defun newsticker--treeview-get-second-child (node)
1477 "Get scond child of NODE."
1478 (let ((children (widget-get node :children)))
1480 (car (cdr children))
1483 (defun newsticker--treeview-get-last-child (node)
1484 "Get last child of NODE."
1485 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1486 (let ((children (widget-get node :children)))
1488 (car (reverse children))
1491 (defun newsticker--treeview-get-feed-vfeed (node)
1492 "Get (virtual) feed of NODE."
1493 (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
1495 (defun newsticker--treeview-get-next-sibling (node)
1496 "Get next sibling of NODE."
1497 (let ((parent (widget-get node :parent)))
1499 (let ((children (widget-get parent :children)))
1501 (if (newsticker--treeview-nodes-eq (car children) node)
1502 (throw 'found (car (cdr children))))
1503 (setq children (cdr children)))))))
1505 (defun newsticker--treeview-get-prev-sibling (node)
1506 "Get previous sibling of NODE."
1507 (let ((parent (widget-get node :parent)))
1509 (let ((children (widget-get parent :children))
1512 (if (and (newsticker--treeview-nodes-eq (car children) node)
1513 (widget-get prev :nt-id))
1514 (throw 'found prev))
1515 (setq prev (car children))
1516 (setq children (cdr children)))))))
1518 (defun newsticker--treeview-get-next-uncle (node)
1519 "Get next uncle of NODE, i.e. parent's next sibling."
1520 (let* ((parent (widget-get node :parent))
1521 (grand-parent (widget-get parent :parent)))
1523 (let ((uncles (widget-get grand-parent :children)))
1525 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1526 (throw 'found (car (cdr uncles))))
1527 (setq uncles (cdr uncles)))))))
1529 (defun newsticker--treeview-get-prev-uncle (node)
1530 "Get previous uncle of NODE, i.e. parent's previous sibling."
1531 (let* ((parent (widget-get node :parent))
1532 (grand-parent (widget-get parent :parent)))
1534 (let ((uncles (widget-get grand-parent :children))
1537 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1538 (throw 'found prev))
1539 (setq prev (car uncles))
1540 (setq uncles (cdr uncles)))))))
1542 (defun newsticker--treeview-get-other-tree ()
1544 (if (and (newsticker--treeview-get-current-node)
1545 (widget-get (newsticker--treeview-get-current-node) :nt-feed))
1546 newsticker--treeview-vfeed-tree
1547 newsticker--treeview-feed-tree))
1549 (defun newsticker--treeview-activate-node (node &optional backward)
1551 If NODE is a tree widget the node's first subnode is activated.
1552 If BACKWARD is non-nil the last subnode of the previous sibling
1554 (newsticker--treeview-set-current-node node)
1555 (save-current-buffer
1556 (set-buffer (newsticker--treeview-tree-buffer))
1557 (cond ((eq (widget-type node) 'tree-widget)
1558 (unless (widget-get node :open)
1559 (widget-put node :open nil)
1560 (widget-apply-action node))
1561 (newsticker--treeview-activate-node
1563 (newsticker--treeview-get-last-child node)
1564 (newsticker--treeview-get-second-child node))))
1566 (widget-apply-action node)))))
1568 (defun newsticker--treeview-first-feed ()
1569 "Jump to the depth-first feed in the `newsticker-groups' tree."
1570 (newsticker-treeview-jump
1571 (car (reverse (newsticker--group-get-feeds newsticker-groups t)))))
1573 (defun newsticker-treeview-next-feed (&optional stay-in-tree)
1575 Optional argument STAY-IN-TREE prevents moving from real feed
1576 tree to virtual feed tree or vice versa.
1577 Return t if a new feed was activated, nil otherwise."
1579 (newsticker--treeview-restore-layout)
1580 (let ((cur (newsticker--treeview-get-current-node))
1584 (or (newsticker--treeview-get-next-sibling cur)
1585 (newsticker--treeview-get-next-uncle cur)
1586 (and (not stay-in-tree)
1587 (newsticker--treeview-get-other-tree)))
1588 (car (widget-get newsticker--treeview-feed-tree :children))))
1591 (newsticker--treeview-activate-node new)
1592 (newsticker--treeview-tree-update-highlight)
1596 (defun newsticker-treeview-prev-feed (&optional stay-in-tree)
1597 "Move to previous feed.
1598 Optional argument STAY-IN-TREE prevents moving from real feed
1599 tree to virtual feed tree or vice versa.
1600 Return t if a new feed was activated, nil otherwise."
1602 (newsticker--treeview-restore-layout)
1603 (let ((cur (newsticker--treeview-get-current-node))
1609 (or (newsticker--treeview-get-prev-sibling cur)
1610 (newsticker--treeview-get-prev-uncle cur)
1611 (and (not stay-in-tree)
1612 (newsticker--treeview-get-other-tree)))
1613 (car (widget-get newsticker--treeview-feed-tree :children))))
1616 (newsticker--treeview-activate-node new t)
1617 (newsticker--treeview-tree-update-highlight)
1622 (defun newsticker-treeview-next-page ()
1623 "Scroll item buffer."
1625 (save-selected-window
1626 (select-window (newsticker--treeview-item-window) t)
1630 (goto-char (point-min))))))
1633 (defun newsticker--treeview-unfold-node (feed-name)
1634 "Recursively show subtree above the node that represents FEED-NAME."
1635 (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
1637 (let* ((group-name (car (newsticker--group-find-parent-group
1639 (newsticker--treeview-unfold-node group-name))
1640 (setq node (newsticker--treeview-get-node-of-feed feed-name)))
1642 (with-current-buffer (newsticker--treeview-tree-buffer)
1643 (widget-put node :nt-selected t)
1644 (widget-apply-action node)
1645 (newsticker--treeview-set-current-node node)))))
1647 (defun newsticker-treeview-jump (feed-name)
1648 "Jump to feed FEED-NAME in newsticker treeview."
1650 (list (let ((completion-ignore-case t))
1653 (append '("new" "obsolete" "immortal" "all")
1654 (mapcar 'car (append newsticker-url-list
1655 newsticker-url-list-defaults)))
1657 (newsticker--treeview-unfold-node feed-name))
1659 ;; ======================================================================
1661 ;; ======================================================================
1662 (defun newsticker--group-do-find-group (feed-or-group-name parent-node node)
1663 "Recursively find FEED-OR-GROUP-NAME in PARENT-NODE or NODE."
1664 (cond ((stringp node)
1665 (when (string= feed-or-group-name node)
1666 (throw 'found parent-node)))
1668 (cond ((string= feed-or-group-name (car node))
1669 (throw 'found parent-node))
1670 ((member feed-or-group-name (cdr node))
1671 (throw 'found node))
1675 (newsticker--group-do-find-group
1676 feed-or-group-name node n)))
1679 (defun newsticker--group-find-parent-group (feed-or-group-name)
1680 "Find group containing FEED-OR-GROUP-NAME."
1683 (newsticker--group-do-find-group feed-or-group-name
1689 (defun newsticker--group-do-get-group (name node)
1690 "Recursively find group with NAME below NODE."
1691 (if (string= name (car node))
1695 (newsticker--group-do-get-group name n)))
1698 (defun newsticker--group-get-group (name)
1699 "Find group with NAME."
1703 (newsticker--group-do-get-group name n)))
1707 (defun newsticker--group-get-subgroups (group &optional recursive)
1708 "Return list of subgroups for GROUP.
1709 If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1713 (setq result (cons (car n) result))
1714 (let ((subgroups (newsticker--group-get-subgroups n recursive)))
1716 (setq result (append subgroups result))))))
1720 (defun newsticker--group-all-groups ()
1721 "Return nested list of all groups."
1722 (newsticker--group-get-subgroups newsticker-groups t))
1724 (defun newsticker--group-get-feeds (group &optional recursive)
1725 "Return list of all feeds in GROUP.
1726 If RECURSIVE is non-nil recursively get feeds of subgroups and
1727 return a nested list."
1731 (setq result (cons n result))
1733 (let ((subfeeds (newsticker--group-get-feeds n t)))
1735 (setq result (append subfeeds result)))))))
1739 (defun newsticker-group-add-group (name parent)
1740 "Add group NAME to group PARENT."
1742 (list (read-string "Name of new group: ")
1743 (let ((completion-ignore-case t))
1744 (completing-read "Name of parent group (optional): " (newsticker--group-all-groups)
1746 (if (newsticker--group-get-group name)
1747 (error "Group %s exists already" name))
1748 (let ((p (if (and parent (not (string= parent "")))
1749 (newsticker--group-get-group parent)
1750 newsticker-groups)))
1752 (error "Parent %s does not exist" parent))
1753 (setcdr p (cons (list name) (cdr p))))
1754 (newsticker--treeview-tree-update)
1755 (newsticker-treeview-jump newsticker--treeview-current-feed))
1757 (defun newsticker-group-delete-group (name)
1758 "Delete group NAME."
1760 (list (let ((completion-ignore-case t))
1761 (completing-read "Delete group: "
1762 (newsticker--group-names)
1763 nil t (car (newsticker--group-find-parent-group
1764 newsticker--treeview-current-feed))))))
1765 (let ((parent-group (newsticker--group-find-parent-group name)))
1766 (unless parent-group
1767 (error "Parent %s does not exist" parent-group))
1768 (setcdr parent-group (cl-delete-if (lambda (g)
1770 (string= name (car g))))
1771 (cdr parent-group)))
1772 (newsticker--group-manage-orphan-feeds)
1773 (newsticker--treeview-tree-update)
1774 (newsticker-treeview-update)
1775 (newsticker-treeview-jump newsticker--treeview-current-feed)))
1777 (defun newsticker--group-do-rename-group (old-name new-name)
1778 "Actually rename group OLD-NAME to NEW-NAME."
1779 (let ((parent-group (newsticker--group-find-parent-group old-name)))
1780 (unless parent-group
1781 (error "Parent of %s does not exist" old-name))
1782 (mapcar (lambda (elt)
1783 (cond ((and (listp elt)
1784 (string= old-name (car elt)))
1785 (cons new-name (cdr elt)))
1787 elt))) parent-group)))
1789 (defun newsticker-group-rename-group (old-name new-name)
1790 "Rename group OLD-NAME to NEW-NAME."
1792 (list (let* ((completion-ignore-case t))
1793 (completing-read "Rename group: "
1794 (newsticker--group-names)
1795 nil t (car (newsticker--group-find-parent-group
1796 newsticker--treeview-current-feed))))
1797 (read-string "Rename to: ")))
1798 (setq newsticker-groups (newsticker--group-do-rename-group old-name new-name))
1799 (newsticker--group-manage-orphan-feeds)
1800 (newsticker--treeview-tree-update)
1801 (newsticker-treeview-update)
1802 (newsticker-treeview-jump newsticker--treeview-current-feed))
1804 (defun newsticker--get-group-names (lst)
1805 "Do get the group names from LST."
1806 (delete nil (cons (car lst)
1810 (newsticker--get-group-names e))
1815 (defun newsticker--group-names ()
1816 "Get names of all newsticker groups."
1817 (newsticker--get-group-names newsticker-groups))
1819 (defun newsticker-group-move-feed (name group-name &optional no-update)
1820 "Move feed NAME to group GROUP-NAME.
1821 Update treeview afterwards unless NO-UPDATE is non-nil."
1823 (let ((completion-ignore-case t))
1824 (list (completing-read "Name of feed or group to move: "
1825 (append (mapcar 'car newsticker-url-list)
1826 (newsticker--group-names))
1827 nil t newsticker--treeview-current-feed)
1828 (completing-read "Name of new parent group: " (newsticker--group-names)
1830 (let* ((group (if (and group-name (not (string= group-name "")))
1831 (newsticker--group-get-group group-name)
1833 (moving-group-p (member name (newsticker--group-names)))
1834 (moved-thing (if moving-group-p
1835 (newsticker--group-get-group name)
1838 (error "Group %s does not exist" group-name))
1839 (while (let ((old-group
1840 (newsticker--group-find-parent-group name)))
1842 (delete moved-thing old-group))
1844 (setcdr group (cons moved-thing (cdr group)))
1846 (newsticker--treeview-tree-update)
1847 (newsticker-treeview-update)
1848 (newsticker-treeview-jump name))))
1850 (defun newsticker-group-shift-feed-down ()
1851 "Shift current feed down in its group."
1853 (newsticker--group-shift 1))
1855 (defun newsticker-group-shift-feed-up ()
1856 "Shift current feed down in its group."
1858 (newsticker--group-shift -1))
1860 (defun newsticker-group-shift-group-down ()
1861 "Shift current group down in its group."
1863 (newsticker--group-shift 1 t))
1865 (defun newsticker-group-shift-group-up ()
1866 "Shift current group down in its group."
1868 (newsticker--group-shift -1 t))
1870 (defun newsticker--group-shift (delta &optional move-group)
1871 "Shift current feed or group within its parent group.
1872 DELTA is an integer which specifies the direction and the amount
1873 of the shift. If MOVE-GROUP is nil the currently selected feed
1874 `newsticker--treeview-current-feed' is shifted, if it is t then
1875 the current feed's parent group is shifted.."
1876 (let* ((cur-feed newsticker--treeview-current-feed)
1877 (thing (if move-group
1878 (newsticker--group-find-parent-group cur-feed)
1880 (parent-group (newsticker--group-find-parent-group
1881 (if move-group (car thing) thing))))
1882 (unless parent-group
1883 (error "Group not found!"))
1884 (let* ((siblings (cdr parent-group))
1885 (pos (cl-position thing siblings :test 'equal))
1886 (tpos (+ pos delta ))
1887 (new-pos (max 0 (min (length siblings) tpos)))
1888 (beg (cl-subseq siblings 0 (min pos new-pos)))
1889 (end (cl-subseq siblings (+ 1 (max pos new-pos))))
1890 (p (elt siblings new-pos)))
1891 (when (not (= pos new-pos))
1892 (setcdr parent-group
1893 (cl-concatenate 'list
1899 (newsticker--treeview-tree-update)
1900 (newsticker-treeview-update)
1901 (newsticker-treeview-jump cur-feed)))))
1903 (defun newsticker--count-groups (group)
1904 "Recursively count number of subgroups of GROUP."
1908 (setq result (+ result (newsticker--count-groups g)))))
1912 (defun newsticker--count-grouped-feeds (group)
1913 "Recursively count number of feeds in GROUP and its subgroups."
1917 (setq result (+ result (newsticker--count-grouped-feeds g)))
1918 (setq result (1+ result))))
1922 (defun newsticker--group-remove-obsolete-feeds (group)
1923 "Recursively remove obsolete feeds from GROUP."
1925 (urls (append newsticker-url-list newsticker-url-list-defaults)))
1929 (newsticker--group-remove-obsolete-feeds g)))
1931 (setq result (cons sub-groups result))))
1933 (setq result (cons g result)))))
1936 (cons (car group) (reverse result))
1939 (defun newsticker--group-manage-orphan-feeds ()
1940 "Put unmanaged feeds into `newsticker-groups'.
1941 Remove obsolete feeds as well.
1942 Return t if groups have changed, nil otherwise."
1943 (unless newsticker-groups
1944 (setq newsticker-groups '("Feeds")))
1945 (let ((new-feed nil)
1946 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
1948 (unless (newsticker--group-find-parent-group (car f))
1950 (newsticker-group-move-feed (car f) nil t)))
1951 (append newsticker-url-list-defaults newsticker-url-list))
1952 (setq newsticker-groups
1953 (newsticker--group-remove-obsolete-feeds newsticker-groups))
1955 (not (= grouped-feeds
1956 (newsticker--count-grouped-feeds newsticker-groups))))))
1958 ;; ======================================================================
1960 ;; ======================================================================
1961 (defun newsticker--treeview-create-groups-menu (group-list
1963 "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
1964 (let ((menu (make-sparse-keymap (if (stringp (car group-list))
1966 "Move to group..."))))
1969 (let ((title (if (stringp (car g))
1971 "Move to group...")))
1972 (unless (eq g excluded-group)
1973 (define-key menu (vector (intern title))
1974 (list 'menu-item title
1975 (newsticker--treeview-create-groups-menu
1976 (cdr g) excluded-group)))))))
1977 (reverse group-list))
1980 (defun newsticker--treeview-create-tree-menu (feed-name)
1981 "Create tree menu for FEED-NAME."
1982 (let ((menu (make-sparse-keymap feed-name)))
1983 (define-key menu [newsticker-treeview-mark-list-items-old]
1984 (list 'menu-item "Mark all items old"
1985 'newsticker-treeview-mark-list-items-old))
1986 (define-key menu [move]
1987 (list 'menu-item "Move to group..."
1988 (newsticker--treeview-create-groups-menu
1990 (newsticker--group-get-group feed-name))))
1993 (defvar newsticker-treeview-list-menu
1994 (let ((menu (make-sparse-keymap "Newsticker List")))
1995 (define-key menu [newsticker-treeview-mark-list-items-old]
1996 (list 'menu-item "Mark all items old"
1997 'newsticker-treeview-mark-list-items-old))
1998 (define-key menu [newsticker-treeview-mark-item-old]
1999 (list 'menu-item "Mark current item old"
2000 'newsticker-treeview-mark-item-old))
2001 (define-key menu [newsticker-treeview-toggle-item-immortal]
2002 (list 'menu-item "Mark current item immortal (toggle)"
2003 'newsticker-treeview-toggle-item-immortal))
2004 (define-key menu [newsticker-treeview-get-news]
2005 (list 'menu-item "Get news for current feed"
2006 'newsticker-treeview-get-news))
2008 "Map for newsticker list menu.")
2010 (defvar newsticker-treeview-item-menu
2011 (let ((menu (make-sparse-keymap "Newsticker Item")))
2012 (define-key menu [newsticker-treeview-mark-item-old]
2013 (list 'menu-item "Mark current item old"
2014 'newsticker-treeview-mark-item-old))
2015 (define-key menu [newsticker-treeview-toggle-item-immortal]
2016 (list 'menu-item "Mark current item immortal (toggle)"
2017 'newsticker-treeview-toggle-item-immortal))
2018 (define-key menu [newsticker-treeview-get-news]
2019 (list 'menu-item "Get news for current feed"
2020 'newsticker-treeview-get-news))
2022 "Map for newsticker item menu.")
2024 (defvar newsticker-treeview-mode-map
2025 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
2026 (define-key map " " 'newsticker-treeview-next-page)
2027 (define-key map "a" 'newsticker-add-url)
2028 (define-key map "b" 'newsticker-treeview-browse-url-item)
2029 (define-key map "F" 'newsticker-treeview-prev-feed)
2030 (define-key map "f" 'newsticker-treeview-next-feed)
2031 (define-key map "g" 'newsticker-treeview-get-news)
2032 (define-key map "G" 'newsticker-get-all-news)
2033 (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
2034 (define-key map "j" 'newsticker-treeview-jump)
2035 (define-key map "n" 'newsticker-treeview-next-item)
2036 (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
2037 (define-key map "O" 'newsticker-treeview-mark-list-items-old)
2038 (define-key map "o" 'newsticker-treeview-mark-item-old)
2039 (define-key map "p" 'newsticker-treeview-prev-item)
2040 (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
2041 (define-key map "q" 'newsticker-treeview-quit)
2042 (define-key map "S" 'newsticker-treeview-save-item)
2043 (define-key map "s" 'newsticker-treeview-save)
2044 (define-key map "u" 'newsticker-treeview-update)
2045 (define-key map "v" 'newsticker-treeview-browse-url)
2046 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
2047 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
2048 (define-key map "\M-m" 'newsticker-group-move-feed)
2049 (define-key map "\M-a" 'newsticker-group-add-group)
2050 (define-key map "\M-d" 'newsticker-group-delete-group)
2051 (define-key map "\M-r" 'newsticker-group-rename-group)
2052 (define-key map [M-down] 'newsticker-group-shift-feed-down)
2053 (define-key map [M-up] 'newsticker-group-shift-feed-up)
2054 (define-key map [M-S-down] 'newsticker-group-shift-group-down)
2055 (define-key map [M-S-up] 'newsticker-group-shift-group-up)
2057 "Mode map for newsticker treeview.")
2059 (define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV"
2060 "Major mode for Newsticker Treeview.
2061 \\{newsticker-treeview-mode-map}"
2062 (if (boundp 'tool-bar-map)
2063 (set (make-local-variable 'tool-bar-map)
2064 newsticker-treeview-tool-bar-map))
2065 (setq buffer-read-only t
2068 (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
2070 (let ((header (concat
2071 (propertize " " 'display '(space :align-to 0))
2072 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
2073 (propertize " " 'display '(space :align-to 2))
2074 (if newsticker--treeview-list-show-feed
2076 (propertize " " 'display '(space :align-to 12)))
2078 (newsticker-treeview-list-make-sort-button "Date"
2080 (if newsticker--treeview-list-show-feed
2081 (propertize " " 'display '(space :align-to 28))
2082 (propertize " " 'display '(space :align-to 18)))
2083 (newsticker-treeview-list-make-sort-button "Title"
2085 (setq header-line-format header))
2086 (define-key newsticker-treeview-list-mode-map [down-mouse-3]
2087 newsticker-treeview-list-menu))
2089 (define-derived-mode newsticker-treeview-item-mode newsticker-treeview-mode
2091 (define-key newsticker-treeview-item-mode-map [down-mouse-3]
2092 newsticker-treeview-item-menu))
2094 (defun newsticker-treeview-tree-click (event)
2095 "Handle click EVENT on a tag in the newsticker tree."
2097 (newsticker--treeview-restore-layout)
2099 (switch-to-buffer (window-buffer (posn-window (event-end event))))
2100 (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
2102 (defun newsticker-treeview-tree-do-click (&optional pos event)
2103 "Actually handle click event.
2104 POS gives the position where EVENT occurred."
2106 (let* ((pos (or pos (point)))
2107 (nt-id (get-text-property pos :nt-id))
2108 (item (get-text-property pos :nt-item)))
2110 ;; click in list buffer
2111 (newsticker-treeview-show-item))
2113 ;; click in tree buffer
2114 (let ((w (newsticker--treeview-get-node-by-id nt-id)))
2116 (newsticker--treeview-tree-update-tag w t t)
2117 (setq w (newsticker--treeview-get-node-by-id nt-id))
2118 (widget-put w :nt-selected t)
2119 (widget-apply w :action event)
2120 (newsticker--treeview-set-current-node w))))))
2121 (newsticker--treeview-tree-update-highlight))
2123 (defun newsticker--treeview-restore-layout ()
2124 "Restore treeview buffers."
2127 (let ((win (nth i newsticker--treeview-windows))
2128 (buf (nth i newsticker--treeview-buffers)))
2129 (unless (window-live-p win)
2130 (newsticker--treeview-window-init)
2131 (newsticker--treeview-buffer-init)
2133 (unless (eq (window-buffer win) buf)
2134 (set-window-buffer win buf t))))))
2136 (defun newsticker--treeview-frame-init ()
2137 "Initialize treeview frame."
2138 (when newsticker-treeview-own-frame
2139 (unless (and newsticker--frame (frame-live-p newsticker--frame))
2140 (setq newsticker--frame (make-frame '((name . "Newsticker")))))
2141 (select-frame-set-input-focus newsticker--frame)
2142 (raise-frame newsticker--frame)))
2144 (defun newsticker--treeview-window-init ()
2145 "Initialize treeview windows."
2146 (setq newsticker--saved-window-config (current-window-configuration))
2147 (setq newsticker--treeview-windows nil)
2148 (setq newsticker--treeview-buffers nil)
2149 (delete-other-windows)
2150 (split-window-right newsticker-treeview-treewindow-width)
2151 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2153 (split-window-below newsticker-treeview-listwindow-height)
2154 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2156 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2160 (defun newsticker-treeview ()
2161 "Start newsticker treeview."
2163 (newsticker--treeview-load)
2164 (setq newsticker--sentinel-callback 'newsticker-treeview-update)
2165 (newsticker--treeview-frame-init)
2166 (newsticker--treeview-window-init)
2167 (newsticker--treeview-buffer-init)
2168 (if (newsticker--group-manage-orphan-feeds)
2169 (newsticker--treeview-tree-update))
2170 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
2171 (newsticker-start t) ;; will start only if not running
2172 (newsticker-treeview-update)
2173 (newsticker--treeview-item-show-text
2175 "Welcome to newsticker!"))
2177 (defun newsticker-treeview-get-news ()
2178 "Get news for current feed."
2180 (when newsticker--treeview-current-feed
2181 (newsticker-get-news newsticker--treeview-current-feed)))
2183 (provide 'newst-treeview)
2185 ;;; newst-treeview.el ends here