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