lisp/net/newsticker.el

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