]> code.delx.au - gnu-emacs/blob - lisp/net/newst-treeview.el
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
[gnu-emacs] / lisp / net / newst-treeview.el
1 ;;; newst-treeview.el --- Treeview frontend for newsticker. -*- lexical-binding:t -*-
2
3 ;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
4
5 ;; Author: Ulf Jasper <ulf.jasper@web.de>
6 ;; Filename: newst-treeview.el
7 ;; Created: 2007
8 ;; Keywords: News, RSS, Atom
9 ;; Package: newsticker
10
11 ;; ======================================================================
12
13 ;; This file is part of GNU Emacs.
14
15 ;; GNU Emacs is free software: you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation, either version 3 of the License, or
18 ;; (at your option) any later version.
19
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
24
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27
28 ;; ======================================================================
29 ;;; Commentary:
30
31 ;; See newsticker.el
32
33 ;; ======================================================================
34 ;;; History:
35 ;;
36
37 ;; ======================================================================
38 ;;; Code:
39 (require 'newst-reader)
40 (require 'widget)
41 (require 'tree-widget)
42 (require 'wid-edit)
43
44 ;; ======================================================================
45 ;;; Customization
46 ;; ======================================================================
47 (defgroup newsticker-treeview nil
48 "Settings for the tree view reader."
49 :group 'newsticker-reader)
50
51 (defface newsticker-treeview-face
52 '((((class color) (background dark)) :foreground "white")
53 (((class color) (background light)) :foreground "black"))
54 "Face for newsticker tree."
55 :group 'newsticker-treeview)
56
57 (defface newsticker-treeview-new-face
58 '((t :inherit newsticker-treeview-face :weight bold))
59 "Face for newsticker tree."
60 :group 'newsticker-treeview)
61
62 (defface newsticker-treeview-old-face
63 '((t :inherit newsticker-treeview-face))
64 "Face for newsticker tree."
65 :group 'newsticker-treeview)
66
67 (defface newsticker-treeview-immortal-face
68 '((default :inherit newsticker-treeview-face :slant italic)
69 (((class color) (background dark)) :foreground "orange")
70 (((class color) (background light)) :foreground "blue"))
71 "Face for newsticker tree."
72 :group 'newsticker-treeview)
73
74 (defface newsticker-treeview-obsolete-face
75 '((t :inherit newsticker-treeview-face :strike-through t))
76 "Face for newsticker tree."
77 :group 'newsticker-treeview)
78
79 (defface newsticker-treeview-selection-face
80 '((((class color) (background dark)) :background "#bbbbff")
81 (((class color) (background light)) :background "#bbbbff"))
82 "Face for newsticker selection."
83 :group 'newsticker-treeview)
84
85 (defcustom newsticker-treeview-date-format
86 "%d.%m.%y, %H:%M"
87 "Format for the date column in the treeview list buffer.
88 See `format-time-string' for a list of valid specifiers."
89 :version "25.1"
90 :type 'string
91 :group 'newsticker-treeview)
92
93 (defcustom newsticker-treeview-own-frame
94 nil
95 "Decides whether newsticker treeview creates and uses its own frame."
96 :type 'boolean
97 :group 'newsticker-treeview)
98
99 (defcustom newsticker-treeview-treewindow-width
100 30
101 "Width of tree window in treeview layout.
102 See also `newsticker-treeview-listwindow-height'."
103 :type 'integer
104 :group 'newsticker-treeview)
105
106 (defcustom newsticker-treeview-listwindow-height
107 10
108 "Height of list window in treeview layout.
109 See also `newsticker-treeview-treewindow-width'."
110 :type 'integer
111 :group 'newsticker-treeview)
112
113 (defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
114 t
115 "Decides whether to automatically mark displayed items as old.
116 If t an item is marked as old as soon as it is displayed. This
117 applies to newsticker only."
118 :type 'boolean
119 :group 'newsticker-treeview)
120
121 (defvar newsticker-groups
122 '("Feeds")
123 "List of feed groups, used in the treeview frontend.
124 First element is a string giving the group name. Remaining
125 elements are either strings giving a feed name or lists having
126 the same structure as `newsticker-groups'. (newsticker-groups :=
127 groupdefinition, groupdefinition := groupname groupcontent*,
128 groupcontent := feedname | groupdefinition)
129
130 Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
131 \"feed3\")")
132
133 (defcustom newsticker-groups-filename
134 nil
135 "Name of the newsticker groups settings file. This variable is obsolete."
136 :version "25.1" ; changed default value to nil
137 :type 'string
138 :group 'newsticker-treeview)
139 (make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
140
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)
161
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.")
172
173
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))
195
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))
205
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)))
210
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 :nt-feed) (widget-get node2 :nt-feed)))))
222
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)))))
232
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)))
240
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)))))
248
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)))
254
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))
258
259 ;; ======================================================================
260
261 (unless (fboundp 'declare-function) (defmacro declare-function (&rest _)))
262 (declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
263 (defvar w3m-fill-column)
264 (defvar w3-maximum-line-length)
265
266 (defun newsticker--treeview-render-text (start end)
267 "Render text between markers START and END."
268 (if newsticker-html-renderer
269 (condition-case error-data
270 (save-excursion
271 (set-marker-insertion-type end t)
272 ;; check whether it is necessary to call html renderer
273 ;; (regexp inspired by htmlr.el)
274 (goto-char start)
275 (when (re-search-forward
276 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
277 ;; (message "%s" (newsticker--title item))
278 (let ((w3m-fill-column (if newsticker-use-full-width
279 -1 fill-column))
280 (w3-maximum-line-length
281 (if newsticker-use-full-width nil fill-column)))
282 (save-excursion
283 (funcall newsticker-html-renderer start end)))
284 ;;(cond ((eq newsticker-html-renderer 'w3m-region)
285 ;; (add-text-properties start end (list 'keymap
286 ;; w3m-minor-mode-map)))
287 ;;((eq newsticker-html-renderer 'w3-region)
288 ;;(add-text-properties start end (list 'keymap w3-mode-map))))
289 (if (eq newsticker-html-renderer 'w3m-region)
290 (w3m-toggle-inline-images t))
291 t))
292 (error
293 (message "Error: HTML rendering failed: %s, %s"
294 (car error-data) (cdr error-data))
295 nil))
296 nil))
297
298 ;; ======================================================================
299 ;;; List window
300 ;; ======================================================================
301 (defun newsticker--treeview-list-add-item (item feed &optional show-feed)
302 "Add news ITEM for FEED to newsticker treeview list window.
303 If string SHOW-FEED is non-nil it is shown in the item string."
304 (setq newsticker--treeview-list-show-feed show-feed)
305 (with-current-buffer (newsticker--treeview-list-buffer)
306 (let* ((inhibit-read-only t)
307 pos1 pos2)
308 (goto-char (point-max))
309 (setq pos1 (point-marker))
310 (insert " ")
311 (insert (propertize " " 'display '(space :align-to 2)))
312 (insert (if show-feed
313 (concat
314 (substring
315 (format "%-10s" (newsticker--real-feed-name
316 feed))
317 0 10)
318 (propertize " " 'display '(space :align-to 12)))
319 ""))
320 (insert (format-time-string newsticker-treeview-date-format
321 (newsticker--time item)))
322 (insert (propertize " " 'display
323 (list 'space :align-to (if show-feed 28 18))))
324 (setq pos2 (point-marker))
325 (insert (newsticker--title item))
326 (insert "\n")
327 (newsticker--treeview-render-text pos2 (point-marker))
328 (goto-char pos2)
329 (while (search-forward "\n" nil t)
330 (replace-match " "))
331 (let ((map (make-sparse-keymap)))
332 (dolist (key'([mouse-1] [mouse-3]))
333 (define-key map key 'newsticker-treeview-tree-click))
334 (define-key map "\n" 'newsticker-treeview-show-item)
335 (define-key map "\C-m" 'newsticker-treeview-show-item)
336 (add-text-properties pos1 (point-max)
337 (list :nt-item item
338 :nt-feed feed
339 :nt-link (newsticker--link item)
340 'mouse-face 'highlight
341 'keymap map
342 'help-echo (buffer-substring pos2
343 (point-max)))))
344 (insert "\n"))))
345
346 (defun newsticker--treeview-list-clear ()
347 "Clear the newsticker treeview list window."
348 (with-current-buffer (newsticker--treeview-list-buffer)
349 (let ((inhibit-read-only t))
350 (erase-buffer)
351 (kill-all-local-variables)
352 (remove-overlays))))
353
354 (defun newsticker--treeview-list-items-with-age-callback (widget
355 _changed-widget
356 &rest ages)
357 "Fill newsticker treeview list window with items of certain age.
358 This is a callback function for the treeview nodes.
359 Argument WIDGET is the calling treeview widget.
360 Argument CHANGED-WIDGET is the widget that actually has changed.
361 Optional argument AGES is the list of ages that are to be shown."
362 (newsticker--treeview-list-clear)
363 (widget-put widget :nt-selected t)
364 (apply #'newsticker--treeview-list-items-with-age ages))
365
366 (defun newsticker--treeview-list-items-with-age (&rest ages)
367 "Actually fill newsticker treeview list window with items of certain age.
368 AGES is the list of ages that are to be shown."
369 (mapc (lambda (feed)
370 (let ((feed-name-symbol (intern (car feed))))
371 (mapc (lambda (item)
372 (when (memq (newsticker--age item) ages)
373 (newsticker--treeview-list-add-item
374 item feed-name-symbol t)))
375 (newsticker--treeview-list-sort-items
376 (cdr (newsticker--cache-get-feed feed-name-symbol))))))
377 (append newsticker-url-list-defaults newsticker-url-list))
378 (newsticker--treeview-list-update nil))
379
380 (defun newsticker--treeview-list-new-items (widget changed-widget
381 &optional _event)
382 "Fill newsticker treeview list window with new items.
383 This is a callback function for the treeview nodes.
384 Argument WIDGET is the calling treeview widget.
385 Argument CHANGED-WIDGET is the widget that actually has changed.
386 Optional argument EVENT is the mouse event that triggered this action."
387 (newsticker--treeview-list-items-with-age-callback widget changed-widget
388 'new)
389 (newsticker--treeview-item-show-text
390 "New items"
391 "This is a virtual feed containing all new items"))
392
393 (defun newsticker--treeview-list-immortal-items (widget changed-widget
394 &optional _event)
395 "Fill newsticker treeview list window with immortal items.
396 This is a callback function for the treeview nodes.
397 Argument WIDGET is the calling treeview widget.
398 Argument CHANGED-WIDGET is the widget that actually has changed.
399 Optional argument EVENT is the mouse event that triggered this action."
400 (newsticker--treeview-list-items-with-age-callback widget changed-widget
401 'immortal)
402 (newsticker--treeview-item-show-text
403 "Immortal items"
404 "This is a virtual feed containing all immortal items."))
405
406 (defun newsticker--treeview-list-obsolete-items (widget changed-widget
407 &optional _event)
408 "Fill newsticker treeview list window with obsolete items.
409 This is a callback function for the treeview nodes.
410 Argument WIDGET is the calling treeview widget.
411 Argument CHANGED-WIDGET is the widget that actually has changed.
412 Optional argument EVENT is the mouse event that triggered this action."
413 (newsticker--treeview-list-items-with-age-callback widget changed-widget
414 'obsolete)
415 (newsticker--treeview-item-show-text
416 "Obsolete items"
417 "This is a virtual feed containing all obsolete items."))
418
419 (defun newsticker--treeview-list-all-items (widget changed-widget
420 &optional event)
421 "Fill newsticker treeview list window with all items.
422 This is a callback function for the treeview nodes.
423 Argument WIDGET is the calling treeview widget.
424 Argument CHANGED-WIDGET is the widget that actually has changed.
425 Optional argument EVENT is the mouse event that triggered this action."
426 (newsticker--treeview-list-items-with-age-callback widget changed-widget
427 event 'new 'old
428 'obsolete 'immortal)
429 (newsticker--treeview-item-show-text
430 "All items"
431 "This is a virtual feed containing all items."))
432
433 (defun newsticker--treeview-list-items-v (vfeed-name)
434 "List items for virtual feed VFEED-NAME."
435 (when vfeed-name
436 (cond ((string-match "\\*new\\*" vfeed-name)
437 (newsticker--treeview-list-items-with-age 'new))
438 ((string-match "\\*immortal\\*" vfeed-name)
439 (newsticker--treeview-list-items-with-age 'immortal))
440 ((string-match "\\*old\\*" vfeed-name)
441 (newsticker--treeview-list-items-with-age 'old nil)))
442 (newsticker--treeview-list-update nil)
443 ))
444
445 (defun newsticker--treeview-list-items (feed-name)
446 "List items for feed FEED-NAME."
447 (when feed-name
448 (if (newsticker--treeview-virtual-feed-p feed-name)
449 (newsticker--treeview-list-items-v feed-name)
450 (mapc (lambda (item)
451 (if (eq (newsticker--age item) 'feed)
452 (newsticker--treeview-item-show item (intern feed-name))
453 (newsticker--treeview-list-add-item item
454 (intern feed-name))))
455 (newsticker--treeview-list-sort-items
456 (cdr (newsticker--cache-get-feed (intern feed-name)))))
457 (newsticker--treeview-list-update nil))))
458
459 (defun newsticker--treeview-list-feed-items (widget _changed-widget
460 &optional _event)
461 "Callback function for listing feed items.
462 Argument WIDGET is the calling treeview widget.
463 Argument CHANGED-WIDGET is the widget that actually has changed.
464 Optional argument EVENT is the mouse event that triggered this action."
465 (newsticker--treeview-list-clear)
466 (widget-put widget :nt-selected t)
467 (let ((feed-name (widget-get widget :nt-feed))
468 (vfeed-name (widget-get widget :nt-vfeed)))
469 (if feed-name
470 (newsticker--treeview-list-items feed-name)
471 (newsticker--treeview-list-items-v vfeed-name))))
472
473 (defun newsticker--treeview-list-compare-item-by-age (item1 item2)
474 "Compare two news items ITEM1 and ITEM2 wrt age."
475 (catch 'result
476 (let ((age1 (newsticker--age item1))
477 (age2 (newsticker--age item2)))
478 (cond ((eq age1 'new)
479 t)
480 ((eq age1 'immortal)
481 (cond ((eq age2 'new)
482 t)
483 ((eq age2 'immortal)
484 t)
485 (t
486 nil)))
487 ((eq age1 'old)
488 (cond ((eq age2 'new)
489 nil)
490 ((eq age2 'immortal)
491 nil)
492 ((eq age2 'old)
493 nil)
494 (t
495 t)))
496 (t
497 nil)))))
498
499 (defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
500 "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
501 (newsticker--treeview-list-compare-item-by-age item2 item1))
502
503 (defun newsticker--treeview-list-compare-item-by-time (item1 item2)
504 "Compare two news items ITEM1 and ITEM2 wrt time values."
505 (newsticker--cache-item-compare-by-time item1 item2))
506
507 (defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
508 "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
509 (newsticker--cache-item-compare-by-time item2 item1))
510
511 (defun newsticker--treeview-list-compare-item-by-title (item1 item2)
512 "Compare two news items ITEM1 and ITEM2 wrt title."
513 (newsticker--cache-item-compare-by-title item1 item2))
514
515 (defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
516 "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
517 (newsticker--cache-item-compare-by-title item2 item1))
518
519 (defun newsticker--treeview-list-sort-items (items)
520 "Return sorted copy of list ITEMS.
521 The sort function is chosen according to the value of
522 `newsticker--treeview-list-sort-order'."
523 (let ((sort-fun
524 (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
525 'newsticker--treeview-list-compare-item-by-age)
526 ((eq newsticker--treeview-list-sort-order
527 'sort-by-age-reverse)
528 'newsticker--treeview-list-compare-item-by-age-reverse)
529 ((eq newsticker--treeview-list-sort-order 'sort-by-time)
530 'newsticker--treeview-list-compare-item-by-time)
531 ((eq newsticker--treeview-list-sort-order
532 'sort-by-time-reverse)
533 'newsticker--treeview-list-compare-item-by-time-reverse)
534 ((eq newsticker--treeview-list-sort-order 'sort-by-title)
535 'newsticker--treeview-list-compare-item-by-title)
536 ((eq newsticker--treeview-list-sort-order
537 'sort-by-title-reverse)
538 'newsticker--treeview-list-compare-item-by-title-reverse)
539 (t
540 'newsticker--treeview-list-compare-item-by-title))))
541 (sort (copy-sequence items) sort-fun)))
542
543 (defun newsticker--treeview-list-update-faces ()
544 "Update faces in the treeview list buffer."
545 (let (pos-sel)
546 (with-current-buffer (newsticker--treeview-list-buffer)
547 (save-excursion
548 (let ((inhibit-read-only t))
549 (goto-char (point-min))
550 (while (not (eobp))
551 (let* ((pos (point-at-eol))
552 (item (get-text-property (point) :nt-item))
553 (age (newsticker--age item))
554 (selected (get-text-property (point) :nt-selected))
555 (face (cond ((eq age 'new)
556 'newsticker-treeview-new-face)
557 ((eq age 'old)
558 'newsticker-treeview-old-face)
559 ((eq age 'immortal)
560 'newsticker-treeview-immortal-face)
561 ((eq age 'obsolete)
562 'newsticker-treeview-obsolete-face)
563 (t
564 'bold))))
565 (put-text-property (point) pos 'face face)
566 (if selected
567 (move-overlay newsticker--selection-overlay (point)
568 (1+ pos) ;include newline
569 (current-buffer)))
570 (if selected (setq pos-sel (point)))
571 (forward-line 1)
572 (beginning-of-line)))))) ;; FIXME!?
573 (when pos-sel
574 (if (window-live-p (newsticker--treeview-list-window))
575 (set-window-point (newsticker--treeview-list-window) pos-sel)))))
576
577 (defun newsticker--treeview-list-clear-highlight ()
578 "Clear the highlight in the treeview list buffer."
579 (with-current-buffer (newsticker--treeview-list-buffer)
580 (let ((inhibit-read-only t))
581 (put-text-property (point-min) (point-max) :nt-selected nil))
582 (newsticker--treeview-list-update-faces)))
583
584 (defun newsticker--treeview-list-update-highlight ()
585 "Update the highlight in the treeview list buffer."
586 (newsticker--treeview-list-clear-highlight)
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)))
591
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))))
598
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))))
613
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.")
622
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)))
647
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)))
663
664 (defun newsticker--treeview-list-select (item)
665 "Select ITEM in treeview's list buffer."
666 (newsticker--treeview-list-clear-highlight)
667 (save-current-buffer
668 (set-buffer (newsticker--treeview-list-buffer))
669 (goto-char (point-min))
670 (catch 'found
671 (while t
672 (let ((it (get-text-property (point) :nt-item)))
673 (when (eq it item)
674 (newsticker--treeview-list-update-highlight)
675 (newsticker--treeview-list-update-faces)
676 (newsticker--treeview-item-show
677 item (get-text-property (point) :nt-feed))
678 (throw 'found t)))
679 (forward-line 1)
680 (when (eobp)
681 (goto-char (point-min))
682 (throw 'found nil))))))
683
684 ;; ======================================================================
685 ;;; item window
686 ;; ======================================================================
687 (defun newsticker--treeview-item-show-text (title description)
688 "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
689 (with-current-buffer (newsticker--treeview-item-buffer)
690 (when (fboundp 'w3m-process-stop)
691 (w3m-process-stop (current-buffer)))
692 (let ((inhibit-read-only t))
693 (erase-buffer)
694 (kill-all-local-variables)
695 (remove-overlays)
696 (insert title)
697 (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
698 (insert "\n\n" description)
699 (when newsticker-justification
700 (fill-region (point-min) (point-max) newsticker-justification))
701 (newsticker-treeview-item-mode)
702 (goto-char (point-min)))))
703
704 (defun newsticker--treeview-item-show (item feed-name-symbol)
705 "Show news ITEM coming from FEED-NAME-SYMBOL in treeview item buffer."
706 (setq newsticker--treeview-current-feed (symbol-name feed-name-symbol))
707 (with-current-buffer (newsticker--treeview-item-buffer)
708 (when (fboundp 'w3m-process-stop)
709 (w3m-process-stop (current-buffer)))
710 (let ((inhibit-read-only t)
711 (is-rendered-HTML nil)
712 pos
713 (marker1 (make-marker))
714 (marker2 (make-marker)))
715 (erase-buffer)
716 (kill-all-local-variables)
717 (remove-overlays)
718
719 (when (and item feed-name-symbol)
720 (let ((wwidth (1- (if (window-live-p (newsticker--treeview-item-window))
721 (window-width (newsticker--treeview-item-window))
722 fill-column))))
723 (if newsticker-use-full-width
724 (set (make-local-variable 'fill-column) wwidth))
725 (set (make-local-variable 'fill-column) (min fill-column
726 wwidth)))
727 (let ((desc (newsticker--desc item)))
728 (insert "\n" (or desc "[No Description]")))
729 (set-marker marker1 (1+ (point-min)))
730 (set-marker marker2 (point-max))
731 (setq is-rendered-HTML (newsticker--treeview-render-text marker1
732 marker2))
733 (when (and newsticker-justification
734 (not is-rendered-HTML))
735 (fill-region marker1 marker2 newsticker-justification))
736
737 (newsticker-treeview-item-mode)
738 (goto-char (point-min))
739 ;; insert logo at top
740 (let* ((newsticker-enable-logo-manipulations nil)
741 (img (newsticker--image-read feed-name-symbol nil 40)))
742 (if (and (display-images-p) img)
743 (newsticker--insert-image img (car item))
744 (insert (newsticker--real-feed-name feed-name-symbol))))
745 (add-text-properties (point-min) (point)
746 (list 'face 'newsticker-feed-face
747 'mouse-face 'highlight
748 'help-echo "Visit in web browser."
749 :nt-link (newsticker--link item)
750 'keymap newsticker--treeview-url-keymap))
751 (setq pos (point))
752
753 (insert "\n\n")
754 ;; insert title
755 (setq pos (point))
756 (insert (newsticker--title item) "\n")
757 (set-marker marker1 pos)
758 (set-marker marker2 (point))
759 (newsticker--treeview-render-text marker1 marker2)
760 (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
761 (goto-char marker2)
762 (delete-char -1)
763 (insert "\n")
764 (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
765 (set-marker marker2 (point))
766 (when newsticker-justification
767 (fill-region marker1 marker2 newsticker-justification))
768 (goto-char marker2)
769 (add-text-properties marker1 (1- (point))
770 (list 'mouse-face 'highlight
771 'help-echo "Visit in web browser."
772 :nt-link (newsticker--link item)
773 'keymap newsticker--treeview-url-keymap))
774 (insert (format-time-string newsticker-date-format
775 (newsticker--time item)))
776 (insert "\n")
777 (setq pos (point))
778 (insert "\n")
779 ;; insert enclosures and rest at bottom
780 (goto-char (point-max))
781 (insert "\n\n")
782 (setq pos (point))
783 (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
784 (put-text-property pos (point) 'face 'newsticker-enclosure-face)
785 (setq pos (point))
786 (insert "\n")
787 (set-marker marker1 pos)
788 (newsticker--print-extra-elements item newsticker--treeview-url-keymap t)
789 (set-marker marker2 (point))
790 (newsticker--treeview-render-text marker1 marker2)
791 (put-text-property marker1 marker2 'face 'newsticker-extra-face)
792 (goto-char (point-min)))))
793 (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
794 item
795 (memq (newsticker--age item) '(new obsolete)))
796 (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
797 (newsticker-treeview-mark-item-old t)
798 (newsticker--treeview-list-update-faces)))
799 (if (window-live-p (newsticker--treeview-item-window))
800 (set-window-point (newsticker--treeview-item-window) 1)))
801
802 (defun newsticker--treeview-item-update ()
803 "Update the treeview item buffer and window."
804 (save-excursion
805 (if (window-live-p (newsticker--treeview-item-window))
806 (set-window-buffer (newsticker--treeview-item-window)
807 (newsticker--treeview-item-buffer)))
808 (set-buffer (newsticker--treeview-item-buffer))
809 (let ((inhibit-read-only t))
810 (erase-buffer))
811 (newsticker-treeview-item-mode)))
812
813 ;; ======================================================================
814 ;;; Tree window
815 ;; ======================================================================
816 (defun newsticker--treeview-tree-expand (tree)
817 "Expand TREE.
818 Callback function for tree widget that adds nodes for feeds and subgroups."
819 (tree-widget-set-theme "folder")
820 (let ((group (widget-get tree :nt-group))
821 (i 0)
822 (nt-id ""))
823 (mapcar (lambda (g)
824 (setq nt-id (newsticker--treeview-get-id tree i))
825 (setq i (1+ i))
826 (if (listp g)
827 (let* ((g-name (car g)))
828 `(tree-widget
829 :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
830 :expander newsticker--treeview-tree-expand
831 :expander-p (lambda (&rest ignore) t)
832 :nt-group ,(cdr g)
833 :nt-feed ,g-name
834 :nt-id ,nt-id
835 :leaf-icon newsticker--tree-widget-leaf-icon
836 :keep (:nt-feed :num-new :nt-id :open);; :nt-group
837 :open nil))
838 (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
839 `(item :tag ,tag
840 :leaf-icon newsticker--tree-widget-leaf-icon
841 :nt-feed ,g
842 :action newsticker--treeview-list-feed-items
843 :nt-id ,nt-id
844 :keep (:nt-id)
845 :open t))))
846 group)))
847
848 (defun newsticker--tree-widget-icon-create (icon)
849 "Create the ICON widget."
850 (let* ((g (widget-get (widget-get icon :node) :nt-feed))
851 (ico (and g (newsticker--icon-read (intern g)))))
852 (if ico
853 (progn
854 (widget-put icon :tag-glyph ico)
855 (widget-default-create icon)
856 ;; Insert space between the icon and the node widget.
857 (insert-char ? 1)
858 (put-text-property
859 (1- (point)) (point)
860 'display (list 'space :width tree-widget-space-width)))
861 ;; fallback: default icon
862 (widget-put icon :leaf-icon 'tree-widget-leaf-icon)
863 (tree-widget-icon-create icon))))
864
865 (defun newsticker--treeview-tree-expand-status (tree &optional _changed-widget
866 _event)
867 "Expand the vfeed TREE.
868 Optional arguments CHANGED-WIDGET and EVENT are ignored."
869 (tree-widget-set-theme "folder")
870 (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
871 :nt-vfeed "new"
872 :action newsticker--treeview-list-new-items
873 :nt-id ,(newsticker--treeview-get-id tree 0)
874 :keep (:nt-id))
875 `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
876 :nt-vfeed "immortal"
877 :action newsticker--treeview-list-immortal-items
878 :nt-id ,(newsticker--treeview-get-id tree 1)
879 :keep (:nt-id))
880 `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
881 :nt-vfeed "obsolete"
882 :action newsticker--treeview-list-obsolete-items
883 :nt-id ,(newsticker--treeview-get-id tree 2)
884 :keep (:nt-id))
885 `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
886 :nt-vfeed "all"
887 :action newsticker--treeview-list-all-items
888 :nt-id ,(newsticker--treeview-get-id tree 3)
889 :keep (:nt-id))))
890
891 (defun newsticker--treeview-virtual-feed-p (feed-name)
892 "Return non-nil if FEED-NAME is a virtual feed."
893 (string-match "\\*.*\\*" feed-name))
894
895 (define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
896 "Icon for a tree-widget leaf node."
897 :tag "O"
898 :glyph-name "leaf"
899 :create 'newsticker--tree-widget-icon-create
900 :button-face 'default)
901
902 (defun newsticker--treeview-tree-update ()
903 "Update treeview tree buffer and window."
904 (save-excursion
905 (if (window-live-p (newsticker--treeview-tree-window))
906 (set-window-buffer (newsticker--treeview-tree-window)
907 (newsticker--treeview-tree-buffer)))
908 (set-buffer (newsticker--treeview-tree-buffer))
909 (kill-all-local-variables)
910 (let ((inhibit-read-only t))
911 (erase-buffer)
912 (tree-widget-set-theme "folder")
913 (setq newsticker--treeview-feed-tree
914 (widget-create 'tree-widget
915 :tag (newsticker--treeview-propertize-tag
916 "Feeds" 0 "feeds")
917 :expander 'newsticker--treeview-tree-expand
918 :expander-p (lambda (&rest _) t)
919 :leaf-icon 'newsticker--tree-widget-leaf-icon
920 :nt-group (cdr newsticker-groups)
921 :nt-id "feeds"
922 :keep '(:nt-id)
923 :open t))
924 (setq newsticker--treeview-vfeed-tree
925 (widget-create 'tree-widget
926 :tag (newsticker--treeview-propertize-tag
927 "Virtual Feeds" 0 "vfeeds")
928 :expander 'newsticker--treeview-tree-expand-status
929 :expander-p (lambda (&rest _) t)
930 :leaf-icon 'newsticker--tree-widget-leaf-icon
931 :nt-id "vfeeds"
932 :keep '(:nt-id)
933 :open t))
934 (use-local-map widget-keymap)
935 (widget-setup))
936 (newsticker-treeview-mode)))
937
938 (defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
939 vfeed)
940 "Return propertized copy of string TAG.
941 Optional argument NUM-NEW is used for choosing face, other
942 arguments NT-ID, FEED, and VFEED are added as properties."
943 ;;(message "newsticker--treeview-propertize-tag `%s' %s" feed nt-id)
944 (let ((face 'newsticker-treeview-face)
945 (map (make-sparse-keymap)))
946 (if (and num-new (> num-new 0))
947 (setq face 'newsticker-treeview-new-face))
948 (dolist (key '([mouse-1] [mouse-3]))
949 (define-key map key 'newsticker-treeview-tree-click))
950 (define-key map "\n" 'newsticker-treeview-tree-do-click)
951 (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
952 (propertize tag 'face face 'keymap map
953 :nt-id nt-id
954 :nt-feed feed
955 :nt-vfeed vfeed
956 'help-echo tag
957 'mouse-face 'highlight)))
958
959 (defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
960 &optional nt-id)
961 "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
962 Optional argument NT-ID is added to the tag's properties."
963 (let (tag (num-new 0))
964 (cond (vfeed-name
965 (cond ((string= vfeed-name "new")
966 (setq num-new (newsticker--stat-num-items-total 'new))
967 (setq tag (format "New items (%d)" num-new)))
968 ((string= vfeed-name "immortal")
969 (setq num-new (newsticker--stat-num-items-total 'immortal))
970 (setq tag (format "Immortal items (%d)" num-new)))
971 ((string= vfeed-name "obsolete")
972 (setq num-new (newsticker--stat-num-items-total 'obsolete))
973 (setq tag (format "Obsolete items (%d)" num-new)))
974 ((string= vfeed-name "all")
975 (setq num-new (newsticker--stat-num-items-total))
976 (setq tag (format "All items (%d)" num-new)))))
977 (feed-name
978 (setq num-new (newsticker--stat-num-items-for-group
979 (intern feed-name) 'new 'immortal))
980 (setq tag
981 (format "%s (%d)"
982 (newsticker--real-feed-name (intern feed-name))
983 num-new))))
984 (if tag
985 (newsticker--treeview-propertize-tag tag num-new
986 nt-id
987 feed-name vfeed-name))))
988
989 (defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
990 "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
991 ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
992 (let ((result (apply #'newsticker--stat-num-items feed-name-symbol ages)))
993 (mapc (lambda (f-n)
994 (setq result (+ result
995 (apply #'newsticker--stat-num-items (intern f-n)
996 ages))))
997 (newsticker--group-get-feeds
998 (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
999 result))
1000
1001 (defun newsticker--treeview-count-node-items (feed &optional isvirtual)
1002 "Count number of relevant items for a treeview node.
1003 FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
1004 the feed is a virtual feed."
1005 (let* ((num-new 0))
1006 (if feed
1007 (if isvirtual
1008 (cond ((string= feed "new")
1009 (setq num-new (newsticker--stat-num-items-total 'new)))
1010 ((string= feed "immortal")
1011 (setq num-new (newsticker--stat-num-items-total 'immortal)))
1012 ((string= feed "obsolete")
1013 (setq num-new (newsticker--stat-num-items-total 'obsolete)))
1014 ((string= feed "all")
1015 (setq num-new (newsticker--stat-num-items-total))))
1016 (setq num-new (newsticker--stat-num-items-for-group
1017 (intern feed) 'new 'immortal))))
1018 num-new))
1019
1020 (defun newsticker--treeview-tree-update-tag (w &optional recursive
1021 &rest _ignore)
1022 "Update tag for tree widget W.
1023 If RECURSIVE is non-nil recursively update parent widgets as
1024 well. Argument IGNORE is ignored. Note that this function, if
1025 called recursively, makes w invalid. You should keep w's nt-id in
1026 that case."
1027 (let* ((parent (widget-get w :parent))
1028 (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
1029 (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
1030 (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
1031 (num-new (newsticker--treeview-count-node-items (or feed vfeed)
1032 vfeed))
1033 (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
1034 (n (widget-get w :node)))
1035 (if parent
1036 (if recursive
1037 (newsticker--treeview-tree-update-tag parent)))
1038 (when tag
1039 (when n
1040 (widget-put n :tag tag))
1041 (widget-put w :num-new num-new)
1042 (widget-put w :tag tag)
1043 (when (marker-position (widget-get w :from))
1044 (let ((p (point)))
1045 ;; FIXME: This moves point!!!!
1046 (with-current-buffer (newsticker--treeview-tree-buffer)
1047 (widget-value-set w (widget-value w)))
1048 (goto-char p))))))
1049
1050 (defun newsticker--treeview-tree-do-update-tags (widget)
1051 "Actually recursively update tags for WIDGET."
1052 (save-excursion
1053 (let ((children (widget-get widget :children)))
1054 (dolist (w children)
1055 (newsticker--treeview-tree-do-update-tags w))
1056 (newsticker--treeview-tree-update-tag widget))))
1057
1058 (defun newsticker--treeview-tree-update-tags (&rest _ignore)
1059 "Update all tags of all trees.
1060 Arguments are ignored."
1061 (save-current-buffer
1062 (set-buffer (newsticker--treeview-tree-buffer))
1063 (let ((inhibit-read-only t))
1064 (newsticker--treeview-tree-do-update-tags
1065 newsticker--treeview-feed-tree)
1066 (newsticker--treeview-tree-do-update-tags
1067 newsticker--treeview-vfeed-tree))
1068 (tree-widget-set-theme "folder")))
1069
1070 (defun newsticker--treeview-tree-update-highlight ()
1071 "Update highlight in tree buffer."
1072 (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
1073 (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
1074 (setq pos (widget-get (widget-get
1075 (newsticker--treeview-get-current-node)
1076 :parent) :from)))
1077 (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
1078 (with-current-buffer (newsticker--treeview-tree-buffer)
1079 (goto-char pos)
1080 (move-overlay newsticker--tree-selection-overlay
1081 (point-at-bol) (1+ (point-at-eol))
1082 (current-buffer)))
1083 (if (window-live-p (newsticker--treeview-tree-window))
1084 (set-window-point (newsticker--treeview-tree-window) pos)))))
1085
1086 ;; ======================================================================
1087 ;;; Toolbar
1088 ;; ======================================================================
1089 (defvar newsticker-treeview-tool-bar-map
1090 (if (featurep 'xemacs)
1091 nil
1092 (if (boundp 'tool-bar-map)
1093 (let ((tool-bar-map (make-sparse-keymap)))
1094 (tool-bar-add-item "newsticker/prev-feed"
1095 'newsticker-treeview-prev-feed
1096 'newsticker-treeview-prev-feed
1097 :help "Go to previous feed"
1098 ;;:enable '(newsticker-previous-feed-available-p) FIXME
1099 )
1100 (tool-bar-add-item "newsticker/prev-item"
1101 'newsticker-treeview-prev-item
1102 'newsticker-treeview-prev-item
1103 :help "Go to previous item"
1104 ;;:enable '(newsticker-previous-item-available-p) FIXME
1105 )
1106 (tool-bar-add-item "newsticker/next-item"
1107 'newsticker-treeview-next-item
1108 'newsticker-treeview-next-item
1109 :visible t
1110 :help "Go to next item"
1111 ;;:enable '(newsticker-next-item-available-p) FIXME
1112 )
1113 (tool-bar-add-item "newsticker/next-feed"
1114 'newsticker-treeview-next-feed
1115 'newsticker-treeview-next-feed
1116 :help "Go to next feed"
1117 ;;:enable '(newsticker-next-feed-available-p) FIXME
1118 )
1119 (tool-bar-add-item "newsticker/mark-immortal"
1120 'newsticker-treeview-toggle-item-immortal
1121 'newsticker-treeview-toggle-item-immortal
1122 :help "Toggle current item as immortal"
1123 ;;:enable '(newsticker-item-not-immortal-p) FIXME
1124 )
1125 (tool-bar-add-item "newsticker/mark-read"
1126 'newsticker-treeview-mark-item-old
1127 'newsticker-treeview-mark-item-old
1128 :help "Mark current item as read"
1129 ;;:enable '(newsticker-item-not-old-p) FIXME
1130 )
1131 (tool-bar-add-item "newsticker/get-all"
1132 'newsticker-get-all-news
1133 'newsticker-get-all-news
1134 :help "Get news for all feeds")
1135 (tool-bar-add-item "newsticker/update"
1136 'newsticker-treeview-update
1137 'newsticker-treeview-update
1138 :help "Update newsticker buffer")
1139 (tool-bar-add-item "newsticker/browse-url"
1140 'newsticker-browse-url
1141 'newsticker-browse-url
1142 :help "Browse URL for item at point")
1143 ;; standard icons / actions
1144 (define-key tool-bar-map [newsticker-sep-1]
1145 (list 'menu-item "--double-line"))
1146 (tool-bar-add-item "close"
1147 'newsticker-treeview-quit
1148 'newsticker-treeview-quit
1149 :help "Close newsticker")
1150 (tool-bar-add-item "preferences"
1151 'newsticker-customize
1152 'newsticker-customize
1153 :help "Customize newsticker")
1154 tool-bar-map))))
1155
1156 ;; ======================================================================
1157 ;;; actions
1158 ;; ======================================================================
1159
1160 (defun newsticker-treeview-mouse-browse-url (event)
1161 "Call `browse-url' for the link of the item at which the EVENT occurred."
1162 (interactive "e")
1163 (save-excursion
1164 (switch-to-buffer (window-buffer (posn-window (event-end event))))
1165 (let ((url (get-text-property (posn-point (event-end event))
1166 :nt-link)))
1167 (when url
1168 (browse-url url)
1169 (if newsticker-automatically-mark-visited-items-as-old
1170 (newsticker-treeview-mark-item-old))))))
1171
1172 (defun newsticker-treeview-browse-url ()
1173 "Call `browse-url' for the link of the item at point."
1174 (interactive)
1175 (with-current-buffer (newsticker--treeview-list-buffer)
1176 (let ((url (get-text-property (point) :nt-link)))
1177 (when url
1178 (browse-url url)
1179 (if newsticker-automatically-mark-visited-items-as-old
1180 (newsticker-treeview-mark-item-old))))))
1181
1182 (defun newsticker--treeview-buffer-init ()
1183 "Initialize all treeview buffers."
1184 (setq newsticker--treeview-buffers nil)
1185 (add-to-list 'newsticker--treeview-buffers
1186 (get-buffer-create "*Newsticker Tree*") t)
1187 (add-to-list 'newsticker--treeview-buffers
1188 (get-buffer-create "*Newsticker List*") t)
1189 (add-to-list 'newsticker--treeview-buffers
1190 (get-buffer-create "*Newsticker Item*") t)
1191
1192 (unless newsticker--selection-overlay
1193 (with-current-buffer (newsticker--treeview-list-buffer)
1194 (setq buffer-undo-list t)
1195 (setq newsticker--selection-overlay (make-overlay (point-min)
1196 (point-max)))
1197 (overlay-put newsticker--selection-overlay 'face
1198 'newsticker-treeview-selection-face)))
1199 (unless newsticker--tree-selection-overlay
1200 (with-current-buffer (newsticker--treeview-tree-buffer)
1201 (setq buffer-undo-list t)
1202 (setq newsticker--tree-selection-overlay (make-overlay (point-min)
1203 (point-max)))
1204 (overlay-put newsticker--tree-selection-overlay 'face
1205 'newsticker-treeview-selection-face)))
1206
1207 (newsticker--treeview-tree-update)
1208 (newsticker--treeview-list-update t)
1209 (newsticker--treeview-item-update))
1210
1211 (defun newsticker-treeview-update ()
1212 "Update all treeview buffers and windows.
1213 Note: does not update the layout."
1214 (interactive)
1215 (let ((cur-item (newsticker--treeview-get-selected-item)))
1216 (if (newsticker--group-manage-orphan-feeds)
1217 (newsticker--treeview-tree-update))
1218 (newsticker--treeview-list-update t)
1219 (newsticker--treeview-item-update)
1220 (newsticker--treeview-tree-update-tags)
1221 (cond (newsticker--treeview-current-feed
1222 (newsticker--treeview-list-items newsticker--treeview-current-feed))
1223 (newsticker--treeview-current-vfeed
1224 (newsticker--treeview-list-items-with-age
1225 (intern newsticker--treeview-current-vfeed))))
1226 (newsticker--treeview-tree-update-highlight)
1227 (newsticker--treeview-list-update-highlight)
1228 (let ((cur-feed (or newsticker--treeview-current-feed
1229 newsticker--treeview-current-vfeed)))
1230 (if (and cur-feed cur-item)
1231 (newsticker--treeview-list-select cur-item)))))
1232
1233 (defun newsticker-treeview-quit ()
1234 "Quit newsticker treeview."
1235 (interactive)
1236 (setq newsticker--sentinel-callback nil)
1237 (bury-buffer "*Newsticker Tree*")
1238 (bury-buffer "*Newsticker List*")
1239 (bury-buffer "*Newsticker Item*")
1240 (set-window-configuration newsticker--saved-window-config)
1241 (when newsticker--frame
1242 (if (frame-live-p newsticker--frame)
1243 (delete-frame newsticker--frame))
1244 (setq newsticker--frame nil))
1245 (newsticker-treeview-save))
1246
1247 (defun newsticker-treeview-save ()
1248 "Save treeview group settings."
1249 (interactive)
1250 (let ((coding-system-for-write 'utf-8)
1251 (buf (find-file-noselect (concat newsticker-dir "/groups"))))
1252 (when buf
1253 (with-current-buffer buf
1254 (setq buffer-undo-list t)
1255 (erase-buffer)
1256 (insert ";; -*- coding: utf-8 -*-\n")
1257 (insert (prin1-to-string newsticker-groups))
1258 (save-buffer)
1259 (kill-buffer)))))
1260
1261 (defun newsticker--treeview-load ()
1262 "Load treeview settings."
1263 (let* ((coding-system-for-read 'utf-8)
1264 (filename
1265 (or (and newsticker-groups-filename
1266 (not (string=
1267 (expand-file-name newsticker-groups-filename)
1268 (expand-file-name (concat newsticker-dir "/groups"))))
1269 (file-exists-p newsticker-groups-filename)
1270 (y-or-n-p
1271 (format-message
1272 (concat "Obsolete variable `newsticker-groups-filename' "
1273 "points to existing file \"%s\".\n"
1274 "Read it? ")
1275 newsticker-groups-filename))
1276 newsticker-groups-filename)
1277 (concat newsticker-dir "/groups")))
1278 (buf (and (file-exists-p filename)
1279 (find-file-noselect filename))))
1280 (and newsticker-groups-filename
1281 (file-exists-p newsticker-groups-filename)
1282 (y-or-n-p (format-message
1283 (concat "Delete the file \"%s\",\nto which the obsolete "
1284 "variable `newsticker-groups-filename' points ? ")
1285 newsticker-groups-filename))
1286 (delete-file newsticker-groups-filename))
1287 (when buf
1288 (set-buffer buf)
1289 (goto-char (point-min))
1290 (condition-case nil
1291 (setq newsticker-groups (read buf))
1292 (error
1293 (message "Error while reading newsticker groups file!")
1294 (setq newsticker-groups nil)))
1295 (kill-buffer buf))))
1296
1297
1298 (defun newsticker-treeview-scroll-item ()
1299 "Scroll current item."
1300 (interactive)
1301 (save-selected-window
1302 (select-window (newsticker--treeview-item-window) t)
1303 (scroll-up 1)))
1304
1305 (defun newsticker-treeview-show-item ()
1306 "Show current item."
1307 (interactive)
1308 (newsticker--treeview-restore-layout)
1309 (newsticker--treeview-list-update-highlight)
1310 (with-current-buffer (newsticker--treeview-list-buffer)
1311 (beginning-of-line)
1312 (let ((item (get-text-property (point) :nt-item))
1313 (feed (get-text-property (point) :nt-feed)))
1314 (newsticker--treeview-item-show item feed)))
1315 (newsticker--treeview-tree-update-tag
1316 (newsticker--treeview-get-current-node) t)
1317 (newsticker--treeview-tree-update-highlight))
1318
1319 (defun newsticker-treeview-next-item ()
1320 "Move to next item."
1321 (interactive)
1322 (newsticker--treeview-restore-layout)
1323 (save-current-buffer
1324 (set-buffer (newsticker--treeview-list-buffer))
1325 (if (newsticker--treeview-list-highlight-start)
1326 (forward-line 1))
1327 (if (eobp)
1328 (forward-line -1)))
1329 (newsticker-treeview-show-item))
1330
1331 (defun newsticker-treeview-prev-item ()
1332 "Move to previous item."
1333 (interactive)
1334 (newsticker--treeview-restore-layout)
1335 (save-current-buffer
1336 (set-buffer (newsticker--treeview-list-buffer))
1337 (forward-line -1))
1338 (newsticker-treeview-show-item))
1339
1340 (defun newsticker-treeview-next-new-or-immortal-item (&optional
1341 current-item-counts
1342 dont-wrap-trees)
1343 "Move to next new or immortal item.
1344 Will move to next feed until an item is found. Will not move if
1345 optional argument CURRENT-ITEM-COUNTS is t and current item is
1346 new or immortal. Will not move from virtual to ordinary feed
1347 tree or vice versa if optional argument DONT-WRAP-TREES is non-nil."
1348 (interactive)
1349 (newsticker--treeview-restore-layout)
1350 (newsticker--treeview-list-clear-highlight)
1351 (unless (catch 'found
1352 (let ((move (not current-item-counts)))
1353 (while t
1354 (save-current-buffer
1355 (set-buffer (newsticker--treeview-list-buffer))
1356 (when move (forward-line 1)
1357 (when (eobp)
1358 (forward-line -1)
1359 (throw 'found nil))))
1360 (when (memq (newsticker--age
1361 (newsticker--treeview-get-selected-item))
1362 '(new immortal))
1363 (newsticker-treeview-show-item)
1364 (throw 'found t))
1365 (setq move t))))
1366 (let ((wrap-trees (not dont-wrap-trees)))
1367 (when (or (newsticker-treeview-next-feed t)
1368 (and wrap-trees (newsticker--treeview-first-feed)))
1369 (newsticker-treeview-next-new-or-immortal-item t t)))))
1370
1371 (defun newsticker-treeview-prev-new-or-immortal-item ()
1372 "Move to previous new or immortal item.
1373 Will move to previous feed until an item is found."
1374 (interactive)
1375 (newsticker--treeview-restore-layout)
1376 (newsticker--treeview-list-clear-highlight)
1377 (unless (catch 'found
1378 (while t
1379 (save-current-buffer
1380 (set-buffer (newsticker--treeview-list-buffer))
1381 (when (bobp)
1382 (throw 'found nil))
1383 (forward-line -1))
1384 (when (memq (newsticker--age
1385 (newsticker--treeview-get-selected-item))
1386 '(new immortal))
1387 (newsticker-treeview-show-item)
1388 (throw 'found t))
1389 (when (bobp)
1390 (throw 'found nil))))
1391 (when (newsticker-treeview-prev-feed t)
1392 (set-buffer (newsticker--treeview-list-buffer))
1393 (goto-char (point-max))
1394 (newsticker-treeview-prev-new-or-immortal-item))))
1395
1396 (defun newsticker--treeview-get-selected-item ()
1397 "Return item that is currently selected in list buffer."
1398 (with-current-buffer (newsticker--treeview-list-buffer)
1399 (beginning-of-line)
1400 (get-text-property (point) :nt-item)))
1401
1402 (defun newsticker-treeview-mark-item-old (&optional dont-proceed)
1403 "Mark current item as old unless it is obsolete.
1404 Move to next item unless DONT-PROCEED is non-nil."
1405 (interactive)
1406 (let ((item (newsticker--treeview-get-selected-item)))
1407 (unless (eq (newsticker--age item) 'obsolete)
1408 (newsticker--treeview-mark-item item 'old)))
1409 (unless dont-proceed
1410 (newsticker-treeview-next-item)))
1411
1412 (defun newsticker-treeview-toggle-item-immortal ()
1413 "Toggle immortality of current item."
1414 (interactive)
1415 (let* ((item (newsticker--treeview-get-selected-item))
1416 (new-age (if (eq (newsticker--age item) 'immortal)
1417 'old
1418 'immortal)))
1419 (newsticker--treeview-mark-item item new-age)
1420 (newsticker-treeview-next-item)))
1421
1422 (defun newsticker--treeview-mark-item (item new-age)
1423 "Mark ITEM with NEW-AGE."
1424 (when item
1425 (setcar (nthcdr 4 item) new-age)
1426 ;; clean up ticker FIXME
1427 )
1428 (newsticker--cache-save-feed
1429 (newsticker--cache-get-feed (intern newsticker--treeview-current-feed)))
1430 (newsticker--treeview-tree-do-update-tags newsticker--treeview-vfeed-tree))
1431
1432 (defun newsticker-treeview-mark-list-items-old ()
1433 "Mark all listed items as old."
1434 (interactive)
1435 (let ((current-feed (or newsticker--treeview-current-feed
1436 newsticker--treeview-current-vfeed)))
1437 (with-current-buffer (newsticker--treeview-list-buffer)
1438 (goto-char (point-min))
1439 (while (not (eobp))
1440 (let ((item (get-text-property (point) :nt-item)))
1441 (unless (memq (newsticker--age item) '(immortal obsolete))
1442 (newsticker--treeview-mark-item item 'old)))
1443 (forward-line 1)))
1444 (newsticker--treeview-tree-update-tags)
1445 (if current-feed
1446 (newsticker-treeview-jump current-feed))))
1447
1448 (defun newsticker-treeview-save-item ()
1449 "Save current item."
1450 (interactive)
1451 (newsticker-save-item (or newsticker--treeview-current-feed
1452 newsticker--treeview-current-vfeed)
1453 (newsticker--treeview-get-selected-item)))
1454
1455 (defun newsticker-treeview-browse-url-item ()
1456 "Convert current item to HTML and call `browse-url' on result."
1457 (interactive)
1458 (newsticker-browse-url-item (or newsticker--treeview-current-feed
1459 newsticker--treeview-current-vfeed)
1460 (newsticker--treeview-get-selected-item)))
1461
1462 (defun newsticker--treeview-set-current-node (node)
1463 "Make NODE the current node."
1464 (with-current-buffer (newsticker--treeview-tree-buffer)
1465 (setq newsticker--treeview-current-node-id
1466 (widget-get node :nt-id))
1467 (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
1468 (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
1469 (newsticker--treeview-tree-update-highlight)))
1470
1471 (defun newsticker--treeview-get-first-child (node)
1472 "Get first child of NODE."
1473 (let ((children (widget-get node :children)))
1474 (if children
1475 (car children)
1476 nil)))
1477
1478 (defun newsticker--treeview-get-second-child (node)
1479 "Get scond child of NODE."
1480 (let ((children (widget-get node :children)))
1481 (if children
1482 (car (cdr children))
1483 nil)))
1484
1485 (defun newsticker--treeview-get-last-child (node)
1486 "Get last child of NODE."
1487 ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
1488 (let ((children (widget-get node :children)))
1489 (if children
1490 (car (reverse children))
1491 nil)))
1492
1493 (defun newsticker--treeview-get-feed-vfeed (node)
1494 "Get (virtual) feed of NODE."
1495 (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
1496
1497 (defun newsticker--treeview-get-next-sibling (node)
1498 "Get next sibling of NODE."
1499 (let ((parent (widget-get node :parent)))
1500 (catch 'found
1501 (let ((children (widget-get parent :children)))
1502 (while children
1503 (if (newsticker--treeview-nodes-eq (car children) node)
1504 (throw 'found (car (cdr children))))
1505 (setq children (cdr children)))))))
1506
1507 (defun newsticker--treeview-get-prev-sibling (node)
1508 "Get previous sibling of NODE."
1509 (let ((parent (widget-get node :parent)))
1510 (catch 'found
1511 (let ((children (widget-get parent :children))
1512 (prev nil))
1513 (while children
1514 (if (and (newsticker--treeview-nodes-eq (car children) node)
1515 (widget-get prev :nt-id))
1516 (throw 'found prev))
1517 (setq prev (car children))
1518 (setq children (cdr children)))))))
1519
1520 (defun newsticker--treeview-get-next-uncle (node)
1521 "Get next uncle of NODE, i.e. parent's next sibling."
1522 (let* ((parent (widget-get node :parent))
1523 (grand-parent (widget-get parent :parent)))
1524 (catch 'found
1525 (let ((uncles (widget-get grand-parent :children)))
1526 (while uncles
1527 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1528 (throw 'found (car (cdr uncles))))
1529 (setq uncles (cdr uncles)))))))
1530
1531 (defun newsticker--treeview-get-prev-uncle (node)
1532 "Get previous uncle of NODE, i.e. parent's previous sibling."
1533 (let* ((parent (widget-get node :parent))
1534 (grand-parent (widget-get parent :parent)))
1535 (catch 'found
1536 (let ((uncles (widget-get grand-parent :children))
1537 (prev nil))
1538 (while uncles
1539 (if (newsticker--treeview-nodes-eq (car uncles) parent)
1540 (throw 'found prev))
1541 (setq prev (car uncles))
1542 (setq uncles (cdr uncles)))))))
1543
1544 (defun newsticker--treeview-get-other-tree ()
1545 "Get other tree."
1546 (if (and (newsticker--treeview-get-current-node)
1547 (widget-get (newsticker--treeview-get-current-node) :nt-feed))
1548 newsticker--treeview-vfeed-tree
1549 newsticker--treeview-feed-tree))
1550
1551 (defun newsticker--treeview-activate-node (node &optional backward)
1552 "Activate NODE.
1553 If NODE is a tree widget the node's first subnode is activated.
1554 If BACKWARD is non-nil the last subnode of the previous sibling
1555 is activated."
1556 (newsticker--treeview-set-current-node node)
1557 (save-current-buffer
1558 (set-buffer (newsticker--treeview-tree-buffer))
1559 (cond ((eq (widget-type node) 'tree-widget)
1560 (unless (widget-get node :open)
1561 (widget-put node :open nil)
1562 (widget-apply-action node))
1563 (newsticker--treeview-activate-node
1564 (if backward
1565 (newsticker--treeview-get-last-child node)
1566 (newsticker--treeview-get-second-child node))))
1567 (node
1568 (widget-apply-action node)))))
1569
1570 (defun newsticker--treeview-first-feed ()
1571 "Jump to the depth-first feed in the `newsticker-groups' tree."
1572 (newsticker-treeview-jump
1573 (car (reverse (newsticker--group-get-feeds newsticker-groups t)))))
1574
1575 (defun newsticker-treeview-next-feed (&optional stay-in-tree)
1576 "Move to next feed.
1577 Optional argument STAY-IN-TREE prevents moving from real feed
1578 tree to virtual feed tree or vice versa.
1579 Return t if a new feed was activated, nil otherwise."
1580 (interactive)
1581 (newsticker--treeview-restore-layout)
1582 (let ((cur (newsticker--treeview-get-current-node))
1583 (new nil))
1584 (setq new
1585 (if cur
1586 (or (newsticker--treeview-get-next-sibling cur)
1587 (newsticker--treeview-get-next-uncle cur)
1588 (and (not stay-in-tree)
1589 (newsticker--treeview-get-other-tree)))
1590 (car (widget-get newsticker--treeview-feed-tree :children))))
1591 (if new
1592 (progn
1593 (newsticker--treeview-activate-node new)
1594 (newsticker--treeview-tree-update-highlight)
1595 (not (eq new cur)))
1596 nil)))
1597
1598 (defun newsticker-treeview-prev-feed (&optional stay-in-tree)
1599 "Move to previous feed.
1600 Optional argument STAY-IN-TREE prevents moving from real feed
1601 tree to virtual feed tree or vice versa.
1602 Return t if a new feed was activated, nil otherwise."
1603 (interactive)
1604 (newsticker--treeview-restore-layout)
1605 (let ((cur (newsticker--treeview-get-current-node))
1606 (new nil))
1607 (if cur
1608 (progn
1609 (setq new
1610 (if cur
1611 (or (newsticker--treeview-get-prev-sibling cur)
1612 (newsticker--treeview-get-prev-uncle cur)
1613 (and (not stay-in-tree)
1614 (newsticker--treeview-get-other-tree)))
1615 (car (widget-get newsticker--treeview-feed-tree :children))))
1616 (if new
1617 (progn
1618 (newsticker--treeview-activate-node new t)
1619 (newsticker--treeview-tree-update-highlight)
1620 (not (eq new cur)))
1621 nil))
1622 nil)))
1623
1624 (defun newsticker-treeview-next-page ()
1625 "Scroll item buffer."
1626 (interactive)
1627 (save-selected-window
1628 (select-window (newsticker--treeview-item-window) t)
1629 (condition-case nil
1630 (scroll-up nil)
1631 (error
1632 (goto-char (point-min))))))
1633
1634
1635 (defun newsticker--treeview-unfold-node (feed-name)
1636 "Recursively show subtree above the node that represents FEED-NAME."
1637 (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
1638 (unless node
1639 (let* ((group-name (car (newsticker--group-find-parent-group
1640 feed-name))))
1641 (newsticker--treeview-unfold-node group-name))
1642 (setq node (newsticker--treeview-get-node-of-feed feed-name)))
1643 (when node
1644 (with-current-buffer (newsticker--treeview-tree-buffer)
1645 (widget-put node :nt-selected t)
1646 (widget-apply-action node)
1647 (newsticker--treeview-set-current-node node)))))
1648
1649 (defun newsticker-treeview-jump (feed-name)
1650 "Jump to feed FEED-NAME in newsticker treeview."
1651 (interactive
1652 (list (let ((completion-ignore-case t))
1653 (completing-read
1654 "Jump to feed: "
1655 (append '("new" "obsolete" "immortal" "all")
1656 (mapcar #'car (append newsticker-url-list
1657 newsticker-url-list-defaults)))
1658 nil t))))
1659 (newsticker--treeview-unfold-node feed-name))
1660
1661 ;; ======================================================================
1662 ;;; Groups
1663 ;; ======================================================================
1664 (defun newsticker--group-do-find-group (feed-or-group-name parent-node node)
1665 "Recursively find FEED-OR-GROUP-NAME in PARENT-NODE or NODE."
1666 (cond ((stringp node)
1667 (when (string= feed-or-group-name node)
1668 (throw 'found parent-node)))
1669 ((listp node)
1670 (cond ((string= feed-or-group-name (car node))
1671 (throw 'found parent-node))
1672 ((member feed-or-group-name (cdr node))
1673 (throw 'found node))
1674 (t
1675 (mapc (lambda (n)
1676 (if (listp n)
1677 (newsticker--group-do-find-group
1678 feed-or-group-name node n)))
1679 (cdr node)))))))
1680
1681 (defun newsticker--group-find-parent-group (feed-or-group-name)
1682 "Find group containing FEED-OR-GROUP-NAME."
1683 (catch 'found
1684 (mapc (lambda (n)
1685 (newsticker--group-do-find-group feed-or-group-name
1686 newsticker-groups
1687 n))
1688 newsticker-groups)
1689 nil))
1690
1691 (defun newsticker--group-do-get-group (name node)
1692 "Recursively find group with NAME below NODE."
1693 (if (string= name (car node))
1694 (throw 'found node)
1695 (mapc (lambda (n)
1696 (if (listp n)
1697 (newsticker--group-do-get-group name n)))
1698 (cdr node))))
1699
1700 (defun newsticker--group-get-group (name)
1701 "Find group with NAME."
1702 (catch 'found
1703 (mapc (lambda (n)
1704 (if (listp n)
1705 (newsticker--group-do-get-group name n)))
1706 newsticker-groups)
1707 nil))
1708
1709 (defun newsticker--group-get-subgroups (group &optional recursive)
1710 "Return list of subgroups for GROUP.
1711 If RECURSIVE is non-nil recursively get subgroups and return a nested list."
1712 (let ((result nil))
1713 (mapc (lambda (n)
1714 (when (listp n)
1715 (setq result (cons (car n) result))
1716 (let ((subgroups (newsticker--group-get-subgroups n recursive)))
1717 (when subgroups
1718 (setq result (append subgroups result))))))
1719 group)
1720 result))
1721
1722 (defun newsticker--group-all-groups ()
1723 "Return nested list of all groups."
1724 (newsticker--group-get-subgroups newsticker-groups t))
1725
1726 (defun newsticker--group-get-feeds (group &optional recursive)
1727 "Return list of all feeds in GROUP.
1728 If RECURSIVE is non-nil recursively get feeds of subgroups and
1729 return a nested list."
1730 (let ((result nil))
1731 (mapc (lambda (n)
1732 (if (not (listp n))
1733 (setq result (cons n result))
1734 (if recursive
1735 (let ((subfeeds (newsticker--group-get-feeds n t)))
1736 (when subfeeds
1737 (setq result (append subfeeds result)))))))
1738 (cdr group))
1739 result))
1740
1741 (defun newsticker-group-add-group (name parent)
1742 "Add group NAME to group PARENT."
1743 (interactive
1744 (list (read-string "Name of new group: ")
1745 (let ((completion-ignore-case t))
1746 (completing-read "Name of parent group (optional): " (newsticker--group-all-groups)
1747 nil t))))
1748 (if (newsticker--group-get-group name)
1749 (error "Group %s exists already" name))
1750 (let ((p (if (and parent (not (string= parent "")))
1751 (newsticker--group-get-group parent)
1752 newsticker-groups)))
1753 (unless p
1754 (error "Parent %s does not exist" parent))
1755 (setcdr p (cons (list name) (cdr p))))
1756 (newsticker--treeview-tree-update)
1757 (newsticker-treeview-jump newsticker--treeview-current-feed))
1758
1759 (defun newsticker-group-delete-group (name)
1760 "Delete group NAME."
1761 (interactive
1762 (list (let ((completion-ignore-case t))
1763 (completing-read "Delete group: "
1764 (newsticker--group-names)
1765 nil t (car (newsticker--group-find-parent-group
1766 newsticker--treeview-current-feed))))))
1767 (let ((parent-group (newsticker--group-find-parent-group name)))
1768 (unless parent-group
1769 (error "Parent %s does not exist" parent-group))
1770 (setcdr parent-group (cl-delete-if (lambda (g)
1771 (and (listp g)
1772 (string= name (car g))))
1773 (cdr parent-group)))
1774 (newsticker--group-manage-orphan-feeds)
1775 (newsticker--treeview-tree-update)
1776 (newsticker-treeview-update)
1777 (newsticker-treeview-jump newsticker--treeview-current-feed)))
1778
1779 (defun newsticker--group-do-rename-group (old-name new-name)
1780 "Actually rename group OLD-NAME to NEW-NAME."
1781 (let ((parent-group (newsticker--group-find-parent-group old-name)))
1782 (unless parent-group
1783 (error "Parent of %s does not exist" old-name))
1784 (mapcar (lambda (elt)
1785 (cond ((and (listp elt)
1786 (string= old-name (car elt)))
1787 (cons new-name (cdr elt)))
1788 (t
1789 elt)))
1790 parent-group)))
1791
1792 (defun newsticker-group-rename-group (old-name new-name)
1793 "Rename group OLD-NAME to NEW-NAME."
1794 (interactive
1795 (list (let* ((completion-ignore-case t))
1796 (completing-read "Rename group: "
1797 (newsticker--group-names)
1798 nil t (car (newsticker--group-find-parent-group
1799 newsticker--treeview-current-feed))))
1800 (read-string "Rename to: ")))
1801 (setq newsticker-groups (newsticker--group-do-rename-group old-name new-name))
1802 (newsticker--group-manage-orphan-feeds)
1803 (newsticker--treeview-tree-update)
1804 (newsticker-treeview-update)
1805 (newsticker-treeview-jump newsticker--treeview-current-feed))
1806
1807 (defun newsticker--get-group-names (lst)
1808 "Do get the group names from LST."
1809 (delete nil (cons (car lst)
1810 (apply #'append
1811 (mapcar (lambda (e)
1812 (cond ((listp e)
1813 (newsticker--get-group-names e))
1814 (t
1815 nil)))
1816 (cdr lst))))))
1817
1818 (defun newsticker--group-names ()
1819 "Get names of all newsticker groups."
1820 (newsticker--get-group-names newsticker-groups))
1821
1822 (defun newsticker-group-move-feed (name group-name &optional no-update)
1823 "Move feed NAME to group GROUP-NAME.
1824 Update treeview afterwards unless NO-UPDATE is non-nil."
1825 (interactive
1826 (let ((completion-ignore-case t))
1827 (list (completing-read "Name of feed or group to move: "
1828 (append (mapcar #'car newsticker-url-list)
1829 (newsticker--group-names))
1830 nil t newsticker--treeview-current-feed)
1831 (completing-read "Name of new parent group: " (newsticker--group-names)
1832 nil t))))
1833 (let* ((group (if (and group-name (not (string= group-name "")))
1834 (newsticker--group-get-group group-name)
1835 newsticker-groups))
1836 (moving-group-p (member name (newsticker--group-names)))
1837 (moved-thing (if moving-group-p
1838 (newsticker--group-get-group name)
1839 name)))
1840 (unless group
1841 (error "Group %s does not exist" group-name))
1842 (while (let ((old-group
1843 (newsticker--group-find-parent-group name)))
1844 (when old-group
1845 (delete moved-thing old-group))
1846 old-group))
1847 (setcdr group (cons moved-thing (cdr group)))
1848 (unless no-update
1849 (newsticker--treeview-tree-update)
1850 (newsticker-treeview-update)
1851 (newsticker-treeview-jump name))))
1852
1853 (defun newsticker-group-shift-feed-down ()
1854 "Shift current feed down in its group."
1855 (interactive)
1856 (newsticker--group-shift 1))
1857
1858 (defun newsticker-group-shift-feed-up ()
1859 "Shift current feed down in its group."
1860 (interactive)
1861 (newsticker--group-shift -1))
1862
1863 (defun newsticker-group-shift-group-down ()
1864 "Shift current group down in its group."
1865 (interactive)
1866 (newsticker--group-shift 1 t))
1867
1868 (defun newsticker-group-shift-group-up ()
1869 "Shift current group down in its group."
1870 (interactive)
1871 (newsticker--group-shift -1 t))
1872
1873 (defun newsticker--group-shift (delta &optional move-group)
1874 "Shift current feed or group within its parent group.
1875 DELTA is an integer which specifies the direction and the amount
1876 of the shift. If MOVE-GROUP is nil the currently selected feed
1877 `newsticker--treeview-current-feed' is shifted, if it is t then
1878 the current feed's parent group is shifted.."
1879 (let* ((cur-feed newsticker--treeview-current-feed)
1880 (thing (if move-group
1881 (newsticker--group-find-parent-group cur-feed)
1882 cur-feed))
1883 (parent-group (newsticker--group-find-parent-group
1884 (if move-group (car thing) thing))))
1885 (unless parent-group
1886 (error "Group not found!"))
1887 (let* ((siblings (cdr parent-group))
1888 (pos (cl-position thing siblings :test 'equal))
1889 (tpos (+ pos delta ))
1890 (new-pos (max 0 (min (length siblings) tpos)))
1891 (beg (cl-subseq siblings 0 (min pos new-pos)))
1892 (end (cl-subseq siblings (+ 1 (max pos new-pos))))
1893 (p (elt siblings new-pos)))
1894 (when (not (= pos new-pos))
1895 (setcdr parent-group
1896 (cl-concatenate 'list
1897 beg
1898 (if (> delta 0)
1899 (list p thing)
1900 (list thing p))
1901 end))
1902 (newsticker--treeview-tree-update)
1903 (newsticker-treeview-update)
1904 (newsticker-treeview-jump cur-feed)))))
1905
1906 (defun newsticker--count-groups (group)
1907 "Recursively count number of subgroups of GROUP."
1908 (let ((result 1))
1909 (mapc (lambda (g)
1910 (if (listp g)
1911 (setq result (+ result (newsticker--count-groups g)))))
1912 (cdr group))
1913 result))
1914
1915 (defun newsticker--count-grouped-feeds (group)
1916 "Recursively count number of feeds in GROUP and its subgroups."
1917 (let ((result 0))
1918 (mapc (lambda (g)
1919 (if (listp g)
1920 (setq result (+ result (newsticker--count-grouped-feeds g)))
1921 (setq result (1+ result))))
1922 (cdr group))
1923 result))
1924
1925 (defun newsticker--group-remove-obsolete-feeds (group)
1926 "Recursively remove obsolete feeds from GROUP."
1927 (let ((result nil)
1928 (urls (append newsticker-url-list newsticker-url-list-defaults)))
1929 (mapc (lambda (g)
1930 (if (listp g)
1931 (let ((sub-groups
1932 (newsticker--group-remove-obsolete-feeds g)))
1933 (if sub-groups
1934 (setq result (cons sub-groups result))))
1935 (if (assoc g urls)
1936 (setq result (cons g result)))))
1937 (cdr group))
1938 (if result
1939 (cons (car group) (reverse result))
1940 result)))
1941
1942 (defun newsticker--group-manage-orphan-feeds ()
1943 "Put unmanaged feeds into `newsticker-groups'.
1944 Remove obsolete feeds as well.
1945 Return t if groups have changed, nil otherwise."
1946 (unless newsticker-groups
1947 (setq newsticker-groups '("Feeds")))
1948 (let ((new-feed nil)
1949 (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
1950 (mapc (lambda (f)
1951 (unless (newsticker--group-find-parent-group (car f))
1952 (setq new-feed t)
1953 (newsticker-group-move-feed (car f) nil t)))
1954 (append newsticker-url-list-defaults newsticker-url-list))
1955 (setq newsticker-groups
1956 (newsticker--group-remove-obsolete-feeds newsticker-groups))
1957 (or new-feed
1958 (not (= grouped-feeds
1959 (newsticker--count-grouped-feeds newsticker-groups))))))
1960
1961 ;; ======================================================================
1962 ;;; Modes
1963 ;; ======================================================================
1964 (defun newsticker--treeview-tree-open-menu (event)
1965 "Open tree menu at position of EVENT."
1966 (let* ((feed-name newsticker--treeview-current-feed)
1967 (menu (make-sparse-keymap feed-name)))
1968 (define-key menu [newsticker-treeview-mark-list-items-old]
1969 (list 'menu-item "Mark all items old"
1970 'newsticker-treeview-mark-list-items-old))
1971 (define-key menu [newsticker-treeview-get-news]
1972 (list 'menu-item (concat "Get news for " feed-name)
1973 'newsticker-treeview-get-news))
1974 (define-key menu [newsticker-get-all-news]
1975 (list 'menu-item "Get news for all feeds"
1976 'newsticker-get-all-news))
1977 (let ((choice (x-popup-menu event menu)))
1978 (when choice
1979 (funcall (car choice))))))
1980
1981 (defvar newsticker-treeview-list-menu
1982 (let ((menu (make-sparse-keymap "Newsticker List")))
1983 (define-key menu [newsticker-treeview-mark-list-items-old]
1984 (list 'menu-item "Mark all items old"
1985 'newsticker-treeview-mark-list-items-old))
1986 (define-key menu [newsticker-treeview-mark-item-old]
1987 (list 'menu-item "Mark current item old"
1988 'newsticker-treeview-mark-item-old))
1989 (define-key menu [newsticker-treeview-toggle-item-immortal]
1990 (list 'menu-item "Mark current item immortal (toggle)"
1991 'newsticker-treeview-toggle-item-immortal))
1992 (define-key menu [newsticker-treeview-get-news]
1993 (list 'menu-item "Get news for current feed"
1994 'newsticker-treeview-get-news))
1995 menu)
1996 "Map for newsticker list menu.")
1997
1998 (defvar newsticker-treeview-item-menu
1999 (let ((menu (make-sparse-keymap "Newsticker Item")))
2000 (define-key menu [newsticker-treeview-mark-item-old]
2001 (list 'menu-item "Mark current item old"
2002 'newsticker-treeview-mark-item-old))
2003 (define-key menu [newsticker-treeview-toggle-item-immortal]
2004 (list 'menu-item "Mark current item immortal (toggle)"
2005 'newsticker-treeview-toggle-item-immortal))
2006 (define-key menu [newsticker-treeview-get-news]
2007 (list 'menu-item "Get news for current feed"
2008 'newsticker-treeview-get-news))
2009 menu)
2010 "Map for newsticker item menu.")
2011
2012 (defvar newsticker-treeview-mode-map
2013 (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
2014 (define-key map " " 'newsticker-treeview-next-page)
2015 (define-key map "a" 'newsticker-add-url)
2016 (define-key map "b" 'newsticker-treeview-browse-url-item)
2017 (define-key map "F" 'newsticker-treeview-prev-feed)
2018 (define-key map "f" 'newsticker-treeview-next-feed)
2019 (define-key map "g" 'newsticker-treeview-get-news)
2020 (define-key map "G" 'newsticker-get-all-news)
2021 (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
2022 (define-key map "j" 'newsticker-treeview-jump)
2023 (define-key map "n" 'newsticker-treeview-next-item)
2024 (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
2025 (define-key map "O" 'newsticker-treeview-mark-list-items-old)
2026 (define-key map "o" 'newsticker-treeview-mark-item-old)
2027 (define-key map "p" 'newsticker-treeview-prev-item)
2028 (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
2029 (define-key map "q" 'newsticker-treeview-quit)
2030 (define-key map "S" 'newsticker-treeview-save-item)
2031 (define-key map "s" 'newsticker-treeview-save)
2032 (define-key map "u" 'newsticker-treeview-update)
2033 (define-key map "v" 'newsticker-treeview-browse-url)
2034 ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
2035 ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
2036 (define-key map "\M-m" 'newsticker-group-move-feed)
2037 (define-key map "\M-a" 'newsticker-group-add-group)
2038 (define-key map "\M-d" 'newsticker-group-delete-group)
2039 (define-key map "\M-r" 'newsticker-group-rename-group)
2040 (define-key map [M-down] 'newsticker-group-shift-feed-down)
2041 (define-key map [M-up] 'newsticker-group-shift-feed-up)
2042 (define-key map [M-S-down] 'newsticker-group-shift-group-down)
2043 (define-key map [M-S-up] 'newsticker-group-shift-group-up)
2044 map)
2045 "Mode map for newsticker treeview.")
2046
2047 (define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV"
2048 "Major mode for Newsticker Treeview.
2049 \\{newsticker-treeview-mode-map}"
2050 (if (boundp 'tool-bar-map)
2051 (set (make-local-variable 'tool-bar-map)
2052 newsticker-treeview-tool-bar-map))
2053 (setq buffer-read-only t
2054 truncate-lines t))
2055
2056 (define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
2057 "Item List"
2058 (let ((header (concat
2059 (propertize " " 'display '(space :align-to 0))
2060 (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
2061 (propertize " " 'display '(space :align-to 2))
2062 (if newsticker--treeview-list-show-feed
2063 (concat "Feed"
2064 (propertize " " 'display '(space :align-to 12)))
2065 "")
2066 (newsticker-treeview-list-make-sort-button "Date"
2067 'sort-by-time)
2068 (if newsticker--treeview-list-show-feed
2069 (propertize " " 'display '(space :align-to 28))
2070 (propertize " " 'display '(space :align-to 18)))
2071 (newsticker-treeview-list-make-sort-button "Title"
2072 'sort-by-title))))
2073 (setq header-line-format header))
2074 (define-key newsticker-treeview-list-mode-map [down-mouse-3]
2075 newsticker-treeview-list-menu))
2076
2077 (define-derived-mode newsticker-treeview-item-mode newsticker-treeview-mode
2078 "Item"
2079 (define-key newsticker-treeview-item-mode-map [down-mouse-3]
2080 newsticker-treeview-item-menu))
2081
2082 (defun newsticker-treeview-tree-click (event)
2083 "Handle click EVENT on a tag in the newsticker tree."
2084 (interactive "e")
2085 (newsticker--treeview-restore-layout)
2086 (save-excursion
2087 (switch-to-buffer (window-buffer (posn-window (event-end event))))
2088 (newsticker-treeview-tree-do-click (posn-point (event-end event)) event)))
2089
2090 (defun newsticker-treeview-tree-do-click (&optional pos event)
2091 "Actually handle click event.
2092 POS gives the position where EVENT occurred."
2093 (interactive)
2094 (let* ((pos (or pos (point)))
2095 (nt-id (get-text-property pos :nt-id))
2096 (item (get-text-property pos :nt-item)))
2097 (cond (item
2098 ;; click in list buffer
2099 (newsticker-treeview-show-item))
2100 (t
2101 ;; click in tree buffer
2102 (let ((w (newsticker--treeview-get-node-by-id nt-id)))
2103 (when w
2104 (newsticker--treeview-tree-update-tag w t t)
2105 (setq w (newsticker--treeview-get-node-by-id nt-id))
2106 (widget-put w :nt-selected t)
2107 (widget-apply w :action event)
2108 (newsticker--treeview-set-current-node w)
2109 (and event
2110 (eq 'mouse-3 (car event))
2111 (sit-for 0)
2112 (newsticker--treeview-tree-open-menu event)))))))
2113 (newsticker--treeview-tree-update-highlight))
2114
2115 (defun newsticker--treeview-restore-layout ()
2116 "Restore treeview buffers."
2117 (catch 'error
2118 (dotimes (i 3)
2119 (let ((win (nth i newsticker--treeview-windows))
2120 (buf (nth i newsticker--treeview-buffers)))
2121 (unless (window-live-p win)
2122 (newsticker--treeview-window-init)
2123 (newsticker--treeview-buffer-init)
2124 (throw 'error t))
2125 (unless (eq (window-buffer win) buf)
2126 (set-window-buffer win buf t))))))
2127
2128 (defun newsticker--treeview-frame-init ()
2129 "Initialize treeview frame."
2130 (when newsticker-treeview-own-frame
2131 (unless (and newsticker--frame (frame-live-p newsticker--frame))
2132 (setq newsticker--frame (make-frame '((name . "Newsticker")))))
2133 (select-frame-set-input-focus newsticker--frame)
2134 (raise-frame newsticker--frame)))
2135
2136 (defun newsticker--treeview-window-init ()
2137 "Initialize treeview windows."
2138 (setq newsticker--saved-window-config (current-window-configuration))
2139 (setq newsticker--treeview-windows nil)
2140 (setq newsticker--treeview-buffers nil)
2141 (delete-other-windows)
2142 (split-window-right newsticker-treeview-treewindow-width)
2143 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2144 (other-window 1)
2145 (split-window-below newsticker-treeview-listwindow-height)
2146 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2147 (other-window 1)
2148 (add-to-list 'newsticker--treeview-windows (selected-window) t)
2149 (other-window 1))
2150
2151 ;;;###autoload
2152 (defun newsticker-treeview ()
2153 "Start newsticker treeview."
2154 (interactive)
2155 (newsticker--treeview-load)
2156 (setq newsticker--sentinel-callback 'newsticker-treeview-update)
2157 (newsticker--treeview-frame-init)
2158 (newsticker--treeview-window-init)
2159 (newsticker--treeview-buffer-init)
2160 (if (newsticker--group-manage-orphan-feeds)
2161 (newsticker--treeview-tree-update))
2162 (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
2163 (newsticker-start t) ;; will start only if not running
2164 (newsticker-treeview-update)
2165 (newsticker--treeview-item-show-text
2166 "Newsticker"
2167 "Welcome to newsticker!"))
2168
2169 (defun newsticker-treeview-get-news ()
2170 "Get news for current feed."
2171 (interactive)
2172 (when newsticker--treeview-current-feed
2173 (newsticker-get-news newsticker--treeview-current-feed)))
2174
2175 (provide 'newst-treeview)
2176
2177 ;;; newst-treeview.el ends here