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