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