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