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
135 "~/.newsticker-groups"
136 "Name of the newsticker groups settings file."
138 :group
'newsticker-treeview
)
139 (make-obsolete-variable 'newsticker-groups-filename
'newsticker-dir
"23.1")
141 ;; ======================================================================
142 ;;; internal variables
143 ;; ======================================================================
144 (defvar newsticker--treeview-windows nil
)
145 (defvar newsticker--treeview-buffers nil
)
146 (defvar newsticker--treeview-current-feed nil
147 "Feed name of currently shown item.")
148 (defvar newsticker--treeview-current-vfeed nil
)
149 (defvar newsticker--treeview-list-show-feed nil
)
150 (defvar newsticker--saved-window-config nil
)
151 (defvar newsticker--selection-overlay nil
152 "Highlight the selected tree node.")
153 (defvar newsticker--tree-selection-overlay nil
154 "Highlight the selected list item.")
155 (defvar newsticker--frame nil
"Special frame for newsticker windows.")
156 (defvar newsticker--treeview-list-sort-order
'sort-by-time
)
157 (defvar newsticker--treeview-current-node-id nil
)
158 (defvar newsticker--treeview-current-tree nil
)
159 (defvar newsticker--treeview-feed-tree nil
)
160 (defvar newsticker--treeview-vfeed-tree nil
)
162 ;; maps for the clickable portions
163 (defvar newsticker--treeview-url-keymap
164 (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap
)))
165 (define-key map
[mouse-1
] 'newsticker-treeview-mouse-browse-url
)
166 (define-key map
[mouse-2
] 'newsticker-treeview-mouse-browse-url
)
167 (define-key map
"\n" 'newsticker-treeview-browse-url
)
168 (define-key map
"\C-m" 'newsticker-treeview-browse-url
)
169 (define-key map
[(control return
)] 'newsticker-handle-url
)
171 "Key map for click-able headings in the newsticker treeview buffers.")
174 ;; ======================================================================
176 ;; ======================================================================
177 (defsubst newsticker--treeview-tree-buffer
()
178 "Return the tree buffer of the newsticker treeview."
179 (nth 0 newsticker--treeview-buffers
))
180 (defsubst newsticker--treeview-list-buffer
()
181 "Return the list buffer of the newsticker treeview."
182 (nth 1 newsticker--treeview-buffers
))
183 (defsubst newsticker--treeview-item-buffer
()
184 "Return the item buffer of the newsticker treeview."
185 (nth 2 newsticker--treeview-buffers
))
186 (defsubst newsticker--treeview-tree-window
()
187 "Return the tree window of the newsticker treeview."
188 (nth 0 newsticker--treeview-windows
))
189 (defsubst newsticker--treeview-list-window
()
190 "Return the list window of the newsticker treeview."
191 (nth 1 newsticker--treeview-windows
))
192 (defsubst newsticker--treeview-item-window
()
193 "Return the item window of the newsticker treeview."
194 (nth 2 newsticker--treeview-windows
))
196 ;; ======================================================================
197 ;;; utility functions
198 ;; ======================================================================
199 (defun newsticker--treeview-get-id (parent i
)
200 "Create an id for a newsticker treeview node.
201 PARENT is the node's parent, I is an integer."
202 ;;(message "newsticker--treeview-get-id %s"
203 ;; (format "%s-%d" (widget-get parent :nt-id) i))
204 (format "%s-%d" (widget-get parent
:nt-id
) i
))
206 (defun newsticker--treeview-ids-eq (id1 id2
)
207 "Return non-nil if ids ID1 and ID2 are equal."
208 ;;(message "%s/%s" (or id1 -1) (or id2 -1))
209 (and id1 id2
(string= id1 id2
)))
211 (defun newsticker--treeview-nodes-eq (node1 node2
)
212 "Compare treeview nodes NODE1 and NODE2 for equality.
213 Nodes are equal if the have the same newsticker-id. Note that
214 during re-tagging and collapsing/expanding nodes change, while
215 their id stays constant."
216 (let ((id1 (widget-get node1
:nt-id
))
217 (id2 (widget-get node2
:nt-id
)))
218 ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
219 ;; (or id1 -1) (or id2 -1))
220 (or (newsticker--treeview-ids-eq id1 id2
)
221 (string= (widget-get node1
:tag
) (widget-get node2
:tag
)))))
223 (defun newsticker--treeview-do-get-node-of-feed (feed-name startnode
)
224 "Recursively search node for feed FEED-NAME starting from STARTNODE."
225 ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
226 (if (string= feed-name
(or (widget-get startnode
:nt-feed
)
227 (widget-get startnode
:nt-vfeed
)))
228 (throw 'found startnode
)
229 (let ((children (widget-get startnode
:children
)))
231 (newsticker--treeview-do-get-node-of-feed feed-name w
)))))
233 (defun newsticker--treeview-get-node-of-feed (feed-name)
234 "Return node for feed FEED-NAME in newsticker treeview tree."
236 (newsticker--treeview-do-get-node-of-feed feed-name
237 newsticker--treeview-feed-tree
)
238 (newsticker--treeview-do-get-node-of-feed feed-name
239 newsticker--treeview-vfeed-tree
)))
241 (defun newsticker--treeview-do-get-node-by-id (id startnode
)
242 "Recursively search node with ID starting from STARTNODE."
243 (if (newsticker--treeview-ids-eq id
(widget-get startnode
:nt-id
))
244 (throw 'found startnode
)
245 (let ((children (widget-get startnode
:children
)))
247 (newsticker--treeview-do-get-node-by-id id w
)))))
249 (defun newsticker--treeview-get-node-by-id (id)
250 "Return node with ID in newsticker treeview tree."
252 (newsticker--treeview-do-get-node-by-id id newsticker--treeview-feed-tree
)
253 (newsticker--treeview-do-get-node-by-id id newsticker--treeview-vfeed-tree
)))
255 (defun newsticker--treeview-get-current-node ()
256 "Return current node in newsticker treeview tree."
257 (newsticker--treeview-get-node-by-id newsticker--treeview-current-node-id
))
259 ;; ======================================================================
261 (unless (fboundp 'declare-function
) (defmacro declare-function
(&rest r
)))
262 (declare-function w3m-toggle-inline-images
"ext:w3m" (&optional force no-cache
))
264 (defun newsticker--treeview-render-text (start end
)
265 "Render text between markers START and END."
266 (if newsticker-html-renderer
267 (condition-case error-data
269 (set-marker-insertion-type end t
)
270 ;; check whether it is necessary to call html renderer
271 ;; (regexp inspired by htmlr.el)
273 (when (re-search-forward
274 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t
)
275 ;; (message "%s" (newsticker--title item))
276 (let ((w3m-fill-column (if newsticker-use-full-width
278 (w3-maximum-line-length
279 (if newsticker-use-full-width nil fill-column
)))
281 (funcall newsticker-html-renderer start end
)))
282 ;;(cond ((eq newsticker-html-renderer 'w3m-region)
283 ;; (add-text-properties start end (list 'keymap
284 ;; w3m-minor-mode-map)))
285 ;;((eq newsticker-html-renderer 'w3-region)
286 ;;(add-text-properties start end (list 'keymap w3-mode-map))))
287 (if (eq newsticker-html-renderer
'w3m-region
)
288 (w3m-toggle-inline-images t
))
291 (message "Error: HTML rendering failed: %s, %s"
292 (car error-data
) (cdr error-data
))
296 ;; ======================================================================
298 ;; ======================================================================
299 (defun newsticker--treeview-list-add-item (item feed
&optional show-feed
)
300 "Add news ITEM for FEED to newsticker treeview list window.
301 If string SHOW-FEED is non-nil it is shown in the item string."
302 (setq newsticker--treeview-list-show-feed show-feed
)
303 (with-current-buffer (newsticker--treeview-list-buffer)
304 (let* ((inhibit-read-only t
)
306 (goto-char (point-max))
307 (setq pos1
(point-marker))
309 (insert (propertize " " 'display
'(space :align-to
2)))
310 (insert (if show-feed
313 (format "%-10s" (newsticker--real-feed-name
316 (propertize " " 'display
'(space :align-to
12)))
318 (insert (format-time-string newsticker-treeview-date-format
319 (newsticker--time item
)))
320 (insert (propertize " " 'display
321 (list 'space
:align-to
(if show-feed
28 18))))
322 (setq pos2
(point-marker))
323 (insert (newsticker--title item
))
325 (newsticker--treeview-render-text pos2
(point-marker))
327 (while (search-forward "\n" nil t
)
329 (let ((map (make-sparse-keymap)))
330 (define-key map
[mouse-1
] 'newsticker-treeview-tree-click
)
331 (define-key map
"\n" 'newsticker-treeview-show-item
)
332 (define-key map
"\C-m" 'newsticker-treeview-show-item
)
333 (add-text-properties pos1
(point-max)
336 :nt-link
(newsticker--link item
)
337 'mouse-face
'highlight
339 'help-echo
(buffer-substring pos2
343 (defun newsticker--treeview-list-clear ()
344 "Clear the newsticker treeview list window."
345 (with-current-buffer (newsticker--treeview-list-buffer)
346 (let ((inhibit-read-only t
))
348 (kill-all-local-variables)
351 (defun newsticker--treeview-list-items-with-age-callback (widget
354 "Fill newsticker treeview list window with items of certain age.
355 This is a callback function for the treeview nodes.
356 Argument WIDGET is the calling treeview widget.
357 Argument CHANGED-WIDGET is the widget that actually has changed.
358 Optional argument AGES is the list of ages that are to be shown."
359 (newsticker--treeview-list-clear)
360 (widget-put widget
:nt-selected t
)
361 (apply 'newsticker--treeview-list-items-with-age ages
))
363 (defun newsticker--treeview-list-items-with-age (&rest ages
)
364 "Actually fill newsticker treeview list window with items of certain age.
365 AGES is the list of ages that are to be shown."
367 (let ((feed-name-symbol (intern (car feed
))))
369 (when (memq (newsticker--age item
) ages
)
370 (newsticker--treeview-list-add-item
371 item feed-name-symbol t
)))
372 (newsticker--treeview-list-sort-items
373 (cdr (newsticker--cache-get-feed feed-name-symbol
))))))
374 (append newsticker-url-list-defaults newsticker-url-list
))
375 (newsticker--treeview-list-update nil
))
377 (defun newsticker--treeview-list-new-items (widget changed-widget
379 "Fill newsticker treeview list window with new items.
380 This is a callback function for the treeview nodes.
381 Argument WIDGET is the calling treeview widget.
382 Argument CHANGED-WIDGET is the widget that actually has changed.
383 Optional argument EVENT is the mouse event that triggered this action."
384 (newsticker--treeview-list-items-with-age-callback widget changed-widget
386 (newsticker--treeview-item-show-text
388 "This is a virtual feed containing all new items"))
390 (defun newsticker--treeview-list-immortal-items (widget changed-widget
392 "Fill newsticker treeview list window with immortal items.
393 This is a callback function for the treeview nodes.
394 Argument WIDGET is the calling treeview widget.
395 Argument CHANGED-WIDGET is the widget that actually has changed.
396 Optional argument EVENT is the mouse event that triggered this action."
397 (newsticker--treeview-list-items-with-age-callback widget changed-widget
399 (newsticker--treeview-item-show-text
401 "This is a virtual feed containing all immortal items."))
403 (defun newsticker--treeview-list-obsolete-items (widget changed-widget
405 "Fill newsticker treeview list window with obsolete items.
406 This is a callback function for the treeview nodes.
407 Argument WIDGET is the calling treeview widget.
408 Argument CHANGED-WIDGET is the widget that actually has changed.
409 Optional argument EVENT is the mouse event that triggered this action."
410 (newsticker--treeview-list-items-with-age-callback widget changed-widget
412 (newsticker--treeview-item-show-text
414 "This is a virtual feed containing all obsolete items."))
416 (defun newsticker--treeview-list-all-items (widget changed-widget
418 "Fill newsticker treeview list window with all items.
419 This is a callback function for the treeview nodes.
420 Argument WIDGET is the calling treeview widget.
421 Argument CHANGED-WIDGET is the widget that actually has changed.
422 Optional argument EVENT is the mouse event that triggered this action."
423 (newsticker--treeview-list-items-with-age-callback widget changed-widget
426 (newsticker--treeview-item-show-text
428 "This is a virtual feed containing all items."))
430 (defun newsticker--treeview-list-items-v (vfeed-name)
431 "List items for virtual feed VFEED-NAME."
433 (cond ((string-match "\\*new\\*" vfeed-name
)
434 (newsticker--treeview-list-items-with-age 'new
))
435 ((string-match "\\*immortal\\*" vfeed-name
)
436 (newsticker--treeview-list-items-with-age 'immortal
))
437 ((string-match "\\*old\\*" vfeed-name
)
438 (newsticker--treeview-list-items-with-age 'old nil
)))
439 (newsticker--treeview-list-update nil
)
442 (defun newsticker--treeview-list-items (feed-name)
443 "List items for feed FEED-NAME."
445 (if (newsticker--treeview-virtual-feed-p feed-name
)
446 (newsticker--treeview-list-items-v feed-name
)
448 (if (eq (newsticker--age item
) 'feed
)
449 (newsticker--treeview-item-show item
(intern feed-name
))
450 (newsticker--treeview-list-add-item item
451 (intern feed-name
))))
452 (newsticker--treeview-list-sort-items
453 (cdr (newsticker--cache-get-feed (intern feed-name
)))))
454 (newsticker--treeview-list-update nil
))))
456 (defun newsticker--treeview-list-feed-items (widget changed-widget
458 "Callback function for listing feed items.
459 Argument WIDGET is the calling treeview widget.
460 Argument CHANGED-WIDGET is the widget that actually has changed.
461 Optional argument EVENT is the mouse event that triggered this action."
462 (newsticker--treeview-list-clear)
463 (widget-put widget
:nt-selected t
)
464 (let ((feed-name (widget-get widget
:nt-feed
))
465 (vfeed-name (widget-get widget
:nt-vfeed
)))
467 (newsticker--treeview-list-items feed-name
)
468 (newsticker--treeview-list-items-v vfeed-name
))))
470 (defun newsticker--treeview-list-compare-item-by-age (item1 item2
)
471 "Compare two news items ITEM1 and ITEM2 wrt age."
473 (let ((age1 (newsticker--age item1
))
474 (age2 (newsticker--age item2
)))
475 (cond ((eq age1
'new
)
478 (cond ((eq age2
'new
)
485 (cond ((eq age2
'new
)
496 (defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2
)
497 "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
498 (newsticker--treeview-list-compare-item-by-age item2 item1
))
500 (defun newsticker--treeview-list-compare-item-by-time (item1 item2
)
501 "Compare two news items ITEM1 and ITEM2 wrt time values."
502 (newsticker--cache-item-compare-by-time item1 item2
))
504 (defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2
)
505 "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
506 (newsticker--cache-item-compare-by-time item2 item1
))
508 (defun newsticker--treeview-list-compare-item-by-title (item1 item2
)
509 "Compare two news items ITEM1 and ITEM2 wrt title."
510 (newsticker--cache-item-compare-by-title item1 item2
))
512 (defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2
)
513 "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
514 (newsticker--cache-item-compare-by-title item2 item1
))
516 (defun newsticker--treeview-list-sort-items (items)
517 "Return sorted copy of list ITEMS.
518 The sort function is chosen according to the value of
519 `newsticker--treeview-list-sort-order'."
521 (cond ((eq newsticker--treeview-list-sort-order
'sort-by-age
)
522 'newsticker--treeview-list-compare-item-by-age
)
523 ((eq newsticker--treeview-list-sort-order
524 'sort-by-age-reverse
)
525 'newsticker--treeview-list-compare-item-by-age-reverse
)
526 ((eq newsticker--treeview-list-sort-order
'sort-by-time
)
527 'newsticker--treeview-list-compare-item-by-time
)
528 ((eq newsticker--treeview-list-sort-order
529 'sort-by-time-reverse
)
530 'newsticker--treeview-list-compare-item-by-time-reverse
)
531 ((eq newsticker--treeview-list-sort-order
'sort-by-title
)
532 'newsticker--treeview-list-compare-item-by-title
)
533 ((eq newsticker--treeview-list-sort-order
534 'sort-by-title-reverse
)
535 'newsticker--treeview-list-compare-item-by-title-reverse
)
537 'newsticker--treeview-list-compare-item-by-title
))))
538 (sort (copy-sequence items
) sort-fun
)))
540 (defun newsticker--treeview-list-update-faces ()
541 "Update faces in the treeview list buffer."
543 (with-current-buffer (newsticker--treeview-list-buffer)
545 (let ((inhibit-read-only t
))
546 (goto-char (point-min))
548 (let* ((pos (point-at-eol))
549 (item (get-text-property (point) :nt-item
))
550 (age (newsticker--age item
))
551 (selected (get-text-property (point) :nt-selected
))
552 (face (cond ((eq age
'new
)
553 'newsticker-treeview-new-face
)
555 'newsticker-treeview-old-face
)
557 'newsticker-treeview-immortal-face
)
559 'newsticker-treeview-obsolete-face
)
562 (put-text-property (point) pos
'face face
)
564 (move-overlay newsticker--selection-overlay
(point)
565 (1+ pos
) ;include newline
567 (if selected
(setq pos-sel
(point)))
569 (beginning-of-line)))))) ;; FIXME!?
571 (if (window-live-p (newsticker--treeview-list-window))
572 (set-window-point (newsticker--treeview-list-window) pos-sel
)))))
574 (defun newsticker--treeview-list-clear-highlight ()
575 "Clear the highlight in the treeview list buffer."
576 (with-current-buffer (newsticker--treeview-list-buffer)
577 (let ((inhibit-read-only t
))
578 (put-text-property (point-min) (point-max) :nt-selected nil
))
579 (newsticker--treeview-list-update-faces)))
581 (defun newsticker--treeview-list-update-highlight ()
582 "Update the highlight in the treeview list buffer."
583 (newsticker--treeview-list-clear-highlight)
585 (with-current-buffer (newsticker--treeview-list-buffer)
586 (let ((inhibit-read-only t
))
587 (put-text-property (point-at-bol) (point-at-eol) :nt-selected t
))
588 (newsticker--treeview-list-update-faces))))
590 (defun newsticker--treeview-list-highlight-start ()
591 "Return position of selection in treeview list buffer."
592 (with-current-buffer (newsticker--treeview-list-buffer)
594 (goto-char (point-min))
595 (next-single-property-change (point) :nt-selected
))))
597 (defun newsticker--treeview-list-update (clear-buffer)
598 "Update the faces and highlight in the treeview list buffer.
599 If CLEAR-BUFFER is non-nil the list buffer is completely erased."
601 (if (window-live-p (newsticker--treeview-list-window))
602 (set-window-buffer (newsticker--treeview-list-window)
603 (newsticker--treeview-list-buffer)))
604 (set-buffer (newsticker--treeview-list-buffer))
606 (let ((inhibit-read-only t
))
608 (newsticker-treeview-list-mode)
609 (newsticker--treeview-list-update-faces)
610 (goto-char (point-min))))
612 (defvar newsticker-treeview-list-sort-button-map
613 (let ((map (make-sparse-keymap)))
614 (define-key map
[header-line mouse-1
]
615 'newsticker--treeview-list-sort-by-column
)
616 (define-key map
[header-line mouse-2
]
617 'newsticker--treeview-list-sort-by-column
)
619 "Local keymap for newsticker treeview list window sort buttons.")
621 (defun newsticker--treeview-list-sort-by-column (&optional event
)
622 "Sort the newsticker list window buffer by the column clicked on.
623 Optional argument EVENT is the mouse event that triggered this action."
624 (interactive (list last-input-event
))
625 (if event
(mouse-select-window event
))
626 (let* ((pos (event-start event
))
627 (obj (posn-object pos
))
629 (get-text-property (cdr obj
) 'sort-order
(car obj
))
630 (get-text-property (posn-point pos
) 'sort-order
))))
631 (setq newsticker--treeview-list-sort-order
632 (cond ((eq sort-order
'sort-by-age
)
633 (if (eq newsticker--treeview-list-sort-order
'sort-by-age
)
636 ((eq sort-order
'sort-by-time
)
637 (if (eq newsticker--treeview-list-sort-order
'sort-by-time
)
638 'sort-by-time-reverse
640 ((eq sort-order
'sort-by-title
)
641 (if (eq newsticker--treeview-list-sort-order
'sort-by-title
)
642 'sort-by-title-reverse
644 (newsticker-treeview-update)))
646 (defun newsticker-treeview-list-make-sort-button (name sort-order
)
647 "Create propertized string for headerline button.
648 NAME is the button text, SORT-ORDER is the associated sort order
650 (let ((face (if (string-match (symbol-name sort-order
)
652 newsticker--treeview-list-sort-order
))
656 'sort-order sort-order
657 'help-echo
(concat "Sort by " name
)
658 'mouse-face
'highlight
660 'keymap newsticker-treeview-list-sort-button-map
)))
662 (defun newsticker--treeview-list-select (item)
663 "Select ITEM in treeview's list buffer."
664 (newsticker--treeview-list-clear-highlight)
667 (set-buffer (newsticker--treeview-list-buffer))
668 (goto-char (point-min))
671 (let ((it (get-text-property (point) :nt-item
)))
673 (newsticker--treeview-list-update-highlight)
674 (newsticker--treeview-list-update-faces)
675 (newsticker--treeview-item-show
676 item
(get-text-property (point) :nt-feed
))
680 (goto-char (point-min))
681 (throw 'found nil
)))))))
683 ;; ======================================================================
685 ;; ======================================================================
686 (defun newsticker--treeview-item-show-text (title description
)
687 "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
688 (with-current-buffer (newsticker--treeview-item-buffer)
689 (when (fboundp 'w3m-process-stop
)
690 (w3m-process-stop (current-buffer)))
691 (let ((inhibit-read-only t
))
693 (kill-all-local-variables)
696 (put-text-property (point-min) (point) 'face
'newsticker-feed-face
)
697 (insert "\n\n" description
)
698 (when newsticker-justification
699 (fill-region (point-min) (point-max) newsticker-justification
))
700 (newsticker-treeview-item-mode)
701 (goto-char (point-min)))))
703 (defun newsticker--treeview-item-show (item feed-name-symbol
)
704 "Show news ITEM coming from FEED-NAME-SYMBOL in treeview item buffer."
705 (setq newsticker--treeview-current-feed
(symbol-name feed-name-symbol
))
706 (with-current-buffer (newsticker--treeview-item-buffer)
707 (when (fboundp 'w3m-process-stop
)
708 (w3m-process-stop (current-buffer)))
709 (let ((inhibit-read-only t
)
710 (is-rendered-HTML nil
)
712 (marker1 (make-marker))
713 (marker2 (make-marker)))
715 (kill-all-local-variables)
718 (when (and item feed-name-symbol
)
719 (let ((wwidth (1- (window-width (newsticker--treeview-item-window)))))
720 (if newsticker-use-full-width
721 (set (make-local-variable 'fill-column
) wwidth
))
722 (set (make-local-variable 'fill-column
) (min fill-column
724 (let ((desc (newsticker--desc item
)))
725 (insert "\n" (or desc
"[No Description]")))
726 (set-marker marker1
(1+ (point-min)))
727 (set-marker marker2
(point-max))
728 (setq is-rendered-HTML
(newsticker--treeview-render-text marker1
730 (when (and newsticker-justification
731 (not is-rendered-HTML
))
732 (fill-region marker1 marker2 newsticker-justification
))
734 (newsticker-treeview-item-mode)
735 (goto-char (point-min))
736 ;; insert logo at top
737 (let* ((newsticker-enable-logo-manipulations nil
)
738 (img (newsticker--image-read feed-name-symbol nil
40)))
739 (if (and (display-images-p) img
)
740 (newsticker--insert-image img
(car item
))
741 (insert (newsticker--real-feed-name feed-name-symbol
))))
742 (add-text-properties (point-min) (point)
743 (list 'face
'newsticker-feed-face
744 'mouse-face
'highlight
745 'help-echo
"Visit in web browser."
746 :nt-link
(newsticker--link item
)
747 'keymap newsticker--treeview-url-keymap
))
753 (insert (newsticker--title item
) "\n")
754 (set-marker marker1 pos
)
755 (set-marker marker2
(point))
756 (newsticker--treeview-render-text marker1 marker2
)
757 (put-text-property pos
(point) 'face
'newsticker-treeview-new-face
)
761 (put-text-property marker2
(point) 'face
'newsticker-treeview-face
)
762 (set-marker marker2
(point))
763 (when newsticker-justification
764 (fill-region marker1 marker2 newsticker-justification
))
766 (add-text-properties marker1
(1- (point))
767 (list 'mouse-face
'highlight
768 'help-echo
"Visit in web browser."
769 :nt-link
(newsticker--link item
)
770 'keymap newsticker--treeview-url-keymap
))
771 (insert (format-time-string newsticker-date-format
772 (newsticker--time item
)))
776 ;; insert enclosures and rest at bottom
777 (goto-char (point-max))
780 (newsticker--insert-enclosure item newsticker--treeview-url-keymap
)
781 (put-text-property pos
(point) 'face
'newsticker-enclosure-face
)
784 (set-marker marker1 pos
)
785 (newsticker--print-extra-elements item newsticker--treeview-url-keymap t
)
786 (set-marker marker2
(point))
787 (newsticker--treeview-render-text marker1 marker2
)
788 (put-text-property marker1 marker2
'face
'newsticker-extra-face
)
789 (goto-char (point-min)))))
790 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
792 (memq (newsticker--age item
) '(new obsolete
)))
793 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil
))
794 (newsticker-treeview-mark-item-old t
)
795 (newsticker--treeview-list-update-faces)))
796 (if (window-live-p (newsticker--treeview-item-window))
797 (set-window-point (newsticker--treeview-item-window) 1)))
799 (defun newsticker--treeview-item-update ()
800 "Update the treeview item buffer and window."
802 (if (window-live-p (newsticker--treeview-item-window))
803 (set-window-buffer (newsticker--treeview-item-window)
804 (newsticker--treeview-item-buffer)))
805 (set-buffer (newsticker--treeview-item-buffer))
806 (let ((inhibit-read-only t
))
808 (newsticker-treeview-item-mode)))
810 ;; ======================================================================
812 ;; ======================================================================
813 (defun newsticker--treeview-tree-expand (tree)
815 Callback function for tree widget that adds nodes for feeds and subgroups."
816 (tree-widget-set-theme "folder")
817 (let ((group (widget-get tree
:nt-group
))
821 (setq nt-id
(newsticker--treeview-get-id tree i
))
824 (let* ((g-name (car g
)))
826 :tag
,(newsticker--treeview-tree-get-tag g-name nil nt-id
)
827 :expander newsticker--treeview-tree-expand
828 :expander-p
(lambda (&rest ignore
) t
)
832 :leaf-icon newsticker--tree-widget-leaf-icon
833 :keep
(:nt-feed
:num-new
:nt-id
:open
);; :nt-group
835 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id
)))
837 :leaf-icon newsticker--tree-widget-leaf-icon
839 :action newsticker--treeview-list-feed-items
845 (defun newsticker--tree-widget-icon-create (icon)
846 "Create the ICON widget."
847 (let* ((g (widget-get (widget-get icon
:node
) :nt-feed
))
848 (ico (and g
(newsticker--icon-read (intern g
)))))
851 (widget-put icon
:tag-glyph ico
)
852 (widget-default-create icon
)
853 ;; Insert space between the icon and the node widget.
857 'display
(list 'space
:width tree-widget-space-width
)))
858 ;; fallback: default icon
859 (widget-put icon
:leaf-icon
'tree-widget-leaf-icon
)
860 (tree-widget-icon-create icon
))))
862 (defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
864 "Expand the vfeed TREE.
865 Optional arguments CHANGED-WIDGET and EVENT are ignored."
866 (tree-widget-set-theme "folder")
867 (list `(item :tag
,(newsticker--treeview-tree-get-tag nil
"new")
869 :action newsticker--treeview-list-new-items
870 :nt-id
,(newsticker--treeview-get-id tree
0)
872 `(item :tag
,(newsticker--treeview-tree-get-tag nil
"immortal")
874 :action newsticker--treeview-list-immortal-items
875 :nt-id
,(newsticker--treeview-get-id tree
1)
877 `(item :tag
,(newsticker--treeview-tree-get-tag nil
"obsolete")
879 :action newsticker--treeview-list-obsolete-items
880 :nt-id
,(newsticker--treeview-get-id tree
2)
882 `(item :tag
,(newsticker--treeview-tree-get-tag nil
"all")
884 :action newsticker--treeview-list-all-items
885 :nt-id
,(newsticker--treeview-get-id tree
3)
888 (defun newsticker--treeview-virtual-feed-p (feed-name)
889 "Return non-nil if FEED-NAME is a virtual feed."
890 (string-match "\\*.*\\*" feed-name
))
892 (define-widget 'newsticker--tree-widget-leaf-icon
'tree-widget-icon
893 "Icon for a tree-widget leaf node."
896 :create
'newsticker--tree-widget-icon-create
897 :button-face
'default
)
899 (defun newsticker--treeview-tree-update ()
900 "Update treeview tree buffer and window."
902 (if (window-live-p (newsticker--treeview-tree-window))
903 (set-window-buffer (newsticker--treeview-tree-window)
904 (newsticker--treeview-tree-buffer)))
905 (set-buffer (newsticker--treeview-tree-buffer))
906 (kill-all-local-variables)
907 (let ((inhibit-read-only t
))
909 (tree-widget-set-theme "folder")
910 (setq newsticker--treeview-feed-tree
911 (widget-create 'tree-widget
912 :tag
(newsticker--treeview-propertize-tag
914 :expander
'newsticker--treeview-tree-expand
915 :expander-p
(lambda (&rest ignore
) t
)
916 :leaf-icon
'newsticker--tree-widget-leaf-icon
917 :nt-group
(cdr newsticker-groups
)
921 (setq newsticker--treeview-vfeed-tree
922 (widget-create 'tree-widget
923 :tag
(newsticker--treeview-propertize-tag
924 "Virtual Feeds" 0 "vfeeds")
925 :expander
'newsticker--treeview-tree-expand-status
926 :expander-p
(lambda (&rest ignore
) t
)
927 :leaf-icon
'newsticker--tree-widget-leaf-icon
931 (use-local-map widget-keymap
)
933 (newsticker-treeview-mode)))
935 (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
937 "Return propertized copy of string TAG.
938 Optional argument NUM-NEW is used for choosing face, other
939 arguments NT-ID, FEED, and VFEED are added as properties."
940 ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
941 (let ((face 'newsticker-treeview-face
)
942 (map (make-sparse-keymap)))
943 (if (and num-new
(> num-new
0))
944 (setq face
'newsticker-treeview-new-face
))
945 (define-key map
[mouse-1
] 'newsticker-treeview-tree-click
)
946 (define-key map
"\n" 'newsticker-treeview-tree-do-click
)
947 (define-key map
"\C-m" 'newsticker-treeview-tree-do-click
)
948 (propertize tag
'face face
'keymap map
953 'mouse-face
'highlight
)))
955 (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
957 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
958 Optional argument NT-ID is added to the tag's properties."
959 (let (tag (num-new 0))
961 (cond ((string= vfeed-name
"new")
962 (setq num-new
(newsticker--stat-num-items-total 'new
))
963 (setq tag
(format "New items (%d)" num-new
)))
964 ((string= vfeed-name
"immortal")
965 (setq num-new
(newsticker--stat-num-items-total 'immortal
))
966 (setq tag
(format "Immortal items (%d)" num-new
)))
967 ((string= vfeed-name
"obsolete")
968 (setq num-new
(newsticker--stat-num-items-total 'obsolete
))
969 (setq tag
(format "Obsolete items (%d)" num-new
)))
970 ((string= vfeed-name
"all")
971 (setq num-new
(newsticker--stat-num-items-total))
972 (setq tag
(format "All items (%d)" num-new
)))))
974 (setq num-new
(newsticker--stat-num-items-for-group
975 (intern feed-name
) 'new
'immortal
))
978 (newsticker--real-feed-name (intern feed-name
))
981 (newsticker--treeview-propertize-tag tag num-new
983 feed-name vfeed-name
))))
985 (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages
)
986 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
987 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
988 (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages
)))
990 (setq result
(+ result
991 (apply 'newsticker--stat-num-items
(intern f-n
)
993 (newsticker--group-get-feeds
994 (newsticker--group-get-group (symbol-name feed-name-symbol
)) t
))
997 (defun newsticker--treeview-count-node-items (feed &optional isvirtual
)
998 "Count number of relevant items for a treeview node.
999 FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
1000 the feed is a virtual feed."
1004 (cond ((string= feed
"new")
1005 (setq num-new
(newsticker--stat-num-items-total 'new
)))
1006 ((string= feed
"immortal")
1007 (setq num-new
(newsticker--stat-num-items-total 'immortal
)))
1008 ((string= feed
"obsolete")
1009 (setq num-new
(newsticker--stat-num-items-total 'obsolete
)))
1010 ((string= feed
"all")
1011 (setq num-new
(newsticker--stat-num-items-total))))
1012 (setq num-new
(newsticker--stat-num-items-for-group
1013 (intern feed
) 'new
'immortal
))))
1016 (defun newsticker--treeview-tree-update-tag (w &optional recursive
1018 "Update tag for tree widget W.
1019 If RECURSIVE is non-nil recursively update parent widgets as
1020 well. Argument IGNORE is ignored. Note that this function, if
1021 called recursively, makes w invalid. You should keep w's nt-id in
1023 (let* ((parent (widget-get w
:parent
))
1024 (feed (or (widget-get w
:nt-feed
) (widget-get parent
:nt-feed
)))
1025 (vfeed (or (widget-get w
:nt-vfeed
) (widget-get parent
:nt-vfeed
)))
1026 (nt-id (or (widget-get w
:nt-id
) (widget-get parent
:nt-id
)))
1027 (num-new (newsticker--treeview-count-node-items (or feed vfeed
)
1029 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id
))
1030 (n (widget-get w
:node
)))
1033 (newsticker--treeview-tree-update-tag parent
)))
1036 (widget-put n
:tag tag
))
1037 (widget-put w
:num-new num-new
)
1038 (widget-put w
:tag tag
)
1039 (when (marker-position (widget-get w
:from
))
1041 (notify (widget-get w
:notify
)))
1042 ;; FIXME: This moves point!!!!
1043 (with-current-buffer (newsticker--treeview-tree-buffer)
1044 (widget-value-set w
(widget-value w
)))
1047 (defun newsticker--treeview-tree-do-update-tags (widget)
1048 "Actually recursively update tags for WIDGET."
1050 (let ((children (widget-get widget
:children
)))
1051 (dolist (w children
)
1052 (newsticker--treeview-tree-do-update-tags w
))
1053 (newsticker--treeview-tree-update-tag widget
))))
1055 (defun newsticker--treeview-tree-update-tags (&rest ignore
)
1056 "Update all tags of all trees.
1057 Arguments IGNORE are ignored."
1058 (save-current-buffer
1059 (set-buffer (newsticker--treeview-tree-buffer))
1060 (let ((inhibit-read-only t
))
1061 (newsticker--treeview-tree-do-update-tags
1062 newsticker--treeview-feed-tree
)
1063 (newsticker--treeview-tree-do-update-tags
1064 newsticker--treeview-vfeed-tree
))
1065 (tree-widget-set-theme "folder")))
1067 (defun newsticker--treeview-tree-update-highlight ()
1068 "Update highlight in tree buffer."
1069 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from
)))
1070 (unless (or (integerp pos
) (and (markerp pos
) (marker-position pos
)))
1071 (setq pos
(widget-get (widget-get
1072 (newsticker--treeview-get-current-node)
1074 (when (or (integerp pos
) (and (markerp pos
) (marker-position pos
)))
1075 (with-current-buffer (newsticker--treeview-tree-buffer)
1077 (move-overlay newsticker--tree-selection-overlay
1078 (point-at-bol) (1+ (point-at-eol))
1080 (if (window-live-p (newsticker--treeview-tree-window))
1081 (set-window-point (newsticker--treeview-tree-window) pos
)))))
1083 ;; ======================================================================
1085 ;; ======================================================================
1086 (defvar newsticker-treeview-tool-bar-map
1087 (if (featurep 'xemacs
)
1089 (if (boundp 'tool-bar-map
)
1090 (let ((tool-bar-map (make-sparse-keymap)))
1091 (tool-bar-add-item "newsticker/prev-feed"
1092 'newsticker-treeview-prev-feed
1093 'newsticker-treeview-prev-feed
1094 :help
"Go to previous feed"
1095 ;;:enable '(newsticker-previous-feed-available-p) FIXME
1097 (tool-bar-add-item "newsticker/prev-item"
1098 'newsticker-treeview-prev-item
1099 'newsticker-treeview-prev-item
1100 :help
"Go to previous item"
1101 ;;:enable '(newsticker-previous-item-available-p) FIXME
1103 (tool-bar-add-item "newsticker/next-item"
1104 'newsticker-treeview-next-item
1105 'newsticker-treeview-next-item
1107 :help
"Go to next item"
1108 ;;:enable '(newsticker-next-item-available-p) FIXME
1110 (tool-bar-add-item "newsticker/next-feed"
1111 'newsticker-treeview-next-feed
1112 'newsticker-treeview-next-feed
1113 :help
"Go to next feed"
1114 ;;:enable '(newsticker-next-feed-available-p) FIXME
1116 (tool-bar-add-item "newsticker/mark-immortal"
1117 'newsticker-treeview-toggle-item-immortal
1118 'newsticker-treeview-toggle-item-immortal
1119 :help
"Toggle current item as immortal"
1120 ;;:enable '(newsticker-item-not-immortal-p) FIXME
1122 (tool-bar-add-item "newsticker/mark-read"
1123 'newsticker-treeview-mark-item-old
1124 'newsticker-treeview-mark-item-old
1125 :help
"Mark current item as read"
1126 ;;:enable '(newsticker-item-not-old-p) FIXME
1128 (tool-bar-add-item "newsticker/get-all"
1129 'newsticker-get-all-news
1130 'newsticker-get-all-news
1131 :help
"Get news for all feeds")
1132 (tool-bar-add-item "newsticker/update"
1133 'newsticker-treeview-update
1134 'newsticker-treeview-update
1135 :help
"Update newsticker buffer")
1136 (tool-bar-add-item "newsticker/browse-url"
1137 'newsticker-browse-url
1138 'newsticker-browse-url
1139 :help
"Browse URL for item at point")
1140 ;; standard icons / actions
1141 (define-key tool-bar-map
[newsticker-sep-1
]
1142 (list 'menu-item
"--double-line"))
1143 (tool-bar-add-item "close"
1144 'newsticker-treeview-quit
1145 'newsticker-treeview-quit
1146 :help
"Close newsticker")
1147 (tool-bar-add-item "preferences"
1148 'newsticker-customize
1149 'newsticker-customize
1150 :help
"Customize newsticker")
1153 ;; ======================================================================
1155 ;; ======================================================================
1157 (defun newsticker-treeview-mouse-browse-url (event)
1158 "Call `browse-url' for the link of the item at which the EVENT occurred."
1161 (switch-to-buffer (window-buffer (posn-window (event-end event
))))
1162 (let ((url (get-text-property (posn-point (event-end event
))
1166 (if newsticker-automatically-mark-visited-items-as-old
1167 (newsticker-treeview-mark-item-old))))))
1169 (defun newsticker-treeview-browse-url ()
1170 "Call `browse-url' for the link of the item at point."
1172 (with-current-buffer (newsticker--treeview-list-buffer)
1173 (let ((url (get-text-property (point) :nt-link
)))
1176 (if newsticker-automatically-mark-visited-items-as-old
1177 (newsticker-treeview-mark-item-old))))))
1179 (defun newsticker--treeview-buffer-init ()
1180 "Initialize all treeview buffers."
1181 (setq newsticker--treeview-buffers nil
)
1182 (add-to-list 'newsticker--treeview-buffers
1183 (get-buffer-create "*Newsticker Tree*") t
)
1184 (add-to-list 'newsticker--treeview-buffers
1185 (get-buffer-create "*Newsticker List*") t
)
1186 (add-to-list 'newsticker--treeview-buffers
1187 (get-buffer-create "*Newsticker Item*") t
)
1189 (unless newsticker--selection-overlay
1190 (with-current-buffer (newsticker--treeview-list-buffer)
1191 (setq buffer-undo-list t
)
1192 (setq newsticker--selection-overlay
(make-overlay (point-min)
1194 (overlay-put newsticker--selection-overlay
'face
1195 'newsticker-treeview-selection-face
)))
1196 (unless newsticker--tree-selection-overlay
1197 (with-current-buffer (newsticker--treeview-tree-buffer)
1198 (setq buffer-undo-list t
)
1199 (setq newsticker--tree-selection-overlay
(make-overlay (point-min)
1201 (overlay-put newsticker--tree-selection-overlay
'face
1202 'newsticker-treeview-selection-face
)))
1204 (newsticker--treeview-tree-update)
1205 (newsticker--treeview-list-update t
)
1206 (newsticker--treeview-item-update))
1208 (defun newsticker-treeview-update ()
1209 "Update all treeview buffers and windows.
1210 Note: does not update the layout."
1212 (let ((cur-item (newsticker--treeview-get-selected-item)))
1213 (if (newsticker--group-manage-orphan-feeds)
1214 (newsticker--treeview-tree-update))
1215 (newsticker--treeview-list-update t
)
1216 (newsticker--treeview-item-update)
1217 (newsticker--treeview-tree-update-tags)
1218 (cond (newsticker--treeview-current-feed
1219 (newsticker--treeview-list-items newsticker--treeview-current-feed
))
1220 (newsticker--treeview-current-vfeed
1221 (newsticker--treeview-list-items-with-age
1222 (intern newsticker--treeview-current-vfeed
))))
1223 (newsticker--treeview-tree-update-highlight)
1224 (newsticker--treeview-list-update-highlight)
1225 (let ((cur-feed (or newsticker--treeview-current-feed
1226 newsticker--treeview-current-vfeed
)))
1227 (if (and cur-feed cur-item
)
1228 (newsticker--treeview-list-select cur-item
)))))
1230 (defun newsticker-treeview-quit ()
1231 "Quit newsticker treeview."
1233 (setq newsticker--sentinel-callback nil
)
1234 (bury-buffer "*Newsticker Tree*")
1235 (bury-buffer "*Newsticker List*")
1236 (bury-buffer "*Newsticker Item*")
1237 (set-window-configuration newsticker--saved-window-config
)
1238 (when newsticker--frame
1239 (if (frame-live-p newsticker--frame
)
1240 (delete-frame newsticker--frame
))
1241 (setq newsticker--frame nil
))
1242 (newsticker-treeview-save))
1244 (defun newsticker-treeview-save ()
1245 "Save treeview group settings."
1247 (let ((coding-system-for-write 'utf-8
)
1248 (buf (find-file-noselect (concat newsticker-dir
"/groups"))))
1250 (with-current-buffer buf
1251 (setq buffer-undo-list t
)
1253 (insert ";; -*- coding: utf-8 -*-\n")
1254 (insert (prin1-to-string newsticker-groups
))
1258 (defun newsticker--treeview-load ()
1259 "Load treeview settings."
1260 (let* ((coding-system-for-read 'utf-8
)
1262 (or (and (file-exists-p newsticker-groups-filename
)
1264 (format "Old newsticker groups (%s) file exists. Read it? "
1265 newsticker-groups-filename
))
1266 newsticker-groups-filename
)
1267 (concat newsticker-dir
"/groups")))
1268 (buf (and (file-exists-p filename
)
1269 (find-file-noselect filename
))))
1270 (and (file-exists-p newsticker-groups-filename
)
1271 (y-or-n-p (format "Delete old newsticker groups file? "))
1272 (delete-file newsticker-groups-filename
))
1275 (goto-char (point-min))
1277 (setq newsticker-groups
(read buf
))
1279 (message "Error while reading newsticker groups file!")
1280 (setq newsticker-groups nil
)))
1281 (kill-buffer buf
))))
1284 (defun newsticker-treeview-scroll-item ()
1285 "Scroll current item."
1287 (save-selected-window
1288 (select-window (newsticker--treeview-item-window) t
)
1291 (defun newsticker-treeview-show-item ()
1292 "Show current item."
1294 (newsticker--treeview-restore-layout)
1295 (newsticker--treeview-list-update-highlight)
1296 (with-current-buffer (newsticker--treeview-list-buffer)
1298 (let ((item (get-text-property (point) :nt-item
))
1299 (feed (get-text-property (point) :nt-feed
)))
1300 (newsticker--treeview-item-show item feed
)))
1301 (newsticker--treeview-tree-update-tag
1302 (newsticker--treeview-get-current-node) t
)
1303 (newsticker--treeview-tree-update-highlight))
1305 (defun newsticker-treeview-next-item ()
1306 "Move to next item."
1308 (newsticker--treeview-restore-layout)
1309 (save-current-buffer
1310 (set-buffer (newsticker--treeview-list-buffer))
1311 (if (newsticker--treeview-list-highlight-start)
1315 (newsticker-treeview-show-item))
1317 (defun newsticker-treeview-prev-item ()
1318 "Move to previous item."
1320 (newsticker--treeview-restore-layout)
1321 (save-current-buffer
1322 (set-buffer (newsticker--treeview-list-buffer))
1324 (newsticker-treeview-show-item))
1326 (defun newsticker-treeview-next-new-or-immortal-item (&optional
1329 "Move to next new or immortal item.
1330 Will move to next feed until an item is found. Will not move if
1331 optional argument CURRENT-ITEM-COUNTS is t and current item is
1332 new or immortal. Will not move from virtual to ordinary feed
1333 tree or vice versa if optional argument DONT-WRAP-TREES is non-nil."
1335 (newsticker--treeview-restore-layout)
1336 (newsticker--treeview-list-clear-highlight)
1337 (unless (catch 'found
1338 (let ((move (not current-item-counts
)))
1340 (save-current-buffer
1341 (set-buffer (newsticker--treeview-list-buffer))
1342 (when move
(forward-line 1)
1345 (throw 'found nil
))))
1346 (when (memq (newsticker--age
1347 (newsticker--treeview-get-selected-item))
1349 (newsticker-treeview-show-item)
1352 (let ((wrap-trees (not dont-wrap-trees
)))
1353 (when (or (newsticker-treeview-next-feed t
)
1354 (and wrap-trees
(newsticker--treeview-first-feed)))
1355 (newsticker-treeview-next-new-or-immortal-item t t
)))))
1357 (defun newsticker-treeview-prev-new-or-immortal-item ()
1358 "Move to previous new or immortal item.
1359 Will move to previous feed until an item is found."
1361 (newsticker--treeview-restore-layout)
1362 (newsticker--treeview-list-clear-highlight)
1363 (unless (catch 'found
1365 (save-current-buffer
1366 (set-buffer (newsticker--treeview-list-buffer))
1370 (when (memq (newsticker--age
1371 (newsticker--treeview-get-selected-item))
1373 (newsticker-treeview-show-item)
1376 (throw 'found nil
))))
1377 (when (newsticker-treeview-prev-feed t
)
1378 (set-buffer (newsticker--treeview-list-buffer))
1379 (goto-char (point-max))
1380 (newsticker-treeview-prev-new-or-immortal-item))))
1382 (defun newsticker--treeview-get-selected-item ()
1383 "Return item that is currently selected in list buffer."
1384 (with-current-buffer (newsticker--treeview-list-buffer)
1386 (get-text-property (point) :nt-item
)))
1388 (defun newsticker-treeview-mark-item-old (&optional dont-proceed
)
1389 "Mark current item as old unless it is obsolete.
1390 Move to next item unless DONT-PROCEED is non-nil."
1392 (let ((item (newsticker--treeview-get-selected-item)))
1393 (unless (eq (newsticker--age item
) 'obsolete
)
1394 (newsticker--treeview-mark-item item
'old
)))
1395 (unless dont-proceed
1396 (newsticker-treeview-next-item)))
1398 (defun newsticker-treeview-toggle-item-immortal ()
1399 "Toggle immortality of current item."
1401 (let* ((item (newsticker--treeview-get-selected-item))
1402 (new-age (if (eq (newsticker--age item
) 'immortal
)
1405 (newsticker--treeview-mark-item item new-age
)
1406 (newsticker-treeview-next-item)))
1408 (defun newsticker--treeview-mark-item (item new-age
)
1409 "Mark ITEM with NEW-AGE."
1411 (setcar (nthcdr 4 item
) new-age
)
1412 ;; clean up ticker FIXME
1414 (newsticker--cache-save-feed
1415 (newsticker--cache-get-feed (intern newsticker--treeview-current-feed
)))
1416 (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree
))
1418 (defun newsticker-treeview-mark-list-items-old ()
1419 "Mark all listed items as old."
1421 (let ((current-feed (or newsticker--treeview-current-feed
1422 newsticker--treeview-current-vfeed
)))
1423 (with-current-buffer (newsticker--treeview-list-buffer)
1424 (goto-char (point-min))
1426 (let ((item (get-text-property (point) :nt-item
)))
1427 (unless (memq (newsticker--age item
) '(immortal obsolete
))
1428 (newsticker--treeview-mark-item item
'old
)))
1430 (newsticker--treeview-tree-update-tags)
1432 (newsticker-treeview-jump current-feed
))))
1434 (defun newsticker-treeview-save-item ()
1435 "Save current item."
1437 (newsticker-save-item (or newsticker--treeview-current-feed
1438 newsticker--treeview-current-vfeed
)
1439 (newsticker--treeview-get-selected-item)))
1441 (defun newsticker-treeview-browse-url-item ()
1442 "Convert current item to HTML and call `browse-url' on result."
1444 (newsticker-browse-url-item (or newsticker--treeview-current-feed
1445 newsticker--treeview-current-vfeed
)
1446 (newsticker--treeview-get-selected-item)))
1448 (defun newsticker--treeview-set-current-node (node)
1449 "Make NODE the current node."
1450 (with-current-buffer (newsticker--treeview-tree-buffer)
1451 (setq newsticker--treeview-current-node-id
1452 (widget-get node
:nt-id
))
1453 (setq newsticker--treeview-current-feed
(widget-get node
:nt-feed
))
1454 (setq newsticker--treeview-current-vfeed
(widget-get node
:nt-vfeed
))
1455 (newsticker--treeview-tree-update-highlight)))
1457 (defun newsticker--treeview-get-first-child (node)
1458 "Get first child of NODE."
1459 (let ((children (widget-get node
:children
)))
1464 (defun newsticker--treeview-get-second-child (node)
1465 "Get scond child of NODE."
1466 (let ((children (widget-get node
:children
)))
1468 (car (cdr children
))
1471 (defun newsticker--treeview-get-last-child (node)
1472 "Get last child of NODE."
1473 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1474 (let ((children (widget-get node
:children
)))
1476 (car (reverse children
))
1479 (defun newsticker--treeview-get-feed-vfeed (node)
1480 "Get (virtual) feed of NODE."
1481 (or (widget-get node
:nt-feed
) (widget-get node
:nt-vfeed
)))
1483 (defun newsticker--treeview-get-next-sibling (node)
1484 "Get next sibling of NODE."
1485 (let ((parent (widget-get node
:parent
)))
1487 (let ((children (widget-get parent
:children
)))
1489 (if (newsticker--treeview-nodes-eq (car children
) node
)
1490 (throw 'found
(car (cdr children
))))
1491 (setq children
(cdr children
)))))))
1493 (defun newsticker--treeview-get-prev-sibling (node)
1494 "Get previous sibling of NODE."
1495 (let ((parent (widget-get node
:parent
)))
1497 (let ((children (widget-get parent
:children
))
1500 (if (and (newsticker--treeview-nodes-eq (car children
) node
)
1501 (widget-get prev
:nt-id
))
1502 (throw 'found prev
))
1503 (setq prev
(car children
))
1504 (setq children
(cdr children
)))))))
1506 (defun newsticker--treeview-get-next-uncle (node)
1507 "Get next uncle of NODE, i.e. parent's next sibling."
1508 (let* ((parent (widget-get node
:parent
))
1509 (grand-parent (widget-get parent
:parent
)))
1511 (let ((uncles (widget-get grand-parent
:children
)))
1513 (if (newsticker--treeview-nodes-eq (car uncles
) parent
)
1514 (throw 'found
(car (cdr uncles
))))
1515 (setq uncles
(cdr uncles
)))))))
1517 (defun newsticker--treeview-get-prev-uncle (node)
1518 "Get previous uncle of NODE, i.e. parent's previous sibling."
1519 (let* ((parent (widget-get node
:parent
))
1520 (grand-parent (widget-get parent
:parent
)))
1522 (let ((uncles (widget-get grand-parent
:children
))
1525 (if (newsticker--treeview-nodes-eq (car uncles
) parent
)
1526 (throw 'found prev
))
1527 (setq prev
(car uncles
))
1528 (setq uncles
(cdr uncles
)))))))
1530 (defun newsticker--treeview-get-other-tree ()
1532 (if (and (newsticker--treeview-get-current-node)
1533 (widget-get (newsticker--treeview-get-current-node) :nt-feed
))
1534 newsticker--treeview-vfeed-tree
1535 newsticker--treeview-feed-tree
))
1537 (defun newsticker--treeview-activate-node (node &optional backward
)
1539 If NODE is a tree widget the node's first subnode is activated.
1540 If BACKWARD is non-nil the last subnode of the previous sibling
1542 (newsticker--treeview-set-current-node node
)
1543 (save-current-buffer
1544 (set-buffer (newsticker--treeview-tree-buffer))
1545 (cond ((eq (widget-type node
) 'tree-widget
)
1546 (unless (widget-get node
:open
)
1547 (widget-put node
:open nil
)
1548 (widget-apply-action node
))
1549 (newsticker--treeview-activate-node
1551 (newsticker--treeview-get-last-child node
)
1552 (newsticker--treeview-get-second-child node
))))
1554 (widget-apply-action node
)))))
1556 (defun newsticker--treeview-first-feed ()
1557 "Jump to the depth-first feed in the `newsticker-groups' tree."
1558 (newsticker-treeview-jump
1559 (car (reverse (newsticker--group-get-feeds newsticker-groups t
)))))
1561 (defun newsticker-treeview-next-feed (&optional stay-in-tree
)
1563 Optional argument STAY-IN-TREE prevents moving from real feed
1564 tree to virtual feed tree or vice versa.
1565 Return t if a new feed was activated, nil otherwise."
1567 (newsticker--treeview-restore-layout)
1568 (let ((cur (newsticker--treeview-get-current-node))
1572 (or (newsticker--treeview-get-next-sibling cur
)
1573 (newsticker--treeview-get-next-uncle cur
)
1574 (and (not stay-in-tree
)
1575 (newsticker--treeview-get-other-tree)))
1576 (car (widget-get newsticker--treeview-feed-tree
:children
))))
1579 (newsticker--treeview-activate-node new
)
1580 (newsticker--treeview-tree-update-highlight)
1584 (defun newsticker-treeview-prev-feed (&optional stay-in-tree
)
1585 "Move to previous feed.
1586 Optional argument STAY-IN-TREE prevents moving from real feed
1587 tree to virtual feed tree or vice versa.
1588 Return t if a new feed was activated, nil otherwise."
1590 (newsticker--treeview-restore-layout)
1591 (let ((cur (newsticker--treeview-get-current-node))
1597 (or (newsticker--treeview-get-prev-sibling cur
)
1598 (newsticker--treeview-get-prev-uncle cur
)
1599 (and (not stay-in-tree
)
1600 (newsticker--treeview-get-other-tree)))
1601 (car (widget-get newsticker--treeview-feed-tree
:children
))))
1604 (newsticker--treeview-activate-node new t
)
1605 (newsticker--treeview-tree-update-highlight)
1610 (defun newsticker-treeview-next-page ()
1611 "Scroll item buffer."
1613 (save-selected-window
1614 (select-window (newsticker--treeview-item-window) t
)
1618 (goto-char (point-min))))))
1621 (defun newsticker--treeview-unfold-node (feed-name)
1622 "Recursively show subtree above the node that represents FEED-NAME."
1623 (let ((node (newsticker--treeview-get-node-of-feed feed-name
)))
1625 (let* ((group-name (car (newsticker--group-find-parent-group
1627 (newsticker--treeview-unfold-node group-name
))
1628 (setq node
(newsticker--treeview-get-node-of-feed feed-name
)))
1630 (with-current-buffer (newsticker--treeview-tree-buffer)
1631 (widget-put node
:nt-selected t
)
1632 (widget-apply-action node
)
1633 (newsticker--treeview-set-current-node node
)))))
1635 (defun newsticker-treeview-jump (feed-name)
1636 "Jump to feed FEED-NAME in newsticker treeview."
1638 (list (let ((completion-ignore-case t
))
1641 (append '("new" "obsolete" "immortal" "all")
1642 (mapcar 'car
(append newsticker-url-list
1643 newsticker-url-list-defaults
)))
1645 (newsticker--treeview-unfold-node feed-name
))
1647 ;; ======================================================================
1649 ;; ======================================================================
1650 (defun newsticker--group-do-find-group (feed-or-group-name parent-node node
)
1651 "Recursively find FEED-OR-GROUP-NAME in PARENT-NODE or NODE."
1652 (cond ((stringp node
)
1653 (when (string= feed-or-group-name node
)
1654 (throw 'found parent-node
)))
1656 (cond ((string= feed-or-group-name
(car node
))
1657 (throw 'found parent-node
))
1658 ((member feed-or-group-name
(cdr node
))
1659 (throw 'found node
))
1663 (newsticker--group-do-find-group
1664 feed-or-group-name node n
)))
1667 (defun newsticker--group-find-parent-group (feed-or-group-name)
1668 "Find group containing FEED-OR-GROUP-NAME."
1671 (newsticker--group-do-find-group feed-or-group-name
1677 (defun newsticker--group-do-get-group (name node
)
1678 "Recursively find group with NAME below NODE."
1679 (if (string= name
(car node
))
1683 (newsticker--group-do-get-group name n
)))
1686 (defun newsticker--group-get-group (name)
1687 "Find group with NAME."
1691 (newsticker--group-do-get-group name n
)))
1695 (defun newsticker--group-get-subgroups (group &optional recursive
)
1696 "Return list of subgroups for GROUP.
1697 If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1701 (setq result
(cons (car n
) result
))
1702 (let ((subgroups (newsticker--group-get-subgroups n recursive
)))
1704 (setq result
(append subgroups result
))))))
1708 (defun newsticker--group-all-groups ()
1709 "Return nested list of all groups."
1710 (newsticker--group-get-subgroups newsticker-groups t
))
1712 (defun newsticker--group-get-feeds (group &optional recursive
)
1713 "Return list of all feeds in GROUP.
1714 If RECURSIVE is non-nil recursively get feeds of subgroups and
1715 return a nested list."
1719 (setq result
(cons n result
))
1721 (let ((subfeeds (newsticker--group-get-feeds n t
)))
1723 (setq result
(append subfeeds result
)))))))
1727 (defun newsticker-group-add-group (name parent
)
1728 "Add group NAME to group PARENT."
1730 (list (read-string "Name of new group: ")
1731 (let ((completion-ignore-case t
))
1732 (completing-read "Name of parent group (optional): " (newsticker--group-all-groups)
1734 (if (newsticker--group-get-group name
)
1735 (error "Group %s exists already" name
))
1736 (let ((p (if (and parent
(not (string= parent
"")))
1737 (newsticker--group-get-group parent
)
1738 newsticker-groups
)))
1740 (error "Parent %s does not exist" parent
))
1741 (setcdr p
(cons (list name
) (cdr p
))))
1742 (newsticker--treeview-tree-update)
1743 (newsticker-treeview-jump newsticker--treeview-current-feed
))
1745 (defun newsticker-group-delete-group (name)
1746 "Delete group NAME."
1748 (list (let ((completion-ignore-case t
))
1749 (completing-read "Delete group: "
1750 (newsticker--group-names)
1751 nil t
(car (newsticker--group-find-parent-group
1752 newsticker--treeview-current-feed
))))))
1753 (let ((parent-group (newsticker--group-find-parent-group name
)))
1754 (unless parent-group
1755 (error "Parent %s does not exist" parent-group
))
1756 (setcdr parent-group
(cl-delete-if (lambda (g)
1758 (string= name
(car g
))))
1759 (cdr parent-group
)))
1760 (newsticker--group-manage-orphan-feeds)
1761 (newsticker--treeview-tree-update)
1762 (newsticker-treeview-update)
1763 (newsticker-treeview-jump newsticker--treeview-current-feed
)))
1765 (defun newsticker--group-do-rename-group (old-name new-name
)
1766 "Actually rename group OLD-NAME to NEW-NAME."
1767 (let ((parent-group (newsticker--group-find-parent-group old-name
)))
1768 (unless parent-group
1769 (error "Parent of %s does not exist" old-name
))
1770 (mapcar (lambda (elt)
1771 (cond ((and (listp elt
)
1772 (string= old-name
(car elt
)))
1773 (cons new-name
(cdr elt
)))
1775 elt
))) parent-group
)))
1777 (defun newsticker-group-rename-group (old-name new-name
)
1778 "Rename group OLD-NAME to NEW-NAME."
1780 (list (let* ((completion-ignore-case t
))
1781 (completing-read "Rename group: "
1782 (newsticker--group-names)
1783 nil t
(car (newsticker--group-find-parent-group
1784 newsticker--treeview-current-feed
))))
1785 (read-string "Rename to: ")))
1786 (setq newsticker-groups
(newsticker--group-do-rename-group old-name new-name
))
1787 (newsticker--group-manage-orphan-feeds)
1788 (newsticker--treeview-tree-update)
1789 (newsticker-treeview-update)
1790 (newsticker-treeview-jump newsticker--treeview-current-feed
))
1792 (defun newsticker--get-group-names (lst)
1793 "Do get the group names from LST."
1794 (delete nil
(cons (car lst
)
1798 (newsticker--get-group-names e
))
1803 (defun newsticker--group-names ()
1804 "Get names of all newsticker groups."
1805 (newsticker--get-group-names newsticker-groups
))
1807 (defun newsticker-group-move-feed (name group-name
&optional no-update
)
1808 "Move feed NAME to group GROUP-NAME.
1809 Update treeview afterwards unless NO-UPDATE is non-nil."
1811 (let ((completion-ignore-case t
))
1812 (list (completing-read "Name of feed or group to move: "
1813 (append (mapcar 'car newsticker-url-list
)
1814 (newsticker--group-names))
1815 nil t newsticker--treeview-current-feed
)
1816 (completing-read "Name of new parent group: " (newsticker--group-names)
1818 (let* ((group (if (and group-name
(not (string= group-name
"")))
1819 (newsticker--group-get-group group-name
)
1821 (moving-group-p (member name
(newsticker--group-names)))
1822 (moved-thing (if moving-group-p
1823 (newsticker--group-get-group name
)
1826 (error "Group %s does not exist" group-name
))
1827 (while (let ((old-group
1828 (newsticker--group-find-parent-group name
)))
1830 (delete moved-thing old-group
))
1832 (setcdr group
(cons moved-thing
(cdr group
)))
1834 (newsticker--treeview-tree-update)
1835 (newsticker-treeview-update)
1836 (newsticker-treeview-jump name
))))
1838 (defun newsticker-group-shift-feed-down ()
1839 "Shift current feed down in its group."
1841 (newsticker--group-shift 1))
1843 (defun newsticker-group-shift-feed-up ()
1844 "Shift current feed down in its group."
1846 (newsticker--group-shift -
1))
1848 (defun newsticker-group-shift-group-down ()
1849 "Shift current group down in its group."
1851 (newsticker--group-shift 1 t
))
1853 (defun newsticker-group-shift-group-up ()
1854 "Shift current group down in its group."
1856 (newsticker--group-shift -
1 t
))
1858 (defun newsticker--group-shift (delta &optional move-group
)
1859 "Shift current feed or group within its parent group.
1860 DELTA is an integer which specifies the direction and the amount
1861 of the shift. If MOVE-GROUP is nil the currently selected feed
1862 `newsticker--treeview-current-feed' is shifted, if it is t then
1863 the current feed's parent group is shifted.."
1864 (let* ((cur-feed newsticker--treeview-current-feed
)
1865 (thing (if move-group
1866 (newsticker--group-find-parent-group cur-feed
)
1868 (parent-group (newsticker--group-find-parent-group
1869 (if move-group
(car thing
) thing
))))
1870 (unless parent-group
1871 (error "Group not found!"))
1872 (let* ((siblings (cdr parent-group
))
1873 (pos (cl-position thing siblings
:test
'equal
))
1874 (tpos (+ pos delta
))
1875 (new-pos (max 0 (min (length siblings
) tpos
)))
1876 (beg (cl-subseq siblings
0 (min pos new-pos
)))
1877 (end (cl-subseq siblings
(+ 1 (max pos new-pos
))))
1878 (p (elt siblings new-pos
)))
1879 (when (not (= pos new-pos
))
1880 (setcdr parent-group
1881 (cl-concatenate 'list
1887 (newsticker--treeview-tree-update)
1888 (newsticker-treeview-update)
1889 (newsticker-treeview-jump cur-feed
)))))
1891 (defun newsticker--count-groups (group)
1892 "Recursively count number of subgroups of GROUP."
1896 (setq result
(+ result
(newsticker--count-groups g
)))))
1900 (defun newsticker--count-grouped-feeds (group)
1901 "Recursively count number of feeds in GROUP and its subgroups."
1905 (setq result
(+ result
(newsticker--count-grouped-feeds g
)))
1906 (setq result
(1+ result
))))
1910 (defun newsticker--group-remove-obsolete-feeds (group)
1911 "Recursively remove obsolete feeds from GROUP."
1913 (urls (append newsticker-url-list newsticker-url-list-defaults
)))
1917 (newsticker--group-remove-obsolete-feeds g
)))
1919 (setq result
(cons sub-groups result
))))
1921 (setq result
(cons g result
)))))
1924 (cons (car group
) (reverse result
))
1927 (defun newsticker--group-manage-orphan-feeds ()
1928 "Put unmanaged feeds into `newsticker-groups'.
1929 Remove obsolete feeds as well.
1930 Return t if groups have changed, nil otherwise."
1931 (unless newsticker-groups
1932 (setq newsticker-groups
'("Feeds")))
1933 (let ((new-feed nil
)
1934 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups
)))
1936 (unless (newsticker--group-find-parent-group (car f
))
1938 (newsticker-group-move-feed (car f
) nil t
)))
1939 (append newsticker-url-list-defaults newsticker-url-list
))
1940 (setq newsticker-groups
1941 (newsticker--group-remove-obsolete-feeds newsticker-groups
))
1943 (not (= grouped-feeds
1944 (newsticker--count-grouped-feeds newsticker-groups
))))))
1946 ;; ======================================================================
1948 ;; ======================================================================
1949 (defun newsticker--treeview-create-groups-menu (group-list
1951 "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
1952 (let ((menu (make-sparse-keymap (if (stringp (car group-list
))
1954 "Move to group..."))))
1957 (let ((title (if (stringp (car g
))
1959 "Move to group...")))
1960 (unless (eq g excluded-group
)
1961 (define-key menu
(vector (intern title
))
1962 (list 'menu-item title
1963 (newsticker--treeview-create-groups-menu
1964 (cdr g
) excluded-group
)))))))
1965 (reverse group-list
))
1968 (defun newsticker--treeview-create-tree-menu (feed-name)
1969 "Create tree menu for FEED-NAME."
1970 (let ((menu (make-sparse-keymap feed-name
)))
1971 (define-key menu
[newsticker-treeview-mark-list-items-old
]
1972 (list 'menu-item
"Mark all items old"
1973 'newsticker-treeview-mark-list-items-old
))
1974 (define-key menu
[move]
1975 (list 'menu-item "Move to group..."
1976 (newsticker--treeview-create-groups-menu
1978 (newsticker--group-get-group feed-name))))
1981 (defvar newsticker-treeview-list-menu
1982 (let ((menu (make-sparse-keymap "Newsticker List")))
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 [newsticker-treeview-mark-item-old]
1987 (list 'menu-item "Mark current item old"
1988 'newsticker-treeview-mark-item-old))
1989 (define-key menu [newsticker-treeview-toggle-item-immortal]
1990 (list 'menu-item "Mark current item immortal (toggle)"
1991 'newsticker-treeview-toggle-item-immortal))
1992 (define-key menu [newsticker-treeview-get-news]
1993 (list 'menu-item "Get news for current feed"
1994 'newsticker-treeview-get-news))
1996 "Map for newsticker list menu.")
1998 (defvar newsticker-treeview-item-menu
1999 (let ((menu (make-sparse-keymap "Newsticker Item")))
2000 (define-key menu [newsticker-treeview-mark-item-old]
2001 (list 'menu-item "Mark current item old"
2002 'newsticker-treeview-mark-item-old))
2003 (define-key menu [newsticker-treeview-toggle-item-immortal]
2004 (list 'menu-item "Mark current item immortal (toggle)"
2005 'newsticker-treeview-toggle-item-immortal))
2006 (define-key menu [newsticker-treeview-get-news]
2007 (list 'menu-item "Get news for current feed"
2008 'newsticker-treeview-get-news))
2010 "Map for newsticker item menu.")
2012 (defvar newsticker-treeview-mode-map
2013 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
2014 (define-key map " " 'newsticker-treeview-next-page)
2015 (define-key map "a" 'newsticker-add-url)
2016 (define-key map "b" 'newsticker-treeview-browse-url-item)
2017 (define-key map "F" 'newsticker-treeview-prev-feed)
2018 (define-key map "f" 'newsticker-treeview-next-feed)
2019 (define-key map "g" 'newsticker-treeview-get-news)
2020 (define-key map "G" 'newsticker-get-all-news)
2021 (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
2022 (define-key map "j" 'newsticker-treeview-jump)
2023 (define-key map "n" 'newsticker-treeview-next-item)
2024 (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
2025 (define-key map "O" 'newsticker-treeview-mark-list-items-old)
2026 (define-key map "o" 'newsticker-treeview-mark-item-old)
2027 (define-key map "p" 'newsticker-treeview-prev-item)
2028 (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
2029 (define-key map "q" 'newsticker-treeview-quit)
2030 (define-key map "S" 'newsticker-treeview-save-item)
2031 (define-key map "s" 'newsticker-treeview-save)
2032 (define-key map "u" 'newsticker-treeview-update)
2033 (define-key map "v" 'newsticker-treeview-browse-url)
2034 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
2035 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
2036 (define-key map "\M-m" 'newsticker-group-move-feed)
2037 (define-key map "\M-a" 'newsticker-group-add-group)
2038 (define-key map "\M-d" 'newsticker-group-delete-group)
2039 (define-key map "\M-r" 'newsticker-group-rename-group)
2040 (define-key map [M-down] 'newsticker-group-shift-feed-down)
2041 (define-key map [M-up] 'newsticker-group-shift-feed-up)
2042 (define-key map [M-S-down] 'newsticker-group-shift-group-down)
2043 (define-key map [M-S-up] 'newsticker-group-shift-group-up)
2045 "Mode map for newsticker treeview.")
2047 (define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV"
2048 "Major mode for Newsticker Treeview.
2049 \\{newsticker-treeview-mode-map}"
2050 (if (boundp 'tool-bar-map)
2051 (set (make-local-variable 'tool-bar-map)
2052 newsticker-treeview-tool-bar-map))
2053 (setq buffer-read-only t
2056 (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
2058 (let ((header (concat
2059 (propertize " " 'display '(space :align-to 0))
2060 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
2061 (propertize " " 'display '(space :align-to 2))
2062 (if newsticker--treeview-list-show-feed
2064 (propertize " " 'display '(space :align-to 12)))
2066 (newsticker-treeview-list-make-sort-button "Date"
2068 (if newsticker--treeview-list-show-feed
2069 (propertize " " 'display '(space :align-to 28))
2070 (propertize " " 'display '(space :align-to 18)))
2071 (newsticker-treeview-list-make-sort-button "Title"
2073 (setq header-line-format header))
2074 (define-key newsticker-treeview-list-mode-map [down-mouse-3]
2075 newsticker-treeview-list-menu))
2077 (define-derived-mode newsticker-treeview-item-mode newsticker-treeview-mode
2079 (define-key newsticker-treeview-item-mode-map [down-mouse-3]
2080 newsticker-treeview-item-menu))
2082 (defun newsticker-treeview-tree-click (event)
2083 "Handle click EVENT on a tag in the newsticker tree."
2085 (newsticker--treeview-restore-layout)
2087 (switch-to-buffer (window-buffer (posn-window (event-end event))))
2088 (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
2090 (defun newsticker-treeview-tree-do-click (&optional pos event)
2091 "Actually handle click event.
2092 POS gives the position where EVENT occurred."
2094 (let* ((pos (or pos (point)))
2095 (nt-id (get-text-property pos :nt-id))
2096 (item (get-text-property pos :nt-item)))
2098 ;; click in list buffer
2099 (newsticker-treeview-show-item))
2101 ;; click in tree buffer
2102 (let ((w (newsticker--treeview-get-node-by-id nt-id)))
2104 (newsticker--treeview-tree-update-tag w t t)
2105 (setq w (newsticker--treeview-get-node-by-id nt-id))
2106 (widget-put w :nt-selected t)
2107 (widget-apply w :action event)
2108 (newsticker--treeview-set-current-node w))))))
2109 (newsticker--treeview-tree-update-highlight))
2111 (defun newsticker--treeview-restore-layout ()
2112 "Restore treeview buffers."
2115 (let ((win (nth i newsticker--treeview-windows))
2116 (buf (nth i newsticker--treeview-buffers)))
2117 (unless (window-live-p win)
2118 (newsticker--treeview-window-init)
2119 (newsticker--treeview-buffer-init)
2121 (unless (eq (window-buffer win) buf)
2122 (set-window-buffer win buf t))))))
2124 (defun newsticker--treeview-frame-init ()
2125 "Initialize treeview frame."
2126 (when newsticker-treeview-own-frame
2127 (unless (and newsticker--frame (frame-live-p newsticker--frame))
2128 (setq newsticker--frame (make-frame '((name . "Newsticker")))))
2129 (select-frame-set-input-focus newsticker--frame)
2130 (raise-frame newsticker--frame)))
2132 (defun newsticker--treeview-window-init ()
2133 "Initialize treeview windows."
2134 (setq newsticker--saved-window-config (current-window-configuration))
2135 (setq newsticker--treeview-windows nil)
2136 (setq newsticker--treeview-buffers nil)
2137 (delete-other-windows)
2138 (split-window-right newsticker-treeview-treewindow-width)
2139 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2141 (split-window-below newsticker-treeview-listwindow-height)
2142 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2144 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2148 (defun newsticker-treeview ()
2149 "Start newsticker treeview."
2151 (newsticker--treeview-load)
2152 (setq newsticker--sentinel-callback 'newsticker-treeview-update)
2153 (newsticker--treeview-frame-init)
2154 (newsticker--treeview-window-init)
2155 (newsticker--treeview-buffer-init)
2156 (if (newsticker--group-manage-orphan-feeds)
2157 (newsticker--treeview-tree-update))
2158 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
2159 (newsticker-start t) ;; will start only if not running
2160 (newsticker-treeview-update)
2161 (newsticker--treeview-item-show-text
2163 "Welcome to newsticker!"))
2165 (defun newsticker-treeview-get-news ()
2166 "Get news for current feed."
2168 (when newsticker--treeview-current-feed
2169 (newsticker-get-news newsticker--treeview-current-feed)))
2171 (provide 'newst-treeview)
2173 ;;; newst-treeview.el ends here