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