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