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