Mercurial > emacs
comparison lisp/net/newst-plainview.el @ 95901:b4bd9957663d
Renamed newsticker-*.el to newst-*.el.
author | Ulf Jasper <ulf.jasper@web.de> |
---|---|
date | Fri, 13 Jun 2008 17:05:34 +0000 |
parents | |
children | 594d82b81559 |
comparison
equal
deleted
inserted
replaced
95900:99342636fa96 | 95901:b4bd9957663d |
---|---|
1 ;;; newst-plainview.el --- Single buffer frontend for newsticker. | |
2 | |
3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 | |
4 ;; Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Ulf Jasper <ulf.jasper@web.de> | |
7 ;; Filename: newst-plainview.el | |
8 ;; URL: http://www.nongnu.org/newsticker | |
9 ;; Time-stamp: "13. Juni 2008, 18:49:26 (ulf)" | |
10 | |
11 ;; ====================================================================== | |
12 | |
13 ;; This file is part of GNU Emacs. | |
14 | |
15 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
16 ;; it under the terms of the GNU General Public License as published by | |
17 ;; the Free Software Foundation, either version 3 of the License, or | |
18 ;; (at your option) any later version. | |
19 | |
20 ;; GNU Emacs is distributed in the hope that it will be useful, | |
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
23 ;; GNU General Public License for more details. | |
24 | |
25 ;; You should have received a copy of the GNU General Public License | |
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
27 | |
28 ;; ====================================================================== | |
29 ;;; Commentary: | |
30 | |
31 ;; See newsticker.el | |
32 | |
33 ;; ====================================================================== | |
34 ;;; Code: | |
35 | |
36 (require 'newsticker-ticker) | |
37 (require 'newsticker-reader) | |
38 (require 'derived) | |
39 (require 'xml) | |
40 | |
41 ;; Silence warnings | |
42 (defvar w3-mode-map) | |
43 (defvar w3m-minor-mode-map) | |
44 | |
45 ;; ====================================================================== | |
46 ;;; Customization | |
47 ;; ====================================================================== | |
48 (defgroup newsticker-plainview nil | |
49 "Settings for the simple plain view reader. | |
50 See also `newsticker-plainview-hooks'." | |
51 :group 'newsticker-reader) | |
52 | |
53 | |
54 (defun newsticker--set-customvar-buffer (symbol value) | |
55 "Set newsticker-variable SYMBOL value to VALUE. | |
56 Calls all actions which are necessary in order to make the new | |
57 value effective." | |
58 (if (or (not (boundp symbol)) | |
59 (equal (symbol-value symbol) value)) | |
60 (set symbol value) | |
61 ;; something must have changed | |
62 (set symbol value) | |
63 (newsticker--buffer-set-uptodate nil))) | |
64 | |
65 (defun newsticker--set-customvar-sorting (symbol value) | |
66 "Set newsticker-variable SYMBOL value to VALUE. | |
67 Calls all actions which are necessary in order to make the new | |
68 value effective." | |
69 (if (or (not (boundp symbol)) | |
70 (equal (symbol-value symbol) value)) | |
71 (set symbol value) | |
72 ;; something must have changed | |
73 (set symbol value) | |
74 (message "Applying new sort method...") | |
75 (when (fboundp 'newsticker--cache-sort) (newsticker--cache-sort)) | |
76 (when (fboundp 'newsticker--buffer-set-uptodate) | |
77 (newsticker--buffer-set-uptodate nil)) | |
78 (message "Applying new sort method...done"))) | |
79 | |
80 (defcustom newsticker-sort-method | |
81 'sort-by-original-order | |
82 "Sort method for news items. | |
83 The following sort methods are available: | |
84 * `sort-by-original-order' keeps the order in which the items | |
85 appear in the headline file (please note that for immortal items, | |
86 which have been removed from the news feed, there is no original | |
87 order), | |
88 * `sort-by-time' looks at the time at which an item has been seen | |
89 the first time. The most recent item is put at top, | |
90 * `sort-by-title' will put the items in an alphabetical order." | |
91 :type '(choice | |
92 (const :tag "Keep original order" sort-by-original-order) | |
93 (const :tag "Sort by time" sort-by-time) | |
94 (const :tag "Sort by title" sort-by-title)) | |
95 :set 'newsticker--set-customvar-sorting | |
96 :group 'newsticker-plainview) | |
97 | |
98 (defcustom newsticker-heading-format | |
99 "%l | |
100 %t %d %s" | |
101 "Format string for feed headings. | |
102 The following printf-like specifiers can be used: | |
103 %d The date the feed was retrieved. See `newsticker-date-format'. | |
104 %l The logo (image) of the feed. Most news feeds provide a small | |
105 image as logo. Newsticker can display them, if Emacs can -- | |
106 see `image-types' for a list of supported image types. | |
107 %L The logo (image) of the feed. If the logo is not available | |
108 the title of the feed is used. | |
109 %s The statistical data of the feed. See `newsticker-statistics-format'. | |
110 %t The title of the feed, i.e. its name." | |
111 :type 'string | |
112 :set 'newsticker--set-customvar-formatting | |
113 :group 'newsticker-plainview) | |
114 | |
115 (defcustom newsticker-item-format | |
116 "%t %d" | |
117 "Format string for news item headlines. | |
118 The following printf-like specifiers can be used: | |
119 %d The date the item was (first) retrieved. See `newsticker-date-format'. | |
120 %l The logo (image) of the feed. Most news feeds provide a small | |
121 image as logo. Newsticker can display them, if Emacs can -- | |
122 see `image-types' for a list of supported image types. | |
123 %L The logo (image) of the feed. If the logo is not available | |
124 the title of the feed is used. | |
125 %t The title of the item." | |
126 :type 'string | |
127 :set 'newsticker--set-customvar-formatting | |
128 :group 'newsticker-plainview) | |
129 | |
130 (defcustom newsticker-desc-format | |
131 "%d %c" | |
132 "Format string for news descriptions (contents). | |
133 The following printf-like specifiers can be used: | |
134 %c The contents (description) of the item. | |
135 %d The date the item was (first) retrieved. See | |
136 `newsticker-date-format'." | |
137 :type 'string | |
138 :set 'newsticker--set-customvar-formatting | |
139 :group 'newsticker-plainview) | |
140 | |
141 (defcustom newsticker-statistics-format | |
142 "[%n + %i + %o + %O = %a]" | |
143 "Format for the statistics part in feed lines. | |
144 The following printf-like specifiers can be used: | |
145 %a The number of all items in the feed. | |
146 %i The number of immortal items in the feed. | |
147 %n The number of new items in the feed. | |
148 %o The number of old items in the feed. | |
149 %O The number of obsolete items in the feed." | |
150 :type 'string | |
151 :set 'newsticker--set-customvar-formatting | |
152 :group 'newsticker-plainview) | |
153 | |
154 | |
155 ;; ====================================================================== | |
156 ;; faces | |
157 (defgroup newsticker-faces nil | |
158 "Settings for the faces of the feed reader." | |
159 :group 'newsticker-plainview) | |
160 | |
161 (defface newsticker-feed-face | |
162 '((((class color) (background dark)) | |
163 (:family "helvetica" :bold t :height 1.2 :foreground "misty rose")) | |
164 (((class color) (background light)) | |
165 (:family "helvetica" :bold t :height 1.2 :foreground "black"))) | |
166 "Face for news feeds." | |
167 :group 'newsticker-faces) | |
168 | |
169 (defface newsticker-new-item-face | |
170 '((((class color) (background dark)) | |
171 (:family "helvetica" :bold t)) | |
172 (((class color) (background light)) | |
173 (:family "helvetica" :bold t))) | |
174 "Face for new news items." | |
175 :group 'newsticker-faces) | |
176 | |
177 (defface newsticker-old-item-face | |
178 '((((class color) (background dark)) | |
179 (:family "helvetica" :bold t :foreground "orange3")) | |
180 (((class color) (background light)) | |
181 (:family "helvetica" :bold t :foreground "red4"))) | |
182 "Face for old news items." | |
183 :group 'newsticker-faces) | |
184 | |
185 (defface newsticker-immortal-item-face | |
186 '((((class color) (background dark)) | |
187 (:family "helvetica" :bold t :italic t :foreground "orange")) | |
188 (((class color) (background light)) | |
189 (:family "helvetica" :bold t :italic t :foreground "blue"))) | |
190 "Face for immortal news items." | |
191 :group 'newsticker-faces) | |
192 | |
193 (defface newsticker-obsolete-item-face | |
194 '((((class color) (background dark)) | |
195 (:family "helvetica" :bold t :strike-through t)) | |
196 (((class color) (background light)) | |
197 (:family "helvetica" :bold t :strike-through t))) | |
198 "Face for old news items." | |
199 :group 'newsticker-faces) | |
200 | |
201 (defface newsticker-date-face | |
202 '((((class color) (background dark)) | |
203 (:family "helvetica" :italic t :height 0.8)) | |
204 (((class color) (background light)) | |
205 (:family "helvetica" :italic t :height 0.8))) | |
206 "Face for newsticker dates." | |
207 :group 'newsticker-faces) | |
208 | |
209 (defface newsticker-statistics-face | |
210 '((((class color) (background dark)) | |
211 (:family "helvetica" :italic t :height 0.8)) | |
212 (((class color) (background light)) | |
213 (:family "helvetica" :italic t :height 0.8))) | |
214 "Face for newsticker dates." | |
215 :group 'newsticker-faces) | |
216 | |
217 (defface newsticker-enclosure-face | |
218 '((((class color) (background dark)) | |
219 (:bold t :background "orange")) | |
220 (((class color) (background light)) | |
221 (:bold t :background "orange"))) | |
222 "Face for enclosed elements." | |
223 :group 'newsticker-faces) | |
224 | |
225 (defface newsticker-extra-face | |
226 '((((class color) (background dark)) | |
227 (:italic t :foreground "gray50" :height 0.8)) | |
228 (((class color) (background light)) | |
229 (:italic t :foreground "gray50" :height 0.8))) | |
230 "Face for newsticker dates." | |
231 :group 'newsticker-faces) | |
232 | |
233 (defface newsticker-default-face | |
234 '((((class color) (background dark)) | |
235 (:inherit default)) | |
236 (((class color) (background light)) | |
237 (:inherit default))) | |
238 "Face for the description of news items." | |
239 ;;:set 'newsticker--set-customvar | |
240 :group 'newsticker-faces) | |
241 | |
242 (defcustom newsticker-hide-old-items-in-newsticker-buffer | |
243 nil | |
244 "Decides whether to automatically hide old items in the *newsticker* buffer. | |
245 If set to t old items will be completely folded and only new | |
246 items will show up in the *newsticker* buffer. Otherwise old as | |
247 well as new items will be visible." | |
248 :type 'boolean | |
249 :set 'newsticker--set-customvar-buffer | |
250 :group 'newsticker-plainview) | |
251 | |
252 (defcustom newsticker-show-descriptions-of-new-items | |
253 t | |
254 "Whether to automatically show descriptions of new items in *newsticker*. | |
255 If set to t old items will be folded and new items will be | |
256 unfolded. Otherwise old as well as new items will be folded." | |
257 :type 'boolean | |
258 :set 'newsticker--set-customvar-buffer | |
259 :group 'newsticker-plainview) | |
260 | |
261 (defcustom newsticker-show-all-news-elements | |
262 nil | |
263 "Show all news elements." | |
264 :type 'boolean | |
265 ;;:set 'newsticker--set-customvar | |
266 :group 'newsticker-plainview) | |
267 | |
268 ;; ====================================================================== | |
269 ;; hooks | |
270 (defgroup newsticker-plainview-hooks nil | |
271 "Settings for newsticker hooks which apply to plainview only." | |
272 :group 'newsticker-hooks) | |
273 | |
274 (defcustom newsticker-select-item-hook | |
275 'newsticker--buffer-make-item-completely-visible | |
276 "List of functions run after a headline has been selected. | |
277 Each function is called after one of `newsticker-next-item', | |
278 `newsticker-next-new-item', `newsticker-previous-item', | |
279 `newsticker-previous-new-item' has been called. | |
280 | |
281 The default value 'newsticker--buffer-make-item-completely-visible | |
282 assures that the current item is always completely visible." | |
283 :type 'hook | |
284 :options '(newsticker--buffer-make-item-completely-visible) | |
285 :group 'newsticker-plainview-hooks) | |
286 | |
287 (defcustom newsticker-select-feed-hook | |
288 'newsticker--buffer-make-item-completely-visible | |
289 "List of functions run after a feed has been selected. | |
290 Each function is called after one of `newsticker-next-feed', and | |
291 `newsticker-previous-feed' has been called. | |
292 | |
293 The default value 'newsticker--buffer-make-item-completely-visible | |
294 assures that the current feed is completely visible." | |
295 :type 'hook | |
296 :options '(newsticker--buffer-make-item-completely-visible) | |
297 :group 'newsticker-plainview-hooks) | |
298 | |
299 (defcustom newsticker-buffer-change-hook | |
300 'newsticker-w3m-show-inline-images | |
301 "List of functions run after the newsticker buffer has been updated. | |
302 Each function is called after `newsticker-buffer-update' has been called. | |
303 | |
304 The default value '`newsticker-w3m-show-inline-images' loads inline | |
305 images." | |
306 :type 'hook | |
307 :group 'newsticker-plainview-hooks) | |
308 | |
309 (defcustom newsticker-narrow-hook | |
310 'newsticker-w3m-show-inline-images | |
311 "List of functions run after narrowing in newsticker buffer has changed. | |
312 Each function is called after | |
313 `newsticker-toggle-auto-narrow-to-feed' or | |
314 `newsticker-toggle-auto-narrow-to-item' has been called. | |
315 | |
316 The default value '`newsticker-w3m-show-inline-images' loads inline | |
317 images." | |
318 :type 'hook | |
319 :group 'newsticker-plainview-hooks) | |
320 | |
321 ;; ====================================================================== | |
322 ;;; Toolbar | |
323 ;; ====================================================================== | |
324 | |
325 (defvar newsticker--plainview-tool-bar-map | |
326 (if (featurep 'xemacs) | |
327 nil | |
328 (if (boundp 'tool-bar-map) | |
329 (let ((tool-bar-map (make-sparse-keymap))) | |
330 (define-key tool-bar-map [newsticker-sep-1] | |
331 (list 'menu-item "--double-line")) | |
332 (define-key tool-bar-map [newsticker-browse-url] | |
333 (list 'menu-item "newsticker-browse-url" 'newsticker-browse-url | |
334 :visible t | |
335 :help "Browse URL for item at point" | |
336 :image newsticker--browse-image)) | |
337 (define-key tool-bar-map [newsticker-buffer-force-update] | |
338 (list 'menu-item "newsticker-buffer-force-update" | |
339 'newsticker-buffer-force-update | |
340 :visible t | |
341 :help "Update newsticker buffer" | |
342 :image newsticker--update-image | |
343 :enable '(not newsticker--buffer-uptodate-p))) | |
344 (define-key tool-bar-map [newsticker-get-all-news] | |
345 (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news | |
346 :visible t | |
347 :help "Get news for all feeds" | |
348 :image newsticker--get-all-image)) | |
349 (define-key tool-bar-map [newsticker-mark-item-at-point-as-read] | |
350 (list 'menu-item "newsticker-mark-item-at-point-as-read" | |
351 'newsticker-mark-item-at-point-as-read | |
352 :visible t | |
353 :image newsticker--mark-read-image | |
354 :help "Mark current item as read" | |
355 :enable '(newsticker-item-not-old-p))) | |
356 (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal] | |
357 (list 'menu-item "newsticker-mark-item-at-point-as-immortal" | |
358 'newsticker-mark-item-at-point-as-immortal | |
359 :visible t | |
360 :image newsticker--mark-immortal-image | |
361 :help "Mark current item as immortal" | |
362 :enable '(newsticker-item-not-immortal-p))) | |
363 (define-key tool-bar-map [newsticker-toggle-auto-narrow-to-feed] | |
364 (list 'menu-item "newsticker-toggle-auto-narrow-to-feed" | |
365 'newsticker-toggle-auto-narrow-to-feed | |
366 :visible t | |
367 :help "Toggle visibility of other feeds" | |
368 :image newsticker--narrow-image)) | |
369 (define-key tool-bar-map [newsticker-next-feed] | |
370 (list 'menu-item "newsticker-next-feed" 'newsticker-next-feed | |
371 :visible t | |
372 :help "Go to next feed" | |
373 :image newsticker--next-feed-image | |
374 :enable '(newsticker-next-feed-available-p))) | |
375 (define-key tool-bar-map [newsticker-next-item] | |
376 (list 'menu-item "newsticker-next-item" 'newsticker-next-item | |
377 :visible t | |
378 :help "Go to next item" | |
379 :image newsticker--next-item-image | |
380 :enable '(newsticker-next-item-available-p))) | |
381 (define-key tool-bar-map [newsticker-previous-item] | |
382 (list 'menu-item "newsticker-previous-item" 'newsticker-previous-item | |
383 :visible t | |
384 :help "Go to previous item" | |
385 :image newsticker--previous-item-image | |
386 :enable '(newsticker-previous-item-available-p))) | |
387 (define-key tool-bar-map [newsticker-previous-feed] | |
388 (list 'menu-item "newsticker-previous-feed" 'newsticker-previous-feed | |
389 :visible t | |
390 :help "Go to previous feed" | |
391 :image newsticker--previous-feed-image | |
392 :enable '(newsticker-previous-feed-available-p))) | |
393 ;; standard icons / actions | |
394 (tool-bar-add-item "close" | |
395 'newsticker-close-buffer | |
396 'newsticker-close-buffer | |
397 :help "Close newsticker buffer") | |
398 (tool-bar-add-item "preferences" | |
399 'newsticker-customize | |
400 'newsticker-customize | |
401 :help "Customize newsticker") | |
402 tool-bar-map)))) | |
403 | |
404 ;; ====================================================================== | |
405 ;;; Newsticker mode | |
406 ;; ====================================================================== | |
407 | |
408 (define-derived-mode newsticker-mode fundamental-mode | |
409 "NewsTicker" | |
410 "Viewing news feeds in Emacs." | |
411 (if (boundp 'tool-bar-map) | |
412 (set (make-local-variable 'tool-bar-map) | |
413 newsticker--plainview-tool-bar-map)) | |
414 (set (make-local-variable 'imenu-sort-function) nil) | |
415 (set (make-local-variable 'scroll-conservatively) 999) | |
416 (setq imenu-create-index-function 'newsticker--imenu-create-index) | |
417 (setq imenu-default-goto-function 'newsticker--imenu-goto) | |
418 (setq buffer-read-only t) | |
419 (auto-fill-mode -1) ;; turn auto-fill off! | |
420 (font-lock-mode -1) ;; turn off font-lock!! | |
421 (set (make-local-variable 'font-lock-defaults) nil) | |
422 (set (make-local-variable 'line-move-ignore-invisible) t) | |
423 (setq mode-line-format | |
424 (list "-" | |
425 'mode-line-mule-info | |
426 'mode-line-modified | |
427 'mode-line-frame-identification | |
428 " Newsticker (" | |
429 '(newsticker--buffer-uptodate-p | |
430 "up to date" | |
431 "NEED UPDATE") | |
432 ") " | |
433 '(:eval (format "[%d]" (length newsticker--process-ids))) | |
434 " -- " | |
435 '(:eval (newsticker--buffer-get-feed-title-at-point)) | |
436 ": " | |
437 '(:eval (newsticker--buffer-get-item-title-at-point)) | |
438 " %-")) | |
439 (add-to-invisibility-spec 't) | |
440 (unless newsticker-show-all-news-elements | |
441 (add-to-invisibility-spec 'extra)) | |
442 (newsticker--buffer-set-uptodate nil)) | |
443 | |
444 ;; refine its mode-map | |
445 (define-key newsticker-mode-map "sO" 'newsticker-show-old-items) | |
446 (define-key newsticker-mode-map "hO" 'newsticker-hide-old-items) | |
447 (define-key newsticker-mode-map "sa" 'newsticker-show-all-desc) | |
448 (define-key newsticker-mode-map "ha" 'newsticker-hide-all-desc) | |
449 (define-key newsticker-mode-map "sf" 'newsticker-show-feed-desc) | |
450 (define-key newsticker-mode-map "hf" 'newsticker-hide-feed-desc) | |
451 (define-key newsticker-mode-map "so" 'newsticker-show-old-item-desc) | |
452 (define-key newsticker-mode-map "ho" 'newsticker-hide-old-item-desc) | |
453 (define-key newsticker-mode-map "sn" 'newsticker-show-new-item-desc) | |
454 (define-key newsticker-mode-map "hn" 'newsticker-hide-new-item-desc) | |
455 (define-key newsticker-mode-map "se" 'newsticker-show-entry) | |
456 (define-key newsticker-mode-map "he" 'newsticker-hide-entry) | |
457 (define-key newsticker-mode-map "sx" 'newsticker-show-extra) | |
458 (define-key newsticker-mode-map "hx" 'newsticker-hide-extra) | |
459 | |
460 (define-key newsticker-mode-map " " 'scroll-up) | |
461 (define-key newsticker-mode-map "q" 'newsticker-close-buffer) | |
462 (define-key newsticker-mode-map "p" 'newsticker-previous-item) | |
463 (define-key newsticker-mode-map "P" 'newsticker-previous-new-item) | |
464 (define-key newsticker-mode-map "F" 'newsticker-previous-feed) | |
465 (define-key newsticker-mode-map "\t" 'newsticker-next-item) | |
466 (define-key newsticker-mode-map "n" 'newsticker-next-item) | |
467 (define-key newsticker-mode-map "N" 'newsticker-next-new-item) | |
468 (define-key newsticker-mode-map "f" 'newsticker-next-feed) | |
469 (define-key newsticker-mode-map "M" 'newsticker-mark-all-items-as-read) | |
470 (define-key newsticker-mode-map "m" | |
471 'newsticker-mark-all-items-at-point-as-read-and-redraw) | |
472 (define-key newsticker-mode-map "o" | |
473 'newsticker-mark-item-at-point-as-read) | |
474 (define-key newsticker-mode-map "O" | |
475 'newsticker-mark-all-items-at-point-as-read) | |
476 (define-key newsticker-mode-map "G" 'newsticker-get-all-news) | |
477 (define-key newsticker-mode-map "g" 'newsticker-get-news-at-point) | |
478 (define-key newsticker-mode-map "u" 'newsticker-buffer-update) | |
479 (define-key newsticker-mode-map "U" 'newsticker-buffer-force-update) | |
480 (define-key newsticker-mode-map "a" 'newsticker-add-url) | |
481 | |
482 (define-key newsticker-mode-map "i" | |
483 'newsticker-mark-item-at-point-as-immortal) | |
484 | |
485 (define-key newsticker-mode-map "xf" | |
486 'newsticker-toggle-auto-narrow-to-feed) | |
487 (define-key newsticker-mode-map "xi" | |
488 'newsticker-toggle-auto-narrow-to-item) | |
489 | |
490 ;; maps for the clickable portions | |
491 (defvar newsticker--url-keymap (make-sparse-keymap) | |
492 "Key map for click-able headings in the newsticker buffer.") | |
493 (define-key newsticker--url-keymap [mouse-1] | |
494 'newsticker-mouse-browse-url) | |
495 (define-key newsticker--url-keymap [mouse-2] | |
496 'newsticker-mouse-browse-url) | |
497 (define-key newsticker--url-keymap "\n" | |
498 'newsticker-browse-url) | |
499 (define-key newsticker--url-keymap "\C-m" | |
500 'newsticker-browse-url) | |
501 (define-key newsticker--url-keymap [(control return)] | |
502 'newsticker-handle-url) | |
503 | |
504 ;; newsticker menu | |
505 (defvar newsticker-menu (make-sparse-keymap "Newsticker")) | |
506 | |
507 (define-key newsticker-menu [newsticker-browse-url] | |
508 '("Browse URL for item at point" . newsticker-browse-url)) | |
509 (define-key newsticker-menu [newsticker-separator-1] | |
510 '("--")) | |
511 (define-key newsticker-menu [newsticker-buffer-update] | |
512 '("Update buffer" . newsticker-buffer-update)) | |
513 (define-key newsticker-menu [newsticker-separator-2] | |
514 '("--")) | |
515 (define-key newsticker-menu [newsticker-get-all-news] | |
516 '("Get news from all feeds" . newsticker-get-all-news)) | |
517 (define-key newsticker-menu [newsticker-get-news-at-point] | |
518 '("Get news from feed at point" . newsticker-get-news-at-point)) | |
519 (define-key newsticker-menu [newsticker-separator-3] | |
520 '("--")) | |
521 (define-key newsticker-menu [newsticker-mark-all-items-as-read] | |
522 '("Mark all items as read" . newsticker-mark-all-items-as-read)) | |
523 (define-key newsticker-menu [newsticker-mark-all-items-at-point-as-read] | |
524 '("Mark all items in feed at point as read" . | |
525 newsticker-mark-all-items-at-point-as-read)) | |
526 (define-key newsticker-menu [newsticker-mark-item-at-point-as-read] | |
527 '("Mark item at point as read" . | |
528 newsticker-mark-item-at-point-as-read)) | |
529 (define-key newsticker-menu [newsticker-mark-item-at-point-as-immortal] | |
530 '("Toggle immortality for item at point" . | |
531 newsticker-mark-item-at-point-as-immortal)) | |
532 (define-key newsticker-menu [newsticker-separator-4] | |
533 '("--")) | |
534 (define-key newsticker-menu [newsticker-toggle-auto-narrow-to-item] | |
535 '("Narrow to single item" . newsticker-toggle-auto-narrow-to-item)) | |
536 (define-key newsticker-menu [newsticker-toggle-auto-narrow-to-feed] | |
537 '("Narrow to single news feed" . newsticker-toggle-auto-narrow-to-feed)) | |
538 (define-key newsticker-menu [newsticker-hide-old-items] | |
539 '("Hide old items" . newsticker-hide-old-items)) | |
540 (define-key newsticker-menu [newsticker-show-old-items] | |
541 '("Show old items" . newsticker-show-old-items)) | |
542 (define-key newsticker-menu [newsticker-next-item] | |
543 '("Go to next item" . newsticker-next-item)) | |
544 (define-key newsticker-menu [newsticker-previous-item] | |
545 '("Go to previous item" . newsticker-previous-item)) | |
546 | |
547 ;; bind menu to mouse | |
548 (define-key newsticker-mode-map [down-mouse-3] newsticker-menu) | |
549 ;; Put menu in menu-bar | |
550 (define-key newsticker-mode-map [menu-bar Newsticker] | |
551 (cons "Newsticker" newsticker-menu)) | |
552 | |
553 | |
554 ;; ====================================================================== | |
555 ;;; User fun | |
556 ;; ====================================================================== | |
557 ;;;###autoload | |
558 (defun newsticker-plainview () | |
559 "Start newsticker plainview." | |
560 (interactive) | |
561 (newsticker-buffer-update t) | |
562 (switch-to-buffer "*newsticker*")) | |
563 | |
564 (defun newsticker-buffer-force-update () | |
565 "Update the newsticker buffer, even if not necessary." | |
566 (interactive) | |
567 (newsticker-buffer-update t)) | |
568 | |
569 (defun newsticker-buffer-update (&optional force) | |
570 "Update the *newsticker* buffer. | |
571 Unless FORCE is t this is done only if necessary, i.e. when the | |
572 *newsticker* buffer is not up-to-date." | |
573 (interactive) | |
574 ;; bring cache data into proper order.... | |
575 (newsticker--cache-sort) | |
576 ;; fill buffer | |
577 (save-excursion | |
578 (let ((buf (get-buffer "*newsticker*"))) | |
579 (if buf | |
580 (switch-to-buffer buf) | |
581 (switch-to-buffer (get-buffer-create "*newsticker*")) | |
582 (newsticker--buffer-set-uptodate nil))) | |
583 (when (or force | |
584 (not newsticker--buffer-uptodate-p)) | |
585 (message "Preparing newsticker buffer...") | |
586 (setq buffer-undo-list t) | |
587 (let ((inhibit-read-only t)) | |
588 (set-buffer-modified-p nil) | |
589 (erase-buffer) | |
590 (newsticker-mode) | |
591 ;; Emacs 21.3.50 does not care if we turn off auto-fill in the | |
592 ;; definition of newsticker-mode, so we do it here (again) | |
593 (auto-fill-mode -1) | |
594 | |
595 (set-buffer-file-coding-system 'utf-8) | |
596 | |
597 (if newsticker-use-full-width | |
598 (set (make-local-variable 'fill-column) (1- (window-width)))) | |
599 (newsticker--buffer-insert-all-items) | |
600 | |
601 ;; FIXME: needed for methods buffer in ecb | |
602 ;; (set-visited-file-name "*newsticker*") | |
603 | |
604 (set-buffer-modified-p nil) | |
605 (newsticker-hide-all-desc) | |
606 (if newsticker-hide-old-items-in-newsticker-buffer | |
607 (newsticker-hide-old-items)) | |
608 (if newsticker-show-descriptions-of-new-items | |
609 (newsticker-show-new-item-desc)) | |
610 ) | |
611 (message "")) | |
612 (newsticker--buffer-set-uptodate t) | |
613 (run-hooks 'newsticker-buffer-change-hook))) | |
614 | |
615 (defun newsticker-get-news-at-point () | |
616 "Launch retrieval of news for the feed point is in. | |
617 This does NOT start the retrieval timers." | |
618 (interactive) | |
619 ;; launch retrieval of news | |
620 (let ((feed (get-text-property (point) 'feed))) | |
621 (when feed | |
622 (newsticker--debug-msg "Getting news for %s" (symbol-name feed)) | |
623 (newsticker-get-news (symbol-name feed))))) | |
624 | |
625 (declare-function w3m-toggle-inline-image "ext:w3m" (&optional force no-cache)) | |
626 | |
627 (defun newsticker-w3m-show-inline-images () | |
628 "Show inline images in visible text ranges. | |
629 In-line images in invisible text ranges are hidden. This function | |
630 calls `w3m-toggle-inline-image'. It works only if | |
631 `newsticker-html-renderer' is set to `w3m-region'." | |
632 (interactive) | |
633 (if (eq newsticker-html-renderer 'w3m-region) | |
634 (let ((inhibit-read-only t)) | |
635 (save-excursion | |
636 (save-restriction | |
637 (widen) | |
638 (goto-char (point-min)) | |
639 (let ((pos (point))) | |
640 (while pos | |
641 (setq pos (next-single-property-change pos 'w3m-image)) | |
642 (when pos | |
643 (goto-char pos) | |
644 (when (get-text-property pos 'w3m-image) | |
645 (let ((invis (newsticker--lists-intersect-p | |
646 (get-text-property (1- (point)) | |
647 'invisible) | |
648 buffer-invisibility-spec))) | |
649 (unless (car (get-text-property (1- (point)) | |
650 'display)) | |
651 (unless invis | |
652 (w3m-toggle-inline-image t))))))))))))) | |
653 | |
654 ;; ====================================================================== | |
655 ;;; Keymap stuff | |
656 ;; ====================================================================== | |
657 (defun newsticker-close-buffer () | |
658 "Close the newsticker buffer." | |
659 (interactive) | |
660 (newsticker--cache-update t) | |
661 (bury-buffer)) | |
662 | |
663 (defun newsticker-next-new-item (&optional do-not-wrap-at-eob) | |
664 "Go to next new news item. | |
665 If no new item is found behind point, search is continued at | |
666 beginning of buffer unless optional argument DO-NOT-WRAP-AT-EOB | |
667 is non-nil." | |
668 (interactive) | |
669 (widen) | |
670 (let ((go-ahead t)) | |
671 (while go-ahead | |
672 (unless (newsticker--buffer-goto '(item) 'new) | |
673 ;; found nothing -- wrap | |
674 (unless do-not-wrap-at-eob | |
675 (goto-char (point-min)) | |
676 (newsticker-next-new-item t)) | |
677 (setq go-ahead nil)) | |
678 (unless (newsticker--lists-intersect-p | |
679 (get-text-property (point) 'invisible) | |
680 buffer-invisibility-spec) | |
681 ;; this item is invisible -- continue search | |
682 (setq go-ahead nil)))) | |
683 (run-hooks 'newsticker-select-item-hook) | |
684 (point)) | |
685 | |
686 (defun newsticker-previous-new-item (&optional do-not-wrap-at-bob) | |
687 "Go to previous new news item. | |
688 If no new item is found before point, search is continued at | |
689 beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB | |
690 is non-nil." | |
691 (interactive) | |
692 (widen) | |
693 (let ((go-ahead t)) | |
694 (while go-ahead | |
695 (unless (newsticker--buffer-goto '(item) 'new t) | |
696 (unless do-not-wrap-at-bob | |
697 (goto-char (point-max)) | |
698 (newsticker--buffer-goto '(item) 'new t))) | |
699 (unless (newsticker--lists-intersect-p | |
700 (get-text-property (point) 'invisible) | |
701 buffer-invisibility-spec) | |
702 (setq go-ahead nil)))) | |
703 (run-hooks 'newsticker-select-item-hook) | |
704 (point)) | |
705 | |
706 (defun newsticker-next-item (&optional do-not-wrap-at-eob) | |
707 "Go to next news item. | |
708 Return new buffer position. | |
709 If no item is found below point, search is continued at beginning | |
710 of buffer unless optional argument DO-NOT-WRAP-AT-EOB is | |
711 non-nil." | |
712 (interactive) | |
713 (widen) | |
714 (let ((go-ahead t) | |
715 (search-list '(item))) | |
716 (if newsticker--auto-narrow-to-item | |
717 (setq search-list '(item feed))) | |
718 (while go-ahead | |
719 (unless (newsticker--buffer-goto search-list) | |
720 ;; found nothing -- wrap | |
721 (unless do-not-wrap-at-eob | |
722 (goto-char (point-min))) | |
723 (setq go-ahead nil)) | |
724 (unless (newsticker--lists-intersect-p | |
725 (get-text-property (point) 'invisible) | |
726 buffer-invisibility-spec) | |
727 (setq go-ahead nil)))) | |
728 (run-hooks 'newsticker-select-item-hook) | |
729 (force-mode-line-update) | |
730 (point)) | |
731 | |
732 (defun newsticker-next-item-same-feed () | |
733 "Go to next news item in the same feed. | |
734 Return new buffer position. If no item is found below point or if | |
735 auto-narrow-to-item is enabled, nil is returned." | |
736 (interactive) | |
737 (if newsticker--auto-narrow-to-item | |
738 nil | |
739 (let ((go-ahead t) | |
740 (current-pos (point)) | |
741 (end-of-feed (save-excursion (newsticker--buffer-end-of-feed)))) | |
742 (while go-ahead | |
743 (unless (newsticker--buffer-goto '(item)) | |
744 (setq go-ahead nil)) | |
745 (unless (newsticker--lists-intersect-p | |
746 (get-text-property (point) 'invisible) | |
747 buffer-invisibility-spec) | |
748 (setq go-ahead nil))) | |
749 (if (and (> (point) current-pos) | |
750 (< (point) end-of-feed)) | |
751 (point) | |
752 (goto-char current-pos) | |
753 nil)))) | |
754 | |
755 (defun newsticker-previous-item (&optional do-not-wrap-at-bob) | |
756 "Go to previous news item. | |
757 Return new buffer position. | |
758 If no item is found before point, search is continued at | |
759 beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB | |
760 is non-nil." | |
761 (interactive) | |
762 (widen) | |
763 (let ((go-ahead t) | |
764 (search-list '(item))) | |
765 (if newsticker--auto-narrow-to-item | |
766 (setq search-list '(item feed))) | |
767 (when (bobp) | |
768 (unless do-not-wrap-at-bob | |
769 (goto-char (point-max)))) | |
770 (while go-ahead | |
771 (if (newsticker--buffer-goto search-list nil t) | |
772 (unless (newsticker--lists-intersect-p | |
773 (get-text-property (point) 'invisible) | |
774 buffer-invisibility-spec) | |
775 (setq go-ahead nil)) | |
776 (goto-char (point-min)) | |
777 (setq go-ahead nil)))) | |
778 (run-hooks 'newsticker-select-item-hook) | |
779 (force-mode-line-update) | |
780 (point)) | |
781 | |
782 (defun newsticker-next-feed () | |
783 "Go to next news feed. | |
784 Return new buffer position." | |
785 (interactive) | |
786 (widen) | |
787 (newsticker--buffer-goto '(feed)) | |
788 (run-hooks 'newsticker-select-feed-hook) | |
789 (force-mode-line-update) | |
790 (point)) | |
791 | |
792 (defun newsticker-previous-feed () | |
793 "Go to previous news feed. | |
794 Return new buffer position." | |
795 (interactive) | |
796 (widen) | |
797 (newsticker--buffer-goto '(feed) nil t) | |
798 (run-hooks 'newsticker-select-feed-hook) | |
799 (force-mode-line-update) | |
800 (point)) | |
801 | |
802 (defun newsticker-mark-all-items-at-point-as-read-and-redraw () | |
803 "Mark all items as read and clear ticker contents." | |
804 (interactive) | |
805 (when (or newsticker--buffer-uptodate-p | |
806 (y-or-n-p | |
807 "Buffer is not up to date -- really mark items as read? ")) | |
808 (newsticker-mark-all-items-of-feed-as-read | |
809 (get-text-property (point) 'feed)))) | |
810 | |
811 (defun newsticker-mark-all-items-of-feed-as-read (feed) | |
812 "Mark all items of FEED as read, clear ticker, and redraw buffer." | |
813 (when feed | |
814 (let ((pos (point))) | |
815 (message "Marking all items as read for %s" (symbol-name feed)) | |
816 (newsticker--cache-replace-age newsticker--cache feed 'new 'old) | |
817 (newsticker--cache-replace-age newsticker--cache feed 'obsolete | |
818 'old) | |
819 (newsticker--cache-update) | |
820 (newsticker--buffer-set-uptodate nil) | |
821 (newsticker--ticker-text-setup) | |
822 (newsticker-buffer-update) | |
823 ;; go back to where we came frome | |
824 (goto-char pos) | |
825 (end-of-line) | |
826 (newsticker--buffer-goto '(feed) nil t)))) | |
827 | |
828 (defun newsticker-mark-all-items-at-point-as-read () | |
829 "Mark all items as read and clear ticker contents." | |
830 (interactive) | |
831 (when (or newsticker--buffer-uptodate-p | |
832 (y-or-n-p | |
833 "Buffer is not up to date -- really mark items as read? ")) | |
834 (newsticker--do-mark-item-at-point-as-read t) | |
835 (while (newsticker-next-item-same-feed) | |
836 (newsticker--do-mark-item-at-point-as-read t)) | |
837 (newsticker-next-item t))) | |
838 | |
839 (defun newsticker-mark-item-at-point-as-read (&optional respect-immortality) | |
840 "Mark item at point as read and move to next item. | |
841 If optional argument RESPECT-IMMORTALITY is not nil immortal items do | |
842 not get changed." | |
843 (interactive) | |
844 (when (or newsticker--buffer-uptodate-p | |
845 (y-or-n-p | |
846 "Buffer is not up to date -- really mark this item as read? ")) | |
847 (newsticker--do-mark-item-at-point-as-read respect-immortality) | |
848 ;; move forward | |
849 (newsticker-next-item t))) | |
850 | |
851 (defun newsticker--do-mark-item-at-point-as-read (&optional respect-immortality) | |
852 "Mark item at point as read. | |
853 If optional argument RESPECT-IMMORTALITY is not nil immortal items do | |
854 not get changed." | |
855 (let ((feed (get-text-property (point) 'feed))) | |
856 (when feed | |
857 (save-excursion | |
858 (newsticker--buffer-beginning-of-item) | |
859 (let ((inhibit-read-only t) | |
860 (age (get-text-property (point) 'nt-age)) | |
861 (title (get-text-property (point) 'nt-title)) | |
862 (guid (get-text-property (point) 'nt-guid)) | |
863 (nt-desc (get-text-property (point) 'nt-desc)) | |
864 (pos (save-excursion (newsticker--buffer-end-of-item))) | |
865 item) | |
866 (when (or (eq age 'new) | |
867 (eq age 'obsolete) | |
868 (and (eq age 'immortal) | |
869 (not respect-immortality))) | |
870 ;; find item | |
871 (setq item (newsticker--cache-contains newsticker--cache | |
872 feed title nt-desc | |
873 nil nil guid)) | |
874 ;; mark as old | |
875 (when item | |
876 (setcar (nthcdr 4 item) 'old) | |
877 (newsticker--do-forget-preformatted item)) | |
878 ;; clean up ticker | |
879 (if (or (and (eq age 'new) | |
880 newsticker-hide-immortal-items-in-echo-area) | |
881 (and (memq age '(old immortal)) | |
882 (not | |
883 (eq newsticker-hide-old-items-in-newsticker-buffer | |
884 newsticker-hide-immortal-items-in-echo-area)))) | |
885 (newsticker--ticker-text-remove feed title)) | |
886 ;; set faces etc. | |
887 (save-excursion | |
888 (save-restriction | |
889 (widen) | |
890 (put-text-property (point) pos 'nt-age 'old) | |
891 (newsticker--buffer-set-faces (point) pos))) | |
892 (set-buffer-modified-p nil))))))) | |
893 | |
894 (defun newsticker-mark-item-at-point-as-immortal () | |
895 "Mark item at point as read." | |
896 (interactive) | |
897 (when (or newsticker--buffer-uptodate-p | |
898 (y-or-n-p | |
899 "Buffer is not up to date -- really mark this item as read? ")) | |
900 (let ((feed (get-text-property (point) 'feed)) | |
901 (item nil)) | |
902 (when feed | |
903 (save-excursion | |
904 (newsticker--buffer-beginning-of-item) | |
905 (let ((inhibit-read-only t) | |
906 (oldage (get-text-property (point) 'nt-age)) | |
907 (title (get-text-property (point) 'nt-title)) | |
908 (guid (get-text-property (point) 'nt-guid)) | |
909 (pos (save-excursion (newsticker--buffer-end-of-item)))) | |
910 (let ((newage 'immortal)) | |
911 (if (eq oldage 'immortal) | |
912 (setq newage 'old)) | |
913 (setq item (newsticker--cache-contains newsticker--cache | |
914 feed title nil nil nil | |
915 guid)) | |
916 ;; change age | |
917 (when item | |
918 (setcar (nthcdr 4 item) newage) | |
919 (newsticker--do-forget-preformatted item)) | |
920 (if (or (and (eq newage 'immortal) | |
921 newsticker-hide-immortal-items-in-echo-area) | |
922 (and (eq newage 'obsolete) | |
923 newsticker-hide-obsolete-items-in-echo-area) | |
924 (and (eq oldage 'immortal) | |
925 (not | |
926 (eq newsticker-hide-old-items-in-newsticker-buffer | |
927 newsticker-hide-immortal-items-in-echo-area)))) | |
928 (newsticker--ticker-text-remove feed title) | |
929 (newsticker--ticker-text-setup)) | |
930 (save-excursion | |
931 (save-restriction | |
932 (widen) | |
933 (put-text-property (point) pos 'nt-age newage) | |
934 (if (eq newage 'immortal) | |
935 (put-text-property (point) pos 'nt-age 'immortal) | |
936 (put-text-property (point) pos 'nt-age 'old)) | |
937 (newsticker--buffer-set-faces (point) pos)))))) | |
938 (if item | |
939 (newsticker-next-item t)))))) | |
940 | |
941 (defun newsticker-mark-all-items-as-read () | |
942 "Mark all items as read and clear ticker contents." | |
943 (interactive) | |
944 (when (or newsticker--buffer-uptodate-p | |
945 (y-or-n-p | |
946 "Buffer is not up to date -- really mark items as read? ")) | |
947 (newsticker--cache-replace-age newsticker--cache 'any 'new 'old) | |
948 (newsticker--buffer-set-uptodate nil) | |
949 (newsticker--ticker-text-setup) | |
950 (newsticker--cache-update) | |
951 (newsticker-buffer-update))) | |
952 | |
953 (defun newsticker-hide-extra () | |
954 "Hide the extra elements of items." | |
955 (interactive) | |
956 (newsticker--buffer-hideshow 'extra nil) | |
957 (newsticker--buffer-redraw)) | |
958 | |
959 (defun newsticker-show-extra () | |
960 "Show the extra elements of items." | |
961 (interactive) | |
962 (newsticker--buffer-hideshow 'extra t) | |
963 (newsticker--buffer-redraw)) | |
964 | |
965 (defun newsticker-hide-old-item-desc () | |
966 "Hide the description of old items." | |
967 (interactive) | |
968 (newsticker--buffer-hideshow 'desc-old nil) | |
969 (newsticker--buffer-redraw)) | |
970 | |
971 (defun newsticker-show-old-item-desc () | |
972 "Show the description of old items." | |
973 (interactive) | |
974 (newsticker--buffer-hideshow 'item-old t) | |
975 (newsticker--buffer-hideshow 'desc-old t) | |
976 (newsticker--buffer-redraw)) | |
977 | |
978 (defun newsticker-hide-new-item-desc () | |
979 "Hide the description of new items." | |
980 (interactive) | |
981 (newsticker--buffer-hideshow 'desc-new nil) | |
982 (newsticker--buffer-hideshow 'desc-immortal nil) | |
983 (newsticker--buffer-hideshow 'desc-obsolete nil) | |
984 (newsticker--buffer-redraw)) | |
985 | |
986 (defun newsticker-show-new-item-desc () | |
987 "Show the description of new items." | |
988 (interactive) | |
989 (newsticker--buffer-hideshow 'desc-new t) | |
990 (newsticker--buffer-hideshow 'desc-immortal t) | |
991 (newsticker--buffer-hideshow 'desc-obsolete t) | |
992 (newsticker--buffer-redraw)) | |
993 | |
994 (defun newsticker-hide-feed-desc () | |
995 "Hide the description of feeds." | |
996 (interactive) | |
997 (newsticker--buffer-hideshow 'desc-feed nil) | |
998 (newsticker--buffer-redraw)) | |
999 | |
1000 (defun newsticker-show-feed-desc () | |
1001 "Show the description of old items." | |
1002 (interactive) | |
1003 (newsticker--buffer-hideshow 'desc-feed t) | |
1004 (newsticker--buffer-redraw)) | |
1005 | |
1006 (defun newsticker-hide-all-desc () | |
1007 "Hide the descriptions of feeds and all items." | |
1008 (interactive) | |
1009 (newsticker--buffer-hideshow 'desc-feed nil) | |
1010 (newsticker--buffer-hideshow 'desc-immortal nil) | |
1011 (newsticker--buffer-hideshow 'desc-obsolete nil) | |
1012 (newsticker--buffer-hideshow 'desc-new nil) | |
1013 (newsticker--buffer-hideshow 'desc-old nil) | |
1014 (newsticker--buffer-redraw)) | |
1015 | |
1016 (defun newsticker-show-all-desc () | |
1017 "Show the descriptions of feeds and all items." | |
1018 (interactive) | |
1019 (newsticker--buffer-hideshow 'desc-feed t) | |
1020 (newsticker--buffer-hideshow 'desc-immortal t) | |
1021 (newsticker--buffer-hideshow 'desc-obsolete t) | |
1022 (newsticker--buffer-hideshow 'desc-new t) | |
1023 (newsticker--buffer-hideshow 'desc-old t) | |
1024 (newsticker--buffer-redraw)) | |
1025 | |
1026 (defun newsticker-hide-old-items () | |
1027 "Hide old items." | |
1028 (interactive) | |
1029 (newsticker--buffer-hideshow 'desc-old nil) | |
1030 (newsticker--buffer-hideshow 'item-old nil) | |
1031 (newsticker--buffer-redraw)) | |
1032 | |
1033 (defun newsticker-show-old-items () | |
1034 "Show old items." | |
1035 (interactive) | |
1036 (newsticker--buffer-hideshow 'item-old t) | |
1037 (newsticker--buffer-redraw)) | |
1038 | |
1039 (defun newsticker-hide-entry () | |
1040 "Hide description of entry at point." | |
1041 (interactive) | |
1042 (save-excursion | |
1043 (let* (pos1 pos2 | |
1044 (inhibit-read-only t) | |
1045 inv-prop org-inv-prop | |
1046 is-invisible) | |
1047 (newsticker--buffer-beginning-of-item) | |
1048 (newsticker--buffer-goto '(desc)) | |
1049 (setq pos1 (max (point-min) (1- (point)))) | |
1050 (newsticker--buffer-goto '(extra feed item nil)) | |
1051 (setq pos2 (max (point-min) (1- (point)))) | |
1052 (setq inv-prop (get-text-property pos1 'invisible)) | |
1053 (setq org-inv-prop (get-text-property pos1 'org-invisible)) | |
1054 (cond ((eq inv-prop t) | |
1055 ;; do nothing | |
1056 ) | |
1057 ((eq org-inv-prop nil) | |
1058 (add-text-properties pos1 pos2 | |
1059 (list 'invisible (list t) | |
1060 'org-invisible inv-prop))) | |
1061 (t | |
1062 ;; toggle | |
1063 (add-text-properties pos1 pos2 | |
1064 (list 'invisible org-inv-prop)) | |
1065 (remove-text-properties pos1 pos2 '(org-invisible)))))) | |
1066 (newsticker--buffer-redraw)) | |
1067 | |
1068 (defun newsticker-show-entry () | |
1069 "Show description of entry at point." | |
1070 (interactive) | |
1071 (save-excursion | |
1072 (let* (pos1 pos2 | |
1073 (inhibit-read-only t) | |
1074 inv-prop org-inv-prop | |
1075 is-invisible) | |
1076 (newsticker--buffer-beginning-of-item) | |
1077 (newsticker--buffer-goto '(desc)) | |
1078 (setq pos1 (max (point-min) (1- (point)))) | |
1079 (newsticker--buffer-goto '(extra feed item)) | |
1080 (setq pos2 (max (point-min) (1- (point)))) | |
1081 (setq inv-prop (get-text-property pos1 'invisible)) | |
1082 (setq org-inv-prop (get-text-property pos1 'org-invisible)) | |
1083 (cond ((eq org-inv-prop nil) | |
1084 (add-text-properties pos1 pos2 | |
1085 (list 'invisible nil | |
1086 'org-invisible inv-prop))) | |
1087 (t | |
1088 ;; toggle | |
1089 (add-text-properties pos1 pos2 | |
1090 (list 'invisible org-inv-prop)) | |
1091 (remove-text-properties pos1 pos2 '(org-invisible)))))) | |
1092 (newsticker--buffer-redraw)) | |
1093 | |
1094 (defun newsticker-toggle-auto-narrow-to-feed () | |
1095 "Toggle narrowing to current news feed. | |
1096 If auto-narrowing is active, only news item of the current feed | |
1097 are visible." | |
1098 (interactive) | |
1099 (newsticker-set-auto-narrow-to-feed | |
1100 (not newsticker--auto-narrow-to-feed))) | |
1101 | |
1102 (defun newsticker-set-auto-narrow-to-feed (value) | |
1103 "Turn narrowing to current news feed on or off. | |
1104 If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on." | |
1105 (interactive) | |
1106 (setq newsticker--auto-narrow-to-item nil) | |
1107 (setq newsticker--auto-narrow-to-feed value) | |
1108 (widen) | |
1109 (newsticker--buffer-make-item-completely-visible) | |
1110 (run-hooks 'newsticker-narrow-hook)) | |
1111 | |
1112 (defun newsticker-toggle-auto-narrow-to-item () | |
1113 "Toggle narrowing to current news item. | |
1114 If auto-narrowing is active, only one item of the current feed | |
1115 is visible." | |
1116 (interactive) | |
1117 (newsticker-set-auto-narrow-to-item | |
1118 (not newsticker--auto-narrow-to-item))) | |
1119 | |
1120 (defun newsticker-set-auto-narrow-to-item (value) | |
1121 "Turn narrowing to current news item on or off. | |
1122 If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on." | |
1123 (interactive) | |
1124 (setq newsticker--auto-narrow-to-feed nil) | |
1125 (setq newsticker--auto-narrow-to-item value) | |
1126 (widen) | |
1127 (newsticker--buffer-make-item-completely-visible) | |
1128 (run-hooks 'newsticker-narrow-hook)) | |
1129 | |
1130 (defun newsticker-next-feed-available-p () | |
1131 "Return t if position is before last feed, nil otherwise." | |
1132 (save-excursion | |
1133 (let ((p (point))) | |
1134 (newsticker--buffer-goto '(feed)) | |
1135 (not (= p (point)))))) | |
1136 | |
1137 (defun newsticker-previous-feed-available-p () | |
1138 "Return t if position is behind first feed, nil otherwise." | |
1139 (save-excursion | |
1140 (let ((p (point))) | |
1141 (newsticker--buffer-goto '(feed) nil t) | |
1142 (not (= p (point)))))) | |
1143 | |
1144 (defun newsticker-next-item-available-p () | |
1145 "Return t if position is before last feed, nil otherwise." | |
1146 (save-excursion | |
1147 (catch 'result | |
1148 (while (< (point) (point-max)) | |
1149 (unless (newsticker--buffer-goto '(item)) | |
1150 (throw 'result nil)) | |
1151 (unless (newsticker--lists-intersect-p | |
1152 (get-text-property (point) 'invisible) | |
1153 buffer-invisibility-spec) | |
1154 (throw 'result t)))))) | |
1155 | |
1156 (defun newsticker-previous-item-available-p () | |
1157 "Return t if position is behind first item, nil otherwise." | |
1158 (save-excursion | |
1159 (catch 'result | |
1160 (while (> (point) (point-min)) | |
1161 (unless (newsticker--buffer-goto '(item) nil t) | |
1162 (throw 'result nil)) | |
1163 (unless (newsticker--lists-intersect-p | |
1164 (get-text-property (point) 'invisible) | |
1165 buffer-invisibility-spec) | |
1166 (throw 'result t)))))) | |
1167 | |
1168 (defun newsticker-item-not-old-p () | |
1169 "Return t if there is an item at point which is not old, nil otherwise." | |
1170 (when (get-text-property (point) 'feed) | |
1171 (save-excursion | |
1172 (newsticker--buffer-beginning-of-item) | |
1173 (let ((age (get-text-property (point) 'nt-age))) | |
1174 (and (memq age '(new immortal obsolete)) t))))) | |
1175 | |
1176 (defun newsticker-item-not-immortal-p () | |
1177 "Return t if there is an item at point which is not immortal, nil otherwise." | |
1178 (when (get-text-property (point) 'feed) | |
1179 (save-excursion | |
1180 (newsticker--buffer-beginning-of-item) | |
1181 (let ((age (get-text-property (point) 'nt-age))) | |
1182 (and (memq age '(new old obsolete)) t))))) | |
1183 | |
1184 ;; ====================================================================== | |
1185 ;;; Imenu stuff | |
1186 ;; ====================================================================== | |
1187 (defun newsticker--imenu-create-index () | |
1188 "Scan newsticker buffer and return an index for imenu." | |
1189 (save-excursion | |
1190 (goto-char (point-min)) | |
1191 (let ((index-alist nil) | |
1192 (feed-list nil) | |
1193 (go-ahead t)) | |
1194 (while go-ahead | |
1195 (let ((type (get-text-property (point) 'nt-type)) | |
1196 (title (get-text-property (point) 'nt-title))) | |
1197 (cond ((eq type 'feed) | |
1198 ;; we're on a feed heading | |
1199 (when feed-list | |
1200 (if index-alist | |
1201 (nconc index-alist (list feed-list)) | |
1202 (setq index-alist (list feed-list)))) | |
1203 (setq feed-list (list title))) | |
1204 (t | |
1205 (nconc feed-list | |
1206 (list (cons title (point))))))) | |
1207 (setq go-ahead (newsticker--buffer-goto '(item feed)))) | |
1208 (if index-alist | |
1209 (nconc index-alist (list feed-list)) | |
1210 (setq index-alist (list feed-list))) | |
1211 index-alist))) | |
1212 | |
1213 (defun newsticker--imenu-goto (name pos &rest args) | |
1214 "Go to item NAME at position POS and show item. | |
1215 ARGS are ignored." | |
1216 (goto-char pos) | |
1217 ;; show headline | |
1218 (newsticker--buffer-goto '(desc extra feed item)) | |
1219 (let* ((inhibit-read-only t) | |
1220 (pos1 (max (point-min) (1- pos))) | |
1221 (pos2 (max pos1 (1- (point)))) | |
1222 (inv-prop (get-text-property pos 'invisible)) | |
1223 (org-inv-prop (get-text-property pos 'org-invisible))) | |
1224 (when (eq org-inv-prop nil) | |
1225 (add-text-properties pos1 pos2 (list 'invisible nil | |
1226 'org-invisible inv-prop)))) | |
1227 ;; show desc | |
1228 (newsticker-show-entry)) | |
1229 | |
1230 ;; ====================================================================== | |
1231 ;;; Buffer stuff | |
1232 ;; ====================================================================== | |
1233 (defun newsticker--buffer-set-uptodate (value) | |
1234 "Set the uptodate-status of the newsticker buffer to VALUE. | |
1235 The mode-line is changed accordingly." | |
1236 (setq newsticker--buffer-uptodate-p value) | |
1237 (let ((b (get-buffer "*newsticker*"))) | |
1238 (when b | |
1239 (save-excursion | |
1240 (set-buffer b) | |
1241 (if value | |
1242 (setq mode-name "Newsticker -- up to date -- ") | |
1243 (setq mode-name "Newsticker -- NEED UPDATE -- "))) | |
1244 (force-mode-line-update 0)))) | |
1245 | |
1246 (defun newsticker--buffer-redraw () | |
1247 "Redraw the newsticker window." | |
1248 (if (fboundp 'force-window-update) | |
1249 (force-window-update (current-buffer)) | |
1250 (redraw-frame (selected-frame))) | |
1251 (run-hooks 'newsticker-buffer-change-hook) | |
1252 (sit-for 0)) | |
1253 | |
1254 (defun newsticker--buffer-insert-all-items () | |
1255 "Insert all cached newsticker items into the current buffer. | |
1256 Keeps order of feeds as given in `newsticker-url-list' and | |
1257 `newsticker-url-list-defaults'." | |
1258 (goto-char (point-min)) | |
1259 (mapc (lambda (url-item) | |
1260 (let* ((feed-name (car url-item)) | |
1261 (feed-name-symbol (intern feed-name)) | |
1262 (feed (assoc feed-name-symbol newsticker--cache)) | |
1263 (items (cdr feed)) | |
1264 (pos (point))) | |
1265 (when feed | |
1266 ;; insert the feed description | |
1267 (mapc (lambda (item) | |
1268 (when (eq (newsticker--age item) 'feed) | |
1269 (newsticker--buffer-insert-item item | |
1270 feed-name-symbol))) | |
1271 items) | |
1272 ;;insert the items | |
1273 (mapc (lambda (item) | |
1274 (if (memq (newsticker--age item) '(new immortal old | |
1275 obsolete)) | |
1276 (newsticker--buffer-insert-item item | |
1277 feed-name-symbol))) | |
1278 items) | |
1279 (put-text-property pos (point) 'feed (car feed)) | |
1280 | |
1281 ;; insert empty line between feeds | |
1282 (let ((p (point))) | |
1283 (insert "\n") | |
1284 (put-text-property p (point) 'hard t))))) | |
1285 (append newsticker-url-list newsticker-url-list-defaults)) | |
1286 | |
1287 (newsticker--buffer-set-faces (point-min) (point-max)) | |
1288 (newsticker--buffer-set-invisibility (point-min) (point-max)) | |
1289 (goto-char (point-min))) | |
1290 | |
1291 (defun newsticker--buffer-insert-item (item &optional feed-name-symbol) | |
1292 "Insert a news item in the current buffer. | |
1293 Insert a formatted representation of the ITEM. The optional parameter | |
1294 FEED-NAME-SYMBOL determines how the item is formatted and whether the | |
1295 item-retrieval time is added as well." | |
1296 ;; insert headline | |
1297 (if (eq (newsticker--age item) 'feed) | |
1298 (newsticker--buffer-do-insert-text item 'feed feed-name-symbol) | |
1299 (newsticker--buffer-do-insert-text item 'item feed-name-symbol)) | |
1300 ;; insert the description | |
1301 (newsticker--buffer-do-insert-text item 'desc feed-name-symbol)) | |
1302 | |
1303 (defun newsticker--buffer-do-insert-text (item type feed-name-symbol) | |
1304 "Actually insert contents of news item, format it, render it and all that. | |
1305 ITEM is a news item, TYPE tells which part of the item shall be inserted, | |
1306 FEED-NAME-SYMBOL tells to which feed this item belongs." | |
1307 (let* ((pos (point)) | |
1308 (format newsticker-desc-format) | |
1309 (pos-date-start nil) | |
1310 (pos-date-end nil) | |
1311 (pos-stat-start nil) | |
1312 (pos-stat-end nil) | |
1313 (pos-text-start nil) | |
1314 (pos-text-end nil) | |
1315 (pos-extra-start nil) | |
1316 (pos-extra-end nil) | |
1317 (pos-enclosure-start nil) | |
1318 (pos-enclosure-end nil) | |
1319 (age (newsticker--age item)) | |
1320 (preformatted-contents (newsticker--preformatted-contents item)) | |
1321 (preformatted-title (newsticker--preformatted-title item))) | |
1322 (cond ((and preformatted-contents | |
1323 (not (eq (aref preformatted-contents 0) ?\n));; we must | |
1324 ;; NOT have a line | |
1325 ;; break! | |
1326 (eq type 'desc)) | |
1327 (insert preformatted-contents)) | |
1328 ((and preformatted-title | |
1329 (not (eq (aref preformatted-title 0) ?\n));; we must NOT have a | |
1330 ;; line break! | |
1331 (eq type 'item)) | |
1332 (insert preformatted-title)) | |
1333 (t | |
1334 ;; item was not formatted before. | |
1335 ;; Let's go. | |
1336 (if (eq type 'item) | |
1337 (setq format newsticker-item-format) | |
1338 (if (eq type 'feed) | |
1339 (setq format newsticker-heading-format))) | |
1340 | |
1341 (while (> (length format) 0) | |
1342 (let ((prefix (if (> (length format) 1) | |
1343 (substring format 0 2) | |
1344 ""))) | |
1345 (cond ((string= "%c" prefix) | |
1346 ;; contents | |
1347 (when (newsticker--desc item) | |
1348 (setq pos-text-start (point-marker)) | |
1349 (insert (newsticker--desc item)) | |
1350 (setq pos-text-end (point-marker))) | |
1351 (setq format (substring format 2))) | |
1352 ((string= "%d" prefix) | |
1353 ;; date | |
1354 (setq pos-date-start (point-marker)) | |
1355 (if (newsticker--time item) | |
1356 (insert (format-time-string newsticker-date-format | |
1357 (newsticker--time item)))) | |
1358 (setq pos-date-end (point-marker)) | |
1359 (setq format (substring format 2))) | |
1360 ((string= "%l" prefix) | |
1361 ;; logo | |
1362 (let ((disabled (cond ((eq (newsticker--age item) 'feed) | |
1363 (= (newsticker--stat-num-items | |
1364 feed-name-symbol 'new) 0)) | |
1365 (t | |
1366 (not (eq (newsticker--age item) | |
1367 'new)))))) | |
1368 (let ((img (newsticker--image-read feed-name-symbol | |
1369 disabled))) | |
1370 (when img | |
1371 (newsticker--insert-image img (car item))))) | |
1372 (setq format (substring format 2))) | |
1373 ((string= "%L" prefix) | |
1374 ;; logo or title | |
1375 (let ((disabled (cond ((eq (newsticker--age item) 'feed) | |
1376 (= (newsticker--stat-num-items | |
1377 feed-name-symbol 'new) 0)) | |
1378 (t | |
1379 (not (eq (newsticker--age item) | |
1380 'new)))))) | |
1381 (let ((img (newsticker--image-read feed-name-symbol | |
1382 disabled))) | |
1383 (if img | |
1384 (newsticker--insert-image img (car item)) | |
1385 (when (car item) | |
1386 (setq pos-text-start (point-marker)) | |
1387 (if (eq (newsticker--age item) 'feed) | |
1388 (insert (newsticker--title item)) | |
1389 ;; FIXME: This is not the "real" title! | |
1390 (insert (format "%s" | |
1391 (car (newsticker--cache-get-feed | |
1392 feed-name-symbol))))) | |
1393 (setq pos-text-end (point-marker)))))) | |
1394 (setq format (substring format 2))) | |
1395 ((string= "%s" prefix) | |
1396 ;; statistics | |
1397 (setq pos-stat-start (point-marker)) | |
1398 (if (eq (newsticker--age item) 'feed) | |
1399 (insert (newsticker--buffer-statistics | |
1400 feed-name-symbol))) | |
1401 (setq pos-stat-end (point-marker)) | |
1402 (setq format (substring format 2))) | |
1403 ((string= "%t" prefix) | |
1404 ;; title | |
1405 (when (car item) | |
1406 (setq pos-text-start (point-marker)) | |
1407 (insert (car item)) | |
1408 (setq pos-text-end (point-marker))) | |
1409 (setq format (substring format 2))) | |
1410 ((string-match "%." prefix) | |
1411 ;; unknown specifier! | |
1412 (insert prefix) | |
1413 (setq format (substring format 2))) | |
1414 ((string-match "^\\([^%]*\\)\\(.*\\)" format) ;; FIXME! | |
1415 ;; everything else | |
1416 (let ((p (point))) | |
1417 (insert (substring format | |
1418 (match-beginning 1) (match-end 1))) | |
1419 ;; in case that the format string contained newlines | |
1420 (put-text-property p (point) 'hard t)) | |
1421 (setq format (substring format (match-beginning 2))))))) | |
1422 | |
1423 ;; decode HTML if possible... | |
1424 (let ((is-rendered-HTML nil)) | |
1425 (when (and newsticker-html-renderer pos-text-start pos-text-end) | |
1426 (condition-case error-data | |
1427 (save-excursion | |
1428 ;; check whether it is necessary to call html renderer | |
1429 ;; (regexp inspired by htmlr.el) | |
1430 (goto-char pos-text-start) | |
1431 (when (re-search-forward | |
1432 "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" pos-text-end t) | |
1433 ;; (message "%s" (newsticker--title item)) | |
1434 (let ((w3m-fill-column (if newsticker-use-full-width | |
1435 -1 fill-column)) | |
1436 (w3-maximum-line-length | |
1437 (if newsticker-use-full-width nil fill-column))) | |
1438 (save-excursion | |
1439 (funcall newsticker-html-renderer pos-text-start | |
1440 pos-text-end))) | |
1441 (cond ((eq newsticker-html-renderer 'w3m-region) | |
1442 (add-text-properties pos (point-max) | |
1443 (list 'keymap | |
1444 w3m-minor-mode-map))) | |
1445 ((eq newsticker-html-renderer 'w3-region) | |
1446 (add-text-properties pos (point-max) | |
1447 (list 'keymap w3-mode-map)))) | |
1448 (setq is-rendered-HTML t))) | |
1449 (error | |
1450 (message "Error: HTML rendering failed: %s, %s" | |
1451 (car error-data) (cdr error-data))))) | |
1452 ;; After html rendering there might be chunks of blank | |
1453 ;; characters between rendered text and date, statistics or | |
1454 ;; whatever. Remove it | |
1455 (when (and (eq type 'item) is-rendered-HTML) | |
1456 (goto-char pos) | |
1457 (while (re-search-forward "[ \t]*\n[ \t]*" nil t) | |
1458 (replace-match " " nil nil)) | |
1459 (goto-char (point-max))) | |
1460 (when (and newsticker-justification | |
1461 (memq type '(item desc)) | |
1462 (not is-rendered-HTML)) | |
1463 (condition-case nil | |
1464 (let ((use-hard-newlines t)) | |
1465 (fill-region pos (point-max) newsticker-justification)) | |
1466 (error nil)))) | |
1467 | |
1468 ;; remove leading and trailing newlines | |
1469 (goto-char pos) | |
1470 (unless (= 0 (skip-chars-forward " \t\r\n")) | |
1471 (delete-region pos (point))) | |
1472 (goto-char (point-max)) | |
1473 (let ((end (point))) | |
1474 (unless (= 0 (skip-chars-backward " \t\r\n" (1+ pos))) | |
1475 (delete-region (point) end))) | |
1476 (goto-char (point-max)) | |
1477 ;; closing newline | |
1478 (unless nil ;;(eq pos (point)) | |
1479 (insert "\n") | |
1480 (put-text-property (1- (point)) (point) 'hard t)) | |
1481 | |
1482 ;; insert enclosure element | |
1483 (when (eq type 'desc) | |
1484 (setq pos-enclosure-start (point)) | |
1485 (newsticker--insert-enclosure item newsticker--url-keymap) | |
1486 (setq pos-enclosure-end (point))) | |
1487 | |
1488 ;; show extra elements | |
1489 (when (eq type 'desc) | |
1490 (goto-char (point-max)) | |
1491 (setq pos-extra-start (point)) | |
1492 (newsticker--print-extra-elements item newsticker--url-keymap) | |
1493 (setq pos-extra-end (point))) | |
1494 | |
1495 ;; text properties | |
1496 (when (memq type '(feed item)) | |
1497 (add-text-properties pos (1- (point)) | |
1498 (list 'mouse-face 'highlight | |
1499 'nt-link (newsticker--link item) | |
1500 'help-echo | |
1501 (format "mouse-2: visit item (%s)" | |
1502 (newsticker--link item)) | |
1503 'keymap newsticker--url-keymap)) | |
1504 (add-text-properties pos (point) | |
1505 (list 'nt-title (newsticker--title item) | |
1506 'nt-desc (newsticker--desc item)))) | |
1507 | |
1508 (add-text-properties pos (point) | |
1509 (list 'nt-type type | |
1510 'nt-face type | |
1511 'nt-age age | |
1512 'nt-guid (newsticker--guid item))) | |
1513 (when (and pos-date-start pos-date-end) | |
1514 (put-text-property pos-date-start pos-date-end 'nt-face 'date)) | |
1515 (when (and pos-stat-start pos-stat-end) | |
1516 (put-text-property pos-stat-start pos-stat-end 'nt-face 'stat)) | |
1517 (when (and pos-extra-start pos-extra-end) | |
1518 (put-text-property pos-extra-start pos-extra-end | |
1519 'nt-face 'extra) | |
1520 (put-text-property pos-extra-start pos-extra-end | |
1521 'nt-type 'extra)) | |
1522 (when (and pos-enclosure-start pos-enclosure-end | |
1523 (> pos-enclosure-end pos-enclosure-start)) | |
1524 (put-text-property pos-enclosure-start (1- pos-enclosure-end) | |
1525 'nt-face 'enclosure)) | |
1526 | |
1527 ;; left margin | |
1528 ;;(unless (memq type '(feed item)) | |
1529 ;;(set-left-margin pos (1- (point)) 1)) | |
1530 | |
1531 ;; save rendered stuff | |
1532 (cond ((eq type 'desc) | |
1533 ;; preformatted contents | |
1534 (newsticker--cache-set-preformatted-contents | |
1535 item (buffer-substring pos (point)))) | |
1536 ((eq type 'item) | |
1537 ;; preformatted title | |
1538 (newsticker--cache-set-preformatted-title | |
1539 item (buffer-substring pos (point))))))))) | |
1540 | |
1541 (defun newsticker--buffer-statistics (feed-name-symbol) | |
1542 "Return a statistic string for the feed given by FEED-NAME-SYMBOL. | |
1543 See `newsticker-statistics-format'." | |
1544 (let ((case-fold-search nil)) | |
1545 (replace-regexp-in-string | |
1546 "%a" | |
1547 (format "%d" (newsticker--stat-num-items feed-name-symbol)) | |
1548 (replace-regexp-in-string | |
1549 "%i" | |
1550 (format "%d" (newsticker--stat-num-items feed-name-symbol 'immortal)) | |
1551 (replace-regexp-in-string | |
1552 "%n" | |
1553 (format "%d" (newsticker--stat-num-items feed-name-symbol 'new)) | |
1554 (replace-regexp-in-string | |
1555 "%o" | |
1556 (format "%d" (newsticker--stat-num-items feed-name-symbol 'old)) | |
1557 (replace-regexp-in-string | |
1558 "%O" | |
1559 (format "%d" (newsticker--stat-num-items feed-name-symbol 'obsolete)) | |
1560 newsticker-statistics-format))))))) | |
1561 | |
1562 (defun newsticker--buffer-set-faces (start end) | |
1563 "Add face properties according to mark property. | |
1564 Scans the buffer between START and END." | |
1565 (save-excursion | |
1566 (put-text-property start end 'face 'newsticker-default-face) | |
1567 (goto-char start) | |
1568 (let ((pos1 start) | |
1569 (pos2 1) | |
1570 (nt-face (get-text-property start 'nt-face)) | |
1571 (nt-age (get-text-property start 'nt-age))) | |
1572 (when nt-face | |
1573 (setq pos2 (next-single-property-change (point) 'nt-face)) | |
1574 (newsticker--set-face-properties pos1 pos2 nt-face nt-age) | |
1575 (setq nt-face (get-text-property pos2 'nt-face)) | |
1576 (setq pos1 pos2)) | |
1577 (while (and (setq pos2 (next-single-property-change pos1 'nt-face)) | |
1578 (<= pos2 end) | |
1579 (> pos2 pos1)) | |
1580 (newsticker--set-face-properties pos1 pos2 nt-face nt-age) | |
1581 (setq nt-face (get-text-property pos2 'nt-face)) | |
1582 (setq nt-age (get-text-property pos2 'nt-age)) | |
1583 (setq pos1 pos2))))) | |
1584 | |
1585 (defun newsticker--buffer-set-invisibility (start end) | |
1586 "Add invisibility properties according to nt-type property. | |
1587 Scans the buffer between START and END. Sets the 'invisible | |
1588 property to '(<nt-type>-<nt-age> <nt-type> <nt-age>)." | |
1589 (save-excursion | |
1590 ;; reset invisibility settings | |
1591 (put-text-property start end 'invisible nil) | |
1592 ;; let's go | |
1593 (goto-char start) | |
1594 (let ((pos1 start) | |
1595 (pos2 1) | |
1596 (nt-type (get-text-property start 'nt-type)) | |
1597 (nt-age (get-text-property start 'nt-age))) | |
1598 (when nt-type | |
1599 (setq pos2 (next-single-property-change (point) 'nt-type)) | |
1600 (put-text-property (max (point-min) pos1) (1- pos2) | |
1601 'invisible | |
1602 (list (intern | |
1603 (concat | |
1604 (symbol-name | |
1605 (if (eq nt-type 'extra) 'desc nt-type)) | |
1606 "-" | |
1607 (symbol-name nt-age))) | |
1608 nt-type | |
1609 nt-age)) | |
1610 (setq nt-type (get-text-property pos2 'nt-type)) | |
1611 (setq pos1 pos2)) | |
1612 (while (and (setq pos2 (next-single-property-change pos1 'nt-type)) | |
1613 (<= pos2 end) | |
1614 (> pos2 pos1)) | |
1615 ;; must shift one char to the left in order to handle inivisible | |
1616 ;; newlines, motion in invisible text areas and all that correctly | |
1617 (put-text-property (1- pos1) (1- pos2) | |
1618 'invisible | |
1619 (list (intern | |
1620 (concat | |
1621 (symbol-name | |
1622 (if (eq nt-type 'extra) 'desc nt-type)) | |
1623 "-" | |
1624 (symbol-name nt-age))) | |
1625 nt-type | |
1626 nt-age)) | |
1627 (setq nt-type (get-text-property pos2 'nt-type)) | |
1628 (setq nt-age (get-text-property pos2 'nt-age)) | |
1629 (setq pos1 pos2))))) | |
1630 | |
1631 (defun newsticker--set-face-properties (pos1 pos2 nt-face age) | |
1632 "Set the face for the text between the positions POS1 and POS2. | |
1633 The face is chosen according the values of NT-FACE and AGE." | |
1634 (let ((face (cond ((eq nt-face 'feed) | |
1635 'newsticker-feed-face) | |
1636 ((eq nt-face 'item) | |
1637 (cond ((eq age 'new) | |
1638 'newsticker-new-item-face) | |
1639 ((eq age 'old) | |
1640 'newsticker-old-item-face) | |
1641 ((eq age 'immortal) | |
1642 'newsticker-immortal-item-face) | |
1643 ((eq age 'obsolete) | |
1644 'newsticker-obsolete-item-face))) | |
1645 ((eq nt-face 'date) | |
1646 'newsticker-date-face) | |
1647 ((eq nt-face 'stat) | |
1648 'newsticker-statistics-face) | |
1649 ((eq nt-face 'extra) | |
1650 'newsticker-extra-face) | |
1651 ((eq nt-face 'enclosure) | |
1652 'newsticker-enclosure-face)))) | |
1653 (when face | |
1654 (put-text-property pos1 (max pos1 pos2) 'face face)))) | |
1655 | |
1656 ;; ====================================================================== | |
1657 ;;; Functions working on the *newsticker* buffer | |
1658 ;; ====================================================================== | |
1659 (defun newsticker--buffer-make-item-completely-visible () | |
1660 "Scroll buffer until current item is completely visible." | |
1661 (when newsticker--auto-narrow-to-feed | |
1662 (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-feed)) | |
1663 (point-min))) | |
1664 (max (or (save-excursion (newsticker--buffer-end-of-feed)) | |
1665 (point-max)))) | |
1666 (narrow-to-region min max))) | |
1667 (when newsticker--auto-narrow-to-item | |
1668 (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-item)) | |
1669 (point-min))) | |
1670 (max (or (save-excursion (newsticker--buffer-end-of-item)) | |
1671 (point-max)))) | |
1672 (narrow-to-region min max))) | |
1673 (sit-for 0) | |
1674 ;; do not count lines and stuff because that does not work when images | |
1675 ;; are displayed. Do it the simple way: | |
1676 (save-excursion | |
1677 (newsticker--buffer-end-of-item) | |
1678 (unless (pos-visible-in-window-p) | |
1679 (recenter -1))) | |
1680 (unless (pos-visible-in-window-p) | |
1681 (recenter 0))) | |
1682 | |
1683 (defun newsticker--buffer-get-feed-title-at-point () | |
1684 "Return feed symbol of headline at point." | |
1685 (format "%s" (or (get-text-property (point) 'feed) " "))) | |
1686 | |
1687 (defun newsticker--buffer-get-item-title-at-point () | |
1688 "Return feed symbol of headline at point." | |
1689 (format "%s" (or (get-text-property (point) 'nt-title) " "))) | |
1690 | |
1691 (defun newsticker--buffer-goto (types &optional age backwards) | |
1692 "Search next occurrence of TYPES in current buffer. | |
1693 TYPES is a list of symbols. If TYPES is found point is moved, if | |
1694 not point is left unchanged. If optional parameter AGE is not | |
1695 nil, the type AND the age must match. If BACKWARDS is t, search | |
1696 backwards." | |
1697 (let ((pos (save-excursion | |
1698 (save-restriction | |
1699 (widen) | |
1700 (catch 'found | |
1701 (let ((tpos (point))) | |
1702 (while (setq tpos | |
1703 (if backwards | |
1704 (if (eq tpos (point-min)) | |
1705 nil | |
1706 (or (previous-single-property-change | |
1707 tpos 'nt-type) | |
1708 (point-min))) | |
1709 (next-single-property-change | |
1710 tpos 'nt-type))) | |
1711 (and (memq (get-text-property tpos 'nt-type) types) | |
1712 (or (not age) | |
1713 (eq (get-text-property tpos 'nt-age) age)) | |
1714 (throw 'found tpos))))))))) | |
1715 (when pos | |
1716 (goto-char pos)) | |
1717 pos)) | |
1718 | |
1719 (defun newsticker--buffer-hideshow (mark-age onoff) | |
1720 "Hide or show items of type MARK-AGE. | |
1721 If ONOFF is nil the item is hidden, otherwise it is shown." | |
1722 (if onoff | |
1723 (remove-from-invisibility-spec mark-age) | |
1724 (add-to-invisibility-spec mark-age))) | |
1725 | |
1726 (defun newsticker--buffer-beginning-of-item () | |
1727 "Move point to the beginning of the item at point. | |
1728 Return new position." | |
1729 (if (bobp) | |
1730 (point) | |
1731 (let ((type (get-text-property (point) 'nt-type)) | |
1732 (typebefore (get-text-property (1- (point)) 'nt-type))) | |
1733 (if (and (memq type '(item feed)) | |
1734 (not (eq type typebefore))) | |
1735 (point) | |
1736 (newsticker--buffer-goto '(item feed) nil t) | |
1737 (point))))) | |
1738 | |
1739 (defun newsticker--buffer-beginning-of-feed () | |
1740 "Move point to the beginning of the feed at point. | |
1741 Return new position." | |
1742 (if (bobp) | |
1743 (point) | |
1744 (let ((type (get-text-property (point) 'nt-type)) | |
1745 (typebefore (get-text-property (1- (point)) 'nt-type))) | |
1746 (if (and (memq type '(feed)) | |
1747 (not (eq type typebefore))) | |
1748 (point) | |
1749 (newsticker--buffer-goto '(feed) nil t) | |
1750 (point))))) | |
1751 | |
1752 (defun newsticker--buffer-end-of-item () | |
1753 "Move point to the end of the item at point. | |
1754 Take care: end of item is at the end of its last line!" | |
1755 (when (newsticker--buffer-goto '(item feed nil)) | |
1756 (point))) | |
1757 | |
1758 (defun newsticker--buffer-end-of-feed () | |
1759 "Move point to the end of the last item of the feed at point. | |
1760 Take care: end of item is at the end of its last line!" | |
1761 (when (newsticker--buffer-goto '(feed nil)) | |
1762 (backward-char 1) | |
1763 (point))) | |
1764 | |
1765 ;; ====================================================================== | |
1766 ;;; misc | |
1767 ;; ====================================================================== | |
1768 | |
1769 (defun newsticker-mouse-browse-url (event) | |
1770 "Call `browse-url' for the link of the item at which the EVENT occurred." | |
1771 (interactive "e") | |
1772 (save-excursion | |
1773 (switch-to-buffer (window-buffer (posn-window (event-end event)))) | |
1774 (let ((url (get-text-property (posn-point (event-end event)) | |
1775 'nt-link))) | |
1776 (when url | |
1777 (browse-url url) | |
1778 (save-excursion | |
1779 (goto-char (posn-point (event-end event))) | |
1780 (if newsticker-automatically-mark-visited-items-as-old | |
1781 (newsticker-mark-item-at-point-as-read t))))))) | |
1782 | |
1783 (defun newsticker-browse-url () | |
1784 "Call `browse-url' for the link of the item at point." | |
1785 (interactive) | |
1786 (let ((url (get-text-property (point) 'nt-link))) | |
1787 (when url | |
1788 (browse-url url) | |
1789 (if newsticker-automatically-mark-visited-items-as-old | |
1790 (newsticker-mark-item-at-point-as-read t))))) | |
1791 | |
1792 (defvar newsticker-open-url-history | |
1793 '("wget" "xmms" "realplay") | |
1794 "...") | |
1795 | |
1796 (defun newsticker-handle-url () | |
1797 "Ask for a program to open the link of the item at point." | |
1798 (interactive) | |
1799 (let ((url (get-text-property (point) 'nt-link))) | |
1800 (when url | |
1801 (let ((prog (read-string "Open url with: " nil | |
1802 'newsticker-open-url-history))) | |
1803 (when prog | |
1804 (message "%s %s" prog url) | |
1805 (start-process prog prog prog url) | |
1806 (if newsticker-automatically-mark-visited-items-as-old | |
1807 (newsticker-mark-item-at-point-as-read t))))))) | |
1808 | |
1809 | |
1810 ;; ====================================================================== | |
1811 ;;; Misc | |
1812 ;; ====================================================================== | |
1813 | |
1814 (defun newsticker--cache-sort () | |
1815 "Sort the newsticker cache data." | |
1816 (let ((sort-fun (cond ((eq newsticker-sort-method 'sort-by-time) | |
1817 'newsticker--cache-item-compare-by-time) | |
1818 ((eq newsticker-sort-method 'sort-by-title) | |
1819 'newsticker--cache-item-compare-by-title) | |
1820 ((eq newsticker-sort-method 'sort-by-original-order) | |
1821 'newsticker--cache-item-compare-by-position)))) | |
1822 (mapc (lambda (feed-list) | |
1823 (setcdr feed-list (sort (cdr feed-list) | |
1824 sort-fun))) | |
1825 newsticker--cache))) | |
1826 | |
1827 (provide 'newsticker-plainview) | |
1828 | |
1829 ;; arch-tag: 4e48b683-d48b-48dd-a13e-fe45baf41184 | |
1830 ;;; newst-plainview.el ends here |