lisp/net/newsticker.el

   1 ;;; newsticker.el --- A Newsticker for Emacs.
   2
   3 ;; Copyright (C) 2003, 2004, 2005, 2006 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 ;;; Newsticker status
 396 ;; ======================================================================
 397
 398 (defvar newsticker--retrieval-timer-list nil
 399   "List of timers for news retrieval.
 400 This is an alist, each element consisting of (feed-name . timer).")
 401
 402 (defvar newsticker--display-timer nil
 403   "Timer for newsticker display.")
 404
 405 ;;;###autoload
 406 (defun newsticker-running-p ()
 407   "Check whether newsticker is running.
 408 Return t if newsticker is running, nil otherwise.  Newsticker is
 409 considered to be running if the newsticker timer list is not empty."
 410   (> (length newsticker--retrieval-timer-list) 0))
 411
 412 ;;;###autoload
 413 (defun newsticker-ticker-running-p ()
 414   "Check whether newsticker's actual ticker is running.
 415 Return t if ticker is running, nil otherwise.  Newsticker is
 416 considered to be running if the newsticker timer list is not
 417 empty."
 418   (timerp newsticker--display-timer))
 419
 420 ;; ======================================================================
 421 ;;; Customizables
 422 ;; ======================================================================
 423 (defgroup newsticker nil
 424   "Aggregator for RSS and Atom feeds."
 425   :group 'applications)
 426
 427 (defconst newsticker--raw-url-list-defaults
 428   '(("CNET News.com"
 429      "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
 430     ("Debian Security Advisories"
 431     "http://www.debian.org/security/dsa.en.rdf")
 432     ("Debian Security Advisories - Long format"
 433     "http://www.debian.org/security/dsa-long.en.rdf")
 434     ("Emacs Wiki"
 435     "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
 436     nil
 437     3600)
 438     ("Freshmeat.net"
 439     "http://freshmeat.net/backend/fm.rdf")
 440     ("Kuro5hin.org"
 441     "http://www.kuro5hin.org/backend.rdf")
 442     ("LWN (Linux Weekly News)"
 443     "http://lwn.net/headlines/rss")
 444     ("NewsForge"
 445     "http://newsforge.com/index.rss")
 446     ("NY Times: Technology"
 447     "http://partners.userland.com/nytRss/technology.xml")
 448     ("NY Times"
 449     "http://partners.userland.com/nytRss/nytHomepage.xml")
 450     ("Quote of the day"
 451     "http://www.quotationspage.com/data/qotd.rss"
 452     "07:00"
 453     86400)
 454     ("The Register"
 455     "http://www.theregister.co.uk/tonys/slashdot.rdf")
 456     ("slashdot"
 457     "http://slashdot.org/index.rss"
 458     nil
 459     3600)                        ;/. will ban you if under 3600 seconds!
 460     ("Wired News"
 461     "http://www.wired.com/news_drop/netcenter/netcenter.rdf")
 462     ("Heise News (german)"
 463     "http://www.heise.de/newsticker/heise.rdf")
 464     ("Tagesschau (german)"
 465     "http://www.tagesschau.de/newsticker.rdf"
 466     nil
 467     1800)
 468     ("Telepolis (german)"
 469     "http://www.heise.de/tp/news.rdf"))
 470   "Default URL list in raw form.
 471 This list is fed into defcustom via `newsticker--splicer'.")
 472
 473 (defun newsticker--splicer (item)
 474   "Convert ITEM for splicing into `newsticker-url-list-defaults'."
 475   (let ((result (list 'list :tag (nth 0 item) (list 'const (nth 0 item))))
 476         (element (cdr item)))
 477     (while element
 478       (setq result (append result (list (list 'const (car element)))))
 479       (setq element (cdr element)))
 480     result))
 481
 482 ;; ======================================================================
 483 ;;; Customization
 484 ;; ======================================================================
 485 (defun newsticker--set-customvar (symbol value)
 486   "Set newsticker-variable SYMBOL value to VALUE.
 487
 488 Calls all actions which are necessary in order to make the new
 489 value effective.  Changing `newsticker-url-list', for example,
 490 will re-start the retrieval-timers."
 491   (unless (condition-case nil
 492               (eq (symbol-value symbol) value)
 493             (error nil))
 494     (set symbol value)
 495     (cond ((eq symbol 'newsticker-sort-method)
 496            (when (fboundp 'newsticker--cache-sort)
 497              (message "Applying new sort method...")
 498              (newsticker--cache-sort)
 499              (newsticker--buffer-set-uptodate nil)
 500              (message "Applying new sort method...done")))
 501           ((memq symbol '(newsticker-url-list-defaults
 502                           newsticker-url-list
 503                           newsticker-retrieval-interval))
 504            (when (and (fboundp 'newsticker-running-p)
 505                       (newsticker-running-p))
 506              (message "Restarting newsticker")
 507              (newsticker-stop)
 508              (newsticker-start)))
 509           ((eq symbol 'newsticker-display-interval)
 510            (when (and (fboundp 'newsticker-running-p)
 511                       (newsticker-running-p))
 512              (message "Restarting ticker")
 513              (newsticker-stop-ticker)
 514              (newsticker-start-ticker)
 515              (message "")))
 516           ((memq symbol '(newsticker-hide-old-items-in-echo-area
 517                           newsticker-hide-obsolete-items-in-echo-area
 518                           newsticker-hide-immortal-items-in-echo-area))
 519            (when (and (fboundp 'newsticker-running-p)
 520                       (newsticker-running-p))
 521              (message "Restarting newsticker")
 522              (newsticker-stop-ticker)
 523              (newsticker--ticker-text-setup)
 524              (newsticker-start-ticker)
 525              (message "")))
 526           ((memq symbol '(newsticker-hide-old-items-in-newsticker-buffer
 527                           newsticker-show-descriptions-of-new-items))
 528            (when (fboundp 'newsticker--buffer-set-uptodate)
 529              (newsticker--buffer-set-uptodate nil)))
 530           ((memq symbol '(newsticker-heading-format
 531                           newsticker-item-format
 532                           newsticker-desc-format
 533                           newsticker-date-format
 534                           newsticker-statistics-format
 535                           newsticker-justification
 536                           newsticker-use-full-width
 537                           newsticker-html-renderer
 538                           newsticker-feed-face
 539                           newsticker-new-item-face
 540                           newsticker-old-item-face
 541                           newsticker-immortal-item-face
 542                           newsticker-obsolete-item-face
 543                           newsticker-date-face
 544                           newsticker-statistics-face
 545                           ;;newsticker-default-face
 546                           ))
 547            (when (fboundp 'newsticker--forget-preformatted)
 548              (newsticker--forget-preformatted)))
 549           (t
 550            (error "Ooops %s" symbol)))))
 551
 552 ;; customization group feed
 553 (defgroup newsticker-feed nil
 554   "Settings for news feeds."
 555   :group 'newsticker)
 556
 557 (defcustom newsticker-url-list-defaults
 558  '(("Emacs Wiki"
 559     "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
 560     nil
 561     3600))
 562   "A customizable list of news feeds to select from.
 563 These were mostly extracted from the Radio Community Server at
 564 http://subhonker6.userland.com/rcsPublic/rssHotlist.
 565
 566 You may add other entries in `newsticker-url-list'."
 567   :type `(set ,@(mapcar `newsticker--splicer
 568                         newsticker--raw-url-list-defaults))
 569   :set 'newsticker--set-customvar
 570   :group 'newsticker-feed)
 571
 572 (defcustom newsticker-url-list nil
 573   "The news feeds which you like to watch.
 574
 575 This alist will be used in addition to selection made customizing
 576 `newsticker-url-list-defaults'.
 577
 578 This is an alist.  Each element consists of two items: a LABEL and a URL,
 579 optionally followed by a START-TIME, INTERVAL specifier and WGET-ARGUMENTS.
 580
 581 The LABEL gives the name of the news feed.  It can be an arbitrary string.
 582
 583 The URL gives the location of the news feed.  It must point to a valid
 584 RSS or Atom file.  The file is retrieved by calling wget, or whatever you
 585 specify as `newsticker-wget-name'.
 586
 587 The START-TIME can be either a string, or nil.  If it is a string it
 588 specifies a fixed time at which this feed shall be retrieved for the
 589 first time.  (Examples: \"11:00pm\", \"23:00\".)  If it is nil (or
 590 unspecified), this feed will be retrieved immediately after calling
 591 `newsticker-start'.
 592
 593 The INTERVAL specifies the time between retrievals for this feed.  If it
 594 is nil (or unspecified) the default interval value as set in
 595 `newsticker-retrieval-interval' is used.
 596
 597 \(newsticker.el calls `run-at-time'. The newsticker-parameters START-TIME
 598 and INTERVAL correspond to the `run-at-time'-parameters TIME and REPEAT.)
 599
 600 WGET-ARGUMENTS specifies arguments for wget (see `newsticker-wget-name')
 601 which apply for this feed only, overriding the value of
 602 `newsticker-wget-arguments'."
 603   :type '(repeat (list :tag "News feed"
 604                        (string :tag "Label")
 605                        (string :tag "URI")
 606                        (choice :tag "Start"
 607                                (const   :tag "Default" nil)
 608                                (string  :tag "Fixed Time"))
 609                        (choice :tag "Interval"
 610                                (const   :tag "Default" nil)
 611                                (const   :tag "Hourly" 3600)
 612                                (const   :tag "Daily" 86400)
 613                                (const   :tag "Weekly" 604800)
 614                                (integer :tag "Interval"))
 615                        (choice :tag "Wget Arguments"
 616                                (const  :tag "Default arguments" nil)
 617                                (repeat :tag "Special arguments" string))))
 618   :set 'newsticker--set-customvar
 619   :group 'newsticker-feed)
 620
 621 (defcustom newsticker-wget-name
 622   "wget"
 623   "Name of the program which is called to retrieve news from the web.
 624 The canonical choice is wget but you may take any other program which is
 625 able to return the contents of a news feed file on stdout."
 626   :type 'string
 627   :group 'newsticker-feed)
 628
 629 (defcustom newsticker-wget-arguments
 630   '("-q" "-O" "-")
 631   "Arguments which are passed to wget.
 632 There is probably no reason to change the default settings, unless you
 633 are living behind a firewall."
 634   :type '(repeat (string :tag "Argument"))
 635   :group 'newsticker-feed)
 636
 637 (defcustom newsticker-retrieval-interval
 638   3600
 639   "Time interval for retrieving new news items (seconds).
 640 If this value is not positive (i.e. less than or equal to 0)
 641 items are retrieved only once!
 642 Please note that some feeds, e.g. Slashdot, will ban you if you
 643 make it less than 1800 seconds (30 minutes)!"
 644   :type '(choice :tag "Interval"
 645                  (const   :tag "No automatic retrieval" 0)
 646                  (const   :tag "Hourly" 3600)
 647                  (const   :tag "Daily" 86400)
 648                  (const   :tag "Weekly" 604800)
 649                  (integer :tag "Interval"))
 650   :set 'newsticker--set-customvar
 651   :group 'newsticker-feed)
 652
 653 (defcustom newsticker-desc-comp-max
 654   100
 655   "Relevant length of headline descriptions.
 656 This value gives the maximum number of characters which will be
 657 taken into account when newsticker compares two headline
 658 descriptions."
 659   :type 'integer
 660   :group 'newsticker-feed)
 661
 662 ;; customization group behaviour
 663 (defgroup newsticker-headline-processing nil
 664   "Settings for the automatic processing of headlines."
 665   :group 'newsticker)
 666
 667 (defcustom newsticker-automatically-mark-items-as-old
 668   t
 669   "Decides whether to automatically mark items as old.
 670 If t a new item is considered as new only after its first retrieval.  As
 671 soon as it is retrieved a second time, it becomes old.  If not t all
 672 items stay new until you mark them as old.  This is done in the
 673 *newsticker* buffer."
 674   :type 'boolean
 675   :group 'newsticker-headline-processing)
 676
 677 (defcustom newsticker-automatically-mark-visited-items-as-old
 678   t
 679   "Decides whether to automatically mark visited items as old.
 680 If t an item is marked as old as soon as the associated link is
 681 visited, i.e. after pressing RET or mouse2 on the item's
 682 headline."
 683
 684   :type 'boolean
 685   :group 'newsticker-headline-processing)
 686
 687 (defcustom newsticker-keep-obsolete-items
 688   t
 689   "Decides whether to keep unread items which have been removed from feed.
 690 If t a new item, which has been removed from the feed, is kept in
 691 the cache until it is marked as read."
 692   :type 'boolean
 693   :group 'newsticker-headline-processing)
 694
 695 (defcustom newsticker-obsolete-item-max-age
 696   (* 60 60 24)
 697   "Maximal age of obsolete items, in seconds.
 698 Obsolete items which are older than this value will be silently
 699 deleted at the next retrieval."
 700   :type 'integer
 701   :group 'newsticker-headline-processing)
 702
 703 (defcustom newsticker-auto-mark-filter-list
 704   nil
 705   "A list of filters for automatically marking headlines.
 706
 707 This is an alist of the form (FEED-NAME PATTERN-LIST).  I.e. each
 708 element consists of a FEED-NAME a PATTERN-LIST.  Each element of
 709 the pattern-list has the form (AGE TITLE-OR-DESCRIPTION REGEXP).
 710 AGE must be one of the symbols 'old or 'immortal.
 711 TITLE-OR-DESCRIPTION must be on of the symbols 'title,
 712 'description, or 'all.  REGEXP is a regular expression, i.e. a
 713 string.
 714
 715 This filter is checked after a new headline has been retrieved.
 716 If FEED-NAME matches the name of the corresponding news feed, the
 717 pattern-list is checked: The new headline will be marked as AGE
 718 if REGEXP matches the headline's TITLE-OR-DESCRIPTION.
 719
 720 If, for example, `newsticker-auto-mark-filter-list' looks like
 721  \((slashdot ('old 'title \"^Forget me!$\") ('immortal 'title \"Read me\")
 722   \('immortal 'all \"important\"))))
 723
 724 then all articles from slashdot are marked as old if they have
 725 the title \"Forget me!\".  All articles with a title containing
 726 the string \"Read me\" are marked as immortal.  All articles which
 727 contain the string \"important\" in their title or their
 728 description are marked as immortal."
 729   :type '(repeat (list :tag "Auto mark filter"
 730                        (string :tag "Feed name")
 731                        (repeat
 732                         (list :tag "Filter element"
 733                               (choice
 734                                :tag "Auto-assigned age"
 735                                (const :tag "Old" old)
 736                                (const :tag "Immortal" immortal))
 737                               (choice
 738                                :tag "Title/Description"
 739                                (const :tag "Title" title)
 740                                (const :tag "Description" description)
 741                                (const :tag "All" all))
 742                               (string :tag "Regexp")))))
 743   :group 'newsticker-headline-processing)
 744
 745 ;; customization group layout
 746 (defgroup newsticker-layout nil
 747   "Settings for layout of the feed reader."
 748   :group 'newsticker)
 749
 750 (defcustom newsticker-sort-method
 751   'sort-by-original-order
 752   "Sort method for news items.
 753 The following sort methods are available:
 754 * `sort-by-original-order' keeps the order in which the items
 755   appear in the headline file (please note that for immortal items,
 756   which have been removed from the news feed, there is no original
 757   order),
 758 * `sort-by-time' looks at the time at which an item has been seen
 759   the first time.  The most recent item is put at top,
 760 * `sort-by-title' will put the items in an alphabetical order."
 761   :type '(choice
 762           (const :tag "Keep original order" sort-by-original-order)
 763           (const :tag "Sort by time"        sort-by-time)
 764           (const :tag "Sort by title"       sort-by-title))
 765   :set 'newsticker--set-customvar
 766   :group 'newsticker-layout)
 767
 768 (defcustom newsticker-hide-old-items-in-newsticker-buffer
 769   nil
 770   "Decides whether to automatically hide old items in the *newsticker* buffer.
 771 If set to t old items will be completely folded and only new
 772 items will show up in the *newsticker* buffer.  Otherwise old as
 773 well as new items will be visible."
 774   :type 'boolean
 775   :set 'newsticker--set-customvar
 776   :group 'newsticker-layout)
 777
 778 (defcustom newsticker-show-descriptions-of-new-items
 779   t
 780   "Whether to automatically show descriptions of new items in *newsticker*.
 781 If set to t old items will be folded and new items will be
 782 unfolded.  Otherwise old as well as new items will be folded."
 783   :type 'boolean
 784   :set 'newsticker--set-customvar
 785   :group 'newsticker-layout)
 786
 787 (defcustom newsticker-heading-format
 788   "%l
 789 %t %d %s"
 790   "Format string for feed headings.
 791 The following printf-like specifiers can be used:
 792 %d  The date the feed was retrieved.  See `newsticker-date-format'.
 793 %l  The logo (image) of the feed.  Most news feeds provide a small
 794     image as logo.  Newsticker can display them, if Emacs can --
 795     see `image-types' for a list of supported image types.
 796 %L  The logo (image) of the feed.  If the logo is not available
 797     the title of the feed is used.
 798 %s  The statistical data of the feed.  See `newsticker-statistics-format'.
 799 %t  The title of the feed, i.e. its name."
 800   :type 'string
 801   :set 'newsticker--set-customvar
 802   :group 'newsticker-layout)
 803
 804 (defcustom newsticker-item-format
 805   "%t %d"
 806   "Format string for news item headlines.
 807 The following printf-like specifiers can be used:
 808 %d  The date the item was (first) retrieved.  See `newsticker-date-format'.
 809 %l  The logo (image) of the feed.  Most news feeds provide a small
 810     image as logo.  Newsticker can display them, if Emacs can --
 811     see `image-types' for a list of supported image types.
 812 %L  The logo (image) of the feed.  If the logo is not available
 813     the title of the feed is used.
 814 %t  The title of the item."
 815   :type 'string
 816   :set 'newsticker--set-customvar
 817   :group 'newsticker-layout)
 818
 819 (defcustom newsticker-desc-format
 820   "%d %c"
 821   "Format string for news descriptions (contents).
 822 The following printf-like specifiers can be used:
 823 %c  The contents (description) of the item.
 824 %d  The date the item was (first) retrieved.  See
 825     `newsticker-date-format'."
 826   :type 'string
 827   :set 'newsticker--set-customvar
 828   :group 'newsticker-layout)
 829
 830 (defcustom newsticker-date-format
 831   "(%A, %H:%M)"
 832   "Format for the date part in item and feed lines.
 833 See `format-time-string' for a list of valid specifiers."
 834   :type 'string
 835   :set 'newsticker--set-customvar
 836   :group 'newsticker-layout)
 837
 838 (defcustom newsticker-statistics-format
 839   "[%n + %i + %o + %O = %a]"
 840   "Format for the statistics part in feed lines.
 841 The following printf-like specifiers can be used:
 842 %a  The number of all items in the feed.
 843 %i  The number of immortal items in the feed.
 844 %n  The number of new items in the feed.
 845 %o  The number of old items in the feed.
 846 %O  The number of obsolete items in the feed."
 847   :type 'string
 848   :set 'newsticker--set-customvar
 849   :group 'newsticker-layout)
 850
 851 (defcustom newsticker-show-all-news-elements
 852   nil
 853   "Show all news elements."
 854   :type 'boolean
 855   ;;:set 'newsticker--set-customvar
 856   :group 'newsticker-layout)
 857
 858 ;; image related things
 859 (defcustom newsticker-enable-logo-manipulations
 860   t
 861   "If non-nil newsticker manipulates logo images.
 862 This enables the following image properties: heuristic mask for all
 863 logos, and laplace-conversion for images without new items."
 864   :type 'boolean
 865   :group 'newsticker-layout)
 866
 867
 868 ;; rendering
 869 (defcustom newsticker-justification
 870   'left
 871   "How to fill item descriptions.
 872 If non-nil newsticker calls `fill-region' to wrap long lines in
 873 item descriptions.  However, if an item description contains HTML
 874 text and `newsticker-html-renderer' is non-nil, filling is not
 875 done."
 876   :type '(choice :tag "Justification"
 877                  (const :tag "No filling" nil)
 878                  (const :tag "Left"       left)
 879                  (const :tag "Right"      right)
 880                  (const :tag "Center"     center)
 881                  (const :tag "Full"       full))
 882   :set 'newsticker--set-customvar
 883   :group 'newsticker-layout)
 884
 885 (defcustom newsticker-use-full-width
 886   t
 887   "Decides whether to use the full window width when filling.
 888 If non-nil newsticker sets `fill-column' so that the whole
 889 window is used when filling.  See also `newsticker-justification'."
 890   :type 'boolean
 891   :set 'newsticker--set-customvar
 892   :group 'newsticker-layout)
 893
 894 (defcustom newsticker-html-renderer
 895   nil
 896   "Function for rendering HTML contents.
 897 If non-nil, newsticker.el will call this function whenever it finds
 898 HTML-like tags in item descriptions.  Possible functions are, for
 899 example, `w3m-region', `w3-region', and (if you have htmlr.el installed)
 900 `newsticker-htmlr-render'.
 901
 902 In order to make sure that the HTML renderer is loaded when you
 903 run newsticker, you should add one of the following statements to
 904 your .emacs.  If you use w3m,
 905
 906   (autoload 'w3m-region \"w3m\"
 907     \"Render region in current buffer and replace with result.\" t)
 908
 909 or, if you use w3,
 910
 911   (require 'w3-auto)
 912
 913 or, if you use htmlr
 914
 915   (require 'htmlr)"
 916   :type '(choice :tag "Function"
 917                  (const :tag "None" nil)
 918                  (const :tag "w3" w3-region)
 919                  (const :tag "w3m" w3m-region)
 920                  (const :tag "htmlr" newsticker-htmlr-render))
 921   :set 'newsticker--set-customvar
 922   :group 'newsticker-layout)
 923
 924
 925 ;; faces
 926 (defgroup newsticker-faces nil
 927   "Settings for the faces of the feed reader."
 928   :group 'newsticker-layout)
 929
 930 (defface newsticker-feed-face
 931   '((((class color) (background dark))
 932      (:family "helvetica" :bold t :height 1.2 :foreground "misty rose"))
 933     (((class color) (background light))
 934      (:family "helvetica" :bold t :height 1.2 :foreground "black")))
 935   "Face for news feeds."
 936   :group 'newsticker-faces)
 937
 938 (defface newsticker-new-item-face
 939   '((((class color) (background dark))
 940      (:family "helvetica" :bold t))
 941     (((class color) (background light))
 942      (:family "helvetica" :bold t)))
 943   "Face for news items."
 944   :group 'newsticker-faces)
 945
 946 (defface newsticker-old-item-face
 947   '((((class color) (background dark))
 948      (:family "helvetica" :bold t :foreground "orange3"))
 949     (((class color) (background light))
 950      (:family "helvetica" :bold t :foreground "red4")))
 951   "Face for old news items."
 952   :group 'newsticker-faces)
 953
 954 (defface newsticker-immortal-item-face
 955   '((((class color) (background dark))
 956      (:family "helvetica" :bold t :italic t :foreground "orange"))
 957     (((class color) (background light))
 958      (:family "helvetica" :bold t :italic t :foreground "blue")))
 959   "Face for immortal news items."
 960   :group 'newsticker-faces)
 961
 962 (defface newsticker-obsolete-item-face
 963   '((((class color) (background dark))
 964      (:family "helvetica" :bold t :strike-through t))
 965     (((class color) (background light))
 966      (:family "helvetica" :bold t :strike-through t)))
 967   "Face for old news items."
 968   :group 'newsticker-faces)
 969
 970 (defface newsticker-date-face
 971   '((((class color) (background dark))
 972      (:family "helvetica" :italic t :height 0.8))
 973     (((class color) (background light))
 974      (:family "helvetica" :italic t :height 0.8)))
 975   "Face for newsticker dates."
 976   :group 'newsticker-faces)
 977
 978 (defface newsticker-statistics-face
 979   '((((class color) (background dark))
 980      (:family "helvetica" :italic t :height 0.8))
 981     (((class color) (background light))
 982      (:family "helvetica" :italic t :height 0.8)))
 983   "Face for newsticker dates."
 984   :group 'newsticker-faces)
 985
 986 (defface newsticker-enclosure-face
 987   '((((class color) (background dark))
 988      (:bold t :background "orange"))
 989     (((class color) (background light))
 990      (:bold t :background "orange")))
 991   "Face for enclosed elements."
 992   :group 'newsticker-faces)
 993
 994 (defface newsticker-extra-face
 995   '((((class color) (background dark))
 996      (:italic t :foreground "gray50" :height 0.8))
 997     (((class color) (background light))
 998      (:italic t :foreground "gray50" :height 0.8)))
 999   "Face for newsticker dates."
1000   :group 'newsticker-faces)
1001
1002 ;; (defface newsticker-default-face
1003 ;;   '((((class color) (background dark))
1004 ;;      (:inherit default))
1005 ;;     (((class color) (background light))
1006 ;;      (:inherit default)))
1007 ;;   "Face for the description of news items."
1008 ;;   ;;:set 'newsticker--set-customvar
1009 ;;   :group 'newsticker-faces)
1010
1011
1012 ;; customization group ticker
1013 (defgroup newsticker-ticker nil
1014   "Settings for the headline ticker."
1015   :group 'newsticker)
1016
1017 (defcustom newsticker-display-interval
1018   0.3
1019   "Time interval for displaying news items in the echo area (seconds).
1020 If equal or less than 0 no messages are shown in the echo area.  For
1021 smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
1022 reasonable.  For non-smooth display a value of 10 is a good starting
1023 point."
1024   :type 'number
1025   :set 'newsticker--set-customvar
1026   :group 'newsticker-ticker)
1027
1028 (defcustom newsticker-scroll-smoothly
1029   t
1030   "Decides whether to flash or scroll news items.
1031 If t the news headlines are scrolled (more-or-less) smoothly in the echo
1032 area.  If nil one headline after another is displayed in the echo area.
1033 The variable `newsticker-display-interval' determines how fast this
1034 display moves/changes and whether headlines are shown in the echo area
1035 at all.  If you change `newsticker-scroll-smoothly' you should also change
1036 `newsticker-display-interval'."
1037   :type 'boolean
1038   :group 'newsticker-ticker)
1039
1040 (defcustom newsticker-hide-immortal-items-in-echo-area
1041   t
1042   "Decides whether to show immortal/non-expiring news items in the ticker.
1043 If t the echo area will not show immortal items.  See also
1044 `newsticker-hide-old-items-in-echo-area'."
1045   :type 'boolean
1046   :set 'newsticker--set-customvar
1047   :group 'newsticker-ticker)
1048
1049 (defcustom newsticker-hide-old-items-in-echo-area
1050   t
1051   "Decides whether to show only the newest news items in the ticker.
1052 If t the echo area will show only new items, i.e. only items which have
1053 been added between the last two retrievals."
1054   :type 'boolean
1055   :set 'newsticker--set-customvar
1056   :group 'newsticker-ticker)
1057
1058 (defcustom newsticker-hide-obsolete-items-in-echo-area
1059   t
1060   "Decides whether to show obsolete items items in the ticker.
1061 If t the echo area will not show obsolete items.  See also
1062 `newsticker-hide-old-items-in-echo-area'."
1063   :type 'boolean
1064   :set 'newsticker--set-customvar
1065   :group 'newsticker-ticker)
1066
1067 (defgroup newsticker-hooks nil
1068   "Settings for newsticker hooks."
1069   :group 'newsticker)
1070
1071 (defcustom newsticker-start-hook
1072   nil
1073   "Hook run when starting newsticker.
1074 This hook is run at the very end of `newsticker-start'."
1075   :options '(newsticker-start-ticker)
1076   :type 'hook
1077   :group 'newsticker-hooks)
1078
1079 (defcustom newsticker-stop-hook
1080   nil
1081   "Hook run when stopping newsticker.
1082 This hook is run at the very end of `newsticker-stop'."
1083   :options nil
1084   :type 'hook
1085   :group 'newsticker-hooks)
1086
1087 (defcustom newsticker-new-item-functions
1088   nil
1089   "List of functions run after a new headline has been retrieved.
1090 Each function is called with the following three arguments:
1091 FEED  the name of the corresponding news feed,
1092 TITLE the title of the headline,
1093 DESC  the decoded description of the headline.
1094
1095 See `newsticker-download-images', and
1096 `newsticker-download-enclosures' for sample functions.
1097
1098 Please note that these functions are called only once for a
1099 headline after it has been retrieved for the first time."
1100   :type 'hook
1101   :options '(newsticker-download-images
1102              newsticker-download-enclosures)
1103   :group 'newsticker-hooks)
1104
1105 (defcustom newsticker-select-item-hook
1106   'newsticker--buffer-make-item-completely-visible
1107   "List of functions run after a headline has been selected.
1108 Each function is called after one of `newsticker-next-item',
1109 `newsticker-next-new-item', `newsticker-previous-item',
1110 `newsticker-previous-new-item' has been called.
1111
1112 The default value 'newsticker--buffer-make-item-completely-visible
1113 assures that the current item is always completely visible."
1114   :type 'hook
1115   :options '(newsticker--buffer-make-item-completely-visible)
1116   :group 'newsticker-hooks)
1117
1118 (defcustom newsticker-select-feed-hook
1119   'newsticker--buffer-make-item-completely-visible
1120   "List of functions run after a feed has been selected.
1121 Each function is called after one of `newsticker-next-feed', and
1122 `newsticker-previous-feed' has been called.
1123
1124 The default value 'newsticker--buffer-make-item-completely-visible
1125 assures that the current feed is completely visible."
1126   :type 'hook
1127   :options '(newsticker--buffer-make-item-completely-visible)
1128   :group 'newsticker-hooks)
1129
1130 (defcustom newsticker-buffer-change-hook
1131   'newsticker-w3m-show-inline-images
1132   "List of functions run after the newsticker buffer has been updated.
1133 Each function is called after `newsticker-buffer-update' has been called.
1134
1135 The default value '`newsticker-w3m-show-inline-images' loads inline
1136 images."
1137   :type 'hook
1138   :group 'newsticker-hooks)
1139
1140 (defcustom newsticker-narrow-hook
1141   'newsticker-w3m-show-inline-images
1142   "List of functions run after narrowing in newsticker buffer has changed.
1143 Each function is called after
1144 `newsticker-toggle-auto-narrow-to-feed' or
1145 `newsticker-toggle-auto-narrow-to-item' has been called.
1146
1147 The default value '`newsticker-w3m-show-inline-images' loads inline
1148 images."
1149   :type 'hook
1150   :group 'newsticker-hooks)
1151
1152 (defgroup newsticker-miscellaneous nil
1153   "Miscellaneous newsticker settings."
1154   :group 'newsticker)
1155
1156 (defcustom newsticker-cache-filename
1157   "~/.newsticker-cache"
1158   "Name of the newsticker cache file."
1159   :type 'string
1160   :group 'newsticker-miscellaneous)
1161
1162 (defcustom newsticker-imagecache-dirname
1163   "~/.newsticker-images"
1164   "Name of the directory where newsticker stores cached images."
1165   :type 'string
1166   :group 'newsticker-miscellaneous)
1167
1168 ;; debugging
1169 (defcustom newsticker-debug
1170   nil
1171   "Enables some features needed for debugging newsticker.el.
1172
1173 If set to t newsticker.el will print lots of debugging messages, and the
1174 buffers *newsticker-wget-<feed>* will not be closed."
1175   :type 'boolean
1176   ;;:set 'newsticker--set-customvar
1177   :group 'newsticker-miscellaneous)
1178
1179 ;; ======================================================================
1180 ;;; Compatibility section, XEmacs, Emacs
1181 ;; ======================================================================
1182 (unless (fboundp 'time-add)
1183   (require 'time-date);;FIXME
1184   (defun time-add (t1 t2)
1185     (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))
1186
1187 (unless (fboundp 'match-string-no-properties)
1188   (defalias 'match-string-no-properties 'match-string))
1189
1190 (unless (fboundp 'replace-regexp-in-string)
1191   (defun replace-regexp-in-string (re rp st)
1192     (save-match-data ;; apparently XEmacs needs save-match-data
1193       (replace-in-string st re rp))))
1194
1195 ;; copied from subr.el
1196 (unless (fboundp 'add-to-invisibility-spec)
1197   (defun add-to-invisibility-spec (arg)
1198     "Add elements to `buffer-invisibility-spec'.
1199 See documentation for `buffer-invisibility-spec' for the kind of elements
1200 that can be added."
1201     (if (eq buffer-invisibility-spec t)
1202         (setq buffer-invisibility-spec (list t)))
1203     (setq buffer-invisibility-spec
1204           (cons arg buffer-invisibility-spec))))
1205
1206 ;; copied from subr.el
1207 (unless (fboundp 'remove-from-invisibility-spec)
1208   (defun remove-from-invisibility-spec (arg)
1209     "Remove elements from `buffer-invisibility-spec'."
1210     (if (consp buffer-invisibility-spec)
1211         (setq buffer-invisibility-spec
1212               (delete arg buffer-invisibility-spec)))))
1213
1214 ;; ======================================================================
1215 ;;; Internal variables
1216 ;; ======================================================================
1217 (defvar newsticker--item-list nil
1218   "List of newsticker items.")
1219 (defvar newsticker--item-position 0
1220   "Actual position in list of newsticker items.")
1221 (defvar newsticker--prev-message "There was no previous message yet!"
1222   "Last message that the newsticker displayed.")
1223 (defvar newsticker--scrollable-text ""
1224   "The text which is scrolled smoothly in the echo area.")
1225 (defvar newsticker--buffer-uptodate-p nil
1226   "Tells whether the newsticker buffer is up to date.")
1227 (defvar newsticker--latest-update-time (current-time)
1228   "The time at which the latest news arrived.")
1229 (defvar newsticker--process-ids nil
1230   "List of PIDs of active newsticker processes.")
1231
1232 (defvar newsticker--cache nil "Cached newsticker data.
1233 This is a list of the form
1234
1235  ((label1
1236    (title description link time age index preformatted-contents
1237     preformatted-title)
1238    ...)
1239   (label2
1240    (title description link time age index preformatted-contents
1241     preformatted-title)
1242    ...)
1243   ...)
1244
1245 where LABEL is a symbol.  TITLE, DESCRIPTION, and LINK are
1246 strings.  TIME is a time value as returned by `current-time'.
1247 AGE is a symbol: 'new, 'old, 'immortal, and 'obsolete denote
1248 ordinary news items, whereas 'feed denotes an item which is not a
1249 headline but describes the feed itself.  INDEX denotes the
1250 original position of the item -- used for restoring the original
1251 order.  PREFORMATTED-CONTENTS and PREFORMATTED-TITLE hold the
1252 formatted contents of the item's description and title.  This
1253 speeds things up if HTML rendering is used, which is rather
1254 slow.")
1255
1256 (defvar newsticker--auto-narrow-to-feed nil
1257   "Automatically narrow to current news feed.
1258 If non-nil only the items of the current news feed are visible.")
1259
1260 (defvar newsticker--auto-narrow-to-item nil
1261   "Automatically narrow to current news item.
1262 If non-nil only the current headline is visible.")
1263
1264 (defconst newsticker--error-headline
1265   "[COULD NOT DOWNLOAD HEADLINES!]"
1266   "Title of error headline which will be inserted if news retrieval fails.")
1267
1268 ;; ======================================================================
1269 ;;; Toolbar
1270 ;; ======================================================================
1271 (defconst newsticker--next-item-image
1272   (if (fboundp 'create-image)
1273       (create-image "/* XPM */
1274 static char * next_xpm[] = {
1275 \"24 24 42 1\",
1276 \"      c None\",
1277 \".     c #000000\",
1278 \"+     c #7EB6DE\",
1279 \"@     c #82BBE2\",
1280 \"#     c #85BEE4\",
1281 \"$     c #88C1E7\",
1282 \"%     c #8AC3E8\",
1283 \"&     c #87C1E6\",
1284 \"*     c #8AC4E9\",
1285 \"=     c #8CC6EA\",
1286 \"-     c #8CC6EB\",
1287 \";     c #88C2E7\",
1288 \">     c #8BC5E9\",
1289 \",     c #8DC7EB\",
1290 \"'     c #87C0E6\",
1291 \")     c #8AC4E8\",
1292 \"!     c #8BC5EA\",
1293 \"~     c #8BC4E9\",
1294 \"{     c #88C1E6\",
1295 \"]     c #89C3E8\",
1296 \"^     c #86BFE5\",
1297 \"/     c #83BBE2\",
1298 \"(     c #82BBE1\",
1299 \"_     c #86C0E5\",
1300 \":     c #87C0E5\",
1301 \"<     c #83BCE2\",
1302 \"[     c #81B9E0\",
1303 \"}     c #81BAE1\",
1304 \"|     c #78B0D9\",
1305 \"1     c #7BB3DB\",
1306 \"2     c #7DB5DD\",
1307 \"3     c #7DB6DD\",
1308 \"4     c #72A9D4\",
1309 \"5     c #75ACD6\",
1310 \"6     c #76AED7\",
1311 \"7     c #77AFD8\",
1312 \"8     c #6BA1CD\",
1313 \"9     c #6EA4CF\",
1314 \"0     c #6FA6D1\",
1315 \"a     c #6298C6\",
1316 \"b     c #659BC8\",
1317 \"c     c #5C91C0\",
1318 \"                        \",
1319 \"                        \",
1320 \"       .                \",
1321 \"       ..               \",
1322 \"       .+.              \",
1323 \"       .@#.             \",
1324 \"       .#$%.            \",
1325 \"       .&*=-.           \",
1326 \"       .;>,,,.          \",
1327 \"       .;>,,,=.         \",
1328 \"       .')!==~;.        \",
1329 \"       .#{]*%;^/.       \",
1330 \"       .(#_':#<.        \",
1331 \"       .+[@</}.         \",
1332 \"       .|1232.          \",
1333 \"       .4567.           \",
1334 \"       .890.            \",
1335 \"       .ab.             \",
1336 \"       .c.              \",
1337 \"       ..               \",
1338 \"       .                \",
1339 \"                        \",
1340 \"                        \",
1341 \"                        \"};
1342 "
1343                  'xpm t)
1344    "Image for the next item button."))
1345
1346 (defconst newsticker--previous-item-image
1347   (if (fboundp 'create-image)
1348       (create-image "/* XPM */
1349 static char * previous_xpm[] = {
1350 \"24 24 39 1\",
1351 \"      c None\",
1352 \".     c #000000\",
1353 \"+     c #7BB3DB\",
1354 \"@     c #83BCE2\",
1355 \"#     c #7FB8DF\",
1356 \"$     c #89C2E7\",
1357 \"%     c #86BFE5\",
1358 \"&     c #83BBE2\",
1359 \"*     c #8CC6EA\",
1360 \"=     c #8BC4E9\",
1361 \"-     c #88C2E7\",
1362 \";     c #85BEE4\",
1363 \">     c #8DC7EB\",
1364 \",     c #89C3E8\",
1365 \"'     c #8AC4E8\",
1366 \")     c #8BC5EA\",
1367 \"!     c #88C1E6\",
1368 \"~     c #8AC4E9\",
1369 \"{     c #8AC3E8\",
1370 \"]     c #86C0E5\",
1371 \"^     c #87C0E6\",
1372 \"/     c #87C0E5\",
1373 \"(     c #82BBE2\",
1374 \"_     c #81BAE1\",
1375 \":     c #7FB7DF\",
1376 \"<     c #7DB6DD\",
1377 \"[     c #7DB5DD\",
1378 \"}     c #7CB4DC\",
1379 \"|     c #79B1DA\",
1380 \"1     c #76ADD7\",
1381 \"2     c #77AFD8\",
1382 \"3     c #73AAD4\",
1383 \"4     c #70A7D1\",
1384 \"5     c #6EA5D0\",
1385 \"6     c #6CA2CE\",
1386 \"7     c #689ECB\",
1387 \"8     c #6399C7\",
1388 \"9     c #6095C4\",
1389 \"0     c #5C90C0\",
1390 \"                        \",
1391 \"                        \",
1392 \"                .       \",
1393 \"               ..       \",
1394 \"              .+.       \",
1395 \"             .@#.       \",
1396 \"            .$%&.       \",
1397 \"           .*=-;.       \",
1398 \"          .>>*,%.       \",
1399 \"         .>>>*,%.       \",
1400 \"        .')**=-;.       \",
1401 \"       .;!,~{-%&.       \",
1402 \"        .;]^/;@#.       \",
1403 \"         .(@&_:+.       \",
1404 \"          .<[}|1.       \",
1405 \"           .2134.       \",
1406 \"            .567.       \",
1407 \"             .89.       \",
1408 \"              .0.       \",
1409 \"               ..       \",
1410 \"                .       \",
1411 \"                        \",
1412 \"                        \",
1413 \"                        \"};
1414 "
1415                  'xpm t)
1416    "Image for the previous item button."))
1417
1418 (defconst newsticker--previous-feed-image
1419   (if (fboundp 'create-image)
1420       (create-image "/* XPM */
1421 static char * prev_feed_xpm[] = {
1422 \"24 24 52 1\",
1423 \"      c None\",
1424 \".     c #000000\",
1425 \"+     c #70A7D2\",
1426 \"@     c #75ADD6\",
1427 \"#     c #71A8D3\",
1428 \"$     c #79B1DA\",
1429 \"%     c #7BB3DB\",
1430 \"&     c #7DB5DD\",
1431 \"*     c #83BBE2\",
1432 \"=     c #7EB6DE\",
1433 \"-     c #78B0D9\",
1434 \";     c #7FB7DE\",
1435 \">     c #88C2E7\",
1436 \",     c #85BEE4\",
1437 \"'     c #80B9E0\",
1438 \")     c #80B8DF\",
1439 \"!     c #8CC6EA\",
1440 \"~     c #89C3E8\",
1441 \"{     c #86BFE5\",
1442 \"]     c #81BAE1\",
1443 \"^     c #7CB4DC\",
1444 \"/     c #7FB8DF\",
1445 \"(     c #8DC7EB\",
1446 \"_     c #7BB3DC\",
1447 \":     c #7EB7DE\",
1448 \"<     c #8BC4E9\",
1449 \"[     c #8AC4E9\",
1450 \"}     c #8AC3E8\",
1451 \"|     c #87C0E6\",
1452 \"1     c #87C0E5\",
1453 \"2     c #83BCE2\",
1454 \"3     c #75ACD6\",
1455 \"4     c #7FB7DF\",
1456 \"5     c #77AED8\",
1457 \"6     c #71A8D2\",
1458 \"7     c #70A7D1\",
1459 \"8     c #76ADD7\",
1460 \"9     c #6CA2CE\",
1461 \"0     c #699FCC\",
1462 \"a     c #73AAD4\",
1463 \"b     c #6BA1CD\",
1464 \"c     c #669CC9\",
1465 \"d     c #6298C5\",
1466 \"e     c #689ECB\",
1467 \"f     c #6499C7\",
1468 \"g     c #6095C3\",
1469 \"h     c #5C91C0\",
1470 \"i     c #5E93C2\",
1471 \"j     c #5B90C0\",
1472 \"k     c #588CBC\",
1473 \"l     c #578CBC\",
1474 \"m     c #5589BA\",
1475 \"                        \",
1476 \"                        \",
1477 \"     ...          .     \",
1478 \"     .+.         ..     \",
1479 \"     .@.        .#.     \",
1480 \"     .$.       .%@.     \",
1481 \"     .&.      .*=-.     \",
1482 \"     .;.     .>,'%.     \",
1483 \"     .).    .!~{]^.     \",
1484 \"     ./.   .(!~{]_.     \",
1485 \"     .:.  .!!<>,'%.     \",
1486 \"     .&. .~[}>{*=-.     \",
1487 \"     .$.  .|1,2/%@.     \",
1488 \"     .3.   .*]4%56.     \",
1489 \"     .7.    .^$8#9.     \",
1490 \"     .0.     .a7bc.     \",
1491 \"     .d.      .efg.     \",
1492 \"     .h.       .ij.     \",
1493 \"     .k.        .l.     \",
1494 \"     .m.         ..     \",
1495 \"     ...          .     \",
1496 \"                        \",
1497 \"                        \",
1498 \"                        \"};
1499 "
1500                  'xpm t)
1501    "Image for the previous feed button."))
1502
1503 (defconst newsticker--next-feed-image
1504   (if (fboundp 'create-image)
1505       (create-image "/* XPM */
1506 static char * next_feed_xpm[] = {
1507 \"24 24 57 1\",
1508 \"      c None\",
1509 \".     c #000000\",
1510 \"+     c #6CA2CE\",
1511 \"@     c #75ADD6\",
1512 \"#     c #71A8D3\",
1513 \"$     c #79B1DA\",
1514 \"%     c #7EB7DE\",
1515 \"&     c #7DB5DD\",
1516 \"*     c #81BAE1\",
1517 \"=     c #85BEE4\",
1518 \"-     c #78B0D9\",
1519 \";     c #7FB7DE\",
1520 \">     c #83BCE3\",
1521 \",     c #87C1E6\",
1522 \"'     c #8AC4E9\",
1523 \")     c #7BB3DB\",
1524 \"!     c #80B8DF\",
1525 \"~     c #88C2E7\",
1526 \"{     c #8BC5E9\",
1527 \"]     c #8DC7EB\",
1528 \"^     c #7CB4DC\",
1529 \"/     c #7FB8DF\",
1530 \"(     c #84BDE3\",
1531 \"_     c #7BB3DC\",
1532 \":     c #83BCE2\",
1533 \"<     c #87C0E6\",
1534 \"[     c #8AC4E8\",
1535 \"}     c #8BC5EA\",
1536 \"|     c #8CC6EA\",
1537 \"1     c #88C1E6\",
1538 \"2     c #89C3E8\",
1539 \"3     c #8AC3E8\",
1540 \"4     c #7EB6DE\",
1541 \"5     c #82BBE1\",
1542 \"6     c #86C0E5\",
1543 \"7     c #87C0E5\",
1544 \"8     c #75ACD6\",
1545 \"9     c #7AB2DA\",
1546 \"0     c #81B9E0\",
1547 \"a     c #82BBE2\",
1548 \"b     c #71A8D2\",
1549 \"c     c #70A7D1\",
1550 \"d     c #74ACD6\",
1551 \"e     c #699FCC\",
1552 \"f     c #6EA5D0\",
1553 \"g     c #72A9D4\",
1554 \"h     c #669CC9\",
1555 \"i     c #6298C5\",
1556 \"j     c #679DCA\",
1557 \"k     c #6BA1CD\",
1558 \"l     c #6095C3\",
1559 \"m     c #5C91C0\",
1560 \"n     c #5F94C2\",
1561 \"o     c #5B90C0\",
1562 \"p     c #588CBC\",
1563 \"q     c #578CBC\",
1564 \"r     c #5589BA\",
1565 \"                        \",
1566 \"                        \",
1567 \"     .          ...     \",
1568 \"     ..         .+.     \",
1569 \"     .@.        .#.     \",
1570 \"     .$%.       .@.     \",
1571 \"     .&*=.      .-.     \",
1572 \"     .;>,'.     .).     \",
1573 \"     .!=~{].    .^.     \",
1574 \"     ./(~{]].   ._.     \",
1575 \"     .%:<[}||.  .).     \",
1576 \"     .&*=12'3~. .-.     \",
1577 \"     .$45=6<7.  .@.     \",
1578 \"     .8940a:.   .b.     \",
1579 \"     .cd-)&.    .+.     \",
1580 \"     .efg8.     .h.     \",
1581 \"     .ijk.      .l.     \",
1582 \"     .mn.       .o.     \",
1583 \"     .p.        .q.     \",
1584 \"     ..         .r.     \",
1585 \"     .          ...     \",
1586 \"                        \",
1587 \"                        \",
1588 \"                        \"};
1589 "
1590                  'xpm t)
1591    "Image for the next feed button."))
1592
1593 (defconst newsticker--mark-read-image
1594   (if (fboundp 'create-image)
1595       (create-image "/* XPM */
1596 static char * mark_read_xpm[] = {
1597 \"24 24 44 1\",
1598 \"      c None\",
1599 \".     c #C20000\",
1600 \"+     c #BE0000\",
1601 \"@     c #C70000\",
1602 \"#     c #CE0000\",
1603 \"$     c #C90000\",
1604 \"%     c #BD0000\",
1605 \"&     c #CB0000\",
1606 \"*     c #D10000\",
1607 \"=     c #D70000\",
1608 \"-     c #D30000\",
1609 \";     c #CD0000\",
1610 \">     c #C60000\",
1611 \",     c #D40000\",
1612 \"'     c #DA0000\",
1613 \")     c #DE0000\",
1614 \"!     c #DB0000\",
1615 \"~     c #D60000\",
1616 \"{     c #D00000\",
1617 \"]     c #DC0000\",
1618 \"^     c #E00000\",
1619 \"/     c #E40000\",
1620 \"(     c #E10000\",
1621 \"_     c #DD0000\",
1622 \":     c #D80000\",
1623 \"<     c #E50000\",
1624 \"[     c #E70000\",
1625 \"}     c #E60000\",
1626 \"|     c #E20000\",
1627 \"1     c #E90000\",
1628 \"2     c #E80000\",
1629 \"3     c #E30000\",
1630 \"4     c #DF0000\",
1631 \"5     c #D90000\",
1632 \"6     c #CC0000\",
1633 \"7     c #C10000\",
1634 \"8     c #C30000\",
1635 \"9     c #BF0000\",
1636 \"0     c #B90000\",
1637 \"a     c #BC0000\",
1638 \"b     c #BB0000\",
1639 \"c     c #B80000\",
1640 \"d     c #B50000\",
1641 \"e     c #B70000\",
1642 \"                        \",
1643 \"                        \",
1644 \"                        \",
1645 \"    .              +    \",
1646 \"   +@#            $.%   \",
1647 \"    &*=          -;>    \",
1648 \"     ,')        !~{     \",
1649 \"      ]^/      (_:      \",
1650 \"       (<[    }|)       \",
1651 \"        <[1  2<|        \",
1652 \"         }222[<         \",
1653 \"          }}}<          \",
1654 \"          333|          \",
1655 \"         _4^4)]         \",
1656 \"        ~:'  5=-        \",
1657 \"       6{-    *#$       \",
1658 \"      7>$      @89      \",
1659 \"     0a+        %bc     \",
1660 \"    ddc          edd    \",
1661 \"   ddd            ddd   \",
1662 \"    d              d    \",
1663 \"                        \",
1664 \"                        \",
1665 \"                        \"};
1666 "
1667                  'xpm t)
1668    "Image for the next feed button."))
1669
1670 (defconst newsticker--mark-immortal-image
1671   (if (fboundp 'create-image)
1672       (create-image "/* XPM */
1673 static char * mark_immortal_xpm[] = {
1674 \"24 24 93 2\",
1675 \"      c None\",
1676 \".     c #171717\",
1677 \"+     c #030303\",
1678 \"@     c #000000\",
1679 \"#     c #181818\",
1680 \"$     c #090909\",
1681 \"%     c #FFC960\",
1682 \"&     c #FFCB61\",
1683 \"*     c #FFCB62\",
1684 \"=     c #FFC961\",
1685 \"-     c #FFC75F\",
1686 \";     c #FFC65E\",
1687 \">     c #FFCA61\",
1688 \",     c #FFCD63\",
1689 \"'     c #FFCF65\",
1690 \")     c #FFD065\",
1691 \"!     c #FFCE64\",
1692 \"~     c #FFC35C\",
1693 \"{     c #FFC45D\",
1694 \"]     c #FFD166\",
1695 \"^     c #FFD267\",
1696 \"/     c #FFD368\",
1697 \"(     c #FFD167\",
1698 \"_     c #FFC05A\",
1699 \":     c #010101\",
1700 \"<     c #040404\",
1701 \"[     c #FFCC62\",
1702 \"}     c #FFD569\",
1703 \"|     c #FFD56A\",
1704 \"1     c #FFC860\",
1705 \"2     c #FFC25B\",
1706 \"3     c #FFBB56\",
1707 \"4     c #020202\",
1708 \"5     c #060606\",
1709 \"6     c #FFC15B\",
1710 \"7     c #FFC85F\",
1711 \"8     c #FFD469\",
1712 \"9     c #FFD66A\",
1713 \"0     c #FFBC57\",
1714 \"a     c #1B1B1B\",
1715 \"b     c #070707\",
1716 \"c     c #FFBA55\",
1717 \"d     c #FFB451\",
1718 \"e     c #FFB954\",
1719 \"f     c #FFB350\",
1720 \"g     c #FFB652\",
1721 \"h     c #FFBE58\",
1722 \"i     c #FFCD64\",
1723 \"j     c #FFD066\",
1724 \"k     c #FFC059\",
1725 \"l     c #FFB14E\",
1726 \"m     c #0B0B0B\",
1727 \"n     c #FFBB55\",
1728 \"o     c #FFC15A\",
1729 \"p     c #FFB552\",
1730 \"q     c #FFAD4B\",
1731 \"r     c #080808\",
1732 \"s     c #FFAF4C\",
1733 \"t     c #FFB853\",
1734 \"u     c #FFA948\",
1735 \"v     c #050505\",
1736 \"w     c #FFB04E\",
1737 \"x     c #FFB753\",
1738 \"y     c #FFBC56\",
1739 \"z     c #FFC55D\",
1740 \"A     c #FFC55E\",
1741 \"B     c #FFC45C\",
1742 \"C     c #FFBD57\",
1743 \"D     c #FFB854\",
1744 \"E     c #FFB34F\",
1745 \"F     c #FFAB4A\",
1746 \"G     c #FFA545\",
1747 \"H     c #FFAA49\",
1748 \"I     c #FFB04D\",
1749 \"J     c #FFB551\",
1750 \"K     c #FFBF58\",
1751 \"L     c #FFB24F\",
1752 \"M     c #FFAC4A\",
1753 \"N     c #FFA646\",
1754 \"O     c #FFA344\",
1755 \"P     c #FFA848\",
1756 \"Q     c #FFB14F\",
1757 \"R     c #FFAF4D\",
1758 \"S     c #FFA546\",
1759 \"T     c #FFA243\",
1760 \"U     c #FFA445\",
1761 \"V     c #FFAE4C\",
1762 \"W     c #FFA444\",
1763 \"X     c #FFA142\",
1764 \"Y     c #FF9F41\",
1765 \"Z     c #0A0A0A\",
1766 \"`     c #FF9E40\",
1767 \" .    c #FF9F40\",
1768 \"                                                \",
1769 \"                                                \",
1770 \"                                                \",
1771 \"                  . + @ @ + #                   \",
1772 \"              $ @ % & * * = - + +               \",
1773 \"            @ ; > , ' ) ' ! * - ~ @             \",
1774 \"          @ { > ! ] ^ / / ( ' * ; _ :           \",
1775 \"        < _ ; [ ) / } | } / ] , 1 2 3 4         \",
1776 \"        5 6 7 , ] 8 9 9 9 } ^ ! = ~ 0 a         \",
1777 \"      b c 6 - , ] 8 9 9 9 } ^ ! % ~ 0 d 5       \",
1778 \"      : e _ ; * ) / 8 } } / ] , 1 2 3 f 5       \",
1779 \"      : g h { = i j ^ / ^ ] ! * ; k e l m       \",
1780 \"      : f n o ; > , ' ) ' ! * - 2 0 p q r       \",
1781 \"      : s g 0 6 ; % > * * = - ~ h t l u r       \",
1782 \"      v u w x y k ~ z A z B o C D E F G b       \",
1783 \"        5 H I J e 0 h K h C c x L M N .         \",
1784 \"        4 O P q Q d g x g J L R H S T <         \",
1785 \"          @ T U P F q V q M H N W X +           \",
1786 \"            @ Y T O W G G W O X Y @             \",
1787 \"              4 Z ` Y Y Y  .` 4 4               \",
1788 \"                  5 : : @ @ Z                   \",
1789 \"                                                \",
1790 \"                                                \",
1791 \"                                                \"};
1792 "
1793                  'xpm t)
1794    "Image for the next feed button."))
1795
1796
1797 (defconst newsticker--narrow-image
1798   (if (fboundp 'create-image)
1799       (create-image "/* XPM */
1800 static char * narrow_xpm[] = {
1801 \"24 24 48 1\",
1802 \"      c None\",
1803 \".     c #000000\",
1804 \"+     c #969696\",
1805 \"@     c #9E9E9E\",
1806 \"#     c #A4A4A4\",
1807 \"$     c #AAAAAA\",
1808 \"%     c #AEAEAE\",
1809 \"&     c #B1B1B1\",
1810 \"*     c #B3B3B3\",
1811 \"=     c #B4B4B4\",
1812 \"-     c #B2B2B2\",
1813 \";     c #AFAFAF\",
1814 \">     c #ABABAB\",
1815 \",     c #A6A6A6\",
1816 \"'     c #A0A0A0\",
1817 \")     c #989898\",
1818 \"!     c #909090\",
1819 \"~     c #73AAD4\",
1820 \"{     c #7AB2DA\",
1821 \"]     c #7FB8DF\",
1822 \"^     c #84BDE3\",
1823 \"/     c #88C2E7\",
1824 \"(     c #8BC5E9\",
1825 \"_     c #8DC7EB\",
1826 \":     c #8CC6EA\",
1827 \"<     c #89C3E8\",
1828 \"[     c #86BFE5\",
1829 \"}     c #81BAE1\",
1830 \"|     c #7BB3DC\",
1831 \"1     c #75ACD6\",
1832 \"2     c #6DA4CF\",
1833 \"3     c #979797\",
1834 \"4     c #A3A3A3\",
1835 \"5     c #A8A8A8\",
1836 \"6     c #ADADAD\",
1837 \"7     c #ACACAC\",
1838 \"8     c #A9A9A9\",
1839 \"9     c #A5A5A5\",
1840 \"0     c #9A9A9A\",
1841 \"a     c #929292\",
1842 \"b     c #8C8C8C\",
1843 \"c     c #808080\",
1844 \"d     c #818181\",
1845 \"e     c #838383\",
1846 \"f     c #848484\",
1847 \"g     c #858585\",
1848 \"h     c #868686\",
1849 \"i     c #828282\",
1850 \"                        \",
1851 \"                        \",
1852 \"                        \",
1853 \"   ..................   \",
1854 \"   .+@#$%&*=*-;>,')!.   \",
1855 \"   ..................   \",
1856 \"                        \",
1857 \"                        \",
1858 \"   ..................   \",
1859 \"   .~{]^/(___:<[}|12.   \",
1860 \"   ..................   \",
1861 \"                        \",
1862 \"                        \",
1863 \"   ..................   \",
1864 \"   .!3@45>666789'0ab.   \",
1865 \"   ..................   \",
1866 \"                        \",
1867 \"                        \",
1868 \"   ..................   \",
1869 \"   .cccdefghhgficccc.   \",
1870 \"   ..................   \",
1871 \"                        \",
1872 \"                        \",
1873 \"                        \"};
1874 "
1875                  'xpm t)
1876    "Image for the next feed button."))
1877
1878 (defconst newsticker--get-all-image
1879   (if (fboundp 'create-image)
1880       (create-image "/* XPM */
1881 static char * get_all_xpm[] = {
1882 \"24 24 70 1\",
1883 \"      c None\",
1884 \".     c #000000\",
1885 \"+     c #F3DA00\",
1886 \"@     c #F5DF00\",
1887 \"#     c #F7E300\",
1888 \"$     c #F9E700\",
1889 \"%     c #FAEA00\",
1890 \"&     c #FBEC00\",
1891 \"*     c #FBED00\",
1892 \"=     c #FCEE00\",
1893 \"-     c #FAEB00\",
1894 \";     c #F9E800\",
1895 \">     c #F8E500\",
1896 \",     c #F6E000\",
1897 \"'     c #F4DB00\",
1898 \")     c #F1D500\",
1899 \"!     c #EFD000\",
1900 \"~     c #B7CA00\",
1901 \"{     c #BFD100\",
1902 \"]     c #C5D700\",
1903 \"^     c #CBDB00\",
1904 \"/     c #CFDF00\",
1905 \"(     c #D2E200\",
1906 \"_     c #D4E400\",
1907 \":     c #D3E300\",
1908 \"<     c #D0E000\",
1909 \"[     c #CCDD00\",
1910 \"}     c #C7D800\",
1911 \"|     c #C1D300\",
1912 \"1     c #BACC00\",
1913 \"2     c #B1C500\",
1914 \"3     c #A8BC00\",
1915 \"4     c #20A900\",
1916 \"5     c #22AF00\",
1917 \"6     c #24B500\",
1918 \"7     c #26B900\",
1919 \"8     c #27BC00\",
1920 \"9     c #27BE00\",
1921 \"0     c #28BF00\",
1922 \"a     c #27BD00\",
1923 \"b     c #26BA00\",
1924 \"c     c #25B600\",
1925 \"d     c #23B100\",
1926 \"e     c #21AB00\",
1927 \"f     c #1FA400\",
1928 \"g     c #1C9B00\",
1929 \"h     c #21AA00\",
1930 \"i     c #24B300\",
1931 \"j     c #25B800\",
1932 \"k     c #25B700\",
1933 \"l     c #24B400\",
1934 \"m     c #23B000\",
1935 \"n     c #1FA500\",
1936 \"o     c #1D9E00\",
1937 \"p     c #20A800\",
1938 \"q     c #21AC00\",
1939 \"r     c #23B200\",
1940 \"s     c #22AD00\",
1941 \"t     c #1D9F00\",
1942 \"u     c #20A700\",
1943 \"v     c #1EA100\",
1944 \"w     c #1C9C00\",
1945 \"x     c #1DA000\",
1946 \"y     c #1B9800\",
1947 \"z     c #1A9600\",
1948 \"A     c #1A9700\",
1949 \"B     c #1A9500\",
1950 \"C     c #199200\",
1951 \"D     c #189100\",
1952 \"E     c #178C00\",
1953 \"                        \",
1954 \"                        \",
1955 \"                        \",
1956 \"                        \",
1957 \"   ...................  \",
1958 \"   .+@#$%&*=*&-;>,')!.  \",
1959 \"   ...................  \",
1960 \"                        \",
1961 \"   ...................  \",
1962 \"   .~{]^/(___:<[}|123.  \",
1963 \"   ...................  \",
1964 \"                        \",
1965 \"   ...................  \",
1966 \"    .45678909abcdefg.   \",
1967 \"     .h5icj7jklmeno.    \",
1968 \"      .pq5drrmshft.     \",
1969 \"       .fu4h4pnvw.      \",
1970 \"        .oxvxtwy.       \",
1971 \"         .zAAzB.        \",
1972 \"          .CCD.         \",
1973 \"           .E.          \",
1974 \"            .           \",
1975 \"                        \",
1976 \"                        \"};
1977 "
1978                  'xpm t)
1979    "Image for the next feed button."))
1980
1981
1982 (defconst newsticker--update-image
1983   (if (fboundp 'create-image)
1984       (create-image "/* XPM */
1985 static char * update_xpm[] = {
1986 \"24 24 37 1\",
1987 \"      c None\",
1988 \".     c #076D00\",
1989 \"+     c #0A8600\",
1990 \"@     c #0A8800\",
1991 \"#     c #098400\",
1992 \"$     c #087200\",
1993 \"%     c #087900\",
1994 \"&     c #098500\",
1995 \"*     c #098100\",
1996 \"=     c #087600\",
1997 \"-     c #097E00\",
1998 \";     c #097F00\",
1999 \">     c #0A8700\",
2000 \",     c #0A8C00\",
2001 \"'     c #097C00\",
2002 \")     c #098300\",
2003 \"!     c #0A8900\",
2004 \"~     c #0A8E00\",
2005 \"{     c #0B9200\",
2006 \"]     c #087700\",
2007 \"^     c #076E00\",
2008 \"/     c #076C00\",
2009 \"(     c #076B00\",
2010 \"_     c #076A00\",
2011 \":     c #076900\",
2012 \"<     c #076800\",
2013 \"[     c #066700\",
2014 \"}     c #066500\",
2015 \"|     c #066400\",
2016 \"1     c #066300\",
2017 \"2     c #066600\",
2018 \"3     c #066200\",
2019 \"4     c #076700\",
2020 \"5     c #065E00\",
2021 \"6     c #066100\",
2022 \"7     c #065F00\",
2023 \"8     c #066000\",
2024 \"                        \",
2025 \"                        \",
2026 \"                        \",
2027 \"    .    +@@@+#         \",
2028 \"    $% &@      +*       \",
2029 \"    =-#          ;      \",
2030 \"    %*>,          '     \",
2031 \"    ')!~{          =    \",
2032 \"                   ]$   \",
2033 \"   ^                ^   \",
2034 \"   .                .   \",
2035 \"   /                (   \",
2036 \"   _                :   \",
2037 \"   <                [   \",
2038 \"   }                |   \",
2039 \"   [[                   \",
2040 \"    1          $.:23    \",
2041 \"     3          4}35    \",
2042 \"      6          655    \",
2043 \"       76      85 55    \",
2044 \"        5555555    5    \",
2045 \"                        \",
2046 \"                        \",
2047 \"                        \"};
2048 "
2049                  'xpm t)
2050    "Image for the update button."))
2051
2052 (defconst newsticker--browse-image
2053   (if (fboundp 'create-image)
2054       (create-image "/* XPM */
2055 static char * visit_xpm[] = {
2056 \"24 24 39 1\",
2057 \"      c None\",
2058 \".     c #000000\",
2059 \"+     c #FFFFFF\",
2060 \"@     c #00E63D\",
2061 \"#     c #00E83E\",
2062 \"$     c #00E73D\",
2063 \"%     c #00E93E\",
2064 \"&     c #00E63C\",
2065 \"*     c #00E53C\",
2066 \"=     c #00E23B\",
2067 \"-     c #00E33B\",
2068 \";     c #00E83D\",
2069 \">     c #00E13A\",
2070 \",     c #00DD38\",
2071 \"'     c #00DE38\",
2072 \")     c #00E23A\",
2073 \"!     c #00E43C\",
2074 \"~     c #00DF39\",
2075 \"{     c #00DB37\",
2076 \"]     c #00D634\",
2077 \"^     c #00D734\",
2078 \"/     c #00E039\",
2079 \"(     c #00DC37\",
2080 \"_     c #00D835\",
2081 \":     c #00D332\",
2082 \"<     c #00CD2F\",
2083 \"[     c #00DB36\",
2084 \"}     c #00D433\",
2085 \"|     c #00CF30\",
2086 \"1     c #00DA36\",
2087 \"2     c #00D936\",
2088 \"3     c #00D533\",
2089 \"4     c #00D131\",
2090 \"5     c #00CE2F\",
2091 \"6     c #00CC2F\",
2092 \"7     c #00CA2D\",
2093 \"8     c #00C62B\",
2094 \"9     c #00C52A\",
2095 \"0     c #00BE27\",
2096 \"                        \",
2097 \"                        \",
2098 \"            .           \",
2099 \"           .+.          \",
2100 \"          .+++.         \",
2101 \"         .++.++.        \",
2102 \"        .++.@.++.       \",
2103 \"       .++.##$.++.      \",
2104 \"      .++.%%%#&.++.     \",
2105 \"     .++.$%%%#*=.++.    \",
2106 \"    .++.-@;##$*>,.++.   \",
2107 \"   .++.')!&@@*=~{].++.  \",
2108 \"  .++.^{~>---)/(_:<.++. \",
2109 \"   .++.^[,~/~'(_}|.++.  \",
2110 \"    .++.]_1[12^:|.++.   \",
2111 \"     .++.:}33:45.++.    \",
2112 \"      .++.<5567.++.     \",
2113 \"       .++.889.++.      \",
2114 \"        .++.0.++.       \",
2115 \"         .++.++.        \",
2116 \"          .+++.         \",
2117 \"           .+.          \",
2118 \"            .           \",
2119 \"                        \"};
2120 "
2121                  'xpm t)
2122    "Image for the browse button."))
2123
2124
2125 (defvar newsticker-tool-bar-map
2126   (if (featurep 'xemacs)
2127       nil
2128     (let ((tool-bar-map (make-sparse-keymap)))
2129       (define-key tool-bar-map [newsticker-sep-1]
2130         (list 'menu-item "--double-line"))
2131       (define-key tool-bar-map [newsticker-browse-url]
2132         (list 'menu-item "newsticker-browse-url" 'newsticker-browse-url
2133               :visible t
2134               :help "Browse URL for item at point"
2135               :image newsticker--browse-image))
2136       (define-key tool-bar-map [newsticker-buffer-force-update]
2137         (list 'menu-item "newsticker-buffer-force-update"
2138               'newsticker-buffer-force-update
2139               :visible t
2140               :help "Update newsticker buffer"
2141               :image newsticker--update-image
2142               :enable '(not newsticker--buffer-uptodate-p)))
2143       (define-key tool-bar-map [newsticker-get-all-news]
2144         (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
2145               :visible t
2146               :help "Get news for all feeds"
2147               :image newsticker--get-all-image))
2148       (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
2149         (list 'menu-item "newsticker-mark-item-at-point-as-read"
2150               'newsticker-mark-item-at-point-as-read
2151               :visible t
2152               :image newsticker--mark-read-image
2153               :help "Mark current item as read"
2154               :enable '(newsticker-item-not-old-p)))
2155       (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
2156         (list 'menu-item "newsticker-mark-item-at-point-as-immortal"
2157               'newsticker-mark-item-at-point-as-immortal
2158               :visible t
2159               :image newsticker--mark-immortal-image
2160               :help "Mark current item as immortal"
2161               :enable '(newsticker-item-not-immortal-p)))
2162       (define-key tool-bar-map [newsticker-toggle-auto-narrow-to-feed]
2163         (list 'menu-item "newsticker-toggle-auto-narrow-to-feed"
2164               'newsticker-toggle-auto-narrow-to-feed
2165               :visible t
2166               :help "Toggle visibility of other feeds"
2167               :image newsticker--narrow-image))
2168       (define-key tool-bar-map [newsticker-next-feed]
2169         (list 'menu-item "newsticker-next-feed" 'newsticker-next-feed
2170               :visible t
2171               :help "Go to next feed"
2172               :image newsticker--next-feed-image
2173               :enable '(newsticker-next-feed-available-p)))
2174       (define-key tool-bar-map [newsticker-next-item]
2175         (list 'menu-item "newsticker-next-item" 'newsticker-next-item
2176               :visible t
2177               :help "Go to next item"
2178               :image newsticker--next-item-image
2179               :enable '(newsticker-next-item-available-p)))
2180       (define-key tool-bar-map [newsticker-previous-item]
2181         (list 'menu-item "newsticker-previous-item" 'newsticker-previous-item
2182               :visible t
2183               :help "Go to previous item"
2184               :image newsticker--previous-item-image
2185               :enable '(newsticker-previous-item-available-p)))
2186       (define-key tool-bar-map [newsticker-previous-feed]
2187         (list 'menu-item "newsticker-previous-feed" 'newsticker-previous-feed
2188               :visible t
2189               :help "Go to previous feed"
2190               :image newsticker--previous-feed-image
2191               :enable '(newsticker-previous-feed-available-p)))
2192       ;; standard icons / actions
2193       (tool-bar-add-item "close"
2194                          'newsticker-close-buffer
2195                          'newsticker-close-buffer
2196                          :help "Close newsticker buffer")
2197       (tool-bar-add-item "preferences"
2198                          'newsticker-customize
2199                          'newsticker-customize
2200                          :help "Customize newsticker")
2201       tool-bar-map)))
2202
2203 ;; ======================================================================
2204 ;;; Newsticker mode
2205 ;; ======================================================================
2206
2207 (define-derived-mode newsticker-mode fundamental-mode
2208   "NewsTicker"
2209   "Viewing news feeds in Emacs."
2210   (set (make-local-variable 'tool-bar-map) newsticker-tool-bar-map)
2211   (set (make-local-variable 'imenu-sort-function) nil)
2212   (set (make-local-variable 'scroll-conservatively) 999)
2213   (setq imenu-create-index-function 'newsticker--imenu-create-index)
2214   (setq imenu-default-goto-function 'newsticker--imenu-goto)
2215   (setq buffer-read-only t)
2216   (auto-fill-mode -1) ;; turn auto-fill off!
2217   (font-lock-mode -1) ;; turn off font-lock!!
2218   (set (make-local-variable 'font-lock-defaults) nil)
2219   (set (make-local-variable 'line-move-ignore-invisible) t)
2220   (setq mode-line-format
2221         (list "-"
2222               'mode-line-mule-info
2223               'mode-line-modified
2224               'mode-line-frame-identification
2225               " Newsticker ("
2226               '(newsticker--buffer-uptodate-p
2227                 "up to date"
2228                 "NEED UPDATE")
2229               ") "
2230               '(:eval (format "[%d]" (length newsticker--process-ids)))
2231               " -- "
2232               '(:eval (newsticker--buffer-get-feed-title-at-point))
2233               ": "
2234               '(:eval (newsticker--buffer-get-item-title-at-point))
2235               " %-"))
2236   (unless newsticker-show-all-news-elements
2237     (add-to-invisibility-spec 'extra))
2238   (newsticker--buffer-set-uptodate nil))
2239
2240 ;; refine its mode-map
2241 (define-key newsticker-mode-map "sO" 'newsticker-show-old-items)
2242 (define-key newsticker-mode-map "hO" 'newsticker-hide-old-items)
2243 (define-key newsticker-mode-map "sa" 'newsticker-show-all-desc)
2244 (define-key newsticker-mode-map "ha" 'newsticker-hide-all-desc)
2245 (define-key newsticker-mode-map "sf" 'newsticker-show-feed-desc)
2246 (define-key newsticker-mode-map "hf" 'newsticker-hide-feed-desc)
2247 (define-key newsticker-mode-map "so" 'newsticker-show-old-item-desc)
2248 (define-key newsticker-mode-map "ho" 'newsticker-hide-old-item-desc)
2249 (define-key newsticker-mode-map "sn" 'newsticker-show-new-item-desc)
2250 (define-key newsticker-mode-map "hn" 'newsticker-hide-new-item-desc)
2251 (define-key newsticker-mode-map "se" 'newsticker-show-entry)
2252 (define-key newsticker-mode-map "he" 'newsticker-hide-entry)
2253 (define-key newsticker-mode-map "sx" 'newsticker-show-extra)
2254 (define-key newsticker-mode-map "hx" 'newsticker-hide-extra)
2255
2256 (define-key newsticker-mode-map " "  'scroll-up)
2257 (define-key newsticker-mode-map "q"  'newsticker-close-buffer)
2258 (define-key newsticker-mode-map "p"  'newsticker-previous-item)
2259 (define-key newsticker-mode-map "P"  'newsticker-previous-new-item)
2260 (define-key newsticker-mode-map "F"  'newsticker-previous-feed)
2261 (define-key newsticker-mode-map "\t" 'newsticker-next-item)
2262 (define-key newsticker-mode-map "n"  'newsticker-next-item)
2263 (define-key newsticker-mode-map "N"  'newsticker-next-new-item)
2264 (define-key newsticker-mode-map "f"  'newsticker-next-feed)
2265 (define-key newsticker-mode-map "M"  'newsticker-mark-all-items-as-read)
2266 (define-key newsticker-mode-map "m"
2267   'newsticker-mark-all-items-at-point-as-read)
2268 (define-key newsticker-mode-map "o"
2269   'newsticker-mark-item-at-point-as-read)
2270 (define-key newsticker-mode-map "G"  'newsticker-get-all-news)
2271 (define-key newsticker-mode-map "g"  'newsticker-get-news-at-point)
2272 (define-key newsticker-mode-map "u"  'newsticker-buffer-update)
2273 (define-key newsticker-mode-map "U"  'newsticker-buffer-force-update)
2274 (define-key newsticker-mode-map "a"  'newsticker-add-url)
2275
2276 (define-key newsticker-mode-map "i"
2277   'newsticker-mark-item-at-point-as-immortal)
2278
2279 (define-key newsticker-mode-map "xf"
2280   'newsticker-toggle-auto-narrow-to-feed)
2281 (define-key newsticker-mode-map "xi"
2282   'newsticker-toggle-auto-narrow-to-item)
2283
2284 ;; maps for the clickable portions
2285 (defvar newsticker--url-keymap (make-sparse-keymap)
2286   "Key map for click-able headings in the newsticker buffer.")
2287 (define-key newsticker--url-keymap [mouse-2]
2288   'newsticker-mouse-browse-url)
2289 (define-key newsticker--url-keymap "\n"
2290   'newsticker-browse-url)
2291 (define-key newsticker--url-keymap "\C-m"
2292   'newsticker-browse-url)
2293 (define-key newsticker--url-keymap [(control return)]
2294   'newsticker-handle-url)
2295
2296 ;; newsticker menu
2297 (defvar newsticker-menu (make-sparse-keymap "Newsticker"))
2298
2299 (define-key newsticker-menu [newsticker-browse-url]
2300   '("Browse URL for item at point" . newsticker-browse-url))
2301 (define-key newsticker-menu [newsticker-separator-1]
2302   '("--"))
2303 (define-key newsticker-menu [newsticker-buffer-update]
2304   '("Update buffer" . newsticker-buffer-update))
2305 (define-key newsticker-menu [newsticker-separator-2]
2306   '("--"))
2307 (define-key newsticker-menu [newsticker-get-all-news]
2308   '("Get news from all feeds" . newsticker-get-all-news))
2309 (define-key newsticker-menu [newsticker-get-news-at-point]
2310   '("Get news from feed at point" . newsticker-get-news-at-point))
2311 (define-key newsticker-menu [newsticker-separator-3]
2312   '("--"))
2313 (define-key newsticker-menu [newsticker-mark-all-items-as-read]
2314   '("Mark all items as read" . newsticker-mark-all-items-as-read))
2315 (define-key newsticker-menu [newsticker-mark-all-items-at-point-as-read]
2316   '("Mark all items in feed at point as read" .
2317     newsticker-mark-all-items-at-point-as-read))
2318 (define-key newsticker-menu [newsticker-mark-item-at-point-as-read]
2319   '("Mark item at point as read" .
2320     newsticker-mark-item-at-point-as-read))
2321 (define-key newsticker-menu [newsticker-mark-item-at-point-as-immortal]
2322   '("Toggle immortality for item at point" .
2323     newsticker-mark-item-at-point-as-immortal))
2324 (define-key newsticker-menu [newsticker-separator-4]
2325   '("--"))
2326 (define-key newsticker-menu [newsticker-hide-old-items]
2327   '("Hide old items" . newsticker-hide-old-items))
2328 (define-key newsticker-menu [newsticker-show-old-items]
2329   '("Show old items" . newsticker-show-old-items))
2330 (define-key newsticker-menu [newsticker-next-item]
2331   '("Go to next item" . newsticker-next-item))
2332 (define-key newsticker-menu [newsticker-previous-item]
2333   '("Go to previous item" . newsticker-previous-item))
2334
2335 ;; bind menu to mouse
2336 (define-key newsticker-mode-map [down-mouse-3] newsticker-menu)
2337 ;; Put menu in menu-bar
2338 (define-key newsticker-mode-map [menu-bar Newsticker]
2339   (cons "Newsticker" newsticker-menu))
2340
2341
2342 ;; ======================================================================
2343 ;;; shortcuts
2344 ;; ======================================================================
2345 (defsubst newsticker--title (item)
2346   "Return title of ITEM."
2347   (nth 0 item))
2348 (defsubst newsticker--desc (item)
2349   "Return description of ITEM."
2350   (nth 1 item))
2351 (defsubst newsticker--link (item)
2352   "Return link of ITEM."
2353   (nth 2 item))
2354 (defsubst newsticker--time (item)
2355   "Return time of ITEM."
2356   (nth 3 item))
2357 (defsubst newsticker--age (item)
2358   "Return age of ITEM."
2359   (nth 4 item))
2360 (defsubst newsticker--pos (item)
2361   "Return position/index of ITEM."
2362   (nth 5 item))
2363 (defsubst newsticker--preformatted-contents (item)
2364   "Return pre-formatted text of ITEM."
2365   (nth 6 item))
2366 (defsubst newsticker--preformatted-title (item)
2367   "Return pre-formatted title of ITEM."
2368   (nth 7 item))
2369 (defsubst newsticker--extra (item)
2370   "Return extra attributes of ITEM."
2371   (nth 8 item))
2372 (defsubst newsticker--guid (item)
2373   "Return guid of ITEM."
2374   (let ((guid (assoc 'guid (newsticker--extra item))))
2375     (if (stringp guid)
2376         guid
2377       (car (xml-node-children guid)))))
2378 (defsubst newsticker--enclosure (item)
2379   "Return enclosure element of ITEM in the form \(...FIXME...\) or nil."
2380   (let ((enclosure (assoc 'enclosure (newsticker--extra item))))
2381     (if enclosure
2382         (xml-node-attributes enclosure))))
2383
2384 ;; ======================================================================
2385 ;;; User fun
2386 ;; ======================================================================
2387
2388 ;;;###autoload
2389 (defun newsticker-start (&optional do-not-complain-if-running)
2390   "Start the newsticker.
2391 Start the timers for display and retrieval.  If the newsticker, i.e. the
2392 timers, are running already a warning message is printed unless
2393 DO-NOT-COMPLAIN-IF-RUNNING is not nil.
2394 Run `newsticker-start-hook' if newsticker was not running already."
2395   (interactive)
2396   (let ((running (newsticker-running-p)))
2397     ;; read old cache if it exists and newsticker is not running
2398     (unless running
2399       (let* ((coding-system-for-read 'utf-8)
2400              (buf (find-file-noselect newsticker-cache-filename)))
2401         (when buf
2402           (set-buffer buf)
2403           (goto-char (point-min))
2404           (condition-case nil
2405               (setq newsticker--cache (read buf))
2406             (error
2407              (message "Error while reading newsticker cache file!")
2408              (setq newsticker--cache nil))))))
2409     ;; start retrieval timers -- for sake of simplicity we will start
2410     ;; one timer for each feed
2411     (mapc (lambda (item)
2412             (let* ((feed-name (car item))
2413                    (start-time (nth 2 item))
2414                    (interval (or (nth 3 item)
2415                                  newsticker-retrieval-interval))
2416                    (timer (assoc (car item)
2417                                  newsticker--retrieval-timer-list)))
2418               (if timer
2419                   (or do-not-complain-if-running
2420                       (message "Timer for %s is running already!"
2421                                feed-name))
2422                 (newsticker--debug-msg "Starting timer for %s: %s, %d"
2423                                        feed-name start-time interval)
2424                 ;; do not repeat retrieval if interval not positive
2425                 (if (<= interval 0)
2426                     (setq interval nil))
2427                 ;; Suddenly XEmacs doesn't like start-time 0
2428                 (if (or (not start-time)
2429                         (and (numberp start-time) (= start-time 0)))
2430                     (setq start-time 1))
2431                 ;; (message "start-time %s" start-time)
2432                 (setq timer (run-at-time start-time interval
2433                                          'newsticker-get-news feed-name))
2434                 (if interval
2435                     (add-to-list 'newsticker--retrieval-timer-list
2436                                  (cons feed-name timer))))))
2437           (append newsticker-url-list-defaults newsticker-url-list))
2438     (unless running
2439       (run-hooks 'newsticker-start-hook)
2440       (message "Newsticker started!"))))
2441
2442 ;;;###autoload
2443 (defun newsticker-start-ticker ()
2444   "Start newsticker's ticker (but not the news retrieval).
2445 Start display timer for the actual ticker if wanted and not
2446 running already."
2447   (interactive)
2448   (if (and (> newsticker-display-interval 0)
2449            (not newsticker--display-timer))
2450       (setq newsticker--display-timer
2451             (run-at-time newsticker-display-interval
2452                          newsticker-display-interval
2453                          'newsticker--display-tick))))
2454
2455 (defun newsticker-stop ()
2456   "Stop the newsticker and the newsticker-ticker.
2457 Cancel the timers for display and retrieval.  Run `newsticker-stop-hook'
2458 if newsticker has been running."
2459   (interactive)
2460   (newsticker--cache-update t)
2461   (newsticker-stop-ticker)
2462   (when (newsticker-running-p)
2463     (mapc (lambda (name-and-timer)
2464             (cancel-timer (cdr name-and-timer)))
2465           newsticker--retrieval-timer-list)
2466     (setq newsticker--retrieval-timer-list nil)
2467     (run-hooks 'newsticker-stop-hook)
2468     (message "Newsticker stopped!")))
2469
2470 (defun newsticker-stop-ticker ()
2471   "Stop newsticker's ticker (but not the news retrieval)."
2472   (interactive)
2473   (when newsticker--display-timer
2474     (cancel-timer newsticker--display-timer)
2475     (setq newsticker--display-timer nil)))
2476
2477 ;; the functions we need for retrieval and display
2478 ;;;###autoload
2479 (defun newsticker-show-news ()
2480   "Switch to newsticker buffer.  You may want to bind this to a key."
2481   (interactive)
2482   (newsticker-start t) ;; will start only if not running
2483   (newsticker-buffer-update)
2484   (switch-to-buffer "*newsticker*"))
2485
2486 (defun newsticker-buffer-force-update ()
2487   "Update the newsticker buffer, even if not necessary."
2488   (interactive)
2489   (newsticker-buffer-update t))
2490
2491 (defun newsticker-buffer-update (&optional force)
2492   "Update the *newsticker* buffer.
2493 Unless FORCE is t this is done only if necessary, i.e. when the
2494 *newsticker* buffer is not up-to-date."
2495   (interactive)
2496   ;; bring cache data into proper order....
2497   (newsticker--cache-sort)
2498   ;; fill buffer
2499   (save-excursion
2500     (let ((buf (get-buffer "*newsticker*")))
2501       (if buf
2502           (switch-to-buffer buf)
2503         (switch-to-buffer (get-buffer-create "*newsticker*"))
2504         (newsticker--buffer-set-uptodate nil)))
2505    (when (or force
2506              (not newsticker--buffer-uptodate-p))
2507      (message "Preparing newsticker buffer...")
2508      (setq buffer-undo-list t)
2509      (let ((inhibit-read-only t))
2510        (set-buffer-modified-p nil)
2511        (erase-buffer)
2512        (newsticker-mode)
2513        ;; Emacs 21.3.50 does not care if we turn off auto-fill in the
2514        ;; definition of newsticker-mode, so we do it here (again)
2515        (auto-fill-mode -1)
2516
2517        (set-buffer-file-coding-system 'utf-8)
2518
2519        (if newsticker-use-full-width
2520            (set (make-local-variable 'fill-column) (1- (window-width))))
2521        (newsticker--buffer-insert-all-items)
2522
2523        ;; FIXME: needed for methods buffer in ecb
2524        ;; (set-visited-file-name "*newsticker*")
2525
2526        (set-buffer-modified-p nil)
2527         (newsticker-hide-all-desc)
2528         (if newsticker-hide-old-items-in-newsticker-buffer
2529             (newsticker-hide-old-items))
2530         (if newsticker-show-descriptions-of-new-items
2531             (newsticker-show-new-item-desc))
2532        )
2533      (message ""))
2534    (newsticker--buffer-set-uptodate t)
2535    (run-hooks 'newsticker-buffer-change-hook)))
2536
2537 (defun newsticker-get-all-news ()
2538   "Launch retrieval of news from all configured newsticker sites.
2539 This does NOT start the retrieval timers."
2540   (interactive)
2541   ;; launch retrieval of news
2542   (mapc (lambda (item)
2543           (newsticker-get-news (car item)))
2544         (append newsticker-url-list-defaults newsticker-url-list)))
2545
2546 (defun newsticker-get-news-at-point ()
2547   "Launch retrieval of news for the feed point is in.
2548 This does NOT start the retrieval timers."
2549   (interactive)
2550   ;; launch retrieval of news
2551   (let ((feed (get-text-property (point) 'feed)))
2552       (when feed
2553         (newsticker--debug-msg "Getting news for %s" (symbol-name feed))
2554         (newsticker-get-news (symbol-name feed)))))
2555
2556 (defun newsticker-add-url (url name)
2557   "Add given URL under given NAME to `newsticker-url-list'.
2558 If URL is nil it is searched at point."
2559   (interactive
2560    (list
2561     (read-string "URL: "
2562                  (save-excursion
2563                    (end-of-line)
2564                    (and
2565                     (re-search-backward
2566                      "http://"
2567                      (if (> (point) (+ (point-min) 100))
2568                          (- (point) 100)
2569                        (point-min))
2570                      t)
2571                     (re-search-forward
2572                      "http://[-a-zA-Z0-9&/_.]*"
2573                      (if (< (point) (- (point-max) 200))
2574                          (+ (point) 200)
2575                        (point-max))
2576                      t)
2577                     (buffer-substring-no-properties (match-beginning 0)
2578                                                     (match-end 0)))))
2579     (read-string "Name: ")))
2580   (add-to-list 'newsticker-url-list (list name url nil nil nil) t)
2581   (customize-variable 'newsticker-url-list))
2582
2583 (defun newsticker-w3m-show-inline-images ()
2584   "Show inline images in visible text ranges.
2585 In-line images in invisible text ranges are hidden.  This function
2586 calls `w3m-toggle-inline-image'.  It works only if
2587 `newsticker-html-renderer' is set to `w3m-region'."
2588   (interactive)
2589   (if (eq newsticker-html-renderer 'w3m-region)
2590       (let ((inhibit-read-only t))
2591         (save-excursion
2592           (save-restriction
2593             (widen)
2594             (goto-char (point-min))
2595             (let ((pos (point)))
2596               (while pos
2597                 (setq pos (next-single-property-change pos 'w3m-image))
2598                 (when pos
2599                   (goto-char pos)
2600                   (when (get-text-property pos 'w3m-image)
2601                     (let ((invis (newsticker--lists-intersect-p
2602                                   (get-text-property (1- (point))
2603                                                      'invisible)
2604                                   buffer-invisibility-spec)))
2605                       (if invis
2606                           (w3m-remove-image
2607                            pos (next-single-property-change pos
2608                                                             'w3m-image))
2609                         (w3m-toggle-inline-image t))))))))))))
2610
2611 ;; ======================================================================
2612 ;;; keymap stuff
2613 ;; ======================================================================
2614 (defun newsticker-close-buffer ()
2615   "Close the newsticker buffer."
2616   (interactive)
2617   (newsticker--cache-update t)
2618   (bury-buffer))
2619
2620 (defun newsticker-next-new-item (&optional do-not-wrap-at-eob)
2621   "Go to next new news item.
2622 If no new item is found behind point, search is continued at
2623 beginning of buffer unless optional argument DO-NOT-WRAP-AT-EOB
2624 is non-nil."
2625   (interactive)
2626   (widen)
2627   (let ((go-ahead t))
2628     (while go-ahead
2629       (unless (newsticker--buffer-goto '(item) 'new)
2630         ;; found nothing -- wrap
2631         (unless do-not-wrap-at-eob
2632           (goto-char (point-min))
2633           (newsticker-next-new-item t))
2634         (setq go-ahead nil))
2635       (unless (newsticker--lists-intersect-p
2636                (get-text-property (point) 'invisible)
2637                buffer-invisibility-spec)
2638         ;; this item is invisible -- continue search
2639         (setq go-ahead nil))))
2640   (run-hooks 'newsticker-select-item-hook)
2641   (point))
2642
2643 (defun newsticker-previous-new-item (&optional do-not-wrap-at-bob)
2644   "Go to previous new news item.
2645 If no new item is found before point, search is continued at
2646 beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
2647 is non-nil."
2648   (interactive)
2649   (widen)
2650   (let ((go-ahead t))
2651     (while go-ahead
2652       (unless (newsticker--buffer-goto '(item) 'new t)
2653         (unless do-not-wrap-at-bob
2654           (goto-char (point-max))
2655           (newsticker--buffer-goto '(item) 'new t)))
2656       (unless (newsticker--lists-intersect-p
2657                (get-text-property (point) 'invisible)
2658                     buffer-invisibility-spec)
2659         (setq go-ahead nil))))
2660   (run-hooks 'newsticker-select-item-hook)
2661   (point))
2662
2663 (defun newsticker-next-item (&optional do-not-wrap-at-eob)
2664   "Go to next news item.
2665 Return new buffer position.
2666 If no item is found below point, search is continued at beginning
2667 of buffer unless optional argument DO-NOT-WRAP-AT-EOB is
2668 non-nil."
2669   (interactive)
2670   (widen)
2671   (let ((go-ahead t)
2672         (search-list '(item)))
2673     (if newsticker--auto-narrow-to-item
2674         (setq search-list '(item feed)))
2675     (while go-ahead
2676       (unless (newsticker--buffer-goto search-list)
2677         ;; found nothing -- wrap
2678         (unless do-not-wrap-at-eob
2679           (goto-char (point-min)))
2680         (setq go-ahead nil))
2681       (unless (newsticker--lists-intersect-p
2682                (get-text-property (point) 'invisible)
2683                     buffer-invisibility-spec)
2684         (setq go-ahead nil))))
2685   (run-hooks 'newsticker-select-item-hook)
2686   (force-mode-line-update)
2687   (point))
2688
2689 (defun newsticker-previous-item (&optional do-not-wrap-at-bob)
2690   "Go to previous news item.
2691 Return new buffer position.
2692 If no item is found before point, search is continued at
2693 beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
2694 is non-nil."
2695   (interactive)
2696   (widen)
2697   (let ((go-ahead t)
2698         (search-list '(item)))
2699     (if newsticker--auto-narrow-to-item
2700         (setq search-list '(item feed)))
2701     (when (bobp)
2702       (unless do-not-wrap-at-bob
2703         (goto-char (point-max))))
2704     (while go-ahead
2705       (if (newsticker--buffer-goto search-list nil t)
2706           (unless (newsticker--lists-intersect-p
2707                    (get-text-property (point) 'invisible)
2708                    buffer-invisibility-spec)
2709             (setq go-ahead nil))
2710         (goto-char (point-min))
2711         (setq go-ahead nil))))
2712   (run-hooks 'newsticker-select-item-hook)
2713   (force-mode-line-update)
2714   (point))
2715
2716 (defun newsticker-next-feed ()
2717   "Go to next news feed.
2718 Return new buffer position."
2719   (interactive)
2720   (widen)
2721   (newsticker--buffer-goto '(feed))
2722   (run-hooks 'newsticker-select-feed-hook)
2723   (force-mode-line-update)
2724   (point))
2725
2726 (defun newsticker-previous-feed ()
2727   "Go to previous news feed.
2728 Return new buffer position."
2729   (interactive)
2730   (widen)
2731   (newsticker--buffer-goto '(feed) nil t)
2732   (run-hooks 'newsticker-select-feed-hook)
2733   (force-mode-line-update)
2734   (point))
2735
2736 (defun newsticker-mark-all-items-at-point-as-read ()
2737   "Mark all items as read and clear ticker contents."
2738   (interactive)
2739   (when (or newsticker--buffer-uptodate-p
2740             (y-or-n-p
2741              "Buffer is not up to date -- really mark items as read? "))
2742     (let ((feed (get-text-property (point) 'feed))
2743           (pos (point)))
2744       (when feed
2745         (message "Marking all items as read for %s" (symbol-name feed))
2746         (newsticker--cache-replace-age newsticker--cache feed 'new 'old)
2747         (newsticker--cache-replace-age newsticker--cache feed 'obsolete
2748                                        'old)
2749         (newsticker--cache-update)
2750         (newsticker--buffer-set-uptodate nil)
2751         (newsticker--ticker-text-setup)
2752         (newsticker-buffer-update)
2753         ;; go back to where we came frome
2754         (goto-char pos)
2755         (end-of-line)
2756         (newsticker--buffer-goto '(feed) nil t)))))
2757
2758 (defun newsticker-mark-item-at-point-as-read (&optional respect-immortality)
2759   "Mark item at point as read.
2760 If optional argument RESPECT-IMMORTALITY is not nil immortal items do
2761 not get changed."
2762   (interactive)
2763   (when (or newsticker--buffer-uptodate-p
2764             (y-or-n-p
2765              "Buffer is not up to date -- really mark this item as read? "))
2766     (let ((feed (get-text-property (point) 'feed))
2767           (item nil))
2768       (when feed
2769         (save-excursion
2770           (newsticker--buffer-beginning-of-item)
2771           (let ((inhibit-read-only t)
2772                 (age (get-text-property (point) 'nt-age))
2773                 (title (get-text-property (point) 'nt-title))
2774                 (guid (get-text-property (point) 'nt-guid))
2775                 (nt-desc (get-text-property (point) 'nt-desc))
2776                 (pos (save-excursion (newsticker--buffer-end-of-item))))
2777             (when (or (eq age 'new)
2778                       (eq age 'obsolete)
2779                       (and (eq age 'immortal)
2780                            (not respect-immortality)))
2781               ;; find item
2782               (setq item (newsticker--cache-contains newsticker--cache
2783                                                      feed title nt-desc
2784                                                      nil nil guid))
2785               ;; mark as old
2786               (when item
2787                 (setcar (nthcdr 4 item) 'old)
2788                 (newsticker--do-forget-preformatted item))
2789               ;; clean up ticker
2790               (if (or (and (eq age 'new)
2791                            newsticker-hide-immortal-items-in-echo-area)
2792                       (and (memq age '(old immortal))
2793                            (not
2794                             (eq newsticker-hide-old-items-in-newsticker-buffer
2795                                 newsticker-hide-immortal-items-in-echo-area))))
2796                   (newsticker--ticker-text-remove feed title))
2797               ;; set faces etc.
2798               (save-excursion
2799                 (save-restriction
2800                   (widen)
2801                   (put-text-property (point) pos 'nt-age 'old)
2802                   (newsticker--buffer-set-faces (point) pos)))
2803               (set-buffer-modified-p nil))))
2804         ;; move forward
2805         (newsticker-next-item t)))))
2806
2807 (defun newsticker-mark-item-at-point-as-immortal ()
2808   "Mark item at point as read."
2809   (interactive)
2810   (when (or newsticker--buffer-uptodate-p
2811             (y-or-n-p
2812              "Buffer is not up to date -- really mark this item as read? "))
2813     (let ((feed (get-text-property (point) 'feed))
2814           (item nil))
2815       (when feed
2816         (save-excursion
2817           (newsticker--buffer-beginning-of-item)
2818           (let ((inhibit-read-only t)
2819                 (oldage (get-text-property (point) 'nt-age))
2820                 (title (get-text-property (point) 'nt-title))
2821                 (guid (get-text-property (point) 'nt-guid))
2822                 (pos  (save-excursion (newsticker--buffer-end-of-item))))
2823             (let ((newage 'immortal))
2824               (if (eq oldage 'immortal)
2825                   (setq newage 'old))
2826               (setq item (newsticker--cache-contains newsticker--cache
2827                                                      feed title nil nil nil
2828                                                      guid))
2829               ;; change age
2830               (when item
2831                 (setcar (nthcdr 4 item) newage)
2832                 (newsticker--do-forget-preformatted item))
2833               (if (or (and (eq newage 'immortal)
2834                            newsticker-hide-immortal-items-in-echo-area)
2835                       (and (eq newage 'obsolete)
2836                            newsticker-hide-obsolete-items-in-echo-area)
2837                       (and (eq oldage 'immortal)
2838                            (not
2839                             (eq newsticker-hide-old-items-in-newsticker-buffer
2840                                 newsticker-hide-immortal-items-in-echo-area))))
2841                   (newsticker--ticker-text-remove feed title)
2842                 (newsticker--ticker-text-setup))
2843               (save-excursion
2844                 (save-restriction
2845                   (widen)
2846                   (put-text-property (point) pos 'nt-age newage)
2847                   (if (eq newage 'immortal)
2848                       (put-text-property (point) pos 'nt-age 'immortal)
2849                     (put-text-property (point) pos 'nt-age 'old))
2850                   (newsticker--buffer-set-faces (point) pos))))))
2851           (if item
2852             (newsticker-next-item t))))))
2853
2854 (defun newsticker-mark-all-items-as-read ()
2855   "Mark all items as read and clear ticker contents."
2856   (interactive)
2857   (when (or newsticker--buffer-uptodate-p
2858             (y-or-n-p
2859              "Buffer is not up to date -- really mark items as read? "))
2860     (newsticker--cache-replace-age newsticker--cache 'any 'new 'old)
2861     (newsticker--buffer-set-uptodate nil)
2862     (newsticker--ticker-text-setup)
2863     (newsticker--cache-update)
2864     (newsticker-buffer-update)))
2865
2866 (defun newsticker-hide-extra ()
2867   "Hide the extra elements of items."
2868   (interactive)
2869   (newsticker--buffer-hideshow 'extra nil)
2870   (newsticker--buffer-redraw))
2871
2872 (defun newsticker-show-extra ()
2873   "Show the extra elements of items."
2874   (interactive)
2875   (newsticker--buffer-hideshow 'extra t)
2876   (newsticker--buffer-redraw))
2877
2878 (defun newsticker-hide-old-item-desc ()
2879   "Hide the description of old items."
2880   (interactive)
2881   (newsticker--buffer-hideshow 'desc-old nil)
2882   (newsticker--buffer-redraw))
2883
2884 (defun newsticker-show-old-item-desc ()
2885   "Show the description of old items."
2886   (interactive)
2887   (newsticker--buffer-hideshow 'item-old t)
2888   (newsticker--buffer-hideshow 'desc-old t)
2889   (newsticker--buffer-redraw))
2890
2891 (defun newsticker-hide-new-item-desc ()
2892   "Hide the description of new items."
2893   (interactive)
2894   (newsticker--buffer-hideshow 'desc-new nil)
2895   (newsticker--buffer-hideshow 'desc-immortal nil)
2896   (newsticker--buffer-hideshow 'desc-obsolete nil)
2897   (newsticker--buffer-redraw))
2898
2899 (defun newsticker-show-new-item-desc ()
2900   "Show the description of new items."
2901   (interactive)
2902   (newsticker--buffer-hideshow 'desc-new t)
2903   (newsticker--buffer-hideshow 'desc-immortal t)
2904   (newsticker--buffer-hideshow 'desc-obsolete t)
2905   (newsticker--buffer-redraw))
2906
2907 (defun newsticker-hide-feed-desc ()
2908   "Hide the description of feeds."
2909   (interactive)
2910   (newsticker--buffer-hideshow 'desc-feed nil)
2911   (newsticker--buffer-redraw))
2912
2913 (defun newsticker-show-feed-desc ()
2914   "Show the description of old items."
2915   (interactive)
2916   (newsticker--buffer-hideshow 'desc-feed t)
2917   (newsticker--buffer-redraw))
2918
2919 (defun newsticker-hide-all-desc ()
2920   "Hide the descriptions of feeds and all items."
2921   (interactive)
2922   (newsticker--buffer-hideshow 'desc-feed nil)
2923   (newsticker--buffer-hideshow 'desc-immortal nil)
2924   (newsticker--buffer-hideshow 'desc-obsolete nil)
2925   (newsticker--buffer-hideshow 'desc-new  nil)
2926   (newsticker--buffer-hideshow 'desc-old  nil)
2927   (newsticker--buffer-redraw))
2928
2929 (defun newsticker-show-all-desc ()
2930   "Show the descriptions of feeds and all items."
2931   (interactive)
2932   (newsticker--buffer-hideshow 'desc-feed t)
2933   (newsticker--buffer-hideshow 'desc-immortal  t)
2934   (newsticker--buffer-hideshow 'desc-obsolete  t)
2935   (newsticker--buffer-hideshow 'desc-new  t)
2936   (newsticker--buffer-hideshow 'desc-old  t)
2937   (newsticker--buffer-redraw))
2938
2939 (defun newsticker-hide-old-items ()
2940   "Hide old items."
2941   (interactive)
2942   (newsticker--buffer-hideshow 'desc-old nil)
2943   (newsticker--buffer-hideshow 'item-old nil)
2944   (newsticker--buffer-redraw))
2945
2946 (defun newsticker-show-old-items ()
2947   "Show old items."
2948   (interactive)
2949   (newsticker--buffer-hideshow 'item-old t)
2950   (newsticker--buffer-redraw))
2951
2952 (defun newsticker-hide-entry ()
2953   "Hide description of entry at point."
2954   (interactive)
2955   (save-excursion
2956     (let* (pos1 pos2
2957                 (inhibit-read-only t)
2958                 inv-prop org-inv-prop
2959                 is-invisible)
2960       (newsticker--buffer-beginning-of-item)
2961       (newsticker--buffer-goto '(desc))
2962       (setq pos1 (max (point-min) (1- (point))))
2963       (newsticker--buffer-goto '(extra feed item nil))
2964       (setq pos2 (max (point-min) (1- (point))))
2965       (setq inv-prop (get-text-property pos1 'invisible))
2966       (setq org-inv-prop (get-text-property pos1 'org-invisible))
2967       (cond ((eq inv-prop t)
2968              ;; do nothing
2969              )
2970             ((eq org-inv-prop nil)
2971              (add-text-properties pos1 pos2
2972                                   (list 'invisible t
2973                                         'org-invisible inv-prop)))
2974             (t
2975              ;; toggle
2976              (add-text-properties pos1 pos2
2977                                   (list 'invisible org-inv-prop))
2978              (remove-text-properties pos1 pos2 '(org-invisible))))))
2979   (newsticker--buffer-redraw))
2980
2981 (defun newsticker-show-entry ()
2982   "Show description of entry at point."
2983   (interactive)
2984   (save-excursion
2985     (let* (pos1 pos2
2986                 (inhibit-read-only t)
2987                 inv-prop org-inv-prop
2988                 is-invisible)
2989       (newsticker--buffer-beginning-of-item)
2990       (newsticker--buffer-goto '(desc))
2991       (setq pos1 (max (point-min) (1- (point))))
2992       (newsticker--buffer-goto '(extra feed item))
2993       (setq pos2 (max (point-min) (1- (point))))
2994       (setq inv-prop (get-text-property pos1 'invisible))
2995       (setq org-inv-prop (get-text-property pos1 'org-invisible))
2996       (cond ((eq org-inv-prop nil)
2997              (add-text-properties pos1 pos2
2998                                   (list 'invisible nil
2999                                         'org-invisible inv-prop)))
3000             (t
3001              ;; toggle
3002              (add-text-properties pos1 pos2
3003                                   (list 'invisible org-inv-prop))
3004              (remove-text-properties pos1 pos2 '(org-invisible))))))
3005   (newsticker--buffer-redraw))
3006
3007 (defun newsticker-toggle-auto-narrow-to-feed ()
3008   "Toggle narrowing to current news feed.
3009 If auto-narrowing is active, only news item of the current feed
3010 are visible."
3011   (interactive)
3012   (newsticker-set-auto-narrow-to-feed
3013    (not newsticker--auto-narrow-to-feed)))
3014
3015 (defun newsticker-set-auto-narrow-to-feed (value)
3016   "Turn narrowing to current news feed on or off.
3017 If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
3018   (interactive)
3019   (setq newsticker--auto-narrow-to-item nil)
3020   (setq newsticker--auto-narrow-to-feed value)
3021   (widen)
3022   (newsticker--buffer-make-item-completely-visible)
3023   (run-hooks 'newsticker-narrow-hook))
3024
3025 (defun newsticker-toggle-auto-narrow-to-item ()
3026   "Toggle narrowing to current news item.
3027 If auto-narrowing is active, only one item of the current feed
3028 is visible."
3029   (interactive)
3030   (newsticker-set-auto-narrow-to-item
3031    (not newsticker--auto-narrow-to-item)))
3032
3033 (defun newsticker-set-auto-narrow-to-item (value)
3034   "Turn narrowing to current news item on or off.
3035 If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
3036   (interactive)
3037   (setq newsticker--auto-narrow-to-feed nil)
3038   (setq newsticker--auto-narrow-to-item value)
3039   (widen)
3040   (newsticker--buffer-make-item-completely-visible)
3041   (run-hooks 'newsticker-narrow-hook))
3042
3043 (defun newsticker-customize ()
3044   "Open the newsticker customization group."
3045   (interactive)
3046   (customize-group "newsticker"))
3047
3048 (defun newsticker-next-feed-available-p ()
3049   "Return t if position is before last feed, nil otherwise."
3050   (save-excursion
3051     (let ((p (point)))
3052       (newsticker--buffer-goto '(feed))
3053       (not (= p (point))))))
3054
3055 (defun newsticker-previous-feed-available-p ()
3056   "Return t if position is behind first feed, nil otherwise."
3057   (save-excursion
3058     (let ((p (point)))
3059       (newsticker--buffer-goto '(feed) nil t)
3060       (not (= p (point))))))
3061
3062 (defun newsticker-next-item-available-p ()
3063   "Return t if position is before last feed, nil otherwise."
3064   (save-excursion
3065     (catch 'result
3066       (while (< (point) (point-max))
3067         (unless (newsticker--buffer-goto '(item))
3068           (throw 'result nil))
3069         (unless (newsticker--lists-intersect-p
3070                  (get-text-property (point) 'invisible)
3071                  buffer-invisibility-spec)
3072           (throw 'result t))))))
3073
3074 (defun newsticker-previous-item-available-p ()
3075   "Return t if position is behind first item, nil otherwise."
3076   (save-excursion
3077     (catch 'result
3078       (while (> (point) (point-min))
3079         (unless (newsticker--buffer-goto '(item) nil t)
3080           (throw 'result nil))
3081         (unless (newsticker--lists-intersect-p
3082                  (get-text-property (point) 'invisible)
3083                  buffer-invisibility-spec)
3084           (throw 'result t))))))
3085
3086 (defun newsticker-item-not-old-p ()
3087   "Return t if there is an item at point which is not old, nil otherwise."
3088     (when (get-text-property (point) 'feed)
3089       (save-excursion
3090         (newsticker--buffer-beginning-of-item)
3091         (let ((age (get-text-property (point) 'nt-age)))
3092           (and (memq  age '(new immortal obsolete)) t)))))
3093
3094 (defun newsticker-item-not-immortal-p ()
3095   "Return t if there is an item at point which is not immortal, nil otherwise."
3096     (when (get-text-property (point) 'feed)
3097       (save-excursion
3098         (newsticker--buffer-beginning-of-item)
3099         (let ((age (get-text-property (point) 'nt-age)))
3100           (and (memq  age '(new old obsolete)) t)))))
3101
3102 ;; ======================================================================
3103 ;;; local stuff
3104 ;; ======================================================================
3105 (defun newsticker-get-news (feed-name)
3106   "Get news from the site FEED-NAME and load feed logo.
3107 FEED-NAME must be a string which occurs as the label (i.e. the first element)
3108 in an element of `newsticker-url-list' or `newsticker-url-list-defaults'."
3109   (newsticker--debug-msg "%s: Getting news for %s"
3110                          (format-time-string "%A, %H:%M" (current-time))
3111                          feed-name)
3112   (let* ((buffername (concat " *newsticker-wget-" feed-name "*"))
3113          (item (or (assoc feed-name newsticker-url-list)
3114                    (assoc feed-name newsticker-url-list-defaults)
3115                    (error
3116                     "Cannot get news for %s: Check newsticker-url-list"
3117                     feed-name)))
3118          (url (cadr item))
3119          (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
3120                              newsticker-wget-arguments)))
3121     (save-excursion
3122       (set-buffer (get-buffer-create buffername))
3123       (erase-buffer)
3124       ;; throw an error if there is an old wget-process around
3125       (if (get-process feed-name)
3126           (error "Another wget-process is running for %s" feed-name))
3127       ;; start wget
3128       (let* ((args (append wget-arguments (list url)))
3129              (proc (apply 'start-process feed-name buffername
3130                           newsticker-wget-name args)))
3131         (set-process-coding-system proc 'no-conversion 'no-conversion)
3132         (set-process-sentinel proc 'newsticker--sentinel)
3133         (setq newsticker--process-ids (cons (process-id proc)
3134                                             newsticker--process-ids))
3135         (force-mode-line-update)))))
3136
3137 (defun newsticker-mouse-browse-url (event)
3138   "Call `browse-url' for the link of the item at which the EVENT occurred."
3139   (interactive "e")
3140   (save-excursion
3141     (switch-to-buffer (window-buffer (posn-window (event-end event))))
3142     (let ((url (get-text-property (posn-point (event-end event))
3143                                   'nt-link)))
3144       (when url
3145         (browse-url url)
3146         (save-excursion
3147           (goto-char (posn-point (event-end event)))
3148           (if newsticker-automatically-mark-visited-items-as-old
3149               (newsticker-mark-item-at-point-as-read t)))))))
3150
3151 (defun newsticker-browse-url ()
3152   "Call `browse-url' for the link of the item at point."
3153   (interactive)
3154   (let ((url (get-text-property (point) 'nt-link)))
3155     (when url
3156       (browse-url url)
3157       (if newsticker-automatically-mark-visited-items-as-old
3158           (newsticker-mark-item-at-point-as-read t)))))
3159
3160 (defvar newsticker-open-url-history
3161   '("wget" "xmms" "realplay")
3162   "...")
3163
3164 (defun newsticker-handle-url ()
3165   "Ask for a program to open the link of the item at point."
3166   (interactive)
3167   (let ((url (get-text-property (point) 'nt-link)))
3168     (when url
3169       (let ((prog (read-string "Open url with: " nil
3170                                'newsticker-open-url-history)))
3171         (when prog
3172           (message "%s %s" prog url)
3173           (start-process prog prog prog url)
3174       (if newsticker-automatically-mark-visited-items-as-old
3175           (newsticker-mark-item-at-point-as-read t)))))))
3176
3177 (defun newsticker--sentinel (process event)
3178   "Sentinel for extracting news titles from an RDF buffer.
3179 Argument PROCESS is the process which has just changed its state.
3180 Argument EVENT tells what has happened to the process."
3181   (let* ((p-status (process-status process))
3182          (exit-status (process-exit-status process))
3183          (time (current-time))
3184          (name (process-name process))
3185          (name-symbol (intern name))
3186          (something-was-added nil))
3187     ;; catch known errors (zombie processes, rubbish-xml etc.
3188     ;; if an error occurs the news feed is not updated!
3189     (catch 'oops
3190       (unless (and (eq p-status 'exit)
3191                    (= exit-status 0))
3192         (setq newsticker--cache
3193               (newsticker--cache-add
3194                newsticker--cache
3195                name-symbol
3196                newsticker--error-headline
3197                (format
3198                 (concat "%s: Newsticker could not retrieve news from %s.\n"
3199                         "Return status: `%s'\n"
3200                         "Command was `%s'")
3201                 (format-time-string "%A, %H:%M" (current-time))
3202                 name event (process-command process))
3203                ""
3204                (current-time)
3205                'new
3206                0 nil))
3207         (message "%s: Error while retrieving news from %s"
3208                  (format-time-string "%A, %H:%M" (current-time))
3209                  (process-name process))
3210         (throw 'oops nil))
3211       (let* ((coding-system 'utf-8)
3212              (node-list
3213               (save-current-buffer
3214                 (set-buffer (process-buffer process))
3215                 ;; a very very dirty workaround to overcome the
3216                 ;; problems with the newest (20030621) xml.el:
3217                 ;; remove all unnecessary whitespace
3218                 (goto-char (point-min))
3219                 (while (re-search-forward ">[ \t\r\n]+<" nil t)
3220                   (replace-match "><" nil t))
3221                 ;; and another brutal workaround (20031105)!  For some
3222                 ;; reason the xml parser does not like the colon in the
3223                 ;; doctype name "rdf:RDF"
3224                 (goto-char (point-min))
3225                 (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t)
3226                   (replace-match "<!DOCTYPE rdfColonRDF" nil t))
3227                 ;; finally.... ~##^°!!!!!
3228                 (goto-char (point-min))
3229                 (while (search-forward "\r\n" nil t)
3230                   (replace-match "\n" nil t))
3231                 ;; still more brutal workarounds (20040309)!  The xml
3232                 ;; parser does not like doctype rss
3233                 (goto-char (point-min))
3234                 (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t)
3235                   (replace-match "" nil t))
3236                 ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
3237                 ;; Remove comments to avoid this xml-parsing bug:
3238                 ;; "XML files can have only one toplevel tag"
3239                 (goto-char (point-min))
3240                 (while (search-forward "<!--" nil t)
3241                   (let ((start (match-beginning 0)))
3242                     (unless (search-forward "-->" nil t)
3243                       (error "Can't find end of comment"))
3244                     (delete-region start (point))))
3245                 ;; And another one (20050702)! If description is HTML
3246                 ;; encoded and starts with a `<', wrap the whole
3247                 ;; description in a CDATA expression.  This happened for
3248                 ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
3249                  (goto-char (point-min))
3250                  (while (re-search-forward
3251                          "<description>\\(<img.*?\\)</description>" nil t)
3252                    (replace-match
3253                     "<description><![CDATA[ \\1 ]]></description>"))
3254                 ;;
3255                 (set-buffer-modified-p nil)
3256                 ;; check coding system
3257                 (goto-char (point-min))
3258                 (if (re-search-forward "encoding=\"\\([^\"]+\\)\""
3259                                        nil t)
3260                     (setq coding-system (intern (downcase (match-string 1))))
3261                   (setq coding-system
3262                         (condition-case nil
3263                               (check-coding-system coding-system)
3264                           (coding-system-error
3265                            (message
3266                             "newsticker.el: ignoring coding system %s for %s"
3267                             coding-system name)
3268                            nil))))
3269                 ;; Decode if possible
3270                 (when coding-system
3271                   (decode-coding-region (point-min) (point-max)
3272                                         coding-system))
3273                 (condition-case errordata
3274                     ;; The xml parser might fail
3275                     ;; or the xml might be bugged
3276                     (xml-parse-region (point-min) (point-max))
3277                   (error (message "Could not parse %s: %s"
3278                                   (buffer-name) (cadr errordata))
3279                          (throw 'oops nil)))))
3280              (topnode (car node-list))
3281              (channelnode (car (xml-get-children topnode 'channel)))
3282              (imageurl nil))
3283         ;; mark all items as obsolete
3284         (newsticker--cache-replace-age newsticker--cache
3285                                        name-symbol
3286                                        'new 'obsolete-new)
3287         (newsticker--cache-replace-age newsticker--cache
3288                                        name-symbol
3289                                        'old 'obsolete-old)
3290         (newsticker--cache-replace-age newsticker--cache
3291                                        name-symbol
3292                                        'feed 'obsolete-old)
3293
3294         ;; check Atom/RSS version and call corresponding parser
3295         (condition-case error-data
3296             (if (cond
3297                  ;; RSS 0.91
3298                  ((and (eq 'rss (xml-node-name topnode))
3299                        (string= "0.91" (xml-get-attribute topnode 'version)))
3300                   (setq imageurl (newsticker--get-logo-url-rss-0.91 topnode))
3301                   (newsticker--parse-rss-0.91 name time topnode))
3302                  ;; RSS 0.92
3303                  ((and (eq 'rss (xml-node-name topnode))
3304                        (string= "0.92" (xml-get-attribute topnode 'version)))
3305                   (setq imageurl (newsticker--get-logo-url-rss-0.92 topnode))
3306                   (newsticker--parse-rss-0.92 name time topnode))
3307                  ;; RSS 1.0
3308                  ((eq 'rdf:RDF (xml-node-name topnode))
3309                   (setq imageurl (newsticker--get-logo-url-rss-1.0 topnode))
3310                   (newsticker--parse-rss-1.0 name time topnode))
3311                  ;; RSS 2.0
3312                  ((and (eq 'rss (xml-node-name topnode))
3313                        (string= "2.0" (xml-get-attribute topnode 'version)))
3314                   (setq imageurl (newsticker--get-logo-url-rss-2.0 topnode))
3315                   (newsticker--parse-rss-2.0 name time topnode))
3316                  ;; Atom 0.3
3317                  ((and (eq 'feed (xml-node-name topnode))
3318                        (string= "http://purl.org/atom/ns#"
3319                                 (xml-get-attribute topnode 'xmlns)))
3320                   (setq imageurl (newsticker--get-logo-url-atom-0.3 topnode))
3321                   (newsticker--parse-atom-0.3 name time topnode))
3322                  ;; Atom 1.0
3323                  ((and (eq 'feed (xml-node-name topnode))
3324                        (string= "http://www.w3.org/2005/Atom"
3325                                 (xml-get-attribute topnode 'xmlns)))
3326                   (setq imageurl (newsticker--get-logo-url-atom-1.0 topnode))
3327                   (newsticker--parse-atom-1.0 name time topnode))
3328                  ;; unknown feed type
3329                  (t
3330                   (newsticker--debug-msg "Feed type unknown: %s: %s"
3331                                          (xml-node-name topnode) name)
3332                   nil))
3333                 (setq something-was-added t))
3334           (xerror (message "sentinelerror in %s: %s" name error-data)))
3335
3336         ;; Remove those old items from cache which have been removed from
3337         ;; the feed
3338         (newsticker--cache-replace-age newsticker--cache
3339                                        name-symbol 'obsolete-old 'deleteme)
3340         (newsticker--cache-remove newsticker--cache name-symbol
3341                                   'deleteme)
3342         ;; Remove those new items from cache which have been removed from
3343         ;; the feed.  Or keep them as `obsolete'
3344         (if (not newsticker-keep-obsolete-items)
3345             (newsticker--cache-remove newsticker--cache
3346                                       name-symbol 'obsolete-new)
3347           (setq newsticker--cache
3348                 (newsticker--cache-mark-expired
3349                  newsticker--cache name-symbol 'obsolete 'obsolete-expired
3350                  newsticker-obsolete-item-max-age))
3351           (newsticker--cache-remove newsticker--cache
3352                                     name-symbol 'obsolete-expired)
3353           (newsticker--cache-replace-age newsticker--cache
3354                                          name-symbol 'obsolete-new
3355                                          'obsolete))
3356         (newsticker--update-process-ids)
3357         ;; setup scrollable text
3358         (when (= 0 (length newsticker--process-ids))
3359           (newsticker--ticker-text-setup))
3360         (setq newsticker--latest-update-time (current-time))
3361         (when something-was-added
3362           ;; FIXME: should we care about removed items as well?
3363           (newsticker--cache-update)
3364           (newsticker--buffer-set-uptodate nil))
3365         ;; kill the process buffer if wanted
3366         (unless newsticker-debug
3367           (kill-buffer (process-buffer process)))
3368         ;; launch retrieval of image
3369         (when (and imageurl
3370                    (string-match "%l" newsticker-heading-format))
3371           (newsticker--image-get name imageurl))))))
3372
3373 (defun newsticker--get-logo-url-atom-1.0 (node)
3374   "Return logo URL from atom 1.0 data in NODE."
3375   (car (xml-node-children
3376         (car (xml-get-children node 'logo)))))
3377
3378 (defun newsticker--get-logo-url-atom-0.3 (node)
3379   "Return logo URL from atom 0.3 data in NODE."
3380   (car (xml-node-children
3381         (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
3382
3383 (defun newsticker--get-logo-url-rss-2.0 (node)
3384   "Return logo URL from RSS 2.0 data in NODE."
3385   (car (xml-node-children
3386         (car (xml-get-children
3387               (car (xml-get-children
3388                     (car (xml-get-children node 'channel)) 'image)) 'url)))))
3389
3390 (defun newsticker--get-logo-url-rss-1.0 (node)
3391   "Return logo URL from RSS 1.0 data in NODE."
3392   (car (xml-node-children
3393         (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
3394
3395 (defun newsticker--get-logo-url-rss-0.92 (node)
3396   "Return logo URL from RSS 0.92 data in NODE."
3397   (car (xml-node-children
3398         (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
3399
3400 (defun newsticker--get-logo-url-rss-0.91 (node)
3401   "Return logo URL from RSS 0.91 data in NODE."
3402   (car (xml-node-children
3403         (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
3404
3405 (defun newsticker--parse-atom-0.3 (name time topnode)
3406   "Parse Atom 0.3 data.
3407 Return value as well as arguments NAME, TIME, and TOPNODE are the
3408 same as in `newsticker--parse-atom-1.0'."
3409   (newsticker--debug-msg "Parsing Atom 0.3 feed %s" name)
3410   (let (new-feed new-item)
3411     (setq new-feed (newsticker--parse-generic-feed
3412                     name time
3413                     ;; title
3414                     (car (xml-node-children
3415                           (car (xml-get-children topnode 'title))))
3416                     ;; desc
3417                     (car (xml-node-children
3418                           (car (xml-get-children topnode 'content))))
3419                     ;; link
3420                     (xml-get-attribute
3421                      (car (xml-get-children topnode 'link)) 'href)
3422                     ;; extra-elements
3423                     (xml-node-children topnode)))
3424     (setq new-item (newsticker--parse-generic-items
3425                     name time (xml-get-children topnode 'entry)
3426                     ;; title-fn
3427                     (lambda (node)
3428                       (car (xml-node-children
3429                             (car (xml-get-children node 'title)))))
3430                     ;; desc-fn
3431                     (lambda (node)
3432                       (or (car (xml-node-children
3433                                 (car (xml-get-children node 'content))))
3434                           (car (xml-node-children
3435                                 (car (xml-get-children node 'summary))))))
3436                     ;; link-fn
3437                     (lambda (node)
3438                       (xml-get-attribute
3439                        (car (xml-get-children node 'link)) 'href))
3440                     ;; time-fn
3441                     (lambda (node)
3442                       (newsticker--decode-rfc822-date
3443                             (car (xml-node-children
3444                                   (car (xml-get-children node 'modified))))))
3445                     ;; guid-fn
3446                     (lambda (node)
3447                       (let ((tguid (assoc 'guid (xml-node-children node))))
3448                         (if (stringp tguid)
3449                             tguid
3450                           (car (xml-node-children tguid)))))
3451                     ;; extra-fn
3452                     (lambda (node)
3453                       (xml-node-children node))))
3454     (or new-item new-feed)))
3455
3456 (defun newsticker--parse-atom-1.0 (name time topnode)
3457   "Parse Atom 1.0 data.
3458 Argument NAME gives the name of a news feed.  TIME gives the
3459 system time at which the data have been retrieved.  TOPNODE
3460 contains the feed data as returned by the xml parser.
3461
3462 For the Atom 1.0 specification see
3463 http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html"
3464   (newsticker--debug-msg "Parsing Atom 1.0 feed %s" name)
3465   (let (new-feed new-item)
3466     (setq new-feed (newsticker--parse-generic-feed
3467                     name time
3468                     ;; title
3469                     (car (xml-node-children
3470                           (car (xml-get-children topnode 'title))))
3471                     ;; desc
3472                     (car (xml-node-children
3473                           (car (xml-get-children topnode 'subtitle))))
3474                     ;; link
3475                     (car (xml-node-children
3476                           (car (xml-get-children topnode 'link))))
3477                     ;; extra-elements
3478                     (xml-node-children topnode)))
3479     (setq new-item (newsticker--parse-generic-items
3480                     name time (xml-get-children topnode 'entry)
3481                     ;; title-fn
3482                     (lambda (node)
3483                       (car (xml-node-children
3484                             (car (xml-get-children node 'title)))))
3485                     ;; desc-fn
3486                     (lambda (node)
3487                       (or (car (xml-node-children
3488                                 (car (xml-get-children node 'content))))
3489                           (car (xml-node-children
3490                                 (car (xml-get-children node 'summary))))))
3491                     ;; link-fn
3492                     (lambda (node)
3493                       (car (xml-node-children
3494                             (car (xml-get-children node 'link)))))
3495                     ;; time-fn
3496                     (lambda (node)
3497                       (newsticker--decode-iso8601-date
3498                        (or (car (xml-node-children
3499                                  (car (xml-get-children node 'updated))))
3500                            (car (xml-node-children
3501                                  (car (xml-get-children node 'published)))))))
3502                     ;; guid-fn
3503                     (lambda (node)
3504                       (car (xml-node-children
3505                             (car (xml-get-children node 'id)))))
3506                     ;; extra-fn
3507                     (lambda (node)
3508                       (xml-node-children node))))
3509     (or new-item new-feed)))
3510
3511 (defun newsticker--parse-rss-0.91 (name time topnode)
3512   "Parse RSS 0.91 data.
3513 Return value as well as arguments NAME, TIME, and TOPNODE are the
3514 same as in `newsticker--parse-atom-1.0'.
3515
3516 For the RSS 0.91 specification see http://backend.userland.com/rss091 or
3517 http://my.netscape.com/publish/formats/rss-spec-0.91.html."
3518   (newsticker--debug-msg "Parsing RSS 0.91 feed %s" name)
3519   (let* ((channelnode (car (xml-get-children topnode 'channel)))
3520          (pub-date (newsticker--decode-rfc822-date
3521                     (car (xml-node-children
3522                           (car (xml-get-children channelnode 'pubDate))))))
3523          is-new-feed has-new-items)
3524     (setq is-new-feed (newsticker--parse-generic-feed
3525                        name time
3526                        ;; title
3527                        (car (xml-node-children
3528                              (car (xml-get-children channelnode 'title))))
3529                        ;; desc
3530                        (car (xml-node-children
3531                              (car (xml-get-children channelnode
3532                                                     'description))))
3533                        ;; link
3534                        (car (xml-node-children
3535                              (car (xml-get-children channelnode 'link))))
3536                        ;; extra-elements
3537                        (xml-node-children channelnode)))
3538     (setq has-new-items (newsticker--parse-generic-items
3539                          name time (xml-get-children channelnode 'item)
3540                          ;; title-fn
3541                          (lambda (node)
3542                            (car (xml-node-children
3543                                  (car (xml-get-children node 'title)))))
3544                          ;; desc-fn
3545                          (lambda (node)
3546                            (car (xml-node-children
3547                                  (car (xml-get-children node 'description)))))
3548                          ;; link-fn
3549                          (lambda (node)
3550                            (car (xml-node-children
3551                                  (car (xml-get-children node 'link)))))
3552                          ;; time-fn
3553                          (lambda (node)
3554                            pub-date)
3555                          ;; guid-fn
3556                          (lambda (node)
3557                            nil)
3558                          ;; extra-fn
3559                          (lambda (node)
3560                            (xml-node-children node))))
3561     (or has-new-items is-new-feed)))
3562
3563 (defun newsticker--parse-rss-0.92 (name time topnode)
3564   "Parse RSS 0.92 data.
3565 Return value as well as arguments NAME, TIME, and TOPNODE are the
3566 same as in `newsticker--parse-atom-1.0'.
3567
3568 For the RSS 0.92 specification see http://backend.userland.com/rss092."
3569   (newsticker--debug-msg "Parsing RSS 0.92 feed %s" name)
3570   (let* ((channelnode (car (xml-get-children topnode 'channel)))
3571          (pub-date (newsticker--decode-rfc822-date
3572                     (car (xml-node-children
3573                           (car (xml-get-children channelnode 'pubDate))))))
3574          is-new-feed has-new-items)
3575     (setq is-new-feed (newsticker--parse-generic-feed
3576                        name time
3577                        ;; title
3578                        (car (xml-node-children
3579                              (car (xml-get-children channelnode 'title))))
3580                        ;; desc
3581                        (car (xml-node-children
3582                              (car (xml-get-children channelnode
3583                                                     'description))))
3584                        ;; link
3585                        (car (xml-node-children
3586                              (car (xml-get-children channelnode 'link))))
3587                        ;; extra-elements
3588                        (xml-node-children channelnode)))
3589     (setq has-new-items (newsticker--parse-generic-items
3590                          name time (xml-get-children channelnode 'item)
3591                          ;; title-fn
3592                          (lambda (node)
3593                            (car (xml-node-children
3594                                  (car (xml-get-children node 'title)))))
3595                          ;; desc-fn
3596                          (lambda (node)
3597                            (car (xml-node-children
3598                                  (car (xml-get-children node 'description)))))
3599                          ;; link-fn
3600                          (lambda (node)
3601                            (car (xml-node-children
3602                                  (car (xml-get-children node 'link)))))
3603                          ;; time-fn
3604                          (lambda (node)
3605                            pub-date)
3606                          ;; guid-fn
3607                          (lambda (node)
3608                            nil)
3609                          ;; extra-fn
3610                          (lambda (node)
3611                            (xml-node-children node))))
3612     (or has-new-items is-new-feed)))
3613
3614 (defun newsticker--parse-rss-1.0 (name time topnode)
3615   "Parse RSS 1.0 data.
3616 Return value as well as arguments NAME, TIME, and TOPNODE are the
3617 same as in `newsticker--parse-atom-1.0'.
3618
3619 For the RSS 1.0 specification see http://web.resource.org/rss/1.0/spec."
3620   (newsticker--debug-msg "Parsing RSS 1.0 feed %s" name)
3621   (let* ((channelnode (car (xml-get-children topnode 'channel)))
3622          is-new-feed has-new-items)
3623     (setq is-new-feed (newsticker--parse-generic-feed
3624                        name time
3625                        ;; title
3626                        (car (xml-node-children
3627                              (car (xml-get-children channelnode 'title))))
3628                        ;; desc
3629                        (car (xml-node-children
3630                              (car (xml-get-children channelnode
3631                                                     'description))))
3632                        ;; link
3633                        (car (xml-node-children
3634                              (car (xml-get-children channelnode 'link))))
3635                        ;; extra-elements
3636                        (xml-node-children channelnode)))
3637     (setq has-new-items (newsticker--parse-generic-items
3638                          name time (xml-get-children topnode 'item)
3639                          ;; title-fn
3640                          (lambda (node)
3641                            (car (xml-node-children
3642                                  (car (xml-get-children node 'title)))))
3643                          ;; desc-fn
3644                          (lambda (node)
3645                            (car (xml-node-children
3646                                  (car (xml-get-children node
3647                                                         'description)))))
3648                          ;; link-fn
3649                          (lambda (node)
3650                            (car (xml-node-children
3651                                  (car (xml-get-children node 'link)))))
3652                          ;; time-fn
3653                          (lambda (node)
3654                            (newsticker--decode-iso8601-date
3655                             (car (xml-node-children
3656                                   (car (xml-get-children node 'dc:date))))))
3657                          ;; guid-fn
3658                          (lambda (node)
3659                            nil)
3660                          ;; extra-fn
3661                          (lambda (node)
3662                            (xml-node-children node))))
3663     (or has-new-items is-new-feed)))
3664
3665 (defun newsticker--parse-rss-2.0 (name time topnode)
3666   "Parse RSS 2.0 data.
3667 Return value as well as arguments NAME, TIME, and TOPNODE are the
3668 same as in `newsticker--parse-atom-1.0'.
3669
3670 For the RSS 2.0 specification see http://blogs.law.harvard.edu/tech/rss."
3671   (newsticker--debug-msg "Parsing RSS 2.0 feed %s" name)
3672   (let* ((channelnode (car (xml-get-children topnode 'channel)))
3673          is-new-feed has-new-items)
3674     (setq is-new-feed (newsticker--parse-generic-feed
3675                        name time
3676                        ;; title
3677                        (car (xml-node-children
3678                              (car (xml-get-children channelnode 'title))))
3679                        ;; desc
3680                        (car (xml-node-children
3681                              (car (xml-get-children channelnode
3682                                                     'description))))
3683                        ;; link
3684                        (car (xml-node-children
3685                              (car (xml-get-children channelnode 'link))))
3686                        ;; extra-elements
3687                        (xml-node-children channelnode)))
3688     (setq has-new-items (newsticker--parse-generic-items
3689                          name time (xml-get-children channelnode 'item)
3690                          ;; title-fn
3691                          (lambda (node)
3692                            (car (xml-node-children
3693                                  (car (xml-get-children node 'title)))))
3694                          ;; desc-fn
3695                          (lambda (node)
3696                            (or (car (xml-node-children
3697                                      (car (xml-get-children node
3698                                                             'content:encoded))))
3699                                (car (xml-node-children
3700                                      (car (xml-get-children node
3701                                                             'description))))))
3702                          ;; link-fn
3703                          (lambda (node)
3704                            (car (xml-node-children
3705                                  (car (xml-get-children node 'link)))))
3706                          ;; time-fn
3707                          (lambda (node)
3708                            (newsticker--decode-rfc822-date
3709                             (car (xml-node-children
3710                                   (car (xml-get-children node 'pubDate))))))
3711                          ;; guid-fn
3712                          (lambda (node)
3713                            (let* ((tguid (assoc 'guid
3714                                                 (xml-node-children node))))
3715                              (if (stringp tguid)
3716                                  tguid
3717                                (car (xml-node-children tguid)))))
3718                          ;; extra-fn
3719                          (lambda (node)
3720                            (xml-node-children node))))
3721     (or has-new-items is-new-feed)))
3722
3723 (defun newsticker--parse-generic-feed (name time title desc link
3724                                             extra-elements)
3725   "Parse generic news feed data.
3726 Argument NAME gives the name of a news feed.  TIME gives the
3727 system time at which the data have been retrieved.
3728
3729 The arguments TITLE, DESC, LINK, and EXTRA-ELEMENTS give the feed's title,
3730 description, link, and extra elements resp."
3731   (let ((title (or title "[untitled]"))
3732         (link (or link ""))
3733         (old-item nil)
3734         (position 0)
3735         (something-was-added nil))
3736     ;; decode numeric entities
3737     (setq title (newsticker--decode-numeric-entities title))
3738     (setq desc  (newsticker--decode-numeric-entities desc))
3739     (setq link  (newsticker--decode-numeric-entities link))
3740     ;; remove whitespace from title, desc, and link
3741     (setq title (newsticker--remove-whitespace title))
3742     (setq desc (newsticker--remove-whitespace desc))
3743     (setq link (newsticker--remove-whitespace link))
3744
3745     ;; handle the feed itself
3746     (unless (newsticker--cache-contains newsticker--cache
3747                                         (intern name) title
3748                                         desc link 'feed)
3749       (setq something-was-added t))
3750     (setq newsticker--cache
3751           (newsticker--cache-add newsticker--cache (intern name)
3752                                  title desc link time 'feed position
3753                                  extra-elements 'feed time))
3754     something-was-added))
3755
3756 (defun newsticker--parse-generic-items (name time itemlist
3757                                              title-fn desc-fn
3758                                              link-fn time-fn
3759                                              guid-fn extra-fn)
3760   "Parse generic news feed data.
3761 Argument NAME gives the name of a news feed.  TIME gives the
3762 system time at which the data have been retrieved.  ITEMLIST
3763 contains the news items returned by the xml parser.
3764
3765 The arguments TITLE-FN, DESC-FN, LINK-FN, TIME-FN, GUID-FN, and
3766 EXTRA-FN give functions for extracting title, description, link,
3767 time, guid, and extra-elements resp.  They are called with one
3768 argument, which is one of the items in ITEMLIST."
3769   (let (title desc link
3770         (old-item nil)
3771         (position 0)
3772         (something-was-added nil))
3773     ;; gather all items for this feed
3774     (mapc (lambda (node)
3775             (setq position (1+ position))
3776             (setq title (or (funcall title-fn node) "[untitled]"))
3777             (setq desc (funcall desc-fn node))
3778             (setq link (or (funcall link-fn node) ""))
3779             (setq time (or (funcall time-fn node) time))
3780             ;; It happened that the title or description
3781             ;; contained evil HTML code that confused the
3782             ;; xml parser.  Therefore:
3783             (unless (stringp title)
3784               (setq title (prin1-to-string title)))
3785             (unless (or (stringp desc) (not desc))
3786               (setq desc (prin1-to-string desc)))
3787             ;; ignore items with empty title AND empty desc
3788             (when (or (> (length title) 0)
3789                       (> (length desc) 0))
3790               ;; decode numeric entities
3791               (setq title (newsticker--decode-numeric-entities title))
3792               (when desc
3793                 (setq desc  (newsticker--decode-numeric-entities desc)))
3794               (setq link (newsticker--decode-numeric-entities link))
3795               ;; remove whitespace from title, desc, and link
3796               (setq title (newsticker--remove-whitespace title))
3797               (setq desc (newsticker--remove-whitespace desc))
3798               (setq link (newsticker--remove-whitespace link))
3799               ;; add data to cache
3800               ;; do we have this item already?
3801               (let* ((guid (funcall guid-fn node)))
3802                 ;;(message "guid=%s" guid)
3803                 (setq old-item
3804                       (newsticker--cache-contains newsticker--cache
3805                                                   (intern name) title
3806                                                   desc link nil guid)))
3807               ;; add this item, or mark it as old, or do nothing
3808               (let ((age1 'new)
3809                     (age2 'old)
3810                     (item-new-p nil))
3811                 (if old-item
3812                     (let ((prev-age (newsticker--age old-item)))
3813                       (unless
3814                           newsticker-automatically-mark-items-as-old
3815                         (if (eq prev-age 'obsolete-old)
3816                             (setq age2 'old)
3817                           (setq age2 'new)))
3818                       (if (eq prev-age 'immortal)
3819                           (setq age2 'immortal)))
3820                   ;; item was not there
3821                   (setq item-new-p t)
3822                   (setq something-was-added t))
3823                 (setq newsticker--cache
3824                       (newsticker--cache-add
3825                        newsticker--cache (intern name) title desc link
3826                        time age1 position (funcall extra-fn node)
3827                        age2))
3828                 (when item-new-p
3829                   (let ((item (newsticker--cache-contains
3830                                newsticker--cache (intern name) title
3831                                desc link nil)))
3832                     (if newsticker-auto-mark-filter-list
3833                         (newsticker--run-auto-mark-filter name item))
3834                     (run-hook-with-args
3835                      'newsticker-new-item-functions name item))))))
3836           itemlist)
3837     something-was-added))
3838
3839 (defun newsticker--display-tick ()
3840   "Called from the display timer.
3841 This function calls a display function, according to the variable
3842 `newsticker-scroll-smoothly'."
3843   (if newsticker-scroll-smoothly
3844       (newsticker--display-scroll)
3845     (newsticker--display-jump)))
3846
3847 (defsubst newsticker--echo-area-clean-p ()
3848   "Check whether somebody is using the echo area / minibuffer.
3849 Return t if echo area and minibuffer are unused."
3850   (not (or (active-minibuffer-window)
3851            (and (current-message)
3852                 (not (string= (current-message)
3853                               newsticker--prev-message))))))
3854
3855 (defun newsticker--display-jump ()
3856   "Called from the display timer.
3857 This function displays the next ticker item in the echo area, unless
3858 there is another message displayed or the minibuffer is active."
3859   (let ((message-log-max nil));; prevents message text from being logged
3860     (when (newsticker--echo-area-clean-p)
3861       (setq newsticker--item-position (1+ newsticker--item-position))
3862       (when (>= newsticker--item-position (length newsticker--item-list))
3863         (setq newsticker--item-position 0))
3864       (setq newsticker--prev-message
3865             (nth newsticker--item-position newsticker--item-list))
3866       (message "%s" newsticker--prev-message))))
3867
3868 (defun newsticker--display-scroll ()
3869   "Called from the display timer.
3870 This function scrolls the ticker items in the echo area, unless
3871 there is another message displayed or the minibuffer is active."
3872   (when (newsticker--echo-area-clean-p)
3873     (let* ((width (- (frame-width) 1))
3874            (message-log-max nil);; prevents message text from being logged
3875            (i newsticker--item-position)
3876            subtext
3877            (s-text newsticker--scrollable-text)
3878            (l (length s-text)))
3879       ;; don't show anything if there is nothing to show
3880       (unless (< (length s-text) 1)
3881         ;; repeat the ticker string if it is shorter than frame width
3882         (while (< (length s-text) width)
3883           (setq s-text (concat s-text s-text)))
3884         ;; get the width of the printed string
3885         (setq l (length s-text))
3886         (cond ((< i (- l width))
3887                (setq subtext (substring s-text i (+ i width))))
3888               (t
3889                (setq subtext (concat
3890                               (substring s-text i l)
3891                               (substring s-text 0 (- width (- l i)))))))
3892         ;; Take care of multibyte strings, for which (string-width) is
3893         ;; larger than (length).
3894         ;; Actually, such strings may be smaller than (frame-width)
3895         ;; because return values of (string-width) are too large:
3896         ;; (string-width "<japanese character>") => 2
3897         (let ((t-width (1- (length subtext))))
3898           (while (> (string-width subtext) width)
3899             (setq subtext (substring subtext 0 t-width))
3900             (setq t-width (1- t-width))))
3901         ;; show the ticker text and save current position
3902         (message "%s" subtext)
3903         (setq newsticker--prev-message subtext)
3904         (setq newsticker--item-position (1+ i))
3905         (when (>= newsticker--item-position l)
3906           (setq newsticker--item-position 0))))))
3907
3908 ;; ======================================================================
3909 ;;; misc
3910 ;; ======================================================================
3911 (defun newsticker--decode-numeric-entities (string)
3912   "Decode SGML numeric entities by their respective utf characters.
3913 This function replaces numeric entities in the input STRING and
3914 returns the modified string.  For example \"&#42;\" gets replaced
3915 by \"*\"."
3916   (if (and string (stringp string))
3917       (let ((start 0))
3918         (while (string-match "&#\\([0-9]+\\);" string start)
3919           (condition-case nil
3920               (setq string (replace-match
3921                             (string (read (substring string
3922                                                      (match-beginning 1)
3923                                                      (match-end 1))))
3924                             nil nil string))
3925             (error nil))
3926           (setq start (1+ (match-beginning 0))))
3927         string)
3928     nil))
3929
3930 (defun newsticker--remove-whitespace (string)
3931   "Remove leading and trailing whitespace from STRING."
3932   ;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
3933   ;; endlessly...
3934   (when (and string (stringp string))
3935     (replace-regexp-in-string
3936      "[ \t\r\n]+$" ""
3937      (replace-regexp-in-string "^[ \t\r\n]+" "" string))))
3938
3939 (defun newsticker--do-forget-preformatted (item)
3940   "Forget pre-formatted data for ITEM.
3941 Remove the pre-formatted from `newsticker--cache'."
3942   (if (nthcdr 7 item)
3943       (setcar (nthcdr 7 item) nil))
3944   (if (nthcdr 6 item)
3945       (setcar (nthcdr 6 item) nil)))
3946
3947 (defun newsticker--forget-preformatted ()
3948   "Forget all cached pre-formatted data.
3949 Remove the pre-formatted from `newsticker--cache'."
3950   (mapc (lambda (feed)
3951           (mapc 'newsticker--do-forget-preformatted
3952                 (cdr feed)))
3953         newsticker--cache)
3954   (newsticker--buffer-set-uptodate nil))
3955
3956 (defun newsticker--debug-msg (string &rest args)
3957   "Print newsticker debug messages.
3958 This function calls `message' with arguments STRING and ARGS, if
3959 `newsticker-debug' is non-nil."
3960   (and newsticker-debug
3961        ;;(not (active-minibuffer-window))
3962        ;;(not (current-message))
3963        (apply 'message string args)))
3964
3965 (defun newsticker--decode-iso8601-date (iso8601-string)
3966   "Return ISO8601-STRING in format like `decode-time'.
3967 Converts from ISO-8601 to Emacs representation.
3968 Examples:
3969 2004-09-17T05:09:49+00:00
3970 2004-09-17T05:09+00:00
3971 2004-09-17T05:09:49
3972 2004-09-17T05:09
3973 2004-09-17
3974 2004-09
3975 2004"
3976   (if iso8601-string
3977       (when (string-match
3978              (concat
3979               "\\([0-9]\\{4\\}\\)"
3980               "\\(-\\([0-9]\\{2\\}\\)"
3981               "\\(-\\([0-9]\\{2\\}\\)"
3982               "\\(T"
3983               "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
3984               "\\(:\\([0-9]\\{2\\}\\)\\)?"
3985               "\\(\\([-+Z]\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)?"
3986               "\\)?\\)?\\)?")
3987              iso8601-string)
3988         (let ((year (read (match-string 1 iso8601-string)))
3989               (month (read (match-string 3 iso8601-string)))
3990               (day (read (match-string 5 iso8601-string)))
3991               (hour (read (or (match-string 7 iso8601-string)
3992                               "0")))
3993               (minute (read (or (match-string 8 iso8601-string)
3994                                 "0")))
3995               ;;(second (read (or (match-string 10 iso8601-string)
3996               ;; "0")))
3997               (sign (match-string 12 iso8601-string))
3998               (offset-hour (read (or (match-string 14 iso8601-string)
3999                                      "0")))
4000               (offset-minute (read (or (match-string 15 iso8601-string)
4001                                        "0")))
4002               (second 0))
4003           (cond ((string= sign "+")
4004                  (setq hour (- hour offset-hour))
4005                  (setq minute (- minute offset-minute)))
4006                 ((string= sign "-")
4007                  (setq hour (+ hour offset-hour))
4008                  (setq minute (+ minute offset-minute))))
4009           ;; if UTC subtract current-time-zone offset
4010           ;;(setq second (+ (car (current-time-zone)) second)))
4011
4012           (condition-case nil
4013               (encode-time second minute hour day month year t)
4014             (error
4015              (message "Cannot decode \"%s\"" iso8601-string)
4016              nil))))
4017     nil))
4018
4019 (defun newsticker--decode-rfc822-date (rfc822-string)
4020   "Return RFC822-STRING in format like `decode-time'.
4021 Converts from RFC822 to Emacs representation.
4022 Examples:
4023 Sat, 07 Sep 2002 00:00:01 GMT
4024 07 Sep 2002 00:00:01 GMT
4025 07 Sep 2002"
4026   (if (and rfc822-string (stringp rfc822-string))
4027       (when (string-match
4028              (concat
4029               "\\s-*"
4030               ;; week day
4031               "\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)?\\s-*"
4032               ;; day
4033               "\\([0-9]\\{1,2\\}\\)\\s-+"
4034               ;; month
4035               "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|"
4036               "Sep\\|Oct\\|Nov\\|Dec\\)\\s-+"
4037               ;; year
4038               "\\([0-9]\\{2,4\\}\\)"
4039               ;; time may be missing
4040               "\\(\\s-+"
4041               ;; hour
4042               "\\([0-9]\\{2\\}\\)"
4043               ;; minute
4044               ":\\([0-9]\\{2\\}\\)"
4045               ;; second
4046               "\\(:\\([0-9]\\{2\\}\\)\\)?"
4047               ;; zone -- fixme
4048               "\\(\\s-+.*\\)?"
4049               "\\)?")
4050              rfc822-string)
4051         (let ((day (read (match-string 3 rfc822-string)))
4052               (month-name (match-string 4 rfc822-string))
4053               (month 0)
4054               (year (read (match-string 5 rfc822-string)))
4055               (hour (read (or (match-string 7 rfc822-string) "0")))
4056               (minute (read (or (match-string 8 rfc822-string) "0")))
4057               (second (read (or (match-string 10 rfc822-string) "0")))
4058               ;;(zone (match-string 11 rfc822-string))
4059               )
4060           (condition-case error-data
4061               (let ((i 1))
4062                 (mapc (lambda (m)
4063                         (if (string= month-name m)
4064                             (setq month i))
4065                         (setq i (1+ i)))
4066                       '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
4067                         "Sep" "Oct" "Nov" "Dec"))
4068                 (encode-time second minute hour day month year t))
4069             (error
4070              (message "Cannot decode \"%s\": %s %s" rfc822-string
4071                       (car error-data) (cdr error-data))
4072              nil))))
4073       nil))
4074
4075 (defun newsticker--lists-intersect-p (list1 list2)
4076   "Return t if LIST1 and LIST2 share elements."
4077   (let ((result nil))
4078     (mapc (lambda (elt)
4079             (if (memq elt list2)
4080                 (setq result t)))
4081           list1)
4082     result))
4083
4084 (defun newsticker--update-process-ids ()
4085   "Update list of ids of active newsticker processes.
4086 Checks list of active processes against list of newsticker processes."
4087   (let ((active-procs (process-list))
4088         (new-list nil))
4089     (mapc (lambda (proc)
4090             (let ((id (process-id proc)))
4091               (if (memq id newsticker--process-ids)
4092                   (setq new-list (cons id new-list)))))
4093           active-procs)
4094     (setq newsticker--process-ids new-list))
4095   (force-mode-line-update))
4096
4097 ;; ======================================================================
4098 ;;; images
4099 ;; ======================================================================
4100 (defun newsticker--image-get (feed-name url)
4101   "Get image of the news site FEED-NAME from URL.
4102 If the image has been downloaded in the last 24h do nothing."
4103   (let ((image-name (concat newsticker-imagecache-dirname "/"
4104                             feed-name)))
4105     (if (and (file-exists-p image-name)
4106              (time-less-p (current-time)
4107                           (time-add (nth 5 (file-attributes image-name))
4108                                     (seconds-to-time 86400))))
4109         (newsticker--debug-msg "%s: Getting image for %s skipped"
4110                                (format-time-string "%A, %H:%M" (current-time))
4111                                feed-name)
4112       ;; download
4113       (newsticker--debug-msg "%s: Getting image for %s"
4114                              (format-time-string "%A, %H:%M" (current-time))
4115                              feed-name)
4116       (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*"))
4117              (item (or (assoc feed-name newsticker-url-list)
4118                        (assoc feed-name newsticker-url-list-defaults)
4119                        (error
4120                         "Cannot get news for %s: Check newsticker-url-list"
4121                         feed-name)))
4122              (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
4123                                  newsticker-wget-arguments)))
4124         (save-excursion
4125           (set-buffer (get-buffer-create buffername))
4126           (erase-buffer)
4127           ;; throw an error if there is an old wget-process around
4128           (if (get-process feed-name)
4129               (error "Another wget-process is running for image %s"
4130                      feed-name))
4131           ;; start wget
4132           (let* ((args (append wget-arguments (list url)))
4133                  (proc (apply 'start-process feed-name buffername
4134                               newsticker-wget-name args)))
4135             (set-process-coding-system proc 'no-conversion 'no-conversion)
4136             (set-process-sentinel proc 'newsticker--image-sentinel)))))))
4137
4138 (defun newsticker--image-sentinel (process event)
4139   "Sentinel for image-retrieving PROCESS caused by EVENT."
4140   (let* ((p-status (process-status process))
4141          (exit-status (process-exit-status process))
4142          (feed-name (process-name process)))
4143     ;; catch known errors (zombie processes, rubbish-xml, etc.)
4144     ;; if an error occurs the news feed is not updated!
4145     (catch 'oops
4146       (unless (and (eq p-status 'exit)
4147                    (= exit-status 0))
4148         (message "%s: Error while retrieving image from %s"
4149                  (format-time-string "%A, %H:%M" (current-time))
4150                  feed-name)
4151         (throw 'oops nil))
4152       (let (image-name)
4153         (save-excursion
4154           (set-buffer (process-buffer process))
4155           (setq image-name (concat newsticker-imagecache-dirname "/"
4156                                    feed-name))
4157           (set-buffer-file-coding-system 'no-conversion)
4158           ;; make sure the cache dir exists
4159           (unless (file-directory-p newsticker-imagecache-dirname)
4160             (make-directory newsticker-imagecache-dirname))
4161           ;; write and close buffer
4162           (let ((require-final-newline nil)
4163                 (backup-inhibited t)
4164                 (coding-system-for-write 'no-conversion))
4165             (write-region nil nil image-name nil 'quiet))
4166           (set-buffer-modified-p nil)
4167           (kill-buffer (current-buffer)))))))
4168
4169 (defun newsticker--image-read (feed-name-symbol disabled)
4170   "Read the cached image for FEED-NAME-SYMBOL from disk.
4171 If DISABLED is non-nil the image will be converted to a disabled look
4172 \(unless `newsticker-enable-logo-manipulations' is not t\).
4173 Return the image."
4174   (let ((image-name (concat newsticker-imagecache-dirname "/"
4175                             (symbol-name feed-name-symbol)))
4176         (img nil))
4177     (when (file-exists-p image-name)
4178       (condition-case error-data
4179           (setq img (create-image
4180                      image-name nil nil
4181                      :conversion (and newsticker-enable-logo-manipulations
4182                                       disabled
4183                                       'disabled)
4184                      :mask (and newsticker-enable-logo-manipulations
4185                                 'heuristic)
4186                      :ascent 70))
4187         (error
4188          (message "Error: cannot create image for %s: %s"
4189                   feed-name-symbol error-data))))
4190     img))
4191
4192 ;; ======================================================================
4193 ;;; imenu stuff
4194 ;; ======================================================================
4195 (defun newsticker--imenu-create-index ()
4196   "Scan newsticker buffer and return an index for imenu."
4197   (save-excursion
4198     (goto-char (point-min))
4199     (let ((index-alist nil)
4200           (feed-list nil)
4201           (go-ahead t))
4202       (while go-ahead
4203         (let ((type  (get-text-property (point) 'nt-type))
4204               (title (get-text-property (point) 'nt-title)))
4205           (cond ((eq type 'feed)
4206                  ;; we're on a feed heading
4207                  (when feed-list
4208                    (if index-alist
4209                        (nconc index-alist (list feed-list))
4210                      (setq index-alist (list feed-list))))
4211                  (setq feed-list (list title)))
4212                 (t
4213                  (nconc feed-list
4214                         (list (cons title (point)))))))
4215         (setq go-ahead (newsticker--buffer-goto '(item feed))))
4216       (if index-alist
4217           (nconc index-alist (list feed-list))
4218         (setq index-alist (list feed-list)))
4219       index-alist)))
4220
4221 (defun newsticker--imenu-goto (name pos &rest args)
4222   "Go to item NAME at position POS and show item.
4223 ARGS are ignored."
4224   (goto-char pos)
4225   ;; show headline
4226   (newsticker--buffer-goto '(desc extra feed item))
4227   (let* ((inhibit-read-only t)
4228          (pos1 (max (point-min) (1- pos)))
4229          (pos2 (max pos1 (1- (point))))
4230          (inv-prop (get-text-property pos 'invisible))
4231          (org-inv-prop (get-text-property pos 'org-invisible)))
4232     (when (eq org-inv-prop nil)
4233       (add-text-properties pos1 pos2 (list 'invisible nil
4234                                           'org-invisible inv-prop))))
4235   ;; show desc
4236   (newsticker-show-entry))
4237
4238 ;; ======================================================================
4239 ;;; buffer stuff
4240 ;; ======================================================================
4241 (defun newsticker--buffer-set-uptodate (value)
4242   "Set the uptodate-status of the newsticker buffer to VALUE.
4243 The mode-line is changed accordingly."
4244   (setq newsticker--buffer-uptodate-p value)
4245   (let ((b (get-buffer "*newsticker*")))
4246     (when b
4247       (save-excursion
4248        (set-buffer b)
4249        (if value
4250            (setq mode-name "Newsticker -- up to date -- ")
4251          (setq mode-name "Newsticker -- NEED UPDATE -- ")))
4252       (force-mode-line-update 0))))
4253
4254 (defun newsticker--buffer-redraw ()
4255   "Sometimes (CVS) Emacs forgets to update the window..."
4256   (if (fboundp 'force-window-update)
4257       (force-window-update (current-buffer))
4258     (redraw-frame (selected-frame)))
4259   (run-hooks 'newsticker-buffer-change-hook)
4260   (sit-for 0))
4261
4262 (defun newsticker--buffer-insert-all-items ()
4263   "Insert all cached newsticker items into the current buffer.
4264 Keeps order of feeds as given in `newsticker-url-list' and
4265 `newsticker-url-list-defaults'."
4266   (goto-char (point-min))
4267   (mapc (lambda (url-item)
4268           (let* ((feed-name (car url-item))
4269                  (feed-name-symbol (intern feed-name))
4270                  (feed (assoc feed-name-symbol newsticker--cache))
4271                  (items (cdr feed))
4272                  (pos (point)))
4273             (when feed
4274               ;; insert the feed description
4275               (mapc (lambda (item)
4276                       (when (eq (newsticker--age item) 'feed)
4277                         (newsticker--buffer-insert-item item
4278                                                         feed-name-symbol)))
4279                     items)
4280               ;;insert the items
4281               (mapc (lambda (item)
4282                       (if (memq (newsticker--age item) '(new immortal old
4283                                                              obsolete))
4284                           (newsticker--buffer-insert-item item
4285                                                           feed-name-symbol)))
4286                     items)
4287               (put-text-property pos (point) 'feed (car feed))
4288
4289               ;; insert empty line between feeds
4290               (let ((p (point)))
4291                 (insert "\n")
4292                 (put-text-property p (point) 'hard t)))))
4293         (append newsticker-url-list newsticker-url-list-defaults))
4294
4295   (newsticker--buffer-set-faces (point-min) (point-max))
4296   (newsticker--buffer-set-invisibility (point-min) (point-max))
4297   (goto-char (point-min)))
4298
4299 (defun newsticker--buffer-insert-item (item &optional feed-name-symbol)
4300   "Insert a news item in the current buffer.
4301 Insert a formatted representation of the ITEM.  The optional parameter
4302 FEED-NAME-SYMBOL determines how the item is formatted and whether the
4303 item-retrieval time is added as 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 of 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 against the pattern-LIST
5330 \(from `newsticker-auto-mark-filter-list')."
5331   (mapc (lambda (pattern)
5332           (let ((age    (nth 0 pattern))
5333                 (place  (nth 1 pattern))
5334                 (regexp (nth 2 pattern))
5335                 (title (newsticker--title item))
5336                 (desc  (newsticker--desc item)))
5337             (when (or (eq place 'title) (eq place 'all))
5338               (when (and title (string-match regexp title))
5339                 (newsticker--debug-msg "Auto-marking as %s: `%s'"
5340                                        age (newsticker--title item))
5341                 (setcar (nthcdr 4 item) age)))
5342             (when (or (eq place 'description) (eq place 'all))
5343               (when (and desc (string-match regexp desc))
5344                 (newsticker--debug-msg "Auto-marking as %s: `%s'"
5345                                        age (newsticker--title item))
5346                 (setcar (nthcdr 4 item) age)))))
5347         list))
5348
5349
5350 ;; ======================================================================
5351 ;;; hook samples
5352 ;; ======================================================================
5353 (defun newsticker-new-item-functions-sample (feed item)
5354   "Demonstrate the use of the `newsticker-new-item-functions' hook.
5355 This function just prints out the values of the FEED and title of the ITEM."
5356   (message (concat "newsticker-new-item-functions-sample: feed=`%s', "
5357                    "title=`%s'")
5358            feed (newsticker--title item)))
5359
5360 (defun newsticker-download-images (feed item)
5361   "Download the first image.
5362 If FEED equals \"imagefeed\" download the first image URL found
5363 in the description=contents of ITEM to the directory
5364 \"~/tmp/newsticker/FEED/TITLE\" where TITLE is the title of the item."
5365   (when (string= feed "imagefeed")
5366     (let ((title (newsticker--title item))
5367           (desc (newsticker--desc item)))
5368       (when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc)
5369         (let ((url (substring desc (match-beginning 1) (match-end 1)))
5370               (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
5371               (org-dir default-directory))
5372           (unless (file-directory-p temp-dir)
5373             (make-directory temp-dir t))
5374           (cd temp-dir)
5375           (message "Getting image %s" url)
5376           (apply 'start-process "wget-image"
5377                  " *newsticker-wget-download-images*"
5378                  newsticker-wget-name
5379                  (list url))
5380           (cd org-dir))))))
5381
5382 (defun newsticker-download-enclosures (feed item)
5383   "In all FEEDs download the enclosed object of the news ITEM.
5384 The object is saved to the directory \"~/tmp/newsticker/FEED/TITLE\", which
5385 is created if it does not exist.  TITLE is the title of the news
5386 item.  Argument FEED is ignored.
5387 This function is suited for adding it to `newsticker-new-item-functions'."
5388   (let ((title (newsticker--title item))
5389         (enclosure (newsticker--enclosure item)))
5390     (when enclosure
5391       (let ((url (cdr (assoc 'url enclosure)))
5392             (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
5393             (org-dir default-directory))
5394         (unless (file-directory-p temp-dir)
5395           (make-directory temp-dir t))
5396         (cd temp-dir)
5397         (message "Getting enclosure %s" url)
5398         (apply 'start-process "wget-enclosure"
5399                " *newsticker-wget-download-enclosures*"
5400                newsticker-wget-name
5401                (list url))
5402         (cd org-dir)))))
5403
5404
5405 (provide 'newsticker)
5406
5407 ;; arch-tag: ab761dfa-67bc-4207-bc64-4307271dc381
5408 ;;; newsticker.el ends here