Newsticker: Add commands to rearrange treeview groups and document them. (Bug#12560)
[emacs.git] / lisp / net / newst-treeview.el
blob05a476696cd9404df694c451c8623df323706689
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
8 ;; Created: 2007
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 ;; ======================================================================
30 ;;; Commentary:
32 ;; See newsticker.el
34 ;; ======================================================================
35 ;;; History:
38 ;; ======================================================================
39 ;;; Code:
40 (require 'newst-reader)
41 (require 'widget)
42 (require 'tree-widget)
43 (require 'wid-edit)
45 ;; ======================================================================
46 ;;; Customization
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
87 "%d.%m.%y, %H:%M"
88 "Format for the date column in the treeview list buffer.
89 See `format-time-string' for a list of valid specifiers."
90 :version "24.5"
91 :type 'string
92 :group 'newsticker-treeview)
94 (defcustom newsticker-treeview-own-frame
95 nil
96 "Decides whether newsticker treeview creates and uses its own frame."
97 :type 'boolean
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'."
104 :type 'integer
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'."
111 :type 'integer
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."
119 :type 'boolean
120 :group 'newsticker-treeview)
122 (defvar newsticker-groups
123 '("Feeds")
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\")
132 \"feed3\")")
134 (defcustom newsticker-groups-filename
135 "~/.newsticker-groups"
136 "Name of the newsticker groups settings file."
137 :type 'string
138 :group 'newsticker-treeview)
139 (make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
141 ;; ======================================================================
142 ;;; internal variables
143 ;; ======================================================================
144 (defvar newsticker--treeview-windows nil)
145 (defvar newsticker--treeview-buffers nil)
146 (defvar newsticker--treeview-current-feed nil
147 "Feed name of currently shown item.")
148 (defvar newsticker--treeview-current-vfeed nil)
149 (defvar newsticker--treeview-list-show-feed nil)
150 (defvar newsticker--saved-window-config nil)
151 (defvar newsticker--selection-overlay nil
152 "Highlight the selected tree node.")
153 (defvar newsticker--tree-selection-overlay nil
154 "Highlight the selected list item.")
155 (defvar newsticker--frame nil "Special frame for newsticker windows.")
156 (defvar newsticker--treeview-list-sort-order 'sort-by-time)
157 (defvar newsticker--treeview-current-node-id nil)
158 (defvar newsticker--treeview-current-tree nil)
159 (defvar newsticker--treeview-feed-tree nil)
160 (defvar newsticker--treeview-vfeed-tree nil)
162 ;; maps for the clickable portions
163 (defvar newsticker--treeview-url-keymap
164 (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
165 (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
166 (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
167 (define-key map "\n" 'newsticker-treeview-browse-url)
168 (define-key map "\C-m" 'newsticker-treeview-browse-url)
169 (define-key map [(control return)] 'newsticker-handle-url)
170 map)
171 "Key map for click-able headings in the newsticker treeview buffers.")
174 ;; ======================================================================
175 ;;; short cuts
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)))
230 (dolist (w 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."
235 (catch 'found
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)))
246 (dolist (w 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."
251 (catch 'found
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
268 (save-excursion
269 (set-marker-insertion-type end t)
270 ;; check whether it is necessary to call html renderer
271 ;; (regexp inspired by htmlr.el)
272 (goto-char start)
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
277 -1 fill-column))
278 (w3-maximum-line-length
279 (if newsticker-use-full-width nil fill-column)))
280 (save-excursion
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))
290 (error
291 (message "Error: HTML rendering failed: %s, %s"
292 (car error-data) (cdr error-data))
293 nil))
294 nil))
296 ;; ======================================================================
297 ;;; List window
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)
305 pos1 pos2)
306 (goto-char (point-max))
307 (setq pos1 (point-marker))
308 (insert " ")
309 (insert (propertize " " 'display '(space :align-to 2)))
310 (insert (if show-feed
311 (concat
312 (substring
313 (format "%-10s" (newsticker--real-feed-name
314 feed))
315 0 10)
316 (propertize " " 'display '(space :align-to 12)))
317 ""))
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))
324 (insert "\n")
325 (newsticker--treeview-render-text pos2 (point-marker))
326 (goto-char pos2)
327 (while (search-forward "\n" nil t)
328 (replace-match " "))
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)
334 (list :nt-item item
335 :nt-feed feed
336 :nt-link (newsticker--link item)
337 'mouse-face 'highlight
338 'keymap map
339 'help-echo (buffer-substring pos2
340 (point-max)))))
341 (insert "\n"))))
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))
347 (erase-buffer)
348 (kill-all-local-variables)
349 (remove-overlays))))
351 (defun newsticker--treeview-list-items-with-age-callback (widget
352 changed-widget
353 &rest ages)
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."
366 (mapc (lambda (feed)
367 (let ((feed-name-symbol (intern (car feed))))
368 (mapc (lambda (item)
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
378 &optional event)
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
385 'new)
386 (newsticker--treeview-item-show-text
387 "New items"
388 "This is a virtual feed containing all new items"))
390 (defun newsticker--treeview-list-immortal-items (widget changed-widget
391 &optional event)
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
398 'immortal)
399 (newsticker--treeview-item-show-text
400 "Immortal items"
401 "This is a virtual feed containing all immortal items."))
403 (defun newsticker--treeview-list-obsolete-items (widget changed-widget
404 &optional event)
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
411 'obsolete)
412 (newsticker--treeview-item-show-text
413 "Obsolete items"
414 "This is a virtual feed containing all obsolete items."))
416 (defun newsticker--treeview-list-all-items (widget changed-widget
417 &optional event)
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
424 event 'new 'old
425 'obsolete 'immortal)
426 (newsticker--treeview-item-show-text
427 "All items"
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."
432 (when 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."
444 (when feed-name
445 (if (newsticker--treeview-virtual-feed-p feed-name)
446 (newsticker--treeview-list-items-v feed-name)
447 (mapc (lambda (item)
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
457 &optional event)
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)))
466 (if feed-name
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."
472 (catch 'result
473 (let ((age1 (newsticker--age item1))
474 (age2 (newsticker--age item2)))
475 (cond ((eq age1 'new)
477 ((eq age1 'immortal)
478 (cond ((eq age2 'new)
480 ((eq age2 'immortal)
483 nil)))
484 ((eq age1 'old)
485 (cond ((eq age2 'new)
486 nil)
487 ((eq age2 'immortal)
488 nil)
489 ((eq age2 'old)
490 nil)
492 t)))
494 nil)))))
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'."
520 (let ((sort-fun
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."
542 (let (pos-sel)
543 (with-current-buffer (newsticker--treeview-list-buffer)
544 (save-excursion
545 (let ((inhibit-read-only t))
546 (goto-char (point-min))
547 (while (not (eobp))
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)
554 ((eq age 'old)
555 'newsticker-treeview-old-face)
556 ((eq age 'immortal)
557 'newsticker-treeview-immortal-face)
558 ((eq age 'obsolete)
559 'newsticker-treeview-obsolete-face)
561 'bold))))
562 (put-text-property (point) pos 'face face)
563 (if selected
564 (move-overlay newsticker--selection-overlay (point)
565 (1+ pos) ;include newline
566 (current-buffer)))
567 (if selected (setq pos-sel (point)))
568 (forward-line 1)
569 (beginning-of-line)))))) ;; FIXME!?
570 (when pos-sel
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)
584 (let (pos num-lines)
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)
593 (save-excursion
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."
600 (save-excursion
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))
605 (if clear-buffer
606 (let ((inhibit-read-only t))
607 (erase-buffer)))
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)
618 map)
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))
628 (sort-order (if obj
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)
634 'sort-by-age-reverse
635 '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
639 'sort-by-time))
640 ((eq sort-order 'sort-by-title)
641 (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
642 'sort-by-title-reverse
643 'sort-by-title))))
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
649 for the button."
650 (let ((face (if (string-match (symbol-name sort-order)
651 (symbol-name
652 newsticker--treeview-list-sort-order))
653 'bold
654 'header-line)))
655 (propertize name
656 'sort-order sort-order
657 'help-echo (concat "Sort by " name)
658 'mouse-face 'highlight
659 'face face
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)
665 (let (pos num-lines)
666 (save-current-buffer
667 (set-buffer (newsticker--treeview-list-buffer))
668 (goto-char (point-min))
669 (catch 'found
670 (while t
671 (let ((it (get-text-property (point) :nt-item)))
672 (when (eq it 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))
677 (throw 'found t)))
678 (forward-line 1)
679 (when (eobp)
680 (goto-char (point-min))
681 (throw 'found nil)))))))
683 ;; ======================================================================
684 ;;; item window
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))
692 (erase-buffer)
693 (kill-all-local-variables)
694 (remove-overlays)
695 (insert title)
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)))
714 (erase-buffer)
715 (kill-all-local-variables)
716 (remove-overlays)
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
723 wwidth)))
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
729 marker2))
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)))
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))
748 (setq pos (point))
750 (insert "\n\n")
751 ;; insert title
752 (setq pos (point))
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)
758 (goto-char marker2)
759 (delete-char -1)
760 (insert "\n")
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))
765 (goto-char marker2)
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)))
773 (insert "\n")
774 (setq pos (point))
775 (insert "\n")
776 ;; insert enclosures and rest at bottom
777 (goto-char (point-max))
778 (insert "\n\n")
779 (setq pos (point))
780 (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
781 (put-text-property pos (point) 'face 'newsticker-enclosure-face)
782 (setq pos (point))
783 (insert "\n")
784 (newsticker--print-extra-elements item newsticker--treeview-url-keymap)
785 (put-text-property pos (point) 'face 'newsticker-extra-face)
786 (goto-char (point-min)))))
787 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
788 item
789 (memq (newsticker--age item) '(new obsolete)))
790 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
791 (newsticker-treeview-mark-item-old t)
792 (newsticker--treeview-list-update-faces)))
793 (if (window-live-p (newsticker--treeview-item-window))
794 (set-window-point (newsticker--treeview-item-window) 1)))
796 (defun newsticker--treeview-item-update ()
797 "Update the treeview item buffer and window."
798 (save-excursion
799 (if (window-live-p (newsticker--treeview-item-window))
800 (set-window-buffer (newsticker--treeview-item-window)
801 (newsticker--treeview-item-buffer)))
802 (set-buffer (newsticker--treeview-item-buffer))
803 (let ((inhibit-read-only t))
804 (erase-buffer))
805 (newsticker-treeview-item-mode)))
807 ;; ======================================================================
808 ;;; Tree window
809 ;; ======================================================================
810 (defun newsticker--treeview-tree-expand (tree)
811 "Expand TREE.
812 Callback function for tree widget that adds nodes for feeds and subgroups."
813 (tree-widget-set-theme "folder")
814 (let ((group (widget-get tree :nt-group))
815 (i 0)
816 (nt-id ""))
817 (mapcar (lambda (g)
818 (setq nt-id (newsticker--treeview-get-id tree i))
819 (setq i (1+ i))
820 (if (listp g)
821 (let* ((g-name (car g)))
822 `(tree-widget
823 :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
824 :expander newsticker--treeview-tree-expand
825 :expander-p (lambda (&rest ignore) t)
826 :nt-group ,(cdr g)
827 :nt-feed ,g-name
828 :nt-id ,nt-id
829 :keep (:nt-feed :num-new :nt-id :open);; :nt-group
830 :open nil))
831 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
832 `(item :tag ,tag
833 :leaf-icon newsticker--tree-widget-leaf-icon
834 :nt-feed ,g
835 :action newsticker--treeview-list-feed-items
836 :nt-id ,nt-id
837 :keep (:nt-id)
838 :open t))))
839 group)))
841 (defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
842 event)
843 "Expand the vfeed TREE.
844 Optional arguments CHANGED-WIDGET and EVENT are ignored."
845 (tree-widget-set-theme "folder")
846 (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
847 :nt-vfeed "new"
848 :action newsticker--treeview-list-new-items
849 :nt-id ,(newsticker--treeview-get-id tree 0)
850 :keep (:nt-id))
851 `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
852 :nt-vfeed "immortal"
853 :action newsticker--treeview-list-immortal-items
854 :nt-id ,(newsticker--treeview-get-id tree 1)
855 :keep (:nt-id))
856 `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
857 :nt-vfeed "obsolete"
858 :action newsticker--treeview-list-obsolete-items
859 :nt-id ,(newsticker--treeview-get-id tree 2)
860 :keep (:nt-id))
861 `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
862 :nt-vfeed "all"
863 :action newsticker--treeview-list-all-items
864 :nt-id ,(newsticker--treeview-get-id tree 3)
865 :keep (:nt-id))))
867 (defun newsticker--treeview-virtual-feed-p (feed-name)
868 "Return non-nil if FEED-NAME is a virtual feed."
869 (string-match "\\*.*\\*" feed-name))
871 (define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
872 "Icon for a tree-widget leaf node."
873 :tag "O"
874 :glyph-name "leaf"
875 :button-face 'default)
877 (defun newsticker--treeview-tree-update ()
878 "Update treeview tree buffer and window."
879 (save-excursion
880 (if (window-live-p (newsticker--treeview-tree-window))
881 (set-window-buffer (newsticker--treeview-tree-window)
882 (newsticker--treeview-tree-buffer)))
883 (set-buffer (newsticker--treeview-tree-buffer))
884 (kill-all-local-variables)
885 (let ((inhibit-read-only t))
886 (erase-buffer)
887 (tree-widget-set-theme "folder")
888 (setq newsticker--treeview-feed-tree
889 (widget-create 'tree-widget
890 :tag (newsticker--treeview-propertize-tag
891 "Feeds" 0 "feeds")
892 :expander 'newsticker--treeview-tree-expand
893 :expander-p (lambda (&rest ignore) t)
894 :leaf-icon 'newsticker--tree-widget-leaf-icon
895 :nt-group (cdr newsticker-groups)
896 :nt-id "feeds"
897 :keep '(:nt-id)
898 :open t))
899 (setq newsticker--treeview-vfeed-tree
900 (widget-create 'tree-widget
901 :tag (newsticker--treeview-propertize-tag
902 "Virtual Feeds" 0 "vfeeds")
903 :expander 'newsticker--treeview-tree-expand-status
904 :expander-p (lambda (&rest ignore) t)
905 :leaf-icon 'newsticker--tree-widget-leaf-icon
906 :nt-id "vfeeds"
907 :keep '(:nt-id)
908 :open t))
909 (use-local-map widget-keymap)
910 (widget-setup))
911 (newsticker-treeview-mode)))
913 (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
914 vfeed)
915 "Return propertized copy of string TAG.
916 Optional argument NUM-NEW is used for choosing face, other
917 arguments NT-ID, FEED, and VFEED are added as properties."
918 ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
919 (let ((face 'newsticker-treeview-face)
920 (map (make-sparse-keymap)))
921 (if (and num-new (> num-new 0))
922 (setq face 'newsticker-treeview-new-face))
923 (define-key map [mouse-1] 'newsticker-treeview-tree-click)
924 (define-key map "\n" 'newsticker-treeview-tree-do-click)
925 (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
926 (propertize tag 'face face 'keymap map
927 :nt-id nt-id
928 :nt-feed feed
929 :nt-vfeed vfeed
930 'help-echo tag
931 'mouse-face 'highlight)))
933 (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
934 &optional nt-id)
935 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
936 Optional argument NT-ID is added to the tag's properties."
937 (let (tag (num-new 0))
938 (cond (vfeed-name
939 (cond ((string= vfeed-name "new")
940 (setq num-new (newsticker--stat-num-items-total 'new))
941 (setq tag (format "New items (%d)" num-new)))
942 ((string= vfeed-name "immortal")
943 (setq num-new (newsticker--stat-num-items-total 'immortal))
944 (setq tag (format "Immortal items (%d)" num-new)))
945 ((string= vfeed-name "obsolete")
946 (setq num-new (newsticker--stat-num-items-total 'obsolete))
947 (setq tag (format "Obsolete items (%d)" num-new)))
948 ((string= vfeed-name "all")
949 (setq num-new (newsticker--stat-num-items-total))
950 (setq tag (format "All items (%d)" num-new)))))
951 (feed-name
952 (setq num-new (newsticker--stat-num-items-for-group
953 (intern feed-name) 'new 'immortal))
954 (setq tag
955 (format "%s (%d)"
956 (newsticker--real-feed-name (intern feed-name))
957 num-new))))
958 (if tag
959 (newsticker--treeview-propertize-tag tag num-new
960 nt-id
961 feed-name vfeed-name))))
963 (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
964 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
965 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
966 (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
967 (mapc (lambda (f-n)
968 (setq result (+ result
969 (apply 'newsticker--stat-num-items (intern f-n)
970 ages))))
971 (newsticker--group-get-feeds
972 (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
973 result))
975 (defun newsticker--treeview-count-node-items (feed &optional isvirtual)
976 "Count number of relevant items for a treeview node.
977 FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
978 the feed is a virtual feed."
979 (let* ((num-new 0))
980 (if feed
981 (if isvirtual
982 (cond ((string= feed "new")
983 (setq num-new (newsticker--stat-num-items-total 'new)))
984 ((string= feed "immortal")
985 (setq num-new (newsticker--stat-num-items-total 'immortal)))
986 ((string= feed "obsolete")
987 (setq num-new (newsticker--stat-num-items-total 'obsolete)))
988 ((string= feed "all")
989 (setq num-new (newsticker--stat-num-items-total))))
990 (setq num-new (newsticker--stat-num-items-for-group
991 (intern feed) 'new 'immortal))))
992 num-new))
994 (defun newsticker--treeview-tree-update-tag (w &optional recursive
995 &rest ignore)
996 "Update tag for tree widget W.
997 If RECURSIVE is non-nil recursively update parent widgets as
998 well. Argument IGNORE is ignored. Note that this function, if
999 called recursively, makes w invalid. You should keep w's nt-id in
1000 that case."
1001 (let* ((parent (widget-get w :parent))
1002 (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
1003 (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
1004 (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
1005 (num-new (newsticker--treeview-count-node-items (or feed vfeed)
1006 vfeed))
1007 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
1008 (n (widget-get w :node)))
1009 (if parent
1010 (if recursive
1011 (newsticker--treeview-tree-update-tag parent)))
1012 (when tag
1013 (when n
1014 (widget-put n :tag tag))
1015 (widget-put w :num-new num-new)
1016 (widget-put w :tag tag)
1017 (when (marker-position (widget-get w :from))
1018 (let ((p (point))
1019 (notify (widget-get w :notify)))
1020 ;; FIXME: This moves point!!!!
1021 (with-current-buffer (newsticker--treeview-tree-buffer)
1022 (widget-value-set w (widget-value w)))
1023 (goto-char p))))))
1025 (defun newsticker--treeview-tree-do-update-tags (widget)
1026 "Actually recursively update tags for WIDGET."
1027 (save-excursion
1028 (let ((children (widget-get widget :children)))
1029 (dolist (w children)
1030 (newsticker--treeview-tree-do-update-tags w))
1031 (newsticker--treeview-tree-update-tag widget))))
1033 (defun newsticker--treeview-tree-update-tags (&rest ignore)
1034 "Update all tags of all trees.
1035 Arguments IGNORE are ignored."
1036 (save-current-buffer
1037 (set-buffer (newsticker--treeview-tree-buffer))
1038 (let ((inhibit-read-only t))
1039 (newsticker--treeview-tree-do-update-tags
1040 newsticker--treeview-feed-tree)
1041 (newsticker--treeview-tree-do-update-tags
1042 newsticker--treeview-vfeed-tree))
1043 (tree-widget-set-theme "folder")))
1045 (defun newsticker--treeview-tree-update-highlight ()
1046 "Update highlight in tree buffer."
1047 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
1048 (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
1049 (setq pos (widget-get (widget-get
1050 (newsticker--treeview-get-current-node)
1051 :parent) :from)))
1052 (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
1053 (with-current-buffer (newsticker--treeview-tree-buffer)
1054 (goto-char pos)
1055 (move-overlay newsticker--tree-selection-overlay
1056 (point-at-bol) (1+ (point-at-eol))
1057 (current-buffer)))
1058 (if (window-live-p (newsticker--treeview-tree-window))
1059 (set-window-point (newsticker--treeview-tree-window) pos)))))
1061 ;; ======================================================================
1062 ;;; Toolbar
1063 ;; ======================================================================
1064 (defvar newsticker-treeview-tool-bar-map
1065 (if (featurep 'xemacs)
1067 (if (boundp 'tool-bar-map)
1068 (let ((tool-bar-map (make-sparse-keymap)))
1069 (tool-bar-add-item "newsticker/prev-feed"
1070 'newsticker-treeview-prev-feed
1071 'newsticker-treeview-prev-feed
1072 :help "Go to previous feed"
1073 ;;:enable '(newsticker-previous-feed-available-p) FIXME
1075 (tool-bar-add-item "newsticker/prev-item"
1076 'newsticker-treeview-prev-item
1077 'newsticker-treeview-prev-item
1078 :help "Go to previous item"
1079 ;;:enable '(newsticker-previous-item-available-p) FIXME
1081 (tool-bar-add-item "newsticker/next-item"
1082 'newsticker-treeview-next-item
1083 'newsticker-treeview-next-item
1084 :visible t
1085 :help "Go to next item"
1086 ;;:enable '(newsticker-next-item-available-p) FIXME
1088 (tool-bar-add-item "newsticker/next-feed"
1089 'newsticker-treeview-next-feed
1090 'newsticker-treeview-next-feed
1091 :help "Go to next feed"
1092 ;;:enable '(newsticker-next-feed-available-p) FIXME
1094 (tool-bar-add-item "newsticker/mark-immortal"
1095 'newsticker-treeview-toggle-item-immortal
1096 'newsticker-treeview-toggle-item-immortal
1097 :help "Toggle current item as immortal"
1098 ;;:enable '(newsticker-item-not-immortal-p) FIXME
1100 (tool-bar-add-item "newsticker/mark-read"
1101 'newsticker-treeview-mark-item-old
1102 'newsticker-treeview-mark-item-old
1103 :help "Mark current item as read"
1104 ;;:enable '(newsticker-item-not-old-p) FIXME
1106 (tool-bar-add-item "newsticker/get-all"
1107 'newsticker-get-all-news
1108 'newsticker-get-all-news
1109 :help "Get news for all feeds")
1110 (tool-bar-add-item "newsticker/update"
1111 'newsticker-treeview-update
1112 'newsticker-treeview-update
1113 :help "Update newsticker buffer")
1114 (tool-bar-add-item "newsticker/browse-url"
1115 'newsticker-browse-url
1116 'newsticker-browse-url
1117 :help "Browse URL for item at point")
1118 ;; standard icons / actions
1119 (define-key tool-bar-map [newsticker-sep-1]
1120 (list 'menu-item "--double-line"))
1121 (tool-bar-add-item "close"
1122 'newsticker-treeview-quit
1123 'newsticker-treeview-quit
1124 :help "Close newsticker")
1125 (tool-bar-add-item "preferences"
1126 'newsticker-customize
1127 'newsticker-customize
1128 :help "Customize newsticker")
1129 tool-bar-map))))
1131 ;; ======================================================================
1132 ;;; actions
1133 ;; ======================================================================
1135 (defun newsticker-treeview-mouse-browse-url (event)
1136 "Call `browse-url' for the link of the item at which the EVENT occurred."
1137 (interactive "e")
1138 (save-excursion
1139 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1140 (let ((url (get-text-property (posn-point (event-end event))
1141 :nt-link)))
1142 (when url
1143 (browse-url url)
1144 (if newsticker-automatically-mark-visited-items-as-old
1145 (newsticker-treeview-mark-item-old))))))
1147 (defun newsticker-treeview-browse-url ()
1148 "Call `browse-url' for the link of the item at point."
1149 (interactive)
1150 (with-current-buffer (newsticker--treeview-list-buffer)
1151 (let ((url (get-text-property (point) :nt-link)))
1152 (when url
1153 (browse-url url)
1154 (if newsticker-automatically-mark-visited-items-as-old
1155 (newsticker-treeview-mark-item-old))))))
1157 (defun newsticker--treeview-buffer-init ()
1158 "Initialize all treeview buffers."
1159 (setq newsticker--treeview-buffers nil)
1160 (add-to-list 'newsticker--treeview-buffers
1161 (get-buffer-create "*Newsticker Tree*") t)
1162 (add-to-list 'newsticker--treeview-buffers
1163 (get-buffer-create "*Newsticker List*") t)
1164 (add-to-list 'newsticker--treeview-buffers
1165 (get-buffer-create "*Newsticker Item*") t)
1167 (unless newsticker--selection-overlay
1168 (with-current-buffer (newsticker--treeview-list-buffer)
1169 (setq buffer-undo-list t)
1170 (setq newsticker--selection-overlay (make-overlay (point-min)
1171 (point-max)))
1172 (overlay-put newsticker--selection-overlay 'face
1173 'newsticker-treeview-selection-face)))
1174 (unless newsticker--tree-selection-overlay
1175 (with-current-buffer (newsticker--treeview-tree-buffer)
1176 (setq buffer-undo-list t)
1177 (setq newsticker--tree-selection-overlay (make-overlay (point-min)
1178 (point-max)))
1179 (overlay-put newsticker--tree-selection-overlay 'face
1180 'newsticker-treeview-selection-face)))
1182 (newsticker--treeview-tree-update)
1183 (newsticker--treeview-list-update t)
1184 (newsticker--treeview-item-update))
1186 (defun newsticker-treeview-update ()
1187 "Update all treeview buffers and windows.
1188 Note: does not update the layout."
1189 (interactive)
1190 (let ((cur-item (newsticker--treeview-get-selected-item)))
1191 (if (newsticker--group-manage-orphan-feeds)
1192 (newsticker--treeview-tree-update))
1193 (newsticker--treeview-list-update t)
1194 (newsticker--treeview-item-update)
1195 (newsticker--treeview-tree-update-tags)
1196 (cond (newsticker--treeview-current-feed
1197 (newsticker--treeview-list-items newsticker--treeview-current-feed))
1198 (newsticker--treeview-current-vfeed
1199 (newsticker--treeview-list-items-with-age
1200 (intern newsticker--treeview-current-vfeed))))
1201 (newsticker--treeview-tree-update-highlight)
1202 (newsticker--treeview-list-update-highlight)
1203 (let ((cur-feed (or newsticker--treeview-current-feed
1204 newsticker--treeview-current-vfeed)))
1205 (if (and cur-feed cur-item)
1206 (newsticker--treeview-list-select cur-item)))))
1208 (defun newsticker-treeview-quit ()
1209 "Quit newsticker treeview."
1210 (interactive)
1211 (setq newsticker--sentinel-callback nil)
1212 (bury-buffer "*Newsticker Tree*")
1213 (bury-buffer "*Newsticker List*")
1214 (bury-buffer "*Newsticker Item*")
1215 (set-window-configuration newsticker--saved-window-config)
1216 (when newsticker--frame
1217 (if (frame-live-p newsticker--frame)
1218 (delete-frame newsticker--frame))
1219 (setq newsticker--frame nil))
1220 (newsticker-treeview-save))
1222 (defun newsticker-treeview-save ()
1223 "Save treeview group settings."
1224 (interactive)
1225 (let ((coding-system-for-write 'utf-8)
1226 (buf (find-file-noselect (concat newsticker-dir "/groups"))))
1227 (when buf
1228 (with-current-buffer buf
1229 (setq buffer-undo-list t)
1230 (erase-buffer)
1231 (insert ";; -*- coding: utf-8 -*-\n")
1232 (insert (prin1-to-string newsticker-groups))
1233 (save-buffer)
1234 (kill-buffer)))))
1236 (defun newsticker--treeview-load ()
1237 "Load treeview settings."
1238 (let* ((coding-system-for-read 'utf-8)
1239 (filename
1240 (or (and (file-exists-p newsticker-groups-filename)
1241 (y-or-n-p
1242 (format "Old newsticker groups (%s) file exists. Read it? "
1243 newsticker-groups-filename))
1244 newsticker-groups-filename)
1245 (concat newsticker-dir "/groups")))
1246 (buf (and (file-exists-p filename)
1247 (find-file-noselect filename))))
1248 (and (file-exists-p newsticker-groups-filename)
1249 (y-or-n-p (format "Delete old newsticker groups file? "))
1250 (delete-file newsticker-groups-filename))
1251 (when buf
1252 (set-buffer buf)
1253 (goto-char (point-min))
1254 (condition-case nil
1255 (setq newsticker-groups (read buf))
1256 (error
1257 (message "Error while reading newsticker groups file!")
1258 (setq newsticker-groups nil)))
1259 (kill-buffer buf))))
1262 (defun newsticker-treeview-scroll-item ()
1263 "Scroll current item."
1264 (interactive)
1265 (save-selected-window
1266 (select-window (newsticker--treeview-item-window) t)
1267 (scroll-up 1)))
1269 (defun newsticker-treeview-show-item ()
1270 "Show current item."
1271 (interactive)
1272 (newsticker--treeview-restore-layout)
1273 (newsticker--treeview-list-update-highlight)
1274 (with-current-buffer (newsticker--treeview-list-buffer)
1275 (beginning-of-line)
1276 (let ((item (get-text-property (point) :nt-item))
1277 (feed (get-text-property (point) :nt-feed)))
1278 (newsticker--treeview-item-show item feed)))
1279 (newsticker--treeview-tree-update-tag
1280 (newsticker--treeview-get-current-node) t)
1281 (newsticker--treeview-tree-update-highlight))
1283 (defun newsticker-treeview-next-item ()
1284 "Move to next item."
1285 (interactive)
1286 (newsticker--treeview-restore-layout)
1287 (save-current-buffer
1288 (set-buffer (newsticker--treeview-list-buffer))
1289 (if (newsticker--treeview-list-highlight-start)
1290 (forward-line 1))
1291 (if (eobp)
1292 (forward-line -1)))
1293 (newsticker-treeview-show-item))
1295 (defun newsticker-treeview-prev-item ()
1296 "Move to previous item."
1297 (interactive)
1298 (newsticker--treeview-restore-layout)
1299 (save-current-buffer
1300 (set-buffer (newsticker--treeview-list-buffer))
1301 (forward-line -1))
1302 (newsticker-treeview-show-item))
1304 (defun newsticker-treeview-next-new-or-immortal-item (&optional
1305 current-item-counts
1306 dont-wrap-trees)
1307 "Move to next new or immortal item.
1308 Will move to next feed until an item is found. Will not move if
1309 optional argument CURRENT-ITEM-COUNTS is t and current item is
1310 new or immortal. Will not move from virtual to ordinary feed
1311 tree or vice versa if optional argument DONT-WRAP-TREES is non-nil."
1312 (interactive)
1313 (newsticker--treeview-restore-layout)
1314 (newsticker--treeview-list-clear-highlight)
1315 (unless (catch 'found
1316 (let ((move (not current-item-counts)))
1317 (while t
1318 (save-current-buffer
1319 (set-buffer (newsticker--treeview-list-buffer))
1320 (when move (forward-line 1)
1321 (when (eobp)
1322 (forward-line -1)
1323 (throw 'found nil))))
1324 (when (memq (newsticker--age
1325 (newsticker--treeview-get-selected-item))
1326 '(new immortal))
1327 (newsticker-treeview-show-item)
1328 (throw 'found t))
1329 (setq move t))))
1330 (let ((wrap-trees (not dont-wrap-trees)))
1331 (when (or (newsticker-treeview-next-feed t)
1332 (and wrap-trees (newsticker--treeview-first-feed)))
1333 (newsticker-treeview-next-new-or-immortal-item t t)))))
1335 (defun newsticker-treeview-prev-new-or-immortal-item ()
1336 "Move to previous new or immortal item.
1337 Will move to previous feed until an item is found."
1338 (interactive)
1339 (newsticker--treeview-restore-layout)
1340 (newsticker--treeview-list-clear-highlight)
1341 (unless (catch 'found
1342 (while t
1343 (save-current-buffer
1344 (set-buffer (newsticker--treeview-list-buffer))
1345 (when (bobp)
1346 (throw 'found nil))
1347 (forward-line -1))
1348 (when (memq (newsticker--age
1349 (newsticker--treeview-get-selected-item))
1350 '(new immortal))
1351 (newsticker-treeview-show-item)
1352 (throw 'found t))
1353 (when (bobp)
1354 (throw 'found nil))))
1355 (when (newsticker-treeview-prev-feed t)
1356 (set-buffer (newsticker--treeview-list-buffer))
1357 (goto-char (point-max))
1358 (newsticker-treeview-prev-new-or-immortal-item))))
1360 (defun newsticker--treeview-get-selected-item ()
1361 "Return item that is currently selected in list buffer."
1362 (with-current-buffer (newsticker--treeview-list-buffer)
1363 (beginning-of-line)
1364 (get-text-property (point) :nt-item)))
1366 (defun newsticker-treeview-mark-item-old (&optional dont-proceed)
1367 "Mark current item as old unless it is obsolete.
1368 Move to next item unless DONT-PROCEED is non-nil."
1369 (interactive)
1370 (let ((item (newsticker--treeview-get-selected-item)))
1371 (unless (eq (newsticker--age item) 'obsolete)
1372 (newsticker--treeview-mark-item item 'old)))
1373 (unless dont-proceed
1374 (newsticker-treeview-next-item)))
1376 (defun newsticker-treeview-toggle-item-immortal ()
1377 "Toggle immortality of current item."
1378 (interactive)
1379 (let* ((item (newsticker--treeview-get-selected-item))
1380 (new-age (if (eq (newsticker--age item) 'immortal)
1381 'old
1382 'immortal)))
1383 (newsticker--treeview-mark-item item new-age)
1384 (newsticker-treeview-next-item)))
1386 (defun newsticker--treeview-mark-item (item new-age)
1387 "Mark ITEM with NEW-AGE."
1388 (when item
1389 (setcar (nthcdr 4 item) new-age)
1390 ;; clean up ticker FIXME
1392 (newsticker--cache-save-feed
1393 (newsticker--cache-get-feed (intern newsticker--treeview-current-feed)))
1394 (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree))
1396 (defun newsticker-treeview-mark-list-items-old ()
1397 "Mark all listed items as old."
1398 (interactive)
1399 (let ((current-feed (or newsticker--treeview-current-feed
1400 newsticker--treeview-current-vfeed)))
1401 (with-current-buffer (newsticker--treeview-list-buffer)
1402 (goto-char (point-min))
1403 (while (not (eobp))
1404 (let ((item (get-text-property (point) :nt-item)))
1405 (unless (memq (newsticker--age item) '(immortal obsolete))
1406 (newsticker--treeview-mark-item item 'old)))
1407 (forward-line 1)))
1408 (newsticker--treeview-tree-update-tags)
1409 (if current-feed
1410 (newsticker-treeview-jump current-feed))))
1412 (defun newsticker-treeview-save-item ()
1413 "Save current item."
1414 (interactive)
1415 (newsticker-save-item (or newsticker--treeview-current-feed
1416 newsticker--treeview-current-vfeed)
1417 (newsticker--treeview-get-selected-item)))
1419 (defun newsticker-treeview-browse-url-item ()
1420 "Convert current item to HTML and call `browse-url' on result."
1421 (interactive)
1422 (newsticker-browse-url-item (or newsticker--treeview-current-feed
1423 newsticker--treeview-current-vfeed)
1424 (newsticker--treeview-get-selected-item)))
1426 (defun newsticker--treeview-set-current-node (node)
1427 "Make NODE the current node."
1428 (with-current-buffer (newsticker--treeview-tree-buffer)
1429 (setq newsticker--treeview-current-node-id
1430 (widget-get node :nt-id))
1431 (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
1432 (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
1433 (newsticker--treeview-tree-update-highlight)))
1435 (defun newsticker--treeview-get-first-child (node)
1436 "Get first child of NODE."
1437 (let ((children (widget-get node :children)))
1438 (if children
1439 (car children)
1440 nil)))
1442 (defun newsticker--treeview-get-second-child (node)
1443 "Get scond child of NODE."
1444 (let ((children (widget-get node :children)))
1445 (if children
1446 (car (cdr children))
1447 nil)))
1449 (defun newsticker--treeview-get-last-child (node)
1450 "Get last child of NODE."
1451 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1452 (let ((children (widget-get node :children)))
1453 (if children
1454 (car (reverse children))
1455 nil)))
1457 (defun newsticker--treeview-get-feed-vfeed (node)
1458 "Get (virtual) feed of NODE."
1459 (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
1461 (defun newsticker--treeview-get-next-sibling (node)
1462 "Get next sibling of NODE."
1463 (let ((parent (widget-get node :parent)))
1464 (catch 'found
1465 (let ((children (widget-get parent :children)))
1466 (while children
1467 (if (newsticker--treeview-nodes-eq (car children) node)
1468 (throw 'found (car (cdr children))))
1469 (setq children (cdr children)))))))
1471 (defun newsticker--treeview-get-prev-sibling (node)
1472 "Get previous sibling of NODE."
1473 (let ((parent (widget-get node :parent)))
1474 (catch 'found
1475 (let ((children (widget-get parent :children))
1476 (prev nil))
1477 (while children
1478 (if (and (newsticker--treeview-nodes-eq (car children) node)
1479 (widget-get prev :nt-id))
1480 (throw 'found prev))
1481 (setq prev (car children))
1482 (setq children (cdr children)))))))
1484 (defun newsticker--treeview-get-next-uncle (node)
1485 "Get next uncle of NODE, i.e. parent's next sibling."
1486 (let* ((parent (widget-get node :parent))
1487 (grand-parent (widget-get parent :parent)))
1488 (catch 'found
1489 (let ((uncles (widget-get grand-parent :children)))
1490 (while uncles
1491 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1492 (throw 'found (car (cdr uncles))))
1493 (setq uncles (cdr uncles)))))))
1495 (defun newsticker--treeview-get-prev-uncle (node)
1496 "Get previous uncle of NODE, i.e. parent's previous sibling."
1497 (let* ((parent (widget-get node :parent))
1498 (grand-parent (widget-get parent :parent)))
1499 (catch 'found
1500 (let ((uncles (widget-get grand-parent :children))
1501 (prev nil))
1502 (while uncles
1503 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1504 (throw 'found prev))
1505 (setq prev (car uncles))
1506 (setq uncles (cdr uncles)))))))
1508 (defun newsticker--treeview-get-other-tree ()
1509 "Get other tree."
1510 (if (and (newsticker--treeview-get-current-node)
1511 (widget-get (newsticker--treeview-get-current-node) :nt-feed))
1512 newsticker--treeview-vfeed-tree
1513 newsticker--treeview-feed-tree))
1515 (defun newsticker--treeview-activate-node (node &optional backward)
1516 "Activate NODE.
1517 If NODE is a tree widget the node's first subnode is activated.
1518 If BACKWARD is non-nil the last subnode of the previous sibling
1519 is activated."
1520 (newsticker--treeview-set-current-node node)
1521 (save-current-buffer
1522 (set-buffer (newsticker--treeview-tree-buffer))
1523 (cond ((eq (widget-type node) 'tree-widget)
1524 (unless (widget-get node :open)
1525 (widget-put node :open nil)
1526 (widget-apply-action node))
1527 (newsticker--treeview-activate-node
1528 (if backward
1529 (newsticker--treeview-get-last-child node)
1530 (newsticker--treeview-get-second-child node))))
1531 (node
1532 (widget-apply-action node)))))
1534 (defun newsticker--treeview-first-feed ()
1535 "Jump to the depth-first feed in the `newsticker-groups' tree."
1536 (newsticker-treeview-jump
1537 (car (reverse (newsticker--group-get-feeds newsticker-groups t)))))
1539 (defun newsticker-treeview-next-feed (&optional stay-in-tree)
1540 "Move to next feed.
1541 Optional argument STAY-IN-TREE prevents moving from real feed
1542 tree to virtual feed tree or vice versa.
1543 Return t if a new feed was activated, nil otherwise."
1544 (interactive)
1545 (newsticker--treeview-restore-layout)
1546 (let ((cur (newsticker--treeview-get-current-node))
1547 (new nil))
1548 (setq new
1549 (if cur
1550 (or (newsticker--treeview-get-next-sibling cur)
1551 (newsticker--treeview-get-next-uncle cur)
1552 (and (not stay-in-tree)
1553 (newsticker--treeview-get-other-tree)))
1554 (car (widget-get newsticker--treeview-feed-tree :children))))
1555 (if new
1556 (progn
1557 (newsticker--treeview-activate-node new)
1558 (newsticker--treeview-tree-update-highlight)
1559 (not (eq new cur)))
1560 nil)))
1562 (defun newsticker-treeview-prev-feed (&optional stay-in-tree)
1563 "Move to previous feed.
1564 Optional argument STAY-IN-TREE prevents moving from real feed
1565 tree to virtual feed tree or vice versa.
1566 Return t if a new feed was activated, nil otherwise."
1567 (interactive)
1568 (newsticker--treeview-restore-layout)
1569 (let ((cur (newsticker--treeview-get-current-node))
1570 (new nil))
1571 (if cur
1572 (progn
1573 (setq new
1574 (if cur
1575 (or (newsticker--treeview-get-prev-sibling cur)
1576 (newsticker--treeview-get-prev-uncle cur)
1577 (and (not stay-in-tree)
1578 (newsticker--treeview-get-other-tree)))
1579 (car (widget-get newsticker--treeview-feed-tree :children))))
1580 (if new
1581 (progn
1582 (newsticker--treeview-activate-node new t)
1583 (newsticker--treeview-tree-update-highlight)
1584 (not (eq new cur)))
1585 nil))
1586 nil)))
1588 (defun newsticker-treeview-next-page ()
1589 "Scroll item buffer."
1590 (interactive)
1591 (save-selected-window
1592 (select-window (newsticker--treeview-item-window) t)
1593 (condition-case nil
1594 (scroll-up nil)
1595 (error
1596 (goto-char (point-min))))))
1599 (defun newsticker--treeview-unfold-node (feed-name)
1600 "Recursively show subtree above the node that represents FEED-NAME."
1601 (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
1602 (unless node
1603 (let* ((group-name (car (newsticker--group-find-parent-group
1604 feed-name))))
1605 (newsticker--treeview-unfold-node group-name))
1606 (setq node (newsticker--treeview-get-node-of-feed feed-name)))
1607 (when node
1608 (with-current-buffer (newsticker--treeview-tree-buffer)
1609 (widget-put node :nt-selected t)
1610 (widget-apply-action node)
1611 (newsticker--treeview-set-current-node node)))))
1613 (defun newsticker-treeview-jump (feed-name)
1614 "Jump to feed FEED-NAME in newsticker treeview."
1615 (interactive
1616 (list (let ((completion-ignore-case t))
1617 (completing-read
1618 "Jump to feed: "
1619 (append '("new" "obsolete" "immortal" "all")
1620 (mapcar 'car (append newsticker-url-list
1621 newsticker-url-list-defaults)))
1622 nil t))))
1623 (newsticker--treeview-unfold-node feed-name))
1625 ;; ======================================================================
1626 ;;; Groups
1627 ;; ======================================================================
1628 (defun newsticker--group-do-find-group (feed-or-group-name parent-node node)
1629 "Recursively find FEED-OR-GROUP-NAME in PARENT-NODE or NODE."
1630 (cond ((stringp node)
1631 (when (string= feed-or-group-name node)
1632 (throw 'found parent-node)))
1633 ((listp node)
1634 (cond ((string= feed-or-group-name (car node))
1635 (throw 'found parent-node))
1636 ((member feed-or-group-name (cdr node))
1637 (throw 'found node))
1639 (mapc (lambda (n)
1640 (if (listp n)
1641 (newsticker--group-do-find-group
1642 feed-or-group-name node n)))
1643 (cdr node)))))))
1645 (defun newsticker--group-find-parent-group (feed-or-group-name)
1646 "Find group containing FEED-OR-GROUP-NAME."
1647 (catch 'found
1648 (mapc (lambda (n)
1649 (newsticker--group-do-find-group feed-or-group-name
1650 newsticker-groups
1652 newsticker-groups)
1653 nil))
1655 (defun newsticker--group-do-get-group (name node)
1656 "Recursively find group with NAME below NODE."
1657 (if (string= name (car node))
1658 (throw 'found node)
1659 (mapc (lambda (n)
1660 (if (listp n)
1661 (newsticker--group-do-get-group name n)))
1662 (cdr node))))
1664 (defun newsticker--group-get-group (name)
1665 "Find group with NAME."
1666 (catch 'found
1667 (mapc (lambda (n)
1668 (if (listp n)
1669 (newsticker--group-do-get-group name n)))
1670 newsticker-groups)
1671 nil))
1673 (defun newsticker--group-get-subgroups (group &optional recursive)
1674 "Return list of subgroups for GROUP.
1675 If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1676 (let ((result nil))
1677 (mapc (lambda (n)
1678 (when (listp n)
1679 (setq result (cons (car n) result))
1680 (let ((subgroups (newsticker--group-get-subgroups n recursive)))
1681 (when subgroups
1682 (setq result (append subgroups result))))))
1683 group)
1684 result))
1686 (defun newsticker--group-all-groups ()
1687 "Return nested list of all groups."
1688 (newsticker--group-get-subgroups newsticker-groups t))
1690 (defun newsticker--group-get-feeds (group &optional recursive)
1691 "Return list of all feeds in GROUP.
1692 If RECURSIVE is non-nil recursively get feeds of subgroups and
1693 return a nested list."
1694 (let ((result nil))
1695 (mapc (lambda (n)
1696 (if (not (listp n))
1697 (setq result (cons n result))
1698 (if recursive
1699 (let ((subfeeds (newsticker--group-get-feeds n t)))
1700 (when subfeeds
1701 (setq result (append subfeeds result)))))))
1702 (cdr group))
1703 result))
1705 (defun newsticker-group-add-group (name parent)
1706 "Add group NAME to group PARENT."
1707 (interactive
1708 (list (read-string "Name of new group: ")
1709 (let ((completion-ignore-case t))
1710 (completing-read "Name of parent group (optional): " (newsticker--group-all-groups)
1711 nil t))))
1712 (if (newsticker--group-get-group name)
1713 (error "Group %s exists already" name))
1714 (let ((p (if (and parent (not (string= parent "")))
1715 (newsticker--group-get-group parent)
1716 newsticker-groups)))
1717 (unless p
1718 (error "Parent %s does not exist" parent))
1719 (setcdr p (cons (list name) (cdr p))))
1720 (newsticker--treeview-tree-update)
1721 (newsticker-treeview-jump newsticker--treeview-current-feed))
1723 (defun newsticker-group-delete-group (name)
1724 "Delete group NAME."
1725 (interactive
1726 (list (let ((completion-ignore-case t))
1727 (completing-read "Delete group: "
1728 (newsticker--group-names)
1729 nil t (car (newsticker--group-find-parent-group
1730 newsticker--treeview-current-feed))))))
1731 (let ((parent-group (newsticker--group-find-parent-group name)))
1732 (unless parent-group
1733 (error "Parent %s does not exist" parent-group))
1734 (setcdr parent-group (cl-delete-if (lambda (g)
1735 (and (listp g)
1736 (string= name (car g))))
1737 (cdr parent-group)))
1738 (newsticker--group-manage-orphan-feeds)
1739 (newsticker--treeview-tree-update)
1740 (newsticker-treeview-update)
1741 (newsticker-treeview-jump newsticker--treeview-current-feed)))
1743 (defun newsticker--group-do-rename-group (old-name new-name)
1744 "Actually rename group OLD-NAME to NEW-NAME."
1745 (let ((parent-group (newsticker--group-find-parent-group old-name)))
1746 (unless parent-group
1747 (error "Parent of %s does not exist" old-name))
1748 (mapcar (lambda (elt)
1749 (cond ((and (listp elt)
1750 (string= old-name (car elt)))
1751 (cons new-name (cdr elt)))
1753 elt))) parent-group)))
1755 (defun newsticker-group-rename-group (old-name new-name)
1756 "Rename group OLD-NAME to NEW-NAME."
1757 (interactive
1758 (list (let* ((completion-ignore-case t))
1759 (completing-read "Rename group: "
1760 (newsticker--group-names)
1761 nil t (car (newsticker--group-find-parent-group
1762 newsticker--treeview-current-feed))))
1763 (read-string "Rename to: ")))
1764 (setq newsticker-groups (newsticker--group-do-rename-group old-name new-name))
1765 (newsticker--group-manage-orphan-feeds)
1766 (newsticker--treeview-tree-update)
1767 (newsticker-treeview-update)
1768 (newsticker-treeview-jump newsticker--treeview-current-feed))
1770 (defun newsticker--get-group-names (lst)
1771 "Do get the group names from LST."
1772 (delete nil (cons (car lst)
1773 (apply 'append
1774 (mapcar (lambda (e)
1775 (cond ((listp e)
1776 (newsticker--get-group-names e))
1778 nil)))
1779 (cdr lst))))))
1781 (defun newsticker--group-names ()
1782 "Get names of all newsticker groups."
1783 (newsticker--get-group-names newsticker-groups))
1785 (defun newsticker-group-move-feed (name group-name &optional no-update)
1786 "Move feed NAME to group GROUP-NAME.
1787 Update treeview afterwards unless NO-UPDATE is non-nil."
1788 (interactive
1789 (let ((completion-ignore-case t))
1790 (list (completing-read "Name of feed or group to move: "
1791 (append (mapcar 'car newsticker-url-list)
1792 (newsticker--group-names))
1793 nil t newsticker--treeview-current-feed)
1794 (completing-read "Name of new parent group: " (newsticker--group-names)
1795 nil t))))
1796 (let* ((group (if (and group-name (not (string= group-name "")))
1797 (newsticker--group-get-group group-name)
1798 newsticker-groups))
1799 (moving-group-p (member name (newsticker--group-names)))
1800 (moved-thing (if moving-group-p
1801 (newsticker--group-get-group name)
1802 name)))
1803 (unless group
1804 (error "Group %s does not exist" group-name))
1805 (while (let ((old-group
1806 (newsticker--group-find-parent-group name)))
1807 (when old-group
1808 (delete moved-thing old-group))
1809 old-group))
1810 (setcdr group (cons moved-thing (cdr group)))
1811 (unless no-update
1812 (newsticker--treeview-tree-update)
1813 (newsticker-treeview-update)
1814 (newsticker-treeview-jump name))))
1816 (defun newsticker-group-shift-feed-down ()
1817 "Shift current feed down in its group."
1818 (interactive)
1819 (newsticker--group-shift 1))
1821 (defun newsticker-group-shift-feed-up ()
1822 "Shift current feed down in its group."
1823 (interactive)
1824 (newsticker--group-shift -1))
1826 (defun newsticker-group-shift-group-down ()
1827 "Shift current group down in its group."
1828 (interactive)
1829 (newsticker--group-shift 1 t))
1831 (defun newsticker-group-shift-group-up ()
1832 "Shift current group down in its group."
1833 (interactive)
1834 (newsticker--group-shift -1 t))
1836 (defun newsticker--group-shift (delta &optional move-group)
1837 "Shift current feed or group within its parent group.
1838 DELTA is an integer which specifies the direction and the amount
1839 of the shift. If MOVE-GROUP is nil the currently selected feed
1840 `newsticker--treeview-current-feed' is shifted, if it is t then
1841 the current feed's parent group is shifted.."
1842 (let* ((cur-feed newsticker--treeview-current-feed)
1843 (thing (if move-group
1844 (newsticker--group-find-parent-group cur-feed)
1845 cur-feed))
1846 (parent-group (newsticker--group-find-parent-group
1847 (if move-group (car thing) thing))))
1848 (unless parent-group
1849 (error "Group not found!"))
1850 (let* ((siblings (cdr parent-group))
1851 (pos (cl-position thing siblings :test 'equal))
1852 (tpos (+ pos delta ))
1853 (new-pos (max 0 (min (length siblings) tpos)))
1854 (beg (cl-subseq siblings 0 (min pos new-pos)))
1855 (end (cl-subseq siblings (+ 1 (max pos new-pos))))
1856 (p (elt siblings new-pos)))
1857 (when (not (= pos new-pos))
1858 (setcdr parent-group
1859 (cl-concatenate 'list
1861 (if (> delta 0)
1862 (list p thing)
1863 (list thing p))
1864 end))
1865 (newsticker--treeview-tree-update)
1866 (newsticker-treeview-update)
1867 (newsticker-treeview-jump cur-feed)))))
1869 (defun newsticker--count-groups (group)
1870 "Recursively count number of subgroups of GROUP."
1871 (let ((result 1))
1872 (mapc (lambda (g)
1873 (if (listp g)
1874 (setq result (+ result (newsticker--count-groups g)))))
1875 (cdr group))
1876 result))
1878 (defun newsticker--count-grouped-feeds (group)
1879 "Recursively count number of feeds in GROUP and its subgroups."
1880 (let ((result 0))
1881 (mapc (lambda (g)
1882 (if (listp g)
1883 (setq result (+ result (newsticker--count-grouped-feeds g)))
1884 (setq result (1+ result))))
1885 (cdr group))
1886 result))
1888 (defun newsticker--group-remove-obsolete-feeds (group)
1889 "Recursively remove obsolete feeds from GROUP."
1890 (let ((result nil)
1891 (urls (append newsticker-url-list newsticker-url-list-defaults)))
1892 (mapc (lambda (g)
1893 (if (listp g)
1894 (let ((sub-groups
1895 (newsticker--group-remove-obsolete-feeds g)))
1896 (if sub-groups
1897 (setq result (cons sub-groups result))))
1898 (if (assoc g urls)
1899 (setq result (cons g result)))))
1900 (cdr group))
1901 (if result
1902 (cons (car group) (reverse result))
1903 result)))
1905 (defun newsticker--group-manage-orphan-feeds ()
1906 "Put unmanaged feeds into `newsticker-groups'.
1907 Remove obsolete feeds as well.
1908 Return t if groups have changed, nil otherwise."
1909 (unless newsticker-groups
1910 (setq newsticker-groups '("Feeds")))
1911 (let ((new-feed nil)
1912 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
1913 (mapc (lambda (f)
1914 (unless (newsticker--group-find-parent-group (car f))
1915 (setq new-feed t)
1916 (newsticker-group-move-feed (car f) nil t)))
1917 (append newsticker-url-list-defaults newsticker-url-list))
1918 (setq newsticker-groups
1919 (newsticker--group-remove-obsolete-feeds newsticker-groups))
1920 (or new-feed
1921 (not (= grouped-feeds
1922 (newsticker--count-grouped-feeds newsticker-groups))))))
1924 ;; ======================================================================
1925 ;;; Modes
1926 ;; ======================================================================
1927 (defun newsticker--treeview-create-groups-menu (group-list
1928 excluded-group)
1929 "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
1930 (let ((menu (make-sparse-keymap (if (stringp (car group-list))
1931 (car group-list)
1932 "Move to group..."))))
1933 (mapc (lambda (g)
1934 (when (listp g)
1935 (let ((title (if (stringp (car g))
1936 (car g)
1937 "Move to group...")))
1938 (unless (eq g excluded-group)
1939 (define-key menu (vector (intern title))
1940 (list 'menu-item title
1941 (newsticker--treeview-create-groups-menu
1942 (cdr g) excluded-group)))))))
1943 (reverse group-list))
1944 menu))
1946 (defun newsticker--treeview-create-tree-menu (feed-name)
1947 "Create tree menu for FEED-NAME."
1948 (let ((menu (make-sparse-keymap feed-name)))
1949 (define-key menu [newsticker-treeview-mark-list-items-old]
1950 (list 'menu-item "Mark all items old"
1951 'newsticker-treeview-mark-list-items-old))
1952 (define-key menu [move]
1953 (list 'menu-item "Move to group..."
1954 (newsticker--treeview-create-groups-menu
1955 newsticker-groups
1956 (newsticker--group-get-group feed-name))))
1957 menu))
1959 (defvar newsticker-treeview-list-menu
1960 (let ((menu (make-sparse-keymap "Newsticker List")))
1961 (define-key menu [newsticker-treeview-mark-list-items-old]
1962 (list 'menu-item "Mark all items old"
1963 'newsticker-treeview-mark-list-items-old))
1964 (define-key menu [newsticker-treeview-mark-item-old]
1965 (list 'menu-item "Mark current item old"
1966 'newsticker-treeview-mark-item-old))
1967 (define-key menu [newsticker-treeview-toggle-item-immortal]
1968 (list 'menu-item "Mark current item immortal (toggle)"
1969 'newsticker-treeview-toggle-item-immortal))
1970 (define-key menu [newsticker-treeview-get-news]
1971 (list 'menu-item "Get news for current feed"
1972 'newsticker-treeview-get-news))
1973 menu)
1974 "Map for newsticker list menu.")
1976 (defvar newsticker-treeview-item-menu
1977 (let ((menu (make-sparse-keymap "Newsticker Item")))
1978 (define-key menu [newsticker-treeview-mark-item-old]
1979 (list 'menu-item "Mark current item old"
1980 'newsticker-treeview-mark-item-old))
1981 (define-key menu [newsticker-treeview-toggle-item-immortal]
1982 (list 'menu-item "Mark current item immortal (toggle)"
1983 'newsticker-treeview-toggle-item-immortal))
1984 (define-key menu [newsticker-treeview-get-news]
1985 (list 'menu-item "Get news for current feed"
1986 'newsticker-treeview-get-news))
1987 menu)
1988 "Map for newsticker item menu.")
1990 (defvar newsticker-treeview-mode-map
1991 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
1992 (define-key map " " 'newsticker-treeview-next-page)
1993 (define-key map "a" 'newsticker-add-url)
1994 (define-key map "b" 'newsticker-treeview-browse-url-item)
1995 (define-key map "F" 'newsticker-treeview-prev-feed)
1996 (define-key map "f" 'newsticker-treeview-next-feed)
1997 (define-key map "g" 'newsticker-treeview-get-news)
1998 (define-key map "G" 'newsticker-get-all-news)
1999 (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
2000 (define-key map "j" 'newsticker-treeview-jump)
2001 (define-key map "n" 'newsticker-treeview-next-item)
2002 (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
2003 (define-key map "O" 'newsticker-treeview-mark-list-items-old)
2004 (define-key map "o" 'newsticker-treeview-mark-item-old)
2005 (define-key map "p" 'newsticker-treeview-prev-item)
2006 (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
2007 (define-key map "q" 'newsticker-treeview-quit)
2008 (define-key map "S" 'newsticker-treeview-save-item)
2009 (define-key map "s" 'newsticker-treeview-save)
2010 (define-key map "u" 'newsticker-treeview-update)
2011 (define-key map "v" 'newsticker-treeview-browse-url)
2012 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
2013 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
2014 (define-key map "\M-m" 'newsticker-group-move-feed)
2015 (define-key map "\M-a" 'newsticker-group-add-group)
2016 (define-key map "\M-d" 'newsticker-group-delete-group)
2017 (define-key map "\M-r" 'newsticker-group-rename-group)
2018 (define-key map [M-down] 'newsticker-group-shift-feed-down)
2019 (define-key map [M-up] 'newsticker-group-shift-feed-up)
2020 (define-key map [M-S-down] 'newsticker-group-shift-group-down)
2021 (define-key map [M-S-up] 'newsticker-group-shift-group-up)
2022 map)
2023 "Mode map for newsticker treeview.")
2025 (define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV"
2026 "Major mode for Newsticker Treeview.
2027 \\{newsticker-treeview-mode-map}"
2028 (if (boundp 'tool-bar-map)
2029 (set (make-local-variable 'tool-bar-map)
2030 newsticker-treeview-tool-bar-map))
2031 (setq buffer-read-only t
2032 truncate-lines t))
2034 (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
2035 "Item List"
2036 (let ((header (concat
2037 (propertize " " 'display '(space :align-to 0))
2038 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
2039 (propertize " " 'display '(space :align-to 2))
2040 (if newsticker--treeview-list-show-feed
2041 (concat "Feed"
2042 (propertize " " 'display '(space :align-to 12)))
2044 (newsticker-treeview-list-make-sort-button "Date"
2045 'sort-by-time)
2046 (if newsticker--treeview-list-show-feed
2047 (propertize " " 'display '(space :align-to 28))
2048 (propertize " " 'display '(space :align-to 18)))
2049 (newsticker-treeview-list-make-sort-button "Title"
2050 'sort-by-title))))
2051 (setq header-line-format header))
2052 (define-key newsticker-treeview-list-mode-map [down-mouse-3]
2053 newsticker-treeview-list-menu))
2055 (define-derived-mode newsticker-treeview-item-mode newsticker-treeview-mode
2056 "Item"
2057 (define-key newsticker-treeview-item-mode-map [down-mouse-3]
2058 newsticker-treeview-item-menu))
2060 (defun newsticker-treeview-tree-click (event)
2061 "Handle click EVENT on a tag in the newsticker tree."
2062 (interactive "e")
2063 (newsticker--treeview-restore-layout)
2064 (save-excursion
2065 (switch-to-buffer (window-buffer (posn-window (event-end event))))
2066 (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
2068 (defun newsticker-treeview-tree-do-click (&optional pos event)
2069 "Actually handle click event.
2070 POS gives the position where EVENT occurred."
2071 (interactive)
2072 (let* ((pos (or pos (point)))
2073 (nt-id (get-text-property pos :nt-id))
2074 (item (get-text-property pos :nt-item)))
2075 (cond (item
2076 ;; click in list buffer
2077 (newsticker-treeview-show-item))
2079 ;; click in tree buffer
2080 (let ((w (newsticker--treeview-get-node-by-id nt-id)))
2081 (when w
2082 (newsticker--treeview-tree-update-tag w t t)
2083 (setq w (newsticker--treeview-get-node-by-id nt-id))
2084 (widget-put w :nt-selected t)
2085 (widget-apply w :action event)
2086 (newsticker--treeview-set-current-node w))))))
2087 (newsticker--treeview-tree-update-highlight))
2089 (defun newsticker--treeview-restore-layout ()
2090 "Restore treeview buffers."
2091 (catch 'error
2092 (dotimes (i 3)
2093 (let ((win (nth i newsticker--treeview-windows))
2094 (buf (nth i newsticker--treeview-buffers)))
2095 (unless (window-live-p win)
2096 (newsticker--treeview-window-init)
2097 (newsticker--treeview-buffer-init)
2098 (throw 'error t))
2099 (unless (eq (window-buffer win) buf)
2100 (set-window-buffer win buf t))))))
2102 (defun newsticker--treeview-frame-init ()
2103 "Initialize treeview frame."
2104 (when newsticker-treeview-own-frame
2105 (unless (and newsticker--frame (frame-live-p newsticker--frame))
2106 (setq newsticker--frame (make-frame '((name . "Newsticker")))))
2107 (select-frame-set-input-focus newsticker--frame)
2108 (raise-frame newsticker--frame)))
2110 (defun newsticker--treeview-window-init ()
2111 "Initialize treeview windows."
2112 (setq newsticker--saved-window-config (current-window-configuration))
2113 (setq newsticker--treeview-windows nil)
2114 (setq newsticker--treeview-buffers nil)
2115 (delete-other-windows)
2116 (split-window-right newsticker-treeview-treewindow-width)
2117 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2118 (other-window 1)
2119 (split-window-below newsticker-treeview-listwindow-height)
2120 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2121 (other-window 1)
2122 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2123 (other-window 1))
2125 ;;;###autoload
2126 (defun newsticker-treeview ()
2127 "Start newsticker treeview."
2128 (interactive)
2129 (newsticker--treeview-load)
2130 (setq newsticker--sentinel-callback 'newsticker-treeview-update)
2131 (newsticker--treeview-frame-init)
2132 (newsticker--treeview-window-init)
2133 (newsticker--treeview-buffer-init)
2134 (if (newsticker--group-manage-orphan-feeds)
2135 (newsticker--treeview-tree-update))
2136 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
2137 (newsticker-start t) ;; will start only if not running
2138 (newsticker-treeview-update)
2139 (newsticker--treeview-item-show-text
2140 "Newsticker"
2141 "Welcome to newsticker!"))
2143 (defun newsticker-treeview-get-news ()
2144 "Get news for current feed."
2145 (interactive)
2146 (when newsticker--treeview-current-feed
2147 (newsticker-get-news newsticker--treeview-current-feed)))
2149 (provide 'newst-treeview)
2151 ;;; newst-treeview.el ends here