Update copyright year to 2015
[emacs.git] / lisp / net / newst-treeview.el
bloba9647501b487ca508ec10e3d7e64a1d5056bf04a
1 ;;; newst-treeview.el --- Treeview frontend for newsticker.
3 ;; Copyright (C) 2008-2015 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 "25.1"
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
136 "Name of the newsticker groups settings file. This variable is obsolete."
137 :version "25.1" ; changed default value to nil
138 :type 'string
139 :group 'newsticker-treeview)
140 (make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
142 ;; ======================================================================
143 ;;; internal variables
144 ;; ======================================================================
145 (defvar newsticker--treeview-windows nil)
146 (defvar newsticker--treeview-buffers nil)
147 (defvar newsticker--treeview-current-feed nil
148 "Feed name of currently shown item.")
149 (defvar newsticker--treeview-current-vfeed nil)
150 (defvar newsticker--treeview-list-show-feed nil)
151 (defvar newsticker--saved-window-config nil)
152 (defvar newsticker--selection-overlay nil
153 "Highlight the selected tree node.")
154 (defvar newsticker--tree-selection-overlay nil
155 "Highlight the selected list item.")
156 (defvar newsticker--frame nil "Special frame for newsticker windows.")
157 (defvar newsticker--treeview-list-sort-order 'sort-by-time)
158 (defvar newsticker--treeview-current-node-id nil)
159 (defvar newsticker--treeview-current-tree nil)
160 (defvar newsticker--treeview-feed-tree nil)
161 (defvar newsticker--treeview-vfeed-tree nil)
163 ;; maps for the clickable portions
164 (defvar newsticker--treeview-url-keymap
165 (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
166 (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
167 (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
168 (define-key map "\n" 'newsticker-treeview-browse-url)
169 (define-key map "\C-m" 'newsticker-treeview-browse-url)
170 (define-key map [(control return)] 'newsticker-handle-url)
171 map)
172 "Key map for click-able headings in the newsticker treeview buffers.")
175 ;; ======================================================================
176 ;;; short cuts
177 ;; ======================================================================
178 (defsubst newsticker--treeview-tree-buffer ()
179 "Return the tree buffer of the newsticker treeview."
180 (nth 0 newsticker--treeview-buffers))
181 (defsubst newsticker--treeview-list-buffer ()
182 "Return the list buffer of the newsticker treeview."
183 (nth 1 newsticker--treeview-buffers))
184 (defsubst newsticker--treeview-item-buffer ()
185 "Return the item buffer of the newsticker treeview."
186 (nth 2 newsticker--treeview-buffers))
187 (defsubst newsticker--treeview-tree-window ()
188 "Return the tree window of the newsticker treeview."
189 (nth 0 newsticker--treeview-windows))
190 (defsubst newsticker--treeview-list-window ()
191 "Return the list window of the newsticker treeview."
192 (nth 1 newsticker--treeview-windows))
193 (defsubst newsticker--treeview-item-window ()
194 "Return the item window of the newsticker treeview."
195 (nth 2 newsticker--treeview-windows))
197 ;; ======================================================================
198 ;;; utility functions
199 ;; ======================================================================
200 (defun newsticker--treeview-get-id (parent i)
201 "Create an id for a newsticker treeview node.
202 PARENT is the node's parent, I is an integer."
203 ;;(message "newsticker--treeview-get-id %s"
204 ;; (format "%s-%d" (widget-get parent :nt-id) i))
205 (format "%s-%d" (widget-get parent :nt-id) i))
207 (defun newsticker--treeview-ids-eq (id1 id2)
208 "Return non-nil if ids ID1 and ID2 are equal."
209 ;;(message "%s/%s" (or id1 -1) (or id2 -1))
210 (and id1 id2 (string= id1 id2)))
212 (defun newsticker--treeview-nodes-eq (node1 node2)
213 "Compare treeview nodes NODE1 and NODE2 for equality.
214 Nodes are equal if the have the same newsticker-id. Note that
215 during re-tagging and collapsing/expanding nodes change, while
216 their id stays constant."
217 (let ((id1 (widget-get node1 :nt-id))
218 (id2 (widget-get node2 :nt-id)))
219 ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
220 ;; (or id1 -1) (or id2 -1))
221 (or (newsticker--treeview-ids-eq id1 id2)
222 (string= (widget-get node1 :tag) (widget-get node2 :tag)))))
224 (defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
225 "Recursively search node for feed FEED-NAME starting from STARTNODE."
226 ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
227 (if (string= feed-name (or (widget-get startnode :nt-feed)
228 (widget-get startnode :nt-vfeed)))
229 (throw 'found startnode)
230 (let ((children (widget-get startnode :children)))
231 (dolist (w children)
232 (newsticker--treeview-do-get-node-of-feed feed-name w)))))
234 (defun newsticker--treeview-get-node-of-feed (feed-name)
235 "Return node for feed FEED-NAME in newsticker treeview tree."
236 (catch 'found
237 (newsticker--treeview-do-get-node-of-feed feed-name
238 newsticker--treeview-feed-tree)
239 (newsticker--treeview-do-get-node-of-feed feed-name
240 newsticker--treeview-vfeed-tree)))
242 (defun newsticker--treeview-do-get-node-by-id (id startnode)
243 "Recursively search node with ID starting from STARTNODE."
244 (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
245 (throw 'found startnode)
246 (let ((children (widget-get startnode :children)))
247 (dolist (w children)
248 (newsticker--treeview-do-get-node-by-id id w)))))
250 (defun newsticker--treeview-get-node-by-id (id)
251 "Return node with ID in newsticker treeview tree."
252 (catch 'found
253 (newsticker--treeview-do-get-node-by-id id newsticker--treeview-feed-tree)
254 (newsticker--treeview-do-get-node-by-id id newsticker--treeview-vfeed-tree)))
256 (defun newsticker--treeview-get-current-node ()
257 "Return current node in newsticker treeview tree."
258 (newsticker--treeview-get-node-by-id newsticker--treeview-current-node-id))
260 ;; ======================================================================
262 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
263 (declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
265 (defun newsticker--treeview-render-text (start end)
266 "Render text between markers START and END."
267 (if newsticker-html-renderer
268 (condition-case error-data
269 (save-excursion
270 (set-marker-insertion-type end t)
271 ;; check whether it is necessary to call html renderer
272 ;; (regexp inspired by htmlr.el)
273 (goto-char start)
274 (when (re-search-forward
275 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
276 ;; (message "%s" (newsticker--title item))
277 (let ((w3m-fill-column (if newsticker-use-full-width
278 -1 fill-column))
279 (w3-maximum-line-length
280 (if newsticker-use-full-width nil fill-column)))
281 (save-excursion
282 (funcall newsticker-html-renderer start end)))
283 ;;(cond ((eq newsticker-html-renderer 'w3m-region)
284 ;; (add-text-properties start end (list 'keymap
285 ;; w3m-minor-mode-map)))
286 ;;((eq newsticker-html-renderer 'w3-region)
287 ;;(add-text-properties start end (list 'keymap w3-mode-map))))
288 (if (eq newsticker-html-renderer 'w3m-region)
289 (w3m-toggle-inline-images t))
291 (error
292 (message "Error: HTML rendering failed: %s, %s"
293 (car error-data) (cdr error-data))
294 nil))
295 nil))
297 ;; ======================================================================
298 ;;; List window
299 ;; ======================================================================
300 (defun newsticker--treeview-list-add-item (item feed &optional show-feed)
301 "Add news ITEM for FEED to newsticker treeview list window.
302 If string SHOW-FEED is non-nil it is shown in the item string."
303 (setq newsticker--treeview-list-show-feed show-feed)
304 (with-current-buffer (newsticker--treeview-list-buffer)
305 (let* ((inhibit-read-only t)
306 pos1 pos2)
307 (goto-char (point-max))
308 (setq pos1 (point-marker))
309 (insert " ")
310 (insert (propertize " " 'display '(space :align-to 2)))
311 (insert (if show-feed
312 (concat
313 (substring
314 (format "%-10s" (newsticker--real-feed-name
315 feed))
316 0 10)
317 (propertize " " 'display '(space :align-to 12)))
318 ""))
319 (insert (format-time-string newsticker-treeview-date-format
320 (newsticker--time item)))
321 (insert (propertize " " 'display
322 (list 'space :align-to (if show-feed 28 18))))
323 (setq pos2 (point-marker))
324 (insert (newsticker--title item))
325 (insert "\n")
326 (newsticker--treeview-render-text pos2 (point-marker))
327 (goto-char pos2)
328 (while (search-forward "\n" nil t)
329 (replace-match " "))
330 (let ((map (make-sparse-keymap)))
331 (dolist (key'([mouse-1] [mouse-3]))
332 (define-key map key 'newsticker-treeview-tree-click))
333 (define-key map "\n" 'newsticker-treeview-show-item)
334 (define-key map "\C-m" 'newsticker-treeview-show-item)
335 (add-text-properties pos1 (point-max)
336 (list :nt-item item
337 :nt-feed feed
338 :nt-link (newsticker--link item)
339 'mouse-face 'highlight
340 'keymap map
341 'help-echo (buffer-substring pos2
342 (point-max)))))
343 (insert "\n"))))
345 (defun newsticker--treeview-list-clear ()
346 "Clear the newsticker treeview list window."
347 (with-current-buffer (newsticker--treeview-list-buffer)
348 (let ((inhibit-read-only t))
349 (erase-buffer)
350 (kill-all-local-variables)
351 (remove-overlays))))
353 (defun newsticker--treeview-list-items-with-age-callback (widget
354 changed-widget
355 &rest ages)
356 "Fill newsticker treeview list window with items of certain age.
357 This is a callback function for the treeview nodes.
358 Argument WIDGET is the calling treeview widget.
359 Argument CHANGED-WIDGET is the widget that actually has changed.
360 Optional argument AGES is the list of ages that are to be shown."
361 (newsticker--treeview-list-clear)
362 (widget-put widget :nt-selected t)
363 (apply 'newsticker--treeview-list-items-with-age ages))
365 (defun newsticker--treeview-list-items-with-age (&rest ages)
366 "Actually fill newsticker treeview list window with items of certain age.
367 AGES is the list of ages that are to be shown."
368 (mapc (lambda (feed)
369 (let ((feed-name-symbol (intern (car feed))))
370 (mapc (lambda (item)
371 (when (memq (newsticker--age item) ages)
372 (newsticker--treeview-list-add-item
373 item feed-name-symbol t)))
374 (newsticker--treeview-list-sort-items
375 (cdr (newsticker--cache-get-feed feed-name-symbol))))))
376 (append newsticker-url-list-defaults newsticker-url-list))
377 (newsticker--treeview-list-update nil))
379 (defun newsticker--treeview-list-new-items (widget changed-widget
380 &optional event)
381 "Fill newsticker treeview list window with new items.
382 This is a callback function for the treeview nodes.
383 Argument WIDGET is the calling treeview widget.
384 Argument CHANGED-WIDGET is the widget that actually has changed.
385 Optional argument EVENT is the mouse event that triggered this action."
386 (newsticker--treeview-list-items-with-age-callback widget changed-widget
387 'new)
388 (newsticker--treeview-item-show-text
389 "New items"
390 "This is a virtual feed containing all new items"))
392 (defun newsticker--treeview-list-immortal-items (widget changed-widget
393 &optional event)
394 "Fill newsticker treeview list window with immortal items.
395 This is a callback function for the treeview nodes.
396 Argument WIDGET is the calling treeview widget.
397 Argument CHANGED-WIDGET is the widget that actually has changed.
398 Optional argument EVENT is the mouse event that triggered this action."
399 (newsticker--treeview-list-items-with-age-callback widget changed-widget
400 'immortal)
401 (newsticker--treeview-item-show-text
402 "Immortal items"
403 "This is a virtual feed containing all immortal items."))
405 (defun newsticker--treeview-list-obsolete-items (widget changed-widget
406 &optional event)
407 "Fill newsticker treeview list window with obsolete items.
408 This is a callback function for the treeview nodes.
409 Argument WIDGET is the calling treeview widget.
410 Argument CHANGED-WIDGET is the widget that actually has changed.
411 Optional argument EVENT is the mouse event that triggered this action."
412 (newsticker--treeview-list-items-with-age-callback widget changed-widget
413 'obsolete)
414 (newsticker--treeview-item-show-text
415 "Obsolete items"
416 "This is a virtual feed containing all obsolete items."))
418 (defun newsticker--treeview-list-all-items (widget changed-widget
419 &optional event)
420 "Fill newsticker treeview list window with all items.
421 This is a callback function for the treeview nodes.
422 Argument WIDGET is the calling treeview widget.
423 Argument CHANGED-WIDGET is the widget that actually has changed.
424 Optional argument EVENT is the mouse event that triggered this action."
425 (newsticker--treeview-list-items-with-age-callback widget changed-widget
426 event 'new 'old
427 'obsolete 'immortal)
428 (newsticker--treeview-item-show-text
429 "All items"
430 "This is a virtual feed containing all items."))
432 (defun newsticker--treeview-list-items-v (vfeed-name)
433 "List items for virtual feed VFEED-NAME."
434 (when vfeed-name
435 (cond ((string-match "\\*new\\*" vfeed-name)
436 (newsticker--treeview-list-items-with-age 'new))
437 ((string-match "\\*immortal\\*" vfeed-name)
438 (newsticker--treeview-list-items-with-age 'immortal))
439 ((string-match "\\*old\\*" vfeed-name)
440 (newsticker--treeview-list-items-with-age 'old nil)))
441 (newsticker--treeview-list-update nil)
444 (defun newsticker--treeview-list-items (feed-name)
445 "List items for feed FEED-NAME."
446 (when feed-name
447 (if (newsticker--treeview-virtual-feed-p feed-name)
448 (newsticker--treeview-list-items-v feed-name)
449 (mapc (lambda (item)
450 (if (eq (newsticker--age item) 'feed)
451 (newsticker--treeview-item-show item (intern feed-name))
452 (newsticker--treeview-list-add-item item
453 (intern feed-name))))
454 (newsticker--treeview-list-sort-items
455 (cdr (newsticker--cache-get-feed (intern feed-name)))))
456 (newsticker--treeview-list-update nil))))
458 (defun newsticker--treeview-list-feed-items (widget changed-widget
459 &optional event)
460 "Callback function for listing feed items.
461 Argument WIDGET is the calling treeview widget.
462 Argument CHANGED-WIDGET is the widget that actually has changed.
463 Optional argument EVENT is the mouse event that triggered this action."
464 (newsticker--treeview-list-clear)
465 (widget-put widget :nt-selected t)
466 (let ((feed-name (widget-get widget :nt-feed))
467 (vfeed-name (widget-get widget :nt-vfeed)))
468 (if feed-name
469 (newsticker--treeview-list-items feed-name)
470 (newsticker--treeview-list-items-v vfeed-name))))
472 (defun newsticker--treeview-list-compare-item-by-age (item1 item2)
473 "Compare two news items ITEM1 and ITEM2 wrt age."
474 (catch 'result
475 (let ((age1 (newsticker--age item1))
476 (age2 (newsticker--age item2)))
477 (cond ((eq age1 'new)
479 ((eq age1 'immortal)
480 (cond ((eq age2 'new)
482 ((eq age2 'immortal)
485 nil)))
486 ((eq age1 'old)
487 (cond ((eq age2 'new)
488 nil)
489 ((eq age2 'immortal)
490 nil)
491 ((eq age2 'old)
492 nil)
494 t)))
496 nil)))))
498 (defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
499 "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
500 (newsticker--treeview-list-compare-item-by-age item2 item1))
502 (defun newsticker--treeview-list-compare-item-by-time (item1 item2)
503 "Compare two news items ITEM1 and ITEM2 wrt time values."
504 (newsticker--cache-item-compare-by-time item1 item2))
506 (defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
507 "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
508 (newsticker--cache-item-compare-by-time item2 item1))
510 (defun newsticker--treeview-list-compare-item-by-title (item1 item2)
511 "Compare two news items ITEM1 and ITEM2 wrt title."
512 (newsticker--cache-item-compare-by-title item1 item2))
514 (defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
515 "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
516 (newsticker--cache-item-compare-by-title item2 item1))
518 (defun newsticker--treeview-list-sort-items (items)
519 "Return sorted copy of list ITEMS.
520 The sort function is chosen according to the value of
521 `newsticker--treeview-list-sort-order'."
522 (let ((sort-fun
523 (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
524 'newsticker--treeview-list-compare-item-by-age)
525 ((eq newsticker--treeview-list-sort-order
526 'sort-by-age-reverse)
527 'newsticker--treeview-list-compare-item-by-age-reverse)
528 ((eq newsticker--treeview-list-sort-order 'sort-by-time)
529 'newsticker--treeview-list-compare-item-by-time)
530 ((eq newsticker--treeview-list-sort-order
531 'sort-by-time-reverse)
532 'newsticker--treeview-list-compare-item-by-time-reverse)
533 ((eq newsticker--treeview-list-sort-order 'sort-by-title)
534 'newsticker--treeview-list-compare-item-by-title)
535 ((eq newsticker--treeview-list-sort-order
536 'sort-by-title-reverse)
537 'newsticker--treeview-list-compare-item-by-title-reverse)
539 'newsticker--treeview-list-compare-item-by-title))))
540 (sort (copy-sequence items) sort-fun)))
542 (defun newsticker--treeview-list-update-faces ()
543 "Update faces in the treeview list buffer."
544 (let (pos-sel)
545 (with-current-buffer (newsticker--treeview-list-buffer)
546 (save-excursion
547 (let ((inhibit-read-only t))
548 (goto-char (point-min))
549 (while (not (eobp))
550 (let* ((pos (point-at-eol))
551 (item (get-text-property (point) :nt-item))
552 (age (newsticker--age item))
553 (selected (get-text-property (point) :nt-selected))
554 (face (cond ((eq age 'new)
555 'newsticker-treeview-new-face)
556 ((eq age 'old)
557 'newsticker-treeview-old-face)
558 ((eq age 'immortal)
559 'newsticker-treeview-immortal-face)
560 ((eq age 'obsolete)
561 'newsticker-treeview-obsolete-face)
563 'bold))))
564 (put-text-property (point) pos 'face face)
565 (if selected
566 (move-overlay newsticker--selection-overlay (point)
567 (1+ pos) ;include newline
568 (current-buffer)))
569 (if selected (setq pos-sel (point)))
570 (forward-line 1)
571 (beginning-of-line)))))) ;; FIXME!?
572 (when pos-sel
573 (if (window-live-p (newsticker--treeview-list-window))
574 (set-window-point (newsticker--treeview-list-window) pos-sel)))))
576 (defun newsticker--treeview-list-clear-highlight ()
577 "Clear the highlight in the treeview list buffer."
578 (with-current-buffer (newsticker--treeview-list-buffer)
579 (let ((inhibit-read-only t))
580 (put-text-property (point-min) (point-max) :nt-selected nil))
581 (newsticker--treeview-list-update-faces)))
583 (defun newsticker--treeview-list-update-highlight ()
584 "Update the highlight in the treeview list buffer."
585 (newsticker--treeview-list-clear-highlight)
586 (let (pos num-lines)
587 (with-current-buffer (newsticker--treeview-list-buffer)
588 (let ((inhibit-read-only t))
589 (put-text-property (point-at-bol) (point-at-eol) :nt-selected t))
590 (newsticker--treeview-list-update-faces))))
592 (defun newsticker--treeview-list-highlight-start ()
593 "Return position of selection in treeview list buffer."
594 (with-current-buffer (newsticker--treeview-list-buffer)
595 (save-excursion
596 (goto-char (point-min))
597 (next-single-property-change (point) :nt-selected))))
599 (defun newsticker--treeview-list-update (clear-buffer)
600 "Update the faces and highlight in the treeview list buffer.
601 If CLEAR-BUFFER is non-nil the list buffer is completely erased."
602 (save-excursion
603 (if (window-live-p (newsticker--treeview-list-window))
604 (set-window-buffer (newsticker--treeview-list-window)
605 (newsticker--treeview-list-buffer)))
606 (set-buffer (newsticker--treeview-list-buffer))
607 (if clear-buffer
608 (let ((inhibit-read-only t))
609 (erase-buffer)))
610 (newsticker-treeview-list-mode)
611 (newsticker--treeview-list-update-faces)
612 (goto-char (point-min))))
614 (defvar newsticker-treeview-list-sort-button-map
615 (let ((map (make-sparse-keymap)))
616 (define-key map [header-line mouse-1]
617 'newsticker--treeview-list-sort-by-column)
618 (define-key map [header-line mouse-2]
619 'newsticker--treeview-list-sort-by-column)
620 map)
621 "Local keymap for newsticker treeview list window sort buttons.")
623 (defun newsticker--treeview-list-sort-by-column (&optional event)
624 "Sort the newsticker list window buffer by the column clicked on.
625 Optional argument EVENT is the mouse event that triggered this action."
626 (interactive (list last-input-event))
627 (if event (mouse-select-window event))
628 (let* ((pos (event-start event))
629 (obj (posn-object pos))
630 (sort-order (if obj
631 (get-text-property (cdr obj) 'sort-order (car obj))
632 (get-text-property (posn-point pos) 'sort-order))))
633 (setq newsticker--treeview-list-sort-order
634 (cond ((eq sort-order 'sort-by-age)
635 (if (eq newsticker--treeview-list-sort-order 'sort-by-age)
636 'sort-by-age-reverse
637 'sort-by-age))
638 ((eq sort-order 'sort-by-time)
639 (if (eq newsticker--treeview-list-sort-order 'sort-by-time)
640 'sort-by-time-reverse
641 'sort-by-time))
642 ((eq sort-order 'sort-by-title)
643 (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
644 'sort-by-title-reverse
645 'sort-by-title))))
646 (newsticker-treeview-update)))
648 (defun newsticker-treeview-list-make-sort-button (name sort-order)
649 "Create propertized string for headerline button.
650 NAME is the button text, SORT-ORDER is the associated sort order
651 for the button."
652 (let ((face (if (string-match (symbol-name sort-order)
653 (symbol-name
654 newsticker--treeview-list-sort-order))
655 'bold
656 'header-line)))
657 (propertize name
658 'sort-order sort-order
659 'help-echo (concat "Sort by " name)
660 'mouse-face 'highlight
661 'face face
662 'keymap newsticker-treeview-list-sort-button-map)))
664 (defun newsticker--treeview-list-select (item)
665 "Select ITEM in treeview's list buffer."
666 (newsticker--treeview-list-clear-highlight)
667 (let (pos num-lines)
668 (save-current-buffer
669 (set-buffer (newsticker--treeview-list-buffer))
670 (goto-char (point-min))
671 (catch 'found
672 (while t
673 (let ((it (get-text-property (point) :nt-item)))
674 (when (eq it item)
675 (newsticker--treeview-list-update-highlight)
676 (newsticker--treeview-list-update-faces)
677 (newsticker--treeview-item-show
678 item (get-text-property (point) :nt-feed))
679 (throw 'found t)))
680 (forward-line 1)
681 (when (eobp)
682 (goto-char (point-min))
683 (throw 'found nil)))))))
685 ;; ======================================================================
686 ;;; item window
687 ;; ======================================================================
688 (defun newsticker--treeview-item-show-text (title description)
689 "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
690 (with-current-buffer (newsticker--treeview-item-buffer)
691 (when (fboundp 'w3m-process-stop)
692 (w3m-process-stop (current-buffer)))
693 (let ((inhibit-read-only t))
694 (erase-buffer)
695 (kill-all-local-variables)
696 (remove-overlays)
697 (insert title)
698 (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
699 (insert "\n\n" description)
700 (when newsticker-justification
701 (fill-region (point-min) (point-max) newsticker-justification))
702 (newsticker-treeview-item-mode)
703 (goto-char (point-min)))))
705 (defun newsticker--treeview-item-show (item feed-name-symbol)
706 "Show news ITEM coming from FEED-NAME-SYMBOL in treeview item buffer."
707 (setq newsticker--treeview-current-feed (symbol-name feed-name-symbol))
708 (with-current-buffer (newsticker--treeview-item-buffer)
709 (when (fboundp 'w3m-process-stop)
710 (w3m-process-stop (current-buffer)))
711 (let ((inhibit-read-only t)
712 (is-rendered-HTML nil)
714 (marker1 (make-marker))
715 (marker2 (make-marker)))
716 (erase-buffer)
717 (kill-all-local-variables)
718 (remove-overlays)
720 (when (and item feed-name-symbol)
721 (let ((wwidth (1- (if (window-live-p (newsticker--treeview-item-window))
722 (window-width (newsticker--treeview-item-window))
723 fill-column))))
724 (if newsticker-use-full-width
725 (set (make-local-variable 'fill-column) wwidth))
726 (set (make-local-variable 'fill-column) (min fill-column
727 wwidth)))
728 (let ((desc (newsticker--desc item)))
729 (insert "\n" (or desc "[No Description]")))
730 (set-marker marker1 (1+ (point-min)))
731 (set-marker marker2 (point-max))
732 (setq is-rendered-HTML (newsticker--treeview-render-text marker1
733 marker2))
734 (when (and newsticker-justification
735 (not is-rendered-HTML))
736 (fill-region marker1 marker2 newsticker-justification))
738 (newsticker-treeview-item-mode)
739 (goto-char (point-min))
740 ;; insert logo at top
741 (let* ((newsticker-enable-logo-manipulations nil)
742 (img (newsticker--image-read feed-name-symbol nil 40)))
743 (if (and (display-images-p) img)
744 (newsticker--insert-image img (car item))
745 (insert (newsticker--real-feed-name feed-name-symbol))))
746 (add-text-properties (point-min) (point)
747 (list 'face 'newsticker-feed-face
748 'mouse-face 'highlight
749 'help-echo "Visit in web browser."
750 :nt-link (newsticker--link item)
751 'keymap newsticker--treeview-url-keymap))
752 (setq pos (point))
754 (insert "\n\n")
755 ;; insert title
756 (setq pos (point))
757 (insert (newsticker--title item) "\n")
758 (set-marker marker1 pos)
759 (set-marker marker2 (point))
760 (newsticker--treeview-render-text marker1 marker2)
761 (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
762 (goto-char marker2)
763 (delete-char -1)
764 (insert "\n")
765 (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
766 (set-marker marker2 (point))
767 (when newsticker-justification
768 (fill-region marker1 marker2 newsticker-justification))
769 (goto-char marker2)
770 (add-text-properties marker1 (1- (point))
771 (list 'mouse-face 'highlight
772 'help-echo "Visit in web browser."
773 :nt-link (newsticker--link item)
774 'keymap newsticker--treeview-url-keymap))
775 (insert (format-time-string newsticker-date-format
776 (newsticker--time item)))
777 (insert "\n")
778 (setq pos (point))
779 (insert "\n")
780 ;; insert enclosures and rest at bottom
781 (goto-char (point-max))
782 (insert "\n\n")
783 (setq pos (point))
784 (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
785 (put-text-property pos (point) 'face 'newsticker-enclosure-face)
786 (setq pos (point))
787 (insert "\n")
788 (set-marker marker1 pos)
789 (newsticker--print-extra-elements item newsticker--treeview-url-keymap t)
790 (set-marker marker2 (point))
791 (newsticker--treeview-render-text marker1 marker2)
792 (put-text-property marker1 marker2 'face 'newsticker-extra-face)
793 (goto-char (point-min)))))
794 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
795 item
796 (memq (newsticker--age item) '(new obsolete)))
797 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
798 (newsticker-treeview-mark-item-old t)
799 (newsticker--treeview-list-update-faces)))
800 (if (window-live-p (newsticker--treeview-item-window))
801 (set-window-point (newsticker--treeview-item-window) 1)))
803 (defun newsticker--treeview-item-update ()
804 "Update the treeview item buffer and window."
805 (save-excursion
806 (if (window-live-p (newsticker--treeview-item-window))
807 (set-window-buffer (newsticker--treeview-item-window)
808 (newsticker--treeview-item-buffer)))
809 (set-buffer (newsticker--treeview-item-buffer))
810 (let ((inhibit-read-only t))
811 (erase-buffer))
812 (newsticker-treeview-item-mode)))
814 ;; ======================================================================
815 ;;; Tree window
816 ;; ======================================================================
817 (defun newsticker--treeview-tree-expand (tree)
818 "Expand TREE.
819 Callback function for tree widget that adds nodes for feeds and subgroups."
820 (tree-widget-set-theme "folder")
821 (let ((group (widget-get tree :nt-group))
822 (i 0)
823 (nt-id ""))
824 (mapcar (lambda (g)
825 (setq nt-id (newsticker--treeview-get-id tree i))
826 (setq i (1+ i))
827 (if (listp g)
828 (let* ((g-name (car g)))
829 `(tree-widget
830 :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
831 :expander newsticker--treeview-tree-expand
832 :expander-p (lambda (&rest ignore) t)
833 :nt-group ,(cdr g)
834 :nt-feed ,g-name
835 :nt-id ,nt-id
836 :leaf-icon newsticker--tree-widget-leaf-icon
837 :keep (:nt-feed :num-new :nt-id :open);; :nt-group
838 :open nil))
839 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
840 `(item :tag ,tag
841 :leaf-icon newsticker--tree-widget-leaf-icon
842 :nt-feed ,g
843 :action newsticker--treeview-list-feed-items
844 :nt-id ,nt-id
845 :keep (:nt-id)
846 :open t))))
847 group)))
849 (defun newsticker--tree-widget-icon-create (icon)
850 "Create the ICON widget."
851 (let* ((g (widget-get (widget-get icon :node) :nt-feed))
852 (ico (and g (newsticker--icon-read (intern g)))))
853 (if ico
854 (progn
855 (widget-put icon :tag-glyph ico)
856 (widget-default-create icon)
857 ;; Insert space between the icon and the node widget.
858 (insert-char ? 1)
859 (put-text-property
860 (1- (point)) (point)
861 'display (list 'space :width tree-widget-space-width)))
862 ;; fallback: default icon
863 (widget-put icon :leaf-icon 'tree-widget-leaf-icon)
864 (tree-widget-icon-create icon))))
866 (defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
867 event)
868 "Expand the vfeed TREE.
869 Optional arguments CHANGED-WIDGET and EVENT are ignored."
870 (tree-widget-set-theme "folder")
871 (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
872 :nt-vfeed "new"
873 :action newsticker--treeview-list-new-items
874 :nt-id ,(newsticker--treeview-get-id tree 0)
875 :keep (:nt-id))
876 `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
877 :nt-vfeed "immortal"
878 :action newsticker--treeview-list-immortal-items
879 :nt-id ,(newsticker--treeview-get-id tree 1)
880 :keep (:nt-id))
881 `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
882 :nt-vfeed "obsolete"
883 :action newsticker--treeview-list-obsolete-items
884 :nt-id ,(newsticker--treeview-get-id tree 2)
885 :keep (:nt-id))
886 `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
887 :nt-vfeed "all"
888 :action newsticker--treeview-list-all-items
889 :nt-id ,(newsticker--treeview-get-id tree 3)
890 :keep (:nt-id))))
892 (defun newsticker--treeview-virtual-feed-p (feed-name)
893 "Return non-nil if FEED-NAME is a virtual feed."
894 (string-match "\\*.*\\*" feed-name))
896 (define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
897 "Icon for a tree-widget leaf node."
898 :tag "O"
899 :glyph-name "leaf"
900 :create 'newsticker--tree-widget-icon-create
901 :button-face 'default)
903 (defun newsticker--treeview-tree-update ()
904 "Update treeview tree buffer and window."
905 (save-excursion
906 (if (window-live-p (newsticker--treeview-tree-window))
907 (set-window-buffer (newsticker--treeview-tree-window)
908 (newsticker--treeview-tree-buffer)))
909 (set-buffer (newsticker--treeview-tree-buffer))
910 (kill-all-local-variables)
911 (let ((inhibit-read-only t))
912 (erase-buffer)
913 (tree-widget-set-theme "folder")
914 (setq newsticker--treeview-feed-tree
915 (widget-create 'tree-widget
916 :tag (newsticker--treeview-propertize-tag
917 "Feeds" 0 "feeds")
918 :expander 'newsticker--treeview-tree-expand
919 :expander-p (lambda (&rest ignore) t)
920 :leaf-icon 'newsticker--tree-widget-leaf-icon
921 :nt-group (cdr newsticker-groups)
922 :nt-id "feeds"
923 :keep '(:nt-id)
924 :open t))
925 (setq newsticker--treeview-vfeed-tree
926 (widget-create 'tree-widget
927 :tag (newsticker--treeview-propertize-tag
928 "Virtual Feeds" 0 "vfeeds")
929 :expander 'newsticker--treeview-tree-expand-status
930 :expander-p (lambda (&rest ignore) t)
931 :leaf-icon 'newsticker--tree-widget-leaf-icon
932 :nt-id "vfeeds"
933 :keep '(:nt-id)
934 :open t))
935 (use-local-map widget-keymap)
936 (widget-setup))
937 (newsticker-treeview-mode)))
939 (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
940 vfeed)
941 "Return propertized copy of string TAG.
942 Optional argument NUM-NEW is used for choosing face, other
943 arguments NT-ID, FEED, and VFEED are added as properties."
944 ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
945 (let ((face 'newsticker-treeview-face)
946 (map (make-sparse-keymap)))
947 (if (and num-new (> num-new 0))
948 (setq face 'newsticker-treeview-new-face))
949 (dolist (key '([mouse-1] [mouse-3]))
950 (define-key map key 'newsticker-treeview-tree-click))
951 (define-key map "\n" 'newsticker-treeview-tree-do-click)
952 (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
953 (propertize tag 'face face 'keymap map
954 :nt-id nt-id
955 :nt-feed feed
956 :nt-vfeed vfeed
957 'help-echo tag
958 'mouse-face 'highlight)))
960 (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
961 &optional nt-id)
962 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
963 Optional argument NT-ID is added to the tag's properties."
964 (let (tag (num-new 0))
965 (cond (vfeed-name
966 (cond ((string= vfeed-name "new")
967 (setq num-new (newsticker--stat-num-items-total 'new))
968 (setq tag (format "New items (%d)" num-new)))
969 ((string= vfeed-name "immortal")
970 (setq num-new (newsticker--stat-num-items-total 'immortal))
971 (setq tag (format "Immortal items (%d)" num-new)))
972 ((string= vfeed-name "obsolete")
973 (setq num-new (newsticker--stat-num-items-total 'obsolete))
974 (setq tag (format "Obsolete items (%d)" num-new)))
975 ((string= vfeed-name "all")
976 (setq num-new (newsticker--stat-num-items-total))
977 (setq tag (format "All items (%d)" num-new)))))
978 (feed-name
979 (setq num-new (newsticker--stat-num-items-for-group
980 (intern feed-name) 'new 'immortal))
981 (setq tag
982 (format "%s (%d)"
983 (newsticker--real-feed-name (intern feed-name))
984 num-new))))
985 (if tag
986 (newsticker--treeview-propertize-tag tag num-new
987 nt-id
988 feed-name vfeed-name))))
990 (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
991 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
992 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
993 (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
994 (mapc (lambda (f-n)
995 (setq result (+ result
996 (apply 'newsticker--stat-num-items (intern f-n)
997 ages))))
998 (newsticker--group-get-feeds
999 (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
1000 result))
1002 (defun newsticker--treeview-count-node-items (feed &optional isvirtual)
1003 "Count number of relevant items for a treeview node.
1004 FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
1005 the feed is a virtual feed."
1006 (let* ((num-new 0))
1007 (if feed
1008 (if isvirtual
1009 (cond ((string= feed "new")
1010 (setq num-new (newsticker--stat-num-items-total 'new)))
1011 ((string= feed "immortal")
1012 (setq num-new (newsticker--stat-num-items-total 'immortal)))
1013 ((string= feed "obsolete")
1014 (setq num-new (newsticker--stat-num-items-total 'obsolete)))
1015 ((string= feed "all")
1016 (setq num-new (newsticker--stat-num-items-total))))
1017 (setq num-new (newsticker--stat-num-items-for-group
1018 (intern feed) 'new 'immortal))))
1019 num-new))
1021 (defun newsticker--treeview-tree-update-tag (w &optional recursive
1022 &rest ignore)
1023 "Update tag for tree widget W.
1024 If RECURSIVE is non-nil recursively update parent widgets as
1025 well. Argument IGNORE is ignored. Note that this function, if
1026 called recursively, makes w invalid. You should keep w's nt-id in
1027 that case."
1028 (let* ((parent (widget-get w :parent))
1029 (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
1030 (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
1031 (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
1032 (num-new (newsticker--treeview-count-node-items (or feed vfeed)
1033 vfeed))
1034 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
1035 (n (widget-get w :node)))
1036 (if parent
1037 (if recursive
1038 (newsticker--treeview-tree-update-tag parent)))
1039 (when tag
1040 (when n
1041 (widget-put n :tag tag))
1042 (widget-put w :num-new num-new)
1043 (widget-put w :tag tag)
1044 (when (marker-position (widget-get w :from))
1045 (let ((p (point))
1046 (notify (widget-get w :notify)))
1047 ;; FIXME: This moves point!!!!
1048 (with-current-buffer (newsticker--treeview-tree-buffer)
1049 (widget-value-set w (widget-value w)))
1050 (goto-char p))))))
1052 (defun newsticker--treeview-tree-do-update-tags (widget)
1053 "Actually recursively update tags for WIDGET."
1054 (save-excursion
1055 (let ((children (widget-get widget :children)))
1056 (dolist (w children)
1057 (newsticker--treeview-tree-do-update-tags w))
1058 (newsticker--treeview-tree-update-tag widget))))
1060 (defun newsticker--treeview-tree-update-tags (&rest ignore)
1061 "Update all tags of all trees.
1062 Arguments IGNORE are ignored."
1063 (save-current-buffer
1064 (set-buffer (newsticker--treeview-tree-buffer))
1065 (let ((inhibit-read-only t))
1066 (newsticker--treeview-tree-do-update-tags
1067 newsticker--treeview-feed-tree)
1068 (newsticker--treeview-tree-do-update-tags
1069 newsticker--treeview-vfeed-tree))
1070 (tree-widget-set-theme "folder")))
1072 (defun newsticker--treeview-tree-update-highlight ()
1073 "Update highlight in tree buffer."
1074 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
1075 (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
1076 (setq pos (widget-get (widget-get
1077 (newsticker--treeview-get-current-node)
1078 :parent) :from)))
1079 (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
1080 (with-current-buffer (newsticker--treeview-tree-buffer)
1081 (goto-char pos)
1082 (move-overlay newsticker--tree-selection-overlay
1083 (point-at-bol) (1+ (point-at-eol))
1084 (current-buffer)))
1085 (if (window-live-p (newsticker--treeview-tree-window))
1086 (set-window-point (newsticker--treeview-tree-window) pos)))))
1088 ;; ======================================================================
1089 ;;; Toolbar
1090 ;; ======================================================================
1091 (defvar newsticker-treeview-tool-bar-map
1092 (if (featurep 'xemacs)
1094 (if (boundp 'tool-bar-map)
1095 (let ((tool-bar-map (make-sparse-keymap)))
1096 (tool-bar-add-item "newsticker/prev-feed"
1097 'newsticker-treeview-prev-feed
1098 'newsticker-treeview-prev-feed
1099 :help "Go to previous feed"
1100 ;;:enable '(newsticker-previous-feed-available-p) FIXME
1102 (tool-bar-add-item "newsticker/prev-item"
1103 'newsticker-treeview-prev-item
1104 'newsticker-treeview-prev-item
1105 :help "Go to previous item"
1106 ;;:enable '(newsticker-previous-item-available-p) FIXME
1108 (tool-bar-add-item "newsticker/next-item"
1109 'newsticker-treeview-next-item
1110 'newsticker-treeview-next-item
1111 :visible t
1112 :help "Go to next item"
1113 ;;:enable '(newsticker-next-item-available-p) FIXME
1115 (tool-bar-add-item "newsticker/next-feed"
1116 'newsticker-treeview-next-feed
1117 'newsticker-treeview-next-feed
1118 :help "Go to next feed"
1119 ;;:enable '(newsticker-next-feed-available-p) FIXME
1121 (tool-bar-add-item "newsticker/mark-immortal"
1122 'newsticker-treeview-toggle-item-immortal
1123 'newsticker-treeview-toggle-item-immortal
1124 :help "Toggle current item as immortal"
1125 ;;:enable '(newsticker-item-not-immortal-p) FIXME
1127 (tool-bar-add-item "newsticker/mark-read"
1128 'newsticker-treeview-mark-item-old
1129 'newsticker-treeview-mark-item-old
1130 :help "Mark current item as read"
1131 ;;:enable '(newsticker-item-not-old-p) FIXME
1133 (tool-bar-add-item "newsticker/get-all"
1134 'newsticker-get-all-news
1135 'newsticker-get-all-news
1136 :help "Get news for all feeds")
1137 (tool-bar-add-item "newsticker/update"
1138 'newsticker-treeview-update
1139 'newsticker-treeview-update
1140 :help "Update newsticker buffer")
1141 (tool-bar-add-item "newsticker/browse-url"
1142 'newsticker-browse-url
1143 'newsticker-browse-url
1144 :help "Browse URL for item at point")
1145 ;; standard icons / actions
1146 (define-key tool-bar-map [newsticker-sep-1]
1147 (list 'menu-item "--double-line"))
1148 (tool-bar-add-item "close"
1149 'newsticker-treeview-quit
1150 'newsticker-treeview-quit
1151 :help "Close newsticker")
1152 (tool-bar-add-item "preferences"
1153 'newsticker-customize
1154 'newsticker-customize
1155 :help "Customize newsticker")
1156 tool-bar-map))))
1158 ;; ======================================================================
1159 ;;; actions
1160 ;; ======================================================================
1162 (defun newsticker-treeview-mouse-browse-url (event)
1163 "Call `browse-url' for the link of the item at which the EVENT occurred."
1164 (interactive "e")
1165 (save-excursion
1166 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1167 (let ((url (get-text-property (posn-point (event-end event))
1168 :nt-link)))
1169 (when url
1170 (browse-url url)
1171 (if newsticker-automatically-mark-visited-items-as-old
1172 (newsticker-treeview-mark-item-old))))))
1174 (defun newsticker-treeview-browse-url ()
1175 "Call `browse-url' for the link of the item at point."
1176 (interactive)
1177 (with-current-buffer (newsticker--treeview-list-buffer)
1178 (let ((url (get-text-property (point) :nt-link)))
1179 (when url
1180 (browse-url url)
1181 (if newsticker-automatically-mark-visited-items-as-old
1182 (newsticker-treeview-mark-item-old))))))
1184 (defun newsticker--treeview-buffer-init ()
1185 "Initialize all treeview buffers."
1186 (setq newsticker--treeview-buffers nil)
1187 (add-to-list 'newsticker--treeview-buffers
1188 (get-buffer-create "*Newsticker Tree*") t)
1189 (add-to-list 'newsticker--treeview-buffers
1190 (get-buffer-create "*Newsticker List*") t)
1191 (add-to-list 'newsticker--treeview-buffers
1192 (get-buffer-create "*Newsticker Item*") t)
1194 (unless newsticker--selection-overlay
1195 (with-current-buffer (newsticker--treeview-list-buffer)
1196 (setq buffer-undo-list t)
1197 (setq newsticker--selection-overlay (make-overlay (point-min)
1198 (point-max)))
1199 (overlay-put newsticker--selection-overlay 'face
1200 'newsticker-treeview-selection-face)))
1201 (unless newsticker--tree-selection-overlay
1202 (with-current-buffer (newsticker--treeview-tree-buffer)
1203 (setq buffer-undo-list t)
1204 (setq newsticker--tree-selection-overlay (make-overlay (point-min)
1205 (point-max)))
1206 (overlay-put newsticker--tree-selection-overlay 'face
1207 'newsticker-treeview-selection-face)))
1209 (newsticker--treeview-tree-update)
1210 (newsticker--treeview-list-update t)
1211 (newsticker--treeview-item-update))
1213 (defun newsticker-treeview-update ()
1214 "Update all treeview buffers and windows.
1215 Note: does not update the layout."
1216 (interactive)
1217 (let ((cur-item (newsticker--treeview-get-selected-item)))
1218 (if (newsticker--group-manage-orphan-feeds)
1219 (newsticker--treeview-tree-update))
1220 (newsticker--treeview-list-update t)
1221 (newsticker--treeview-item-update)
1222 (newsticker--treeview-tree-update-tags)
1223 (cond (newsticker--treeview-current-feed
1224 (newsticker--treeview-list-items newsticker--treeview-current-feed))
1225 (newsticker--treeview-current-vfeed
1226 (newsticker--treeview-list-items-with-age
1227 (intern newsticker--treeview-current-vfeed))))
1228 (newsticker--treeview-tree-update-highlight)
1229 (newsticker--treeview-list-update-highlight)
1230 (let ((cur-feed (or newsticker--treeview-current-feed
1231 newsticker--treeview-current-vfeed)))
1232 (if (and cur-feed cur-item)
1233 (newsticker--treeview-list-select cur-item)))))
1235 (defun newsticker-treeview-quit ()
1236 "Quit newsticker treeview."
1237 (interactive)
1238 (setq newsticker--sentinel-callback nil)
1239 (bury-buffer "*Newsticker Tree*")
1240 (bury-buffer "*Newsticker List*")
1241 (bury-buffer "*Newsticker Item*")
1242 (set-window-configuration newsticker--saved-window-config)
1243 (when newsticker--frame
1244 (if (frame-live-p newsticker--frame)
1245 (delete-frame newsticker--frame))
1246 (setq newsticker--frame nil))
1247 (newsticker-treeview-save))
1249 (defun newsticker-treeview-save ()
1250 "Save treeview group settings."
1251 (interactive)
1252 (let ((coding-system-for-write 'utf-8)
1253 (buf (find-file-noselect (concat newsticker-dir "/groups"))))
1254 (when buf
1255 (with-current-buffer buf
1256 (setq buffer-undo-list t)
1257 (erase-buffer)
1258 (insert ";; -*- coding: utf-8 -*-\n")
1259 (insert (prin1-to-string newsticker-groups))
1260 (save-buffer)
1261 (kill-buffer)))))
1263 (defun newsticker--treeview-load ()
1264 "Load treeview settings."
1265 (let* ((coding-system-for-read 'utf-8)
1266 (filename
1267 (or (and newsticker-groups-filename
1268 (not (string=
1269 (expand-file-name newsticker-groups-filename)
1270 (expand-file-name (concat newsticker-dir "/groups"))))
1271 (file-exists-p newsticker-groups-filename)
1272 (y-or-n-p
1273 (format
1274 (concat "Obsolete variable `newsticker-groups-filename' "
1275 "points to existing file \"%s\".\n"
1276 "Read it? ")
1277 newsticker-groups-filename))
1278 newsticker-groups-filename)
1279 (concat newsticker-dir "/groups")))
1280 (buf (and (file-exists-p filename)
1281 (find-file-noselect filename))))
1282 (and newsticker-groups-filename
1283 (file-exists-p newsticker-groups-filename)
1284 (y-or-n-p (format
1285 (concat "Delete the file \"%s\",\nto which the obsolete "
1286 "variable `newsticker-groups-filename' points ? ")
1287 newsticker-groups-filename))
1288 (delete-file newsticker-groups-filename))
1289 (when buf
1290 (set-buffer buf)
1291 (goto-char (point-min))
1292 (condition-case nil
1293 (setq newsticker-groups (read buf))
1294 (error
1295 (message "Error while reading newsticker groups file!")
1296 (setq newsticker-groups nil)))
1297 (kill-buffer buf))))
1300 (defun newsticker-treeview-scroll-item ()
1301 "Scroll current item."
1302 (interactive)
1303 (save-selected-window
1304 (select-window (newsticker--treeview-item-window) t)
1305 (scroll-up 1)))
1307 (defun newsticker-treeview-show-item ()
1308 "Show current item."
1309 (interactive)
1310 (newsticker--treeview-restore-layout)
1311 (newsticker--treeview-list-update-highlight)
1312 (with-current-buffer (newsticker--treeview-list-buffer)
1313 (beginning-of-line)
1314 (let ((item (get-text-property (point) :nt-item))
1315 (feed (get-text-property (point) :nt-feed)))
1316 (newsticker--treeview-item-show item feed)))
1317 (newsticker--treeview-tree-update-tag
1318 (newsticker--treeview-get-current-node) t)
1319 (newsticker--treeview-tree-update-highlight))
1321 (defun newsticker-treeview-next-item ()
1322 "Move to next item."
1323 (interactive)
1324 (newsticker--treeview-restore-layout)
1325 (save-current-buffer
1326 (set-buffer (newsticker--treeview-list-buffer))
1327 (if (newsticker--treeview-list-highlight-start)
1328 (forward-line 1))
1329 (if (eobp)
1330 (forward-line -1)))
1331 (newsticker-treeview-show-item))
1333 (defun newsticker-treeview-prev-item ()
1334 "Move to previous item."
1335 (interactive)
1336 (newsticker--treeview-restore-layout)
1337 (save-current-buffer
1338 (set-buffer (newsticker--treeview-list-buffer))
1339 (forward-line -1))
1340 (newsticker-treeview-show-item))
1342 (defun newsticker-treeview-next-new-or-immortal-item (&optional
1343 current-item-counts
1344 dont-wrap-trees)
1345 "Move to next new or immortal item.
1346 Will move to next feed until an item is found. Will not move if
1347 optional argument CURRENT-ITEM-COUNTS is t and current item is
1348 new or immortal. Will not move from virtual to ordinary feed
1349 tree or vice versa if optional argument DONT-WRAP-TREES is non-nil."
1350 (interactive)
1351 (newsticker--treeview-restore-layout)
1352 (newsticker--treeview-list-clear-highlight)
1353 (unless (catch 'found
1354 (let ((move (not current-item-counts)))
1355 (while t
1356 (save-current-buffer
1357 (set-buffer (newsticker--treeview-list-buffer))
1358 (when move (forward-line 1)
1359 (when (eobp)
1360 (forward-line -1)
1361 (throw 'found nil))))
1362 (when (memq (newsticker--age
1363 (newsticker--treeview-get-selected-item))
1364 '(new immortal))
1365 (newsticker-treeview-show-item)
1366 (throw 'found t))
1367 (setq move t))))
1368 (let ((wrap-trees (not dont-wrap-trees)))
1369 (when (or (newsticker-treeview-next-feed t)
1370 (and wrap-trees (newsticker--treeview-first-feed)))
1371 (newsticker-treeview-next-new-or-immortal-item t t)))))
1373 (defun newsticker-treeview-prev-new-or-immortal-item ()
1374 "Move to previous new or immortal item.
1375 Will move to previous feed until an item is found."
1376 (interactive)
1377 (newsticker--treeview-restore-layout)
1378 (newsticker--treeview-list-clear-highlight)
1379 (unless (catch 'found
1380 (while t
1381 (save-current-buffer
1382 (set-buffer (newsticker--treeview-list-buffer))
1383 (when (bobp)
1384 (throw 'found nil))
1385 (forward-line -1))
1386 (when (memq (newsticker--age
1387 (newsticker--treeview-get-selected-item))
1388 '(new immortal))
1389 (newsticker-treeview-show-item)
1390 (throw 'found t))
1391 (when (bobp)
1392 (throw 'found nil))))
1393 (when (newsticker-treeview-prev-feed t)
1394 (set-buffer (newsticker--treeview-list-buffer))
1395 (goto-char (point-max))
1396 (newsticker-treeview-prev-new-or-immortal-item))))
1398 (defun newsticker--treeview-get-selected-item ()
1399 "Return item that is currently selected in list buffer."
1400 (with-current-buffer (newsticker--treeview-list-buffer)
1401 (beginning-of-line)
1402 (get-text-property (point) :nt-item)))
1404 (defun newsticker-treeview-mark-item-old (&optional dont-proceed)
1405 "Mark current item as old unless it is obsolete.
1406 Move to next item unless DONT-PROCEED is non-nil."
1407 (interactive)
1408 (let ((item (newsticker--treeview-get-selected-item)))
1409 (unless (eq (newsticker--age item) 'obsolete)
1410 (newsticker--treeview-mark-item item 'old)))
1411 (unless dont-proceed
1412 (newsticker-treeview-next-item)))
1414 (defun newsticker-treeview-toggle-item-immortal ()
1415 "Toggle immortality of current item."
1416 (interactive)
1417 (let* ((item (newsticker--treeview-get-selected-item))
1418 (new-age (if (eq (newsticker--age item) 'immortal)
1419 'old
1420 'immortal)))
1421 (newsticker--treeview-mark-item item new-age)
1422 (newsticker-treeview-next-item)))
1424 (defun newsticker--treeview-mark-item (item new-age)
1425 "Mark ITEM with NEW-AGE."
1426 (when item
1427 (setcar (nthcdr 4 item) new-age)
1428 ;; clean up ticker FIXME
1430 (newsticker--cache-save-feed
1431 (newsticker--cache-get-feed (intern newsticker--treeview-current-feed)))
1432 (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree))
1434 (defun newsticker-treeview-mark-list-items-old ()
1435 "Mark all listed items as old."
1436 (interactive)
1437 (let ((current-feed (or newsticker--treeview-current-feed
1438 newsticker--treeview-current-vfeed)))
1439 (with-current-buffer (newsticker--treeview-list-buffer)
1440 (goto-char (point-min))
1441 (while (not (eobp))
1442 (let ((item (get-text-property (point) :nt-item)))
1443 (unless (memq (newsticker--age item) '(immortal obsolete))
1444 (newsticker--treeview-mark-item item 'old)))
1445 (forward-line 1)))
1446 (newsticker--treeview-tree-update-tags)
1447 (if current-feed
1448 (newsticker-treeview-jump current-feed))))
1450 (defun newsticker-treeview-save-item ()
1451 "Save current item."
1452 (interactive)
1453 (newsticker-save-item (or newsticker--treeview-current-feed
1454 newsticker--treeview-current-vfeed)
1455 (newsticker--treeview-get-selected-item)))
1457 (defun newsticker-treeview-browse-url-item ()
1458 "Convert current item to HTML and call `browse-url' on result."
1459 (interactive)
1460 (newsticker-browse-url-item (or newsticker--treeview-current-feed
1461 newsticker--treeview-current-vfeed)
1462 (newsticker--treeview-get-selected-item)))
1464 (defun newsticker--treeview-set-current-node (node)
1465 "Make NODE the current node."
1466 (with-current-buffer (newsticker--treeview-tree-buffer)
1467 (setq newsticker--treeview-current-node-id
1468 (widget-get node :nt-id))
1469 (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
1470 (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
1471 (newsticker--treeview-tree-update-highlight)))
1473 (defun newsticker--treeview-get-first-child (node)
1474 "Get first child of NODE."
1475 (let ((children (widget-get node :children)))
1476 (if children
1477 (car children)
1478 nil)))
1480 (defun newsticker--treeview-get-second-child (node)
1481 "Get scond child of NODE."
1482 (let ((children (widget-get node :children)))
1483 (if children
1484 (car (cdr children))
1485 nil)))
1487 (defun newsticker--treeview-get-last-child (node)
1488 "Get last child of NODE."
1489 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1490 (let ((children (widget-get node :children)))
1491 (if children
1492 (car (reverse children))
1493 nil)))
1495 (defun newsticker--treeview-get-feed-vfeed (node)
1496 "Get (virtual) feed of NODE."
1497 (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
1499 (defun newsticker--treeview-get-next-sibling (node)
1500 "Get next sibling of NODE."
1501 (let ((parent (widget-get node :parent)))
1502 (catch 'found
1503 (let ((children (widget-get parent :children)))
1504 (while children
1505 (if (newsticker--treeview-nodes-eq (car children) node)
1506 (throw 'found (car (cdr children))))
1507 (setq children (cdr children)))))))
1509 (defun newsticker--treeview-get-prev-sibling (node)
1510 "Get previous sibling of NODE."
1511 (let ((parent (widget-get node :parent)))
1512 (catch 'found
1513 (let ((children (widget-get parent :children))
1514 (prev nil))
1515 (while children
1516 (if (and (newsticker--treeview-nodes-eq (car children) node)
1517 (widget-get prev :nt-id))
1518 (throw 'found prev))
1519 (setq prev (car children))
1520 (setq children (cdr children)))))))
1522 (defun newsticker--treeview-get-next-uncle (node)
1523 "Get next uncle of NODE, i.e. parent's next sibling."
1524 (let* ((parent (widget-get node :parent))
1525 (grand-parent (widget-get parent :parent)))
1526 (catch 'found
1527 (let ((uncles (widget-get grand-parent :children)))
1528 (while uncles
1529 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1530 (throw 'found (car (cdr uncles))))
1531 (setq uncles (cdr uncles)))))))
1533 (defun newsticker--treeview-get-prev-uncle (node)
1534 "Get previous uncle of NODE, i.e. parent's previous sibling."
1535 (let* ((parent (widget-get node :parent))
1536 (grand-parent (widget-get parent :parent)))
1537 (catch 'found
1538 (let ((uncles (widget-get grand-parent :children))
1539 (prev nil))
1540 (while uncles
1541 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1542 (throw 'found prev))
1543 (setq prev (car uncles))
1544 (setq uncles (cdr uncles)))))))
1546 (defun newsticker--treeview-get-other-tree ()
1547 "Get other tree."
1548 (if (and (newsticker--treeview-get-current-node)
1549 (widget-get (newsticker--treeview-get-current-node) :nt-feed))
1550 newsticker--treeview-vfeed-tree
1551 newsticker--treeview-feed-tree))
1553 (defun newsticker--treeview-activate-node (node &optional backward)
1554 "Activate NODE.
1555 If NODE is a tree widget the node's first subnode is activated.
1556 If BACKWARD is non-nil the last subnode of the previous sibling
1557 is activated."
1558 (newsticker--treeview-set-current-node node)
1559 (save-current-buffer
1560 (set-buffer (newsticker--treeview-tree-buffer))
1561 (cond ((eq (widget-type node) 'tree-widget)
1562 (unless (widget-get node :open)
1563 (widget-put node :open nil)
1564 (widget-apply-action node))
1565 (newsticker--treeview-activate-node
1566 (if backward
1567 (newsticker--treeview-get-last-child node)
1568 (newsticker--treeview-get-second-child node))))
1569 (node
1570 (widget-apply-action node)))))
1572 (defun newsticker--treeview-first-feed ()
1573 "Jump to the depth-first feed in the `newsticker-groups' tree."
1574 (newsticker-treeview-jump
1575 (car (reverse (newsticker--group-get-feeds newsticker-groups t)))))
1577 (defun newsticker-treeview-next-feed (&optional stay-in-tree)
1578 "Move to next feed.
1579 Optional argument STAY-IN-TREE prevents moving from real feed
1580 tree to virtual feed tree or vice versa.
1581 Return t if a new feed was activated, nil otherwise."
1582 (interactive)
1583 (newsticker--treeview-restore-layout)
1584 (let ((cur (newsticker--treeview-get-current-node))
1585 (new nil))
1586 (setq new
1587 (if cur
1588 (or (newsticker--treeview-get-next-sibling cur)
1589 (newsticker--treeview-get-next-uncle cur)
1590 (and (not stay-in-tree)
1591 (newsticker--treeview-get-other-tree)))
1592 (car (widget-get newsticker--treeview-feed-tree :children))))
1593 (if new
1594 (progn
1595 (newsticker--treeview-activate-node new)
1596 (newsticker--treeview-tree-update-highlight)
1597 (not (eq new cur)))
1598 nil)))
1600 (defun newsticker-treeview-prev-feed (&optional stay-in-tree)
1601 "Move to previous feed.
1602 Optional argument STAY-IN-TREE prevents moving from real feed
1603 tree to virtual feed tree or vice versa.
1604 Return t if a new feed was activated, nil otherwise."
1605 (interactive)
1606 (newsticker--treeview-restore-layout)
1607 (let ((cur (newsticker--treeview-get-current-node))
1608 (new nil))
1609 (if cur
1610 (progn
1611 (setq new
1612 (if cur
1613 (or (newsticker--treeview-get-prev-sibling cur)
1614 (newsticker--treeview-get-prev-uncle cur)
1615 (and (not stay-in-tree)
1616 (newsticker--treeview-get-other-tree)))
1617 (car (widget-get newsticker--treeview-feed-tree :children))))
1618 (if new
1619 (progn
1620 (newsticker--treeview-activate-node new t)
1621 (newsticker--treeview-tree-update-highlight)
1622 (not (eq new cur)))
1623 nil))
1624 nil)))
1626 (defun newsticker-treeview-next-page ()
1627 "Scroll item buffer."
1628 (interactive)
1629 (save-selected-window
1630 (select-window (newsticker--treeview-item-window) t)
1631 (condition-case nil
1632 (scroll-up nil)
1633 (error
1634 (goto-char (point-min))))))
1637 (defun newsticker--treeview-unfold-node (feed-name)
1638 "Recursively show subtree above the node that represents FEED-NAME."
1639 (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
1640 (unless node
1641 (let* ((group-name (car (newsticker--group-find-parent-group
1642 feed-name))))
1643 (newsticker--treeview-unfold-node group-name))
1644 (setq node (newsticker--treeview-get-node-of-feed feed-name)))
1645 (when node
1646 (with-current-buffer (newsticker--treeview-tree-buffer)
1647 (widget-put node :nt-selected t)
1648 (widget-apply-action node)
1649 (newsticker--treeview-set-current-node node)))))
1651 (defun newsticker-treeview-jump (feed-name)
1652 "Jump to feed FEED-NAME in newsticker treeview."
1653 (interactive
1654 (list (let ((completion-ignore-case t))
1655 (completing-read
1656 "Jump to feed: "
1657 (append '("new" "obsolete" "immortal" "all")
1658 (mapcar 'car (append newsticker-url-list
1659 newsticker-url-list-defaults)))
1660 nil t))))
1661 (newsticker--treeview-unfold-node feed-name))
1663 ;; ======================================================================
1664 ;;; Groups
1665 ;; ======================================================================
1666 (defun newsticker--group-do-find-group (feed-or-group-name parent-node node)
1667 "Recursively find FEED-OR-GROUP-NAME in PARENT-NODE or NODE."
1668 (cond ((stringp node)
1669 (when (string= feed-or-group-name node)
1670 (throw 'found parent-node)))
1671 ((listp node)
1672 (cond ((string= feed-or-group-name (car node))
1673 (throw 'found parent-node))
1674 ((member feed-or-group-name (cdr node))
1675 (throw 'found node))
1677 (mapc (lambda (n)
1678 (if (listp n)
1679 (newsticker--group-do-find-group
1680 feed-or-group-name node n)))
1681 (cdr node)))))))
1683 (defun newsticker--group-find-parent-group (feed-or-group-name)
1684 "Find group containing FEED-OR-GROUP-NAME."
1685 (catch 'found
1686 (mapc (lambda (n)
1687 (newsticker--group-do-find-group feed-or-group-name
1688 newsticker-groups
1690 newsticker-groups)
1691 nil))
1693 (defun newsticker--group-do-get-group (name node)
1694 "Recursively find group with NAME below NODE."
1695 (if (string= name (car node))
1696 (throw 'found node)
1697 (mapc (lambda (n)
1698 (if (listp n)
1699 (newsticker--group-do-get-group name n)))
1700 (cdr node))))
1702 (defun newsticker--group-get-group (name)
1703 "Find group with NAME."
1704 (catch 'found
1705 (mapc (lambda (n)
1706 (if (listp n)
1707 (newsticker--group-do-get-group name n)))
1708 newsticker-groups)
1709 nil))
1711 (defun newsticker--group-get-subgroups (group &optional recursive)
1712 "Return list of subgroups for GROUP.
1713 If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1714 (let ((result nil))
1715 (mapc (lambda (n)
1716 (when (listp n)
1717 (setq result (cons (car n) result))
1718 (let ((subgroups (newsticker--group-get-subgroups n recursive)))
1719 (when subgroups
1720 (setq result (append subgroups result))))))
1721 group)
1722 result))
1724 (defun newsticker--group-all-groups ()
1725 "Return nested list of all groups."
1726 (newsticker--group-get-subgroups newsticker-groups t))
1728 (defun newsticker--group-get-feeds (group &optional recursive)
1729 "Return list of all feeds in GROUP.
1730 If RECURSIVE is non-nil recursively get feeds of subgroups and
1731 return a nested list."
1732 (let ((result nil))
1733 (mapc (lambda (n)
1734 (if (not (listp n))
1735 (setq result (cons n result))
1736 (if recursive
1737 (let ((subfeeds (newsticker--group-get-feeds n t)))
1738 (when subfeeds
1739 (setq result (append subfeeds result)))))))
1740 (cdr group))
1741 result))
1743 (defun newsticker-group-add-group (name parent)
1744 "Add group NAME to group PARENT."
1745 (interactive
1746 (list (read-string "Name of new group: ")
1747 (let ((completion-ignore-case t))
1748 (completing-read "Name of parent group (optional): " (newsticker--group-all-groups)
1749 nil t))))
1750 (if (newsticker--group-get-group name)
1751 (error "Group %s exists already" name))
1752 (let ((p (if (and parent (not (string= parent "")))
1753 (newsticker--group-get-group parent)
1754 newsticker-groups)))
1755 (unless p
1756 (error "Parent %s does not exist" parent))
1757 (setcdr p (cons (list name) (cdr p))))
1758 (newsticker--treeview-tree-update)
1759 (newsticker-treeview-jump newsticker--treeview-current-feed))
1761 (defun newsticker-group-delete-group (name)
1762 "Delete group NAME."
1763 (interactive
1764 (list (let ((completion-ignore-case t))
1765 (completing-read "Delete group: "
1766 (newsticker--group-names)
1767 nil t (car (newsticker--group-find-parent-group
1768 newsticker--treeview-current-feed))))))
1769 (let ((parent-group (newsticker--group-find-parent-group name)))
1770 (unless parent-group
1771 (error "Parent %s does not exist" parent-group))
1772 (setcdr parent-group (cl-delete-if (lambda (g)
1773 (and (listp g)
1774 (string= name (car g))))
1775 (cdr parent-group)))
1776 (newsticker--group-manage-orphan-feeds)
1777 (newsticker--treeview-tree-update)
1778 (newsticker-treeview-update)
1779 (newsticker-treeview-jump newsticker--treeview-current-feed)))
1781 (defun newsticker--group-do-rename-group (old-name new-name)
1782 "Actually rename group OLD-NAME to NEW-NAME."
1783 (let ((parent-group (newsticker--group-find-parent-group old-name)))
1784 (unless parent-group
1785 (error "Parent of %s does not exist" old-name))
1786 (mapcar (lambda (elt)
1787 (cond ((and (listp elt)
1788 (string= old-name (car elt)))
1789 (cons new-name (cdr elt)))
1791 elt))) parent-group)))
1793 (defun newsticker-group-rename-group (old-name new-name)
1794 "Rename group OLD-NAME to NEW-NAME."
1795 (interactive
1796 (list (let* ((completion-ignore-case t))
1797 (completing-read "Rename group: "
1798 (newsticker--group-names)
1799 nil t (car (newsticker--group-find-parent-group
1800 newsticker--treeview-current-feed))))
1801 (read-string "Rename to: ")))
1802 (setq newsticker-groups (newsticker--group-do-rename-group old-name new-name))
1803 (newsticker--group-manage-orphan-feeds)
1804 (newsticker--treeview-tree-update)
1805 (newsticker-treeview-update)
1806 (newsticker-treeview-jump newsticker--treeview-current-feed))
1808 (defun newsticker--get-group-names (lst)
1809 "Do get the group names from LST."
1810 (delete nil (cons (car lst)
1811 (apply 'append
1812 (mapcar (lambda (e)
1813 (cond ((listp e)
1814 (newsticker--get-group-names e))
1816 nil)))
1817 (cdr lst))))))
1819 (defun newsticker--group-names ()
1820 "Get names of all newsticker groups."
1821 (newsticker--get-group-names newsticker-groups))
1823 (defun newsticker-group-move-feed (name group-name &optional no-update)
1824 "Move feed NAME to group GROUP-NAME.
1825 Update treeview afterwards unless NO-UPDATE is non-nil."
1826 (interactive
1827 (let ((completion-ignore-case t))
1828 (list (completing-read "Name of feed or group to move: "
1829 (append (mapcar 'car newsticker-url-list)
1830 (newsticker--group-names))
1831 nil t newsticker--treeview-current-feed)
1832 (completing-read "Name of new parent group: " (newsticker--group-names)
1833 nil t))))
1834 (let* ((group (if (and group-name (not (string= group-name "")))
1835 (newsticker--group-get-group group-name)
1836 newsticker-groups))
1837 (moving-group-p (member name (newsticker--group-names)))
1838 (moved-thing (if moving-group-p
1839 (newsticker--group-get-group name)
1840 name)))
1841 (unless group
1842 (error "Group %s does not exist" group-name))
1843 (while (let ((old-group
1844 (newsticker--group-find-parent-group name)))
1845 (when old-group
1846 (delete moved-thing old-group))
1847 old-group))
1848 (setcdr group (cons moved-thing (cdr group)))
1849 (unless no-update
1850 (newsticker--treeview-tree-update)
1851 (newsticker-treeview-update)
1852 (newsticker-treeview-jump name))))
1854 (defun newsticker-group-shift-feed-down ()
1855 "Shift current feed down in its group."
1856 (interactive)
1857 (newsticker--group-shift 1))
1859 (defun newsticker-group-shift-feed-up ()
1860 "Shift current feed down in its group."
1861 (interactive)
1862 (newsticker--group-shift -1))
1864 (defun newsticker-group-shift-group-down ()
1865 "Shift current group down in its group."
1866 (interactive)
1867 (newsticker--group-shift 1 t))
1869 (defun newsticker-group-shift-group-up ()
1870 "Shift current group down in its group."
1871 (interactive)
1872 (newsticker--group-shift -1 t))
1874 (defun newsticker--group-shift (delta &optional move-group)
1875 "Shift current feed or group within its parent group.
1876 DELTA is an integer which specifies the direction and the amount
1877 of the shift. If MOVE-GROUP is nil the currently selected feed
1878 `newsticker--treeview-current-feed' is shifted, if it is t then
1879 the current feed's parent group is shifted.."
1880 (let* ((cur-feed newsticker--treeview-current-feed)
1881 (thing (if move-group
1882 (newsticker--group-find-parent-group cur-feed)
1883 cur-feed))
1884 (parent-group (newsticker--group-find-parent-group
1885 (if move-group (car thing) thing))))
1886 (unless parent-group
1887 (error "Group not found!"))
1888 (let* ((siblings (cdr parent-group))
1889 (pos (cl-position thing siblings :test 'equal))
1890 (tpos (+ pos delta ))
1891 (new-pos (max 0 (min (length siblings) tpos)))
1892 (beg (cl-subseq siblings 0 (min pos new-pos)))
1893 (end (cl-subseq siblings (+ 1 (max pos new-pos))))
1894 (p (elt siblings new-pos)))
1895 (when (not (= pos new-pos))
1896 (setcdr parent-group
1897 (cl-concatenate 'list
1899 (if (> delta 0)
1900 (list p thing)
1901 (list thing p))
1902 end))
1903 (newsticker--treeview-tree-update)
1904 (newsticker-treeview-update)
1905 (newsticker-treeview-jump cur-feed)))))
1907 (defun newsticker--count-groups (group)
1908 "Recursively count number of subgroups of GROUP."
1909 (let ((result 1))
1910 (mapc (lambda (g)
1911 (if (listp g)
1912 (setq result (+ result (newsticker--count-groups g)))))
1913 (cdr group))
1914 result))
1916 (defun newsticker--count-grouped-feeds (group)
1917 "Recursively count number of feeds in GROUP and its subgroups."
1918 (let ((result 0))
1919 (mapc (lambda (g)
1920 (if (listp g)
1921 (setq result (+ result (newsticker--count-grouped-feeds g)))
1922 (setq result (1+ result))))
1923 (cdr group))
1924 result))
1926 (defun newsticker--group-remove-obsolete-feeds (group)
1927 "Recursively remove obsolete feeds from GROUP."
1928 (let ((result nil)
1929 (urls (append newsticker-url-list newsticker-url-list-defaults)))
1930 (mapc (lambda (g)
1931 (if (listp g)
1932 (let ((sub-groups
1933 (newsticker--group-remove-obsolete-feeds g)))
1934 (if sub-groups
1935 (setq result (cons sub-groups result))))
1936 (if (assoc g urls)
1937 (setq result (cons g result)))))
1938 (cdr group))
1939 (if result
1940 (cons (car group) (reverse result))
1941 result)))
1943 (defun newsticker--group-manage-orphan-feeds ()
1944 "Put unmanaged feeds into `newsticker-groups'.
1945 Remove obsolete feeds as well.
1946 Return t if groups have changed, nil otherwise."
1947 (unless newsticker-groups
1948 (setq newsticker-groups '("Feeds")))
1949 (let ((new-feed nil)
1950 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
1951 (mapc (lambda (f)
1952 (unless (newsticker--group-find-parent-group (car f))
1953 (setq new-feed t)
1954 (newsticker-group-move-feed (car f) nil t)))
1955 (append newsticker-url-list-defaults newsticker-url-list))
1956 (setq newsticker-groups
1957 (newsticker--group-remove-obsolete-feeds newsticker-groups))
1958 (or new-feed
1959 (not (= grouped-feeds
1960 (newsticker--count-grouped-feeds newsticker-groups))))))
1962 ;; ======================================================================
1963 ;;; Modes
1964 ;; ======================================================================
1965 (defun newsticker--treeview-tree-open-menu (event)
1966 "Open tree menu at position of EVENT."
1967 (let* ((feed-name newsticker--treeview-current-feed)
1968 (menu (make-sparse-keymap feed-name)))
1969 (define-key menu [newsticker-treeview-mark-list-items-old]
1970 (list 'menu-item "Mark all items old"
1971 'newsticker-treeview-mark-list-items-old))
1972 (define-key menu [newsticker-treeview-get-news]
1973 (list 'menu-item (concat "Get news for " feed-name)
1974 'newsticker-treeview-get-news))
1975 (define-key menu [newsticker-get-all-news]
1976 (list 'menu-item "Get news for all feeds"
1977 'newsticker-get-all-news))
1978 (let ((choice (x-popup-menu event menu)))
1979 (when choice
1980 (funcall (car choice))))))
1982 (defvar newsticker-treeview-list-menu
1983 (let ((menu (make-sparse-keymap "Newsticker List")))
1984 (define-key menu [newsticker-treeview-mark-list-items-old]
1985 (list 'menu-item "Mark all items old"
1986 'newsticker-treeview-mark-list-items-old))
1987 (define-key menu [newsticker-treeview-mark-item-old]
1988 (list 'menu-item "Mark current item old"
1989 'newsticker-treeview-mark-item-old))
1990 (define-key menu [newsticker-treeview-toggle-item-immortal]
1991 (list 'menu-item "Mark current item immortal (toggle)"
1992 'newsticker-treeview-toggle-item-immortal))
1993 (define-key menu [newsticker-treeview-get-news]
1994 (list 'menu-item "Get news for current feed"
1995 'newsticker-treeview-get-news))
1996 menu)
1997 "Map for newsticker list menu.")
1999 (defvar newsticker-treeview-item-menu
2000 (let ((menu (make-sparse-keymap "Newsticker Item")))
2001 (define-key menu [newsticker-treeview-mark-item-old]
2002 (list 'menu-item "Mark current item old"
2003 'newsticker-treeview-mark-item-old))
2004 (define-key menu [newsticker-treeview-toggle-item-immortal]
2005 (list 'menu-item "Mark current item immortal (toggle)"
2006 'newsticker-treeview-toggle-item-immortal))
2007 (define-key menu [newsticker-treeview-get-news]
2008 (list 'menu-item "Get news for current feed"
2009 'newsticker-treeview-get-news))
2010 menu)
2011 "Map for newsticker item menu.")
2013 (defvar newsticker-treeview-mode-map
2014 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
2015 (define-key map " " 'newsticker-treeview-next-page)
2016 (define-key map "a" 'newsticker-add-url)
2017 (define-key map "b" 'newsticker-treeview-browse-url-item)
2018 (define-key map "F" 'newsticker-treeview-prev-feed)
2019 (define-key map "f" 'newsticker-treeview-next-feed)
2020 (define-key map "g" 'newsticker-treeview-get-news)
2021 (define-key map "G" 'newsticker-get-all-news)
2022 (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
2023 (define-key map "j" 'newsticker-treeview-jump)
2024 (define-key map "n" 'newsticker-treeview-next-item)
2025 (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
2026 (define-key map "O" 'newsticker-treeview-mark-list-items-old)
2027 (define-key map "o" 'newsticker-treeview-mark-item-old)
2028 (define-key map "p" 'newsticker-treeview-prev-item)
2029 (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
2030 (define-key map "q" 'newsticker-treeview-quit)
2031 (define-key map "S" 'newsticker-treeview-save-item)
2032 (define-key map "s" 'newsticker-treeview-save)
2033 (define-key map "u" 'newsticker-treeview-update)
2034 (define-key map "v" 'newsticker-treeview-browse-url)
2035 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
2036 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
2037 (define-key map "\M-m" 'newsticker-group-move-feed)
2038 (define-key map "\M-a" 'newsticker-group-add-group)
2039 (define-key map "\M-d" 'newsticker-group-delete-group)
2040 (define-key map "\M-r" 'newsticker-group-rename-group)
2041 (define-key map [M-down] 'newsticker-group-shift-feed-down)
2042 (define-key map [M-up] 'newsticker-group-shift-feed-up)
2043 (define-key map [M-S-down] 'newsticker-group-shift-group-down)
2044 (define-key map [M-S-up] 'newsticker-group-shift-group-up)
2045 map)
2046 "Mode map for newsticker treeview.")
2048 (define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV"
2049 "Major mode for Newsticker Treeview.
2050 \\{newsticker-treeview-mode-map}"
2051 (if (boundp 'tool-bar-map)
2052 (set (make-local-variable 'tool-bar-map)
2053 newsticker-treeview-tool-bar-map))
2054 (setq buffer-read-only t
2055 truncate-lines t))
2057 (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
2058 "Item List"
2059 (let ((header (concat
2060 (propertize " " 'display '(space :align-to 0))
2061 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
2062 (propertize " " 'display '(space :align-to 2))
2063 (if newsticker--treeview-list-show-feed
2064 (concat "Feed"
2065 (propertize " " 'display '(space :align-to 12)))
2067 (newsticker-treeview-list-make-sort-button "Date"
2068 'sort-by-time)
2069 (if newsticker--treeview-list-show-feed
2070 (propertize " " 'display '(space :align-to 28))
2071 (propertize " " 'display '(space :align-to 18)))
2072 (newsticker-treeview-list-make-sort-button "Title"
2073 'sort-by-title))))
2074 (setq header-line-format header))
2075 (define-key newsticker-treeview-list-mode-map [down-mouse-3]
2076 newsticker-treeview-list-menu))
2078 (define-derived-mode newsticker-treeview-item-mode newsticker-treeview-mode
2079 "Item"
2080 (define-key newsticker-treeview-item-mode-map [down-mouse-3]
2081 newsticker-treeview-item-menu))
2083 (defun newsticker-treeview-tree-click (event)
2084 "Handle click EVENT on a tag in the newsticker tree."
2085 (interactive "e")
2086 (newsticker--treeview-restore-layout)
2087 (save-excursion
2088 (switch-to-buffer (window-buffer (posn-window (event-end event))))
2089 (newsticker-treeview-tree-do-click (posn-point (event-end event)) event)))
2091 (defun newsticker-treeview-tree-do-click (&optional pos event)
2092 "Actually handle click event.
2093 POS gives the position where EVENT occurred."
2094 (interactive)
2095 (let* ((pos (or pos (point)))
2096 (nt-id (get-text-property pos :nt-id))
2097 (item (get-text-property pos :nt-item)))
2098 (cond (item
2099 ;; click in list buffer
2100 (newsticker-treeview-show-item))
2102 ;; click in tree buffer
2103 (let ((w (newsticker--treeview-get-node-by-id nt-id)))
2104 (when w
2105 (newsticker--treeview-tree-update-tag w t t)
2106 (setq w (newsticker--treeview-get-node-by-id nt-id))
2107 (widget-put w :nt-selected t)
2108 (widget-apply w :action event)
2109 (newsticker--treeview-set-current-node w)
2110 (and event
2111 (eq 'mouse-3 (car event))
2112 (sit-for 0)
2113 (newsticker--treeview-tree-open-menu event)))))))
2114 (newsticker--treeview-tree-update-highlight))
2116 (defun newsticker--treeview-restore-layout ()
2117 "Restore treeview buffers."
2118 (catch 'error
2119 (dotimes (i 3)
2120 (let ((win (nth i newsticker--treeview-windows))
2121 (buf (nth i newsticker--treeview-buffers)))
2122 (unless (window-live-p win)
2123 (newsticker--treeview-window-init)
2124 (newsticker--treeview-buffer-init)
2125 (throw 'error t))
2126 (unless (eq (window-buffer win) buf)
2127 (set-window-buffer win buf t))))))
2129 (defun newsticker--treeview-frame-init ()
2130 "Initialize treeview frame."
2131 (when newsticker-treeview-own-frame
2132 (unless (and newsticker--frame (frame-live-p newsticker--frame))
2133 (setq newsticker--frame (make-frame '((name . "Newsticker")))))
2134 (select-frame-set-input-focus newsticker--frame)
2135 (raise-frame newsticker--frame)))
2137 (defun newsticker--treeview-window-init ()
2138 "Initialize treeview windows."
2139 (setq newsticker--saved-window-config (current-window-configuration))
2140 (setq newsticker--treeview-windows nil)
2141 (setq newsticker--treeview-buffers nil)
2142 (delete-other-windows)
2143 (split-window-right newsticker-treeview-treewindow-width)
2144 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2145 (other-window 1)
2146 (split-window-below newsticker-treeview-listwindow-height)
2147 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2148 (other-window 1)
2149 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2150 (other-window 1))
2152 ;;;###autoload
2153 (defun newsticker-treeview ()
2154 "Start newsticker treeview."
2155 (interactive)
2156 (newsticker--treeview-load)
2157 (setq newsticker--sentinel-callback 'newsticker-treeview-update)
2158 (newsticker--treeview-frame-init)
2159 (newsticker--treeview-window-init)
2160 (newsticker--treeview-buffer-init)
2161 (if (newsticker--group-manage-orphan-feeds)
2162 (newsticker--treeview-tree-update))
2163 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
2164 (newsticker-start t) ;; will start only if not running
2165 (newsticker-treeview-update)
2166 (newsticker--treeview-item-show-text
2167 "Newsticker"
2168 "Welcome to newsticker!"))
2170 (defun newsticker-treeview-get-news ()
2171 "Get news for current feed."
2172 (interactive)
2173 (when newsticker--treeview-current-feed
2174 (newsticker-get-news newsticker--treeview-current-feed)))
2176 (provide 'newst-treeview)
2178 ;;; newst-treeview.el ends here