1 ;;; newst-treeview.el --- Treeview frontend for newsticker. -*- lexical-binding:t -*-
3 ;; Copyright (C) 2008-2018 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 <https://www.gnu.org/licenses/>.
28 ;; ======================================================================
33 ;; ======================================================================
37 ;; ======================================================================
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
"#4444aa")
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."
137 :version
"25.1" ; changed default value to nil
138 :type
'(choice (const nil
) string
)
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
:nt-feed
) (widget-get node2
:nt-feed
)))))
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 _
)))
263 (declare-function w3m-toggle-inline-images
"ext:w3m" (&optional force no-cache
))
264 (defvar w3m-fill-column
)
265 (defvar w3-maximum-line-length
)
267 (defun newsticker--treeview-render-text (start end
)
268 "Render text between markers START and END."
269 (if newsticker-html-renderer
270 (condition-case error-data
271 ;; Need to save selected window in order to prevent mixing
272 ;; up contents of the item buffer. This happens with shr
273 ;; which does some smart optimizations that apparently
274 ;; interfere with our own, maybe not-so-smart, optimizations.
275 (save-selected-window
277 (set-marker-insertion-type end t
)
278 ;; check whether it is necessary to call html renderer
279 ;; (regexp inspired by htmlr.el)
281 (when (re-search-forward
282 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t
)
283 ;; (message "%s" (newsticker--title item))
284 (let ((w3m-fill-column (if newsticker-use-full-width
286 (w3-maximum-line-length
287 (if newsticker-use-full-width nil fill-column
)))
288 (select-window (newsticker--treeview-item-window))
290 (funcall newsticker-html-renderer start end
)))
291 ;;(cond ((eq newsticker-html-renderer 'w3m-region)
292 ;; (add-text-properties start end (list 'keymap
293 ;; w3m-minor-mode-map)))
294 ;;((eq newsticker-html-renderer 'w3-region)
295 ;;(add-text-properties start end (list 'keymap w3-mode-map))))
296 (if (eq newsticker-html-renderer
'w3m-region
)
297 (w3m-toggle-inline-images t
))
300 (message "Error: HTML rendering failed: %s, %s"
301 (car error-data
) (cdr error-data
))
305 ;; ======================================================================
307 ;; ======================================================================
308 (defun newsticker--treeview-list-add-item (item feed
&optional show-feed
)
309 "Add news ITEM for FEED to newsticker treeview list window.
310 If string SHOW-FEED is non-nil it is shown in the item string."
311 (setq newsticker--treeview-list-show-feed show-feed
)
312 (with-current-buffer (newsticker--treeview-list-buffer)
313 (let* ((inhibit-read-only t
)
315 (goto-char (point-max))
316 (setq pos1
(point-marker))
318 (insert (propertize " " 'display
'(space :align-to
2)))
319 (insert (if show-feed
322 (format "%-10s" (newsticker--real-feed-name
325 (propertize " " 'display
'(space :align-to
12)))
327 (insert (format-time-string newsticker-treeview-date-format
328 (newsticker--time item
)))
329 (insert (propertize " " 'display
330 (list 'space
:align-to
(if show-feed
28 18))))
331 (setq pos2
(point-marker))
332 (insert (newsticker--title item
))
334 (newsticker--treeview-render-text pos2
(point-marker))
336 (while (search-forward "\n" nil t
)
338 (let ((map (make-sparse-keymap)))
339 (dolist (key'([mouse-1
] [mouse-3
]))
340 (define-key map key
'newsticker-treeview-tree-click
))
341 (define-key map
"\n" 'newsticker-treeview-show-item
)
342 (define-key map
"\C-m" 'newsticker-treeview-show-item
)
343 (add-text-properties pos1
(point-max)
346 :nt-link
(newsticker--link item
)
347 'mouse-face
'highlight
349 'help-echo
(buffer-substring pos2
353 (defun newsticker--treeview-list-clear ()
354 "Clear the newsticker treeview list window."
355 (with-current-buffer (newsticker--treeview-list-buffer)
356 (let ((inhibit-read-only t
))
358 (kill-all-local-variables)
361 (defun newsticker--treeview-list-items-with-age-callback (widget
364 "Fill newsticker treeview list window with items of certain age.
365 This is a callback function for the treeview nodes.
366 Argument WIDGET is the calling treeview widget.
367 Argument CHANGED-WIDGET is the widget that actually has changed.
368 Optional argument AGES is the list of ages that are to be shown."
369 (newsticker--treeview-list-clear)
370 (widget-put widget
:nt-selected t
)
371 (apply #'newsticker--treeview-list-items-with-age ages
))
373 (defun newsticker--treeview-list-items-with-age (&rest ages
)
374 "Actually fill newsticker treeview list window with items of certain age.
375 AGES is the list of ages that are to be shown."
377 (let ((feed-name-symbol (intern (car feed
))))
379 (when (memq (newsticker--age item
) ages
)
380 (newsticker--treeview-list-add-item
381 item feed-name-symbol t
)))
382 (newsticker--treeview-list-sort-items
383 (cdr (newsticker--cache-get-feed feed-name-symbol
))))))
384 (append newsticker-url-list-defaults newsticker-url-list
))
385 (newsticker--treeview-list-update nil
))
387 (defun newsticker--treeview-list-new-items (widget changed-widget
389 "Fill newsticker treeview list window with new items.
390 This is a callback function for the treeview nodes.
391 Argument WIDGET is the calling treeview widget.
392 Argument CHANGED-WIDGET is the widget that actually has changed.
393 Optional argument EVENT is the mouse event that triggered this action."
394 (newsticker--treeview-list-items-with-age-callback widget changed-widget
396 (newsticker--treeview-item-show-text
398 "This is a virtual feed containing all new items"))
400 (defun newsticker--treeview-list-immortal-items (widget changed-widget
402 "Fill newsticker treeview list window with immortal items.
403 This is a callback function for the treeview nodes.
404 Argument WIDGET is the calling treeview widget.
405 Argument CHANGED-WIDGET is the widget that actually has changed.
406 Optional argument EVENT is the mouse event that triggered this action."
407 (newsticker--treeview-list-items-with-age-callback widget changed-widget
409 (newsticker--treeview-item-show-text
411 "This is a virtual feed containing all immortal items."))
413 (defun newsticker--treeview-list-obsolete-items (widget changed-widget
415 "Fill newsticker treeview list window with obsolete items.
416 This is a callback function for the treeview nodes.
417 Argument WIDGET is the calling treeview widget.
418 Argument CHANGED-WIDGET is the widget that actually has changed.
419 Optional argument EVENT is the mouse event that triggered this action."
420 (newsticker--treeview-list-items-with-age-callback widget changed-widget
422 (newsticker--treeview-item-show-text
424 "This is a virtual feed containing all obsolete items."))
426 (defun newsticker--treeview-list-all-items (widget changed-widget
428 "Fill newsticker treeview list window with all items.
429 This is a callback function for the treeview nodes.
430 Argument WIDGET is the calling treeview widget.
431 Argument CHANGED-WIDGET is the widget that actually has changed.
432 Optional argument EVENT is the mouse event that triggered this action."
433 (newsticker--treeview-list-items-with-age-callback widget changed-widget
436 (newsticker--treeview-item-show-text
438 "This is a virtual feed containing all items."))
440 (defun newsticker--treeview-list-items-v (vfeed-name)
441 "List items for virtual feed VFEED-NAME."
443 (cond ((string-match "\\*new\\*" vfeed-name
)
444 (newsticker--treeview-list-items-with-age 'new
))
445 ((string-match "\\*immortal\\*" vfeed-name
)
446 (newsticker--treeview-list-items-with-age 'immortal
))
447 ((string-match "\\*old\\*" vfeed-name
)
448 (newsticker--treeview-list-items-with-age 'old nil
)))
449 (newsticker--treeview-list-update nil
)
452 (defun newsticker--treeview-list-items (feed-name)
453 "List items for feed FEED-NAME."
455 (if (newsticker--treeview-virtual-feed-p feed-name
)
456 (newsticker--treeview-list-items-v feed-name
)
458 (if (eq (newsticker--age item
) 'feed
)
459 (newsticker--treeview-item-show item
(intern feed-name
))
460 (newsticker--treeview-list-add-item item
461 (intern feed-name
))))
462 (newsticker--treeview-list-sort-items
463 (cdr (newsticker--cache-get-feed (intern feed-name
)))))
464 (newsticker--treeview-list-update nil
))))
466 (defun newsticker--treeview-list-feed-items (widget _changed-widget
468 "Callback function for listing feed items.
469 Argument WIDGET is the calling treeview widget.
470 Argument CHANGED-WIDGET is the widget that actually has changed.
471 Optional argument EVENT is the mouse event that triggered this action."
472 (newsticker--treeview-list-clear)
473 (widget-put widget
:nt-selected t
)
474 (let ((feed-name (widget-get widget
:nt-feed
))
475 (vfeed-name (widget-get widget
:nt-vfeed
)))
477 (newsticker--treeview-list-items feed-name
)
478 (newsticker--treeview-list-items-v vfeed-name
))))
480 (defun newsticker--treeview-list-compare-item-by-age (item1 item2
)
481 "Compare two news items ITEM1 and ITEM2 wrt age."
483 (let ((age1 (newsticker--age item1
))
484 (age2 (newsticker--age item2
)))
485 (cond ((eq age1
'new
)
488 (cond ((eq age2
'new
)
495 (cond ((eq age2
'new
)
506 (defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2
)
507 "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
508 (newsticker--treeview-list-compare-item-by-age item2 item1
))
510 (defun newsticker--treeview-list-compare-item-by-time (item1 item2
)
511 "Compare two news items ITEM1 and ITEM2 wrt time values."
512 (newsticker--cache-item-compare-by-time item1 item2
))
514 (defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2
)
515 "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
516 (newsticker--cache-item-compare-by-time item2 item1
))
518 (defun newsticker--treeview-list-compare-item-by-title (item1 item2
)
519 "Compare two news items ITEM1 and ITEM2 wrt title."
520 (newsticker--cache-item-compare-by-title item1 item2
))
522 (defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2
)
523 "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
524 (newsticker--cache-item-compare-by-title item2 item1
))
526 (defun newsticker--treeview-list-sort-items (items)
527 "Return sorted copy of list ITEMS.
528 The sort function is chosen according to the value of
529 `newsticker--treeview-list-sort-order'."
531 (cond ((eq newsticker--treeview-list-sort-order
'sort-by-age
)
532 'newsticker--treeview-list-compare-item-by-age
)
533 ((eq newsticker--treeview-list-sort-order
534 'sort-by-age-reverse
)
535 'newsticker--treeview-list-compare-item-by-age-reverse
)
536 ((eq newsticker--treeview-list-sort-order
'sort-by-time
)
537 'newsticker--treeview-list-compare-item-by-time
)
538 ((eq newsticker--treeview-list-sort-order
539 'sort-by-time-reverse
)
540 'newsticker--treeview-list-compare-item-by-time-reverse
)
541 ((eq newsticker--treeview-list-sort-order
'sort-by-title
)
542 'newsticker--treeview-list-compare-item-by-title
)
543 ((eq newsticker--treeview-list-sort-order
544 'sort-by-title-reverse
)
545 'newsticker--treeview-list-compare-item-by-title-reverse
)
547 'newsticker--treeview-list-compare-item-by-title
))))
548 (sort (copy-sequence items
) sort-fun
)))
550 (defun newsticker--treeview-list-update-faces ()
551 "Update faces in the treeview list buffer."
553 (with-current-buffer (newsticker--treeview-list-buffer)
555 (let ((inhibit-read-only t
))
556 (goto-char (point-min))
558 (let* ((pos (point-at-eol))
559 (item (get-text-property (point) :nt-item
))
560 (age (newsticker--age item
))
561 (selected (get-text-property (point) :nt-selected
))
562 (face (cond ((eq age
'new
)
563 'newsticker-treeview-new-face
)
565 'newsticker-treeview-old-face
)
567 'newsticker-treeview-immortal-face
)
569 'newsticker-treeview-obsolete-face
)
572 (put-text-property (point) pos
'face face
)
574 (move-overlay newsticker--selection-overlay
(point)
575 (1+ pos
) ;include newline
577 (if selected
(setq pos-sel
(point)))
579 (beginning-of-line)))))) ;; FIXME!?
581 (if (window-live-p (newsticker--treeview-list-window))
582 (set-window-point (newsticker--treeview-list-window) pos-sel
)))))
584 (defun newsticker--treeview-list-clear-highlight ()
585 "Clear the highlight in the treeview list buffer."
586 (with-current-buffer (newsticker--treeview-list-buffer)
587 (let ((inhibit-read-only t
))
588 (put-text-property (point-min) (point-max) :nt-selected nil
))
589 (newsticker--treeview-list-update-faces)))
591 (defun newsticker--treeview-list-update-highlight ()
592 "Update the highlight in the treeview list buffer."
593 (newsticker--treeview-list-clear-highlight)
594 (with-current-buffer (newsticker--treeview-list-buffer)
595 (let ((inhibit-read-only t
))
596 (put-text-property (point-at-bol) (point-at-eol) :nt-selected t
))
597 (newsticker--treeview-list-update-faces)))
599 (defun newsticker--treeview-list-highlight-start ()
600 "Return position of selection in treeview list buffer."
601 (with-current-buffer (newsticker--treeview-list-buffer)
603 (goto-char (point-min))
604 (next-single-property-change (point) :nt-selected
))))
606 (defun newsticker--treeview-list-update (clear-buffer)
607 "Update the faces and highlight in the treeview list buffer.
608 If CLEAR-BUFFER is non-nil the list buffer is completely erased."
610 (if (window-live-p (newsticker--treeview-list-window))
611 (set-window-buffer (newsticker--treeview-list-window)
612 (newsticker--treeview-list-buffer)))
613 (set-buffer (newsticker--treeview-list-buffer))
615 (let ((inhibit-read-only t
))
617 (newsticker-treeview-list-mode)
618 (newsticker--treeview-list-update-faces)
619 (goto-char (point-min))))
621 (defvar newsticker-treeview-list-sort-button-map
622 (let ((map (make-sparse-keymap)))
623 (define-key map
[header-line mouse-1
]
624 'newsticker--treeview-list-sort-by-column
)
625 (define-key map
[header-line mouse-2
]
626 'newsticker--treeview-list-sort-by-column
)
628 "Local keymap for newsticker treeview list window sort buttons.")
630 (defun newsticker--treeview-list-sort-by-column (&optional event
)
631 "Sort the newsticker list window buffer by the column clicked on.
632 Optional argument EVENT is the mouse event that triggered this action."
633 (interactive (list last-input-event
))
634 (if event
(mouse-select-window event
))
635 (let* ((pos (event-start event
))
636 (obj (posn-object pos
))
638 (get-text-property (cdr obj
) 'sort-order
(car obj
))
639 (get-text-property (posn-point pos
) 'sort-order
))))
640 (setq newsticker--treeview-list-sort-order
641 (cond ((eq sort-order
'sort-by-age
)
642 (if (eq newsticker--treeview-list-sort-order
'sort-by-age
)
645 ((eq sort-order
'sort-by-time
)
646 (if (eq newsticker--treeview-list-sort-order
'sort-by-time
)
647 'sort-by-time-reverse
649 ((eq sort-order
'sort-by-title
)
650 (if (eq newsticker--treeview-list-sort-order
'sort-by-title
)
651 'sort-by-title-reverse
653 (newsticker-treeview-update)))
655 (defun newsticker-treeview-list-make-sort-button (name sort-order
)
656 "Create propertized string for headerline button.
657 NAME is the button text, SORT-ORDER is the associated sort order
659 (let ((face (if (string-match (symbol-name sort-order
)
661 newsticker--treeview-list-sort-order
))
665 'sort-order sort-order
666 'help-echo
(concat "Sort by " name
)
667 'mouse-face
'highlight
669 'keymap newsticker-treeview-list-sort-button-map
)))
671 (defun newsticker--treeview-list-select (item)
672 "Select ITEM in treeview's list buffer."
673 (newsticker--treeview-list-clear-highlight)
675 (set-buffer (newsticker--treeview-list-buffer))
676 (goto-char (point-min))
679 (let ((it (get-text-property (point) :nt-item
)))
681 (newsticker--treeview-list-update-highlight)
682 (newsticker--treeview-list-update-faces)
683 (newsticker--treeview-item-show
684 item
(get-text-property (point) :nt-feed
))
688 (goto-char (point-min))
689 (throw 'found nil
))))))
691 ;; ======================================================================
693 ;; ======================================================================
694 (defun newsticker--treeview-item-show-text (title description
)
695 "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
696 (with-current-buffer (newsticker--treeview-item-buffer)
697 (when (fboundp 'w3m-process-stop
)
698 (w3m-process-stop (current-buffer)))
699 (let ((inhibit-read-only t
))
701 (kill-all-local-variables)
704 (put-text-property (point-min) (point) 'face
'newsticker-feed-face
)
705 (insert "\n\n" description
)
706 (when newsticker-justification
707 (fill-region (point-min) (point-max) newsticker-justification
))
708 (newsticker-treeview-item-mode)
709 (goto-char (point-min)))))
711 (defun newsticker--treeview-item-show (item feed-name-symbol
)
712 "Show news ITEM coming from FEED-NAME-SYMBOL in treeview item buffer."
713 (setq newsticker--treeview-current-feed
(symbol-name feed-name-symbol
))
714 (with-current-buffer (newsticker--treeview-item-buffer)
715 (when (fboundp 'w3m-process-stop
)
716 (w3m-process-stop (current-buffer)))
717 (let ((inhibit-read-only t
)
718 (is-rendered-HTML nil
)
720 (marker1 (make-marker))
721 (marker2 (make-marker)))
723 (kill-all-local-variables)
726 (when (and item feed-name-symbol
)
727 (let ((wwidth (1- (if (window-live-p (newsticker--treeview-item-window))
728 (window-width (newsticker--treeview-item-window))
730 (if newsticker-use-full-width
731 (set (make-local-variable 'fill-column
) wwidth
))
732 (set (make-local-variable 'fill-column
) (min fill-column
734 (let ((desc (newsticker--desc item
)))
735 (insert "\n" (or desc
"[No Description]")))
736 (set-marker marker1
(1+ (point-min)))
737 (set-marker marker2
(point-max))
738 (setq is-rendered-HTML
(newsticker--treeview-render-text marker1
740 (when (and newsticker-justification
741 (not is-rendered-HTML
))
742 (fill-region marker1 marker2 newsticker-justification
))
744 (newsticker-treeview-item-mode)
745 (goto-char (point-min))
746 ;; insert logo at top
747 (let* ((newsticker-enable-logo-manipulations nil
)
748 (img (newsticker--image-read feed-name-symbol nil
40)))
749 (if (and (display-images-p) img
)
750 (newsticker--insert-image img
(car item
))
751 (insert (newsticker--real-feed-name feed-name-symbol
))))
752 (add-text-properties (point-min) (point)
753 (list 'face
'newsticker-feed-face
754 'mouse-face
'highlight
755 'help-echo
"Visit in web browser."
756 :nt-link
(newsticker--link item
)
757 'keymap newsticker--treeview-url-keymap
))
763 (insert (newsticker--title item
) "\n")
764 (set-marker marker1 pos
)
765 (set-marker marker2
(point))
766 (newsticker--treeview-render-text marker1 marker2
)
767 (put-text-property pos
(point) 'face
'newsticker-treeview-new-face
)
771 (put-text-property marker2
(point) 'face
'newsticker-treeview-face
)
772 (set-marker marker2
(point))
773 (when newsticker-justification
774 (fill-region marker1 marker2 newsticker-justification
))
776 (add-text-properties marker1
(1- (point))
777 (list 'mouse-face
'highlight
778 'help-echo
"Visit in web browser."
779 :nt-link
(newsticker--link item
)
780 'keymap newsticker--treeview-url-keymap
))
781 (insert (format-time-string newsticker-date-format
782 (newsticker--time item
)))
786 ;; insert enclosures and rest at bottom
787 (goto-char (point-max))
790 (newsticker--insert-enclosure item newsticker--treeview-url-keymap
)
791 (put-text-property pos
(point) 'face
'newsticker-enclosure-face
)
794 (set-marker marker1 pos
)
795 (newsticker--print-extra-elements item newsticker--treeview-url-keymap t
)
796 (set-marker marker2
(point))
797 (newsticker--treeview-render-text marker1 marker2
)
798 (put-text-property marker1 marker2
'face
'newsticker-extra-face
)
799 (goto-char (point-min)))))
800 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
802 (memq (newsticker--age item
) '(new obsolete
)))
803 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil
))
804 (newsticker-treeview-mark-item-old t
)
805 (newsticker--treeview-list-update-faces)))
806 (if (window-live-p (newsticker--treeview-item-window))
807 (set-window-point (newsticker--treeview-item-window) 1)))
809 (defun newsticker--treeview-item-update ()
810 "Update the treeview item buffer and window."
812 (if (window-live-p (newsticker--treeview-item-window))
813 (set-window-buffer (newsticker--treeview-item-window)
814 (newsticker--treeview-item-buffer)))
815 (set-buffer (newsticker--treeview-item-buffer))
816 (let ((inhibit-read-only t
))
818 (newsticker-treeview-item-mode)))
820 ;; ======================================================================
822 ;; ======================================================================
823 (defun newsticker--treeview-tree-expand (tree)
825 Callback function for tree widget that adds nodes for feeds and subgroups."
826 (tree-widget-set-theme "folder")
827 (let ((group (widget-get tree
:nt-group
))
831 (setq nt-id
(newsticker--treeview-get-id tree i
))
834 (let* ((g-name (car g
)))
836 :tag
,(newsticker--treeview-tree-get-tag g-name nil nt-id
)
837 :expander newsticker--treeview-tree-expand
838 :expander-p
(lambda (&rest ignore
) t
)
842 :leaf-icon newsticker--tree-widget-leaf-icon
843 :keep
(:nt-feed
:num-new
:nt-id
:open
);; :nt-group
845 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id
)))
847 :leaf-icon newsticker--tree-widget-leaf-icon
849 :action newsticker--treeview-list-feed-items
855 (defun newsticker--tree-widget-icon-create (icon)
856 "Create the ICON widget."
857 (let* ((g (widget-get (widget-get icon
:node
) :nt-feed
))
858 (ico (and g
(newsticker--icon-read (intern g
)))))
861 (widget-put icon
:tag-glyph ico
)
862 (widget-default-create icon
)
863 ;; Insert space between the icon and the node widget.
867 'display
(list 'space
:width tree-widget-space-width
)))
868 ;; fallback: default icon
869 (widget-put icon
:leaf-icon
'tree-widget-leaf-icon
)
870 (tree-widget-icon-create icon
))))
872 (defun newsticker--treeview-tree-expand-status (tree &optional _changed-widget
874 "Expand the vfeed TREE.
875 Optional arguments CHANGED-WIDGET and EVENT are ignored."
876 (tree-widget-set-theme "folder")
877 (list `(item :tag
,(newsticker--treeview-tree-get-tag nil
"new")
879 :action newsticker--treeview-list-new-items
880 :nt-id
,(newsticker--treeview-get-id tree
0)
882 `(item :tag
,(newsticker--treeview-tree-get-tag nil
"immortal")
884 :action newsticker--treeview-list-immortal-items
885 :nt-id
,(newsticker--treeview-get-id tree
1)
887 `(item :tag
,(newsticker--treeview-tree-get-tag nil
"obsolete")
889 :action newsticker--treeview-list-obsolete-items
890 :nt-id
,(newsticker--treeview-get-id tree
2)
892 `(item :tag
,(newsticker--treeview-tree-get-tag nil
"all")
894 :action newsticker--treeview-list-all-items
895 :nt-id
,(newsticker--treeview-get-id tree
3)
898 (defun newsticker--treeview-virtual-feed-p (feed-name)
899 "Return non-nil if FEED-NAME is a virtual feed."
900 (string-match "\\*.*\\*" feed-name
))
902 (define-widget 'newsticker--tree-widget-leaf-icon
'tree-widget-icon
903 "Icon for a tree-widget leaf node."
906 :create
'newsticker--tree-widget-icon-create
907 :button-face
'default
)
909 (defun newsticker--treeview-tree-update ()
910 "Update treeview tree buffer and window."
912 (if (window-live-p (newsticker--treeview-tree-window))
913 (set-window-buffer (newsticker--treeview-tree-window)
914 (newsticker--treeview-tree-buffer)))
915 (set-buffer (newsticker--treeview-tree-buffer))
916 (kill-all-local-variables)
917 (let ((inhibit-read-only t
))
919 (tree-widget-set-theme "folder")
920 (setq newsticker--treeview-feed-tree
921 (widget-create 'tree-widget
922 :tag
(newsticker--treeview-propertize-tag
924 :expander
'newsticker--treeview-tree-expand
925 :expander-p
(lambda (&rest _
) t
)
926 :leaf-icon
'newsticker--tree-widget-leaf-icon
927 :nt-group
(cdr newsticker-groups
)
931 (setq newsticker--treeview-vfeed-tree
932 (widget-create 'tree-widget
933 :tag
(newsticker--treeview-propertize-tag
934 "Virtual Feeds" 0 "vfeeds")
935 :expander
'newsticker--treeview-tree-expand-status
936 :expander-p
(lambda (&rest _
) t
)
937 :leaf-icon
'newsticker--tree-widget-leaf-icon
941 (use-local-map widget-keymap
)
943 (newsticker-treeview-mode)))
945 (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
947 "Return propertized copy of string TAG.
948 Optional argument NUM-NEW is used for choosing face, other
949 arguments NT-ID, FEED, and VFEED are added as properties."
950 ;;(message "newsticker--treeview-propertize-tag `%s' %s" feed nt-id)
951 (let ((face 'newsticker-treeview-face
)
952 (map (make-sparse-keymap)))
953 (if (and num-new
(> num-new
0))
954 (setq face
'newsticker-treeview-new-face
))
955 (dolist (key '([mouse-1
] [mouse-3
]))
956 (define-key map key
'newsticker-treeview-tree-click
))
957 (define-key map
"\n" 'newsticker-treeview-tree-do-click
)
958 (define-key map
"\C-m" 'newsticker-treeview-tree-do-click
)
959 (propertize tag
'face face
'keymap map
964 'mouse-face
'highlight
)))
966 (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
968 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
969 Optional argument NT-ID is added to the tag's properties."
970 (let (tag (num-new 0))
972 (cond ((string= vfeed-name
"new")
973 (setq num-new
(newsticker--stat-num-items-total 'new
))
974 (setq tag
(format "New items (%d)" num-new
)))
975 ((string= vfeed-name
"immortal")
976 (setq num-new
(newsticker--stat-num-items-total 'immortal
))
977 (setq tag
(format "Immortal items (%d)" num-new
)))
978 ((string= vfeed-name
"obsolete")
979 (setq num-new
(newsticker--stat-num-items-total 'obsolete
))
980 (setq tag
(format "Obsolete items (%d)" num-new
)))
981 ((string= vfeed-name
"all")
982 (setq num-new
(newsticker--stat-num-items-total))
983 (setq tag
(format "All items (%d)" num-new
)))))
985 (setq num-new
(newsticker--stat-num-items-for-group
986 (intern feed-name
) 'new
'immortal
))
989 (newsticker--real-feed-name (intern feed-name
))
992 (newsticker--treeview-propertize-tag tag num-new
994 feed-name vfeed-name
))))
996 (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages
)
997 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
998 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
999 (let ((result (apply #'newsticker--stat-num-items feed-name-symbol ages
)))
1001 (setq result
(+ result
1002 (apply #'newsticker--stat-num-items
(intern f-n
)
1004 (newsticker--group-get-feeds
1005 (newsticker--group-get-group (symbol-name feed-name-symbol
)) t
))
1008 (defun newsticker--treeview-count-node-items (feed &optional isvirtual
)
1009 "Count number of relevant items for a treeview node.
1010 FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
1011 the feed is a virtual feed."
1015 (cond ((string= feed
"new")
1016 (setq num-new
(newsticker--stat-num-items-total 'new
)))
1017 ((string= feed
"immortal")
1018 (setq num-new
(newsticker--stat-num-items-total 'immortal
)))
1019 ((string= feed
"obsolete")
1020 (setq num-new
(newsticker--stat-num-items-total 'obsolete
)))
1021 ((string= feed
"all")
1022 (setq num-new
(newsticker--stat-num-items-total))))
1023 (setq num-new
(newsticker--stat-num-items-for-group
1024 (intern feed
) 'new
'immortal
))))
1027 (defun newsticker--treeview-tree-update-tag (w &optional recursive
1029 "Update tag for tree widget W.
1030 If RECURSIVE is non-nil recursively update parent widgets as
1031 well. Argument IGNORE is ignored. Note that this function, if
1032 called recursively, makes w invalid. You should keep w's nt-id in
1034 (let* ((parent (widget-get w
:parent
))
1035 (feed (or (widget-get w
:nt-feed
) (widget-get parent
:nt-feed
)))
1036 (vfeed (or (widget-get w
:nt-vfeed
) (widget-get parent
:nt-vfeed
)))
1037 (nt-id (or (widget-get w
:nt-id
) (widget-get parent
:nt-id
)))
1038 (num-new (newsticker--treeview-count-node-items (or feed vfeed
)
1040 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id
))
1041 (n (widget-get w
:node
)))
1044 (newsticker--treeview-tree-update-tag parent
)))
1047 (widget-put n
:tag tag
))
1048 (widget-put w
:num-new num-new
)
1049 (widget-put w
:tag tag
)
1050 (when (marker-position (widget-get w
:from
))
1052 ;; FIXME: This moves point!!!!
1053 (with-current-buffer (newsticker--treeview-tree-buffer)
1054 (widget-value-set w
(widget-value w
)))
1057 (defun newsticker--treeview-tree-do-update-tags (widget)
1058 "Actually recursively update tags for WIDGET."
1060 (let ((children (widget-get widget
:children
)))
1061 (dolist (w children
)
1062 (newsticker--treeview-tree-do-update-tags w
))
1063 (newsticker--treeview-tree-update-tag widget
))))
1065 (defun newsticker--treeview-tree-update-tags (&rest _ignore
)
1066 "Update all tags of all trees.
1067 Arguments are ignored."
1068 (save-current-buffer
1069 (set-buffer (newsticker--treeview-tree-buffer))
1070 (let ((inhibit-read-only t
))
1071 (newsticker--treeview-tree-do-update-tags
1072 newsticker--treeview-feed-tree
)
1073 (newsticker--treeview-tree-do-update-tags
1074 newsticker--treeview-vfeed-tree
))
1075 (tree-widget-set-theme "folder")))
1077 (defun newsticker--treeview-tree-update-highlight ()
1078 "Update highlight in tree buffer."
1079 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from
)))
1080 (unless (or (integerp pos
) (and (markerp pos
) (marker-position pos
)))
1081 (setq pos
(widget-get (widget-get
1082 (newsticker--treeview-get-current-node)
1084 (when (or (integerp pos
) (and (markerp pos
) (marker-position pos
)))
1085 (with-current-buffer (newsticker--treeview-tree-buffer)
1087 (move-overlay newsticker--tree-selection-overlay
1088 (point-at-bol) (1+ (point-at-eol))
1090 (if (window-live-p (newsticker--treeview-tree-window))
1091 (set-window-point (newsticker--treeview-tree-window) pos
)))))
1093 ;; ======================================================================
1095 ;; ======================================================================
1096 (defvar newsticker-treeview-tool-bar-map
1097 (if (featurep 'xemacs
)
1099 (if (boundp 'tool-bar-map
)
1100 (let ((tool-bar-map (make-sparse-keymap)))
1101 (tool-bar-add-item "newsticker/prev-feed"
1102 'newsticker-treeview-prev-feed
1103 'newsticker-treeview-prev-feed
1104 :help
"Go to previous feed"
1105 ;;:enable '(newsticker-previous-feed-available-p) FIXME
1107 (tool-bar-add-item "newsticker/prev-item"
1108 'newsticker-treeview-prev-item
1109 'newsticker-treeview-prev-item
1110 :help
"Go to previous item"
1111 ;;:enable '(newsticker-previous-item-available-p) FIXME
1113 (tool-bar-add-item "newsticker/next-item"
1114 'newsticker-treeview-next-item
1115 'newsticker-treeview-next-item
1117 :help
"Go to next item"
1118 ;;:enable '(newsticker-next-item-available-p) FIXME
1120 (tool-bar-add-item "newsticker/next-feed"
1121 'newsticker-treeview-next-feed
1122 'newsticker-treeview-next-feed
1123 :help
"Go to next feed"
1124 ;;:enable '(newsticker-next-feed-available-p) FIXME
1126 (tool-bar-add-item "newsticker/mark-immortal"
1127 'newsticker-treeview-toggle-item-immortal
1128 'newsticker-treeview-toggle-item-immortal
1129 :help
"Toggle current item as immortal"
1130 ;;:enable '(newsticker-item-not-immortal-p) FIXME
1132 (tool-bar-add-item "newsticker/mark-read"
1133 'newsticker-treeview-mark-item-old
1134 'newsticker-treeview-mark-item-old
1135 :help
"Mark current item as read"
1136 ;;:enable '(newsticker-item-not-old-p) FIXME
1138 (tool-bar-add-item "newsticker/get-all"
1139 'newsticker-get-all-news
1140 'newsticker-get-all-news
1141 :help
"Get news for all feeds")
1142 (tool-bar-add-item "newsticker/update"
1143 'newsticker-treeview-update
1144 'newsticker-treeview-update
1145 :help
"Update newsticker buffer")
1146 (tool-bar-add-item "newsticker/browse-url"
1147 'newsticker-browse-url
1148 'newsticker-browse-url
1149 :help
"Browse URL for item at point")
1150 ;; standard icons / actions
1151 (define-key tool-bar-map
[newsticker-sep-1
]
1152 (list 'menu-item
"--double-line"))
1153 (tool-bar-add-item "close"
1154 'newsticker-treeview-quit
1155 'newsticker-treeview-quit
1156 :help
"Close newsticker")
1157 (tool-bar-add-item "preferences"
1158 'newsticker-customize
1159 'newsticker-customize
1160 :help
"Customize newsticker")
1163 ;; ======================================================================
1165 ;; ======================================================================
1167 (defun newsticker-treeview-mouse-browse-url (event)
1168 "Call `browse-url' for the link of the item at which the EVENT occurred."
1171 (switch-to-buffer (window-buffer (posn-window (event-end event
))))
1172 (let ((url (get-text-property (posn-point (event-end event
))
1176 (if newsticker-automatically-mark-visited-items-as-old
1177 (newsticker-treeview-mark-item-old))))))
1179 (defun newsticker-treeview-browse-url ()
1180 "Call `browse-url' for the link of the item at point."
1182 (with-current-buffer (newsticker--treeview-list-buffer)
1183 (let ((url (get-text-property (point) :nt-link
)))
1186 (if newsticker-automatically-mark-visited-items-as-old
1187 (newsticker-treeview-mark-item-old))))))
1189 (defun newsticker--treeview-buffer-init ()
1190 "Initialize all treeview buffers."
1191 (setq newsticker--treeview-buffers nil
)
1192 (add-to-list 'newsticker--treeview-buffers
1193 (get-buffer-create "*Newsticker Tree*") t
)
1194 (add-to-list 'newsticker--treeview-buffers
1195 (get-buffer-create "*Newsticker List*") t
)
1196 (add-to-list 'newsticker--treeview-buffers
1197 (get-buffer-create "*Newsticker Item*") t
)
1199 (unless newsticker--selection-overlay
1200 (with-current-buffer (newsticker--treeview-list-buffer)
1201 (setq buffer-undo-list t
)
1202 (setq newsticker--selection-overlay
(make-overlay (point-min)
1204 (overlay-put newsticker--selection-overlay
'face
1205 'newsticker-treeview-selection-face
)))
1206 (unless newsticker--tree-selection-overlay
1207 (with-current-buffer (newsticker--treeview-tree-buffer)
1208 (setq buffer-undo-list t
)
1209 (setq newsticker--tree-selection-overlay
(make-overlay (point-min)
1211 (overlay-put newsticker--tree-selection-overlay
'face
1212 'newsticker-treeview-selection-face
)))
1214 (newsticker--treeview-tree-update)
1215 (newsticker--treeview-list-update t
)
1216 (newsticker--treeview-item-update))
1218 (defun newsticker-treeview-update ()
1219 "Update all treeview buffers and windows.
1220 Note: does not update the layout."
1222 (let ((cur-item (newsticker--treeview-get-selected-item)))
1223 (if (newsticker--group-manage-orphan-feeds)
1224 (newsticker--treeview-tree-update))
1225 (newsticker--treeview-list-update t
)
1226 (newsticker--treeview-item-update)
1227 (newsticker--treeview-tree-update-tags)
1228 (cond (newsticker--treeview-current-feed
1229 (newsticker--treeview-list-items newsticker--treeview-current-feed
))
1230 (newsticker--treeview-current-vfeed
1231 (newsticker--treeview-list-items-with-age
1232 (intern newsticker--treeview-current-vfeed
))))
1233 (newsticker--treeview-tree-update-highlight)
1234 (newsticker--treeview-list-update-highlight)
1235 (let ((cur-feed (or newsticker--treeview-current-feed
1236 newsticker--treeview-current-vfeed
)))
1237 (if (and cur-feed cur-item
)
1238 (newsticker--treeview-list-select cur-item
)))))
1240 (defun newsticker-treeview-quit ()
1241 "Quit newsticker treeview."
1243 (setq newsticker--sentinel-callback nil
)
1244 (bury-buffer "*Newsticker Tree*")
1245 (bury-buffer "*Newsticker List*")
1246 (bury-buffer "*Newsticker Item*")
1247 (set-window-configuration newsticker--saved-window-config
)
1248 (when newsticker--frame
1249 (if (frame-live-p newsticker--frame
)
1250 (delete-frame newsticker--frame
))
1251 (setq newsticker--frame nil
))
1252 (newsticker-treeview-save))
1254 (defun newsticker-treeview-save ()
1255 "Save treeview group settings."
1257 (let ((coding-system-for-write 'utf-8
)
1258 (buf (find-file-noselect (concat newsticker-dir
"/groups"))))
1260 (with-current-buffer buf
1261 (setq buffer-undo-list t
)
1263 (insert ";; -*- coding: utf-8 -*-\n")
1264 (insert (prin1-to-string newsticker-groups
))
1268 (defun newsticker--treeview-load ()
1269 "Load treeview settings."
1270 (let* ((coding-system-for-read 'utf-8
)
1272 (or (and newsticker-groups-filename
1274 (expand-file-name newsticker-groups-filename
)
1275 (expand-file-name (concat newsticker-dir
"/groups"))))
1276 (file-exists-p newsticker-groups-filename
)
1279 (concat "Obsolete variable `newsticker-groups-filename' "
1280 "points to existing file \"%s\".\n"
1282 newsticker-groups-filename
))
1283 newsticker-groups-filename
)
1284 (concat newsticker-dir
"/groups")))
1285 (buf (and (file-exists-p filename
)
1286 (find-file-noselect filename
))))
1287 (and newsticker-groups-filename
1288 (file-exists-p newsticker-groups-filename
)
1289 (y-or-n-p (format-message
1290 (concat "Delete the file \"%s\",\nto which the obsolete "
1291 "variable `newsticker-groups-filename' points ? ")
1292 newsticker-groups-filename
))
1293 (delete-file newsticker-groups-filename
))
1296 (goto-char (point-min))
1298 (setq newsticker-groups
(read buf
))
1300 (message "Error while reading newsticker groups file!")
1301 (setq newsticker-groups nil
)))
1302 (kill-buffer buf
))))
1305 (defun newsticker-treeview-scroll-item ()
1306 "Scroll current item."
1308 (save-selected-window
1309 (select-window (newsticker--treeview-item-window) t
)
1312 (defun newsticker-treeview-show-item ()
1313 "Show current item."
1315 (newsticker--treeview-restore-layout)
1316 (newsticker--treeview-list-update-highlight)
1317 (with-current-buffer (newsticker--treeview-list-buffer)
1319 (let ((item (get-text-property (point) :nt-item
))
1320 (feed (get-text-property (point) :nt-feed
)))
1321 (newsticker--treeview-item-show item feed
)))
1322 (newsticker--treeview-tree-update-tag
1323 (newsticker--treeview-get-current-node) t
)
1324 (newsticker--treeview-tree-update-highlight))
1326 (defun newsticker-treeview-next-item ()
1327 "Move to next item."
1329 (newsticker--treeview-restore-layout)
1330 (save-current-buffer
1331 (set-buffer (newsticker--treeview-list-buffer))
1332 (if (newsticker--treeview-list-highlight-start)
1336 (newsticker-treeview-show-item))
1338 (defun newsticker-treeview-prev-item ()
1339 "Move to previous item."
1341 (newsticker--treeview-restore-layout)
1342 (save-current-buffer
1343 (set-buffer (newsticker--treeview-list-buffer))
1345 (newsticker-treeview-show-item))
1347 (defun newsticker-treeview-next-new-or-immortal-item (&optional
1350 "Move to next new or immortal item.
1351 Will move to next feed until an item is found. Will not move if
1352 optional argument CURRENT-ITEM-COUNTS is t and current item is
1353 new or immortal. Will not move from virtual to ordinary feed
1354 tree or vice versa if optional argument DONT-WRAP-TREES is non-nil."
1356 (newsticker--treeview-restore-layout)
1357 (newsticker--treeview-list-clear-highlight)
1358 (unless (catch 'found
1359 (let ((move (not current-item-counts
)))
1361 (save-current-buffer
1362 (set-buffer (newsticker--treeview-list-buffer))
1363 (when move
(forward-line 1)
1366 (throw 'found nil
))))
1367 (when (memq (newsticker--age
1368 (newsticker--treeview-get-selected-item))
1370 (newsticker-treeview-show-item)
1373 (let ((wrap-trees (not dont-wrap-trees
)))
1374 (when (or (newsticker-treeview-next-feed t
)
1375 (and wrap-trees
(newsticker--treeview-first-feed)))
1376 (newsticker-treeview-next-new-or-immortal-item t t
)))))
1378 (defun newsticker-treeview-prev-new-or-immortal-item ()
1379 "Move to previous new or immortal item.
1380 Will move to previous feed until an item is found."
1382 (newsticker--treeview-restore-layout)
1383 (newsticker--treeview-list-clear-highlight)
1384 (unless (catch 'found
1386 (save-current-buffer
1387 (set-buffer (newsticker--treeview-list-buffer))
1391 (when (memq (newsticker--age
1392 (newsticker--treeview-get-selected-item))
1394 (newsticker-treeview-show-item)
1397 (throw 'found nil
))))
1398 (when (newsticker-treeview-prev-feed t
)
1399 (set-buffer (newsticker--treeview-list-buffer))
1400 (goto-char (point-max))
1401 (newsticker-treeview-prev-new-or-immortal-item))))
1403 (defun newsticker--treeview-get-selected-item ()
1404 "Return item that is currently selected in list buffer."
1405 (with-current-buffer (newsticker--treeview-list-buffer)
1407 (get-text-property (point) :nt-item
)))
1409 (defun newsticker-treeview-mark-item-old (&optional dont-proceed
)
1410 "Mark current item as old unless it is obsolete.
1411 Move to next item unless DONT-PROCEED is non-nil."
1413 (let ((item (newsticker--treeview-get-selected-item)))
1414 (unless (eq (newsticker--age item
) 'obsolete
)
1415 (newsticker--treeview-mark-item item
'old
)))
1416 (unless dont-proceed
1417 (newsticker-treeview-next-item)))
1419 (defun newsticker-treeview-toggle-item-immortal ()
1420 "Toggle immortality of current item."
1422 (let* ((item (newsticker--treeview-get-selected-item))
1423 (new-age (if (eq (newsticker--age item
) 'immortal
)
1426 (newsticker--treeview-mark-item item new-age
)
1427 (newsticker-treeview-next-item)))
1429 (defun newsticker--treeview-mark-item (item new-age
)
1430 "Mark ITEM with NEW-AGE."
1432 (setcar (nthcdr 4 item
) new-age
)
1433 ;; clean up ticker FIXME
1435 (newsticker--cache-save-feed
1436 (newsticker--cache-get-feed (intern newsticker--treeview-current-feed
)))
1437 (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree
))
1439 (defun newsticker-treeview-mark-list-items-old ()
1440 "Mark all listed items as old."
1442 (let ((current-feed (or newsticker--treeview-current-feed
1443 newsticker--treeview-current-vfeed
)))
1444 (with-current-buffer (newsticker--treeview-list-buffer)
1445 (goto-char (point-min))
1447 (let ((item (get-text-property (point) :nt-item
)))
1448 (unless (memq (newsticker--age item
) '(immortal obsolete
))
1449 (newsticker--treeview-mark-item item
'old
)))
1451 (newsticker--treeview-tree-update-tags)
1453 (newsticker-treeview-jump current-feed
))))
1455 (defun newsticker-treeview-save-item ()
1456 "Save current item."
1458 (newsticker-save-item (or newsticker--treeview-current-feed
1459 newsticker--treeview-current-vfeed
)
1460 (newsticker--treeview-get-selected-item)))
1462 (defun newsticker-treeview-browse-url-item ()
1463 "Convert current item to HTML and call `browse-url' on result."
1465 (newsticker-browse-url-item (or newsticker--treeview-current-feed
1466 newsticker--treeview-current-vfeed
)
1467 (newsticker--treeview-get-selected-item)))
1469 (defun newsticker--treeview-set-current-node (node)
1470 "Make NODE the current node."
1471 (with-current-buffer (newsticker--treeview-tree-buffer)
1472 (setq newsticker--treeview-current-node-id
1473 (widget-get node
:nt-id
))
1474 (setq newsticker--treeview-current-feed
(widget-get node
:nt-feed
))
1475 (setq newsticker--treeview-current-vfeed
(widget-get node
:nt-vfeed
))
1476 (newsticker--treeview-tree-update-highlight)))
1478 (defun newsticker--treeview-get-first-child (node)
1479 "Get first child of NODE."
1480 (let ((children (widget-get node
:children
)))
1485 (defun newsticker--treeview-get-second-child (node)
1486 "Get scond child of NODE."
1487 (let ((children (widget-get node
:children
)))
1489 (car (cdr children
))
1492 (defun newsticker--treeview-get-last-child (node)
1493 "Get last child of NODE."
1494 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1495 (let ((children (widget-get node
:children
)))
1497 (car (reverse children
))
1500 (defun newsticker--treeview-get-feed-vfeed (node)
1501 "Get (virtual) feed of NODE."
1502 (or (widget-get node
:nt-feed
) (widget-get node
:nt-vfeed
)))
1504 (defun newsticker--treeview-get-next-sibling (node)
1505 "Get next sibling of NODE."
1506 (let ((parent (widget-get node
:parent
)))
1508 (let ((children (widget-get parent
:children
)))
1510 (if (newsticker--treeview-nodes-eq (car children
) node
)
1511 (throw 'found
(car (cdr children
))))
1512 (setq children
(cdr children
)))))))
1514 (defun newsticker--treeview-get-prev-sibling (node)
1515 "Get previous sibling of NODE."
1516 (let ((parent (widget-get node
:parent
)))
1518 (let ((children (widget-get parent
:children
))
1521 (if (and (newsticker--treeview-nodes-eq (car children
) node
)
1522 (widget-get prev
:nt-id
))
1523 (throw 'found prev
))
1524 (setq prev
(car children
))
1525 (setq children
(cdr children
)))))))
1527 (defun newsticker--treeview-get-next-uncle (node)
1528 "Get next uncle of NODE, i.e. parent's next sibling."
1529 (let* ((parent (widget-get node
:parent
))
1530 (grand-parent (widget-get parent
:parent
)))
1532 (let ((uncles (widget-get grand-parent
:children
)))
1534 (if (newsticker--treeview-nodes-eq (car uncles
) parent
)
1535 (throw 'found
(car (cdr uncles
))))
1536 (setq uncles
(cdr uncles
)))))))
1538 (defun newsticker--treeview-get-prev-uncle (node)
1539 "Get previous uncle of NODE, i.e. parent's previous sibling."
1540 (let* ((parent (widget-get node
:parent
))
1541 (grand-parent (widget-get parent
:parent
)))
1543 (let ((uncles (widget-get grand-parent
:children
))
1546 (if (newsticker--treeview-nodes-eq (car uncles
) parent
)
1547 (throw 'found prev
))
1548 (setq prev
(car uncles
))
1549 (setq uncles
(cdr uncles
)))))))
1551 (defun newsticker--treeview-get-other-tree ()
1553 (if (and (newsticker--treeview-get-current-node)
1554 (widget-get (newsticker--treeview-get-current-node) :nt-feed
))
1555 newsticker--treeview-vfeed-tree
1556 newsticker--treeview-feed-tree
))
1558 (defun newsticker--treeview-activate-node (node &optional backward
)
1560 If NODE is a tree widget the node's first subnode is activated.
1561 If BACKWARD is non-nil the last subnode of the previous sibling
1563 (newsticker--treeview-set-current-node node
)
1564 (save-current-buffer
1565 (set-buffer (newsticker--treeview-tree-buffer))
1566 (cond ((eq (widget-type node
) 'tree-widget
)
1567 (unless (widget-get node
:open
)
1568 (widget-put node
:open nil
)
1569 (widget-apply-action node
))
1570 (newsticker--treeview-activate-node
1572 (newsticker--treeview-get-last-child node
)
1573 (newsticker--treeview-get-second-child node
))))
1575 (widget-apply-action node
)))))
1577 (defun newsticker--treeview-first-feed ()
1578 "Jump to the depth-first feed in the `newsticker-groups' tree."
1579 (newsticker-treeview-jump
1580 (car (reverse (newsticker--group-get-feeds newsticker-groups t
)))))
1582 (defun newsticker-treeview-next-feed (&optional stay-in-tree
)
1584 Optional argument STAY-IN-TREE prevents moving from real feed
1585 tree to virtual feed tree or vice versa.
1586 Return t if a new feed was activated, nil otherwise."
1588 (newsticker--treeview-restore-layout)
1589 (let ((cur (newsticker--treeview-get-current-node))
1593 (or (newsticker--treeview-get-next-sibling cur
)
1594 (newsticker--treeview-get-next-uncle cur
)
1595 (and (not stay-in-tree
)
1596 (newsticker--treeview-get-other-tree)))
1597 (car (widget-get newsticker--treeview-feed-tree
:children
))))
1600 (newsticker--treeview-activate-node new
)
1601 (newsticker--treeview-tree-update-highlight)
1605 (defun newsticker-treeview-prev-feed (&optional stay-in-tree
)
1606 "Move to previous feed.
1607 Optional argument STAY-IN-TREE prevents moving from real feed
1608 tree to virtual feed tree or vice versa.
1609 Return t if a new feed was activated, nil otherwise."
1611 (newsticker--treeview-restore-layout)
1612 (let ((cur (newsticker--treeview-get-current-node))
1618 (or (newsticker--treeview-get-prev-sibling cur
)
1619 (newsticker--treeview-get-prev-uncle cur
)
1620 (and (not stay-in-tree
)
1621 (newsticker--treeview-get-other-tree)))
1622 (car (widget-get newsticker--treeview-feed-tree
:children
))))
1625 (newsticker--treeview-activate-node new t
)
1626 (newsticker--treeview-tree-update-highlight)
1631 (defun newsticker-treeview-next-page ()
1632 "Scroll item buffer."
1634 (save-selected-window
1635 (select-window (newsticker--treeview-item-window) t
)
1639 (goto-char (point-min))))))
1642 (defun newsticker--treeview-unfold-node (feed-name)
1643 "Recursively show subtree above the node that represents FEED-NAME."
1644 (let ((node (newsticker--treeview-get-node-of-feed feed-name
)))
1646 (let* ((group-name (car (newsticker--group-find-parent-group
1648 (newsticker--treeview-unfold-node group-name
))
1649 (setq node
(newsticker--treeview-get-node-of-feed feed-name
)))
1651 (with-current-buffer (newsticker--treeview-tree-buffer)
1652 (widget-put node
:nt-selected t
)
1653 (widget-apply-action node
)
1654 (newsticker--treeview-set-current-node node
)))))
1656 (defun newsticker-treeview-jump (feed-name)
1657 "Jump to feed FEED-NAME in newsticker treeview."
1659 (list (let ((completion-ignore-case t
))
1662 (append '("new" "obsolete" "immortal" "all")
1663 (mapcar #'car
(append newsticker-url-list
1664 newsticker-url-list-defaults
)))
1666 (newsticker--treeview-unfold-node feed-name
))
1668 ;; ======================================================================
1670 ;; ======================================================================
1671 (defun newsticker--group-do-find-group (feed-or-group-name parent-node node
)
1672 "Recursively find FEED-OR-GROUP-NAME in PARENT-NODE or NODE."
1673 (cond ((stringp node
)
1674 (when (string= feed-or-group-name node
)
1675 (throw 'found parent-node
)))
1677 (cond ((string= feed-or-group-name
(car node
))
1678 (throw 'found parent-node
))
1679 ((member feed-or-group-name
(cdr node
))
1680 (throw 'found node
))
1684 (newsticker--group-do-find-group
1685 feed-or-group-name node n
)))
1688 (defun newsticker--group-find-parent-group (feed-or-group-name)
1689 "Find group containing FEED-OR-GROUP-NAME."
1692 (newsticker--group-do-find-group feed-or-group-name
1698 (defun newsticker--group-do-get-group (name node
)
1699 "Recursively find group with NAME below NODE."
1700 (if (string= name
(car node
))
1704 (newsticker--group-do-get-group name n
)))
1707 (defun newsticker--group-get-group (name)
1708 "Find group with NAME."
1712 (newsticker--group-do-get-group name n
)))
1716 (defun newsticker--group-get-subgroups (group &optional recursive
)
1717 "Return list of subgroups for GROUP.
1718 If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1722 (setq result
(cons (car n
) result
))
1723 (let ((subgroups (newsticker--group-get-subgroups n recursive
)))
1725 (setq result
(append subgroups result
))))))
1729 (defun newsticker--group-all-groups ()
1730 "Return nested list of all groups."
1731 (newsticker--group-get-subgroups newsticker-groups t
))
1733 (defun newsticker--group-get-feeds (group &optional recursive
)
1734 "Return list of all feeds in GROUP.
1735 If RECURSIVE is non-nil recursively get feeds of subgroups and
1736 return a nested list."
1740 (setq result
(cons n result
))
1742 (let ((subfeeds (newsticker--group-get-feeds n t
)))
1744 (setq result
(append subfeeds result
)))))))
1748 (defun newsticker-group-add-group (name parent
)
1749 "Add group NAME to group PARENT."
1751 (list (read-string "Name of new group: ")
1752 (let ((completion-ignore-case t
))
1753 (completing-read "Name of parent group (optional): " (newsticker--group-all-groups)
1755 (if (newsticker--group-get-group name
)
1756 (error "Group %s exists already" name
))
1757 (let ((p (if (and parent
(not (string= parent
"")))
1758 (newsticker--group-get-group parent
)
1759 newsticker-groups
)))
1761 (error "Parent %s does not exist" parent
))
1762 (setcdr p
(cons (list name
) (cdr p
))))
1763 (newsticker--treeview-tree-update)
1764 (newsticker-treeview-jump newsticker--treeview-current-feed
))
1766 (defun newsticker-group-delete-group (name)
1767 "Delete group NAME."
1769 (list (let ((completion-ignore-case t
))
1770 (completing-read "Delete group: "
1771 (newsticker--group-names)
1772 nil t
(car (newsticker--group-find-parent-group
1773 newsticker--treeview-current-feed
))))))
1774 (let ((parent-group (newsticker--group-find-parent-group name
)))
1775 (unless parent-group
1776 (error "Parent %s does not exist" parent-group
))
1777 (setcdr parent-group
(cl-delete-if (lambda (g)
1779 (string= name
(car g
))))
1780 (cdr parent-group
)))
1781 (newsticker--group-manage-orphan-feeds)
1782 (newsticker--treeview-tree-update)
1783 (newsticker-treeview-update)
1784 (newsticker-treeview-jump newsticker--treeview-current-feed
)))
1786 (defun newsticker--group-do-rename-group (old-name new-name
)
1787 "Actually rename group OLD-NAME to NEW-NAME."
1788 (let ((parent-group (newsticker--group-find-parent-group old-name
)))
1789 (unless parent-group
1790 (error "Parent of %s does not exist" old-name
))
1791 (mapcar (lambda (elt)
1792 (cond ((and (listp elt
)
1793 (string= old-name
(car elt
)))
1794 (cons new-name
(cdr elt
)))
1799 (defun newsticker-group-rename-group (old-name new-name
)
1800 "Rename group OLD-NAME to NEW-NAME."
1802 (list (let* ((completion-ignore-case t
))
1803 (completing-read "Rename group: "
1804 (newsticker--group-names)
1805 nil t
(car (newsticker--group-find-parent-group
1806 newsticker--treeview-current-feed
))))
1807 (read-string "Rename to: ")))
1808 (setq newsticker-groups
(newsticker--group-do-rename-group old-name new-name
))
1809 (newsticker--group-manage-orphan-feeds)
1810 (newsticker--treeview-tree-update)
1811 (newsticker-treeview-update)
1812 (newsticker-treeview-jump newsticker--treeview-current-feed
))
1814 (defun newsticker--get-group-names (lst)
1815 "Do get the group names from LST."
1816 (delete nil
(cons (car lst
)
1820 (newsticker--get-group-names e
))
1825 (defun newsticker--group-names ()
1826 "Get names of all newsticker groups."
1827 (newsticker--get-group-names newsticker-groups
))
1829 (defun newsticker-group-move-feed (name group-name
&optional no-update
)
1830 "Move feed NAME to group GROUP-NAME.
1831 Update treeview afterwards unless NO-UPDATE is non-nil."
1833 (let ((completion-ignore-case t
))
1834 (list (completing-read "Name of feed or group to move: "
1835 (append (mapcar #'car newsticker-url-list
)
1836 (newsticker--group-names))
1837 nil t newsticker--treeview-current-feed
)
1838 (completing-read "Name of new parent group: " (newsticker--group-names)
1840 (let* ((group (if (and group-name
(not (string= group-name
"")))
1841 (newsticker--group-get-group group-name
)
1843 (moving-group-p (member name
(newsticker--group-names)))
1844 (moved-thing (if moving-group-p
1845 (newsticker--group-get-group name
)
1848 (error "Group %s does not exist" group-name
))
1849 (while (let ((old-group
1850 (newsticker--group-find-parent-group name
)))
1852 (delete moved-thing old-group
))
1854 (setcdr group
(cons moved-thing
(cdr group
)))
1856 (newsticker--treeview-tree-update)
1857 (newsticker-treeview-update)
1858 (newsticker-treeview-jump name
))))
1860 (defun newsticker-group-shift-feed-down ()
1861 "Shift current feed down in its group."
1863 (newsticker--group-shift 1))
1865 (defun newsticker-group-shift-feed-up ()
1866 "Shift current feed down in its group."
1868 (newsticker--group-shift -
1))
1870 (defun newsticker-group-shift-group-down ()
1871 "Shift current group down in its group."
1873 (newsticker--group-shift 1 t
))
1875 (defun newsticker-group-shift-group-up ()
1876 "Shift current group down in its group."
1878 (newsticker--group-shift -
1 t
))
1880 (defun newsticker--group-shift (delta &optional move-group
)
1881 "Shift current feed or group within its parent group.
1882 DELTA is an integer which specifies the direction and the amount
1883 of the shift. If MOVE-GROUP is nil the currently selected feed
1884 `newsticker--treeview-current-feed' is shifted, if it is t then
1885 the current feed's parent group is shifted.."
1886 (let* ((cur-feed newsticker--treeview-current-feed
)
1887 (thing (if move-group
1888 (newsticker--group-find-parent-group cur-feed
)
1890 (parent-group (newsticker--group-find-parent-group
1891 (if move-group
(car thing
) thing
))))
1892 (unless parent-group
1893 (error "Group not found!"))
1894 (let* ((siblings (cdr parent-group
))
1895 (pos (cl-position thing siblings
:test
'equal
))
1896 (tpos (+ pos delta
))
1897 (new-pos (max 0 (min (length siblings
) tpos
)))
1898 (beg (cl-subseq siblings
0 (min pos new-pos
)))
1899 (end (cl-subseq siblings
(+ 1 (max pos new-pos
))))
1900 (p (elt siblings new-pos
)))
1901 (when (not (= pos new-pos
))
1902 (setcdr parent-group
1903 (cl-concatenate 'list
1909 (newsticker--treeview-tree-update)
1910 (newsticker-treeview-update)
1911 (newsticker-treeview-jump cur-feed
)))))
1913 (defun newsticker--count-groups (group)
1914 "Recursively count number of subgroups of GROUP."
1918 (setq result
(+ result
(newsticker--count-groups g
)))))
1922 (defun newsticker--count-grouped-feeds (group)
1923 "Recursively count number of feeds in GROUP and its subgroups."
1927 (setq result
(+ result
(newsticker--count-grouped-feeds g
)))
1928 (setq result
(1+ result
))))
1932 (defun newsticker--group-remove-obsolete-feeds (group)
1933 "Recursively remove obsolete feeds from GROUP."
1935 (urls (append newsticker-url-list newsticker-url-list-defaults
)))
1939 (newsticker--group-remove-obsolete-feeds g
)))
1941 (setq result
(cons sub-groups result
))))
1943 (setq result
(cons g result
)))))
1946 (cons (car group
) (reverse result
))
1949 (defun newsticker--group-manage-orphan-feeds ()
1950 "Put unmanaged feeds into `newsticker-groups'.
1951 Remove obsolete feeds as well.
1952 Return t if groups have changed, nil otherwise."
1953 (unless newsticker-groups
1954 (setq newsticker-groups
'("Feeds")))
1955 (let ((new-feed nil
)
1956 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups
)))
1958 (unless (newsticker--group-find-parent-group (car f
))
1960 (newsticker-group-move-feed (car f
) nil t
)))
1961 (append newsticker-url-list-defaults newsticker-url-list
))
1962 (setq newsticker-groups
1963 (newsticker--group-remove-obsolete-feeds newsticker-groups
))
1965 (not (= grouped-feeds
1966 (newsticker--count-grouped-feeds newsticker-groups
))))))
1968 ;; ======================================================================
1970 ;; ======================================================================
1971 (defun newsticker--treeview-tree-open-menu (event)
1972 "Open tree menu at position of EVENT."
1973 (let* ((feed-name newsticker--treeview-current-feed
)
1974 (menu (make-sparse-keymap feed-name
)))
1975 (define-key menu
[newsticker-treeview-mark-list-items-old
]
1976 (list 'menu-item
"Mark all items old"
1977 'newsticker-treeview-mark-list-items-old
))
1978 (define-key menu
[newsticker-treeview-get-news
]
1979 (list 'menu-item
(concat "Get news for " feed-name
)
1980 'newsticker-treeview-get-news
))
1981 (define-key menu
[newsticker-get-all-news
]
1982 (list 'menu-item
"Get news for all feeds"
1983 'newsticker-get-all-news
))
1984 (let ((choice (x-popup-menu event menu
)))
1986 (funcall (car choice
))))))
1988 (defvar newsticker-treeview-list-menu
1989 (let ((menu (make-sparse-keymap "Newsticker List")))
1990 (define-key menu
[newsticker-treeview-mark-list-items-old
]
1991 (list 'menu-item
"Mark all items old"
1992 'newsticker-treeview-mark-list-items-old
))
1993 (define-key menu
[newsticker-treeview-mark-item-old
]
1994 (list 'menu-item
"Mark current item old"
1995 'newsticker-treeview-mark-item-old
))
1996 (define-key menu
[newsticker-treeview-toggle-item-immortal
]
1997 (list 'menu-item
"Mark current item immortal (toggle)"
1998 'newsticker-treeview-toggle-item-immortal
))
1999 (define-key menu
[newsticker-treeview-get-news
]
2000 (list 'menu-item
"Get news for current feed"
2001 'newsticker-treeview-get-news
))
2003 "Map for newsticker list menu.")
2005 (defvar newsticker-treeview-item-menu
2006 (let ((menu (make-sparse-keymap "Newsticker Item")))
2007 (define-key menu
[newsticker-treeview-mark-item-old
]
2008 (list 'menu-item
"Mark current item old"
2009 'newsticker-treeview-mark-item-old
))
2010 (define-key menu
[newsticker-treeview-toggle-item-immortal
]
2011 (list 'menu-item
"Mark current item immortal (toggle)"
2012 'newsticker-treeview-toggle-item-immortal
))
2013 (define-key menu
[newsticker-treeview-get-news
]
2014 (list 'menu-item
"Get news for current feed"
2015 'newsticker-treeview-get-news
))
2017 "Map for newsticker item menu.")
2019 (defvar newsticker-treeview-mode-map
2020 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map
)))
2021 (define-key map
" " 'newsticker-treeview-next-page
)
2022 (define-key map
"a" 'newsticker-add-url
)
2023 (define-key map
"b" 'newsticker-treeview-browse-url-item
)
2024 (define-key map
"F" 'newsticker-treeview-prev-feed
)
2025 (define-key map
"f" 'newsticker-treeview-next-feed
)
2026 (define-key map
"g" 'newsticker-treeview-get-news
)
2027 (define-key map
"G" 'newsticker-get-all-news
)
2028 (define-key map
"i" 'newsticker-treeview-toggle-item-immortal
)
2029 (define-key map
"j" 'newsticker-treeview-jump
)
2030 (define-key map
"n" 'newsticker-treeview-next-item
)
2031 (define-key map
"N" 'newsticker-treeview-next-new-or-immortal-item
)
2032 (define-key map
"O" 'newsticker-treeview-mark-list-items-old
)
2033 (define-key map
"o" 'newsticker-treeview-mark-item-old
)
2034 (define-key map
"p" 'newsticker-treeview-prev-item
)
2035 (define-key map
"P" 'newsticker-treeview-prev-new-or-immortal-item
)
2036 (define-key map
"q" 'newsticker-treeview-quit
)
2037 (define-key map
"S" 'newsticker-treeview-save-item
)
2038 (define-key map
"s" 'newsticker-treeview-save
)
2039 (define-key map
"u" 'newsticker-treeview-update
)
2040 (define-key map
"v" 'newsticker-treeview-browse-url
)
2041 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
2042 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
2043 (define-key map
"\M-m" 'newsticker-group-move-feed
)
2044 (define-key map
"\M-a" 'newsticker-group-add-group
)
2045 (define-key map
"\M-d" 'newsticker-group-delete-group
)
2046 (define-key map
"\M-r" 'newsticker-group-rename-group
)
2047 (define-key map
[M-down
] 'newsticker-group-shift-feed-down
)
2048 (define-key map
[M-up
] 'newsticker-group-shift-feed-up
)
2049 (define-key map
[M-S-down
] 'newsticker-group-shift-group-down
)
2050 (define-key map
[M-S-up
] 'newsticker-group-shift-group-up
)
2052 "Mode map for newsticker treeview.")
2054 (define-derived-mode newsticker-treeview-mode fundamental-mode
"Newsticker TV"
2055 "Major mode for Newsticker Treeview.
2056 \\{newsticker-treeview-mode-map}"
2057 (if (boundp 'tool-bar-map
)
2058 (set (make-local-variable 'tool-bar-map
)
2059 newsticker-treeview-tool-bar-map
))
2060 (setq buffer-read-only t
2063 (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
2065 (let ((header (concat
2066 (propertize " " 'display
'(space :align-to
0))
2067 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age
)
2068 (propertize " " 'display
'(space :align-to
2))
2069 (if newsticker--treeview-list-show-feed
2071 (propertize " " 'display
'(space :align-to
12)))
2073 (newsticker-treeview-list-make-sort-button "Date"
2075 (if newsticker--treeview-list-show-feed
2076 (propertize " " 'display
'(space :align-to
28))
2077 (propertize " " 'display
'(space :align-to
18)))
2078 (newsticker-treeview-list-make-sort-button "Title"
2080 (setq header-line-format header
))
2081 (define-key newsticker-treeview-list-mode-map
[down-mouse-3
]
2082 newsticker-treeview-list-menu
))
2084 (define-derived-mode newsticker-treeview-item-mode newsticker-treeview-mode
2086 (define-key newsticker-treeview-item-mode-map
[down-mouse-3
]
2087 newsticker-treeview-item-menu
))
2089 (defun newsticker-treeview-tree-click (event)
2090 "Handle click EVENT on a tag in the newsticker tree."
2092 (newsticker--treeview-restore-layout)
2094 (switch-to-buffer (window-buffer (posn-window (event-end event
))))
2095 (newsticker-treeview-tree-do-click (posn-point (event-end event
)) event
)))
2097 (defun newsticker-treeview-tree-do-click (&optional pos event
)
2098 "Actually handle click event.
2099 POS gives the position where EVENT occurred."
2101 (let* ((pos (or pos
(point)))
2102 (nt-id (get-text-property pos
:nt-id
))
2103 (item (get-text-property pos
:nt-item
)))
2105 ;; click in list buffer
2106 (newsticker-treeview-show-item))
2108 ;; click in tree buffer
2109 (let ((w (newsticker--treeview-get-node-by-id nt-id
)))
2111 (newsticker--treeview-tree-update-tag w t t
)
2112 (setq w
(newsticker--treeview-get-node-by-id nt-id
))
2113 (widget-put w
:nt-selected t
)
2114 (widget-apply w
:action event
)
2115 (newsticker--treeview-set-current-node w
)
2117 (eq 'mouse-3
(car event
))
2119 (newsticker--treeview-tree-open-menu event
)))))))
2120 (newsticker--treeview-tree-update-highlight))
2122 (defun newsticker--treeview-restore-layout ()
2123 "Restore treeview buffers."
2126 (let ((win (nth i newsticker--treeview-windows
))
2127 (buf (nth i newsticker--treeview-buffers
)))
2128 (unless (window-live-p win
)
2129 (newsticker--treeview-window-init)
2130 (newsticker--treeview-buffer-init)
2132 (unless (eq (window-buffer win
) buf
)
2133 (set-window-buffer win buf t
))))))
2135 (defun newsticker--treeview-frame-init ()
2136 "Initialize treeview frame."
2137 (when newsticker-treeview-own-frame
2138 (unless (and newsticker--frame
(frame-live-p newsticker--frame
))
2139 (setq newsticker--frame
(make-frame '((name .
"Newsticker")))))
2140 (select-frame-set-input-focus newsticker--frame
)
2141 (raise-frame newsticker--frame
)))
2143 (defun newsticker--treeview-window-init ()
2144 "Initialize treeview windows."
2145 (setq newsticker--saved-window-config
(current-window-configuration))
2146 (setq newsticker--treeview-windows nil
)
2147 (setq newsticker--treeview-buffers nil
)
2148 (delete-other-windows)
2149 (split-window-right newsticker-treeview-treewindow-width
)
2150 (add-to-list 'newsticker--treeview-windows
(selected-window) t
)
2152 (split-window-below newsticker-treeview-listwindow-height
)
2153 (add-to-list 'newsticker--treeview-windows
(selected-window) t
)
2155 (add-to-list 'newsticker--treeview-windows
(selected-window) t
)
2159 (defun newsticker-treeview ()
2160 "Start newsticker treeview."
2162 (newsticker--treeview-load)
2163 (setq newsticker--sentinel-callback
'newsticker-treeview-update
)
2164 (newsticker--treeview-frame-init)
2165 (newsticker--treeview-window-init)
2166 (newsticker--treeview-buffer-init)
2167 (if (newsticker--group-manage-orphan-feeds)
2168 (newsticker--treeview-tree-update))
2169 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree
)
2170 (newsticker-start t
) ;; will start only if not running
2171 (newsticker-treeview-update)
2172 (newsticker--treeview-item-show-text
2174 "Welcome to newsticker!"))
2176 (defun newsticker-treeview-get-news ()
2177 "Get news for current feed."
2179 (when newsticker--treeview-current-feed
2180 (newsticker-get-news newsticker--treeview-current-feed
)))
2182 (provide 'newst-treeview
)
2184 ;;; newst-treeview.el ends here