code.delx.au - gnu-emacs/blob - lisp/net/newsticker.el

   1 ;;; newsticker.el --- A news-ticker for Emacs.
   2
   3 ;; Copyright (C) 2003, 2004, 2005  Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; Author:      Ulf Jasper <ulf.jasper@web.de>
   8 ;; Filename:    newsticker.el
   9 ;; URL:         http://www.nongnu.org/newsticker
  10 ;; Created:     17. June 2003
  11 ;; Keywords:    News, RSS
  12
  13 ;; This program is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2 of the License, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; if not, write to the Free Software Foundation,
  25 ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  26
  27 (defconst newsticker-version "1.8" "Version number of newsticker.el.")
  28
  29 ;; ======================================================================
  30
  31 ;;; Commentary:
  32
  33 ;; Overview
  34 ;; --------
  35
  36 ;; Newsticker provides a newsticker for Emacs. A newsticker is a thing that
  37 ;; asynchronously retrieves headlines from a list of news sites, prepares
  38 ;; these headlines for reading, and allows for loading the corresponding
  39 ;; articles in a web browser.
  40
  41 ;; Headlines consist of a title and (possibly) a small description. They
  42 ;; are contained in RSS (RDF Site Summary) files. Newsticker should work
  43 ;; with all RSS files that follow the RDF Rich Site Summary 1.0
  44 ;; specification. It should also work with version 2.0 as well as
  45 ;; other/older/alternative RSS formats (like 0.9<something> or such). In
  46 ;; other words: Newsticker is a "RSS reader" or "RSS aggregator".
  47
  48 ;; Newsticker provides several commands for reading headlines, navigating
  49 ;; through them, marking them as read/unread, hiding old headlines
  50 ;; etc. Headlines can be displayed as plain text or as rendered HTML.
  51
  52 ;; Headlines can be displayed in the echo area, either scrolling like
  53 ;; messages in a stock-quote ticker, or just changing.
  54
  55 ;; Newsticker allows for automatic processing of headlines by providing
  56 ;; hooks and (sample) functions for automatically downloading images and
  57 ;; enclosed files (as delivered by podcasts, e.g.).
  58
  59
  60
  61 ;; Requirements
  62 ;; ------------
  63 ;; Newsticker can be used with Emacs version 21.1 or later as well as
  64 ;; XEmacs. It requires an XML-parser (`xml.el') which is part of
  65 ;; Emacs. If you are using XEmacs you want to get the `net-utils' package
  66 ;; which contains `xml.el' for XEmacs.
  67
  68 ;; Newsticker requires a program which can retrieve files via http and
  69 ;; prints them to stdout. By default Newsticker will use wget for this
  70 ;; task.
  71
  72 ;; Usage
  73 ;; -----
  74 ;; The command newsticker-show-news will display all available headlines in
  75 ;; a special buffer, called `*newsticker*'. It will also start the
  76 ;; asynchronous download of headlines. The modeline in the `*newsticker*'
  77 ;; buffer informs whenever new headlines have arrived. Clicking
  78 ;; mouse-button 2 or pressing RET in this buffer on a headline will call
  79 ;; browse-url to load the corresponding news story in your favourite web
  80 ;; browser.
  81
  82 ;; The scrolling, or flashing of headlines in the echo area, can be started
  83 ;; with the command newsticker-start-ticker. It can be stopped with
  84 ;; newsticker-stop-ticker.
  85
  86 ;; If you just want to start the periodic download of headlines use the
  87 ;; command newsticker-start. Calling newsticker-stop will stop the periodic
  88 ;; download, but will call newsticker-stop-ticker as well.
  89
  90 ;; Configuration
  91 ;; -------------
  92 ;; All Newsticker options are customizable, i.e. they can be changed with
  93 ;; Emacs customization methods: Call the command customize-group and enter
  94 ;; `newsticker' for the customization group.
  95
  96 ;; All Newsticker options have reasonable default values, so that in most
  97 ;; cases it is not necessary to customize settings before starting
  98 ;; Newsticker for the first time.
  99
 100 ;; Newsticker options are organized in the following groups.
 101
 102 ;; * newsticker-feed contains options that define which news
 103 ;;   feeds are retrieved and how this is done.
 104 ;;   o newsticker-url-list defines the list of headlines which are
 105 ;;     retrieved.
 106 ;;   o newsticker-retrieval-interval defines how often headlines are
 107 ;;     retrieved.
 108 ;; * newsticker-headline-processing contains options that define how the
 109 ;;   retrieved headlines are processed.
 110 ;;   o newsticker-keep-obsolete-items decides whether unread headlines that
 111 ;;     have been removed from the feed are kept in the Newsticker cache.
 112 ;; * newsticker-layout contains options that define how the buffer for
 113 ;;   reading RSS headlines is formatted.
 114 ;;   o newsticker-item-format defines how the title of a headline is
 115 ;;     formatted.
 116 ;; * newsticker-ticker contains options that define how headlines are shown
 117 ;;   in the echo area.
 118 ;;   o newsticker-display-interval and newsticker-scroll-smoothly define
 119 ;;     how headlines are shown in the echo area.
 120 ;; * newsticker-hooks contains options for hooking other Emacs commands to
 121 ;;   newsticker functions.
 122 ;;   o newsticker-new-item-functions allows for automatic processing of
 123 ;;     headlines. See `newsticker-download-images', and
 124 ;;     `newsticker-download-enclosures' for sample functions.
 125 ;; * newsticker-miscellaneous contains other Newsticker options.
 126
 127 ;; Please have a look at the customization buffers for the complete list of
 128 ;; options.
 129
 130 ;; Remarks
 131 ;; -------
 132 ;; This newsticker is designed do its job silently in the background
 133 ;; without disturbing you.  However, it is probably impossible to prevent
 134 ;; such a tool from slightly attenuating your Editor's responsiveness every
 135 ;; once in a while.
 136
 137 ;; Newsticker-mode supports imenu. It allows for navigating with the help
 138 ;; of a menu. In order to use this feature you should also add the
 139 ;; following.
 140 ;;   (add-hook 'newsticker-mode-hook 'imenu-add-menubar-index)
 141
 142 ;; ======================================================================
 143 ;;; History:
 144
 145 ;; 1.8 (2005-08-26)
 146 ;;     * Added commands `newsticker-show-extra' and `newsticker-hide-extra'
 147 ;;       to show and hide extra RSS elements, bound to "sx" and "hx"
 148 ;;       resp. Changed default value of `newsticker-show-all-rss-elements'
 149 ;;       to nil.
 150 ;;     * mode-line: Introduced special mode-line-format for newsticker.
 151 ;;     * Get feed logos only once every 24 h.
 152 ;;     * Default faces changed.
 153 ;;     * Minor fixes.
 154
 155 ;; 1.7 (2005-06-25)
 156 ;;     * Tool-bar support: most important commands can be called from
 157 ;;       tool-bar buttons.
 158 ;;     * Auto-Narrowing introduced: *newsticker* buffer can be narrowed to
 159 ;;       a single item (bound to key `xi') or a single feed (bound to `xf').
 160 ;;     * Enclosure support: enclosed items are shown (see
 161 ;;       `newsticker-enclosure-face') and can be (automatically) downloaded
 162 ;;       (see below). For those of you who read "podcasts".
 163 ;;     * Added variable `newsticker-auto-mark-filter' for automatically
 164 ;;       marking items as immortal or old.
 165 ;;     * Added hook variable `newsticker-new-item-functions' for handling
 166 ;;       new items.  Added sample functions `newsticker-download-images',
 167 ;;       and `newsticker-download-enclosures'.
 168 ;;     * Added hook variable `newsticker-select-item-hook' which is run
 169 ;;       after `newsticker-(next|previous)-(new-)?-item'.
 170 ;;     * Added hook variable `newsticker-select-feed-hook' which is run
 171 ;;       after `newsticker-(next|previous)-feed'.
 172 ;;     * Added hook variable `newsticker-buffer-change-hook' which is run
 173 ;;       after the contents or visibility of the newsticker buffer has
 174 ;;       changed, e.g. after `newsticker-buffer-update' or
 175 ;;       `newsticker-show-feed-desc'.
 176 ;;     * Added command `newsticker-handle-url' for interactively launching
 177 ;;       arbitrary programs for URLs, bound to `C-RET'.
 178 ;;     * URLs in extra elements are clickable.
 179 ;;     * Better support for w3, added command
 180 ;;       `newsticker-w3m-show-inline-images' for displaying all inline
 181 ;;       images.
 182 ;;     * Insert an artificial headline which notifies about failed retrievals.
 183 ;;     * Use pubDate element (RSS 2.0) instead of retrieval time when
 184 ;;       available.
 185 ;;     * Customizable options grouped.
 186 ;;     * Bugfixes: `newsticker--imenu-create-index'; strip whitespace
 187 ;;       from links; apply coding-system to extra-elements; time-comparison
 188 ;;       for obsolete items; and others which I have forgotten.
 189 ;;     * Workaround for another bug in xml-parse-region -- thanks to anonymous
 190 ;;       for sending patch.
 191 ;;     * Renamed invisible buffers ` *wget-newsticker-<feed>*' to
 192 ;;       ` *newsticker-wget-<feed>*'.
 193 ;;     * Tested with Emacs versions 21.3 and 22.0 and XEmacs 21.something.
 194
 195 ;; 1.6 * Support for (some) optional RSS elements: guid, dc:date. See
 196 ;;       `newsticker-show-all-rss-elements' `newsticker-extra-face'.
 197 ;;     * Better support for w3m -- `newsticker-default-face' is obsolete
 198 ;;       now, removed `newsticker-w3m-toggle-inline-image'.
 199 ;;     * Added `newsticker-desc-comp-max' -- comparison of item descriptions
 200 ;;       can take quite some time.
 201 ;;     * Added `newsticker--buffer-make-item-completely-visible' to
 202 ;;       ensure that the current item is fully visible.
 203 ;;     * Allow for non-positive retrieval-interval, which make newsticker
 204 ;;       get news only once.
 205 ;;     * Use :set for customizable variables.
 206 ;;     * Added `newsticker-buffer-force-update', bound to key `U'.
 207 ;;     * Added concept of obsolete items, see
 208 ;;       `newsticker-keep-obsolete-items', `newsticker-obsolete-item-face',
 209 ;;       `newsticker-obsolete-item-max-age'.
 210 ;;     * Added `newsticker-add-url'.
 211 ;;     * OPML export.
 212 ;;     * Save pre-formatted titles => even better performance!!
 213 ;;     * `newsticker-*-new-item' wraps at beginning/end of buffer.
 214 ;;     * Always sort obsolete items to end of item list.
 215 ;;     * Bugfixes:
 216 ;;       - newsticker-hide-entry,
 217 ;;       - changes of feed-titles led to duplicate feed items,
 218 ;;       - faces for rendered HTML texts,
 219 ;;       - length of ticker-text (for "exotic"/multibyte texts),
 220 ;;         Thanks to Hiroshi Maruyama.
 221 ;;       - suppress items with empty title and description
 222 ;;       - newsticker-sort-method was ignored!
 223 ;;       - prevent call of fill-region on HTML-rendered descriptions.
 224
 225 ;; 1.5 * Rewrote the visibility stuff. newsticker does not inherit
 226 ;;       outline anymore.  Now you have complete freedom for
 227 ;;       `newsticker-*-format'.
 228 ;;     * Save pre-formatted descriptions => incredible performance boost!!
 229 ;;     * Introduced `newsticker-(start|stop)-ticker'.
 230 ;;     * Introduced statistics for heading-format and
 231 ;;       `newsticker-statistics-face'.
 232 ;;     * Introduced `newsticker-enable-logo-manipulations'.
 233 ;;     * Compare link of items (as well as title and desc).
 234 ;;     * Added `newsticker-start-hook' and `newsticker-stop-hook', thanks
 235 ;;       to mace.
 236 ;;     * Bugfixes -- thanks to Ryan Yeske, Jari Aalto, Bruce Ingalls.
 237 ;;     * Tested with Emacs 21.3.50, 21.3.1, 21.2, 21.1; XEmacs 21.4.15
 238
 239 ;; 1.4 * Enabled HTML rendering, added `newsticker-html-renderer' to
 240 ;;       choose a HTML rendering engine, thanks to Greg Scott for testing
 241 ;;     * New Outline handling using text properties instead of "**"
 242 ;;       prefixes.
 243 ;;     * Added possibility to mark single item as old (bound to key
 244 ;;       `o' (`newsticker-mark-item-at-point-as-read').
 245 ;;     * Added possibility to mark single item as immortal (bound to key
 246 ;;       `i' (`newsticker-mark-item-at-point-as-immortal').
 247 ;;     * Added possibility to display feed logos.
 248 ;;     * Added `newsticker-heading-format', `newsticker-item-format'.
 249 ;;     * Added `newsticker-date-format'.
 250 ;;     * Added `newsticker-justification'.
 251 ;;     * Added `newsticker-automatically-mark-visited-items-as-old'.
 252 ;;     * Added `newsticker-w3m-toggle-inline-image' which calls
 253 ;;       `w3m-toggle-inline-image' if `newsticker-html-renderer' is
 254 ;;       `w3m-region'. Exists for convenience only (bound to key
 255 ;;       `RET').
 256
 257 ;; 1.3 * Compare title AND desc to check whether item is old, except
 258 ;;       for feed desc
 259 ;;     * Mark as not-up-to-date only after new items have arrived.
 260 ;;     * Added XEmacs compatibility code, tested with XEmacs 21.4.13.
 261 ;;     * Tested with Emacs 21.3.50 and Emacs 21.2.something.
 262 ;;     * Bugfix: Apply coding-systems to feed title and description,
 263 ;;       thanks to OHASHI Akira
 264 ;;     * Bugfix: xml-parser-workaround did not work for japanese texts,
 265 ;;       thanks to OHASHI Akira
 266 ;;     * Kill wget-buffers unless newsticker-debug is not nil.
 267 ;;     * Bugfix: xml-parser-workaround for "DOCTYPE rdf:RDF"
 268
 269 ;; 1.2 Peter S Galbraith <psg@debian.org>
 270 ;;     * Added `newsticker-url-list-defaults', splitting the URLs into
 271 ;;       a customizable selection list, and a user add-on list.
 272 ;;     * Minor checkdoc fixes.
 273
 274 ;; 1.1 * Introduced optional feed-specific wget-arguments.
 275 ;;     * Keep order of feeds as given in `newsticker-url-list' in
 276 ;;       *newsticker* buffer.
 277 ;;     * Ignore unsupported coding systems.
 278
 279 ;; 1.0 * Introduced feed-specific retrieval-timers.
 280 ;;     * Removed dependency on 'cl (cddddr).
 281 ;;     * Thanks to Kevin Rodgers and T.V.  Raman for their help.
 282 ;;     * Use utf-8 for reading and writing cache data.
 283 ;;     * Reported to work with Emacs 21.3.50.
 284
 285 ;; 0.99 * Minor tweaks.
 286 ;;      * Tested with Emacs 21.3.2
 287
 288 ;; 0.98 * Check exit status of wget processes.  Keep cache data if
 289 ;;        something went wrong.  Throw error when old wget-processes
 290 ;;        are hanging around.
 291 ;;      * Introduced newsticker-specific faces.
 292 ;;      * Added `newsticker-show-descriptions-of-new-items'.
 293 ;;      * Added `newsticker-hide-old-items-in-newsticker-buffer'.
 294 ;;      * Added `newsticker-(hide|show)-old-items'.
 295
 296 ;; 0.97 * Minor tweaks.
 297
 298 ;; 0.96 * Added caching.
 299 ;;      * newsticker-mode inherits outline-mode.
 300 ;;      * newsticker-mode supports imenu.
 301 ;;      * Easy buffer-navigation with newsticker-mode's keymap.
 302 ;;      * Some bugs fixed.
 303 ;;      * Thanks to Moritz Epple for documentation tips.
 304
 305 ;; 0.95 * Added newsticker-mode -- Thanks to T.V.  Raman.
 306 ;;      * Catch xml-parser errors -- Thanks to T.V.  Raman.
 307 ;;      * Remove stupid newlines in titles (headlines) -- Thanks to
 308 ;;        Jeff Rancier.
 309
 310 ;; 0.94 * Added clickerability and description for channel headings.
 311 ;;      * Made it work for (at least some) rss 0.9<something> feeds.
 312
 313 ;; 0.93 * Added some more sites.
 314 ;;      * Do not flood the *Messages* buffer.
 315 ;;      * First attempt at handling coding systems.
 316
 317 ;; 0.92 * Added `newsticker-wget-name'.
 318 ;;      * Try to display message only if minibuffer and echo area are
 319 ;;        not in use already.
 320 ;;      * Dirty workaround for newer versions of xml.el: Remove
 321 ;;        whitespace in rdf.
 322 ;;      * Tested with Emacs 21.3.2 and CVS-snapshot of 2003-06-21.
 323
 324 ;; 0.91 * First bugfix: *newsticker* is read-only.
 325
 326 ;; 0.9  * First release.
 327 ;;      * Tested with Emacs 21.3.2 and wget 1.8.2.
 328
 329 ;; ======================================================================
 330 ;;; To Do:
 331
 332 ;; * Image handling for XEmacs (create-image does not exist)
 333
 334 ;; ======================================================================
 335 ;;; Code:
 336
 337 (require 'derived)
 338 (require 'xml)
 339
 340 ;; Silence warnings
 341 (defvar tool-bar-map)
 342 (defvar w3-mode-map)
 343 (defvar w3m-minor-mode-map)
 344
 345 ;; ======================================================================
 346 ;;; Customizables
 347 ;; ======================================================================
 348 (defgroup newsticker nil
 349   "RSS aggregator."
 350   :group 'applications)
 351
 352 (defconst newsticker--raw-url-list-defaults
 353   '(("CNET News.com"
 354      "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
 355     ("Debian Security Advisories"
 356     "http://www.debian.org/security/dsa.en.rdf")
 357     ("Debian Security Advisories - Long format"
 358     "http://www.debian.org/security/dsa-long.en.rdf")
 359     ("Emacs Wiki"
 360     "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
 361     nil
 362     3600)
 363     ("Freshmeat.net"
 364     "http://freshmeat.net/backend/fm.rdf")
 365     ("Kuro5hin.org"
 366     "http://www.kuro5hin.org/backend.rdf")
 367     ("LWN (Linux Weekly News)"
 368     "http://lwn.net/headlines/rss")
 369     ("NewsForge"
 370     "http://newsforge.com/index.rss")
 371     ("NY Times: Technology"
 372     "http://partners.userland.com/nytRss/technology.xml")
 373     ("NY Times"
 374     "http://partners.userland.com/nytRss/nytHomepage.xml")
 375     ("Quote of the day"
 376     "http://www.quotationspage.com/data/qotd.rss"
 377     "07:00"
 378     86400)
 379     ("The Register"
 380     "http://www.theregister.co.uk/tonys/slashdot.rdf")
 381     ("slashdot"
 382     "http://slashdot.org/index.rss"
 383     nil
 384     3600)                        ;/. will ban you if under 3600 seconds!
 385     ("Wired News"
 386     "http://www.wired.com/news_drop/netcenter/netcenter.rdf")
 387     ("Heise News (german)"
 388     "http://www.heise.de/newsticker/heise.rdf")
 389     ("Tagesschau (german)"
 390     "http://www.tagesschau.de/newsticker.rdf"
 391     nil
 392     1800)
 393     ("Telepolis (german)"
 394     "http://www.heise.de/tp/news.rdf"))
 395   "Default URL list in raw form.
 396 This list is fed into defcustom via `newsticker--splicer'.")
 397
 398 (defun newsticker--splicer (item)
 399   "Convert ITEM for splicing into `newsticker-url-list-defaults'."
 400   (let ((result (list 'list :tag (nth 0 item) (list 'const (nth 0 item))))
 401         (element (cdr item)))
 402     (while element
 403       (setq result (append result (list (list 'const (car element)))))
 404       (setq element (cdr element)))
 405     result))
 406
 407 ;; ======================================================================
 408 ;;; Customization
 409 ;; ======================================================================
 410 (defun newsticker--set-customvar (symbol value)
 411   "Set newsticker-variable SYMBOL value to VALUE.
 412
 413 Calls all necessary actions which are necessary in order to make
 414 the new value effective.  Changing `newsticker-url-list', for example,
 415 will re-start the retrieval-timers."
 416   (unless (condition-case nil
 417               (eq (symbol-value symbol) value)
 418             (error nil))
 419     (set symbol value)
 420     (cond ((eq symbol 'newsticker-sort-method)
 421            (when (fboundp 'newsticker--cache-sort)
 422              (message "Applying new sort method...")
 423              (newsticker--cache-sort)
 424              (newsticker--buffer-set-uptodate nil)
 425              (message "Applying new sort method...done")))
 426           ((memq symbol '(newsticker-url-list-defaults
 427                           newsticker-url-list
 428                           newsticker-retrieval-interval))
 429            (when (and (fboundp 'newsticker-running-p)
 430                       (newsticker-running-p))
 431              (message "Restarting newsticker")
 432              (newsticker-stop)
 433              (newsticker-start)))
 434           ((eq symbol 'newsticker-display-interval)
 435            (when (and (fboundp 'newsticker-running-p)
 436                       (newsticker-running-p))
 437              (message "Restarting ticker")
 438              (newsticker-stop-ticker)
 439              (newsticker-start-ticker)
 440              (message "")))
 441           ((memq symbol '(newsticker-hide-old-items-in-echo-area
 442                           newsticker-hide-obsolete-items-in-echo-area
 443                           newsticker-hide-immortal-items-in-echo-area))
 444            (when (and (fboundp 'newsticker-running-p)
 445                       (newsticker-running-p))
 446              (message "Restarting newsticker")
 447              (newsticker-stop-ticker)
 448              (newsticker--ticker-text-setup)
 449              (newsticker-start-ticker)
 450              (message "")))
 451           ((memq symbol '(newsticker-hide-old-items-in-newsticker-buffer
 452                           newsticker-show-descriptions-of-new-items))
 453            (when (fboundp 'newsticker--buffer-set-uptodate)
 454              (newsticker--buffer-set-uptodate nil)))
 455           ((memq symbol '(newsticker-heading-format
 456                           newsticker-item-format
 457                           newsticker-desc-format
 458                           newsticker-date-format
 459                           newsticker-statistics-format
 460                           newsticker-justification
 461                           newsticker-use-full-width
 462                           newsticker-html-renderer
 463                           newsticker-feed-face
 464                           newsticker-new-item-face
 465                           newsticker-old-item-face
 466                           newsticker-immortal-item-face
 467                           newsticker-obsolete-item-face
 468                           newsticker-date-face
 469                           newsticker-statistics-face
 470                           ;;newsticker-default-face
 471                           ))
 472            (when (fboundp 'newsticker--forget-preformatted)
 473              (newsticker--forget-preformatted)))
 474           (t
 475            (error "Ooops %s" symbol)))))
 476
 477 ;; customization group feed
 478 (defgroup newsticker-feed nil
 479   "Settings for the RSS feeds."
 480   :group 'newsticker)
 481
 482 (defcustom newsticker-url-list-defaults
 483  '(("Emacs Wiki"
 484     "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
 485     nil
 486     3600))
 487   "A customizable list of news feeds to select from.
 488 These were mostly extracted from the Radio Community Server at
 489 http://subhonker6.userland.com/rcsPublic/rssHotlist.
 490
 491 You may add other entries in `newsticker-url-list'."
 492   :type `(set ,@(mapcar `newsticker--splicer
 493                         newsticker--raw-url-list-defaults))
 494   :set 'newsticker--set-customvar
 495   :group 'newsticker-feed)
 496
 497 (defcustom newsticker-url-list nil
 498   "The news feeds which you like to watch.
 499
 500 This alist will be used in addition to selection made customizing
 501 `newsticker-url-list-defaults'.
 502
 503 This is an alist.  Each element consists of two items: a LABEL and a URL,
 504 optionally followed by a START-TIME, INTERVAL specifier and WGET-ARGUMENTS.
 505
 506 The LABEL gives the name of the news feed.  It can be an arbitrary string.
 507
 508 The URL gives the location of the news feed.  It must point to a valid
 509 RSS file.  The RSS file is retrieved by calling wget, or whatever you
 510 specify as `newsticker-wget-name'.
 511
 512 The START-TIME can be either a string, or nil.  If it is a string it
 513 specifies a fixed time at which this feed shall be retrieved for the
 514 first time.  (Examples: \"11:00pm\", \"23:00\").  If it is nil (or
 515 unspecified), this feed will be retrieved immediately after calling
 516 `newsticker-start'.
 517
 518 The INTERVAL specifies the time between retrievals for this feed.  If it
 519 is nil (or unspecified) the default interval value as set in
 520 `newsticker-retrieval-interval' is used.
 521
 522 \(newsticker.el calls `run-at-time'. The newsticker-parameters START-TIME
 523 and INTERVAL correspond to the `run-at-time'-parameters TIME and REPEAT.)
 524
 525 WGET-ARGUMENTS specifies arguments for wget (see `newsticker-wget-name')
 526 which apply for this feed only, overriding the value of
 527 `newsticker-wget-arguments'."
 528   :type '(repeat (list :tag "News feed"
 529                        (string :tag "Label")
 530                        (string :tag "URI")
 531                        (choice :tag "Start"
 532                                (const   :tag "Default" nil)
 533                                (string  :tag "Fixed Time"))
 534                        (choice :tag "Interval"
 535                                (const   :tag "Default" nil)
 536                                (const   :tag "Hourly" 3600)
 537                                (const   :tag "Daily" 86400)
 538                                (integer :tag "Interval"))
 539                        (choice :tag "Wget Arguments"
 540                                (const  :tag "Default arguments" nil)
 541                                (repeat :tag "Special arguments" string))))
 542   :set 'newsticker--set-customvar
 543   :group 'newsticker-feed)
 544
 545 (defcustom newsticker-wget-name
 546   "wget"
 547   "Name of the program which is called to retrieve news from the web.
 548 The canonical choice is wget but you may take any other program which is
 549 able to return the contents of a news feed file on stdout."
 550   :type 'string
 551   :group 'newsticker-feed)
 552
 553 (defcustom newsticker-wget-arguments
 554   '("-q" "-O" "-")
 555   "Arguments which are passed to wget.
 556 There is probably no reason to change the default settings, unless you
 557 are living behind a firewall."
 558   :type '(repeat (string :tag "Argument"))
 559   :group 'newsticker-feed)
 560
 561 (defcustom newsticker-retrieval-interval
 562   3600
 563   "Time interval for retrieving new news items (seconds).
 564 If this value is not positive (i.e. less than or equal to 0)
 565 items are retrieved only once!
 566 Please note that some feeds, e.g. Slashdot, will ban you if you
 567 make it less than 1800 seconds (30 minutes)!"
 568   :type '(choice :tag "Interval"
 569                  (const   :tag "No automatic retrieval" 0)
 570                  (const   :tag "Hourly" 3600)
 571                  (const   :tag "Daily" 86400)
 572                  (integer :tag "Interval"))
 573   :set 'newsticker--set-customvar
 574   :group 'newsticker-feed)
 575
 576 (defcustom newsticker-desc-comp-max
 577   100
 578   "Relevant length of headline descriptions.
 579 This value gives the maximum number of characters which will be
 580 taken into account when newsticker compares two headline
 581 descriptions."
 582   :type 'integer
 583   :group 'newsticker-feed)
 584
 585 ;; customization group behaviour
 586 (defgroup newsticker-headline-processing nil
 587   "Settings for the automatic processing of RSS headlines."
 588   :group 'newsticker)
 589
 590 (defcustom newsticker-automatically-mark-items-as-old
 591   t
 592   "Decides whether to automatically mark items as old.
 593 If t a new item is considered as new only after its first retrieval.  As
 594 soon as it is retrieved a second time, it becomes old.  If not t all
 595 items stay new until you mark them as old.  This is done in the
 596 *newsticker* buffer."
 597   :type 'boolean
 598   :group 'newsticker-headline-processing)
 599
 600 (defcustom newsticker-automatically-mark-visited-items-as-old
 601   t
 602   "Decides whether to automatically mark visited items as old.
 603 If t an item is marked as old as soon as the associated link is
 604 visited, i.e. after pressing RET or mouse2 on the item's
 605 headline."
 606
 607   :type 'boolean
 608   :group 'newsticker-headline-processing)
 609
 610 (defcustom newsticker-keep-obsolete-items
 611   t
 612   "Decides whether to keep unread items which have been removed from feed.
 613 If t a new item, which has been removed from the feed, is kept in
 614 the cache until it is marked as read."
 615   :type 'boolean
 616   :group 'newsticker-headline-processing)
 617
 618 (defcustom newsticker-obsolete-item-max-age
 619   (* 60 60 24)
 620   "Maximal age of obsolete items, in seconds.
 621 Obsolete items which are older than this value will be silently
 622 deleted at the next retrieval."
 623   :type 'integer
 624   :group 'newsticker-headline-processing)
 625
 626 (defcustom newsticker-auto-mark-filter
 627   nil
 628   "A filter for automatically marking headlines.
 629
 630 This is an alist of the form (FEED-NAME OLD-LIST IMMORTAL-LIST).  I.e. each
 631 element consists of a FEED-NAME and two lists.  Each list consists a set of
 632 regular expressions.  The first list contains patterns of headlines which
 633 will be marked as old.  The second list contains patterns of headlines which
 634 will be marked as immortal.
 635
 636 This filter is checked after a new headline has been retrieved.  If
 637 FEED-NAME matches the name of the corresponding news feed, both sublists
 638 are checked: If the title of the headline matches any of the regular
 639 expressions in OLD-LIST, this headline is marked as old, if it matches any
 640 of the expressions in IMMORTAL-LIST it is marked as immortal.
 641
 642 If, for example, `newsticker-auto-mark-filter' looks like
 643  \((slashdot (\"^Forget me!$\") (\"^Read me$\" \"important\")))
 644 then all articles from slashdot are marked as old if they have the title
 645 \"Forget me!\".  All articles which have the title \"Read me\" and all
 646 articles which contain the string \"important\" in their title are marked
 647 as immortal."
 648   :type '(repeat (list :tag "Feed filter rule"
 649                        (string :tag "Feed name")
 650                        ;;(choice ,@(mapcar (lambda (i)
 651                          ;;                  (list :tag (car i) (car i)))
 652                            ;;              newsticker-url-list))
 653                        (repeat :tag "Mark as old" string)
 654                        (repeat :tag "Mark as immortal" string)))
 655   :group 'newsticker-headline-processing)
 656
 657 ;; customization group layout
 658 (defgroup newsticker-layout nil
 659   "Settings for layout of the RSS reader."
 660   :group 'newsticker)
 661
 662 (defcustom newsticker-sort-method
 663   'sort-by-original-order
 664   "Sort method for news items.
 665 The following sort methods are available:
 666 * `sort-by-original-order' keeps the order in which the items
 667   appear in the RSS file (please note that for immortal items,
 668   which have been removed from the news feed, there is no original
 669   order),
 670 * `sort-by-time' looks at the time at which an item has been seen
 671   the first time.  The most recent item is put at top,
 672 * `sort-by-title' will put the items in an alphabetical order."
 673   :type '(choice
 674           (const :tag "Keep original order" sort-by-original-order)
 675           (const :tag "Sort by time"        sort-by-time)
 676           (const :tag "Sort by title"       sort-by-title))
 677   :set 'newsticker--set-customvar
 678   :group 'newsticker-layout)
 679
 680 (defcustom newsticker-hide-old-items-in-newsticker-buffer
 681   nil
 682   "Decides whether to automatically hide old items in the *newsticker* buffer.
 683 If set to t old items will be completely folded and only new items
 684 will show up in the *newsticker* buffer.  Otherwise old as well as new
 685 items will be visible."
 686   :type 'boolean
 687   :set 'newsticker--set-customvar
 688   :group 'newsticker-layout)
 689
 690 (defcustom newsticker-show-descriptions-of-new-items
 691   t
 692   "Whether to automatically show descriptions of new items in *newsticker*.
 693 If set to t old items will be folded and new items will be
 694 unfolded.  Otherwise old as well as new items will be folded."
 695   :type 'boolean
 696   :set 'newsticker--set-customvar
 697   :group 'newsticker-layout)
 698
 699 (defcustom newsticker-heading-format
 700   "%l
 701 %t %d %s"
 702   "Format string for feed headings.
 703 The following printf-like specifiers can be used:
 704 %d  The date the feed was retrieved.  See `newsticker-date-format'.
 705 %l  The logo (image) of the feed.  Most RSS feeds provide a small
 706     image as logo.  Newsticker can display them, if Emacs can --
 707     see `image-types' for a list of supported image types.
 708 %L  The logo (image) of the feed.  If the logo is not available
 709     the title of the feed is used.
 710 %s  The statistical data of the feed.  See `newsticker-statistics-format'.
 711 %t  The title of the feed, i.e. its name."
 712   :type 'string
 713   :set 'newsticker--set-customvar
 714   :group 'newsticker-layout)
 715
 716 (defcustom newsticker-item-format
 717   "%t %d"
 718   "Format string for news item headlines.
 719 The following printf-like specifiers can be used:
 720 %d  The date the item was (first) retrieved.  See `newsticker-date-format'.
 721 %l  The logo (image) of the feed.  Most RSS feeds provide a small
 722     image as logo.  Newsticker can display them, if Emacs can --
 723     see `image-types' for a list of supported image types.
 724 %L  The logo (image) of the feed.  If the logo is not available
 725     the title of the feed is used.
 726 %t  The title of the item."
 727   :type 'string
 728   :set 'newsticker--set-customvar
 729   :group 'newsticker-layout)
 730
 731 (defcustom newsticker-desc-format
 732   "%d %c"
 733   "Format string for news descriptions (contents).
 734 The following printf-like specifiers can be used:
 735 %c  The contents (description) of the item.
 736 %d  The date the item was (first) retrieved.  See `newsticker-date-format'."
 737   :type 'string
 738   :set 'newsticker--set-customvar
 739   :group 'newsticker-layout)
 740
 741 (defcustom newsticker-date-format
 742   "(%A, %H:%M)"
 743   "Format for the date part in item and feed lines.
 744 See `format-time-string' for a list of valid specifiers."
 745   :type 'string
 746   :set 'newsticker--set-customvar
 747   :group 'newsticker-layout)
 748
 749 (defcustom newsticker-statistics-format
 750   "[%n + %i + %o + %O = %a]"
 751   "Format for the statistics part in feed lines.
 752 The following printf-like specifiers can be used:
 753 %a  The number of all items in the feed.
 754 %i  The number of immortal items in the feed.
 755 %n  The number of new items in the feed.
 756 %o  The number of old items in the feed.
 757 %O  The number of obsolete items in the feed."
 758   :type 'string
 759   :set 'newsticker--set-customvar
 760   :group 'newsticker-layout)
 761
 762 (defcustom newsticker-show-all-rss-elements
 763   nil
 764   "Show all RSS elements."
 765   :type 'boolean
 766   ;;:set 'newsticker--set-customvar
 767   :group 'newsticker-layout)
 768
 769 ;; image related things
 770 (defcustom newsticker-enable-logo-manipulations
 771   t
 772   "If non-nil newsticker manipulates logo images.
 773 This enables the following image properties: heuristic mask for all
 774 logos, and laplace-conversion for images without new items."
 775   :type 'boolean
 776   :group 'newsticker-layout)
 777
 778
 779 ;; rendering
 780 (defcustom newsticker-justification
 781   'left
 782   "How to fill item descriptions.
 783 If non-nil newsticker calls `fill-region' to wrap long lines in
 784 item descriptions.  However, if an item description contains HTML
 785 text and `newsticker-html-renderer' is non-nil, filling is not
 786 done."
 787   :type '(choice :tag "Justification"
 788                  (const :tag "No filling" nil)
 789                  (const :tag "Left"       left)
 790                  (const :tag "Right"      right)
 791                  (const :tag "Center"     center)
 792                  (const :tag "Full"       full))
 793   :set 'newsticker--set-customvar
 794   :group 'newsticker-layout)
 795
 796 (defcustom newsticker-use-full-width
 797   t
 798   "Decides whether to use the full window width when filling.
 799 If non-nil newsticker sets `fill-column' so that the whole
 800 window is used when filling.  See also `newsticker-justification'."
 801   :type 'boolean
 802   :set 'newsticker--set-customvar
 803   :group 'newsticker-layout)
 804
 805 (defcustom newsticker-html-renderer
 806   nil
 807   "Function for rendering HTML contents.
 808 If non-nil, newsticker.el will call this function whenever it finds
 809 HTML-like tags in item descriptions.  Possible functions are, for
 810 example, `w3m-region', `w3-region', and (if you have htmlr.el installed)
 811 `newsticker-htmlr-render'.
 812
 813 In order to make sure that the HTML renderer is loaded when you
 814 run newsticker, you should add one of the following statements to
 815 your .emacs.  If you use w3m,
 816
 817   (autoload 'w3m-region \"w3m\"
 818     \"Render region in current buffer and replace with result.\" t)
 819
 820 or, if you use w3,
 821
 822   (require 'w3-auto)
 823
 824 or, if you use htmlr
 825
 826   (require 'htmlr)"
 827   :type '(choice :tag "Function"
 828                  (const :tag "None" nil)
 829                  (const :tag "w3" w3-region)
 830                  (const :tag "w3m" w3m-region)
 831                  (const :tag "htmlr" newsticker-htmlr-render))
 832   :set 'newsticker--set-customvar
 833   :group 'newsticker-layout)
 834
 835
 836 ;; faces
 837 (defgroup newsticker-faces nil
 838   "Settings for the faces of the RSS reader."
 839   :group 'newsticker-layout)
 840
 841 (defface newsticker-feed-face
 842   '((((class color) (background dark))
 843      (:family "helvetica" :bold t :height 1.2 :foreground "misty rose"))
 844     (((class color) (background light))
 845      (:family "helvetica" :bold t :height 1.2 :foreground "black")))
 846   "Face for news feeds."
 847   :group 'newsticker-faces)
 848
 849 (defface newsticker-new-item-face
 850   '((((class color) (background dark))
 851      (:family "helvetica" :bold t))
 852     (((class color) (background light))
 853      (:family "helvetica" :bold t)))
 854   "Face for old news items."
 855   :group 'newsticker-faces)
 856
 857 (defface newsticker-old-item-face
 858   '((((class color) (background dark))
 859      (:family "helvetica" :bold t :foreground "orange3"))
 860     (((class color) (background light))
 861      (:family "helvetica" :bold t :foreground "red4")))
 862   "Face for old news items."
 863   :group 'newsticker-faces)
 864
 865 (defface newsticker-immortal-item-face
 866   '((((class color) (background dark))
 867      (:family "helvetica" :bold t :italic t :foreground "orange"))
 868     (((class color) (background light))
 869      (:family "helvetica" :bold t :italic t :foreground "blue")))
 870   "Face for immortal news items."
 871   :group 'newsticker-faces)
 872
 873 (defface newsticker-obsolete-item-face
 874   '((((class color) (background dark))
 875      (:family "helvetica" :bold t :strike-through t))
 876     (((class color) (background light))
 877      (:family "helvetica" :bold t :strike-through t)))
 878   "Face for old news items."
 879   :group 'newsticker-faces)
 880
 881 (defface newsticker-date-face
 882   '((((class color) (background dark))
 883      (:family "helvetica" :italic t :height 0.8))
 884     (((class color) (background light))
 885      (:family "helvetica" :italic t :height 0.8)))
 886   "Face for newsticker dates."
 887   :group 'newsticker-faces)
 888
 889 (defface newsticker-statistics-face
 890   '((((class color) (background dark))
 891      (:family "helvetica" :italic t :height 0.8))
 892     (((class color) (background light))
 893      (:family "helvetica" :italic t :height 0.8)))
 894   "Face for newsticker dates."
 895   :group 'newsticker-faces)
 896
 897 (defface newsticker-enclosure-face
 898   '((((class color) (background dark))
 899      (:bold t :background "orange"))
 900     (((class color) (background light))
 901      (:bold t :background "orange")))
 902   "Face for enclosed elements."
 903   :group 'newsticker-faces)
 904
 905 (defface newsticker-extra-face
 906   '((((class color) (background dark))
 907      (:italic t :foreground "gray50" :height 0.8))
 908     (((class color) (background light))
 909      (:italic t :foreground "gray50" :height 0.8)))
 910   "Face for newsticker dates."
 911   :group 'newsticker-faces)
 912
 913 ;; (defface newsticker-default-face
 914 ;;   '((((class color) (background dark))
 915 ;;      (:inherit default))
 916 ;;     (((class color) (background light))
 917 ;;      (:inherit default)))
 918 ;;   "Face for the description of news items."
 919 ;;   ;;:set 'newsticker--set-customvar
 920 ;;   :group 'newsticker-faces)
 921
 922
 923 ;; customization group ticker
 924 (defgroup newsticker-ticker nil
 925   "Settings for the RSS ticker."
 926   :group 'newsticker)
 927
 928 (defcustom newsticker-display-interval
 929   0.3
 930   "Time interval for displaying news items in the echo area (seconds).
 931 If equal or less than 0 no messages are shown in the echo area.  For
 932 smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
 933 reasonable.  For non-smooth display a value of 10 is a good starting
 934 point."
 935   :type 'number
 936   :set 'newsticker--set-customvar
 937   :group 'newsticker-ticker)
 938
 939 (defcustom newsticker-scroll-smoothly
 940   t
 941   "Decides whether to flash or scroll news items.
 942 If t the news headlines are scrolled (more-or-less) smoothly in the echo
 943 area.  If nil one headline after another is displayed in the echo area.
 944 The variable `newsticker-display-interval' determines how fast this
 945 display moves/changes and whether headlines are shown in the echo area
 946 at all.  If you change `newsticker-scroll-smoothly' you should also change
 947 `newsticker-display-interval'."
 948   :type 'boolean
 949   :group 'newsticker-ticker)
 950
 951 (defcustom newsticker-hide-immortal-items-in-echo-area
 952   t
 953   "Decides whether to show immortal/non-expiring news items in the ticker.
 954 If t the echo area will not show immortal items.  See also
 955 `newsticker-hide-old-items-in-echo-area."
 956   :type 'boolean
 957   :set 'newsticker--set-customvar
 958   :group 'newsticker-ticker)
 959
 960 (defcustom newsticker-hide-old-items-in-echo-area
 961   t
 962   "Decides whether to show only the newest news items in the ticker.
 963 If t the echo area will show only new items, i.e. only items which have
 964 been added between the last two retrievals."
 965   :type 'boolean
 966   :set 'newsticker--set-customvar
 967   :group 'newsticker-ticker)
 968
 969 (defcustom newsticker-hide-obsolete-items-in-echo-area
 970   t
 971   "Decides whether to show obsolete items items in the ticker.
 972 If t the echo area will not show obsolete items.  See also
 973 `newsticker-hide-old-items-in-echo-area."
 974   :type 'boolean
 975   :set 'newsticker--set-customvar
 976   :group 'newsticker-ticker)
 977
 978 (defgroup newsticker-hooks nil
 979   "Settings for newsticker hooks."
 980   :group 'newsticker)
 981
 982 (defcustom newsticker-start-hook
 983   nil
 984   "Hook run when starting newsticker.
 985 This hook is run at the very end of `newsticker-start'."
 986   :options '(newsticker-start-ticker)
 987   :type 'hook
 988   :group 'newsticker-hooks)
 989
 990 (defcustom newsticker-stop-hook
 991   nil
 992   "Hook run when stopping newsticker.
 993 This hook is run at the very end of `newsticker-stop'."
 994   :options nil
 995   :type 'hook
 996   :group 'newsticker-hooks)
 997
 998 (defcustom newsticker-new-item-functions
 999   nil
1000   "List of functions run after a new headline has been retrieved.
1001 Each function is called with the following three arguments:
1002 FEED  the name of the corresponding news feed,
1003 TITLE the title of the headline,
1004 DESC  the decoded description of the headline.
1005
1006 See `newsticker-download-images', and
1007 `newsticker-download-enclosures' for sample functions.
1008
1009 Please note that these functions are called only once for a
1010 headline after it has been retrieved for the first time."
1011   :type 'hook
1012   :options '(newsticker-download-images
1013              newsticker-download-enclosures)
1014   :group 'newsticker-hooks)
1015
1016 (defcustom newsticker-select-item-hook
1017   'newsticker--buffer-make-item-completely-visible
1018   "List of functions run after a headline has been selected.
1019 Each function is called after one of `newsticker-next-item',
1020 `newsticker-next-new-item', `newsticker-previous-item',
1021 `newsticker-previous-new-item' has been called.
1022
1023 The default value 'newsticker--buffer-make-item-completely-visible
1024 assures that the current item is always completely visible."
1025   :type 'hook
1026   :options '(newsticker--buffer-make-item-completely-visible)
1027   :group 'newsticker-hooks)
1028
1029 (defcustom newsticker-select-feed-hook
1030   'newsticker--buffer-make-item-completely-visible
1031   "List of functions run after a feed has been selected.
1032 Each function is called after one of `newsticker-next-feed', and
1033 `newsticker-previous-feed' has been called.
1034
1035 The default value 'newsticker--buffer-make-item-completely-visible
1036 assures that the current feed is completely visible."
1037   :type 'hook
1038   :options '(newsticker--buffer-make-item-completely-visible)
1039   :group 'newsticker-hooks)
1040
1041 (defcustom newsticker-buffer-change-hook
1042   'newsticker-w3m-show-inline-images
1043   "List of functions run after the newsticker buffer has been updated.
1044 Each function is called after `newsticker-buffer-update' has been called.
1045
1046 The default value '`newsticker-w3m-show-inline-images' loads inline
1047 images."
1048   :type 'hook
1049   :group 'newsticker-hooks)
1050
1051 (defcustom newsticker-narrow-hook
1052   'newsticker-w3m-show-inline-images
1053   "List of functions run after narrowing in newsticker buffer has changed.
1054 Each function is called after
1055 `newsticker-toggle-auto-narrow-to-feed' or
1056 `newsticker-toggle-auto-narrow-to-item' has been called.
1057
1058 The default value '`newsticker-w3m-show-inline-images' loads inline
1059 images."
1060   :type 'hook
1061   :group 'newsticker-hooks)
1062
1063 (defgroup newsticker-miscellaneous nil
1064   "Miscellaneous newsticker settings."
1065   :group 'newsticker)
1066
1067 (defcustom newsticker-cache-filename
1068   "~/.newsticker-cache"
1069   "Name of the newsticker cache file."
1070   :type 'string
1071   :group 'newsticker-miscellaneous)
1072
1073 (defcustom newsticker-imagecache-dirname
1074   "~/.newsticker-images"
1075   "Name of the directory where newsticker stores cached images."
1076   :type 'string
1077   :group 'newsticker-miscellaneous)
1078
1079 ;; debugging
1080 (defcustom newsticker-debug
1081   nil
1082   "Enables some features needed for debugging newsticker.el.
1083
1084 If set to t newsticker.el will print lots of debugging messages, and the
1085 buffers *newsticker-wget-<feed>* will not be closed."
1086   :type 'boolean
1087   ;;:set 'newsticker--set-customvar
1088   :group 'newsticker-miscellaneous)
1089
1090 ;; ======================================================================
1091 ;;; Compatibility section, XEmacs, Emacs
1092 ;; ======================================================================
1093 (unless (fboundp 'time-add)
1094   (require 'time-date);;FIXME
1095   (defun time-add (t1 t2)
1096     (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))
1097
1098 (unless (fboundp 'match-string-no-properties)
1099   (defalias 'match-string-no-properties 'match-string))
1100
1101 (unless (fboundp 'replace-regexp-in-string)
1102   (defun replace-regexp-in-string (re rp st)
1103     (save-match-data ;; apparently XEmacs needs save-match-data
1104       (replace-in-string st re rp))))
1105
1106 ;; copied from subr.el
1107 (unless (fboundp 'add-to-invisibility-spec)
1108   (defun add-to-invisibility-spec (arg)
1109     "Add elements to `buffer-invisibility-spec'.
1110 See documentation for `buffer-invisibility-spec' for the kind of elements
1111 that can be added."
1112     (if (eq buffer-invisibility-spec t)
1113         (setq buffer-invisibility-spec (list t)))
1114     (setq buffer-invisibility-spec
1115           (cons arg buffer-invisibility-spec))))
1116
1117 ;; copied from subr.el
1118 (unless (fboundp 'remove-from-invisibility-spec)
1119   (defun remove-from-invisibility-spec (arg)
1120     "Remove elements from `buffer-invisibility-spec'."
1121     (if (consp buffer-invisibility-spec)
1122         (setq buffer-invisibility-spec (delete arg buffer-invisibility-spec)))))
1123
1124 ;; ======================================================================
1125 ;;; Internal variables
1126 ;; ======================================================================
1127 (defvar newsticker--display-timer nil
1128   "Timer for newsticker display.")
1129 (defvar newsticker--retrieval-timer-list nil
1130   "List of timers for news retrieval.
1131 This is an alist, each element consisting of (feed-name . timer)")
1132 (defvar newsticker--item-list nil
1133   "List of newsticker items.")
1134 (defvar newsticker--item-position 0
1135   "Actual position in list of newsticker items.")
1136 (defvar newsticker--prev-message "There was no previous message yet!"
1137   "Last message that the newsticker displayed.")
1138 (defvar newsticker--scrollable-text ""
1139   "The text which is scrolled smoothly in the echo area.")
1140 (defvar newsticker--buffer-uptodate-p nil
1141   "Tells whether the newsticker buffer is up to date.")
1142 (defvar newsticker--latest-update-time (current-time)
1143   "The time at which the latest news arrived.")
1144
1145 (defvar newsticker--cache nil "Cached newsticker data.
1146 This is a list of the form
1147
1148  ((label1
1149    (title description link time age index preformatted-contents
1150     preformatted-title)
1151    ...)
1152   (label2
1153    (title description link time age index preformatted-contents
1154     preformatted-title)
1155    ...)
1156   ...)
1157
1158 where LABEL is a symbol.  TITLE, DESCRIPTION, and LINK are
1159 strings.  TIME is a time value as returned by `current-time'.
1160 AGE is a symbol: 'new, 'old, 'immortal, and 'obsolete denote
1161 ordinary news items, whereas 'feed denotes an item which is not a
1162 headline but describes the feed itself.  INDEX denotes the
1163 original position of the item -- used for restoring the original
1164 order.  PREFORMATTED-CONTENTS and PREFORMATTED-TITLE hold the
1165 formatted contents of the item's description and title.  This
1166 speeds things up if HTML rendering is used, which is rather
1167 slow.")
1168
1169 (defvar newsticker--auto-narrow-to-feed nil
1170   "Automatically narrow to current news feed.
1171 If non-nil only the items of the current news feed are visible.")
1172
1173 (defvar newsticker--auto-narrow-to-item nil
1174   "Automatically narrow to current news item.
1175 If non-nil only the current headline is visible.")
1176
1177 (defconst newsticker--error-headline
1178   "[COULD NOT DOWNLOAD HEADLINES!]"
1179   "Title of error headline which will be inserted if news retrieval fails.")
1180
1181 ;; ======================================================================
1182 ;;; Toolbar
1183 ;; ======================================================================
1184 (defconst newsticker--next-item-image
1185   (if (fboundp 'create-image)
1186       (create-image "/* XPM */
1187 static char * next_xpm[] = {
1188 \"24 24 42 1\",
1189 \"      c None\",
1190 \".     c #000000\",
1191 \"+     c #7EB6DE\",
1192 \"@     c #82BBE2\",
1193 \"#     c #85BEE4\",
1194 \"$     c #88C1E7\",
1195 \"%     c #8AC3E8\",
1196 \"&     c #87C1E6\",
1197 \"*     c #8AC4E9\",
1198 \"=     c #8CC6EA\",
1199 \"-     c #8CC6EB\",
1200 \";     c #88C2E7\",
1201 \">     c #8BC5E9\",
1202 \",     c #8DC7EB\",
1203 \"'     c #87C0E6\",
1204 \")     c #8AC4E8\",
1205 \"!     c #8BC5EA\",
1206 \"~     c #8BC4E9\",
1207 \"{     c #88C1E6\",
1208 \"]     c #89C3E8\",
1209 \"^     c #86BFE5\",
1210 \"/     c #83BBE2\",
1211 \"(     c #82BBE1\",
1212 \"_     c #86C0E5\",
1213 \":     c #87C0E5\",
1214 \"<     c #83BCE2\",
1215 \"[     c #81B9E0\",
1216 \"}     c #81BAE1\",
1217 \"|     c #78B0D9\",
1218 \"1     c #7BB3DB\",
1219 \"2     c #7DB5DD\",
1220 \"3     c #7DB6DD\",
1221 \"4     c #72A9D4\",
1222 \"5     c #75ACD6\",
1223 \"6     c #76AED7\",
1224 \"7     c #77AFD8\",
1225 \"8     c #6BA1CD\",
1226 \"9     c #6EA4CF\",
1227 \"0     c #6FA6D1\",
1228 \"a     c #6298C6\",
1229 \"b     c #659BC8\",
1230 \"c     c #5C91C0\",
1231 \"                        \",
1232 \"                        \",
1233 \"       .                \",
1234 \"       ..               \",
1235 \"       .+.              \",
1236 \"       .@#.             \",
1237 \"       .#$%.            \",
1238 \"       .&*=-.           \",
1239 \"       .;>,,,.          \",
1240 \"       .;>,,,=.         \",
1241 \"       .')!==~;.        \",
1242 \"       .#{]*%;^/.       \",
1243 \"       .(#_':#<.        \",
1244 \"       .+[@</}.         \",
1245 \"       .|1232.          \",
1246 \"       .4567.           \",
1247 \"       .890.            \",
1248 \"       .ab.             \",
1249 \"       .c.              \",
1250 \"       ..               \",
1251 \"       .                \",
1252 \"                        \",
1253 \"                        \",
1254 \"                        \"};
1255 "
1256                  'xpm t)
1257    "Image for the next item button."))
1258
1259 (defconst newsticker--previous-item-image
1260   (if (fboundp 'create-image)
1261       (create-image "/* XPM */
1262 static char * previous_xpm[] = {
1263 \"24 24 39 1\",
1264 \"      c None\",
1265 \".     c #000000\",
1266 \"+     c #7BB3DB\",
1267 \"@     c #83BCE2\",
1268 \"#     c #7FB8DF\",
1269 \"$     c #89C2E7\",
1270 \"%     c #86BFE5\",
1271 \"&     c #83BBE2\",
1272 \"*     c #8CC6EA\",
1273 \"=     c #8BC4E9\",
1274 \"-     c #88C2E7\",
1275 \";     c #85BEE4\",
1276 \">     c #8DC7EB\",
1277 \",     c #89C3E8\",
1278 \"'     c #8AC4E8\",
1279 \")     c #8BC5EA\",
1280 \"!     c #88C1E6\",
1281 \"~     c #8AC4E9\",
1282 \"{     c #8AC3E8\",
1283 \"]     c #86C0E5\",
1284 \"^     c #87C0E6\",
1285 \"/     c #87C0E5\",
1286 \"(     c #82BBE2\",
1287 \"_     c #81BAE1\",
1288 \":     c #7FB7DF\",
1289 \"<     c #7DB6DD\",
1290 \"[     c #7DB5DD\",
1291 \"}     c #7CB4DC\",
1292 \"|     c #79B1DA\",
1293 \"1     c #76ADD7\",
1294 \"2     c #77AFD8\",
1295 \"3     c #73AAD4\",
1296 \"4     c #70A7D1\",
1297 \"5     c #6EA5D0\",
1298 \"6     c #6CA2CE\",
1299 \"7     c #689ECB\",
1300 \"8     c #6399C7\",
1301 \"9     c #6095C4\",
1302 \"0     c #5C90C0\",
1303 \"                        \",
1304 \"                        \",
1305 \"                .       \",
1306 \"               ..       \",
1307 \"              .+.       \",
1308 \"             .@#.       \",
1309 \"            .$%&.       \",
1310 \"           .*=-;.       \",
1311 \"          .>>*,%.       \",
1312 \"         .>>>*,%.       \",
1313 \"        .')**=-;.       \",
1314 \"       .;!,~{-%&.       \",
1315 \"        .;]^/;@#.       \",
1316 \"         .(@&_:+.       \",
1317 \"          .<[}|1.       \",
1318 \"           .2134.       \",
1319 \"            .567.       \",
1320 \"             .89.       \",
1321 \"              .0.       \",
1322 \"               ..       \",
1323 \"                .       \",
1324 \"                        \",
1325 \"                        \",
1326 \"                        \"};
1327 "
1328                  'xpm t)
1329    "Image for the previous item button."))
1330
1331 (defconst newsticker--previous-feed-image
1332   (if (fboundp 'create-image)
1333       (create-image "/* XPM */
1334 static char * prev_feed_xpm[] = {
1335 \"24 24 52 1\",
1336 \"      c None\",
1337 \".     c #000000\",
1338 \"+     c #70A7D2\",
1339 \"@     c #75ADD6\",
1340 \"#     c #71A8D3\",
1341 \"$     c #79B1DA\",
1342 \"%     c #7BB3DB\",
1343 \"&     c #7DB5DD\",
1344 \"*     c #83BBE2\",
1345 \"=     c #7EB6DE\",
1346 \"-     c #78B0D9\",
1347 \";     c #7FB7DE\",
1348 \">     c #88C2E7\",
1349 \",     c #85BEE4\",
1350 \"'     c #80B9E0\",
1351 \")     c #80B8DF\",
1352 \"!     c #8CC6EA\",
1353 \"~     c #89C3E8\",
1354 \"{     c #86BFE5\",
1355 \"]     c #81BAE1\",
1356 \"^     c #7CB4DC\",
1357 \"/     c #7FB8DF\",
1358 \"(     c #8DC7EB\",
1359 \"_     c #7BB3DC\",
1360 \":     c #7EB7DE\",
1361 \"<     c #8BC4E9\",
1362 \"[     c #8AC4E9\",
1363 \"}     c #8AC3E8\",
1364 \"|     c #87C0E6\",
1365 \"1     c #87C0E5\",
1366 \"2     c #83BCE2\",
1367 \"3     c #75ACD6\",
1368 \"4     c #7FB7DF\",
1369 \"5     c #77AED8\",
1370 \"6     c #71A8D2\",
1371 \"7     c #70A7D1\",
1372 \"8     c #76ADD7\",
1373 \"9     c #6CA2CE\",
1374 \"0     c #699FCC\",
1375 \"a     c #73AAD4\",
1376 \"b     c #6BA1CD\",
1377 \"c     c #669CC9\",
1378 \"d     c #6298C5\",
1379 \"e     c #689ECB\",
1380 \"f     c #6499C7\",
1381 \"g     c #6095C3\",
1382 \"h     c #5C91C0\",
1383 \"i     c #5E93C2\",
1384 \"j     c #5B90C0\",
1385 \"k     c #588CBC\",
1386 \"l     c #578CBC\",
1387 \"m     c #5589BA\",
1388 \"                        \",
1389 \"                        \",
1390 \"     ...          .     \",
1391 \"     .+.         ..     \",
1392 \"     .@.        .#.     \",
1393 \"     .$.       .%@.     \",
1394 \"     .&.      .*=-.     \",
1395 \"     .;.     .>,'%.     \",
1396 \"     .).    .!~{]^.     \",
1397 \"     ./.   .(!~{]_.     \",
1398 \"     .:.  .!!<>,'%.     \",
1399 \"     .&. .~[}>{*=-.     \",
1400 \"     .$.  .|1,2/%@.     \",
1401 \"     .3.   .*]4%56.     \",
1402 \"     .7.    .^$8#9.     \",
1403 \"     .0.     .a7bc.     \",
1404 \"     .d.      .efg.     \",
1405 \"     .h.       .ij.     \",
1406 \"     .k.        .l.     \",
1407 \"     .m.         ..     \",
1408 \"     ...          .     \",
1409 \"                        \",
1410 \"                        \",
1411 \"                        \"};
1412 "
1413                  'xpm t)
1414    "Image for the previous feed button."))
1415
1416 (defconst newsticker--next-feed-image
1417   (if (fboundp 'create-image)
1418       (create-image "/* XPM */
1419 static char * next_feed_xpm[] = {
1420 \"24 24 57 1\",
1421 \"      c None\",
1422 \".     c #000000\",
1423 \"+     c #6CA2CE\",
1424 \"@     c #75ADD6\",
1425 \"#     c #71A8D3\",
1426 \"$     c #79B1DA\",
1427 \"%     c #7EB7DE\",
1428 \"&     c #7DB5DD\",
1429 \"*     c #81BAE1\",
1430 \"=     c #85BEE4\",
1431 \"-     c #78B0D9\",
1432 \";     c #7FB7DE\",
1433 \">     c #83BCE3\",
1434 \",     c #87C1E6\",
1435 \"'     c #8AC4E9\",
1436 \")     c #7BB3DB\",
1437 \"!     c #80B8DF\",
1438 \"~     c #88C2E7\",
1439 \"{     c #8BC5E9\",
1440 \"]     c #8DC7EB\",
1441 \"^     c #7CB4DC\",
1442 \"/     c #7FB8DF\",
1443 \"(     c #84BDE3\",
1444 \"_     c #7BB3DC\",
1445 \":     c #83BCE2\",
1446 \"<     c #87C0E6\",
1447 \"[     c #8AC4E8\",
1448 \"}     c #8BC5EA\",
1449 \"|     c #8CC6EA\",
1450 \"1     c #88C1E6\",
1451 \"2     c #89C3E8\",
1452 \"3     c #8AC3E8\",
1453 \"4     c #7EB6DE\",
1454 \"5     c #82BBE1\",
1455 \"6     c #86C0E5\",
1456 \"7     c #87C0E5\",
1457 \"8     c #75ACD6\",
1458 \"9     c #7AB2DA\",
1459 \"0     c #81B9E0\",
1460 \"a     c #82BBE2\",
1461 \"b     c #71A8D2\",
1462 \"c     c #70A7D1\",
1463 \"d     c #74ACD6\",
1464 \"e     c #699FCC\",
1465 \"f     c #6EA5D0\",
1466 \"g     c #72A9D4\",
1467 \"h     c #669CC9\",
1468 \"i     c #6298C5\",
1469 \"j     c #679DCA\",
1470 \"k     c #6BA1CD\",
1471 \"l     c #6095C3\",
1472 \"m     c #5C91C0\",
1473 \"n     c #5F94C2\",
1474 \"o     c #5B90C0\",
1475 \"p     c #588CBC\",
1476 \"q     c #578CBC\",
1477 \"r     c #5589BA\",
1478 \"                        \",
1479 \"                        \",
1480 \"     .          ...     \",
1481 \"     ..         .+.     \",
1482 \"     .@.        .#.     \",
1483 \"     .$%.       .@.     \",
1484 \"     .&*=.      .-.     \",
1485 \"     .;>,'.     .).     \",
1486 \"     .!=~{].    .^.     \",
1487 \"     ./(~{]].   ._.     \",
1488 \"     .%:<[}||.  .).     \",
1489 \"     .&*=12'3~. .-.     \",
1490 \"     .$45=6<7.  .@.     \",
1491 \"     .8940a:.   .b.     \",
1492 \"     .cd-)&.    .+.     \",
1493 \"     .efg8.     .h.     \",
1494 \"     .ijk.      .l.     \",
1495 \"     .mn.       .o.     \",
1496 \"     .p.        .q.     \",
1497 \"     ..         .r.     \",
1498 \"     .          ...     \",
1499 \"                        \",
1500 \"                        \",
1501 \"                        \"};
1502 "
1503                  'xpm t)
1504    "Image for the next feed button."))
1505
1506 (defconst newsticker--mark-read-image
1507   (if (fboundp 'create-image)
1508       (create-image "/* XPM */
1509 static char * mark_read_xpm[] = {
1510 \"24 24 44 1\",
1511 \"      c None\",
1512 \".     c #C20000\",
1513 \"+     c #BE0000\",
1514 \"@     c #C70000\",
1515 \"#     c #CE0000\",
1516 \"$     c #C90000\",
1517 \"%     c #BD0000\",
1518 \"&     c #CB0000\",
1519 \"*     c #D10000\",
1520 \"=     c #D70000\",
1521 \"-     c #D30000\",
1522 \";     c #CD0000\",
1523 \">     c #C60000\",
1524 \",     c #D40000\",
1525 \"'     c #DA0000\",
1526 \")     c #DE0000\",
1527 \"!     c #DB0000\",
1528 \"~     c #D60000\",
1529 \"{     c #D00000\",
1530 \"]     c #DC0000\",
1531 \"^     c #E00000\",
1532 \"/     c #E40000\",
1533 \"(     c #E10000\",
1534 \"_     c #DD0000\",
1535 \":     c #D80000\",
1536 \"<     c #E50000\",
1537 \"[     c #E70000\",
1538 \"}     c #E60000\",
1539 \"|     c #E20000\",
1540 \"1     c #E90000\",
1541 \"2     c #E80000\",
1542 \"3     c #E30000\",
1543 \"4     c #DF0000\",
1544 \"5     c #D90000\",
1545 \"6     c #CC0000\",
1546 \"7     c #C10000\",
1547 \"8     c #C30000\",
1548 \"9     c #BF0000\",
1549 \"0     c #B90000\",
1550 \"a     c #BC0000\",
1551 \"b     c #BB0000\",
1552 \"c     c #B80000\",
1553 \"d     c #B50000\",
1554 \"e     c #B70000\",
1555 \"                        \",
1556 \"                        \",
1557 \"                        \",
1558 \"    .              +    \",
1559 \"   +@#            $.%   \",
1560 \"    &*=          -;>    \",
1561 \"     ,')        !~{     \",
1562 \"      ]^/      (_:      \",
1563 \"       (<[    }|)       \",
1564 \"        <[1  2<|        \",
1565 \"         }222[<         \",
1566 \"          }}}<          \",
1567 \"          333|          \",
1568 \"         _4^4)]         \",
1569 \"        ~:'  5=-        \",
1570 \"       6{-    *#$       \",
1571 \"      7>$      @89      \",
1572 \"     0a+        %bc     \",
1573 \"    ddc          edd    \",
1574 \"   ddd            ddd   \",
1575 \"    d              d    \",
1576 \"                        \",
1577 \"                        \",
1578 \"                        \"};
1579 "
1580                  'xpm t)
1581    "Image for the next feed button."))
1582
1583 (defconst newsticker--mark-immortal-image
1584   (if (fboundp 'create-image)
1585       (create-image "/* XPM */
1586 static char * mark_immortal_xpm[] = {
1587 \"24 24 93 2\",
1588 \"      c None\",
1589 \".     c #171717\",
1590 \"+     c #030303\",
1591 \"@     c #000000\",
1592 \"#     c #181818\",
1593 \"$     c #090909\",
1594 \"%     c #FFC960\",
1595 \"&     c #FFCB61\",
1596 \"*     c #FFCB62\",
1597 \"=     c #FFC961\",
1598 \"-     c #FFC75F\",
1599 \";     c #FFC65E\",
1600 \">     c #FFCA61\",
1601 \",     c #FFCD63\",
1602 \"'     c #FFCF65\",
1603 \")     c #FFD065\",
1604 \"!     c #FFCE64\",
1605 \"~     c #FFC35C\",
1606 \"{     c #FFC45D\",
1607 \"]     c #FFD166\",
1608 \"^     c #FFD267\",
1609 \"/     c #FFD368\",
1610 \"(     c #FFD167\",
1611 \"_     c #FFC05A\",
1612 \":     c #010101\",
1613 \"<     c #040404\",
1614 \"[     c #FFCC62\",
1615 \"}     c #FFD569\",
1616 \"|     c #FFD56A\",
1617 \"1     c #FFC860\",
1618 \"2     c #FFC25B\",
1619 \"3     c #FFBB56\",
1620 \"4     c #020202\",
1621 \"5     c #060606\",
1622 \"6     c #FFC15B\",
1623 \"7     c #FFC85F\",
1624 \"8     c #FFD469\",
1625 \"9     c #FFD66A\",
1626 \"0     c #FFBC57\",
1627 \"a     c #1B1B1B\",
1628 \"b     c #070707\",
1629 \"c     c #FFBA55\",
1630 \"d     c #FFB451\",
1631 \"e     c #FFB954\",
1632 \"f     c #FFB350\",
1633 \"g     c #FFB652\",
1634 \"h     c #FFBE58\",
1635 \"i     c #FFCD64\",
1636 \"j     c #FFD066\",
1637 \"k     c #FFC059\",
1638 \"l     c #FFB14E\",
1639 \"m     c #0B0B0B\",
1640 \"n     c #FFBB55\",
1641 \"o     c #FFC15A\",
1642 \"p     c #FFB552\",
1643 \"q     c #FFAD4B\",
1644 \"r     c #080808\",
1645 \"s     c #FFAF4C\",
1646 \"t     c #FFB853\",
1647 \"u     c #FFA948\",
1648 \"v     c #050505\",
1649 \"w     c #FFB04E\",
1650 \"x     c #FFB753\",
1651 \"y     c #FFBC56\",
1652 \"z     c #FFC55D\",
1653 \"A     c #FFC55E\",
1654 \"B     c #FFC45C\",
1655 \"C     c #FFBD57\",
1656 \"D     c #FFB854\",
1657 \"E     c #FFB34F\",
1658 \"F     c #FFAB4A\",
1659 \"G     c #FFA545\",
1660 \"H     c #FFAA49\",
1661 \"I     c #FFB04D\",
1662 \"J     c #FFB551\",
1663 \"K     c #FFBF58\",
1664 \"L     c #FFB24F\",
1665 \"M     c #FFAC4A\",
1666 \"N     c #FFA646\",
1667 \"O     c #FFA344\",
1668 \"P     c #FFA848\",
1669 \"Q     c #FFB14F\",
1670 \"R     c #FFAF4D\",
1671 \"S     c #FFA546\",
1672 \"T     c #FFA243\",
1673 \"U     c #FFA445\",
1674 \"V     c #FFAE4C\",
1675 \"W     c #FFA444\",
1676 \"X     c #FFA142\",
1677 \"Y     c #FF9F41\",
1678 \"Z     c #0A0A0A\",
1679 \"`     c #FF9E40\",
1680 \" .    c #FF9F40\",
1681 \"                                                \",
1682 \"                                                \",
1683 \"                                                \",
1684 \"                  . + @ @ + #                   \",
1685 \"              $ @ % & * * = - + +               \",
1686 \"            @ ; > , ' ) ' ! * - ~ @             \",
1687 \"          @ { > ! ] ^ / / ( ' * ; _ :           \",
1688 \"        < _ ; [ ) / } | } / ] , 1 2 3 4         \",
1689 \"        5 6 7 , ] 8 9 9 9 } ^ ! = ~ 0 a         \",
1690 \"      b c 6 - , ] 8 9 9 9 } ^ ! % ~ 0 d 5       \",
1691 \"      : e _ ; * ) / 8 } } / ] , 1 2 3 f 5       \",
1692 \"      : g h { = i j ^ / ^ ] ! * ; k e l m       \",
1693 \"      : f n o ; > , ' ) ' ! * - 2 0 p q r       \",
1694 \"      : s g 0 6 ; % > * * = - ~ h t l u r       \",
1695 \"      v u w x y k ~ z A z B o C D E F G b       \",
1696 \"        5 H I J e 0 h K h C c x L M N .         \",
1697 \"        4 O P q Q d g x g J L R H S T <         \",
1698 \"          @ T U P F q V q M H N W X +           \",
1699 \"            @ Y T O W G G W O X Y @             \",
1700 \"              4 Z ` Y Y Y  .` 4 4               \",
1701 \"                  5 : : @ @ Z                   \",
1702 \"                                                \",
1703 \"                                                \",
1704 \"                                                \"};
1705 "
1706                  'xpm t)
1707    "Image for the next feed button."))
1708
1709
1710 (defconst newsticker--narrow-image
1711   (if (fboundp 'create-image)
1712       (create-image "/* XPM */
1713 static char * narrow_xpm[] = {
1714 \"24 24 48 1\",
1715 \"      c None\",
1716 \".     c #000000\",
1717 \"+     c #969696\",
1718 \"@     c #9E9E9E\",
1719 \"#     c #A4A4A4\",
1720 \"$     c #AAAAAA\",
1721 \"%     c #AEAEAE\",
1722 \"&     c #B1B1B1\",
1723 \"*     c #B3B3B3\",
1724 \"=     c #B4B4B4\",
1725 \"-     c #B2B2B2\",
1726 \";     c #AFAFAF\",
1727 \">     c #ABABAB\",
1728 \",     c #A6A6A6\",
1729 \"'     c #A0A0A0\",
1730 \")     c #989898\",
1731 \"!     c #909090\",
1732 \"~     c #73AAD4\",
1733 \"{     c #7AB2DA\",
1734 \"]     c #7FB8DF\",
1735 \"^     c #84BDE3\",
1736 \"/     c #88C2E7\",
1737 \"(     c #8BC5E9\",
1738 \"_     c #8DC7EB\",
1739 \":     c #8CC6EA\",
1740 \"<     c #89C3E8\",
1741 \"[     c #86BFE5\",
1742 \"}     c #81BAE1\",
1743 \"|     c #7BB3DC\",
1744 \"1     c #75ACD6\",
1745 \"2     c #6DA4CF\",
1746 \"3     c #979797\",
1747 \"4     c #A3A3A3\",
1748 \"5     c #A8A8A8\",
1749 \"6     c #ADADAD\",
1750 \"7     c #ACACAC\",
1751 \"8     c #A9A9A9\",
1752 \"9     c #A5A5A5\",
1753 \"0     c #9A9A9A\",
1754 \"a     c #929292\",
1755 \"b     c #8C8C8C\",
1756 \"c     c #808080\",
1757 \"d     c #818181\",
1758 \"e     c #838383\",
1759 \"f     c #848484\",
1760 \"g     c #858585\",
1761 \"h     c #868686\",
1762 \"i     c #828282\",
1763 \"                        \",
1764 \"                        \",
1765 \"                        \",
1766 \"   ..................   \",
1767 \"   .+@#$%&*=*-;>,')!.   \",
1768 \"   ..................   \",
1769 \"                        \",
1770 \"                        \",
1771 \"   ..................   \",
1772 \"   .~{]^/(___:<[}|12.   \",
1773 \"   ..................   \",
1774 \"                        \",
1775 \"                        \",
1776 \"   ..................   \",
1777 \"   .!3@45>666789'0ab.   \",
1778 \"   ..................   \",
1779 \"                        \",
1780 \"                        \",
1781 \"   ..................   \",
1782 \"   .cccdefghhgficccc.   \",
1783 \"   ..................   \",
1784 \"                        \",
1785 \"                        \",
1786 \"                        \"};
1787 "
1788                  'xpm t)
1789    "Image for the next feed button."))
1790
1791 (defconst newsticker--get-all-image
1792   (if (fboundp 'create-image)
1793       (create-image "/* XPM */
1794 static char * get_all_xpm[] = {
1795 \"24 24 70 1\",
1796 \"      c None\",
1797 \".     c #000000\",
1798 \"+     c #F3DA00\",
1799 \"@     c #F5DF00\",
1800 \"#     c #F7E300\",
1801 \"$     c #F9E700\",
1802 \"%     c #FAEA00\",
1803 \"&     c #FBEC00\",
1804 \"*     c #FBED00\",
1805 \"=     c #FCEE00\",
1806 \"-     c #FAEB00\",
1807 \";     c #F9E800\",
1808 \">     c #F8E500\",
1809 \",     c #F6E000\",
1810 \"'     c #F4DB00\",
1811 \")     c #F1D500\",
1812 \"!     c #EFD000\",
1813 \"~     c #B7CA00\",
1814 \"{     c #BFD100\",
1815 \"]     c #C5D700\",
1816 \"^     c #CBDB00\",
1817 \"/     c #CFDF00\",
1818 \"(     c #D2E200\",
1819 \"_     c #D4E400\",
1820 \":     c #D3E300\",
1821 \"<     c #D0E000\",
1822 \"[     c #CCDD00\",
1823 \"}     c #C7D800\",
1824 \"|     c #C1D300\",
1825 \"1     c #BACC00\",
1826 \"2     c #B1C500\",
1827 \"3     c #A8BC00\",
1828 \"4     c #20A900\",
1829 \"5     c #22AF00\",
1830 \"6     c #24B500\",
1831 \"7     c #26B900\",
1832 \"8     c #27BC00\",
1833 \"9     c #27BE00\",
1834 \"0     c #28BF00\",
1835 \"a     c #27BD00\",
1836 \"b     c #26BA00\",
1837 \"c     c #25B600\",
1838 \"d     c #23B100\",
1839 \"e     c #21AB00\",
1840 \"f     c #1FA400\",
1841 \"g     c #1C9B00\",
1842 \"h     c #21AA00\",
1843 \"i     c #24B300\",
1844 \"j     c #25B800\",
1845 \"k     c #25B700\",
1846 \"l     c #24B400\",
1847 \"m     c #23B000\",
1848 \"n     c #1FA500\",
1849 \"o     c #1D9E00\",
1850 \"p     c #20A800\",
1851 \"q     c #21AC00\",
1852 \"r     c #23B200\",
1853 \"s     c #22AD00\",
1854 \"t     c #1D9F00\",
1855 \"u     c #20A700\",
1856 \"v     c #1EA100\",
1857 \"w     c #1C9C00\",
1858 \"x     c #1DA000\",
1859 \"y     c #1B9800\",
1860 \"z     c #1A9600\",
1861 \"A     c #1A9700\",
1862 \"B     c #1A9500\",
1863 \"C     c #199200\",
1864 \"D     c #189100\",
1865 \"E     c #178C00\",
1866 \"                        \",
1867 \"                        \",
1868 \"                        \",
1869 \"                        \",
1870 \"   ...................  \",
1871 \"   .+@#$%&*=*&-;>,')!.  \",
1872 \"   ...................  \",
1873 \"                        \",
1874 \"   ...................  \",
1875 \"   .~{]^/(___:<[}|123.  \",
1876 \"   ...................  \",
1877 \"                        \",
1878 \"   ...................  \",
1879 \"    .45678909abcdefg.   \",
1880 \"     .h5icj7jklmeno.    \",
1881 \"      .pq5drrmshft.     \",
1882 \"       .fu4h4pnvw.      \",
1883 \"        .oxvxtwy.       \",
1884 \"         .zAAzB.        \",
1885 \"          .CCD.         \",
1886 \"           .E.          \",
1887 \"            .           \",
1888 \"                        \",
1889 \"                        \"};
1890 "
1891                  'xpm t)
1892    "Image for the next feed button."))
1893
1894
1895 (defconst newsticker--update-image
1896   (if (fboundp 'create-image)
1897       (create-image "/* XPM */
1898 static char * update_xpm[] = {
1899 \"24 24 37 1\",
1900 \"      c None\",
1901 \".     c #076D00\",
1902 \"+     c #0A8600\",
1903 \"@     c #0A8800\",
1904 \"#     c #098400\",
1905 \"$     c #087200\",
1906 \"%     c #087900\",
1907 \"&     c #098500\",
1908 \"*     c #098100\",
1909 \"=     c #087600\",
1910 \"-     c #097E00\",
1911 \";     c #097F00\",
1912 \">     c #0A8700\",
1913 \",     c #0A8C00\",
1914 \"'     c #097C00\",
1915 \")     c #098300\",
1916 \"!     c #0A8900\",
1917 \"~     c #0A8E00\",
1918 \"{     c #0B9200\",
1919 \"]     c #087700\",
1920 \"^     c #076E00\",
1921 \"/     c #076C00\",
1922 \"(     c #076B00\",
1923 \"_     c #076A00\",
1924 \":     c #076900\",
1925 \"<     c #076800\",
1926 \"[     c #066700\",
1927 \"}     c #066500\",
1928 \"|     c #066400\",
1929 \"1     c #066300\",
1930 \"2     c #066600\",
1931 \"3     c #066200\",
1932 \"4     c #076700\",
1933 \"5     c #065E00\",
1934 \"6     c #066100\",
1935 \"7     c #065F00\",
1936 \"8     c #066000\",
1937 \"                        \",
1938 \"                        \",
1939 \"                        \",
1940 \"    .    +@@@+#         \",
1941 \"    $% &@      +*       \",
1942 \"    =-#          ;      \",
1943 \"    %*>,          '     \",
1944 \"    ')!~{          =    \",
1945 \"                   ]$   \",
1946 \"   ^                ^   \",
1947 \"   .                .   \",
1948 \"   /                (   \",
1949 \"   _                :   \",
1950 \"   <                [   \",
1951 \"   }                |   \",
1952 \"   [[                   \",
1953 \"    1          $.:23    \",
1954 \"     3          4}35    \",
1955 \"      6          655    \",
1956 \"       76      85 55    \",
1957 \"        5555555    5    \",
1958 \"                        \",
1959 \"                        \",
1960 \"                        \"};
1961 "
1962                  'xpm t)
1963    "Image for the update button."))
1964
1965 (defconst newsticker--browse-image
1966   (if (fboundp 'create-image)
1967       (create-image "/* XPM */
1968 static char * visit_xpm[] = {
1969 \"24 24 39 1\",
1970 \"      c None\",
1971 \".     c #000000\",
1972 \"+     c #FFFFFF\",
1973 \"@     c #00E63D\",
1974 \"#     c #00E83E\",
1975 \"$     c #00E73D\",
1976 \"%     c #00E93E\",
1977 \"&     c #00E63C\",
1978 \"*     c #00E53C\",
1979 \"=     c #00E23B\",
1980 \"-     c #00E33B\",
1981 \";     c #00E83D\",
1982 \">     c #00E13A\",
1983 \",     c #00DD38\",
1984 \"'     c #00DE38\",
1985 \")     c #00E23A\",
1986 \"!     c #00E43C\",
1987 \"~     c #00DF39\",
1988 \"{     c #00DB37\",
1989 \"]     c #00D634\",
1990 \"^     c #00D734\",
1991 \"/     c #00E039\",
1992 \"(     c #00DC37\",
1993 \"_     c #00D835\",
1994 \":     c #00D332\",
1995 \"<     c #00CD2F\",
1996 \"[     c #00DB36\",
1997 \"}     c #00D433\",
1998 \"|     c #00CF30\",
1999 \"1     c #00DA36\",
2000 \"2     c #00D936\",
2001 \"3     c #00D533\",
2002 \"4     c #00D131\",
2003 \"5     c #00CE2F\",
2004 \"6     c #00CC2F\",
2005 \"7     c #00CA2D\",
2006 \"8     c #00C62B\",
2007 \"9     c #00C52A\",
2008 \"0     c #00BE27\",
2009 \"                        \",
2010 \"                        \",
2011 \"            .           \",
2012 \"           .+.          \",
2013 \"          .+++.         \",
2014 \"         .++.++.        \",
2015 \"        .++.@.++.       \",
2016 \"       .++.##$.++.      \",
2017 \"      .++.%%%#&.++.     \",
2018 \"     .++.$%%%#*=.++.    \",
2019 \"    .++.-@;##$*>,.++.   \",
2020 \"   .++.')!&@@*=~{].++.  \",
2021 \"  .++.^{~>---)/(_:<.++. \",
2022 \"   .++.^[,~/~'(_}|.++.  \",
2023 \"    .++.]_1[12^:|.++.   \",
2024 \"     .++.:}33:45.++.    \",
2025 \"      .++.<5567.++.     \",
2026 \"       .++.889.++.      \",
2027 \"        .++.0.++.       \",
2028 \"         .++.++.        \",
2029 \"          .+++.         \",
2030 \"           .+.          \",
2031 \"            .           \",
2032 \"                        \"};
2033 "
2034                  'xpm t)
2035    "Image for the browse button."))
2036
2037
2038 (defvar newsticker-tool-bar-map
2039   (if (featurep 'xemacs)
2040       nil
2041     (let ((tool-bar-map (make-sparse-keymap)))
2042       (define-key tool-bar-map [newsticker-sep-1]
2043         (list 'menu-item "--double-line"))
2044       (define-key tool-bar-map [newsticker-browse-url]
2045         (list 'menu-item "newsticker-browse-url" 'newsticker-browse-url
2046               :visible t
2047               :help "Browse URL for item at point"
2048               :image newsticker--browse-image))
2049       (define-key tool-bar-map [newsticker-buffer-force-update]
2050         (list 'menu-item "newsticker-buffer-force-update"
2051               'newsticker-buffer-force-update
2052               :visible t
2053               :help "Update newsticker buffer"
2054               :image newsticker--update-image
2055               :enable '(not newsticker--buffer-uptodate-p)))
2056       (define-key tool-bar-map [newsticker-get-all-news]
2057         (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
2058               :visible t
2059               :help "Get news for all feeds"
2060               :image newsticker--get-all-image))
2061       (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
2062         (list 'menu-item "newsticker-mark-item-at-point-as-read"
2063               'newsticker-mark-item-at-point-as-read
2064               :visible t
2065               :image newsticker--mark-read-image
2066               :help "Mark current item as read"
2067               :enable '(newsticker-item-not-old-p)))
2068       (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
2069         (list 'menu-item "newsticker-mark-item-at-point-as-immortal"
2070               'newsticker-mark-item-at-point-as-immortal
2071               :visible t
2072               :image newsticker--mark-immortal-image
2073               :help "Mark current item as immortal"
2074               :enable '(newsticker-item-not-immortal-p)))
2075       (define-key tool-bar-map [newsticker-toggle-auto-narrow-to-feed]
2076         (list 'menu-item "newsticker-toggle-auto-narrow-to-feed"
2077               'newsticker-toggle-auto-narrow-to-feed
2078               :visible t
2079               :help "Toggle visibility of other feeds"
2080               :image newsticker--narrow-image))
2081       (define-key tool-bar-map [newsticker-next-feed]
2082         (list 'menu-item "newsticker-next-feed" 'newsticker-next-feed
2083               :visible t
2084               :help "Go to next feed"
2085               :image newsticker--next-feed-image
2086               :enable '(newsticker-next-feed-available-p)))
2087       (define-key tool-bar-map [newsticker-next-item]
2088         (list 'menu-item "newsticker-next-item" 'newsticker-next-item
2089               :visible t
2090               :help "Go to next item"
2091               :image newsticker--next-item-image
2092               :enable '(newsticker-next-item-available-p)))
2093       (define-key tool-bar-map [newsticker-previous-item]
2094         (list 'menu-item "newsticker-previous-item" 'newsticker-previous-item
2095               :visible t
2096               :help "Go to previous item"
2097               :image newsticker--previous-item-image
2098               :enable '(newsticker-previous-item-available-p)))
2099       (define-key tool-bar-map [newsticker-previous-feed]
2100         (list 'menu-item "newsticker-previous-feed" 'newsticker-previous-feed
2101               :visible t
2102               :help "Go to previous feed"
2103               :image newsticker--previous-feed-image
2104               :enable '(newsticker-previous-feed-available-p)))
2105       ;; standard icons / actions
2106       (tool-bar-add-item "close"
2107                          'newsticker-close-buffer
2108                          'newsticker-close-buffer
2109                          :help "Close newsticker buffer")
2110       (tool-bar-add-item "preferences"
2111                          'newsticker-customize
2112                          'newsticker-customize
2113                          :help "Customize newsticker")
2114       tool-bar-map)))
2115
2116 ;; ======================================================================
2117 ;;; Newsticker mode
2118 ;; ======================================================================
2119
2120 (define-derived-mode newsticker-mode fundamental-mode
2121   "NewsTicker"
2122   "Viewing RSS news feeds in Emacs."
2123   (set (make-local-variable 'tool-bar-map) newsticker-tool-bar-map)
2124   (set (make-local-variable 'imenu-sort-function) nil)
2125   (set (make-local-variable 'scroll-conservatively) 999)
2126   (setq imenu-create-index-function 'newsticker--imenu-create-index)
2127   (setq imenu-default-goto-function 'newsticker--imenu-goto)
2128   (setq buffer-read-only t)
2129   (auto-fill-mode -1) ;; turn auto-fill off!
2130   (font-lock-mode -1) ;; turn off font-lock!!
2131   (set (make-local-variable 'font-lock-defaults) nil)
2132   (set (make-local-variable 'line-move-ignore-invisible) t)
2133   (setq mode-line-format
2134         (list "-"
2135               'mode-line-mule-info
2136               'mode-line-modified
2137               'mode-line-frame-identification
2138               " Newsticker ("
2139               '(newsticker--buffer-uptodate-p
2140                 "up to date"
2141                 "NEED UPDATE")
2142               ") -- "
2143               '(:eval (newsticker--buffer-get-feed-title-at-point))
2144               ": "
2145               '(:eval (newsticker--buffer-get-item-title-at-point))
2146               " %-"))
2147   (unless newsticker-show-all-rss-elements
2148     (add-to-invisibility-spec 'extra))
2149   (newsticker--buffer-set-uptodate nil))
2150
2151 ;; refine its mode-map
2152 (define-key newsticker-mode-map "sO" 'newsticker-show-old-items)
2153 (define-key newsticker-mode-map "hO" 'newsticker-hide-old-items)
2154 (define-key newsticker-mode-map "sa" 'newsticker-show-all-desc)
2155 (define-key newsticker-mode-map "ha" 'newsticker-hide-all-desc)
2156 (define-key newsticker-mode-map "sf" 'newsticker-show-feed-desc)
2157 (define-key newsticker-mode-map "hf" 'newsticker-hide-feed-desc)
2158 (define-key newsticker-mode-map "so" 'newsticker-show-old-item-desc)
2159 (define-key newsticker-mode-map "ho" 'newsticker-hide-old-item-desc)
2160 (define-key newsticker-mode-map "sn" 'newsticker-show-new-item-desc)
2161 (define-key newsticker-mode-map "hn" 'newsticker-hide-new-item-desc)
2162 (define-key newsticker-mode-map "se" 'newsticker-show-entry)
2163 (define-key newsticker-mode-map "he" 'newsticker-hide-entry)
2164 (define-key newsticker-mode-map "sx" 'newsticker-show-extra)
2165 (define-key newsticker-mode-map "hx" 'newsticker-hide-extra)
2166
2167 (define-key newsticker-mode-map " "  'scroll-up)
2168 (define-key newsticker-mode-map "q"  'newsticker-close-buffer)
2169 (define-key newsticker-mode-map "p"  'newsticker-previous-item)
2170 (define-key newsticker-mode-map "P"  'newsticker-previous-new-item)
2171 (define-key newsticker-mode-map "F"  'newsticker-previous-feed)
2172 (define-key newsticker-mode-map "\t" 'newsticker-next-item)
2173 (define-key newsticker-mode-map "n"  'newsticker-next-item)
2174 (define-key newsticker-mode-map "N"  'newsticker-next-new-item)
2175 (define-key newsticker-mode-map "f"  'newsticker-next-feed)
2176 (define-key newsticker-mode-map "M"  'newsticker-mark-all-items-as-read)
2177 (define-key newsticker-mode-map "m"
2178   'newsticker-mark-all-items-at-point-as-read)
2179 (define-key newsticker-mode-map "o"  'newsticker-mark-item-at-point-as-read)
2180 (define-key newsticker-mode-map "G"  'newsticker-get-all-news)
2181 (define-key newsticker-mode-map "g"  'newsticker-get-news-at-point)
2182 (define-key newsticker-mode-map "u"  'newsticker-buffer-update)
2183 (define-key newsticker-mode-map "U"  'newsticker-buffer-force-update)
2184 (define-key newsticker-mode-map "a"  'newsticker-add-url)
2185
2186 (define-key newsticker-mode-map "i"
2187   'newsticker-mark-item-at-point-as-immortal)
2188
2189 (define-key newsticker-mode-map "xf" 'newsticker-toggle-auto-narrow-to-feed)
2190 (define-key newsticker-mode-map "xi" 'newsticker-toggle-auto-narrow-to-item)
2191
2192 ;; maps for the clickable portions
2193 (defvar newsticker--url-keymap (make-sparse-keymap)
2194   "Key map for click-able headings in the newsticker buffer.")
2195 (define-key newsticker--url-keymap [mouse-2]
2196   'newsticker-mouse-browse-url)
2197 (define-key newsticker--url-keymap "\n"
2198   'newsticker-browse-url)
2199 (define-key newsticker--url-keymap "\C-m"
2200   'newsticker-browse-url)
2201 (define-key newsticker--url-keymap [(control return)]
2202   'newsticker-handle-url)
2203
2204 ;; newsticker menu
2205 (defvar newsticker-menu (make-sparse-keymap "Newsticker"))
2206
2207 (define-key newsticker-menu [newsticker-browse-url]
2208   '("Browse URL for item at point" . newsticker-browse-url))
2209 (define-key newsticker-menu [newsticker-separator-1]
2210   '("--"))
2211 (define-key newsticker-menu [newsticker-buffer-update]
2212   '("Update buffer" . newsticker-buffer-update))
2213 (define-key newsticker-menu [newsticker-separator-2]
2214   '("--"))
2215 (define-key newsticker-menu [newsticker-get-all-news]
2216   '("Get news from all feeds" . newsticker-get-all-news))
2217 (define-key newsticker-menu [newsticker-get-news-at-point]
2218   '("Get news from feed at point" . newsticker-get-news-at-point))
2219 (define-key newsticker-menu [newsticker-separator-3]
2220   '("--"))
2221 (define-key newsticker-menu [newsticker-mark-all-items-as-read]
2222   '("Mark all items as read" . newsticker-mark-all-items-as-read))
2223 (define-key newsticker-menu [newsticker-mark-all-items-at-point-as-read]
2224   '("Mark all items in feed at point as read" .
2225     newsticker-mark-all-items-at-point-as-read))
2226 (define-key newsticker-menu [newsticker-mark-item-at-point-as-read]
2227   '("Mark item at point as read" .
2228     newsticker-mark-item-at-point-as-read))
2229 (define-key newsticker-menu [newsticker-mark-item-at-point-as-immortal]
2230   '("Toggle immortality for item at point" .
2231     newsticker-mark-item-at-point-as-immortal))
2232 (define-key newsticker-menu [newsticker-separator-4]
2233   '("--"))
2234 (define-key newsticker-menu [newsticker-hide-old-items]
2235   '("Hide old items" . newsticker-hide-old-items))
2236 (define-key newsticker-menu [newsticker-show-old-items]
2237   '("Show old items" . newsticker-show-old-items))
2238 (define-key newsticker-menu [newsticker-next-item]
2239   '("Go to next item" . newsticker-next-item))
2240 (define-key newsticker-menu [newsticker-previous-item]
2241   '("Go to previous item" . newsticker-previous-item))
2242
2243 ;; bind menu to mouse
2244 (define-key newsticker-mode-map [down-mouse-3] newsticker-menu)
2245 ;; Put menu in menu-bar
2246 (define-key newsticker-mode-map [menu-bar Newsticker]
2247   (cons "Newsticker" newsticker-menu))
2248
2249
2250 ;; ======================================================================
2251 ;;; shortcuts
2252 ;; ======================================================================
2253 (defsubst newsticker--title (item)
2254   "Return title of ITEM."
2255   (nth 0 item))
2256 (defsubst newsticker--desc (item)
2257   "Return description of ITEM."
2258   (nth 1 item))
2259 (defsubst newsticker--link (item)
2260   "Return link of ITEM."
2261   (nth 2 item))
2262 (defsubst newsticker--time (item)
2263   "Return time of ITEM."
2264   (nth 3 item))
2265 (defsubst newsticker--age (item)
2266   "Return age of ITEM."
2267   (nth 4 item))
2268 (defsubst newsticker--pos (item)
2269   "Return position/index of ITEM."
2270   (nth 5 item))
2271 (defsubst newsticker--preformatted-contents (item)
2272   "Return pre-formatted text of ITEM."
2273   (nth 6 item))
2274 (defsubst newsticker--preformatted-title (item)
2275   "Return pre-formatted title of ITEM."
2276   (nth 7 item))
2277 (defsubst newsticker--extra (item)
2278   "Return extra attributes of ITEM."
2279   (nth 8 item))
2280 (defsubst newsticker--guid (item)
2281   "Return guid of ITEM."
2282   (let ((guid (assoc 'guid (newsticker--extra item))))
2283     (if (stringp guid)
2284         guid
2285       (car (xml-node-children guid)))))
2286 (defsubst newsticker--enclosure (item)
2287   "Return enclosure element of ITEM in the form \(...FIXME...\)or nil."
2288   (let ((enclosure (assoc 'enclosure (newsticker--extra item))))
2289     (if enclosure
2290         (xml-node-attributes enclosure))))
2291
2292 ;; ======================================================================
2293 ;;; User fun
2294 ;; ======================================================================
2295
2296 ;;;###autoload
2297 (defun newsticker-start (&optional do-not-complain-if-running)
2298   "Start the newsticker.
2299 Start the timers for display and retrieval.  If the newsticker, i.e. the
2300 timers, are running already a warning message is printed unless
2301 DO-NOT-COMPLAIN-IF-RUNNING is not nil.
2302 Run `newsticker-start-hook' if newsticker was not running already."
2303   (interactive)
2304   (let ((running (newsticker-running-p)))
2305     ;; read old cache if it exists and newsticker is not running
2306     (unless running
2307       (let* ((coding-system-for-read 'utf-8)
2308              (buf (find-file-noselect newsticker-cache-filename)))
2309         (when buf
2310           (set-buffer buf)
2311           (goto-char (point-min))
2312           (condition-case nil
2313               (setq newsticker--cache (read buf))
2314             (error
2315              (message "Error while reading newsticker cache file!")
2316              (setq newsticker--cache nil))))))
2317     ;; start retrieval timers -- for sake of simplicity we will start
2318     ;; one timer for each feed
2319     (mapc (lambda (item)
2320             (let* ((feed-name (car item))
2321                    (start-time (nth 2 item))
2322                    (interval (or (nth 3 item)
2323                                  newsticker-retrieval-interval))
2324                    (timer (assoc (car item)
2325                                  newsticker--retrieval-timer-list)))
2326               (if timer
2327                   (or do-not-complain-if-running
2328                       (message "Timer for %s is running already!"
2329                                feed-name))
2330                 (newsticker--debug-msg "Starting timer for %s: %s, %d"
2331                                        feed-name start-time interval)
2332                 ;; do not repeat retrieval if interval not positive
2333                 (if (<= interval 0)
2334                     (setq interval nil))
2335                 ;; Suddenly XEmacs doesn't like start-time 0
2336                 (if (or (not start-time)
2337                         (and (numberp start-time) (= start-time 0)))
2338                     (setq start-time 1))
2339                 (message "start-time %s" start-time)
2340                 (setq timer (run-at-time start-time interval
2341                                          'newsticker-get-news feed-name))
2342                 (if interval
2343                     (add-to-list 'newsticker--retrieval-timer-list
2344                                  (cons feed-name timer))))))
2345           (append newsticker-url-list-defaults newsticker-url-list))
2346     (unless running
2347       (run-hooks 'newsticker-start-hook)
2348       (message "Newsticker started!"))))
2349
2350 (defun newsticker-start-ticker ()
2351   "Start newsticker's ticker (but not the news retrieval.
2352 Start display timer for the actual ticker if wanted and not
2353 running already."
2354   (interactive)
2355   (if (and (> newsticker-display-interval 0)
2356            (not newsticker--display-timer))
2357       (setq newsticker--display-timer
2358             (run-at-time newsticker-display-interval
2359                          newsticker-display-interval
2360                          'newsticker--display-tick))))
2361
2362 (defun newsticker-stop ()
2363   "Stop the newsticker and the newsticker-ticker.
2364 Cancel the timers for display and retrieval.  Run `newsticker-stop-hook'
2365 if newsticker has been running."
2366   (interactive)
2367   (newsticker--cache-update t)
2368   (newsticker-stop-ticker)
2369   (when (newsticker-running-p)
2370     (mapc (lambda (name-and-timer)
2371             (cancel-timer (cdr name-and-timer)))
2372           newsticker--retrieval-timer-list)
2373     (setq newsticker--retrieval-timer-list nil)
2374     (run-hooks 'newsticker-stop-hook)
2375     (message "Newsticker stopped!")))
2376
2377 (defun newsticker-stop-ticker ()
2378   "Stop newsticker's ticker (but not the news retrieval)."
2379   (interactive)
2380   (when newsticker--display-timer
2381     (cancel-timer newsticker--display-timer)
2382     (setq newsticker--display-timer nil)))
2383
2384 ;; the functions we need for retrieval and display
2385 ;;;###autoload
2386 (defun newsticker-show-news ()
2387   "Switch to newsticker buffer.  You may want to bind this to a key."
2388   (interactive)
2389   (newsticker-start t) ;; will start only if not running
2390   (newsticker-buffer-update)
2391   (switch-to-buffer "*newsticker*"))
2392
2393 (defun newsticker-buffer-force-update ()
2394   "Update the newsticker buffer, even if not necessary."
2395   (interactive)
2396   (newsticker-buffer-update t))
2397
2398 (defun newsticker-buffer-update (&optional force)
2399   "Update the *newsticker* buffer.
2400 Unless FORCE is t this is donly only if necessary, i.e. when the
2401 *newsticker* buffer is not up-to-date."
2402   (interactive)
2403   ;; bring cache data into proper order....
2404   (newsticker--cache-sort)
2405   ;; fill buffer
2406   (save-excursion
2407     (let ((buf (get-buffer "*newsticker*")))
2408       (if buf
2409           (switch-to-buffer buf)
2410         (switch-to-buffer (get-buffer-create "*newsticker*"))
2411         (newsticker--buffer-set-uptodate nil)))
2412    (when (or force
2413              (not newsticker--buffer-uptodate-p))
2414      (message "Preparing newsticker buffer...")
2415      (setq buffer-undo-list t)
2416      (let ((inhibit-read-only t))
2417        (set-buffer-modified-p nil)
2418        (erase-buffer)
2419        (newsticker-mode)
2420        ;; Emacs 21.3.50 does not care if we turn off auto-fill in the
2421        ;; definition of newsticker-mode, so we do it here (again)
2422        (auto-fill-mode -1)
2423
2424        (set-buffer-file-coding-system 'utf-8)
2425
2426        (if newsticker-use-full-width
2427            (set (make-local-variable 'fill-column) (1- (window-width))))
2428        (newsticker--buffer-insert-all-items)
2429
2430        ;; FIXME: needed for methods buffer in ecb
2431        ;; (set-visited-file-name "*newsticker*")
2432
2433        (set-buffer-modified-p nil)
2434         (newsticker-hide-all-desc)
2435         (if newsticker-hide-old-items-in-newsticker-buffer
2436             (newsticker-hide-old-items))
2437         (if newsticker-show-descriptions-of-new-items
2438             (newsticker-show-new-item-desc))
2439        )
2440      (message ""))
2441    (newsticker--buffer-set-uptodate t)
2442    (run-hooks 'newsticker-buffer-change-hook)))
2443
2444 (defun newsticker-get-all-news ()
2445   "Launch retrieval of news from all configured newsticker sites.
2446 This does NOT start the retrieval timers."
2447   (interactive)
2448   ;; launch retrieval of news
2449   (mapc (lambda (item)
2450           (newsticker-get-news (car item)))
2451         (append newsticker-url-list-defaults newsticker-url-list)))
2452
2453 (defun newsticker-get-news-at-point ()
2454   "Launch retrieval of news for the feed point is in.
2455 This does NOT start the retrieval timers."
2456   (interactive)
2457   ;; launch retrieval of news
2458   (let ((feed (get-text-property (point) 'feed)))
2459       (when feed
2460         (newsticker--debug-msg "Getting news for %s" (symbol-name feed))
2461         (newsticker-get-news (symbol-name feed)))))
2462
2463 (defun newsticker-add-url (url name)
2464   "Add given URL under given NAME to `newsticker-url-list'.
2465 If URL is nil it is searched at point."
2466   (interactive
2467    (list
2468     (read-string "URL: "
2469                  (save-excursion
2470                    (end-of-line)
2471                    (and
2472                     (re-search-backward
2473                      "http://"
2474                      (if (> (point) (+ (point-min) 100))
2475                          (- (point) 100)
2476                        (point-min))
2477                      t)
2478                     (re-search-forward
2479                      "http://[-a-zA-Z0-9&/_.]*"
2480                      (if (< (point) (- (point-max) 200))
2481                          (+ (point) 200)
2482                        (point-max))
2483                      t)
2484                     (buffer-substring-no-properties (match-beginning 0)
2485                                                     (match-end 0)))))
2486     (read-string "Name: ")))
2487   (add-to-list 'newsticker-url-list (list name url nil nil nil) t)
2488   (customize-variable 'newsticker-url-list))
2489
2490 (defun newsticker-w3m-show-inline-images ()
2491   "Show inline images in visible text ranges.
2492 In-line images in invisible text ranges are hidden.  This function
2493 calls `w3m-toggle-inline-image'.  It works only if
2494 `newsticker-html-renderer' is set to `w3m-region'"
2495   (interactive)
2496   (if (eq newsticker-html-renderer 'w3m-region)
2497       (let ((inhibit-read-only t))
2498         (save-excursion
2499           (save-restriction
2500             (widen)
2501             (goto-char (point-min))
2502             (let ((pos (point)))
2503               (while pos
2504                 (setq pos (next-single-property-change pos 'w3m-image))
2505                 (when pos
2506                   (goto-char pos)
2507                   (when (get-text-property pos 'w3m-image)
2508                     (let ((invis (newsticker--lists-intersect-p
2509                                   (get-text-property (1- (point)) 'invisible)
2510                                   buffer-invisibility-spec)))
2511                       (if invis
2512                           (w3m-remove-image
2513                            pos (next-single-property-change pos 'w3m-image))
2514                         (w3m-toggle-inline-image t))))))))))))
2515
2516 ;; ======================================================================
2517 ;;; keymap stuff
2518 ;; ======================================================================
2519 (defun newsticker-close-buffer ()
2520   "Close the newsticker buffer."
2521   (interactive)
2522   (newsticker--cache-update t)
2523   (bury-buffer))
2524
2525 (defun newsticker-next-new-item (&optional do-not-wrap-at-eob)
2526   "Go to next new news item.
2527 If no new item is found behind point, search is continued at
2528 beginning of buffer unless optional argument DO-NOT-WRAP-AT-EOB
2529 is non-nil."
2530   (interactive)
2531   (widen)
2532   (let ((go-ahead t))
2533     (while go-ahead
2534       (unless (newsticker--buffer-goto '(item) 'new)
2535         ;; found nothing -- wrap
2536         (unless do-not-wrap-at-eob
2537           (goto-char (point-min))
2538           (newsticker-next-new-item t))
2539         (setq go-ahead nil))
2540       (unless (newsticker--lists-intersect-p
2541                (get-text-property (point) 'invisible)
2542                buffer-invisibility-spec)
2543         ;; this item is invisible -- continue search
2544         (setq go-ahead nil))))
2545   (run-hooks 'newsticker-select-item-hook)
2546   (point))
2547
2548 (defun newsticker-previous-new-item (&optional do-not-wrap-at-bob)
2549   "Go to previous new news item.
2550 If no new item is found before point, search is continued at
2551 beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
2552 is non-nil."
2553   (interactive)
2554   (widen)
2555   (let ((go-ahead t))
2556     (while go-ahead
2557       (unless (newsticker--buffer-goto '(item) 'new t)
2558         (unless do-not-wrap-at-bob
2559           (goto-char (point-max))
2560           (newsticker--buffer-goto '(item) 'new t)))
2561       (unless (newsticker--lists-intersect-p
2562                (get-text-property (point) 'invisible)
2563                     buffer-invisibility-spec)
2564         (setq go-ahead nil))))
2565   (run-hooks 'newsticker-select-item-hook)
2566   (point))
2567
2568 (defun newsticker-next-item (&optional do-not-wrap-at-eob)
2569   "Go to next news item.
2570 Return new buffer position.
2571 If no item is found below point, search is continued at beginning
2572 of buffer unless optional argument DO-NOT-WRAP-AT-EOB is
2573 non-nil."
2574   (interactive)
2575   (widen)
2576   (let ((go-ahead t)
2577         (search-list '(item)))
2578     (if newsticker--auto-narrow-to-item
2579         (setq search-list '(item feed)))
2580     (while go-ahead
2581       (unless (newsticker--buffer-goto search-list)
2582         ;; found nothing -- wrap
2583         (unless do-not-wrap-at-eob
2584           (goto-char (point-min)))
2585         (setq go-ahead nil))
2586       (unless (newsticker--lists-intersect-p
2587                (get-text-property (point) 'invisible)
2588                     buffer-invisibility-spec)
2589         (setq go-ahead nil))))
2590   (run-hooks 'newsticker-select-item-hook)
2591   (point))
2592
2593 (defun newsticker-previous-item (&optional do-not-wrap-at-bob)
2594   "Go to previous news item.
2595 Return new buffer position.
2596 If no item is found before point, search is continued at
2597 beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
2598 is non-nil."
2599   (interactive)
2600   (widen)
2601   (let ((go-ahead t)
2602         (search-list '(item)))
2603     (if newsticker--auto-narrow-to-item
2604         (setq search-list '(item feed)))
2605     (when (bobp)
2606       (unless do-not-wrap-at-bob
2607         (goto-char (point-max))))
2608     (while go-ahead
2609       (if (newsticker--buffer-goto search-list nil t)
2610           (unless (newsticker--lists-intersect-p
2611                    (get-text-property (point) 'invisible)
2612                    buffer-invisibility-spec)
2613             (setq go-ahead nil))
2614         (goto-char (point-min))
2615         (setq go-ahead nil))))
2616   (run-hooks 'newsticker-select-item-hook)
2617   (point))
2618
2619 (defun newsticker-next-feed ()
2620   "Go to next news feed.
2621 Return new buffer position."
2622   (interactive)
2623   (widen)
2624   (newsticker--buffer-goto '(feed))
2625   (run-hooks 'newsticker-select-feed-hook)
2626   (point))
2627
2628 (defun newsticker-previous-feed ()
2629   "Go to previous news feed.
2630 Return new buffer position."
2631   (interactive)
2632   (widen)
2633   (newsticker--buffer-goto '(feed) nil t)
2634   (run-hooks 'newsticker-select-feed-hook)
2635   (point))
2636
2637 (defun newsticker-mark-all-items-at-point-as-read ()
2638   "Mark all items as read and clear ticker contents."
2639   (interactive)
2640   (when (or newsticker--buffer-uptodate-p
2641             (y-or-n-p
2642              "Buffer is not up to date -- really mark items as read? "))
2643     (let ((feed (get-text-property (point) 'feed))
2644           (pos (point)))
2645       (when feed
2646         (message "Marking all items as read for %s" (symbol-name feed))
2647         (newsticker--cache-replace-age newsticker--cache feed 'new 'old)
2648         (newsticker--cache-replace-age newsticker--cache feed 'obsolete 'old)
2649         (newsticker--cache-update)
2650         (newsticker--buffer-set-uptodate nil)
2651         (newsticker--ticker-text-setup)
2652         (newsticker-buffer-update)
2653         ;; go back to where we came frome
2654         (goto-char pos)
2655         (end-of-line)
2656         (newsticker--buffer-goto '(feed) nil t)))))
2657
2658 (defun newsticker-mark-item-at-point-as-read (&optional respect-immortality)
2659   "Mark item at point as read.
2660 If optional argument RESPECT-IMMORTALITY is not nil immortal items do
2661 not get changed."
2662   (interactive)
2663   (when (or newsticker--buffer-uptodate-p
2664             (y-or-n-p
2665              "Buffer is not up to date -- really mark this item as read? "))
2666     (let ((feed (get-text-property (point) 'feed))
2667           (item nil))
2668       (when feed
2669         (save-excursion
2670           (newsticker--buffer-beginning-of-item)
2671           (let ((inhibit-read-only t)
2672                 (age (get-text-property (point) 'nt-age))
2673                 (title (get-text-property (point) 'nt-title))
2674                 (guid (get-text-property (point) 'nt-guid))
2675                 (nt-desc (get-text-property (point) 'nt-desc))
2676                 (pos (save-excursion (newsticker--buffer-end-of-item))))
2677             (when (or (eq age 'new)
2678                       (eq age 'obsolete)
2679                       (and (eq age 'immortal)
2680                            (not respect-immortality)))
2681               ;; find item
2682               (setq item (newsticker--cache-contains newsticker--cache
2683                                                      feed title nt-desc
2684                                                      nil nil guid))
2685               ;; mark as old
2686               (when item
2687                 (setcar (nthcdr 4 item) 'old)
2688                 (newsticker--do-forget-preformatted item))
2689               ;; clean up ticker
2690               (if (or (and (eq age 'new)
2691                            newsticker-hide-immortal-items-in-echo-area)
2692                       (and (memq age '(old immortal))
2693                            (not
2694                             (eq newsticker-hide-old-items-in-newsticker-buffer
2695                                 newsticker-hide-immortal-items-in-echo-area))))
2696                   (newsticker--ticker-text-remove feed title))
2697               ;; set faces etc.
2698               (save-excursion
2699                 (save-restriction
2700                   (widen)
2701                   (put-text-property (point) pos 'nt-age 'old)
2702                   (newsticker--buffer-set-faces (point) pos)))
2703               (set-buffer-modified-p nil))))
2704         ;; move forward
2705         (newsticker-next-item t)))))
2706
2707 (defun newsticker-mark-item-at-point-as-immortal ()
2708   "Mark item at point as read."
2709   (interactive)
2710   (when (or newsticker--buffer-uptodate-p
2711             (y-or-n-p
2712              "Buffer is not up to date -- really mark this item as read? "))
2713     (let ((feed (get-text-property (point) 'feed))
2714           (item nil))
2715       (when feed
2716         (save-excursion
2717           (newsticker--buffer-beginning-of-item)
2718           (let ((inhibit-read-only t)
2719                 (oldage (get-text-property (point) 'nt-age))
2720                 (title (get-text-property (point) 'nt-title))
2721                 (guid (get-text-property (point) 'nt-guid))
2722                 (pos  (save-excursion (newsticker--buffer-end-of-item))))
2723             (let ((newage 'immortal))
2724               (if (eq oldage 'immortal)
2725                   (setq newage 'old))
2726               (setq item (newsticker--cache-contains newsticker--cache
2727                                                      feed title nil nil nil
2728                                                      guid))
2729               ;; change age
2730               (when item
2731                 (setcar (nthcdr 4 item) newage)
2732                 (newsticker--do-forget-preformatted item))
2733               (if (or (and (eq newage 'immortal)
2734                            newsticker-hide-immortal-items-in-echo-area)
2735                       (and (eq newage 'obsolete)
2736                            newsticker-hide-obsolete-items-in-echo-area)
2737                       (and (eq oldage 'immortal)
2738                            (not
2739                             (eq newsticker-hide-old-items-in-newsticker-buffer
2740                                 newsticker-hide-immortal-items-in-echo-area))))
2741                   (newsticker--ticker-text-remove feed title)
2742                 (newsticker--ticker-text-setup))
2743               (save-excursion
2744                 (save-restriction
2745                   (widen)
2746                   (put-text-property (point) pos 'nt-age newage)
2747                   (if (eq newage 'immortal)
2748                       (put-text-property (point) pos 'nt-age 'immortal)
2749                     (put-text-property (point) pos 'nt-age 'old))
2750                   (newsticker--buffer-set-faces (point) pos))))))
2751           (if item
2752             (newsticker-next-item t))))))
2753
2754 (defun newsticker-mark-all-items-as-read ()
2755   "Mark all items as read and clear ticker contents."
2756   (interactive)
2757   (when (or newsticker--buffer-uptodate-p
2758             (y-or-n-p
2759              "Buffer is not up to date -- really mark items as read? "))
2760     (newsticker--cache-replace-age newsticker--cache 'any 'new 'old)
2761     (newsticker--buffer-set-uptodate nil)
2762     (newsticker--ticker-text-setup)
2763     (newsticker--cache-update)
2764     (newsticker-buffer-update)))
2765
2766 (defun newsticker-hide-extra ()
2767   "Hide the extra elements of items."
2768   (interactive)
2769   (newsticker--buffer-hideshow 'extra nil)
2770   (newsticker--buffer-redraw))
2771
2772 (defun newsticker-show-extra ()
2773   "Show the extra elements of items."
2774   (interactive)
2775   (newsticker--buffer-hideshow 'extra t)
2776   (newsticker--buffer-redraw))
2777
2778 (defun newsticker-hide-old-item-desc ()
2779   "Hide the description of old items."
2780   (interactive)
2781   (newsticker--buffer-hideshow 'desc-old nil)
2782   (newsticker--buffer-redraw))
2783
2784 (defun newsticker-show-old-item-desc ()
2785   "Show the description of old items."
2786   (interactive)
2787   (newsticker--buffer-hideshow 'item-old t)
2788   (newsticker--buffer-hideshow 'desc-old t)
2789   (newsticker--buffer-redraw))
2790
2791 (defun newsticker-hide-new-item-desc ()
2792   "Hide the description of new items."
2793   (interactive)
2794   (newsticker--buffer-hideshow 'desc-new nil)
2795   (newsticker--buffer-hideshow 'desc-immortal nil)
2796   (newsticker--buffer-hideshow 'desc-obsolete nil)
2797   (newsticker--buffer-redraw))
2798
2799 (defun newsticker-show-new-item-desc ()
2800   "Show the description of new items."
2801   (interactive)
2802   (newsticker--buffer-hideshow 'desc-new t)
2803   (newsticker--buffer-hideshow 'desc-immortal t)
2804   (newsticker--buffer-hideshow 'desc-obsolete t)
2805   (newsticker--buffer-redraw))
2806
2807 (defun newsticker-hide-feed-desc ()
2808   "Hide the description of feeds."
2809   (interactive)
2810   (newsticker--buffer-hideshow 'desc-feed nil)
2811   (newsticker--buffer-redraw))
2812
2813 (defun newsticker-show-feed-desc ()
2814   "Show the description of old items."
2815   (interactive)
2816   (newsticker--buffer-hideshow 'desc-feed t)
2817   (newsticker--buffer-redraw))
2818
2819 (defun newsticker-hide-all-desc ()
2820   "Hide the descriptions of feeds and all items."
2821   (interactive)
2822   (newsticker--buffer-hideshow 'desc-feed nil)
2823   (newsticker--buffer-hideshow 'desc-immortal nil)
2824   (newsticker--buffer-hideshow 'desc-obsolete nil)
2825   (newsticker--buffer-hideshow 'desc-new  nil)
2826   (newsticker--buffer-hideshow 'desc-old  nil)
2827   (newsticker--buffer-redraw))
2828
2829 (defun newsticker-show-all-desc ()
2830   "Show the descriptions of feeds and all items."
2831   (interactive)
2832   (newsticker--buffer-hideshow 'desc-feed t)
2833   (newsticker--buffer-hideshow 'desc-immortal  t)
2834   (newsticker--buffer-hideshow 'desc-obsolete  t)
2835   (newsticker--buffer-hideshow 'desc-new  t)
2836   (newsticker--buffer-hideshow 'desc-old  t)
2837   (newsticker--buffer-redraw))
2838
2839 (defun newsticker-hide-old-items ()
2840   "Hide old items."
2841   (interactive)
2842   (newsticker--buffer-hideshow 'desc-old nil)
2843   (newsticker--buffer-hideshow 'item-old nil)
2844   (newsticker--buffer-redraw))
2845
2846 (defun newsticker-show-old-items ()
2847   "Show old items."
2848   (interactive)
2849   (newsticker--buffer-hideshow 'desc-old t)
2850   (newsticker--buffer-hideshow 'item-old t)
2851   (newsticker--buffer-redraw))
2852
2853 (defun newsticker-hide-entry ()
2854   "Hide description of entry at point."
2855   (interactive)
2856   (save-excursion
2857     (let* (pos1 pos2
2858                 (inhibit-read-only t)
2859                 inv-prop org-inv-prop
2860                 is-invisible)
2861       (newsticker--buffer-beginning-of-item)
2862       (newsticker--buffer-goto '(desc))
2863       (setq pos1 (max (point-min) (1- (point))))
2864       (newsticker--buffer-goto '(extra feed item))
2865       (setq pos2 (max (point-min) (1- (point))))
2866       (setq inv-prop (get-text-property pos1 'invisible))
2867       (setq org-inv-prop (get-text-property pos1 'org-invisible))
2868       (cond ((eq inv-prop t)
2869              ;; do nothing
2870              )
2871             ((eq org-inv-prop nil)
2872              (add-text-properties pos1 pos2 (list 'invisible t
2873                                                   'org-invisible inv-prop)))
2874             (t
2875              ;; toggle
2876              (add-text-properties pos1 pos2 (list 'invisible org-inv-prop))
2877              (remove-text-properties pos1 pos2 '(org-invisible))))))
2878   (newsticker--buffer-redraw))
2879
2880 (defun newsticker-show-entry ()
2881   "Show description of entry at point."
2882   (interactive)
2883   (save-excursion
2884     (let* (pos1 pos2
2885                 (inhibit-read-only t)
2886                 inv-prop org-inv-prop
2887                 is-invisible)
2888       (newsticker--buffer-beginning-of-item)
2889       (newsticker--buffer-goto '(desc))
2890       (setq pos1 (max (point-min) (1- (point))))
2891       (newsticker--buffer-goto '(extra feed item))
2892       (setq pos2 (max (point-min) (1- (point))))
2893       (setq inv-prop (get-text-property pos1 'invisible))
2894       (setq org-inv-prop (get-text-property pos1 'org-invisible))
2895       (cond ((eq org-inv-prop nil)
2896              (add-text-properties pos1 pos2 (list 'invisible nil
2897                                                   'org-invisible inv-prop)))
2898             (t
2899              ;; toggle
2900              (add-text-properties pos1 pos2 (list 'invisible org-inv-prop))
2901              (remove-text-properties pos1 pos2 '(org-invisible))))))
2902   (newsticker--buffer-redraw))
2903
2904 (defun newsticker-toggle-auto-narrow-to-feed ()
2905   "Toggle narrowing to current news feed.
2906 If auto-narrowing is active, only news item of the current feed
2907 are visible."
2908   (interactive)
2909   (newsticker-set-auto-narrow-to-feed (not newsticker--auto-narrow-to-feed)))
2910
2911 (defun newsticker-set-auto-narrow-to-feed (value)
2912   "Turn narrowing to current news feed on or off.
2913 If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
2914   (interactive)
2915   (setq newsticker--auto-narrow-to-item nil)
2916   (setq newsticker--auto-narrow-to-feed value)
2917   (widen)
2918   (run-hooks 'newsticker-narrow-hook))
2919
2920 (defun newsticker-toggle-auto-narrow-to-item ()
2921   "Toggle narrowing to current news item.
2922 If auto-narrowing is active, only one item of the current feed
2923 is visible."
2924   (interactive)
2925   (newsticker-set-auto-narrow-to-item (not newsticker--auto-narrow-to-item)))
2926
2927 (defun newsticker-set-auto-narrow-to-item (value)
2928   "Turn narrowing to current news item on or off.
2929 If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
2930   (interactive)
2931   (setq newsticker--auto-narrow-to-feed nil)
2932   (setq newsticker--auto-narrow-to-item value)
2933   (widen)
2934   (run-hooks 'newsticker-narrow-hook))
2935
2936 (defun newsticker-customize ()
2937   "Open the newsticker customization group."
2938   (interactive)
2939   (customize-group "newsticker"))
2940
2941 (defun newsticker-next-feed-available-p ()
2942   "Return t if position is before last feed, nil otherwise."
2943   (save-excursion
2944     (let ((p (point)))
2945       (newsticker--buffer-goto '(feed))
2946       (not (= p (point))))))
2947
2948 (defun newsticker-previous-feed-available-p ()
2949   "Return t if position is behind first feed, nil otherwise."
2950   (save-excursion
2951     (let ((p (point)))
2952       (newsticker--buffer-goto '(feed) nil t)
2953       (not (= p (point))))))
2954
2955 (defun newsticker-next-item-available-p ()
2956   "Return t if position is before last feed, nil otherwise."
2957   (save-excursion
2958     (catch 'result
2959       (while (< (point) (point-max))
2960         (unless (newsticker--buffer-goto '(item))
2961           (throw 'result nil))
2962         (unless (newsticker--lists-intersect-p
2963                  (get-text-property (point) 'invisible)
2964                  buffer-invisibility-spec)
2965           (throw 'result t))))))
2966
2967 (defun newsticker-previous-item-available-p ()
2968   "Return t if position is behind first item, nil otherwise."
2969   (save-excursion
2970     (catch 'result
2971       (while (> (point) (point-min))
2972         (unless (newsticker--buffer-goto '(item) nil t)
2973           (throw 'result nil))
2974         (unless (newsticker--lists-intersect-p
2975                  (get-text-property (point) 'invisible)
2976                  buffer-invisibility-spec)
2977           (throw 'result t))))))
2978
2979 (defun newsticker-item-not-old-p ()
2980   "Return t if there is an item at point which is not old, nil otherwise."
2981     (when (get-text-property (point) 'feed)
2982       (save-excursion
2983         (newsticker--buffer-beginning-of-item)
2984         (let ((age (get-text-property (point) 'nt-age)))
2985           (and (memq  age '(new immortal obsolete)) t)))))
2986
2987 (defun newsticker-item-not-immortal-p ()
2988   "Return t if there is an item at point which is not immortal, nil otherwise."
2989     (when (get-text-property (point) 'feed)
2990       (save-excursion
2991         (newsticker--buffer-beginning-of-item)
2992         (let ((age (get-text-property (point) 'nt-age)))
2993           (and (memq  age '(new old obsolete)) t)))))
2994
2995 ;; ======================================================================
2996 ;;; local stuff
2997 ;; ======================================================================
2998 (defun newsticker-running-p ()
2999   "Check whether newsticker is running.
3000 Return t if newsticker is running, nil otherwise.  Newsticker is
3001 considered to be running if the newsticker timer list is not empty."
3002   (> (length newsticker--retrieval-timer-list) 0))
3003
3004 (defun newsticker-ticker-running-p ()
3005   "Check whether newsticker's actual ticker is running.
3006 Return t if ticker is running, nil otherwise.  Newsticker is
3007 considered to be running if the newsticker timer list is not
3008 empty."
3009   (timerp newsticker--display-timer))
3010
3011 ;; ======================================================================
3012 ;;; local stuff
3013 ;; ======================================================================
3014 (defun newsticker-get-news (feed-name)
3015   "Get news from the site FEED-NAME and load feed logo.
3016 FEED-NAME must be a string which occurs as the label (i.e. the first element)
3017 in an element of `newsticker-url-list' or `newsticker-url-list-defaults'."
3018   (newsticker--debug-msg "%s: Getting news for %s"
3019                          (format-time-string "%A, %H:%M" (current-time))
3020                          feed-name)
3021   (let* ((buffername (concat " *newsticker-wget-" feed-name "*"))
3022          (item (or (assoc feed-name newsticker-url-list)
3023                    (assoc feed-name newsticker-url-list-defaults)
3024                    (error
3025                     "Cannot get news for %s: Check newsticker-url-list"
3026                     feed-name)))
3027          (url (cadr item))
3028          (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
3029                              newsticker-wget-arguments)))
3030     (save-excursion
3031       (set-buffer (get-buffer-create buffername))
3032       (erase-buffer)
3033       ;; throw an error if there is an old wget-process around
3034       (if (get-process feed-name)
3035           (error "Another wget-process is running for %s" feed-name))
3036       ;; start wget
3037       (let* ((args (append wget-arguments (list url)))
3038              (proc (apply 'start-process feed-name buffername
3039                           newsticker-wget-name args)))
3040         (set-process-coding-system proc 'no-conversion 'no-conversion)
3041         (set-process-sentinel proc 'newsticker--sentinel)))))
3042
3043
3044 (defun newsticker-mouse-browse-url (event)
3045   "Call `browse-url' for the link of the item at which the EVENT occurred."
3046   (interactive "e")
3047   (save-excursion
3048     (switch-to-buffer (window-buffer (posn-window (event-end event))))
3049     (let ((url (get-text-property (posn-point (event-end event))
3050                                   'nt-link)))
3051       (when url
3052         (browse-url url)
3053         (save-excursion
3054           (goto-char (posn-point (event-end event)))
3055           (if newsticker-automatically-mark-visited-items-as-old
3056               (newsticker-mark-item-at-point-as-read t)))))))
3057
3058 (defun newsticker-browse-url ()
3059   "Call `browse-url' for the link of the item at point."
3060   (interactive)
3061   (let ((url (get-text-property (point) 'nt-link)))
3062     (when url
3063       (browse-url url)
3064       (if newsticker-automatically-mark-visited-items-as-old
3065           (newsticker-mark-item-at-point-as-read t)))))
3066
3067 (defvar newsticker-open-url-history
3068   '("wget" "xmms" "realplay")
3069   "...")
3070
3071 (defun newsticker-handle-url ()
3072   "Ask for a program to open the link of the item at point."
3073   (interactive)
3074   (let ((url (get-text-property (point) 'nt-link)))
3075     (when url
3076       (let ((prog (read-string "Open url with: " nil
3077                                'newsticker-open-url-history)))
3078         (when prog
3079           (message "%s %s" prog url)
3080           (start-process prog prog prog url)
3081       (if newsticker-automatically-mark-visited-items-as-old
3082           (newsticker-mark-item-at-point-as-read t)))))))
3083
3084 (defun newsticker--sentinel (process event)
3085   "Sentinel for extracting news titles from an RDF buffer.
3086 Argument PROCESS is the process which has just changed its state.
3087 Argument EVENT tells what has happened to the process."
3088   (let* ((p-status (process-status process))
3089          (exit-status (process-exit-status process))
3090          (time (current-time))
3091          (name (process-name process))
3092          (name-symbol (intern name))
3093          (something-was-added nil))
3094     ;; catch known errors (zombie processes, rubbish-xml etc.
3095     ;; if an error occurs the news feed is not updated!
3096     (catch 'oops
3097       (unless (and (eq p-status 'exit)
3098                    (= exit-status 0))
3099         (setq newsticker--cache
3100               (newsticker--cache-add
3101                newsticker--cache
3102                name-symbol
3103                newsticker--error-headline
3104                (format
3105                 (concat "%s: Newsticker could not retrieve news from %s.\n"
3106                         "Return status: `%s'\n"
3107                         "Command was `%s'")
3108                 (format-time-string "%A, %H:%M" (current-time))
3109                 name event (process-command process))
3110                ""
3111                (current-time)
3112                'new
3113                0 nil))
3114         (message "%s: Error while retrieving news from %s"
3115                  (format-time-string "%A, %H:%M" (current-time))
3116                  (process-name process))
3117         (throw 'oops nil))
3118       (let* ((coding-system nil)
3119              (node-list
3120               (save-current-buffer
3121                 (set-buffer (process-buffer process))
3122                 ;; a very very dirty workaround to overcome the
3123                 ;; problems with the newest (20030621) xml.el:
3124                 ;; remove all unnecessary whitespace
3125                 (goto-char (point-min))
3126                 (while (re-search-forward ">[ \t\r\n]+<" nil t)
3127                   (replace-match "><" nil t))
3128                 ;; and another brutal workaround (20031105)!  For some
3129                 ;; reason the xml parser does not like the colon in the
3130                 ;; doctype name "rdf:RDF"
3131                 (goto-char (point-min))
3132                 (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t)
3133                   (replace-match "<!DOCTYPE rdfColonRDF" nil t))
3134                 ;; finally.... ~##^°!!!!!
3135                 (goto-char (point-min))
3136                 (while (search-forward "\r\n" nil t)
3137                   (replace-match "\n" nil t))
3138                 ;; still more brutal workarounds (20040309)!  The xml
3139                 ;; parser does not like doctype rss
3140                 (goto-char (point-min))
3141                 (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t)
3142                   (replace-match "" nil t))
3143                 ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
3144                 ;; Remove comments to avoid this xml-parsing bug:
3145                 ;; "XML files can have only one toplevel tag"
3146                 (goto-char (point-min))
3147                 (while (search-forward "<!--" nil t)
3148                   (let ((start (match-beginning 0)))
3149                     (unless (search-forward "-->" nil t)
3150                       (error "Can't find end of comment"))
3151                     (delete-region start (point))))
3152                 ;; And another one (20050702)! If description is HTML
3153                 ;; encoded and starts with a `<', wrap the whole
3154                 ;; description in a CDATA expression.  This happened for
3155                 ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
3156                  (goto-char (point-min))
3157                  (while (re-search-forward
3158                          "<description>\\(<img.*?\\)</description>" nil t)
3159                    (replace-match
3160                     "<description><![CDATA[ \\1 ]]></description>"))
3161                 ;;
3162                 (set-buffer-modified-p nil)
3163                 (goto-char (point-min))
3164                 (if (re-search-forward "encoding=\"\\([^\"]+\\)\""
3165                                        nil t)
3166                     (setq coding-system (intern
3167                                          (downcase(match-string 1)))))
3168                 (condition-case errordata
3169                     ;; The xml parser might fail
3170                     ;; or the xml might be bugged
3171                     (xml-parse-region (point-min) (point-max))
3172                   (error (message "Could not parse %s: %s"
3173                                   (buffer-name) (cadr errordata))
3174                          (throw 'oops nil)))))
3175              (topnode (car node-list))
3176              (channelnode (car (xml-get-children topnode 'channel)))
3177              (imageurl nil)
3178              (position 0))
3179         ;; mark all items as obsolete
3180         (newsticker--cache-replace-age newsticker--cache
3181                                        name-symbol
3182                                        'new 'obsolete-new)
3183         (newsticker--cache-replace-age newsticker--cache
3184                                        name-symbol
3185                                        'old 'obsolete-old)
3186         (newsticker--cache-replace-age newsticker--cache
3187                                        name-symbol
3188                                        'feed 'obsolete-old)
3189         ;; gather the news
3190         (if (eq (xml-node-name topnode) 'rss)
3191             ;; this is RSS 0.91 or something similar
3192             ;; all items are inside the channel node
3193             (setq topnode channelnode))
3194         (setq imageurl
3195               (car (xml-node-children
3196                     (car (xml-get-children
3197                           (car (xml-get-children
3198                                 topnode
3199                                 'image))
3200                           'url)))))
3201         (let ((title (or (car (xml-node-children (car (xml-get-children
3202                                                        channelnode 'title))))
3203                          "[untitled]"))
3204               (link (or (car (xml-node-children (car (xml-get-children
3205                                                       channelnode 'link))))
3206                         ""))
3207               (desc (or (car (xml-node-children (car (xml-get-children
3208                                                       channelnode
3209                                                       'content:encoded))))
3210                         (car (xml-node-children (car (xml-get-children
3211                                                       channelnode
3212                                                       'description))))
3213                         "[No description available]"))
3214               (old-item nil))
3215           ;; check coding system
3216           (setq coding-system
3217                 (condition-case nil
3218                     (check-coding-system coding-system)
3219                   (coding-system-error
3220                    (message "newsticker.el: %s %s %s %s"
3221                             "ignoring coding system "
3222                             coding-system
3223                             " for "
3224                             name)
3225                    nil)))
3226           ;; apply coding system
3227           (when coding-system
3228             (setq title (newsticker--decode-coding-string title coding-system))
3229             (if desc
3230                 (setq desc (newsticker--decode-coding-string desc
3231                                                              coding-system)))
3232             (setq link (newsticker--decode-coding-string link coding-system)))
3233           ;; decode numeric entities
3234           (setq title (newsticker--decode-numeric-entities title))
3235           (setq desc  (newsticker--decode-numeric-entities desc))
3236           (setq link  (newsticker--decode-numeric-entities link))
3237           ;; remove whitespace from title, desc, and link
3238           (setq title (newsticker--remove-whitespace title))
3239           (setq desc (newsticker--remove-whitespace desc))
3240           (setq link (newsticker--remove-whitespace link))
3241
3242           ;; handle the feed itself
3243           (unless (newsticker--cache-contains newsticker--cache
3244                                               name-symbol title
3245                                               desc link 'feed)
3246             (setq something-was-added t))
3247           (setq newsticker--cache
3248                 (newsticker--cache-add
3249                  newsticker--cache name-symbol
3250                  title desc link time 'feed position
3251                  (xml-node-children channelnode)
3252                  'feed time))
3253           ;; gather all items for this feed
3254           (mapc (lambda (node)
3255                   (when (eq (xml-node-name node) 'item)
3256                     (setq position (1+ position))
3257                     (setq title (or (car (xml-node-children
3258                                           (car (xml-get-children
3259                                                 node 'title))))
3260                                     "[untitled]"))
3261                     (setq link (or (car (xml-node-children
3262                                          (car (xml-get-children
3263                                                node 'link))))
3264                                    ""))
3265                     (setq desc (or
3266                                 (car (xml-node-children
3267                                       (car (xml-get-children
3268                                             node 'content:encoded))))
3269                                 (car (xml-node-children
3270                                       (car (xml-get-children
3271                                             node 'description))))))
3272                     ;; use pubDate value if present
3273                     (setq time (or (newsticker--decode-rfc822-date
3274                                     (car (xml-node-children
3275                                           (car (xml-get-children
3276                                                 node 'pubDate)))))
3277                                    time))
3278                     ;; use dc:date value if present
3279                     (setq time (or (newsticker--decode-iso8601-date
3280                                     (car (xml-node-children
3281                                           (car (xml-get-children
3282                                                 node 'dc:date)))))
3283                                    time))
3284                     ;; It happened that the title or description
3285                     ;; contained evil HTML code that confused the
3286                     ;; xml parser.  Therefore:
3287                     (unless (stringp title)
3288                       (setq title (prin1-to-string title)))
3289                     (unless (or (stringp desc) (not desc))
3290                       (setq desc (prin1-to-string desc)))
3291                     ;; ignore items with empty title AND empty desc
3292                     (when (or (> (length title) 0)
3293                               (> (length desc) 0))
3294                       ;; apply coding system
3295                       (when coding-system
3296                         (setq title (newsticker--decode-coding-string
3297                                      title coding-system))
3298                         (if desc
3299                             (setq desc (newsticker--decode-coding-string desc
3300                                                              coding-system)))
3301                         (setq link (newsticker--decode-coding-string
3302                                     link coding-system)))
3303                       ;; decode numeric entities
3304                       (setq title (newsticker--decode-numeric-entities title))
3305                       (when desc
3306                         (setq desc  (newsticker--decode-numeric-entities desc)))
3307                       (setq link (newsticker--decode-numeric-entities link))
3308                       ;; remove whitespace from title, desc, and link
3309                       (setq title (newsticker--remove-whitespace title))
3310                       (setq desc (newsticker--remove-whitespace desc))
3311                       (setq link (newsticker--remove-whitespace link))
3312                       ;; add data to cache
3313                       ;; do we have this item already?
3314                       (let* ((tguid (assoc 'guid (xml-node-children node)))
3315                              (guid (if (stringp tguid)
3316                                        tguid
3317                                      (car (xml-node-children tguid)))))
3318                         ;;(message "guid=%s" guid)
3319                         (setq old-item
3320                               (newsticker--cache-contains newsticker--cache
3321                                                           name-symbol title
3322                                                           desc link nil guid)))
3323                       ;; add this item, or mark it as old, or do nothing
3324                       (let ((age1 'new)
3325                             (age2 'old)
3326                             (item-new-p nil))
3327                         (if old-item
3328                             (let ((prev-age (newsticker--age old-item)))
3329                               (unless
3330                                   newsticker-automatically-mark-items-as-old
3331                                 (if (eq prev-age 'obsolete-old)
3332                                     (setq age2 'old)
3333                                   (setq age2 'new)))
3334                               (if (eq prev-age 'immortal)
3335                                   (setq age2 'immortal)))
3336                           ;; item was not there
3337                           (setq item-new-p t)
3338                           (setq something-was-added t))
3339                         (setq newsticker--cache
3340                               (newsticker--cache-add
3341                                newsticker--cache name-symbol title desc link
3342                                time age1 position (xml-node-children node)
3343                                age2))
3344                         (when item-new-p
3345                           (let ((item (newsticker--cache-contains
3346                                        newsticker--cache
3347                                        name-symbol title
3348                                        desc link nil)))
3349                             (if newsticker-auto-mark-filter
3350                                 (newsticker--run-auto-mark-filter name item))
3351                             (run-hook-with-args
3352                              'newsticker-new-item-functions name item)))))))
3353                 (xml-get-children topnode 'item)))
3354         ;; Remove those old items from cache which have been removed from
3355         ;; the feed
3356         (newsticker--cache-replace-age newsticker--cache
3357                                        name-symbol 'obsolete-old 'deleteme)
3358         (newsticker--cache-remove newsticker--cache name-symbol
3359                                   'deleteme)
3360         ;; Remove those new items from cache which have been removed from
3361         ;; the feed.  Or keep them as `obsolete'
3362         (if (not newsticker-keep-obsolete-items)
3363             (newsticker--cache-remove newsticker--cache
3364                                       name-symbol 'obsolete-new)
3365           (setq newsticker--cache
3366                 (newsticker--cache-mark-expired
3367                  newsticker--cache name-symbol 'obsolete 'obsolete-expired
3368                  newsticker-obsolete-item-max-age))
3369           (newsticker--cache-remove newsticker--cache
3370                                     name-symbol 'obsolete-expired)
3371           (newsticker--cache-replace-age newsticker--cache
3372                                          name-symbol 'obsolete-new
3373                                          'obsolete))
3374         ;; bring cache data into proper order....
3375         ;; (newsticker--cache-sort)
3376         ;; setup scrollable text
3377         (newsticker--ticker-text-setup)
3378         (setq newsticker--latest-update-time (current-time))
3379         (when something-was-added
3380           ;; FIXME: should we care about removed items as well?
3381           (newsticker--cache-update)
3382           (newsticker--buffer-set-uptodate nil))
3383         ;; kill the process buffer if wanted
3384         (unless newsticker-debug
3385           (kill-buffer (process-buffer process)))
3386         ;; launch retrieval of image
3387         (when (and imageurl
3388                    (string-match "%l" newsticker-heading-format))
3389           (newsticker--image-get name imageurl))))))
3390
3391 (defun newsticker--display-tick ()
3392   "Called from the display timer.
3393 This function calls a display function, according to the variable
3394 `newsticker-scroll-smoothly'."
3395   (if newsticker-scroll-smoothly
3396       (newsticker--display-scroll)
3397     (newsticker--display-jump)))
3398
3399 (defsubst newsticker--echo-area-clean-p ()
3400   "Check whether somebody is using the echo area / minibuffer.
3401 Return t if echo area and minibuffer are unused."
3402   (not (or (active-minibuffer-window)
3403            (and (current-message)
3404                 (not (string= (current-message)
3405                               newsticker--prev-message))))))
3406
3407 (defun newsticker--display-jump ()
3408   "Called from the display timer.
3409 This function displays the next ticker item in the echo area, unless
3410 there is another message displayed or the minibuffer is active."
3411   (let ((message-log-max nil));; prevents message text from being logged
3412     (when (newsticker--echo-area-clean-p)
3413       (setq newsticker--item-position (1+ newsticker--item-position))
3414       (when (>= newsticker--item-position (length newsticker--item-list))
3415         (setq newsticker--item-position 0))
3416       (setq newsticker--prev-message
3417             (nth newsticker--item-position newsticker--item-list))
3418       (message "%s" newsticker--prev-message))))
3419
3420 (defun newsticker--display-scroll ()
3421   "Called from the display timer.
3422 This function scrolls the ticker items in the echo area, unless
3423 there is another message displayed or the minibuffer is active."
3424   (when (newsticker--echo-area-clean-p)
3425     (let* ((width (- (frame-width) 1))
3426            (message-log-max nil);; prevents message text from being logged
3427            (i newsticker--item-position)
3428            subtext
3429            (s-text newsticker--scrollable-text)
3430            (l (length s-text)))
3431       ;; don't show anything if there is nothing to show
3432       (unless (< (length s-text) 1)
3433         ;; repeat the ticker string if it is shorter than frame width
3434         (while (< (length s-text) width)
3435           (setq s-text (concat s-text s-text)))
3436         ;; get the width of the printed string
3437         (setq l (length s-text))
3438         (cond ((< i (- l width))
3439                (setq subtext (substring s-text i (+ i width))))
3440               (t
3441                (setq subtext (concat
3442                               (substring s-text i l)
3443                               (substring s-text 0 (- width (- l i)))))))
3444         ;; Take care of multibyte strings, for which (string-width) is
3445         ;; larger than (length).
3446         ;; Actually, such strings may be smaller than (frame-width)
3447         ;; because return values of (string-width) are too large:
3448         ;; (string-width "<japanese character>") => 2
3449         (let ((t-width (1- (length subtext))))
3450           (while (> (string-width subtext) width)
3451             (setq subtext (substring subtext 0 t-width))
3452             (setq t-width (1- t-width))))
3453         ;; show the ticker text and save current position
3454         (message "%s" subtext)
3455         (setq newsticker--prev-message subtext)
3456         (setq newsticker--item-position (1+ i))
3457         (when (>= newsticker--item-position l)
3458           (setq newsticker--item-position 0))))))
3459
3460 ;; ======================================================================
3461 ;;; misc
3462 ;; ======================================================================
3463 (defun newsticker--decode-coding-string (string coding-system)
3464   "Wrapper around `decode-coding-string'.
3465 This functions passes the arguments STRING and CODING-SYSTEM to
3466 `decode-coding-string'.  If the decoding is successful the
3467 decoded string is returned, otherwise the unmodified input string
3468 is returned."
3469   (condition-case nil
3470       (decode-coding-string string coding-system)
3471     (error
3472      (message "Cannot decode encoded string `%s'" string)
3473      string)))
3474
3475 (defun newsticker--decode-numeric-entities (string)
3476   "Decode SGML numeric entities by their respective utf characters.
3477 This function replaces numeric entities in the input STRING and
3478 returns the modified string.  For example \"&#42;\" gets replaced
3479 by \"*\"."
3480   (let ((start 0))
3481     (while (string-match "&#\\([0-9]+\\);" string start)
3482       (condition-case nil
3483           (setq string (replace-match
3484                         (string (read (substring string (match-beginning 1)
3485                                                  (match-end 1))))
3486                         nil nil string))
3487         (error nil))
3488       (setq start (1+ (match-beginning 0))))
3489     string))
3490
3491 (defun newsticker--remove-whitespace (string)
3492   "Remove leading and trailing whitespace from STRING."
3493   ;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
3494   ;; endlessly...
3495   (when string
3496     (replace-regexp-in-string
3497      "[ \t\r\n]+$" ""
3498      (replace-regexp-in-string "^[ \t\r\n]+" "" string))))
3499
3500 (defun newsticker--do-forget-preformatted (item)
3501   "Forget all cached pre-formatted data.
3502 Remove the pre-formatted from `newsticker--cache'."
3503   (if (nthcdr 7 item)
3504       (setcar (nthcdr 7 item) nil))
3505   (if (nthcdr 6 item)
3506       (setcar (nthcdr 6 item) nil)))
3507
3508 (defun newsticker--forget-preformatted ()
3509   "Forget all cached pre-formatted data.
3510 Remove the pre-formatted from `newsticker--cache'."
3511   (mapc (lambda (feed)
3512           (mapc 'newsticker--do-forget-preformatted
3513                 (cdr feed)))
3514         newsticker--cache)
3515   (newsticker--buffer-set-uptodate nil))
3516
3517 (defun newsticker--debug-msg (string &rest args)
3518   "Print newsticker debug messages.
3519 This function calls `message' with arguments STRING and ARGS, if
3520 `newsticker-debug' is non-nil."
3521   (and newsticker-debug
3522        ;;(not (active-minibuffer-window))
3523        ;;(not (current-message))
3524        (apply 'message string args)))
3525
3526 (defun newsticker--decode-iso8601-date (iso8601-string)
3527   "Return ISO8601-STRING in format like `decode-time'.
3528 Converts from ISO-8601 to Emacs representation.  If ISO8601-STRING
3529 Examples:
3530 2004-09-17T05:09:49+00:00
3531 2004-09-17T05:09+00:00
3532 2004-09-17T05:09:49
3533 2004-09-17T05:09
3534 2004-09-17
3535 2004-09
3536 2004"
3537   (if iso8601-string
3538       (when (string-match
3539              (concat
3540               "\\([0-9]\\{4\\}\\)"
3541               "\\(-\\([0-9]\\{2\\}\\)"
3542               "\\(-\\([0-9]\\{2\\}\\)"
3543               "\\(T"
3544               "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
3545               "\\(:\\([0-9]\\{2\\}\\)\\)?"
3546               "\\(\\([-+Z]\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)?"
3547               "\\)?\\)?\\)?")
3548              iso8601-string)
3549         (let ((year (read (match-string 1 iso8601-string)))
3550               (month (read (match-string 3 iso8601-string)))
3551               (day (read (match-string 5 iso8601-string)))
3552               (hour (read (or (match-string 7 iso8601-string)
3553                               "0")))
3554               (minute (read (or (match-string 8 iso8601-string)
3555                                 "0")))
3556               ;;(second (read (or (match-string 10 iso8601-string)
3557               ;; "0")))
3558               (sign (match-string 12 iso8601-string))
3559               (offset-hour (read (or (match-string 14 iso8601-string)
3560                                      "0")))
3561               (offset-minute (read (or (match-string 15 iso8601-string)
3562                                        "0")))
3563               (second 0))
3564           (cond ((string= sign "+")
3565                  (setq hour (- hour offset-hour))
3566                  (setq minute (- minute offset-minute)))
3567                 ((string= sign "-")
3568                  (setq hour (+ hour offset-hour))
3569                  (setq minute (+ minute offset-minute))))
3570           ;; if UTC subtract current-time-zone offset
3571           ;;(setq second (+ (car (current-time-zone)) second)))
3572
3573           (condition-case nil
3574               (encode-time second minute hour day month year t)
3575             (error
3576              (message "Cannot decode \"%s\"" iso8601-string)
3577              nil))))
3578     nil))
3579
3580 (defun newsticker--decode-rfc822-date (rfc822-string)
3581   "Return RFC822-STRING in format like `decode-time'.
3582 Converts from RFC822 to Emacs representation.
3583 Examples:
3584 Sat, 07 Sep 2002 00:00:01 GMT
3585 07 Sep 2002 00:00:01 GMT"
3586   (if rfc822-string
3587       (when (string-match
3588              (concat
3589               "\\s-*"
3590               ;; week day
3591               "\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)\\s-+"
3592               ;; day
3593               "\\([0-9]\\{1,2\\}\\)\\s-+"
3594               ;; month
3595               "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|"
3596               "Sep\\|Oct\\|Nov\\|Dec\\)\\s-+"
3597               ;; year
3598               "\\([0-9]\\{2,4\\}\\)\\s-+"
3599               ;; hour
3600               "\\([0-9]\\{2\\}\\)"
3601               ;; minute
3602               ":\\([0-9]\\{2\\}\\)"
3603               ;; second
3604               "\\(:\\([0-9]\\{2\\}\\)\\)?"
3605               ;; zone -- fixme
3606               "\\(\\s-+.*\\)?")
3607              rfc822-string)
3608         (let ((day (read (match-string 3 rfc822-string)))
3609               (month-name (match-string 4 rfc822-string))
3610               (month 0)
3611               (year (read (match-string 5 rfc822-string)))
3612               (hour (read (match-string 6 rfc822-string)))
3613               (minute (read (match-string 7 rfc822-string)))
3614               (second (read (or (match-string 9 rfc822-string)
3615                                 "0")))
3616               ;;(zone (match-string 10 rfc822-string))
3617               )
3618           (condition-case error-data
3619               (let ((i 1))
3620                 (mapc (lambda (m)
3621                         (if (string= month-name m)
3622                             (setq month i))
3623                         (setq i (1+ i)))
3624                       '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
3625                         "Sep" "Oct" "Nov" "Dec"))
3626                 (encode-time second minute hour day month year t))
3627             (error
3628              (message "Cannot decode \"%s\": %s %s" rfc822-string
3629                       (car error-data) (cdr error-data))
3630              nil))))
3631       nil))
3632
3633 (defun newsticker--lists-intersect-p (list1 list2)
3634   "Return t if LIST1 and LIST2 share elements."
3635   (let ((result nil))
3636     (mapc (lambda (elt)
3637             (if (memq elt list2)
3638                 (setq result t)))
3639           list1)
3640     result))
3641
3642 ;; ======================================================================
3643 ;;; images
3644 ;; ======================================================================
3645 (defun newsticker--image-get (feed-name url)
3646   "Get image of the news site FEED-NAME from URL.
3647 If the image has been downloaded in the last 24h do nothing."
3648   (let ((image-name (concat newsticker-imagecache-dirname "/"
3649                             feed-name)))
3650     (if (and (file-exists-p image-name)
3651              (time-less-p (current-time)
3652                           (time-add (nth 5 (file-attributes image-name))
3653                                     (seconds-to-time 86400))))
3654         (newsticker--debug-msg "%s: Getting image for %s skipped"
3655                                (format-time-string "%A, %H:%M" (current-time))
3656                                feed-name)
3657       ;; download
3658       (newsticker--debug-msg "%s: Getting image for %s"
3659                              (format-time-string "%A, %H:%M" (current-time))
3660                              feed-name)
3661       (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*"))
3662              (item (or (assoc feed-name newsticker-url-list)
3663                        (assoc feed-name newsticker-url-list-defaults)
3664                        (error
3665                         "Cannot get news for %s: Check newsticker-url-list"
3666                         feed-name)))
3667              (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
3668                                  newsticker-wget-arguments)))
3669         (save-excursion
3670           (set-buffer (get-buffer-create buffername))
3671           (erase-buffer)
3672           ;; throw an error if there is an old wget-process around
3673           (if (get-process feed-name)
3674               (error "Another wget-process is running for image %s"
3675                      feed-name))
3676           ;; start wget
3677           (let* ((args (append wget-arguments (list url)))
3678                  (proc (apply 'start-process feed-name buffername
3679                               newsticker-wget-name args)))
3680             (set-process-coding-system proc 'no-conversion 'no-conversion)
3681             (set-process-sentinel proc 'newsticker--image-sentinel)))))))
3682
3683 (defun newsticker--image-sentinel (process event)
3684   "Sentinel for image-retrieving PROCESS caused by EVENT."
3685   (let* ((p-status (process-status process))
3686          (exit-status (process-exit-status process))
3687          (feed-name (process-name process)))
3688     ;; catch known errors (zombie processes, rubbish-xml etc.
3689     ;; if an error occurs the news feed is not updated!
3690     (catch 'oops
3691       (unless (and (eq p-status 'exit)
3692                    (= exit-status 0))
3693         (message "%s: Error while retrieving image from %s"
3694                  (format-time-string "%A, %H:%M" (current-time))
3695                  feed-name)
3696         (throw 'oops nil))
3697       (let (image-name)
3698         (save-excursion
3699           (set-buffer (process-buffer process))
3700           (setq image-name (concat newsticker-imagecache-dirname "/"
3701                                    feed-name))
3702           (set-buffer-file-coding-system 'no-conversion)
3703           ;; make sure the cache dir exists
3704           (unless (file-directory-p newsticker-imagecache-dirname)
3705             (make-directory newsticker-imagecache-dirname))
3706           ;; write and close buffer
3707           (let ((require-final-newline nil)
3708                 (backup-inhibited t)
3709                 (coding-system-for-write 'no-conversion))
3710             (write-region nil nil image-name nil 'quiet))
3711           (set-buffer-modified-p nil)
3712           (kill-buffer (current-buffer)))))))
3713
3714 (defun newsticker--image-read (feed-name-symbol disabled)
3715   "Read the cached image for FEED-NAME-SYMBOL from disk.
3716 If DISABLED is non-nil the image will be converted to a disabled look
3717 \(unless `newsticker-enable-logo-manipulations' is not t\).
3718 Return the image."
3719   (let ((image-name (concat newsticker-imagecache-dirname "/"
3720                             (symbol-name feed-name-symbol)))
3721         (img nil))
3722     (when (file-exists-p image-name)
3723       (condition-case error-data
3724           (setq img (create-image
3725                      image-name nil nil
3726                      :conversion (and newsticker-enable-logo-manipulations
3727                                       disabled
3728                                       'disabled)
3729                      :mask (and newsticker-enable-logo-manipulations
3730                                 'heuristic)
3731                      :ascent 70))
3732         (error
3733          (message "Error: cannot create image: %s"
3734                   (cadr error-data)))))
3735     img))
3736
3737 ;; ======================================================================
3738 ;;; imenu stuff
3739 ;; ======================================================================
3740 (defun newsticker--imenu-create-index ()
3741   "Scan newsticker buffer and return an index for imenu."
3742   (save-excursion
3743     (goto-char (point-min))
3744     (let ((index-alist nil)
3745           (feed-list nil)
3746           (go-ahead t))
3747       (while go-ahead
3748         (let ((type  (get-text-property (point) 'nt-type))
3749               (title (get-text-property (point) 'nt-title)))
3750           (cond ((eq type 'feed)
3751                  ;; we're on a feed heading
3752                  (when feed-list
3753                    (if index-alist
3754                        (nconc index-alist (list feed-list))
3755                      (setq index-alist (list feed-list))))
3756                  (setq feed-list (list title)))
3757                 (t
3758                  (nconc feed-list
3759                         (list (cons title (point)))))))
3760         (setq go-ahead (newsticker--buffer-goto '(item feed))))
3761       (if index-alist
3762           (nconc index-alist (list feed-list))
3763         (setq index-alist (list feed-list)))
3764       index-alist)))
3765
3766 (defun newsticker--imenu-goto (name pos &rest args)
3767   "Go item NAME at position POS and show item.
3768 ARGS are ignored."
3769   (goto-char pos)
3770   (newsticker-show-entry))
3771
3772 ;; ======================================================================
3773 ;;; buffer stuff
3774 ;; ======================================================================
3775 (defun newsticker--buffer-set-uptodate (value)
3776   "Set the uptodate-status of the newsticker buffer to VALUE.
3777 The mode-line is changed accordingly."
3778   (setq newsticker--buffer-uptodate-p value)
3779   (let ((b (get-buffer "*newsticker*")))
3780     (when b
3781       (save-excursion
3782        (set-buffer b)
3783        (if value
3784            (setq mode-name "Newsticker -- up to date -- ")
3785          (setq mode-name "Newsticker -- NEED UPDATE -- ")))
3786       (sit-for 0))))
3787
3788 (defun newsticker--buffer-redraw ()
3789   "Sometimes (CVS) Emacs forgets to update the window..."
3790   (if (fboundp 'force-window-update)
3791       (force-window-update (current-buffer))
3792     (redraw-frame (selected-frame)))
3793   (run-hooks 'newsticker-buffer-change-hook)
3794   (sit-for 0))
3795
3796 (defun newsticker--buffer-insert-all-items ()
3797   "Insert all cached newsticker items into the current buffer.
3798 Keeps order of feeds as given in `newsticker-url-list' and
3799 `newsticker-url-list-defaults'."
3800   (goto-char (point-min))
3801   (mapc (lambda (url-item)
3802           (let* ((feed-name (car url-item))
3803                  (feed-name-symbol (intern feed-name))
3804                  (feed (assoc feed-name-symbol newsticker--cache))
3805                  (items (cdr feed))
3806                  (pos (point)))
3807             (when feed
3808               ;; insert the feed description
3809               (mapc (lambda (item)
3810                       (when (eq (newsticker--age item) 'feed)
3811                         (newsticker--buffer-insert-item item
3812                                                         feed-name-symbol)))
3813                     items)
3814               ;;insert the items
3815               (mapc (lambda (item)
3816                       (if (memq (newsticker--age item) '(new immortal old
3817                                                              obsolete))
3818                           (newsticker--buffer-insert-item item
3819                                                           feed-name-symbol)))
3820                     items)
3821               (put-text-property pos (point) 'feed (car feed))
3822
3823               ;; insert empty line between feeds
3824               (let ((p (point)))
3825                 (insert "\n")
3826                 (put-text-property p (point) 'hard t)))))
3827         (append newsticker-url-list newsticker-url-list-defaults))
3828
3829   (newsticker--buffer-set-faces (point-min) (point-max))
3830   (newsticker--buffer-set-invisibility (point-min) (point-max))
3831   (goto-char (point-min)))
3832
3833 (defun newsticker--buffer-insert-item (item &optional feed-name-symbol)
3834   "Insert a news item in the current buffer.
3835 Insert the string PREFIX and a formatted representation of the
3836 ITEM.  The optional parameter FEED-NAME-SYMBOL determines how the
3837 item is formatted and whether the item-retrieval time is added as
3838 well."
3839   ;; insert headline
3840   (if (eq (newsticker--age item) 'feed)
3841       (newsticker--buffer-do-insert-text item 'feed feed-name-symbol)
3842     (newsticker--buffer-do-insert-text item 'item feed-name-symbol))
3843   ;; insert the description
3844   (newsticker--buffer-do-insert-text item 'desc feed-name-symbol))
3845
3846 (defun newsticker--buffer-do-insert-text (item type feed-name-symbol)
3847   "Actually insert contents of news item, format it, render it and all that.
3848 ITEM is a news item, TYPE tells which part of the item shall be inserted,
3849 FEED-NAME-SYMBOL tells to which feed this item belongs."
3850   (let* ((pos (point))
3851          (format newsticker-desc-format)
3852          (pos-date-start nil)
3853          (pos-date-end nil)
3854          (pos-stat-start nil)
3855          (pos-stat-end nil)
3856          (pos-text-start nil)
3857          (pos-text-end nil)
3858          (pos-extra-start nil)
3859          (pos-extra-end nil)
3860          (pos-enclosure-start nil)
3861          (pos-enclosure-end nil)
3862          (age (newsticker--age item))
3863          (preformatted-contents (newsticker--preformatted-contents item))
3864          (preformatted-title (newsticker--preformatted-title item)))
3865     (cond ((and preformatted-contents
3866                 (not (eq (aref preformatted-contents 0) ?\n));; we must
3867                                                        ;; NOT have a line
3868                                                        ;; break!
3869                 (eq type 'desc))
3870            (insert preformatted-contents))
3871           ((and preformatted-title
3872                 (not (eq (aref preformatted-title 0) ?\n));; we must NOT have a
3873                                                     ;; line break!
3874                 (eq type 'item))
3875            (insert preformatted-title))
3876           (t
3877            ;; item was not formatted before.
3878            ;; Let's go.
3879            (if (eq type 'item)
3880                (setq format newsticker-item-format)
3881              (if (eq type 'feed)
3882                  (setq format newsticker-heading-format)))
3883
3884            (while (> (length format) 0)
3885              (let ((prefix (if (> (length format) 1)
3886                                (substring format 0 2)
3887                              "")))
3888                (cond ((string= "%c" prefix)
3889                       ;; contents
3890                       (when (newsticker--desc item)
3891                         (setq pos-text-start (point-marker))
3892                         (insert (newsticker--desc item))
3893                         (setq pos-text-end (point-marker)))
3894                       (setq format (substring format 2)))
3895                      ((string= "%d" prefix)
3896                       ;; date
3897                       (setq pos-date-start (point-marker))
3898                       (if (newsticker--time item)
3899                           (insert (format-time-string newsticker-date-format
3900                                                       (newsticker--time item))))
3901                       (setq pos-date-end (point-marker))
3902                       (setq format (substring format 2)))
3903                      ((string= "%l" prefix)
3904                       ;; logo
3905                       (let ((disabled (cond ((eq (newsticker--age item) 'feed)
3906                                              (= (newsticker--stat-num-items
3907                                                  feed-name-symbol 'new) 0))
3908                                             (t
3909                                              (not (eq (newsticker--age item)
3910                                                       'new))))))
3911                         (let ((img (newsticker--image-read feed-name-symbol
3912                                                            disabled)))
3913                           (when img
3914                             (newsticker--insert-image img (car item)))))
3915                       (setq format (substring format 2)))
3916                      ((string= "%L" prefix)
3917                       ;; logo or title
3918                       (let ((disabled (cond ((eq (newsticker--age item) 'feed)
3919                                              (= (newsticker--stat-num-items
3920                                                  feed-name-symbol 'new) 0))
3921                                             (t
3922                                              (not (eq (newsticker--age item)
3923                                                       'new))))))
3924                         (let ((img (newsticker--image-read feed-name-symbol
3925                                                            disabled)))
3926                           (if img
3927                               (newsticker--insert-image img (car item))
3928                             (when (car item)
3929                               (setq pos-text-start (point-marker))
3930                               (if (eq (newsticker--age item) 'feed)
3931                                   (insert (newsticker--title item))
3932                                 ;; FIXME: This is not the "real" title!
3933                                 (insert (format "%s"
3934                                                 (car (newsticker--cache-get-feed
3935                                                       feed-name-symbol)))))
3936                               (setq pos-text-end (point-marker))))))
3937                       (setq format (substring format 2)))
3938                      ((string= "%s" prefix)
3939                       ;; statistics
3940                       (setq pos-stat-start (point-marker))
3941                       (if (eq (newsticker--age item) 'feed)
3942                           (insert (newsticker--buffer-statistics
3943                                    feed-name-symbol)))
3944                       (setq pos-stat-end (point-marker))
3945                       (setq format (substring format 2)))
3946                      ((string= "%t" prefix)
3947                       ;; title
3948                       (when (car item)
3949                         (setq pos-text-start (point-marker))
3950                         (insert (car item))
3951                         (setq pos-text-end (point-marker)))
3952                       (setq format (substring format 2)))
3953                      ((string-match "%." prefix)
3954                       ;; unknown specifier!
3955                       (insert prefix)
3956                       (setq format (substring format 2)))
3957                      ((string-match "^\\([^%]*\\)\\(.*\\)" format) ;; FIXME!
3958                       ;; everything else
3959                       (let ((p (point)))
3960                         (insert (substring format
3961                                            (match-beginning 1) (match-end 1)))
3962                         ;; in case that the format string contained newlines
3963                         (put-text-property p (point) 'hard t))
3964                       (setq format (substring format (match-beginning 2)))))))
3965
3966            ;; decode HTML if possible...
3967            (let ((is-rendered-HTML nil))
3968              (when (and newsticker-html-renderer pos-text-start pos-text-end)
3969                (condition-case error-data
3970                    (save-excursion
3971                      ;; check whether it is necessary to call html renderer
3972                      ;; (regexp inspired by htmlr.el)
3973                      (goto-char pos-text-start)
3974                      (when (re-search-forward
3975                             "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" pos-text-end t)
3976                        ;; (message "%s" (newsticker--title item))
3977                        (let ((w3m-fill-column (if newsticker-use-full-width
3978                                                   -1 fill-column))
3979                              (w3-maximum-line-length
3980                               (if newsticker-use-full-width nil fill-column)))
3981                          (save-excursion
3982                            (funcall newsticker-html-renderer pos-text-start
3983                                     pos-text-end)))
3984                        (cond ((eq newsticker-html-renderer 'w3m-region)
3985                               (add-text-properties pos (point-max)
3986                                                    (list 'keymap
3987                                                          w3m-minor-mode-map)))
3988                              ((eq newsticker-html-renderer 'w3-region)
3989                               (add-text-properties pos (point-max)
3990                                                    (list 'keymap w3-mode-map))))
3991                        (setq is-rendered-HTML t)))
3992                  (error
3993                   (message "Error: HTML rendering failed: %s, %s"
3994                            (car error-data) (cdr error-data)))))
3995              (when (and newsticker-justification
3996                         (eq type 'desc)
3997                         (not is-rendered-HTML))
3998                (condition-case nil
3999                    (let ((use-hard-newlines t))
4000                      (fill-region pos (point-max) newsticker-justification))
4001                  (error nil))))
4002
4003              ;; remove leading and trailing newlines
4004            (goto-char pos)
4005            (unless (= 0 (skip-chars-forward " \t\r\n"))
4006              (delete-region pos (point)))
4007            (goto-char (point-max))
4008            (let ((end (point)))
4009              (unless (= 0 (skip-chars-backward " \t\r\n" (1+ pos)))
4010                (delete-region (point) end)))
4011            (goto-char (point-max))
4012
4013            ;; closing newline
4014            (unless nil ;;(eq pos (point))
4015              (insert "\n")
4016              (put-text-property (1- (point)) (point) 'hard t))
4017
4018            ;; insert enclosure element
4019            (when (eq type 'desc)
4020              (setq pos-enclosure-start (point))
4021              (newsticker--buffer-insert-enclosure item)
4022              (setq pos-enclosure-end (point)))
4023
4024            ;; show extra elements
4025            (when (eq type 'desc)
4026              (goto-char (point-max))
4027              (setq pos-extra-start (point))
4028              (mapc (lambda (extra-element)
4029                      (unless (memq (car extra-element)
4030                                    '(items link title description
4031                                            content:encoded
4032                                            dc:subject dc:date item guid
4033                                            pubDate
4034                                            enclosure))
4035                        (newsticker--buffer-print-extra-element
4036                         extra-element)))
4037                    (newsticker--extra item))
4038              (setq pos-extra-end (point)))
4039
4040            ;; text properties
4041            (when (memq type '(feed item))
4042              (add-text-properties pos (1- (point))
4043                                   (list 'mouse-face 'highlight
4044                                         'nt-link (newsticker--link item)
4045                                         'help-echo
4046                                         (format "mouse-2: visit item (%s)"
4047                                                 (newsticker--link item))
4048                                         'keymap newsticker--url-keymap))
4049              (add-text-properties pos (point)
4050                                   (list 'nt-title (newsticker--title item)
4051                                         'nt-desc (newsticker--desc item))))
4052
4053            (add-text-properties pos (point)
4054                                 (list 'nt-type type
4055                                       'nt-face type
4056                                       'nt-age  age
4057                                       'nt-guid (newsticker--guid item)))
4058            (when (and pos-date-start pos-date-end)
4059              (put-text-property pos-date-start pos-date-end 'nt-face 'date))
4060            (when (and pos-stat-start pos-stat-end)
4061              (put-text-property pos-stat-start pos-stat-end 'nt-face 'stat))
4062            (when (and pos-extra-start pos-extra-end)
4063              (put-text-property pos-extra-start pos-extra-end
4064                                 'nt-face 'extra)
4065              (put-text-property pos-extra-start pos-extra-end
4066                                 'nt-type 'extra))
4067            (when (and pos-enclosure-start pos-enclosure-end
4068                       (> pos-enclosure-end pos-enclosure-start))
4069              (put-text-property pos-enclosure-start (1- pos-enclosure-end)
4070                                 'nt-face 'enclosure))
4071
4072            ;; left margin
4073            ;;(unless (memq type '(feed item))
4074            ;;(set-left-margin pos (1- (point)) 1))
4075
4076            ;; save rendered stuff
4077            (cond ((eq type 'desc)
4078                   ;; preformatted contents
4079                   (newsticker--cache-set-preformatted-contents
4080                    item (buffer-substring pos (point))))
4081                   ((eq type 'item)
4082                    ;; preformatted title
4083                    (newsticker--cache-set-preformatted-title
4084                     item (buffer-substring pos (point)))))))))
4085
4086 (defun newsticker--buffer-print-extra-element (extra-element)
4087   "Insert EXTRA-ELEMENT in a pretty form into the current buffer."
4088   (insert (format "%s:\t" (car extra-element)))
4089   (let (;;(attributes (cadr extra-element)) ;FIXME!!!!
4090         (contents (cddr extra-element)))
4091     (cond ((listp contents)
4092            (mapc (lambda (i)
4093                    (if (and (stringp i)
4094                             (string-match "^http://.*" i))
4095                        (let ((pos (point)))
4096                          (insert i " ") ; avoid self-reference from the
4097                                         ; nt-link thing
4098                          (add-text-properties
4099                           pos (point)
4100                           (list 'mouse-face 'highlight
4101                                 'nt-link i
4102                                 'help-echo
4103                                 (format "mouse-2: visit (%s)" i)
4104                                 'keymap newsticker--url-keymap)))
4105                          (insert (format "%s" i))))
4106                  contents))
4107           (t
4108            (insert (format "%s" contents))))
4109     (insert "\n")))
4110
4111 (defun newsticker--buffer-insert-enclosure (item)
4112   "Insert enclosure element of an RSS ITEM into the current buffer."
4113   (let ((enclosure (newsticker--enclosure item))
4114         (beg (point)))
4115     (when enclosure
4116       (let ((url (cdr (assoc 'url enclosure)))
4117             (length (cdr (assoc 'length enclosure)))
4118             (type (cdr (assoc 'type enclosure))))
4119         (insert (format "Enclosed file (%s, %1.2f kBytes)" type
4120                         (/ (string-to-number length) 1024)))
4121         (add-text-properties beg (point)
4122                              (list 'mouse-face 'highlight
4123                                    'nt-link url
4124                                    'help-echo (format
4125                                                "mouse-2: visit (%s)" url)
4126                                    'keymap newsticker--url-keymap
4127                                    'nt-face 'enclosure
4128                                    'nt-type 'desc))
4129         (insert "\n")))))
4130
4131 (defun newsticker--buffer-statistics (feed-name-symbol)
4132   "Return a statistic string for the feed given by FEED-NAME-SYMBOL.
4133 See `newsticker-statistics-format'."
4134   (let ((case-fold-search nil))
4135     (replace-regexp-in-string
4136      "%a"
4137      (format "%d" (newsticker--stat-num-items feed-name-symbol))
4138      (replace-regexp-in-string
4139       "%i"
4140       (format "%d" (newsticker--stat-num-items feed-name-symbol 'immortal))
4141       (replace-regexp-in-string
4142        "%n"
4143        (format "%d" (newsticker--stat-num-items feed-name-symbol 'new))
4144        (replace-regexp-in-string
4145         "%o"
4146         (format "%d" (newsticker--stat-num-items feed-name-symbol 'old))
4147         (replace-regexp-in-string
4148          "%O"
4149          (format "%d" (newsticker--stat-num-items feed-name-symbol 'obsolete))
4150          newsticker-statistics-format)))))))
4151
4152 (defun newsticker--buffer-set-faces (start end)
4153   "Add face properties according to mark property.
4154 Scans the buffer between START and END."
4155   (save-excursion
4156     ;;(put-text-property start end 'face 'newsticker-default-face)
4157     (goto-char start)
4158     (let ((pos1 start)
4159           (pos2 1)
4160           (nt-face (get-text-property start 'nt-face))
4161           (nt-age (get-text-property start 'nt-age)))
4162       (when nt-face
4163         (setq pos2 (next-single-property-change (point) 'nt-face))
4164         (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
4165         (setq nt-face (get-text-property pos2 'nt-face))
4166         (setq pos1 pos2))
4167       (while (and (setq pos2 (next-single-property-change pos1 'nt-face))
4168                   (<= pos2 end)
4169                   (> pos2 pos1))
4170         (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
4171         (setq nt-face (get-text-property pos2 'nt-face))
4172         (setq nt-age (get-text-property pos2 'nt-age))
4173         (setq pos1 pos2)))))
4174
4175 (defun newsticker--buffer-set-invisibility (start end)
4176   "Add invisibility properties according to nt-type property.
4177 Scans the buffer between START and END.  Sets the 'invisible
4178 property to '(<nt-type>-<nt-age> <nt-type> <nt-age>)."
4179   (save-excursion
4180     ;; reset invisibility settings
4181     (put-text-property start end 'invisible nil)
4182     ;; let's go
4183     (goto-char start)
4184     (let ((pos1 start)
4185           (pos2 1)
4186           (nt-type (get-text-property start 'nt-type))
4187           (nt-age (get-text-property start 'nt-age)))
4188       (when nt-type
4189         (setq pos2 (next-single-property-change (point) 'nt-type))
4190         (put-text-property (max (point-min) pos1) (1- pos2)
4191                            'invisible
4192                            (list (intern
4193                                   (concat
4194                                    (symbol-name
4195                                     (if (eq nt-type 'extra) 'desc nt-type))
4196                                    "-"
4197                                    (symbol-name nt-age)))
4198                                  nt-type
4199                                  nt-age))
4200         (setq nt-type (get-text-property pos2 'nt-type))
4201         (setq pos1 pos2))
4202       (while (and (setq pos2 (next-single-property-change pos1 'nt-type))
4203                   (<= pos2 end)
4204                   (> pos2 pos1))
4205         ;; must shift one char to the left in order to handle inivisible
4206         ;; newlines, motion in invisible text areas and all that correctly
4207         (put-text-property (1- pos1) (1- pos2)
4208                            'invisible
4209                            (list (intern
4210                                   (concat
4211                                    (symbol-name
4212                                     (if (eq nt-type 'extra) 'desc nt-type))
4213                                    "-"
4214                                    (symbol-name nt-age)))
4215                                  nt-type
4216                                  nt-age))
4217         (setq nt-type (get-text-property pos2 'nt-type))
4218         (setq nt-age (get-text-property pos2 'nt-age))
4219         (setq pos1 pos2)))))
4220
4221 (defun newsticker--set-face-properties (pos1 pos2 nt-face age)
4222   "Set the face for the text between the positions POS1 and POS2.
4223 The face is chosen according the values of NT-FACE and AGE."
4224   (let ((face (cond ((eq nt-face 'feed)
4225                      'newsticker-feed-face)
4226                     ((eq nt-face 'item)
4227                      (cond ((eq age 'new)
4228                             'newsticker-new-item-face)
4229                            ((eq age 'old)
4230                             'newsticker-old-item-face)
4231                            ((eq age 'immortal)
4232                             'newsticker-immortal-item-face)
4233                            ((eq age 'obsolete)
4234                             'newsticker-obsolete-item-face)))
4235                     ((eq nt-face 'date)
4236                      'newsticker-date-face)
4237                     ((eq nt-face 'stat)
4238                      'newsticker-statistics-face)
4239                     ((eq nt-face 'extra)
4240                      'newsticker-extra-face)
4241                     ((eq nt-face 'enclosure)
4242                      'newsticker-enclosure-face))))
4243     (when face
4244       (put-text-property pos1 (max pos1 pos2) 'face face))))
4245
4246 (defun newsticker--insert-image (img string)
4247   "Insert IMG with STRING at point.
4248 This is a work-around for a strange behavior of Emacs versions before
4249 21.3.50.  Images inserted with `insert-image' vanished after doing
4250 `fill-region'."
4251   ;; This should work:
4252   ;;(insert-image img string)
4253   ;; but it does not. Therefore we do this, which should be equivalent!
4254   (let ((pos (point)))
4255     ;;(insert string)
4256     (insert ":-)")
4257     (add-text-properties pos (point) (list 'display img))))
4258
4259 ;; ======================================================================
4260 ;;; HTML rendering
4261 ;; ======================================================================
4262 (defun newsticker-htmlr-render (pos1 pos2) ;
4263   "Replacement for `htmlr-render'.
4264 Renders the HTML code in the region POS1 to POS2 using htmlr."
4265   (let ((str (buffer-substring-no-properties pos1 pos2)))
4266     (delete-region pos1 pos2)
4267     (insert
4268      (with-temp-buffer
4269        (insert str)
4270        (goto-char (point-min))
4271        ;; begin original htmlr-render
4272        (htmlr-reset)
4273        ;; something omitted here...
4274        (while (< (point) (point-max))
4275          (htmlr-step))
4276        ;; end original htmlr-render
4277        (newsticker--remove-whitespace (buffer-string))))))
4278
4279 ;; ======================================================================
4280 ;;; Functions working on the *newsticker* buffer
4281 ;; ======================================================================
4282 (defun newsticker--buffer-make-item-completely-visible ()
4283   "Scroll buffer until current item is completely visible."
4284   (switch-to-buffer (get-buffer-create "*newsticker*"))
4285   (when newsticker--auto-narrow-to-feed
4286     (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-feed))
4287                     (point-min)))
4288            (max (or (save-excursion (newsticker--buffer-end-of-feed))
4289                     (point-max))))
4290       (narrow-to-region min max)))
4291   (when newsticker--auto-narrow-to-item
4292     (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-item))
4293                     (point-min)))
4294            (max (or (save-excursion (newsticker--buffer-end-of-item))
4295                     (point-max))))
4296       (narrow-to-region min max)))
4297   (sit-for 0)
4298   ;; do not count lines and stuff because that does not work when images
4299   ;; are displayed. Do it the simple way:
4300   (save-excursion
4301     (newsticker--buffer-end-of-item)
4302     (unless (pos-visible-in-window-p)
4303       (recenter -1)))
4304   (unless (pos-visible-in-window-p)
4305     (recenter 0)))
4306
4307 (defun newsticker--buffer-get-feed-title-at-point ()
4308   "Return feed symbol of headline at point."
4309   (format "%s" (or (get-text-property (point) 'feed) " ")))
4310
4311 (defun newsticker--buffer-get-item-title-at-point ()
4312   "Return feed symbol of headline at point."
4313   (format "%s" (or (get-text-property (point) 'nt-title) " ")))
4314
4315 (defun newsticker--buffer-goto (types &optional age backwards)
4316   "Search next occurrence of TYPES in current buffer.
4317 TYPES is a list of symbols.  If TYPES is found point is moved, if
4318 not point is left unchanged.  If optional parameter AGE is not
4319 nil, the type AND the age must match.  If BACKWARDS is t, search
4320 backwards."
4321   (let ((pos (save-excursion
4322                (save-restriction
4323                  (widen)
4324                  (catch 'found
4325                    (let ((tpos (point)))
4326                      (while (setq tpos
4327                                   (if backwards
4328                                       (if (eq tpos (point-min))
4329                                           nil
4330                                         (or (previous-single-property-change
4331                                              tpos 'nt-type)
4332                                             (point-min)))
4333                                     (next-single-property-change
4334                                      tpos 'nt-type)))
4335                        (and (memq (get-text-property tpos 'nt-type) types)
4336                             (or (not age)
4337                                 (eq (get-text-property tpos 'nt-age) age))
4338                             (throw 'found tpos)))))))))
4339     (when pos
4340       (goto-char pos))
4341     pos))
4342
4343 (defun newsticker--buffer-hideshow (mark-age onoff )
4344   "Hide or show items of type MARK-AGE.
4345 If ONOFF is nil the item is hidden, otherwise it is shown."
4346   (if onoff
4347       (remove-from-invisibility-spec mark-age )
4348     (add-to-invisibility-spec mark-age)))
4349
4350 (defun newsticker--buffer-beginning-of-item ()
4351   "Move point to the beginning of the item at point.
4352 Return new position."
4353   (if (bobp)
4354       (point)
4355     (let ((type (get-text-property (point) 'nt-type))
4356           (typebefore (get-text-property (1- (point)) 'nt-type)))
4357       (if (and (memq type '(item feed))
4358                    (not (eq type typebefore)))
4359           (point)
4360         (newsticker--buffer-goto '(item feed) nil t)
4361         (point)))))
4362
4363 (defun newsticker--buffer-beginning-of-feed ()
4364   "Move point to the beginning of the feed at point.
4365 Return new position."
4366   (if (bobp)
4367       (point)
4368     (let ((type (get-text-property (point) 'nt-type))
4369           (typebefore (get-text-property (1- (point)) 'nt-type)))
4370       (if (and (memq type '(feed))
4371                    (not (eq type typebefore)))
4372           (point)
4373         (newsticker--buffer-goto '(feed) nil t)
4374         (point)))))
4375
4376 (defun newsticker--buffer-end-of-item ()
4377   "Move point to the end of the item at point.
4378 Take care: end of item is at the end of its last line!"
4379   (when (newsticker--buffer-goto '(item feed nil))
4380     (point)))
4381
4382 (defun newsticker--buffer-end-of-feed ()
4383   "Move point to the end of the last item of the feed at point.
4384 Take care: end of item is at the end of its last line!"
4385   (when (newsticker--buffer-goto '(feed nil))
4386     (backward-char 1)
4387     (point)))
4388
4389 ;; ======================================================================
4390 ;;; manipulation of ticker text
4391 ;; ======================================================================
4392 (defun newsticker--ticker-text-setup ()
4393   "Build the ticker text which is scrolled or flashed in the echo area."
4394   ;; reset scrollable text
4395   (setq newsticker--scrollable-text "")
4396   (setq newsticker--item-list nil)
4397   (setq newsticker--item-position 0)
4398   ;; build scrollable text from cache data
4399   (let ((have-something nil))
4400     (mapc
4401      (lambda (feed)
4402        (let ((feed-name (symbol-name (car feed))))
4403          (let ((num-new (newsticker--stat-num-items (car feed) 'new))
4404                (num-old (newsticker--stat-num-items (car feed) 'old))
4405                (num-imm (newsticker--stat-num-items (car feed) 'immortal))
4406                (num-obs (newsticker--stat-num-items (car feed) 'obsolete)))
4407            (when (or (> num-new 0)
4408                      (and (> num-old 0)
4409                           (not newsticker-hide-old-items-in-echo-area))
4410                      (and (> num-imm 0)
4411                           (not newsticker-hide-immortal-items-in-echo-area))
4412                      (and (> num-obs 0)
4413                           (not newsticker-hide-obsolete-items-in-echo-area)))
4414              (setq have-something t)
4415              (mapc
4416               (lambda (item)
4417                 (let ((title (replace-regexp-in-string
4418                               "[\r\n]+" " "
4419                               (newsticker--title item)))
4420                       (age (newsticker--age item)))
4421                   (unless (string= title newsticker--error-headline)
4422                     (when
4423                         (or (eq age 'new)
4424                             (and (eq age 'old)
4425                                  (not newsticker-hide-old-items-in-echo-area))
4426                             (and (eq age 'obsolete)
4427                                  (not
4428                                   newsticker-hide-obsolete-items-in-echo-area))
4429                             (and (eq age 'immortal)
4430                                  (not
4431                                   newsticker-hide-immortal-items-in-echo-area)))
4432                       (setq title (newsticker--remove-whitespace title))
4433                       ;; add to flash list
4434                       (add-to-list 'newsticker--item-list
4435                                    (concat feed-name ": " title) t)
4436                       ;; and to the scrollable text
4437                       (setq newsticker--scrollable-text
4438                             (concat newsticker--scrollable-text
4439                                     " " feed-name ": " title " +++"))))))
4440                 (cdr feed))))))
4441      newsticker--cache)
4442     (when have-something
4443       (setq newsticker--scrollable-text
4444             (concat "+++ "
4445                     (format-time-string "%A, %H:%M"
4446                                         newsticker--latest-update-time)
4447                     " ++++++" newsticker--scrollable-text)))))
4448
4449 (defun newsticker--ticker-text-remove (feed title)
4450   "Remove the item of FEED with TITLE from the ticker text."
4451   ;; reset scrollable text
4452   (setq newsticker--item-position 0)
4453   (let ((feed-name (symbol-name feed))
4454         (t-title (replace-regexp-in-string "[\r\n]+" " " title)))
4455     ;; remove from flash list
4456     (setq newsticker--item-list (remove (concat feed-name ": " t-title)
4457                                         newsticker--item-list))
4458     ;; and from the scrollable text
4459     (setq newsticker--scrollable-text
4460           (replace-regexp-in-string
4461            (regexp-quote (concat " " feed-name ": " t-title " +++"))
4462            ""
4463            newsticker--scrollable-text))
4464     (if (string-match (concat "^\\+\\+\\+ [A-Z][a-z]+, "
4465                               "[012]?[0-9]:[0-9][0-9] \\+\\+\\+\\+\\+\\+$")
4466                               newsticker--scrollable-text)
4467         (setq newsticker--scrollable-text ""))))
4468
4469 ;; ======================================================================
4470 ;;; manipulation of cached data
4471 ;; ======================================================================
4472 (defun newsticker--cache-set-preformatted-contents (item contents)
4473   "Set preformatted contents of ITEM to CONTENTS."
4474   (if (nthcdr 6 item)
4475       (setcar (nthcdr 6 item) contents)
4476     (setcdr (nthcdr 5 item) (list contents))))
4477
4478 (defun newsticker--cache-set-preformatted-title (item title)
4479   "Set preformatted title of ITEM to TITLE."
4480   (if (nthcdr 7 item)
4481       (setcar (nthcdr 7 item) title)
4482     (setcdr (nthcdr 6 item) title)))
4483
4484 (defun newsticker--cache-replace-age (data feed old-age new-age)
4485   "Mark all items in DATA in FEED which carry age OLD-AGE with NEW-AGE.
4486 If FEED is 'any it applies to all feeds.  If OLD-AGE is 'any,
4487 all marks are replaced by NEW-AGE.  Removes all pre-formatted contents."
4488   (mapc (lambda (a-feed)
4489           (when (or (eq feed 'any)
4490                     (eq (car a-feed) feed))
4491             (let ((items (cdr a-feed)))
4492               (mapc (lambda (item)
4493                       (when (or (eq old-age 'any)
4494                                 (eq (newsticker--age item) old-age))
4495                         (setcar (nthcdr 4 item) new-age)
4496                         (newsticker--do-forget-preformatted item)))
4497                     items))))
4498         data)
4499   data)
4500
4501 (defun newsticker--cache-mark-expired (data feed old-age new-age time)
4502   "Mark all expired entries.
4503 This function sets the age entries in DATA in the feed FEED.  If
4504 an item's age is OLD-AGE it is set to NEW-AGE if the item is
4505 older than TIME."
4506   (mapc
4507    (lambda (a-feed)
4508      (when (or (eq feed 'any)
4509                (eq (car a-feed) feed))
4510        (let ((items (cdr a-feed)))
4511          (mapc
4512           (lambda (item)
4513             (when (eq (newsticker--age item) old-age)
4514               (let ((exp-time (time-add (newsticker--time item)
4515                                         (seconds-to-time time))))
4516                 (when (time-less-p exp-time (current-time))
4517                   (newsticker--debug-msg
4518                    "Item `%s' from %s has expired on %s"
4519                    (newsticker--title item)
4520                    (format-time-string "%Y-%02m-%d, %H:%M"
4521                                        (newsticker--time item))
4522                    (format-time-string "%Y-%02m-%d, %H:%M" exp-time))
4523                   (setcar (nthcdr 4 item) new-age)))))
4524           items))))
4525    data)
4526   data)
4527
4528 (defun newsticker--cache-contains (data feed title desc link age
4529                                         &optional guid)
4530   "Check DATA whether FEED contains an item with the given properties.
4531 This function returns the contained item or nil if it is not
4532 contained.
4533 The properties which are checked are TITLE, DESC, LINK, AGE, and
4534 GUID.  In general all properties must match in order to return a
4535 certain item, except for the following cases.
4536
4537 If AGE equals 'feed the TITLE, DESCription and LINK do not
4538 matter. If DESC is nil it is ignored as well.  If
4539 `newsticker-desc-comp-max' is non-nil, only the first
4540 `newsticker-desc-comp-max' characters of DESC are taken into
4541 account.
4542
4543 If GUID is non-nil it is sufficient to match this value, and the
4544 other properties are ignored."
4545   (condition-case nil
4546       (catch 'found
4547         (when (and desc newsticker-desc-comp-max
4548                    (> (length desc) newsticker-desc-comp-max))
4549           (setq desc (substring desc 0 newsticker-desc-comp-max)))
4550         (mapc
4551          (lambda (this-feed)
4552            (when (eq (car this-feed) feed)
4553              (mapc (lambda (anitem)
4554                      (when (or
4555                             ;; global unique id can match
4556                             (and guid
4557                                  (string= guid (newsticker--guid anitem)))
4558                             ;; or title, desc, etc.
4559                             (and
4560                              ;;(or (not (eq age 'feed))
4561                              ;;  (eq (newsticker--age anitem) 'feed))
4562                              (string= (newsticker--title anitem)
4563                                       title)
4564                              (or (not link)
4565                                  (string= (newsticker--link anitem)
4566                                           link))
4567                              (or (not desc)
4568                                  (if (and desc newsticker-desc-comp-max
4569                                           (> (length (newsticker--desc anitem))
4570                                              newsticker-desc-comp-max))
4571                                      (string= (substring
4572                                                (newsticker--desc anitem)
4573                                                0 newsticker-desc-comp-max)
4574                                               desc)
4575                                    (string= (newsticker--desc anitem)
4576                                             desc)))))
4577                        (throw 'found anitem)))
4578                    (cdr this-feed))))
4579          data)
4580         nil)
4581     (error nil)))
4582
4583 (defun newsticker--cache-add (data feed-name-symbol title desc link time age
4584                                    position extra-elements
4585                                    &optional updated-age updated-time
4586                                    preformatted-contents
4587                                    preformatted-title)
4588   "Add another item to cache data.
4589 Add to DATA in the FEED-NAME-SYMBOL an item with TITLE, DESC,
4590 LINK, TIME, AGE, POSITION, and EXTRA-ELEMENTS.  If this item is
4591 contained already, its mark is set to UPDATED-AGE, its time is
4592 set to UPDATED-TIME, and its pre-formatted contents is set to
4593 PREFORMATTED-CONTENTS and PREFORMATTED-TITLE.  Returns the age
4594 which the item got."
4595   (let ((item (newsticker--cache-contains data feed-name-symbol title
4596                                           desc link age)))
4597     (if item
4598       ;; does exist already -- change age, update time and position
4599         (progn
4600           (if (nthcdr 5 item)
4601               (setcar (nthcdr 5 item) position)
4602             (setcdr (nthcdr 4 item) (list position)))
4603           (setcar (nthcdr 4 item) updated-age)
4604           (if updated-time
4605               (setcar (nthcdr 3 item) updated-time))
4606           ;; replace cached pre-formatted contents
4607           (newsticker--cache-set-preformatted-contents
4608            item preformatted-contents)
4609           (newsticker--cache-set-preformatted-title
4610            item preformatted-title))
4611       ;; did not exist or age equals 'feed-name-symbol
4612       (catch 'found
4613         (mapc (lambda (this-feed)
4614                 (when (eq (car this-feed) feed-name-symbol)
4615                   (setcdr this-feed (nconc (cdr this-feed)
4616                                            (list (list title desc link
4617                                                        time age position
4618                                                        preformatted-contents
4619                                                        preformatted-title
4620                                                        extra-elements))))
4621                   (throw 'found this-feed)))
4622               data)
4623         ;; the feed is not contained
4624         (add-to-list 'data (list feed-name-symbol
4625                                  (list title desc link time age position
4626                                        preformatted-contents
4627                                        preformatted-title
4628                                        extra-elements))
4629                      t))))
4630   data)
4631
4632 (defun newsticker--cache-remove (data feed-symbol age)
4633   "Remove all entries from DATA in the feed FEED-SYMBOL with AGE.
4634 FEED-SYMBOL may be 'any.  Entries from old feeds, which are no longer in
4635 `newsticker-url-list' or `newsticker-url-list-defaults', are removed as
4636 well."
4637   (let* ((pos data)
4638          (feed (car pos))
4639          (last-pos nil))
4640     (while feed
4641       (if (or (assoc (symbol-name (car feed)) newsticker-url-list)
4642               (assoc (symbol-name (car feed)) newsticker-url-list-defaults))
4643           ;; feed is still valid=active
4644           ;; (message "Keeping feed %s" (car feed))
4645           (if  (or (eq feed-symbol 'any)
4646                    (eq feed-symbol (car feed)))
4647               (let* ((item-pos (cdr feed))
4648                      (item (car item-pos))
4649                      (prev-pos nil))
4650                 (while item
4651                   ;;(message "%s" (car item))
4652                   (if (eq age (newsticker--age item))
4653                       ;; remove this item
4654                       (progn
4655                         ;;(message "Removing item %s" (car item))
4656                         (if prev-pos
4657                             (setcdr prev-pos (cdr item-pos))
4658                           (setcdr feed (cdr item-pos))))
4659                     ;;(message "Keeping item %s" (car item))
4660                     (setq prev-pos item-pos))
4661                   (setq item-pos (cdr item-pos))
4662                   (setq item (car item-pos)))))
4663         ;; feed is not active anymore
4664         ;; (message "Removing feed %s" (car feed))
4665         (if last-pos
4666             (setcdr last-pos (cdr pos))
4667           (setq data (cdr pos))))
4668       (setq last-pos pos)
4669       (setq pos (cdr pos))
4670       (setq feed (car pos)))))
4671
4672 ;; ======================================================================
4673 ;;; Sorting
4674 ;; ======================================================================
4675 (defun newsticker--cache-item-compare-by-time (item1 item2)
4676   "Compare two news items ITEM1 and ITEM2 by comparing their time values."
4677   (catch 'result
4678     (let ((age1 (newsticker--age item1))
4679           (age2 (newsticker--age item2)))
4680       (if (not (eq age1 age2))
4681           (cond ((eq age1 'obsolete)
4682                  (throw 'result nil))
4683                 ((eq age2 'obsolete)
4684                  (throw 'result t)))))
4685     (let* ((time1 (newsticker--time item1))
4686            (time2 (newsticker--time item2)))
4687       (cond ((< (nth 0 time1) (nth 0 time2))
4688              nil)
4689             ((> (nth 0 time1) (nth 0 time2))
4690              t)
4691             ((< (nth 1 time1) (nth 1 time2))
4692              nil)
4693             ((> (nth 1 time1) (nth 1 time2))
4694              t)
4695             ((< (or (nth 2 time1) 0) (or (nth 2 time2) 0))
4696              nil)
4697             ((> (or (nth 2 time1) 0) (or (nth 2 time2) 0))
4698              t)
4699             (t
4700              nil)))))
4701
4702 (defun newsticker--cache-item-compare-by-title (item1 item2)
4703   "Compare ITEM1 and ITEM2 by comparing their titles."
4704   (catch 'result
4705     (let ((age1 (newsticker--age item1))
4706           (age2 (newsticker--age item2)))
4707       (if (not (eq age1 age2))
4708           (cond ((eq age1 'obsolete)
4709                  (throw 'result nil))
4710                 ((eq age2 'obsolete)
4711                  (throw 'result t)))))
4712     (string< (newsticker--title item1) (newsticker--title item2))))
4713
4714 (defun newsticker--cache-item-compare-by-position (item1 item2)
4715   "Compare ITEM1 and ITEM2 by comparing their original positions."
4716   (catch 'result
4717     (let ((age1 (newsticker--age item1))
4718           (age2 (newsticker--age item2)))
4719       (if (not (eq age1 age2))
4720           (cond ((eq age1 'obsolete)
4721                  (throw 'result nil))
4722                 ((eq age2 'obsolete)
4723                  (throw 'result t)))))
4724     (< (or (newsticker--pos item1) 0) (or (newsticker--pos item2) 0))))
4725
4726 (defun newsticker--cache-sort ()
4727   "Sort the newsticker cache data."
4728   (let ((sort-fun (cond ((eq newsticker-sort-method 'sort-by-time)
4729                          'newsticker--cache-item-compare-by-time)
4730                         ((eq newsticker-sort-method 'sort-by-title)
4731                          'newsticker--cache-item-compare-by-title)
4732                         ((eq newsticker-sort-method 'sort-by-original-order)
4733                          'newsticker--cache-item-compare-by-position))))
4734     (mapc (lambda (feed-list)
4735             (setcdr feed-list (sort (cdr feed-list)
4736                                     sort-fun)))
4737           newsticker--cache)))
4738
4739 (defun newsticker--cache-update (&optional save)
4740   "Update newsticker cache file.
4741 If optional argument SAVE is not nil the cache file is saved to disk."
4742   (save-excursion
4743     (let ((coding-system-for-write 'utf-8)
4744           (buf (find-file-noselect newsticker-cache-filename)))
4745       (when buf
4746         (set-buffer buf)
4747         (setq buffer-undo-list t)
4748         (erase-buffer)
4749         (insert ";; -*- coding: utf-8 -*-\n")
4750         (insert (prin1-to-string newsticker--cache))
4751         (when save
4752           (save-buffer))))))
4753
4754 (defun newsticker--cache-get-feed (feed)
4755   "Return the cached data for the feed FEED.
4756 FEED is a symbol!"
4757   (assoc feed newsticker--cache))
4758
4759 ;; ======================================================================
4760 ;;; Statistics
4761 ;; ======================================================================
4762 (defun newsticker--stat-num-items (feed &optional age)
4763   "Return number of items in the given FEED which have the given AGE.
4764 If AGE is nil, the total number items is returned."
4765   (let ((items (cdr (newsticker--cache-get-feed feed)))
4766         (num 0))
4767     (while items
4768       (if age
4769           (if (eq (newsticker--age (car items)) age)
4770               (setq num (1+ num)))
4771         (if (memq (newsticker--age (car items)) '(new old immortal obsolete))
4772               (setq num (1+ num))))
4773       (setq items (cdr items)))
4774     num))
4775
4776 ;; ======================================================================
4777 ;;; OPML
4778 ;; ======================================================================
4779 (defun newsticker-opml-export ()
4780   "OPML subscription export.
4781 Export subscriptions to a buffer in OPML Format."
4782   (interactive)
4783   (with-current-buffer (get-buffer-create "*OPML Export*")
4784     (set-buffer-file-coding-system 'utf-8)
4785     (insert (concat
4786              "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
4787              "<!-- OPML generated by Emacs newsticker.el -->\n"
4788              "<opml version=\"1.0\">\n"
4789              "  <head>\n"
4790              "    <title>mySubscriptions</title>\n"
4791              "    <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
4792              "</dateCreated>\n"
4793              "    <ownerEmail>" user-mail-address "</ownerEmail>\n"
4794              "    <ownerName>" (user-full-name) "</ownerName>\n"
4795              "  </head>\n"
4796              "  <body>\n"))
4797     (mapc (lambda (sub)
4798             (insert "    <outline text=\"")
4799             (insert (newsticker--title sub))
4800             (insert "\" xmlUrl=\"")
4801             (insert (cadr sub))
4802             (insert "\"/>\n"))
4803           (append newsticker-url-list newsticker-url-list-defaults))
4804     (insert "  </body>\n</opml>\n"))
4805   (pop-to-buffer "*OPML Export*")
4806   (when (fboundp 'sgml-mode)
4807     (sgml-mode)))
4808
4809 (defun newsticker-opml-import (filename)
4810   "Import OPML data from FILENAME."
4811   (interactive "fOPML file: ")
4812   (set-buffer (find-file-noselect filename))
4813   (goto-char (point-min))
4814   (let* ((node-list (xml-parse-region (point-min) (point-max)))
4815          (body (car (xml-get-children (car node-list) 'body)))
4816          (outlines (xml-get-children body 'outline)))
4817     (mapc (lambda (outline)
4818             (let ((name (xml-get-attribute outline 'text))
4819                   (url (xml-get-attribute outline 'xmlUrl)))
4820               (add-to-list 'newsticker-url-list
4821                            (list name url nil nil nil) t)))
4822           outlines))
4823   (customize-variable 'newsticker-url-list))
4824
4825 ;; ======================================================================
4826 ;;; Auto marking
4827 ;; ======================================================================
4828 (defun newsticker--run-auto-mark-filter (feed item)
4829   "Automatically mark an item as old or immortal.
4830 This function checks the variable `newsticker-auto-mark-filter'
4831 for an entry that matches FEED and ITEM."
4832  (let ((case-fold-search t))
4833     (mapc (lambda (filter)
4834             (let ((filter-feed (car filter))
4835                   (old-list (nth 1 filter))
4836                   (imm-list (nth 2 filter)))
4837             (when (string-match filter-feed feed)
4838               (newsticker--do-run-auto-mark-filter item 'old old-list)
4839               (newsticker--do-run-auto-mark-filter item 'immortal imm-list))))
4840           newsticker-auto-mark-filter)))
4841
4842 (defun newsticker--do-run-auto-mark-filter (item age list)
4843   "Actually compare ITEM AGE LIST against `newsticker-auto-mark-filter'."
4844   (mapc (lambda (pattern)
4845           (when (string-match pattern (newsticker--title item))
4846             (setcar (nthcdr 4 item) age)))
4847         list))
4848
4849
4850 ;; ======================================================================
4851 ;;; hook samples
4852 ;; ======================================================================
4853 (defun newsticker-new-item-functions-sample (feed item)
4854   "Demonstrate the use of the `newsticker-new-item-functions' hook.
4855 This function just prints out the values of the FEED and title of the ITEM."
4856   (message (concat "newsticker-new-item-functions-sample: feed=`%s', "
4857                    "title=`%s'")
4858            feed (newsticker--title item)))
4859
4860 (defun newsticker-download-images (feed item)
4861   "Download the first image.
4862 If FEED equals \"imagefeed\" download the first image URL found
4863 in the description=contents of ITEM to the directory
4864 \"~/tmp/newsticker/FEED/TITLE\" where TITLE is the title of the item."
4865   (when (string= feed "imagefeed")
4866     (let ((title (newsticker--title item))
4867           (desc (newsticker--desc item)))
4868       (when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc)
4869         (let ((url (substring desc (match-beginning 1) (match-end 1)))
4870               (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
4871               (org-dir default-directory))
4872           (unless (file-directory-p temp-dir)
4873             (make-directory temp-dir t))
4874           (cd temp-dir)
4875           (message "Getting image %s" url)
4876           (apply 'start-process "wget-image"
4877                  " *newsticker-wget-download-images*"
4878                  newsticker-wget-name
4879                  (list url))
4880           (cd org-dir))))))
4881
4882 (defun newsticker-download-enclosures (feed item)
4883   "In all FEEDs download the enclosed object of the news ITEM.
4884 The object is saved to the directory \"~/tmp/newsticker/FEED/TITLE\", which
4885 is created if it does not exist. TITLE is the title of the news
4886 item. Argument FEED is ignored.
4887 This function is suited for adding it to `newsticker-new-item-functions'."
4888   (let ((title (newsticker--title item))
4889         (enclosure (newsticker--enclosure item)))
4890     (when enclosure
4891       (let ((url (cdr (assoc 'url enclosure)))
4892             (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
4893             (org-dir default-directory))
4894         (unless (file-directory-p temp-dir)
4895           (make-directory temp-dir t))
4896         (cd temp-dir)
4897         (message "Getting enclosure %s" url)
4898         (apply 'start-process "wget-enclosure"
4899                " *newsticker-wget-download-enclosures*"
4900                newsticker-wget-name
4901                (list url))
4902         (cd org-dir)))))
4903
4904
4905 (provide 'newsticker)
4906
4907 ;; arch-tag: ab761dfa-67bc-4207-bc64-4307271dc381
4908 ;;; newsticker.el ends here