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