+2008-06-13 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newsticker.el: Renamed net/newsticker-*.el to net/newst-*.el.
+ * net/newst-backend.el: New. Renamed from net/newsticker-backend.el.
+ * net/newst-plainview.el: New. Renamed from net/newsticker-plainview.el.
+ * net/newst-reader.el: New. Renamed from net/newsticker-reader.el.
+ * net/newst-ticker.el: New. Renamed from net/newsticker-ticker.el.
+ * net/newst-treeview.el: New. Renamed from net/newsticker-treeview.el.
+ * net/newsticker-backend.el: Removed. Renamed to net/newst-backend.el.
+ * net/newsticker-plainview.el: Removed. Renamed to net/newst-plainview.el.
+ * net/newsticker-reader.el: Removed. Renamed to net/newst-reader.el.
+ * net/newsticker-ticker.el: Removed. Renamed to net/newst-ticker.el.
+ * net/newsticker-treeview.el: Removed. Renamed to net/newst-treeview.el.
+
2008-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/compile.el (compilation-start): Don't disable undo in
--- /dev/null
+;;; newst-backend.el --- Retrieval backend for newsticker.
+
+;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+;; Free Software Foundation, Inc.
+
+;; Author: Ulf Jasper <ulf.jasper@web.de>
+;; Filename: newst-backend.el
+;; URL: http://www.nongnu.org/newsticker
+;; Keywords: News, RSS, Atom
+;; Time-stamp: "13. Juni 2008, 17:41:00 (ulf)"
+
+;; ======================================================================
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;; ======================================================================
+
+;;; Commentary:
+
+;; See newsticker.el
+
+;; ======================================================================
+;;; Code:
+
+(require 'derived)
+(require 'xml)
+
+;; Silence warnings
+(defvar w3-mode-map)
+(defvar w3m-minor-mode-map)
+
+
+(defvar newsticker--retrieval-timer-list nil
+ "List of timers for news retrieval.
+This is an alist, each element consisting of (feed-name . timer).")
+
+(defvar newsticker--download-logos nil
+ "If non-nil download feed logos if available.")
+
+(defvar newsticker--sentinel-callback nil
+ "Function called at end of `newsticker--sentinel'.")
+
+;;;###autoload
+(defun newsticker-running-p ()
+ "Check whether newsticker is running.
+Return t if newsticker is running, nil otherwise. Newsticker is
+considered to be running if the newsticker timer list is not empty."
+ (> (length newsticker--retrieval-timer-list) 0))
+
+;; ======================================================================
+;;; Customization
+;; ======================================================================
+(defgroup newsticker nil
+ "Aggregator for RSS and Atom feeds."
+ :group 'applications)
+
+(defconst newsticker--raw-url-list-defaults
+ '(("CNET News.com"
+ "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
+ ("Debian Security Advisories"
+ "http://www.debian.org/security/dsa.en.rdf")
+ ("Debian Security Advisories - Long format"
+ "http://www.debian.org/security/dsa-long.en.rdf")
+ ("Emacs Wiki"
+ "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
+ nil
+ 3600)
+ ("Freshmeat.net"
+ "http://freshmeat.net/backend/fm.rdf")
+ ("Kuro5hin.org"
+ "http://www.kuro5hin.org/backend.rdf")
+ ("LWN (Linux Weekly News)"
+ "http://lwn.net/headlines/rss")
+ ("NewsForge"
+ "http://newsforge.com/index.rss")
+ ("NY Times: Technology"
+ "http://partners.userland.com/nytRss/technology.xml")
+ ("NY Times"
+ "http://partners.userland.com/nytRss/nytHomepage.xml")
+ ("Quote of the day"
+ "http://www.quotationspage.com/data/qotd.rss"
+ "07:00"
+ 86400)
+ ("The Register"
+ "http://www.theregister.co.uk/tonys/slashdot.rdf")
+ ("slashdot"
+ "http://slashdot.org/index.rss"
+ nil
+ 3600) ;/. will ban you if under 3600 seconds!
+ ("Wired News"
+ "http://www.wired.com/news_drop/netcenter/netcenter.rdf")
+ ("Heise News (german)"
+ "http://www.heise.de/newsticker/heise.rdf")
+ ("Tagesschau (german)"
+ "http://www.tagesschau.de/newsticker.rdf"
+ nil
+ 1800)
+ ("Telepolis (german)"
+ "http://www.heise.de/tp/news.rdf"))
+ "Default URL list in raw form.
+This list is fed into defcustom via `newsticker--splicer'.")
+
+(defun newsticker--splicer (item)
+ "Convert ITEM for splicing into `newsticker-url-list-defaults'."
+ (let ((result (list 'list :tag (nth 0 item) (list 'const (nth 0 item))))
+ (element (cdr item)))
+ (while element
+ (setq result (append result (list (list 'const (car element)))))
+ (setq element (cdr element)))
+ result))
+
+(defun newsticker--set-customvar-retrieval (symbol value)
+ "Set retrieval related newsticker-variable SYMBOL value to VALUE.
+Calls all actions which are necessary in order to make the new
+value effective."
+ (if (or (not (boundp symbol))
+ (equal (symbol-value symbol) value))
+ (set symbol value)
+ ;; something must have changed
+ (let ((need-restart nil)
+ (new-or-changed-feeds nil)
+ (removed-feeds))
+ (cond ((eq symbol 'newsticker-retrieval-interval)
+ (setq need-restart t))
+ ((memq symbol '(newsticker-url-list-defaults newsticker-url-list))
+ (dolist (elt value)
+ (unless (member elt (symbol-value symbol))
+ (setq new-or-changed-feeds (cons elt new-or-changed-feeds))))
+ (dolist (elt (symbol-value symbol))
+ (unless (member elt value)
+ (setq removed-feeds (cons elt removed-feeds))))))
+ (cond (need-restart
+ (set symbol value)
+ (when (newsticker-running-p)
+ (message "Restarting newsticker")
+ (newsticker-stop)
+ (newsticker-start)))
+ (t
+ (dolist (feed removed-feeds)
+ (message "Stopping feed `%s'" (car feed))
+ (newsticker--stop-feed (car feed)))
+ (dolist (feed new-or-changed-feeds)
+ (message "Starting feed `%s'" (car feed))
+ (newsticker--stop-feed (car feed))
+ (newsticker--start-feed feed))
+ (unless new-or-changed-feeds
+ (when newsticker--sentinel-callback
+ (funcall newsticker--sentinel-callback)))))
+ (set symbol value))))
+
+;; ======================================================================
+;; retrieval
+(defgroup newsticker-retrieval nil
+ "Settings for news retrieval."
+ :group 'newsticker)
+
+(defcustom newsticker-url-list-defaults
+ '(("Emacs Wiki"
+ "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
+ nil
+ 3600))
+ "A customizable list of news feeds to select from.
+These were mostly extracted from the Radio Community Server at
+http://subhonker6.userland.com/rcsPublic/rssHotlist.
+
+You may add other entries in `newsticker-url-list'."
+ :type `(set ,@(mapcar `newsticker--splicer
+ newsticker--raw-url-list-defaults))
+ :set 'newsticker--set-customvar-retrieval
+ :group 'newsticker-retrieval)
+
+(defcustom newsticker-url-list nil
+ "The news feeds which you like to watch.
+
+This alist will be used in addition to selection made customizing
+`newsticker-url-list-defaults'.
+
+This is an alist. Each element consists of two items: a LABEL and a URL,
+optionally followed by a START-TIME, INTERVAL specifier and WGET-ARGUMENTS.
+
+The LABEL gives the name of the news feed. It can be an arbitrary string.
+
+The URL gives the location of the news feed. It must point to a valid
+RSS or Atom file. The file is retrieved by calling wget, or whatever you
+specify as `newsticker-wget-name'.
+
+URL may also be a function which returns news data. In this case
+`newsticker-retrieval-method' etc. are ignored for this feed.
+
+The START-TIME can be either a string, or nil. If it is a string it
+specifies a fixed time at which this feed shall be retrieved for the
+first time. (Examples: \"11:00pm\", \"23:00\".) If it is nil (or
+unspecified), this feed will be retrieved immediately after calling
+`newsticker-start'.
+
+The INTERVAL specifies the time between retrievals for this feed. If it
+is nil (or unspecified) the default interval value as set in
+`newsticker-retrieval-interval' is used.
+
+\(newsticker.el calls `run-at-time'. The newsticker-parameters START-TIME
+and INTERVAL correspond to the `run-at-time'-parameters TIME and REPEAT.)
+
+WGET-ARGUMENTS specifies arguments for wget (see `newsticker-wget-name')
+which apply for this feed only, overriding the value of
+`newsticker-wget-arguments'."
+ :type '(repeat (list :tag "News feed"
+ (string :tag "Label")
+ (choice :tag "URI"
+ (string :tag "String")
+ (function :tag "Function"))
+ (choice :tag "Start"
+ (const :tag "Default" nil)
+ (string :tag "Fixed Time"))
+ (choice :tag "Interval"
+ (const :tag "Default" nil)
+ (const :tag "Hourly" 3600)
+ (const :tag "Daily" 86400)
+ (const :tag "Weekly" 604800)
+ (integer :tag "Interval"))
+ (choice :tag "Wget Arguments"
+ (const :tag "Default arguments" nil)
+ (repeat :tag "Special arguments" string))))
+ :set 'newsticker--set-customvar-retrieval
+ :group 'newsticker-retrieval)
+
+(defcustom newsticker-retrieval-method
+ 'intern
+ "Method for retrieving news from the web, either `intern' or `extern'.
+Default value `intern' uses Emacs' built-in asynchronous download
+capabilities ('url-retrieve'). If set to `extern' the external
+program wget is used, see `newsticker-wget-name'."
+ :type '(choice :tag "Method"
+ (const :tag "Intern" intern)
+ (const :tag "Extern" extern))
+ :group 'newsticker-retrieval)
+
+(defcustom newsticker-wget-name
+ "wget"
+ "Name of the program which is called to retrieve news from the web.
+The canonical choice is wget but you may take any other program which is
+able to return the contents of a news feed file on stdout."
+ :type 'string
+ :group 'newsticker-retrieval)
+
+(defcustom newsticker-wget-arguments
+ '("-q" "-O" "-")
+ "Arguments which are passed to wget.
+There is probably no reason to change the default settings, unless you
+are living behind a firewall."
+ :type '(repeat (string :tag "Argument"))
+ :group 'newsticker-retrieval)
+
+(defcustom newsticker-retrieval-interval
+ 3600
+ "Time interval for retrieving new news items (seconds).
+If this value is not positive (i.e. less than or equal to 0)
+items are retrieved only once!
+Please note that some feeds, e.g. Slashdot, will ban you if you
+make it less than 1800 seconds (30 minutes)!"
+ :type '(choice :tag "Interval"
+ (const :tag "No automatic retrieval" 0)
+ (const :tag "Hourly" 3600)
+ (const :tag "Daily" 86400)
+ (const :tag "Weekly" 604800)
+ (integer :tag "Interval"))
+ :set 'newsticker--set-customvar-retrieval
+ :group 'newsticker-retrieval)
+
+(defcustom newsticker-desc-comp-max
+ 100
+ "Relevant length of headline descriptions.
+This value gives the maximum number of characters which will be
+taken into account when newsticker compares two headline
+descriptions."
+ :type 'integer
+ :group 'newsticker-retrieval)
+
+;; ======================================================================
+;; headline processing
+(defgroup newsticker-headline-processing nil
+ "Settings for the automatic processing of headlines."
+ :group 'newsticker)
+
+(defcustom newsticker-automatically-mark-items-as-old
+ t
+ "Decides whether to automatically mark items as old.
+If t a new item is considered as new only after its first retrieval. As
+soon as it is retrieved a second time, it becomes old. If not t all
+items stay new until you mark them as old. This is done in the
+*newsticker* buffer."
+ :type 'boolean
+ :group 'newsticker-headline-processing)
+
+(defcustom newsticker-automatically-mark-visited-items-as-old
+ t
+ "Decides whether to automatically mark visited items as old.
+If t an item is marked as old as soon as the associated link is
+visited, i.e. after pressing RET or mouse2 on the item's
+headline."
+
+ :type 'boolean
+ :group 'newsticker-headline-processing)
+
+(defcustom newsticker-keep-obsolete-items
+ t
+ "Decides whether to keep unread items which have been removed from feed.
+If t a new item, which has been removed from the feed, is kept in
+the cache until it is marked as read."
+ :type 'boolean
+ :group 'newsticker-headline-processing)
+
+(defcustom newsticker-obsolete-item-max-age
+ (* 60 60 24)
+ "Maximal age of obsolete items, in seconds.
+Obsolete items which are older than this value will be silently
+deleted at the next retrieval."
+ :type 'integer
+ :group 'newsticker-headline-processing)
+
+(defcustom newsticker-auto-mark-filter-list
+ nil
+ "A list of filters for automatically marking headlines.
+
+This is an alist of the form (FEED-NAME PATTERN-LIST). I.e. each
+element consists of a FEED-NAME a PATTERN-LIST. Each element of
+the pattern-list has the form (AGE TITLE-OR-DESCRIPTION REGEXP).
+AGE must be one of the symbols 'old or 'immortal.
+TITLE-OR-DESCRIPTION must be on of the symbols 'title,
+'description, or 'all. REGEXP is a regular expression, i.e. a
+string.
+
+This filter is checked after a new headline has been retrieved.
+If FEED-NAME matches the name of the corresponding news feed, the
+pattern-list is checked: The new headline will be marked as AGE
+if REGEXP matches the headline's TITLE-OR-DESCRIPTION.
+
+If, for example, `newsticker-auto-mark-filter-list' looks like
+ \((slashdot ('old 'title \"^Forget me!$\") ('immortal 'title \"Read me\")
+ \('immortal 'all \"important\"))))
+
+then all articles from slashdot are marked as old if they have
+the title \"Forget me!\". All articles with a title containing
+the string \"Read me\" are marked as immortal. All articles which
+contain the string \"important\" in their title or their
+description are marked as immortal."
+ :type '(repeat (list :tag "Auto mark filter"
+ (string :tag "Feed name")
+ (repeat
+ (list :tag "Filter element"
+ (choice
+ :tag "Auto-assigned age"
+ (const :tag "Old" old)
+ (const :tag "Immortal" immortal))
+ (choice
+ :tag "Title/Description"
+ (const :tag "Title" title)
+ (const :tag "Description" description)
+ (const :tag "All" all))
+ (string :tag "Regexp")))))
+ :group 'newsticker-headline-processing)
+
+;; ======================================================================
+;; hooks
+(defgroup newsticker-hooks nil
+ "Settings for newsticker hooks."
+ :group 'newsticker)
+
+(defcustom newsticker-start-hook
+ nil
+ "Hook run when starting newsticker.
+This hook is run at the very end of `newsticker-start'."
+ :options '(newsticker-start-ticker)
+ :type 'hook
+ :group 'newsticker-hooks)
+
+(defcustom newsticker-stop-hook
+ nil
+ "Hook run when stopping newsticker.
+This hook is run at the very end of `newsticker-stop'."
+ :options nil
+ :type 'hook
+ :group 'newsticker-hooks)
+
+(defcustom newsticker-new-item-functions
+ nil
+ "List of functions run after a new headline has been retrieved.
+Each function is called with the following three arguments:
+FEED the name of the corresponding news feed,
+TITLE the title of the headline,
+DESC the decoded description of the headline.
+
+See `newsticker-download-images', and
+`newsticker-download-enclosures' for sample functions.
+
+Please note that these functions are called only once for a
+headline after it has been retrieved for the first time."
+ :type 'hook
+ :options '(newsticker-download-images
+ newsticker-download-enclosures)
+ :group 'newsticker-hooks)
+
+;; ======================================================================
+;; miscellaneous
+(defgroup newsticker-miscellaneous nil
+ "Miscellaneous newsticker settings."
+ :group 'newsticker)
+
+(defcustom newsticker-cache-filename
+ "~/.newsticker-cache"
+ "Name of the newsticker cache file."
+ :type 'string
+ :group 'newsticker-miscellaneous)
+
+(defcustom newsticker-imagecache-dirname
+ "~/.newsticker-images"
+ "Name of the directory where newsticker stores cached images."
+ :type 'string
+ :group 'newsticker-miscellaneous)
+
+;; debugging
+(defcustom newsticker-debug
+ nil
+ "Enables some features needed for debugging newsticker.el.
+
+If set to t newsticker.el will print lots of debugging messages, and the
+buffers *newsticker-wget-<feed>* will not be closed."
+ :type 'boolean
+ :group 'newsticker-miscellaneous)
+
+;; ======================================================================
+;;; Compatibility section, XEmacs, Emacs
+;; ======================================================================
+(unless (fboundp 'time-add)
+ (require 'time-date);;FIXME
+ (defun time-add (t1 t2)
+ (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))
+
+(unless (fboundp 'match-string-no-properties)
+ (defalias 'match-string-no-properties 'match-string))
+
+(when (featurep 'xemacs)
+ (unless (fboundp 'replace-regexp-in-string)
+ (defun replace-regexp-in-string (re rp st)
+ (save-match-data ;; apparently XEmacs needs save-match-data
+ (replace-in-string st re rp)))))
+
+;; copied from subr.el
+(unless (fboundp 'add-to-invisibility-spec)
+ (defun add-to-invisibility-spec (arg)
+ "Add elements to `buffer-invisibility-spec'.
+See documentation for `buffer-invisibility-spec' for the kind of elements
+that can be added."
+ (if (eq buffer-invisibility-spec t)
+ (setq buffer-invisibility-spec (list t)))
+ (setq buffer-invisibility-spec
+ (cons arg buffer-invisibility-spec))))
+
+;; copied from subr.el
+(unless (fboundp 'remove-from-invisibility-spec)
+ (defun remove-from-invisibility-spec (arg)
+ "Remove elements from `buffer-invisibility-spec'."
+ (if (consp buffer-invisibility-spec)
+ (setq buffer-invisibility-spec
+ (delete arg buffer-invisibility-spec)))))
+
+;; ======================================================================
+;;; Internal variables
+;; ======================================================================
+(defvar newsticker--item-list nil
+ "List of newsticker items.")
+(defvar newsticker--item-position 0
+ "Actual position in list of newsticker items.")
+(defvar newsticker--prev-message "There was no previous message yet!"
+ "Last message that the newsticker displayed.")
+(defvar newsticker--scrollable-text ""
+ "The text which is scrolled smoothly in the echo area.")
+(defvar newsticker--buffer-uptodate-p nil
+ "Tells whether the newsticker buffer is up to date.")
+(defvar newsticker--latest-update-time (current-time)
+ "The time at which the latest news arrived.")
+(defvar newsticker--process-ids nil
+ "List of PIDs of active newsticker processes.")
+
+(defvar newsticker--cache nil "Cached newsticker data.
+This is a list of the form
+
+ ((label1
+ (title description link time age index preformatted-contents
+ preformatted-title extra-elements)
+ ...)
+ (label2
+ (title description link time age index preformatted-contents
+ preformatted-title extra-elements)
+ ...)
+ ...)
+
+where LABEL is a symbol. TITLE, DESCRIPTION, and LINK are
+strings. TIME is a time value as returned by `current-time'.
+AGE is a symbol: 'new, 'old, 'immortal, and 'obsolete denote
+ordinary news items, whereas 'feed denotes an item which is not a
+headline but describes the feed itself. INDEX denotes the
+original position of the item -- used for restoring the original
+order. PREFORMATTED-CONTENTS and PREFORMATTED-TITLE hold the
+formatted contents of the item's description and title. This
+speeds things up if HTML rendering is used, which is rather
+slow. EXTRA-ELEMENTS is an alist containing additional elements.")
+
+(defvar newsticker--auto-narrow-to-feed nil
+ "Automatically narrow to current news feed.
+If non-nil only the items of the current news feed are visible.")
+
+(defvar newsticker--auto-narrow-to-item nil
+ "Automatically narrow to current news item.
+If non-nil only the current headline is visible.")
+
+(defconst newsticker--error-headline
+ "[COULD NOT DOWNLOAD HEADLINES!]"
+ "Title of error headline which will be inserted if news retrieval fails.")
+
+;; ======================================================================
+;;; Shortcuts
+;; ======================================================================
+(defsubst newsticker--title (item)
+ "Return title of ITEM."
+ (nth 0 item))
+(defsubst newsticker--desc (item)
+ "Return description of ITEM."
+ (nth 1 item))
+(defsubst newsticker--link (item)
+ "Return link of ITEM."
+ (nth 2 item))
+(defsubst newsticker--time (item)
+ "Return time of ITEM."
+ (nth 3 item))
+(defsubst newsticker--age (item)
+ "Return age of ITEM."
+ (nth 4 item))
+(defsubst newsticker--pos (item)
+ "Return position/index of ITEM."
+ (nth 5 item))
+(defsubst newsticker--preformatted-contents (item)
+ "Return pre-formatted text of ITEM."
+ (nth 6 item))
+(defsubst newsticker--preformatted-title (item)
+ "Return pre-formatted title of ITEM."
+ (nth 7 item))
+(defsubst newsticker--extra (item)
+ "Return extra attributes of ITEM."
+ (nth 8 item))
+(defsubst newsticker--guid-to-string (guid)
+ "Return string representation of GUID."
+ (if (stringp guid)
+ guid
+ (car (xml-node-children guid))))
+(defsubst newsticker--guid (item)
+ "Return guid of ITEM."
+ (newsticker--guid-to-string (assoc 'guid (newsticker--extra item))))
+(defsubst newsticker--enclosure (item)
+ "Return enclosure element of ITEM in the form \(...FIXME...\) or nil."
+ (let ((enclosure (assoc 'enclosure (newsticker--extra item))))
+ (if enclosure
+ (xml-node-attributes enclosure))))
+(defun newsticker--real-feed-name (feed)
+ "Return real name of FEED."
+ (catch 'name
+ (mapc (lambda (item)
+ (if (eq (newsticker--age item) 'feed)
+ (throw 'name (newsticker--title item))))
+ (cdr (newsticker--cache-get-feed feed)))
+ (symbol-name feed)))
+
+
+;; ======================================================================
+;;; User fun
+;; ======================================================================
+
+(defun newsticker--start-feed (feed &optional do-not-complain-if-running)
+ "Start retrieval timer for FEED.
+If timer is running already a warning message is printed unless
+DO-NOT-COMPLAIN-IF-RUNNING is not nil. Add the started
+name/timer pair to `newsticker--retrieval-timer-list'."
+ (let* ((feed-name (car feed))
+ (start-time (nth 2 feed))
+ (interval (or (nth 3 feed)
+ newsticker-retrieval-interval))
+ (timer (assoc (car feed)
+ newsticker--retrieval-timer-list)))
+ (if timer
+ (or do-not-complain-if-running
+ (message "Timer for %s is running already!"
+ feed-name))
+ (newsticker--debug-msg "Starting timer for %s: %s, %d"
+ feed-name start-time interval)
+ ;; do not repeat retrieval if interval not positive
+ (if (<= interval 0)
+ (setq interval nil))
+ ;; Suddenly XEmacs doesn't like start-time 0
+ (if (or (not start-time)
+ (and (numberp start-time) (= start-time 0)))
+ (setq start-time 1))
+ ;; (message "start-time %s" start-time)
+ (setq timer (run-at-time start-time interval
+ 'newsticker-get-news feed-name))
+ (if interval
+ (add-to-list 'newsticker--retrieval-timer-list
+ (cons feed-name timer))))))
+
+;;;###autoload
+(defun newsticker-start (&optional do-not-complain-if-running)
+ "Start the newsticker.
+Start the timers for display and retrieval. If the newsticker, i.e. the
+timers, are running already a warning message is printed unless
+DO-NOT-COMPLAIN-IF-RUNNING is not nil.
+Run `newsticker-start-hook' if newsticker was not running already."
+ (interactive)
+ (let ((running (newsticker-running-p)))
+ ;; read old cache if it exists and newsticker is not running
+ (unless running
+ (let ((coding-system-for-read 'utf-8))
+ (when (file-exists-p newsticker-cache-filename)
+ (with-temp-buffer
+ (insert-file-contents newsticker-cache-filename)
+ (goto-char (point-min))
+ (condition-case nil
+ (setq newsticker--cache (read (current-buffer)))
+ (error
+ (message "Error while reading newsticker cache file!")
+ (setq newsticker--cache nil)))))))
+ ;; start retrieval timers -- one timer for each feed
+ (dolist (feed (append newsticker-url-list-defaults newsticker-url-list))
+ (newsticker--start-feed feed))
+ (unless running
+ (run-hooks 'newsticker-start-hook)
+ (message "Newsticker started!"))))
+
+(defun newsticker--stop-feed (feed-name)
+ "Stop retrieval for feed FEED-NAME.
+Delete the stopped name/timer pair from `newsticker--retrieval-timer-list'."
+ (let ((name-and-timer (assoc feed-name newsticker--retrieval-timer-list)))
+ (when name-and-timer
+ (cancel-timer (cdr name-and-timer))
+ (setq newsticker--retrieval-timer-list
+ (delete name-and-timer newsticker--retrieval-timer-list)))))
+
+(defun newsticker-stop ()
+ "Stop the newsticker and the newsticker-ticker.
+Cancel the timers for display and retrieval. Run `newsticker-stop-hook'
+if newsticker has been running."
+ (interactive)
+ (newsticker--cache-update t)
+ (when (fboundp 'newsticker-stop-ticker) ; silence compiler warnings
+ (newsticker-stop-ticker))
+ (when (newsticker-running-p)
+ (mapc (lambda (name-and-timer)
+ (newsticker--stop-feed (car name-and-timer)))
+ newsticker--retrieval-timer-list)
+ (setq newsticker--retrieval-timer-list nil)
+ (run-hooks 'newsticker-stop-hook)
+ (message "Newsticker stopped!")))
+
+(defun newsticker-get-all-news ()
+ "Launch retrieval of news from all configured newsticker sites.
+This does NOT start the retrieval timers."
+ (interactive)
+ ;; launch retrieval of news
+ (mapc (lambda (item)
+ (newsticker-get-news (car item)))
+ (append newsticker-url-list-defaults newsticker-url-list)))
+
+(defun newsticker-save-item (feed item)
+ "Save FEED ITEM."
+ (interactive)
+ (let ((filename (read-string "Filename: "
+ (concat feed ":_"
+ (replace-regexp-in-string
+ " " "_" (newsticker--title item))
+ ".html"))))
+ (with-temp-buffer
+ (insert (newsticker--desc item))
+ (write-file filename t))))
+
+(defun newsticker-add-url (url name)
+ "Add given URL under given NAME to `newsticker-url-list'.
+If URL is nil it is searched at point."
+ (interactive
+ (list
+ (read-string "URL: "
+ (save-excursion
+ (end-of-line)
+ (and
+ (re-search-backward
+ "http://"
+ (if (> (point) (+ (point-min) 100))
+ (- (point) 100)
+ (point-min))
+ t)
+ (re-search-forward
+ "http://[-a-zA-Z0-9&/_.]*"
+ (if (< (point) (- (point-max) 200))
+ (+ (point) 200)
+ (point-max))
+ t)
+ (buffer-substring-no-properties (match-beginning 0)
+ (match-end 0)))))
+ (read-string "Name: ")))
+ (add-to-list 'newsticker-url-list (list name url nil nil nil) t)
+ (customize-variable 'newsticker-url-list))
+
+(defun newsticker-customize ()
+ "Open the newsticker customization group."
+ (interactive)
+ (customize-group "newsticker"))
+
+;; ======================================================================
+;;; Local stuff
+;; ======================================================================
+(defun newsticker--get-news-by-funcall (feed-name function)
+ "Get news for the site FEED-NAME by calling FUNCTION.
+See `newsticker-get-news'."
+ (let ((buffername (concat " *newsticker-funcall-" feed-name "*")))
+ (save-excursion
+ (set-buffer (get-buffer-create buffername))
+ (erase-buffer)
+ (insert (string-to-multibyte (funcall function feed-name)))
+ (newsticker--sentinel-work nil t feed-name function
+ (current-buffer)))))
+
+(defun newsticker--get-news-by-url (feed-name url)
+ "Get news for the site FEED-NAME from address URL using `url-retrieve'.
+See `newsticker-get-news'."
+ (let ((coding-system-for-read 'no-conversion))
+ (url-retrieve url 'newsticker--get-news-by-url-callback (list feed-name)))
+ (force-mode-line-update))
+
+(defun newsticker--get-news-by-url-callback (status feed-name)
+ "Callback function for `newsticker--get-news-by-url'.
+STATUS is the return status as delivered by `url-retrieve', and
+FEED-NAME is the name of the feed that the news were retrieved
+from."
+ (let ((buf (get-buffer-create (concat " *newsticker-url-" feed-name "*")))
+ (result (string-to-multibyte (buffer-string))))
+ (set-buffer buf)
+ (erase-buffer)
+ (insert result)
+ ;; remove MIME header
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (delete-region (point-min) (point))
+ ;; read the rss/atom contents
+ (newsticker--sentinel-work nil t feed-name "url-retrieve" (current-buffer))
+ (when status
+ (let ((status-type (car status))
+ (status-details (cdr status)))
+ (cond ((eq status-type :redirect)
+ ;; don't care about redirects
+ )
+ ((eq status-type :error)
+ (message "%s: Error while retrieving news from %s: %s: \"%s\""
+ (format-time-string "%A, %H:%M" (current-time))
+ feed-name
+ (car status-details) (cdr status-details))))))))
+
+(defun newsticker--get-news-by-wget (feed-name url wget-arguments)
+ "Get news for the site FEED-NAME from address URL using wget.
+WGET-ARGUMENTS is a list of arguments for wget.
+See `newsticker-get-news'."
+ (let ((buffername (concat " *newsticker-wget-" feed-name "*")))
+ (save-excursion
+ (set-buffer (get-buffer-create buffername))
+ (erase-buffer)
+ ;; throw an error if there is an old wget-process around
+ (if (get-process feed-name)
+ (error "Another wget-process is running for %s" feed-name))
+ ;; start wget
+ (let* ((args (append wget-arguments (list url)))
+ (proc (apply 'start-process feed-name buffername
+ newsticker-wget-name args)))
+ (set-process-coding-system proc 'no-conversion 'no-conversion)
+ (set-process-sentinel proc 'newsticker--sentinel)
+ (setq newsticker--process-ids (cons (process-id proc)
+ newsticker--process-ids))
+ (force-mode-line-update)))))
+
+(defun newsticker-get-news (feed-name)
+ "Get news from the site FEED-NAME and load feed logo.
+FEED-NAME must be a string which occurs as the label (i.e. the first element)
+in an element of `newsticker-url-list' or `newsticker-url-list-defaults'."
+ (newsticker--debug-msg "%s: Getting news for %s"
+ (format-time-string "%A, %H:%M" (current-time))
+ feed-name)
+ (let* ((item (or (assoc feed-name newsticker-url-list)
+ (assoc feed-name newsticker-url-list-defaults)
+ (error
+ "Cannot get news for %s: Check newsticker-url-list"
+ feed-name)))
+ (url (cadr item))
+ (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
+ newsticker-wget-arguments)))
+ (if (functionp url)
+ (newsticker--get-news-by-funcall feed-name url)
+ (if (eq newsticker-retrieval-method 'intern)
+ (newsticker--get-news-by-url feed-name url)
+ (newsticker--get-news-by-wget feed-name url wget-arguments)))))
+
+;; ======================================================================
+;; Parsing
+;; ======================================================================
+
+(defun newsticker--sentinel (process event)
+ "Sentinel for extracting news titles from an RDF buffer.
+Argument PROCESS is the process which has just changed its state.
+Argument EVENT tells what has happened to the process."
+ (let ((p-status (process-status process))
+ (exit-status (process-exit-status process))
+ (name (process-name process))
+ (command (process-command process))
+ (buffer (process-buffer process)))
+ (newsticker--sentinel-work event
+ (and (eq p-status 'exit)
+ (= exit-status 0))
+ name command buffer)))
+
+(defun newsticker--sentinel-work (event status-ok name command buffer)
+ "Actually do the sentinel work.
+Argument EVENT tells what has happened to the retrieval process.
+Argument STATUS-OK is the final status of the retrieval process,
+non-nil meaning retrieval was successful.
+Argument NAME is the name of the retrieval process.
+Argument COMMAND is the command of the retrieval process.
+Argument BUFFER is the buffer of the retrieval process."
+ (let ((time (current-time))
+ (name-symbol (intern name))
+ (something-was-added nil))
+ ;; catch known errors (zombie processes, rubbish-xml etc.
+ ;; if an error occurs the news feed is not updated!
+ (catch 'oops
+ (unless status-ok
+ (setq newsticker--cache
+ (newsticker--cache-add
+ newsticker--cache
+ name-symbol
+ newsticker--error-headline
+ (format
+ (concat "%s: Newsticker could not retrieve news from %s.\n"
+ "Return status: `%s'\n"
+ "Command was `%s'")
+ (format-time-string "%A, %H:%M" (current-time))
+ name event command)
+ ""
+ (current-time)
+ 'new
+ 0 nil))
+ (message "%s: Error while retrieving news from %s"
+ (format-time-string "%A, %H:%M" (current-time))
+ name)
+ (throw 'oops nil))
+ (let* ((coding-system 'utf-8)
+ (node-list
+ (save-current-buffer
+ (set-buffer buffer)
+ ;; a very very dirty workaround to overcome the
+ ;; problems with the newest (20030621) xml.el:
+ ;; remove all unnecessary whitespace
+ (goto-char (point-min))
+ (while (re-search-forward ">[ \t\r\n]+<" nil t)
+ (replace-match "><" nil t))
+ ;; and another brutal workaround (20031105)! For some
+ ;; reason the xml parser does not like the colon in the
+ ;; doctype name "rdf:RDF"
+ (goto-char (point-min))
+ (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t)
+ (replace-match "<!DOCTYPE rdfColonRDF" nil t))
+ ;; finally.... ~##^°!!!!!
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" nil t))
+ ;; still more brutal workarounds (20040309)! The xml
+ ;; parser does not like doctype rss
+ (goto-char (point-min))
+ (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t)
+ (replace-match "" nil t))
+ ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
+ ;; Remove comments to avoid this xml-parsing bug:
+ ;; "XML files can have only one toplevel tag"
+ (goto-char (point-min))
+ (while (search-forward "<!--" nil t)
+ (let ((start (match-beginning 0)))
+ (unless (search-forward "-->" nil t)
+ (error "Can't find end of comment"))
+ (delete-region start (point))))
+ ;; And another one (20050702)! If description is HTML
+ ;; encoded and starts with a `<', wrap the whole
+ ;; description in a CDATA expression. This happened for
+ ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<description>\\(<img.*?\\)</description>" nil t)
+ (replace-match
+ "<description><![CDATA[ \\1 ]]></description>"))
+ ;; And another one (20051123)! XML parser does not
+ ;; like this: <yweather:location city="Frankfurt/Main"
+ ;; region="" country="GM" />
+ ;; try to "fix" empty attributes
+ ;; This happened for
+ ;; http://xml.weather.yahoo.com/forecastrss?p=GMXX0040&u=f
+ (goto-char (point-min))
+ (while (re-search-forward "\\(<[^>]*\\)=\"\"" nil t)
+ (replace-match "\\1=\" \""))
+ ;;
+ (set-buffer-modified-p nil)
+ ;; check coding system
+ (goto-char (point-min))
+ (if (re-search-forward "encoding=\"\\([^\"]+\\)\""
+ nil t)
+ (setq coding-system (intern (downcase (match-string 1))))
+ (setq coding-system
+ (condition-case nil
+ (check-coding-system coding-system)
+ (coding-system-error
+ (message
+ "newsticker.el: ignoring coding system %s for %s"
+ coding-system name)
+ nil))))
+ ;; Decode if possible
+ (when coding-system
+ (decode-coding-region (point-min) (point-max)
+ coding-system))
+ (condition-case errordata
+ ;; The xml parser might fail
+ ;; or the xml might be bugged
+ (xml-parse-region (point-min) (point-max))
+ (error (message "Could not parse %s: %s"
+ (buffer-name) (cadr errordata))
+ (throw 'oops nil)))))
+ (topnode (car node-list))
+ (channelnode (car (xml-get-children topnode 'channel)))
+ (imageurl nil))
+ ;; mark all items as obsolete
+ (newsticker--cache-replace-age newsticker--cache
+ name-symbol
+ 'new 'obsolete-new)
+ (newsticker--cache-replace-age newsticker--cache
+ name-symbol
+ 'old 'obsolete-old)
+ (newsticker--cache-replace-age newsticker--cache
+ name-symbol
+ 'feed 'obsolete-old)
+
+ ;; check Atom/RSS version and call corresponding parser
+ (condition-case error-data
+ (if (cond
+ ;; RSS 0.91
+ ((and (eq 'rss (xml-node-name topnode))
+ (string= "0.91" (xml-get-attribute topnode 'version)))
+ (setq imageurl (newsticker--get-logo-url-rss-0.91 topnode))
+ (newsticker--parse-rss-0.91 name time topnode))
+ ;; RSS 0.92
+ ((and (eq 'rss (xml-node-name topnode))
+ (string= "0.92" (xml-get-attribute topnode 'version)))
+ (setq imageurl (newsticker--get-logo-url-rss-0.92 topnode))
+ (newsticker--parse-rss-0.92 name time topnode))
+ ;; RSS 1.0
+ ((eq 'rdf:RDF (xml-node-name topnode))
+ (setq imageurl (newsticker--get-logo-url-rss-1.0 topnode))
+ (newsticker--parse-rss-1.0 name time topnode))
+ ;; RSS 2.0
+ ((and (eq 'rss (xml-node-name topnode))
+ (string= "2.0" (xml-get-attribute topnode 'version)))
+ (setq imageurl (newsticker--get-logo-url-rss-2.0 topnode))
+ (newsticker--parse-rss-2.0 name time topnode))
+ ;; Atom 0.3
+ ((and (eq 'feed (xml-node-name topnode))
+ (string= "http://purl.org/atom/ns#"
+ (xml-get-attribute topnode 'xmlns)))
+ (setq imageurl (newsticker--get-logo-url-atom-0.3 topnode))
+ (newsticker--parse-atom-0.3 name time topnode))
+ ;; Atom 1.0
+ ((and (eq 'feed (xml-node-name topnode))
+ (string= "http://www.w3.org/2005/Atom"
+ (xml-get-attribute topnode 'xmlns)))
+ (setq imageurl (newsticker--get-logo-url-atom-1.0 topnode))
+ (newsticker--parse-atom-1.0 name time topnode))
+ ;; unknown feed type
+ (t
+ (newsticker--debug-msg "Feed type unknown: %s: %s"
+ (xml-node-name topnode) name)
+ nil))
+ (setq something-was-added t))
+ (xerror (message "sentinelerror in %s: %s" name error-data)))
+
+ ;; Remove those old items from cache which have been removed from
+ ;; the feed
+ (newsticker--cache-replace-age newsticker--cache
+ name-symbol 'obsolete-old 'deleteme)
+ (newsticker--cache-remove newsticker--cache name-symbol
+ 'deleteme)
+ ;; Remove those new items from cache which have been removed from
+ ;; the feed. Or keep them as `obsolete'
+ (if (not newsticker-keep-obsolete-items)
+ (newsticker--cache-remove newsticker--cache
+ name-symbol 'obsolete-new)
+ (setq newsticker--cache
+ (newsticker--cache-mark-expired
+ newsticker--cache name-symbol 'obsolete 'obsolete-expired
+ newsticker-obsolete-item-max-age))
+ (newsticker--cache-remove newsticker--cache
+ name-symbol 'obsolete-expired)
+ (newsticker--cache-replace-age newsticker--cache
+ name-symbol 'obsolete-new
+ 'obsolete))
+ (newsticker--update-process-ids)
+ ;; setup scrollable text
+ (when (= 0 (length newsticker--process-ids))
+ (when (fboundp 'newsticker--ticker-text-setup) ;silence
+ ;compiler
+ ;warnings
+ (newsticker--ticker-text-setup)))
+ (setq newsticker--latest-update-time (current-time))
+ (when something-was-added
+ ;; FIXME: should we care about removed items as well?
+ (newsticker--cache-update)
+ (when (fboundp 'newsticker--buffer-set-uptodate) ;silence
+ ;compiler
+ ;warnings
+ (newsticker--buffer-set-uptodate nil)))
+ ;; kill the process buffer if wanted
+ (unless newsticker-debug
+ (kill-buffer buffer))
+ ;; launch retrieval of image
+ (when (and imageurl newsticker--download-logos)
+ (newsticker--image-get name imageurl)))))
+ (when newsticker--sentinel-callback
+ (funcall newsticker--sentinel-callback)))
+
+(defun newsticker--get-logo-url-atom-1.0 (node)
+ "Return logo URL from atom 1.0 data in NODE."
+ (car (xml-node-children
+ (car (xml-get-children node 'logo)))))
+
+(defun newsticker--get-logo-url-atom-0.3 (node)
+ "Return logo URL from atom 0.3 data in NODE."
+ (car (xml-node-children
+ (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
+
+(defun newsticker--get-logo-url-rss-2.0 (node)
+ "Return logo URL from RSS 2.0 data in NODE."
+ (car (xml-node-children
+ (car (xml-get-children
+ (car (xml-get-children
+ (car (xml-get-children node 'channel)) 'image)) 'url)))))
+
+(defun newsticker--get-logo-url-rss-1.0 (node)
+ "Return logo URL from RSS 1.0 data in NODE."
+ (car (xml-node-children
+ (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
+
+(defun newsticker--get-logo-url-rss-0.92 (node)
+ "Return logo URL from RSS 0.92 data in NODE."
+ (car (xml-node-children
+ (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
+
+(defun newsticker--get-logo-url-rss-0.91 (node)
+ "Return logo URL from RSS 0.91 data in NODE."
+ (car (xml-node-children
+ (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
+
+(defun newsticker--parse-atom-0.3 (name time topnode)
+ "Parse Atom 0.3 data.
+Return value as well as arguments NAME, TIME, and TOPNODE are the
+same as in `newsticker--parse-atom-1.0'."
+ (newsticker--debug-msg "Parsing Atom 0.3 feed %s" name)
+ (let (new-feed new-item)
+ (setq new-feed (newsticker--parse-generic-feed
+ name time
+ ;; title
+ (car (xml-node-children
+ (car (xml-get-children topnode 'title))))
+ ;; desc
+ (car (xml-node-children
+ (car (xml-get-children topnode 'content))))
+ ;; link
+ (xml-get-attribute
+ (car (xml-get-children topnode 'link)) 'href)
+ ;; extra-elements
+ (xml-node-children topnode)))
+ (setq new-item (newsticker--parse-generic-items
+ name time (xml-get-children topnode 'entry)
+ ;; title-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'title)))))
+ ;; desc-fn
+ (lambda (node)
+ (or (car (xml-node-children
+ (car (xml-get-children node 'content))))
+ (car (xml-node-children
+ (car (xml-get-children node 'summary))))))
+ ;; link-fn
+ (lambda (node)
+ (xml-get-attribute
+ (car (xml-get-children node 'link)) 'href))
+ ;; time-fn
+ (lambda (node)
+ (newsticker--decode-rfc822-date
+ (car (xml-node-children
+ (car (xml-get-children node 'modified))))))
+ ;; guid-fn
+ (lambda (node)
+ (newsticker--guid-to-string
+ (assoc 'guid (xml-node-children node))))
+ ;; extra-fn
+ (lambda (node)
+ (xml-node-children node))))
+ (or new-item new-feed)))
+
+(defun newsticker--parse-atom-1.0 (name time topnode)
+ "Parse Atom 1.0 data.
+Argument NAME gives the name of a news feed. TIME gives the
+system time at which the data have been retrieved. TOPNODE
+contains the feed data as returned by the xml parser.
+
+For the Atom 1.0 specification see
+http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html"
+ (newsticker--debug-msg "Parsing Atom 1.0 feed %s" name)
+ (let (new-feed new-item)
+ (setq new-feed (newsticker--parse-generic-feed
+ name time
+ ;; title
+ (car (xml-node-children
+ (car (xml-get-children topnode 'title))))
+ ;; desc
+ (car (xml-node-children
+ (car (xml-get-children topnode 'subtitle))))
+ ;; link
+ (lambda (node)
+ (xml-get-attribute
+ (car (xml-get-children node 'link)) 'href))
+ ;; extra-elements
+ (xml-node-children topnode)))
+ (setq new-item (newsticker--parse-generic-items
+ name time (xml-get-children topnode 'entry)
+ ;; title-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'title)))))
+ ;; desc-fn
+ (lambda (node)
+ (or (car (xml-node-children
+ (car (xml-get-children node 'content))))
+ (car (xml-node-children
+ (car (xml-get-children node 'summary))))))
+ ;; link-fn
+ (lambda (node)
+ (xml-get-attribute
+ (car (xml-get-children node 'link)) 'href))
+ ;; time-fn
+ (lambda (node)
+ (newsticker--decode-iso8601-date
+ (or (car (xml-node-children
+ (car (xml-get-children node 'updated))))
+ (car (xml-node-children
+ (car (xml-get-children node 'published)))))))
+ ;; guid-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'id)))))
+ ;; extra-fn
+ (lambda (node)
+ (xml-node-children node))))
+ (or new-item new-feed)))
+
+(defun newsticker--parse-rss-0.91 (name time topnode)
+ "Parse RSS 0.91 data.
+Return value as well as arguments NAME, TIME, and TOPNODE are the
+same as in `newsticker--parse-atom-1.0'.
+
+For the RSS 0.91 specification see http://backend.userland.com/rss091 or
+http://my.netscape.com/publish/formats/rss-spec-0.91.html."
+ (newsticker--debug-msg "Parsing RSS 0.91 feed %s" name)
+ (let* ((channelnode (car (xml-get-children topnode 'channel)))
+ (pub-date (newsticker--decode-rfc822-date
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'pubDate))))))
+ is-new-feed has-new-items)
+ (setq is-new-feed (newsticker--parse-generic-feed
+ name time
+ ;; title
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'title))))
+ ;; desc
+ (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'description))))
+ ;; link
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'link))))
+ ;; extra-elements
+ (xml-node-children channelnode)))
+ (setq has-new-items (newsticker--parse-generic-items
+ name time (xml-get-children channelnode 'item)
+ ;; title-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'title)))))
+ ;; desc-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'description)))))
+ ;; link-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'link)))))
+ ;; time-fn
+ (lambda (node)
+ (newsticker--decode-rfc822-date
+ (car (xml-node-children
+ (car (xml-get-children node 'pubDate))))))
+ ;; guid-fn
+ (lambda (node)
+ nil)
+ ;; extra-fn
+ (lambda (node)
+ (xml-node-children node))))
+ (or has-new-items is-new-feed)))
+
+(defun newsticker--parse-rss-0.92 (name time topnode)
+ "Parse RSS 0.92 data.
+Return value as well as arguments NAME, TIME, and TOPNODE are the
+same as in `newsticker--parse-atom-1.0'.
+
+For the RSS 0.92 specification see http://backend.userland.com/rss092."
+ (newsticker--debug-msg "Parsing RSS 0.92 feed %s" name)
+ (let* ((channelnode (car (xml-get-children topnode 'channel)))
+ (pub-date (newsticker--decode-rfc822-date
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'pubDate))))))
+ is-new-feed has-new-items)
+ (setq is-new-feed (newsticker--parse-generic-feed
+ name time
+ ;; title
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'title))))
+ ;; desc
+ (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'description))))
+ ;; link
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'link))))
+ ;; extra-elements
+ (xml-node-children channelnode)))
+ (setq has-new-items (newsticker--parse-generic-items
+ name time (xml-get-children channelnode 'item)
+ ;; title-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'title)))))
+ ;; desc-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'description)))))
+ ;; link-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'link)))))
+ ;; time-fn
+ (lambda (node)
+ (newsticker--decode-rfc822-date
+ (car (xml-node-children
+ (car (xml-get-children node 'pubDate))))))
+ ;; guid-fn
+ (lambda (node)
+ nil)
+ ;; extra-fn
+ (lambda (node)
+ (xml-node-children node))))
+ (or has-new-items is-new-feed)))
+
+(defun newsticker--parse-rss-1.0 (name time topnode)
+ "Parse RSS 1.0 data.
+Return value as well as arguments NAME, TIME, and TOPNODE are the
+same as in `newsticker--parse-atom-1.0'.
+
+For the RSS 1.0 specification see http://web.resource.org/rss/1.0/spec."
+ (newsticker--debug-msg "Parsing RSS 1.0 feed %s" name)
+ (let* ((channelnode (car (xml-get-children topnode 'channel)))
+ is-new-feed has-new-items)
+ (setq is-new-feed (newsticker--parse-generic-feed
+ name time
+ ;; title
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'title))))
+ ;; desc
+ (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'description))))
+ ;; link
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'link))))
+ ;; extra-elements
+ (xml-node-children channelnode)))
+ (setq has-new-items (newsticker--parse-generic-items
+ name time (xml-get-children topnode 'item)
+ ;; title-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'title)))))
+ ;; desc-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node
+ 'description)))))
+ ;; link-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'link)))))
+ ;; time-fn
+ (lambda (node)
+ (newsticker--decode-iso8601-date
+ (car (xml-node-children
+ (car (xml-get-children node 'dc:date))))))
+ ;; guid-fn
+ (lambda (node)
+ nil)
+ ;; extra-fn
+ (lambda (node)
+ (xml-node-children node))))
+ (or has-new-items is-new-feed)))
+
+(defun newsticker--parse-rss-2.0 (name time topnode)
+ "Parse RSS 2.0 data.
+Return value as well as arguments NAME, TIME, and TOPNODE are the
+same as in `newsticker--parse-atom-1.0'.
+
+For the RSS 2.0 specification see http://blogs.law.harvard.edu/tech/rss."
+ (newsticker--debug-msg "Parsing RSS 2.0 feed %s" name)
+ (let* ((channelnode (car (xml-get-children topnode 'channel)))
+ is-new-feed has-new-items)
+ (setq is-new-feed (newsticker--parse-generic-feed
+ name time
+ ;; title
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'title))))
+ ;; desc
+ (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'description))))
+ ;; link
+ (car (xml-node-children
+ (car (xml-get-children channelnode 'link))))
+ ;; extra-elements
+ (xml-node-children channelnode)))
+ (setq has-new-items (newsticker--parse-generic-items
+ name time (xml-get-children channelnode 'item)
+ ;; title-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'title)))))
+ ;; desc-fn
+ (lambda (node)
+ (or (car (xml-node-children
+ (car (xml-get-children node
+ 'content:encoded))))
+ (car (xml-node-children
+ (car (xml-get-children node
+ 'description))))))
+ ;; link-fn
+ (lambda (node)
+ (car (xml-node-children
+ (car (xml-get-children node 'link)))))
+ ;; time-fn
+ (lambda (node)
+ (newsticker--decode-rfc822-date
+ (car (xml-node-children
+ (car (xml-get-children node 'pubDate))))))
+ ;; guid-fn
+ (lambda (node)
+ (newsticker--guid-to-string
+ (assoc 'guid (xml-node-children node))))
+ ;; extra-fn
+ (lambda (node)
+ (xml-node-children node))))
+ (or has-new-items is-new-feed)))
+
+(defun newsticker--parse-generic-feed (name time title desc link
+ extra-elements)
+ "Parse generic news feed data.
+Argument NAME gives the name of a news feed. TIME gives the
+system time at which the data have been retrieved.
+
+The arguments TITLE, DESC, LINK, and EXTRA-ELEMENTS give the feed's title,
+description, link, and extra elements resp."
+ (let ((title (or title "[untitled]"))
+ (link (or link ""))
+ (old-item nil)
+ (position 0)
+ (something-was-added nil))
+ ;; decode numeric entities
+ (setq title (newsticker--decode-numeric-entities title))
+ (setq desc (newsticker--decode-numeric-entities desc))
+ (setq link (newsticker--decode-numeric-entities link))
+ ;; remove whitespace from title, desc, and link
+ (setq title (newsticker--remove-whitespace title))
+ (setq desc (newsticker--remove-whitespace desc))
+ (setq link (newsticker--remove-whitespace link))
+
+ ;; handle the feed itself
+ (unless (newsticker--cache-contains newsticker--cache
+ (intern name) title
+ desc link 'feed)
+ (setq something-was-added t))
+ (setq newsticker--cache
+ (newsticker--cache-add newsticker--cache (intern name)
+ title desc link time 'feed position
+ extra-elements time 'feed))
+ something-was-added))
+
+(defun newsticker--parse-generic-items (name time itemlist
+ title-fn desc-fn
+ link-fn time-fn
+ guid-fn extra-fn)
+ "Parse generic news feed data.
+Argument NAME gives the name of a news feed. TIME gives the
+system time at which the data have been retrieved. ITEMLIST
+contains the news items returned by the xml parser.
+
+The arguments TITLE-FN, DESC-FN, LINK-FN, TIME-FN, GUID-FN, and
+EXTRA-FN give functions for extracting title, description, link,
+time, guid, and extra-elements resp. They are called with one
+argument, which is one of the items in ITEMLIST."
+ (let (title desc link
+ (old-item nil)
+ (position 0)
+ (something-was-added nil))
+ ;; gather all items for this feed
+ (mapc (lambda (node)
+ (setq position (1+ position))
+ (setq title (or (funcall title-fn node) "[untitled]"))
+ (setq desc (funcall desc-fn node))
+ (setq link (or (funcall link-fn node) ""))
+ (setq time (or (funcall time-fn node) time))
+ ;; It happened that the title or description
+ ;; contained evil HTML code that confused the
+ ;; xml parser. Therefore:
+ (unless (stringp title)
+ (setq title (prin1-to-string title)))
+ (unless (or (stringp desc) (not desc))
+ (setq desc (prin1-to-string desc)))
+ ;; ignore items with empty title AND empty desc
+ (when (or (> (length title) 0)
+ (> (length desc) 0))
+ ;; decode numeric entities
+ (setq title (newsticker--decode-numeric-entities title))
+ (when desc
+ (setq desc (newsticker--decode-numeric-entities desc)))
+ (setq link (newsticker--decode-numeric-entities link))
+ ;; remove whitespace from title, desc, and link
+ (setq title (newsticker--remove-whitespace title))
+ (setq desc (newsticker--remove-whitespace desc))
+ (setq link (newsticker--remove-whitespace link))
+ ;; add data to cache
+ ;; do we have this item already?
+ (let* ((guid (funcall guid-fn node)))
+ ;;(message "guid=%s" guid)
+ (setq old-item
+ (newsticker--cache-contains newsticker--cache
+ (intern name) title
+ desc link nil guid)))
+ ;; add this item, or mark it as old, or do nothing
+ (let ((age1 'new)
+ (age2 'old)
+ (item-new-p nil))
+ (if old-item
+ (let ((prev-age (newsticker--age old-item)))
+ (unless newsticker-automatically-mark-items-as-old
+ ;; Some feeds deliver items multiply, the
+ ;; first time we find an 'obsolete-old one the
+ ;; cache, the following times we find an 'old
+ ;; one
+ (if (memq prev-age '(obsolete-old old))
+ (setq age2 'old)
+ (setq age2 'new)))
+ (if (eq prev-age 'immortal)
+ (setq age2 'immortal))
+ (setq time (newsticker--time old-item)))
+ ;; item was not there
+ (setq item-new-p t)
+ (setq something-was-added t))
+ (setq newsticker--cache
+ (newsticker--cache-add
+ newsticker--cache (intern name) title desc link
+ time age1 position (funcall extra-fn node)
+ time age2))
+ (when item-new-p
+ (let ((item (newsticker--cache-contains
+ newsticker--cache (intern name) title
+ desc link nil)))
+ (if newsticker-auto-mark-filter-list
+ (newsticker--run-auto-mark-filter name item))
+ (run-hook-with-args
+ 'newsticker-new-item-functions name item))))))
+ itemlist)
+ something-was-added))
+
+;; ======================================================================
+;;; Misc
+;; ======================================================================
+(defun newsticker--decode-numeric-entities (string)
+ "Decode SGML numeric entities by their respective utf characters.
+This function replaces numeric entities in the input STRING and
+returns the modified string. For example \"*\" gets replaced
+by \"*\"."
+ (if (and string (stringp string))
+ (let ((start 0))
+ (while (string-match "&#\\([0-9]+\\);" string start)
+ (condition-case nil
+ (setq string (replace-match
+ (string (read (substring string
+ (match-beginning 1)
+ (match-end 1))))
+ nil nil string))
+ (error nil))
+ (setq start (1+ (match-beginning 0))))
+ string)
+ nil))
+
+(defun newsticker--remove-whitespace (string)
+ "Remove leading and trailing whitespace from STRING."
+ ;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
+ ;; endlessly...
+ (when (and string (stringp string))
+ (replace-regexp-in-string
+ "[ \t\r\n]+$" ""
+ (replace-regexp-in-string "^[ \t\r\n]+" "" string))))
+
+(defun newsticker--do-forget-preformatted (item)
+ "Forget pre-formatted data for ITEM.
+Remove the pre-formatted from `newsticker--cache'."
+ (if (nthcdr 7 item)
+ (setcar (nthcdr 7 item) nil))
+ (if (nthcdr 6 item)
+ (setcar (nthcdr 6 item) nil)))
+
+(defun newsticker--forget-preformatted ()
+ "Forget all cached pre-formatted data.
+Remove the pre-formatted from `newsticker--cache'."
+ (mapc (lambda (feed)
+ (mapc 'newsticker--do-forget-preformatted
+ (cdr feed)))
+ newsticker--cache)
+ (when (fboundp 'newsticker--buffer-set-uptodate)
+ (newsticker--buffer-set-uptodate nil)))
+
+(defun newsticker--debug-msg (string &rest args)
+ "Print newsticker debug messages.
+This function calls `message' with arguments STRING and ARGS, if
+`newsticker-debug' is non-nil."
+ (and newsticker-debug
+ ;;(not (active-minibuffer-window))
+ ;;(not (current-message))
+ (apply 'message string args)))
+
+(defun newsticker--decode-iso8601-date (iso8601-string)
+ "Return ISO8601-STRING in format like `decode-time'.
+Converts from ISO-8601 to Emacs representation.
+Examples:
+2004-09-17T05:09:49.001+00:00
+2004-09-17T05:09:49+00:00
+2004-09-17T05:09+00:00
+2004-09-17T05:09:49
+2004-09-17T05:09
+2004-09-17
+2004-09
+2004"
+ (if iso8601-string
+ (when (string-match
+ (concat
+ "^ *\\([0-9]\\{4\\}\\)" ;year
+ "\\(-\\([0-9]\\{2\\}\\)" ;month
+ "\\(-\\([0-9]\\{2\\}\\)" ;day
+ "\\(T"
+ "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" ;hour:minute
+ "\\(:\\([0-9]\\{2\\}\\)\\(\\.[0-9]+\\)?\\)?" ;second
+ ;timezone
+ "\\(\\([-+Z]\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)?"
+ "\\)?\\)?\\)? *$")
+ iso8601-string)
+ (let ((year (read (match-string 1 iso8601-string)))
+ (month (read (or (match-string 3 iso8601-string)
+ "1")))
+ (day (read (or (match-string 5 iso8601-string)
+ "1")))
+ (hour (read (or (match-string 7 iso8601-string)
+ "0")))
+ (minute (read (or (match-string 8 iso8601-string)
+ "0")))
+ (second (read (or (match-string 10 iso8601-string)
+ "0")))
+ (sign (match-string 13 iso8601-string))
+ (offset-hour (read (or (match-string 15 iso8601-string)
+ "0")))
+ (offset-minute (read (or (match-string 16 iso8601-string)
+ "0"))))
+ (cond ((string= sign "+")
+ (setq hour (- hour offset-hour))
+ (setq minute (- minute offset-minute)))
+ ((string= sign "-")
+ (setq hour (+ hour offset-hour))
+ (setq minute (+ minute offset-minute))))
+ ;; if UTC subtract current-time-zone offset
+ ;;(setq second (+ (car (current-time-zone)) second)))
+
+ (condition-case nil
+ (encode-time second minute hour day month year t)
+ (error
+ (message "Cannot decode \"%s\"" iso8601-string)
+ nil))))
+ nil))
+
+(defun newsticker--decode-rfc822-date (rfc822-string)
+ "Return RFC822-STRING in format like `decode-time'.
+Converts from RFC822 to Emacs representation.
+Examples:
+Sat, 07 September 2002 00:00:01 +0100
+Sat, 07 September 2002 00:00:01 MET
+Sat, 07 Sep 2002 00:00:01 GMT
+07 Sep 2002 00:00:01 GMT
+07 Sep 2002"
+ (if (and rfc822-string (stringp rfc822-string))
+ (when (string-match
+ (concat
+ "\\s-*"
+ ;; week day
+ "\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)?\\s-*"
+ ;; day
+ "\\([0-9]\\{1,2\\}\\)\\s-+"
+ ;; month
+ "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|"
+ "Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\).*?\\s-+"
+ ;; year
+ "\\([0-9]\\{2,4\\}\\)"
+ ;; time may be missing
+ "\\(\\s-+"
+ ;; hour
+ "\\([0-9]\\{2\\}\\)"
+ ;; minute
+ ":\\([0-9]\\{2\\}\\)"
+ ;; second
+ "\\(:\\([0-9]\\{2\\}\\)\\)?"
+ ;; zone -- fixme
+ "\\(\\s-+\\("
+ "UT\\|GMT\\|EST\\|EDT\\|CST\\|CDT\\|MST\\|MDT\\|PST\\|PDT"
+ "\\|\\([-+]\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)"
+ "\\)\\)?"
+ "\\)?")
+ rfc822-string)
+ (let ((day (read (match-string 3 rfc822-string)))
+ (month-name (match-string 4 rfc822-string))
+ (month 0)
+ (year (read (match-string 5 rfc822-string)))
+ (hour (read (or (match-string 7 rfc822-string) "0")))
+ (minute (read (or (match-string 8 rfc822-string) "0")))
+ (second (read (or (match-string 10 rfc822-string) "0")))
+ (zone (match-string 12 rfc822-string))
+ (sign (match-string 13 rfc822-string))
+ (offset-hour (read (or (match-string 14 rfc822-string)
+ "0")))
+ (offset-minute (read (or (match-string 15 rfc822-string)
+ "0")))
+ ;;FIXME
+ )
+ (when zone
+ (cond ((string= sign "+")
+ (setq hour (- hour offset-hour))
+ (setq minute (- minute offset-minute)))
+ ((string= sign "-")
+ (setq hour (+ hour offset-hour))
+ (setq minute (+ minute offset-minute)))))
+ (condition-case error-data
+ (let ((i 1))
+ (mapc (lambda (m)
+ (if (string= month-name m)
+ (setq month i))
+ (setq i (1+ i)))
+ '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
+ "Sep" "Oct" "Nov" "Dec"))
+ (encode-time second minute hour day month year t))
+ (error
+ (message "Cannot decode \"%s\": %s %s" rfc822-string
+ (car error-data) (cdr error-data))
+ nil))))
+ nil))
+
+(defun newsticker--lists-intersect-p (list1 list2)
+ "Return t if LIST1 and LIST2 share elements."
+ (let ((result nil))
+ (mapc (lambda (elt)
+ (if (memq elt list2)
+ (setq result t)))
+ list1)
+ result))
+
+(defun newsticker--update-process-ids ()
+ "Update list of ids of active newsticker processes.
+Checks list of active processes against list of newsticker processes."
+ (let ((active-procs (process-list))
+ (new-list nil))
+ (mapc (lambda (proc)
+ (let ((id (process-id proc)))
+ (if (memq id newsticker--process-ids)
+ (setq new-list (cons id new-list)))))
+ active-procs)
+ (setq newsticker--process-ids new-list))
+ (force-mode-line-update))
+
+;; ======================================================================
+;;; Images
+;; ======================================================================
+(defun newsticker--image-get (feed-name url)
+ "Get image of the news site FEED-NAME from URL.
+If the image has been downloaded in the last 24h do nothing."
+ (let ((image-name (concat newsticker-imagecache-dirname "/"
+ feed-name)))
+ (if (and (file-exists-p image-name)
+ (time-less-p (current-time)
+ (time-add (nth 5 (file-attributes image-name))
+ (seconds-to-time 86400))))
+ (newsticker--debug-msg "%s: Getting image for %s skipped"
+ (format-time-string "%A, %H:%M" (current-time))
+ feed-name)
+ ;; download
+ (newsticker--debug-msg "%s: Getting image for %s"
+ (format-time-string "%A, %H:%M" (current-time))
+ feed-name)
+ (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*"))
+ (item (or (assoc feed-name newsticker-url-list)
+ (assoc feed-name newsticker-url-list-defaults)
+ (error
+ "Cannot get news for %s: Check newsticker-url-list"
+ feed-name)))
+ (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
+ newsticker-wget-arguments)))
+ (save-excursion
+ (set-buffer (get-buffer-create buffername))
+ (erase-buffer)
+ ;; throw an error if there is an old wget-process around
+ (if (get-process feed-name)
+ (error "Another wget-process is running for image %s"
+ feed-name))
+ ;; start wget
+ (let* ((args (append wget-arguments (list url)))
+ (proc (apply 'start-process feed-name buffername
+ newsticker-wget-name args)))
+ (set-process-coding-system proc 'no-conversion 'no-conversion)
+ (set-process-sentinel proc 'newsticker--image-sentinel)))))))
+
+(defun newsticker--image-sentinel (process event)
+ "Sentinel for image-retrieving PROCESS caused by EVENT."
+ (let* ((p-status (process-status process))
+ (exit-status (process-exit-status process))
+ (feed-name (process-name process)))
+ ;; catch known errors (zombie processes, rubbish-xml, etc.)
+ ;; if an error occurs the news feed is not updated!
+ (catch 'oops
+ (unless (and (eq p-status 'exit)
+ (= exit-status 0))
+ (message "%s: Error while retrieving image from %s"
+ (format-time-string "%A, %H:%M" (current-time))
+ feed-name)
+ (throw 'oops nil))
+ (let (image-name)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (setq image-name (concat newsticker-imagecache-dirname "/"
+ feed-name))
+ (set-buffer-file-coding-system 'no-conversion)
+ ;; make sure the cache dir exists
+ (unless (file-directory-p newsticker-imagecache-dirname)
+ (make-directory newsticker-imagecache-dirname))
+ ;; write and close buffer
+ (let ((require-final-newline nil)
+ (backup-inhibited t)
+ (coding-system-for-write 'no-conversion))
+ (write-region nil nil image-name nil 'quiet))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer)))))))
+
+
+
+(defun newsticker--insert-image (img string)
+ "Insert IMG with STRING at point."
+ (insert-image img string))
+
+;; ======================================================================
+;;; HTML rendering
+;; ======================================================================
+(defun newsticker-htmlr-render (pos1 pos2) ;
+ "Replacement for `htmlr-render'.
+Renders the HTML code in the region POS1 to POS2 using htmlr."
+ (let ((str (buffer-substring-no-properties pos1 pos2)))
+ (delete-region pos1 pos2)
+ (insert
+ (with-temp-buffer
+ (insert str)
+ (goto-char (point-min))
+ ;; begin original htmlr-render
+ (when (fboundp 'htmlr-reset) (htmlr-reset))
+ ;; something omitted here...
+ (when (fboundp 'htmlr-step)
+ (while (< (point) (point-max))
+ (htmlr-step)))
+ ;; end original htmlr-render
+ (newsticker--remove-whitespace (buffer-string))))))
+
+;; ======================================================================
+;;; Manipulation of cached data
+;; ======================================================================
+(defun newsticker--cache-set-preformatted-contents (item contents)
+ "Set preformatted contents of ITEM to CONTENTS."
+ (if (nthcdr 6 item)
+ (setcar (nthcdr 6 item) contents)
+ (setcdr (nthcdr 5 item) (list contents))))
+
+(defun newsticker--cache-set-preformatted-title (item title)
+ "Set preformatted title of ITEM to TITLE."
+ (if (nthcdr 7 item)
+ (setcar (nthcdr 7 item) title)
+ (setcdr (nthcdr 6 item) title)))
+
+(defun newsticker--cache-replace-age (data feed old-age new-age)
+ "Mark all items in DATA in FEED which carry age OLD-AGE with NEW-AGE.
+If FEED is 'any it applies to all feeds. If OLD-AGE is 'any,
+all marks are replaced by NEW-AGE. Removes all pre-formatted contents."
+ (mapc (lambda (a-feed)
+ (when (or (eq feed 'any)
+ (eq (car a-feed) feed))
+ (let ((items (cdr a-feed)))
+ (mapc (lambda (item)
+ (when (or (eq old-age 'any)
+ (eq (newsticker--age item) old-age))
+ (setcar (nthcdr 4 item) new-age)
+ (newsticker--do-forget-preformatted item)))
+ items))))
+ data)
+ data)
+
+(defun newsticker--cache-mark-expired (data feed old-age new-age time)
+ "Mark all expired entries.
+This function sets the age entries in DATA in the feed FEED. If
+an item's age is OLD-AGE it is set to NEW-AGE if the item is
+older than TIME."
+ (mapc
+ (lambda (a-feed)
+ (when (or (eq feed 'any)
+ (eq (car a-feed) feed))
+ (let ((items (cdr a-feed)))
+ (mapc
+ (lambda (item)
+ (when (eq (newsticker--age item) old-age)
+ (let ((exp-time (time-add (newsticker--time item)
+ (seconds-to-time time))))
+ (when (time-less-p exp-time (current-time))
+ (newsticker--debug-msg
+ "Item `%s' from %s has expired on %s"
+ (newsticker--title item)
+ (format-time-string "%Y-%02m-%d, %H:%M"
+ (newsticker--time item))
+ (format-time-string "%Y-%02m-%d, %H:%M" exp-time))
+ (setcar (nthcdr 4 item) new-age)))))
+ items))))
+ data)
+ data)
+
+(defun newsticker--cache-contains (data feed title desc link age
+ &optional guid)
+ "Check DATA whether FEED contains an item with the given properties.
+This function returns the contained item or nil if it is not
+contained.
+The properties which are checked are TITLE, DESC, LINK, AGE, and
+GUID. In general all properties must match in order to return a
+certain item, except for the following cases.
+
+If AGE equals 'feed the TITLE, DESCription and LINK do not
+matter. If DESC is nil it is ignored as well. If
+`newsticker-desc-comp-max' is non-nil, only the first
+`newsticker-desc-comp-max' characters of DESC are taken into
+account.
+
+If GUID is non-nil it is sufficient to match this value, and the
+other properties are ignored."
+ ;;(newsticker--debug-msg "Looking for %s guid=%s" title guid)
+ (condition-case nil
+ (catch 'found
+ (when (and desc newsticker-desc-comp-max
+ (> (length desc) newsticker-desc-comp-max))
+ (setq desc (substring desc 0 newsticker-desc-comp-max)))
+ (mapc
+ (lambda (this-feed)
+ (when (eq (car this-feed) feed)
+ (mapc (lambda (anitem)
+ (when (cond (guid
+ ;; global unique id can match
+ (string= guid (newsticker--guid anitem)))
+ (t;;FIXME?
+ (or
+ ;; or title, desc, etc.
+ (and
+ ;;(or (not (eq age 'feed))
+ ;; (eq (newsticker--age anitem) 'feed))
+ (string= (newsticker--title anitem)
+ title)
+ (or (not link)
+ (string= (newsticker--link anitem)
+ link))
+ (or (not desc)
+ (if (and desc newsticker-desc-comp-max
+ (> (length (newsticker--desc
+ anitem))
+ newsticker-desc-comp-max))
+ (string= (substring
+ (newsticker--desc anitem)
+ 0
+ newsticker-desc-comp-max)
+ desc)
+ (string= (newsticker--desc anitem)
+ desc)))))))
+ ;;(newsticker--debug-msg "Found %s guid=%s"
+ ;; (newsticker--title anitem)
+ ;; (newsticker--guid anitem))
+ (throw 'found anitem)))
+ (cdr this-feed))))
+ data)
+ ;;(newsticker--debug-msg "Found nothing")
+ nil)
+ (error nil)))
+
+(defun newsticker--cache-add (data feed-name-symbol title desc link time age
+ position extra-elements
+ &optional updated-time updated-age
+ preformatted-contents
+ preformatted-title)
+ "Add another item to cache data.
+Add to DATA in the FEED-NAME-SYMBOL an item with TITLE, DESC,
+LINK, TIME, AGE, POSITION, and EXTRA-ELEMENTS. If this item is
+contained already, its time is set to UPDATED-TIME, its mark is
+set to UPDATED-AGE, and its pre-formatted contents is set to
+PREFORMATTED-CONTENTS and PREFORMATTED-TITLE. Returns the age
+which the item got."
+ (let* ((guid (newsticker--guid-to-string (assoc 'guid extra-elements)))
+ (item (newsticker--cache-contains data feed-name-symbol title desc link
+ age guid)))
+ ;;(message "guid=%s" guid)
+ (if item
+ ;; does exist already -- change age, update time and position
+ (progn
+ ;;(newsticker--debug-msg "Updating item %s %s %s %s %s -> %s %s
+ ;; (guid %s -> %s)"
+ ;; feed-name-symbol title link time age
+ ;; updated-time updated-age
+ ;; guid (newsticker--guid item))
+ (if (nthcdr 5 item)
+ (setcar (nthcdr 5 item) position)
+ (setcdr (nthcdr 4 item) (list position)))
+ (setcar (nthcdr 4 item) updated-age)
+ (if updated-time
+ (setcar (nthcdr 3 item) updated-time))
+ ;; replace cached pre-formatted contents
+ (newsticker--cache-set-preformatted-contents
+ item preformatted-contents)
+ (newsticker--cache-set-preformatted-title
+ item preformatted-title))
+ ;; did not exist or age equals 'feed-name-symbol
+ (setq item (list title desc link time age position preformatted-contents
+ preformatted-title extra-elements))
+ ;;(newsticker--debug-msg "Adding item %s" item)
+ (catch 'found
+ (mapc (lambda (this-feed)
+ (when (eq (car this-feed) feed-name-symbol)
+ (setcdr this-feed (nconc (cdr this-feed) (list item)))
+ (throw 'found this-feed)))
+ data)
+ ;; the feed is not contained
+ (add-to-list 'data (list feed-name-symbol item) t))))
+ data)
+
+(defun newsticker--cache-remove (data feed-symbol age)
+ "Remove all entries from DATA in the feed FEED-SYMBOL with AGE.
+FEED-SYMBOL may be 'any. Entries from old feeds, which are no longer in
+`newsticker-url-list' or `newsticker-url-list-defaults', are removed as
+well."
+ (let* ((pos data)
+ (feed (car pos))
+ (last-pos nil))
+ (while feed
+ (if (or (assoc (symbol-name (car feed)) newsticker-url-list)
+ (assoc (symbol-name (car feed)) newsticker-url-list-defaults))
+ ;; feed is still valid=active
+ ;; (message "Keeping feed %s" (car feed))
+ (if (or (eq feed-symbol 'any)
+ (eq feed-symbol (car feed)))
+ (let* ((item-pos (cdr feed))
+ (item (car item-pos))
+ (prev-pos nil))
+ (while item
+ ;;(message "%s" (car item))
+ (if (eq age (newsticker--age item))
+ ;; remove this item
+ (progn
+ ;;(message "Removing item %s" (car item))
+ (if prev-pos
+ (setcdr prev-pos (cdr item-pos))
+ (setcdr feed (cdr item-pos))))
+ ;;(message "Keeping item %s" (car item))
+ (setq prev-pos item-pos))
+ (setq item-pos (cdr item-pos))
+ (setq item (car item-pos)))))
+ ;; feed is not active anymore
+ ;; (message "Removing feed %s" (car feed))
+ (if last-pos
+ (setcdr last-pos (cdr pos))
+ (setq data (cdr pos))))
+ (setq last-pos pos)
+ (setq pos (cdr pos))
+ (setq feed (car pos)))))
+
+;; ======================================================================
+;;; Sorting
+;; ======================================================================
+(defun newsticker--cache-item-compare-by-time (item1 item2)
+ "Compare two news items ITEM1 and ITEM2 by comparing their time values."
+ (catch 'result
+ (let ((age1 (newsticker--age item1))
+ (age2 (newsticker--age item2)))
+ (if (not (eq age1 age2))
+ (cond ((eq age1 'obsolete)
+ (throw 'result nil))
+ ((eq age2 'obsolete)
+ (throw 'result t)))))
+ (let* ((time1 (newsticker--time item1))
+ (time2 (newsticker--time item2)))
+ (cond ((< (nth 0 time1) (nth 0 time2))
+ nil)
+ ((> (nth 0 time1) (nth 0 time2))
+ t)
+ ((< (nth 1 time1) (nth 1 time2))
+ nil)
+ ((> (nth 1 time1) (nth 1 time2))
+ t)
+ ((< (or (nth 2 time1) 0) (or (nth 2 time2) 0))
+ nil)
+ ((> (or (nth 2 time1) 0) (or (nth 2 time2) 0))
+ t)
+ (t
+ nil)))))
+
+(defun newsticker--cache-item-compare-by-title (item1 item2)
+ "Compare ITEM1 and ITEM2 by comparing their titles."
+ (catch 'result
+ (let ((age1 (newsticker--age item1))
+ (age2 (newsticker--age item2)))
+ (if (not (eq age1 age2))
+ (cond ((eq age1 'obsolete)
+ (throw 'result nil))
+ ((eq age2 'obsolete)
+ (throw 'result t)))))
+ (string< (newsticker--title item1) (newsticker--title item2))))
+
+(defun newsticker--cache-item-compare-by-position (item1 item2)
+ "Compare ITEM1 and ITEM2 by comparing their original positions."
+ (catch 'result
+ (let ((age1 (newsticker--age item1))
+ (age2 (newsticker--age item2)))
+ (if (not (eq age1 age2))
+ (cond ((eq age1 'obsolete)
+ (throw 'result nil))
+ ((eq age2 'obsolete)
+ (throw 'result t)))))
+ (< (or (newsticker--pos item1) 0) (or (newsticker--pos item2) 0))))
+
+
+
+(defun newsticker--cache-save ()
+ "Update and save newsticker cache file."
+ (interactive)
+ (newsticker--cache-update t))
+
+(defun newsticker--cache-update (&optional save)
+ "Update newsticker cache file.
+If optional argument SAVE is not nil the cache file is saved to disk."
+ (save-excursion
+ (let ((coding-system-for-write 'utf-8))
+ (with-temp-buffer
+ (setq buffer-undo-list t)
+ (erase-buffer)
+ (insert ";; -*- coding: utf-8 -*-\n")
+ (insert (prin1-to-string newsticker--cache))
+ (when save
+ (set-visited-file-name newsticker-cache-filename)
+ (save-buffer))))))
+
+(defun newsticker--cache-get-feed (feed)
+ "Return the cached data for the feed FEED.
+FEED is a symbol!"
+ (assoc feed newsticker--cache))
+
+;; ======================================================================
+;;; Statistics
+;; ======================================================================
+(defun newsticker--stat-num-items (feed &rest ages)
+ "Return number of items in the given FEED which have one of the given AGES.
+If AGES is nil, the total number of items is returned."
+ (let ((items (cdr (newsticker--cache-get-feed feed)))
+ (num 0))
+ (while items
+ (if ages
+ (if (memq (newsticker--age (car items)) ages)
+ (setq num (1+ num)))
+ (if (memq (newsticker--age (car items)) '(new old immortal obsolete))
+ (setq num (1+ num))))
+ (setq items (cdr items)))
+ num))
+
+(defun newsticker--stat-num-items-total (&optional age)
+ "Return total number of items in all feeds which have the given AGE.
+If AGE is nil, the total number of items is returned."
+ (apply '+
+ (mapcar (lambda (feed)
+ (if age
+ (newsticker--stat-num-items (intern (car feed)) age)
+ (newsticker--stat-num-items (intern (car feed)))))
+ (append newsticker-url-list-defaults newsticker-url-list))))
+
+;; ======================================================================
+;;; OPML
+;; ======================================================================
+(defun newsticker-opml-export ()
+ "OPML subscription export.
+Export subscriptions to a buffer in OPML Format."
+ (interactive)
+ (with-current-buffer (get-buffer-create "*OPML Export*")
+ (set-buffer-file-coding-system 'utf-8)
+ (insert (concat
+ "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
+ "<!-- OPML generated by Emacs newsticker.el -->\n"
+ "<opml version=\"1.0\">\n"
+ " <head>\n"
+ " <title>mySubscriptions</title>\n"
+ " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
+ "</dateCreated>\n"
+ " <ownerEmail>" user-mail-address "</ownerEmail>\n"
+ " <ownerName>" (user-full-name) "</ownerName>\n"
+ " </head>\n"
+ " <body>\n"))
+ (mapc (lambda (sub)
+ (insert " <outline text=\"")
+ (insert (newsticker--title sub))
+ (insert "\" xmlUrl=\"")
+ (insert (cadr sub))
+ (insert "\"/>\n"))
+ (append newsticker-url-list newsticker-url-list-defaults))
+ (insert " </body>\n</opml>\n"))
+ (pop-to-buffer "*OPML Export*")
+ (when (fboundp 'sgml-mode)
+ (sgml-mode)))
+
+(defun newsticker--opml-import-outlines (outlines)
+ "Recursively import OUTLINES from OPML data.
+Note that nested outlines are currently flattened -- i.e. grouping is
+removed."
+ (mapc (lambda (outline)
+ (let ((name (xml-get-attribute outline 'text))
+ (url (xml-get-attribute outline 'xmlUrl))
+ (children (xml-get-children outline 'outline)))
+ (unless (string= "" url)
+ (add-to-list 'newsticker-url-list
+ (list name url nil nil nil) t))
+ (if children
+ (newsticker--opml-import-outlines children))))
+ outlines))
+
+(defun newsticker-opml-import (filename)
+ "Import OPML data from FILENAME."
+ (interactive "fOPML file: ")
+ (set-buffer (find-file-noselect filename))
+ (goto-char (point-min))
+ (let* ((node-list (xml-parse-region (point-min) (point-max)))
+ (body (car (xml-get-children (car node-list) 'body)))
+ (outlines (xml-get-children body 'outline)))
+ (newsticker--opml-import-outlines outlines))
+ (customize-variable 'newsticker-url-list))
+
+;; ======================================================================
+;;; Auto marking
+;; ======================================================================
+(defun newsticker--run-auto-mark-filter (feed item)
+ "Automatically mark an item as old or immortal.
+This function checks the variable `newsticker-auto-mark-filter-list'
+for an entry that matches FEED and ITEM."
+ (let ((case-fold-search t))
+ (mapc (lambda (filter)
+ (let ((filter-feed (car filter))
+ (pattern-list (cadr filter)))
+ (when (string-match filter-feed feed)
+ (newsticker--do-run-auto-mark-filter item pattern-list))))
+ newsticker-auto-mark-filter-list)))
+
+(defun newsticker--do-run-auto-mark-filter (item list)
+ "Actually compare ITEM against the pattern-LIST.
+LIST must be an element of `newsticker-auto-mark-filter-list'."
+ (mapc (lambda (pattern)
+ (let ((age (nth 0 pattern))
+ (place (nth 1 pattern))
+ (regexp (nth 2 pattern))
+ (title (newsticker--title item))
+ (desc (newsticker--desc item)))
+ (when (or (eq place 'title) (eq place 'all))
+ (when (and title (string-match regexp title))
+ (newsticker--debug-msg "Auto-marking as %s: `%s'"
+ age (newsticker--title item))
+ (setcar (nthcdr 4 item) age)))
+ (when (or (eq place 'description) (eq place 'all))
+ (when (and desc (string-match regexp desc))
+ (newsticker--debug-msg "Auto-marking as %s: `%s'"
+ age (newsticker--title item))
+ (setcar (nthcdr 4 item) age)))))
+ list))
+
+
+;; ======================================================================
+;;; Hook samples
+;; ======================================================================
+(defun newsticker-new-item-functions-sample (feed item)
+ "Demonstrate the use of the `newsticker-new-item-functions' hook.
+This function just prints out the values of the FEED and title of the ITEM."
+ (message (concat "newsticker-new-item-functions-sample: feed=`%s', "
+ "title=`%s'")
+ feed (newsticker--title item)))
+
+(defun newsticker-download-images (feed item)
+ "Download the first image.
+If FEED equals \"imagefeed\" download the first image URL found
+in the description=contents of ITEM to the directory
+\"~/tmp/newsticker/FEED/TITLE\" where TITLE is the title of the item."
+ (when (string= feed "imagefeed")
+ (let ((title (newsticker--title item))
+ (desc (newsticker--desc item)))
+ (when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc)
+ (let ((url (substring desc (match-beginning 1) (match-end 1)))
+ (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
+ (org-dir default-directory))
+ (unless (file-directory-p temp-dir)
+ (make-directory temp-dir t))
+ (cd temp-dir)
+ (message "Getting image %s" url)
+ (apply 'start-process "wget-image"
+ " *newsticker-wget-download-images*"
+ newsticker-wget-name
+ (list url))
+ (cd org-dir))))))
+
+(defun newsticker-download-enclosures (feed item)
+ "In all FEEDs download the enclosed object of the news ITEM.
+The object is saved to the directory \"~/tmp/newsticker/FEED/TITLE\", which
+is created if it does not exist. TITLE is the title of the news
+item. Argument FEED is ignored.
+This function is suited for adding it to `newsticker-new-item-functions'."
+ (let ((title (newsticker--title item))
+ (enclosure (newsticker--enclosure item)))
+ (when enclosure
+ (let ((url (cdr (assoc 'url enclosure)))
+ (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
+ (org-dir default-directory))
+ (unless (file-directory-p temp-dir)
+ (make-directory temp-dir t))
+ (cd temp-dir)
+ (message "Getting enclosure %s" url)
+ (apply 'start-process "wget-enclosure"
+ " *newsticker-wget-download-enclosures*"
+ newsticker-wget-name
+ (list url))
+ (cd org-dir)))))
+
+;; ======================================================================
+;;; Retrieve samples
+;; ======================================================================
+(defun newsticker-retrieve-random-message (feed-name)
+ "Return an artificial RSS string under the name FEED-NAME."
+ (concat "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?><rss version=\"0.91\">"
+ "<channel>"
+ "<title>newsticker-retrieve-random-message</title>"
+ "<description>Sample retrieval function</description>"
+ "<pubDate>FIXME Sat, 07 Sep 2005 00:00:01 GMT</pubDate>"
+ "<item><title>" (format "Your lucky number is %d" (random 10000))
+ "</title><description>" (format "Or maybe it is %d" (random 10000))
+ "</description></item></channel></rss>"))
+
+(provide 'newsticker-backend)
+
+;; arch-tag: 0e37b658-56e9-49ab-90f9-f2df57e1a659
+;;; newsticker-backend.el ends here
--- /dev/null
+;;; newst-plainview.el --- Single buffer frontend for newsticker.
+
+;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+;; Free Software Foundation, Inc.
+
+;; Author: Ulf Jasper <ulf.jasper@web.de>
+;; Filename: newst-plainview.el
+;; URL: http://www.nongnu.org/newsticker
+;; Time-stamp: "13. Juni 2008, 18:49:26 (ulf)"
+
+;; ======================================================================
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;; ======================================================================
+;;; Commentary:
+
+;; See newsticker.el
+
+;; ======================================================================
+;;; Code:
+
+(require 'newsticker-ticker)
+(require 'newsticker-reader)
+(require 'derived)
+(require 'xml)
+
+;; Silence warnings
+(defvar w3-mode-map)
+(defvar w3m-minor-mode-map)
+
+;; ======================================================================
+;;; Customization
+;; ======================================================================
+(defgroup newsticker-plainview nil
+ "Settings for the simple plain view reader.
+See also `newsticker-plainview-hooks'."
+ :group 'newsticker-reader)
+
+
+(defun newsticker--set-customvar-buffer (symbol value)
+ "Set newsticker-variable SYMBOL value to VALUE.
+Calls all actions which are necessary in order to make the new
+value effective."
+ (if (or (not (boundp symbol))
+ (equal (symbol-value symbol) value))
+ (set symbol value)
+ ;; something must have changed
+ (set symbol value)
+ (newsticker--buffer-set-uptodate nil)))
+
+(defun newsticker--set-customvar-sorting (symbol value)
+ "Set newsticker-variable SYMBOL value to VALUE.
+Calls all actions which are necessary in order to make the new
+value effective."
+ (if (or (not (boundp symbol))
+ (equal (symbol-value symbol) value))
+ (set symbol value)
+ ;; something must have changed
+ (set symbol value)
+ (message "Applying new sort method...")
+ (when (fboundp 'newsticker--cache-sort) (newsticker--cache-sort))
+ (when (fboundp 'newsticker--buffer-set-uptodate)
+ (newsticker--buffer-set-uptodate nil))
+ (message "Applying new sort method...done")))
+
+(defcustom newsticker-sort-method
+ 'sort-by-original-order
+ "Sort method for news items.
+The following sort methods are available:
+* `sort-by-original-order' keeps the order in which the items
+ appear in the headline file (please note that for immortal items,
+ which have been removed from the news feed, there is no original
+ order),
+* `sort-by-time' looks at the time at which an item has been seen
+ the first time. The most recent item is put at top,
+* `sort-by-title' will put the items in an alphabetical order."
+ :type '(choice
+ (const :tag "Keep original order" sort-by-original-order)
+ (const :tag "Sort by time" sort-by-time)
+ (const :tag "Sort by title" sort-by-title))
+ :set 'newsticker--set-customvar-sorting
+ :group 'newsticker-plainview)
+
+(defcustom newsticker-heading-format
+ "%l
+%t %d %s"
+ "Format string for feed headings.
+The following printf-like specifiers can be used:
+%d The date the feed was retrieved. See `newsticker-date-format'.
+%l The logo (image) of the feed. Most news feeds provide a small
+ image as logo. Newsticker can display them, if Emacs can --
+ see `image-types' for a list of supported image types.
+%L The logo (image) of the feed. If the logo is not available
+ the title of the feed is used.
+%s The statistical data of the feed. See `newsticker-statistics-format'.
+%t The title of the feed, i.e. its name."
+ :type 'string
+ :set 'newsticker--set-customvar-formatting
+ :group 'newsticker-plainview)
+
+(defcustom newsticker-item-format
+ "%t %d"
+ "Format string for news item headlines.
+The following printf-like specifiers can be used:
+%d The date the item was (first) retrieved. See `newsticker-date-format'.
+%l The logo (image) of the feed. Most news feeds provide a small
+ image as logo. Newsticker can display them, if Emacs can --
+ see `image-types' for a list of supported image types.
+%L The logo (image) of the feed. If the logo is not available
+ the title of the feed is used.
+%t The title of the item."
+ :type 'string
+ :set 'newsticker--set-customvar-formatting
+ :group 'newsticker-plainview)
+
+(defcustom newsticker-desc-format
+ "%d %c"
+ "Format string for news descriptions (contents).
+The following printf-like specifiers can be used:
+%c The contents (description) of the item.
+%d The date the item was (first) retrieved. See
+ `newsticker-date-format'."
+ :type 'string
+ :set 'newsticker--set-customvar-formatting
+ :group 'newsticker-plainview)
+
+(defcustom newsticker-statistics-format
+ "[%n + %i + %o + %O = %a]"
+ "Format for the statistics part in feed lines.
+The following printf-like specifiers can be used:
+%a The number of all items in the feed.
+%i The number of immortal items in the feed.
+%n The number of new items in the feed.
+%o The number of old items in the feed.
+%O The number of obsolete items in the feed."
+ :type 'string
+ :set 'newsticker--set-customvar-formatting
+ :group 'newsticker-plainview)
+
+
+;; ======================================================================
+;; faces
+(defgroup newsticker-faces nil
+ "Settings for the faces of the feed reader."
+ :group 'newsticker-plainview)
+
+(defface newsticker-feed-face
+ '((((class color) (background dark))
+ (:family "helvetica" :bold t :height 1.2 :foreground "misty rose"))
+ (((class color) (background light))
+ (:family "helvetica" :bold t :height 1.2 :foreground "black")))
+ "Face for news feeds."
+ :group 'newsticker-faces)
+
+(defface newsticker-new-item-face
+ '((((class color) (background dark))
+ (:family "helvetica" :bold t))
+ (((class color) (background light))
+ (:family "helvetica" :bold t)))
+ "Face for new news items."
+ :group 'newsticker-faces)
+
+(defface newsticker-old-item-face
+ '((((class color) (background dark))
+ (:family "helvetica" :bold t :foreground "orange3"))
+ (((class color) (background light))
+ (:family "helvetica" :bold t :foreground "red4")))
+ "Face for old news items."
+ :group 'newsticker-faces)
+
+(defface newsticker-immortal-item-face
+ '((((class color) (background dark))
+ (:family "helvetica" :bold t :italic t :foreground "orange"))
+ (((class color) (background light))
+ (:family "helvetica" :bold t :italic t :foreground "blue")))
+ "Face for immortal news items."
+ :group 'newsticker-faces)
+
+(defface newsticker-obsolete-item-face
+ '((((class color) (background dark))
+ (:family "helvetica" :bold t :strike-through t))
+ (((class color) (background light))
+ (:family "helvetica" :bold t :strike-through t)))
+ "Face for old news items."
+ :group 'newsticker-faces)
+
+(defface newsticker-date-face
+ '((((class color) (background dark))
+ (:family "helvetica" :italic t :height 0.8))
+ (((class color) (background light))
+ (:family "helvetica" :italic t :height 0.8)))
+ "Face for newsticker dates."
+ :group 'newsticker-faces)
+
+(defface newsticker-statistics-face
+ '((((class color) (background dark))
+ (:family "helvetica" :italic t :height 0.8))
+ (((class color) (background light))
+ (:family "helvetica" :italic t :height 0.8)))
+ "Face for newsticker dates."
+ :group 'newsticker-faces)
+
+(defface newsticker-enclosure-face
+ '((((class color) (background dark))
+ (:bold t :background "orange"))
+ (((class color) (background light))
+ (:bold t :background "orange")))
+ "Face for enclosed elements."
+ :group 'newsticker-faces)
+
+(defface newsticker-extra-face
+ '((((class color) (background dark))
+ (:italic t :foreground "gray50" :height 0.8))
+ (((class color) (background light))
+ (:italic t :foreground "gray50" :height 0.8)))
+ "Face for newsticker dates."
+ :group 'newsticker-faces)
+
+(defface newsticker-default-face
+ '((((class color) (background dark))
+ (:inherit default))
+ (((class color) (background light))
+ (:inherit default)))
+ "Face for the description of news items."
+ ;;:set 'newsticker--set-customvar
+ :group 'newsticker-faces)
+
+(defcustom newsticker-hide-old-items-in-newsticker-buffer
+ nil
+ "Decides whether to automatically hide old items in the *newsticker* buffer.
+If set to t old items will be completely folded and only new
+items will show up in the *newsticker* buffer. Otherwise old as
+well as new items will be visible."
+ :type 'boolean
+ :set 'newsticker--set-customvar-buffer
+ :group 'newsticker-plainview)
+
+(defcustom newsticker-show-descriptions-of-new-items
+ t
+ "Whether to automatically show descriptions of new items in *newsticker*.
+If set to t old items will be folded and new items will be
+unfolded. Otherwise old as well as new items will be folded."
+ :type 'boolean
+ :set 'newsticker--set-customvar-buffer
+ :group 'newsticker-plainview)
+
+(defcustom newsticker-show-all-news-elements
+ nil
+ "Show all news elements."
+ :type 'boolean
+ ;;:set 'newsticker--set-customvar
+ :group 'newsticker-plainview)
+
+;; ======================================================================
+;; hooks
+(defgroup newsticker-plainview-hooks nil
+ "Settings for newsticker hooks which apply to plainview only."
+ :group 'newsticker-hooks)
+
+(defcustom newsticker-select-item-hook
+ 'newsticker--buffer-make-item-completely-visible
+ "List of functions run after a headline has been selected.
+Each function is called after one of `newsticker-next-item',
+`newsticker-next-new-item', `newsticker-previous-item',
+`newsticker-previous-new-item' has been called.
+
+The default value 'newsticker--buffer-make-item-completely-visible
+assures that the current item is always completely visible."
+ :type 'hook
+ :options '(newsticker--buffer-make-item-completely-visible)
+ :group 'newsticker-plainview-hooks)
+
+(defcustom newsticker-select-feed-hook
+ 'newsticker--buffer-make-item-completely-visible
+ "List of functions run after a feed has been selected.
+Each function is called after one of `newsticker-next-feed', and
+`newsticker-previous-feed' has been called.
+
+The default value 'newsticker--buffer-make-item-completely-visible
+assures that the current feed is completely visible."
+ :type 'hook
+ :options '(newsticker--buffer-make-item-completely-visible)
+ :group 'newsticker-plainview-hooks)
+
+(defcustom newsticker-buffer-change-hook
+ 'newsticker-w3m-show-inline-images
+ "List of functions run after the newsticker buffer has been updated.
+Each function is called after `newsticker-buffer-update' has been called.
+
+The default value '`newsticker-w3m-show-inline-images' loads inline
+images."
+ :type 'hook
+ :group 'newsticker-plainview-hooks)
+
+(defcustom newsticker-narrow-hook
+ 'newsticker-w3m-show-inline-images
+ "List of functions run after narrowing in newsticker buffer has changed.
+Each function is called after
+`newsticker-toggle-auto-narrow-to-feed' or
+`newsticker-toggle-auto-narrow-to-item' has been called.
+
+The default value '`newsticker-w3m-show-inline-images' loads inline
+images."
+ :type 'hook
+ :group 'newsticker-plainview-hooks)
+
+;; ======================================================================
+;;; Toolbar
+;; ======================================================================
+
+(defvar newsticker--plainview-tool-bar-map
+ (if (featurep 'xemacs)
+ nil
+ (if (boundp 'tool-bar-map)
+ (let ((tool-bar-map (make-sparse-keymap)))
+ (define-key tool-bar-map [newsticker-sep-1]
+ (list 'menu-item "--double-line"))
+ (define-key tool-bar-map [newsticker-browse-url]
+ (list 'menu-item "newsticker-browse-url" 'newsticker-browse-url
+ :visible t
+ :help "Browse URL for item at point"
+ :image newsticker--browse-image))
+ (define-key tool-bar-map [newsticker-buffer-force-update]
+ (list 'menu-item "newsticker-buffer-force-update"
+ 'newsticker-buffer-force-update
+ :visible t
+ :help "Update newsticker buffer"
+ :image newsticker--update-image
+ :enable '(not newsticker--buffer-uptodate-p)))
+ (define-key tool-bar-map [newsticker-get-all-news]
+ (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
+ :visible t
+ :help "Get news for all feeds"
+ :image newsticker--get-all-image))
+ (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
+ (list 'menu-item "newsticker-mark-item-at-point-as-read"
+ 'newsticker-mark-item-at-point-as-read
+ :visible t
+ :image newsticker--mark-read-image
+ :help "Mark current item as read"
+ :enable '(newsticker-item-not-old-p)))
+ (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
+ (list 'menu-item "newsticker-mark-item-at-point-as-immortal"
+ 'newsticker-mark-item-at-point-as-immortal
+ :visible t
+ :image newsticker--mark-immortal-image
+ :help "Mark current item as immortal"
+ :enable '(newsticker-item-not-immortal-p)))
+ (define-key tool-bar-map [newsticker-toggle-auto-narrow-to-feed]
+ (list 'menu-item "newsticker-toggle-auto-narrow-to-feed"
+ 'newsticker-toggle-auto-narrow-to-feed
+ :visible t
+ :help "Toggle visibility of other feeds"
+ :image newsticker--narrow-image))
+ (define-key tool-bar-map [newsticker-next-feed]
+ (list 'menu-item "newsticker-next-feed" 'newsticker-next-feed
+ :visible t
+ :help "Go to next feed"
+ :image newsticker--next-feed-image
+ :enable '(newsticker-next-feed-available-p)))
+ (define-key tool-bar-map [newsticker-next-item]
+ (list 'menu-item "newsticker-next-item" 'newsticker-next-item
+ :visible t
+ :help "Go to next item"
+ :image newsticker--next-item-image
+ :enable '(newsticker-next-item-available-p)))
+ (define-key tool-bar-map [newsticker-previous-item]
+ (list 'menu-item "newsticker-previous-item" 'newsticker-previous-item
+ :visible t
+ :help "Go to previous item"
+ :image newsticker--previous-item-image
+ :enable '(newsticker-previous-item-available-p)))
+ (define-key tool-bar-map [newsticker-previous-feed]
+ (list 'menu-item "newsticker-previous-feed" 'newsticker-previous-feed
+ :visible t
+ :help "Go to previous feed"
+ :image newsticker--previous-feed-image
+ :enable '(newsticker-previous-feed-available-p)))
+ ;; standard icons / actions
+ (tool-bar-add-item "close"
+ 'newsticker-close-buffer
+ 'newsticker-close-buffer
+ :help "Close newsticker buffer")
+ (tool-bar-add-item "preferences"
+ 'newsticker-customize
+ 'newsticker-customize
+ :help "Customize newsticker")
+ tool-bar-map))))
+
+;; ======================================================================
+;;; Newsticker mode
+;; ======================================================================
+
+(define-derived-mode newsticker-mode fundamental-mode
+ "NewsTicker"
+ "Viewing news feeds in Emacs."
+ (if (boundp 'tool-bar-map)
+ (set (make-local-variable 'tool-bar-map)
+ newsticker--plainview-tool-bar-map))
+ (set (make-local-variable 'imenu-sort-function) nil)
+ (set (make-local-variable 'scroll-conservatively) 999)
+ (setq imenu-create-index-function 'newsticker--imenu-create-index)
+ (setq imenu-default-goto-function 'newsticker--imenu-goto)
+ (setq buffer-read-only t)
+ (auto-fill-mode -1) ;; turn auto-fill off!
+ (font-lock-mode -1) ;; turn off font-lock!!
+ (set (make-local-variable 'font-lock-defaults) nil)
+ (set (make-local-variable 'line-move-ignore-invisible) t)
+ (setq mode-line-format
+ (list "-"
+ 'mode-line-mule-info
+ 'mode-line-modified
+ 'mode-line-frame-identification
+ " Newsticker ("
+ '(newsticker--buffer-uptodate-p
+ "up to date"
+ "NEED UPDATE")
+ ") "
+ '(:eval (format "[%d]" (length newsticker--process-ids)))
+ " -- "
+ '(:eval (newsticker--buffer-get-feed-title-at-point))
+ ": "
+ '(:eval (newsticker--buffer-get-item-title-at-point))
+ " %-"))
+ (add-to-invisibility-spec 't)
+ (unless newsticker-show-all-news-elements
+ (add-to-invisibility-spec 'extra))
+ (newsticker--buffer-set-uptodate nil))
+
+;; refine its mode-map
+(define-key newsticker-mode-map "sO" 'newsticker-show-old-items)
+(define-key newsticker-mode-map "hO" 'newsticker-hide-old-items)
+(define-key newsticker-mode-map "sa" 'newsticker-show-all-desc)
+(define-key newsticker-mode-map "ha" 'newsticker-hide-all-desc)
+(define-key newsticker-mode-map "sf" 'newsticker-show-feed-desc)
+(define-key newsticker-mode-map "hf" 'newsticker-hide-feed-desc)
+(define-key newsticker-mode-map "so" 'newsticker-show-old-item-desc)
+(define-key newsticker-mode-map "ho" 'newsticker-hide-old-item-desc)
+(define-key newsticker-mode-map "sn" 'newsticker-show-new-item-desc)
+(define-key newsticker-mode-map "hn" 'newsticker-hide-new-item-desc)
+(define-key newsticker-mode-map "se" 'newsticker-show-entry)
+(define-key newsticker-mode-map "he" 'newsticker-hide-entry)
+(define-key newsticker-mode-map "sx" 'newsticker-show-extra)
+(define-key newsticker-mode-map "hx" 'newsticker-hide-extra)
+
+(define-key newsticker-mode-map " " 'scroll-up)
+(define-key newsticker-mode-map "q" 'newsticker-close-buffer)
+(define-key newsticker-mode-map "p" 'newsticker-previous-item)
+(define-key newsticker-mode-map "P" 'newsticker-previous-new-item)
+(define-key newsticker-mode-map "F" 'newsticker-previous-feed)
+(define-key newsticker-mode-map "\t" 'newsticker-next-item)
+(define-key newsticker-mode-map "n" 'newsticker-next-item)
+(define-key newsticker-mode-map "N" 'newsticker-next-new-item)
+(define-key newsticker-mode-map "f" 'newsticker-next-feed)
+(define-key newsticker-mode-map "M" 'newsticker-mark-all-items-as-read)
+(define-key newsticker-mode-map "m"
+ 'newsticker-mark-all-items-at-point-as-read-and-redraw)
+(define-key newsticker-mode-map "o"
+ 'newsticker-mark-item-at-point-as-read)
+(define-key newsticker-mode-map "O"
+ 'newsticker-mark-all-items-at-point-as-read)
+(define-key newsticker-mode-map "G" 'newsticker-get-all-news)
+(define-key newsticker-mode-map "g" 'newsticker-get-news-at-point)
+(define-key newsticker-mode-map "u" 'newsticker-buffer-update)
+(define-key newsticker-mode-map "U" 'newsticker-buffer-force-update)
+(define-key newsticker-mode-map "a" 'newsticker-add-url)
+
+(define-key newsticker-mode-map "i"
+ 'newsticker-mark-item-at-point-as-immortal)
+
+(define-key newsticker-mode-map "xf"
+ 'newsticker-toggle-auto-narrow-to-feed)
+(define-key newsticker-mode-map "xi"
+ 'newsticker-toggle-auto-narrow-to-item)
+
+;; maps for the clickable portions
+(defvar newsticker--url-keymap (make-sparse-keymap)
+ "Key map for click-able headings in the newsticker buffer.")
+(define-key newsticker--url-keymap [mouse-1]
+ 'newsticker-mouse-browse-url)
+(define-key newsticker--url-keymap [mouse-2]
+ 'newsticker-mouse-browse-url)
+(define-key newsticker--url-keymap "\n"
+ 'newsticker-browse-url)
+(define-key newsticker--url-keymap "\C-m"
+ 'newsticker-browse-url)
+(define-key newsticker--url-keymap [(control return)]
+ 'newsticker-handle-url)
+
+;; newsticker menu
+(defvar newsticker-menu (make-sparse-keymap "Newsticker"))
+
+(define-key newsticker-menu [newsticker-browse-url]
+ '("Browse URL for item at point" . newsticker-browse-url))
+(define-key newsticker-menu [newsticker-separator-1]
+ '("--"))
+(define-key newsticker-menu [newsticker-buffer-update]
+ '("Update buffer" . newsticker-buffer-update))
+(define-key newsticker-menu [newsticker-separator-2]
+ '("--"))
+(define-key newsticker-menu [newsticker-get-all-news]
+ '("Get news from all feeds" . newsticker-get-all-news))
+(define-key newsticker-menu [newsticker-get-news-at-point]
+ '("Get news from feed at point" . newsticker-get-news-at-point))
+(define-key newsticker-menu [newsticker-separator-3]
+ '("--"))
+(define-key newsticker-menu [newsticker-mark-all-items-as-read]
+ '("Mark all items as read" . newsticker-mark-all-items-as-read))
+(define-key newsticker-menu [newsticker-mark-all-items-at-point-as-read]
+ '("Mark all items in feed at point as read" .
+ newsticker-mark-all-items-at-point-as-read))
+(define-key newsticker-menu [newsticker-mark-item-at-point-as-read]
+ '("Mark item at point as read" .
+ newsticker-mark-item-at-point-as-read))
+(define-key newsticker-menu [newsticker-mark-item-at-point-as-immortal]
+ '("Toggle immortality for item at point" .
+ newsticker-mark-item-at-point-as-immortal))
+(define-key newsticker-menu [newsticker-separator-4]
+ '("--"))
+(define-key newsticker-menu [newsticker-toggle-auto-narrow-to-item]
+ '("Narrow to single item" . newsticker-toggle-auto-narrow-to-item))
+(define-key newsticker-menu [newsticker-toggle-auto-narrow-to-feed]
+ '("Narrow to single news feed" . newsticker-toggle-auto-narrow-to-feed))
+(define-key newsticker-menu [newsticker-hide-old-items]
+ '("Hide old items" . newsticker-hide-old-items))
+(define-key newsticker-menu [newsticker-show-old-items]
+ '("Show old items" . newsticker-show-old-items))
+(define-key newsticker-menu [newsticker-next-item]
+ '("Go to next item" . newsticker-next-item))
+(define-key newsticker-menu [newsticker-previous-item]
+ '("Go to previous item" . newsticker-previous-item))
+
+;; bind menu to mouse
+(define-key newsticker-mode-map [down-mouse-3] newsticker-menu)
+;; Put menu in menu-bar
+(define-key newsticker-mode-map [menu-bar Newsticker]
+ (cons "Newsticker" newsticker-menu))
+
+
+;; ======================================================================
+;;; User fun
+;; ======================================================================
+;;;###autoload
+(defun newsticker-plainview ()
+ "Start newsticker plainview."
+ (interactive)
+ (newsticker-buffer-update t)
+ (switch-to-buffer "*newsticker*"))
+
+(defun newsticker-buffer-force-update ()
+ "Update the newsticker buffer, even if not necessary."
+ (interactive)
+ (newsticker-buffer-update t))
+
+(defun newsticker-buffer-update (&optional force)
+ "Update the *newsticker* buffer.
+Unless FORCE is t this is done only if necessary, i.e. when the
+*newsticker* buffer is not up-to-date."
+ (interactive)
+ ;; bring cache data into proper order....
+ (newsticker--cache-sort)
+ ;; fill buffer
+ (save-excursion
+ (let ((buf (get-buffer "*newsticker*")))
+ (if buf
+ (switch-to-buffer buf)
+ (switch-to-buffer (get-buffer-create "*newsticker*"))
+ (newsticker--buffer-set-uptodate nil)))
+ (when (or force
+ (not newsticker--buffer-uptodate-p))
+ (message "Preparing newsticker buffer...")
+ (setq buffer-undo-list t)
+ (let ((inhibit-read-only t))
+ (set-buffer-modified-p nil)
+ (erase-buffer)
+ (newsticker-mode)
+ ;; Emacs 21.3.50 does not care if we turn off auto-fill in the
+ ;; definition of newsticker-mode, so we do it here (again)
+ (auto-fill-mode -1)
+
+ (set-buffer-file-coding-system 'utf-8)
+
+ (if newsticker-use-full-width
+ (set (make-local-variable 'fill-column) (1- (window-width))))
+ (newsticker--buffer-insert-all-items)
+
+ ;; FIXME: needed for methods buffer in ecb
+ ;; (set-visited-file-name "*newsticker*")
+
+ (set-buffer-modified-p nil)
+ (newsticker-hide-all-desc)
+ (if newsticker-hide-old-items-in-newsticker-buffer
+ (newsticker-hide-old-items))
+ (if newsticker-show-descriptions-of-new-items
+ (newsticker-show-new-item-desc))
+ )
+ (message ""))
+ (newsticker--buffer-set-uptodate t)
+ (run-hooks 'newsticker-buffer-change-hook)))
+
+(defun newsticker-get-news-at-point ()
+ "Launch retrieval of news for the feed point is in.
+This does NOT start the retrieval timers."
+ (interactive)
+ ;; launch retrieval of news
+ (let ((feed (get-text-property (point) 'feed)))
+ (when feed
+ (newsticker--debug-msg "Getting news for %s" (symbol-name feed))
+ (newsticker-get-news (symbol-name feed)))))
+
+(declare-function w3m-toggle-inline-image "ext:w3m" (&optional force no-cache))
+
+(defun newsticker-w3m-show-inline-images ()
+ "Show inline images in visible text ranges.
+In-line images in invisible text ranges are hidden. This function
+calls `w3m-toggle-inline-image'. It works only if
+`newsticker-html-renderer' is set to `w3m-region'."
+ (interactive)
+ (if (eq newsticker-html-renderer 'w3m-region)
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((pos (point)))
+ (while pos
+ (setq pos (next-single-property-change pos 'w3m-image))
+ (when pos
+ (goto-char pos)
+ (when (get-text-property pos 'w3m-image)
+ (let ((invis (newsticker--lists-intersect-p
+ (get-text-property (1- (point))
+ 'invisible)
+ buffer-invisibility-spec)))
+ (unless (car (get-text-property (1- (point))
+ 'display))
+ (unless invis
+ (w3m-toggle-inline-image t)))))))))))))
+
+;; ======================================================================
+;;; Keymap stuff
+;; ======================================================================
+(defun newsticker-close-buffer ()
+ "Close the newsticker buffer."
+ (interactive)
+ (newsticker--cache-update t)
+ (bury-buffer))
+
+(defun newsticker-next-new-item (&optional do-not-wrap-at-eob)
+ "Go to next new news item.
+If no new item is found behind point, search is continued at
+beginning of buffer unless optional argument DO-NOT-WRAP-AT-EOB
+is non-nil."
+ (interactive)
+ (widen)
+ (let ((go-ahead t))
+ (while go-ahead
+ (unless (newsticker--buffer-goto '(item) 'new)
+ ;; found nothing -- wrap
+ (unless do-not-wrap-at-eob
+ (goto-char (point-min))
+ (newsticker-next-new-item t))
+ (setq go-ahead nil))
+ (unless (newsticker--lists-intersect-p
+ (get-text-property (point) 'invisible)
+ buffer-invisibility-spec)
+ ;; this item is invisible -- continue search
+ (setq go-ahead nil))))
+ (run-hooks 'newsticker-select-item-hook)
+ (point))
+
+(defun newsticker-previous-new-item (&optional do-not-wrap-at-bob)
+ "Go to previous new news item.
+If no new item is found before point, search is continued at
+beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
+is non-nil."
+ (interactive)
+ (widen)
+ (let ((go-ahead t))
+ (while go-ahead
+ (unless (newsticker--buffer-goto '(item) 'new t)
+ (unless do-not-wrap-at-bob
+ (goto-char (point-max))
+ (newsticker--buffer-goto '(item) 'new t)))
+ (unless (newsticker--lists-intersect-p
+ (get-text-property (point) 'invisible)
+ buffer-invisibility-spec)
+ (setq go-ahead nil))))
+ (run-hooks 'newsticker-select-item-hook)
+ (point))
+
+(defun newsticker-next-item (&optional do-not-wrap-at-eob)
+ "Go to next news item.
+Return new buffer position.
+If no item is found below point, search is continued at beginning
+of buffer unless optional argument DO-NOT-WRAP-AT-EOB is
+non-nil."
+ (interactive)
+ (widen)
+ (let ((go-ahead t)
+ (search-list '(item)))
+ (if newsticker--auto-narrow-to-item
+ (setq search-list '(item feed)))
+ (while go-ahead
+ (unless (newsticker--buffer-goto search-list)
+ ;; found nothing -- wrap
+ (unless do-not-wrap-at-eob
+ (goto-char (point-min)))
+ (setq go-ahead nil))
+ (unless (newsticker--lists-intersect-p
+ (get-text-property (point) 'invisible)
+ buffer-invisibility-spec)
+ (setq go-ahead nil))))
+ (run-hooks 'newsticker-select-item-hook)
+ (force-mode-line-update)
+ (point))
+
+(defun newsticker-next-item-same-feed ()
+ "Go to next news item in the same feed.
+Return new buffer position. If no item is found below point or if
+auto-narrow-to-item is enabled, nil is returned."
+ (interactive)
+ (if newsticker--auto-narrow-to-item
+ nil
+ (let ((go-ahead t)
+ (current-pos (point))
+ (end-of-feed (save-excursion (newsticker--buffer-end-of-feed))))
+ (while go-ahead
+ (unless (newsticker--buffer-goto '(item))
+ (setq go-ahead nil))
+ (unless (newsticker--lists-intersect-p
+ (get-text-property (point) 'invisible)
+ buffer-invisibility-spec)
+ (setq go-ahead nil)))
+ (if (and (> (point) current-pos)
+ (< (point) end-of-feed))
+ (point)
+ (goto-char current-pos)
+ nil))))
+
+(defun newsticker-previous-item (&optional do-not-wrap-at-bob)
+ "Go to previous news item.
+Return new buffer position.
+If no item is found before point, search is continued at
+beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
+is non-nil."
+ (interactive)
+ (widen)
+ (let ((go-ahead t)
+ (search-list '(item)))
+ (if newsticker--auto-narrow-to-item
+ (setq search-list '(item feed)))
+ (when (bobp)
+ (unless do-not-wrap-at-bob
+ (goto-char (point-max))))
+ (while go-ahead
+ (if (newsticker--buffer-goto search-list nil t)
+ (unless (newsticker--lists-intersect-p
+ (get-text-property (point) 'invisible)
+ buffer-invisibility-spec)
+ (setq go-ahead nil))
+ (goto-char (point-min))
+ (setq go-ahead nil))))
+ (run-hooks 'newsticker-select-item-hook)
+ (force-mode-line-update)
+ (point))
+
+(defun newsticker-next-feed ()
+ "Go to next news feed.
+Return new buffer position."
+ (interactive)
+ (widen)
+ (newsticker--buffer-goto '(feed))
+ (run-hooks 'newsticker-select-feed-hook)
+ (force-mode-line-update)
+ (point))
+
+(defun newsticker-previous-feed ()
+ "Go to previous news feed.
+Return new buffer position."
+ (interactive)
+ (widen)
+ (newsticker--buffer-goto '(feed) nil t)
+ (run-hooks 'newsticker-select-feed-hook)
+ (force-mode-line-update)
+ (point))
+
+(defun newsticker-mark-all-items-at-point-as-read-and-redraw ()
+ "Mark all items as read and clear ticker contents."
+ (interactive)
+ (when (or newsticker--buffer-uptodate-p
+ (y-or-n-p
+ "Buffer is not up to date -- really mark items as read? "))
+ (newsticker-mark-all-items-of-feed-as-read
+ (get-text-property (point) 'feed))))
+
+(defun newsticker-mark-all-items-of-feed-as-read (feed)
+ "Mark all items of FEED as read, clear ticker, and redraw buffer."
+ (when feed
+ (let ((pos (point)))
+ (message "Marking all items as read for %s" (symbol-name feed))
+ (newsticker--cache-replace-age newsticker--cache feed 'new 'old)
+ (newsticker--cache-replace-age newsticker--cache feed 'obsolete
+ 'old)
+ (newsticker--cache-update)
+ (newsticker--buffer-set-uptodate nil)
+ (newsticker--ticker-text-setup)
+ (newsticker-buffer-update)
+ ;; go back to where we came frome
+ (goto-char pos)
+ (end-of-line)
+ (newsticker--buffer-goto '(feed) nil t))))
+
+(defun newsticker-mark-all-items-at-point-as-read ()
+ "Mark all items as read and clear ticker contents."
+ (interactive)
+ (when (or newsticker--buffer-uptodate-p
+ (y-or-n-p
+ "Buffer is not up to date -- really mark items as read? "))
+ (newsticker--do-mark-item-at-point-as-read t)
+ (while (newsticker-next-item-same-feed)
+ (newsticker--do-mark-item-at-point-as-read t))
+ (newsticker-next-item t)))
+
+(defun newsticker-mark-item-at-point-as-read (&optional respect-immortality)
+ "Mark item at point as read and move to next item.
+If optional argument RESPECT-IMMORTALITY is not nil immortal items do
+not get changed."
+ (interactive)
+ (when (or newsticker--buffer-uptodate-p
+ (y-or-n-p
+ "Buffer is not up to date -- really mark this item as read? "))
+ (newsticker--do-mark-item-at-point-as-read respect-immortality)
+ ;; move forward
+ (newsticker-next-item t)))
+
+(defun newsticker--do-mark-item-at-point-as-read (&optional respect-immortality)
+ "Mark item at point as read.
+If optional argument RESPECT-IMMORTALITY is not nil immortal items do
+not get changed."
+ (let ((feed (get-text-property (point) 'feed)))
+ (when feed
+ (save-excursion
+ (newsticker--buffer-beginning-of-item)
+ (let ((inhibit-read-only t)
+ (age (get-text-property (point) 'nt-age))
+ (title (get-text-property (point) 'nt-title))
+ (guid (get-text-property (point) 'nt-guid))
+ (nt-desc (get-text-property (point) 'nt-desc))
+ (pos (save-excursion (newsticker--buffer-end-of-item)))
+ item)
+ (when (or (eq age 'new)
+ (eq age 'obsolete)
+ (and (eq age 'immortal)
+ (not respect-immortality)))
+ ;; find item
+ (setq item (newsticker--cache-contains newsticker--cache
+ feed title nt-desc
+ nil nil guid))
+ ;; mark as old
+ (when item
+ (setcar (nthcdr 4 item) 'old)
+ (newsticker--do-forget-preformatted item))
+ ;; clean up ticker
+ (if (or (and (eq age 'new)
+ newsticker-hide-immortal-items-in-echo-area)
+ (and (memq age '(old immortal))
+ (not
+ (eq newsticker-hide-old-items-in-newsticker-buffer
+ newsticker-hide-immortal-items-in-echo-area))))
+ (newsticker--ticker-text-remove feed title))
+ ;; set faces etc.
+ (save-excursion
+ (save-restriction
+ (widen)
+ (put-text-property (point) pos 'nt-age 'old)
+ (newsticker--buffer-set-faces (point) pos)))
+ (set-buffer-modified-p nil)))))))
+
+(defun newsticker-mark-item-at-point-as-immortal ()
+ "Mark item at point as read."
+ (interactive)
+ (when (or newsticker--buffer-uptodate-p
+ (y-or-n-p
+ "Buffer is not up to date -- really mark this item as read? "))
+ (let ((feed (get-text-property (point) 'feed))
+ (item nil))
+ (when feed
+ (save-excursion
+ (newsticker--buffer-beginning-of-item)
+ (let ((inhibit-read-only t)
+ (oldage (get-text-property (point) 'nt-age))
+ (title (get-text-property (point) 'nt-title))
+ (guid (get-text-property (point) 'nt-guid))
+ (pos (save-excursion (newsticker--buffer-end-of-item))))
+ (let ((newage 'immortal))
+ (if (eq oldage 'immortal)
+ (setq newage 'old))
+ (setq item (newsticker--cache-contains newsticker--cache
+ feed title nil nil nil
+ guid))
+ ;; change age
+ (when item
+ (setcar (nthcdr 4 item) newage)
+ (newsticker--do-forget-preformatted item))
+ (if (or (and (eq newage 'immortal)
+ newsticker-hide-immortal-items-in-echo-area)
+ (and (eq newage 'obsolete)
+ newsticker-hide-obsolete-items-in-echo-area)
+ (and (eq oldage 'immortal)
+ (not
+ (eq newsticker-hide-old-items-in-newsticker-buffer
+ newsticker-hide-immortal-items-in-echo-area))))
+ (newsticker--ticker-text-remove feed title)
+ (newsticker--ticker-text-setup))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (put-text-property (point) pos 'nt-age newage)
+ (if (eq newage 'immortal)
+ (put-text-property (point) pos 'nt-age 'immortal)
+ (put-text-property (point) pos 'nt-age 'old))
+ (newsticker--buffer-set-faces (point) pos))))))
+ (if item
+ (newsticker-next-item t))))))
+
+(defun newsticker-mark-all-items-as-read ()
+ "Mark all items as read and clear ticker contents."
+ (interactive)
+ (when (or newsticker--buffer-uptodate-p
+ (y-or-n-p
+ "Buffer is not up to date -- really mark items as read? "))
+ (newsticker--cache-replace-age newsticker--cache 'any 'new 'old)
+ (newsticker--buffer-set-uptodate nil)
+ (newsticker--ticker-text-setup)
+ (newsticker--cache-update)
+ (newsticker-buffer-update)))
+
+(defun newsticker-hide-extra ()
+ "Hide the extra elements of items."
+ (interactive)
+ (newsticker--buffer-hideshow 'extra nil)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-show-extra ()
+ "Show the extra elements of items."
+ (interactive)
+ (newsticker--buffer-hideshow 'extra t)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-hide-old-item-desc ()
+ "Hide the description of old items."
+ (interactive)
+ (newsticker--buffer-hideshow 'desc-old nil)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-show-old-item-desc ()
+ "Show the description of old items."
+ (interactive)
+ (newsticker--buffer-hideshow 'item-old t)
+ (newsticker--buffer-hideshow 'desc-old t)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-hide-new-item-desc ()
+ "Hide the description of new items."
+ (interactive)
+ (newsticker--buffer-hideshow 'desc-new nil)
+ (newsticker--buffer-hideshow 'desc-immortal nil)
+ (newsticker--buffer-hideshow 'desc-obsolete nil)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-show-new-item-desc ()
+ "Show the description of new items."
+ (interactive)
+ (newsticker--buffer-hideshow 'desc-new t)
+ (newsticker--buffer-hideshow 'desc-immortal t)
+ (newsticker--buffer-hideshow 'desc-obsolete t)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-hide-feed-desc ()
+ "Hide the description of feeds."
+ (interactive)
+ (newsticker--buffer-hideshow 'desc-feed nil)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-show-feed-desc ()
+ "Show the description of old items."
+ (interactive)
+ (newsticker--buffer-hideshow 'desc-feed t)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-hide-all-desc ()
+ "Hide the descriptions of feeds and all items."
+ (interactive)
+ (newsticker--buffer-hideshow 'desc-feed nil)
+ (newsticker--buffer-hideshow 'desc-immortal nil)
+ (newsticker--buffer-hideshow 'desc-obsolete nil)
+ (newsticker--buffer-hideshow 'desc-new nil)
+ (newsticker--buffer-hideshow 'desc-old nil)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-show-all-desc ()
+ "Show the descriptions of feeds and all items."
+ (interactive)
+ (newsticker--buffer-hideshow 'desc-feed t)
+ (newsticker--buffer-hideshow 'desc-immortal t)
+ (newsticker--buffer-hideshow 'desc-obsolete t)
+ (newsticker--buffer-hideshow 'desc-new t)
+ (newsticker--buffer-hideshow 'desc-old t)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-hide-old-items ()
+ "Hide old items."
+ (interactive)
+ (newsticker--buffer-hideshow 'desc-old nil)
+ (newsticker--buffer-hideshow 'item-old nil)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-show-old-items ()
+ "Show old items."
+ (interactive)
+ (newsticker--buffer-hideshow 'item-old t)
+ (newsticker--buffer-redraw))
+
+(defun newsticker-hide-entry ()
+ "Hide description of entry at point."
+ (interactive)
+ (save-excursion
+ (let* (pos1 pos2
+ (inhibit-read-only t)
+ inv-prop org-inv-prop
+ is-invisible)
+ (newsticker--buffer-beginning-of-item)
+ (newsticker--buffer-goto '(desc))
+ (setq pos1 (max (point-min) (1- (point))))
+ (newsticker--buffer-goto '(extra feed item nil))
+ (setq pos2 (max (point-min) (1- (point))))
+ (setq inv-prop (get-text-property pos1 'invisible))
+ (setq org-inv-prop (get-text-property pos1 'org-invisible))
+ (cond ((eq inv-prop t)
+ ;; do nothing
+ )
+ ((eq org-inv-prop nil)
+ (add-text-properties pos1 pos2
+ (list 'invisible (list t)
+ 'org-invisible inv-prop)))
+ (t
+ ;; toggle
+ (add-text-properties pos1 pos2
+ (list 'invisible org-inv-prop))
+ (remove-text-properties pos1 pos2 '(org-invisible))))))
+ (newsticker--buffer-redraw))
+
+(defun newsticker-show-entry ()
+ "Show description of entry at point."
+ (interactive)
+ (save-excursion
+ (let* (pos1 pos2
+ (inhibit-read-only t)
+ inv-prop org-inv-prop
+ is-invisible)
+ (newsticker--buffer-beginning-of-item)
+ (newsticker--buffer-goto '(desc))
+ (setq pos1 (max (point-min) (1- (point))))
+ (newsticker--buffer-goto '(extra feed item))
+ (setq pos2 (max (point-min) (1- (point))))
+ (setq inv-prop (get-text-property pos1 'invisible))
+ (setq org-inv-prop (get-text-property pos1 'org-invisible))
+ (cond ((eq org-inv-prop nil)
+ (add-text-properties pos1 pos2
+ (list 'invisible nil
+ 'org-invisible inv-prop)))
+ (t
+ ;; toggle
+ (add-text-properties pos1 pos2
+ (list 'invisible org-inv-prop))
+ (remove-text-properties pos1 pos2 '(org-invisible))))))
+ (newsticker--buffer-redraw))
+
+(defun newsticker-toggle-auto-narrow-to-feed ()
+ "Toggle narrowing to current news feed.
+If auto-narrowing is active, only news item of the current feed
+are visible."
+ (interactive)
+ (newsticker-set-auto-narrow-to-feed
+ (not newsticker--auto-narrow-to-feed)))
+
+(defun newsticker-set-auto-narrow-to-feed (value)
+ "Turn narrowing to current news feed on or off.
+If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
+ (interactive)
+ (setq newsticker--auto-narrow-to-item nil)
+ (setq newsticker--auto-narrow-to-feed value)
+ (widen)
+ (newsticker--buffer-make-item-completely-visible)
+ (run-hooks 'newsticker-narrow-hook))
+
+(defun newsticker-toggle-auto-narrow-to-item ()
+ "Toggle narrowing to current news item.
+If auto-narrowing is active, only one item of the current feed
+is visible."
+ (interactive)
+ (newsticker-set-auto-narrow-to-item
+ (not newsticker--auto-narrow-to-item)))
+
+(defun newsticker-set-auto-narrow-to-item (value)
+ "Turn narrowing to current news item on or off.
+If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
+ (interactive)
+ (setq newsticker--auto-narrow-to-feed nil)
+ (setq newsticker--auto-narrow-to-item value)
+ (widen)
+ (newsticker--buffer-make-item-completely-visible)
+ (run-hooks 'newsticker-narrow-hook))
+
+(defun newsticker-next-feed-available-p ()
+ "Return t if position is before last feed, nil otherwise."
+ (save-excursion
+ (let ((p (point)))
+ (newsticker--buffer-goto '(feed))
+ (not (= p (point))))))
+
+(defun newsticker-previous-feed-available-p ()
+ "Return t if position is behind first feed, nil otherwise."
+ (save-excursion
+ (let ((p (point)))
+ (newsticker--buffer-goto '(feed) nil t)
+ (not (= p (point))))))
+
+(defun newsticker-next-item-available-p ()
+ "Return t if position is before last feed, nil otherwise."
+ (save-excursion
+ (catch 'result
+ (while (< (point) (point-max))
+ (unless (newsticker--buffer-goto '(item))
+ (throw 'result nil))
+ (unless (newsticker--lists-intersect-p
+ (get-text-property (point) 'invisible)
+ buffer-invisibility-spec)
+ (throw 'result t))))))
+
+(defun newsticker-previous-item-available-p ()
+ "Return t if position is behind first item, nil otherwise."
+ (save-excursion
+ (catch 'result
+ (while (> (point) (point-min))
+ (unless (newsticker--buffer-goto '(item) nil t)
+ (throw 'result nil))
+ (unless (newsticker--lists-intersect-p
+ (get-text-property (point) 'invisible)
+ buffer-invisibility-spec)
+ (throw 'result t))))))
+
+(defun newsticker-item-not-old-p ()
+ "Return t if there is an item at point which is not old, nil otherwise."
+ (when (get-text-property (point) 'feed)
+ (save-excursion
+ (newsticker--buffer-beginning-of-item)
+ (let ((age (get-text-property (point) 'nt-age)))
+ (and (memq age '(new immortal obsolete)) t)))))
+
+(defun newsticker-item-not-immortal-p ()
+ "Return t if there is an item at point which is not immortal, nil otherwise."
+ (when (get-text-property (point) 'feed)
+ (save-excursion
+ (newsticker--buffer-beginning-of-item)
+ (let ((age (get-text-property (point) 'nt-age)))
+ (and (memq age '(new old obsolete)) t)))))
+
+;; ======================================================================
+;;; Imenu stuff
+;; ======================================================================
+(defun newsticker--imenu-create-index ()
+ "Scan newsticker buffer and return an index for imenu."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((index-alist nil)
+ (feed-list nil)
+ (go-ahead t))
+ (while go-ahead
+ (let ((type (get-text-property (point) 'nt-type))
+ (title (get-text-property (point) 'nt-title)))
+ (cond ((eq type 'feed)
+ ;; we're on a feed heading
+ (when feed-list
+ (if index-alist
+ (nconc index-alist (list feed-list))
+ (setq index-alist (list feed-list))))
+ (setq feed-list (list title)))
+ (t
+ (nconc feed-list
+ (list (cons title (point)))))))
+ (setq go-ahead (newsticker--buffer-goto '(item feed))))
+ (if index-alist
+ (nconc index-alist (list feed-list))
+ (setq index-alist (list feed-list)))
+ index-alist)))
+
+(defun newsticker--imenu-goto (name pos &rest args)
+ "Go to item NAME at position POS and show item.
+ARGS are ignored."
+ (goto-char pos)
+ ;; show headline
+ (newsticker--buffer-goto '(desc extra feed item))
+ (let* ((inhibit-read-only t)
+ (pos1 (max (point-min) (1- pos)))
+ (pos2 (max pos1 (1- (point))))
+ (inv-prop (get-text-property pos 'invisible))
+ (org-inv-prop (get-text-property pos 'org-invisible)))
+ (when (eq org-inv-prop nil)
+ (add-text-properties pos1 pos2 (list 'invisible nil
+ 'org-invisible inv-prop))))
+ ;; show desc
+ (newsticker-show-entry))
+
+;; ======================================================================
+;;; Buffer stuff
+;; ======================================================================
+(defun newsticker--buffer-set-uptodate (value)
+ "Set the uptodate-status of the newsticker buffer to VALUE.
+The mode-line is changed accordingly."
+ (setq newsticker--buffer-uptodate-p value)
+ (let ((b (get-buffer "*newsticker*")))
+ (when b
+ (save-excursion
+ (set-buffer b)
+ (if value
+ (setq mode-name "Newsticker -- up to date -- ")
+ (setq mode-name "Newsticker -- NEED UPDATE -- ")))
+ (force-mode-line-update 0))))
+
+(defun newsticker--buffer-redraw ()
+ "Redraw the newsticker window."
+ (if (fboundp 'force-window-update)
+ (force-window-update (current-buffer))
+ (redraw-frame (selected-frame)))
+ (run-hooks 'newsticker-buffer-change-hook)
+ (sit-for 0))
+
+(defun newsticker--buffer-insert-all-items ()
+ "Insert all cached newsticker items into the current buffer.
+Keeps order of feeds as given in `newsticker-url-list' and
+`newsticker-url-list-defaults'."
+ (goto-char (point-min))
+ (mapc (lambda (url-item)
+ (let* ((feed-name (car url-item))
+ (feed-name-symbol (intern feed-name))
+ (feed (assoc feed-name-symbol newsticker--cache))
+ (items (cdr feed))
+ (pos (point)))
+ (when feed
+ ;; insert the feed description
+ (mapc (lambda (item)
+ (when (eq (newsticker--age item) 'feed)
+ (newsticker--buffer-insert-item item
+ feed-name-symbol)))
+ items)
+ ;;insert the items
+ (mapc (lambda (item)
+ (if (memq (newsticker--age item) '(new immortal old
+ obsolete))
+ (newsticker--buffer-insert-item item
+ feed-name-symbol)))
+ items)
+ (put-text-property pos (point) 'feed (car feed))
+
+ ;; insert empty line between feeds
+ (let ((p (point)))
+ (insert "\n")
+ (put-text-property p (point) 'hard t)))))
+ (append newsticker-url-list newsticker-url-list-defaults))
+
+ (newsticker--buffer-set-faces (point-min) (point-max))
+ (newsticker--buffer-set-invisibility (point-min) (point-max))
+ (goto-char (point-min)))
+
+(defun newsticker--buffer-insert-item (item &optional feed-name-symbol)
+ "Insert a news item in the current buffer.
+Insert a formatted representation of the ITEM. The optional parameter
+FEED-NAME-SYMBOL determines how the item is formatted and whether the
+item-retrieval time is added as well."
+ ;; insert headline
+ (if (eq (newsticker--age item) 'feed)
+ (newsticker--buffer-do-insert-text item 'feed feed-name-symbol)
+ (newsticker--buffer-do-insert-text item 'item feed-name-symbol))
+ ;; insert the description
+ (newsticker--buffer-do-insert-text item 'desc feed-name-symbol))
+
+(defun newsticker--buffer-do-insert-text (item type feed-name-symbol)
+ "Actually insert contents of news item, format it, render it and all that.
+ITEM is a news item, TYPE tells which part of the item shall be inserted,
+FEED-NAME-SYMBOL tells to which feed this item belongs."
+ (let* ((pos (point))
+ (format newsticker-desc-format)
+ (pos-date-start nil)
+ (pos-date-end nil)
+ (pos-stat-start nil)
+ (pos-stat-end nil)
+ (pos-text-start nil)
+ (pos-text-end nil)
+ (pos-extra-start nil)
+ (pos-extra-end nil)
+ (pos-enclosure-start nil)
+ (pos-enclosure-end nil)
+ (age (newsticker--age item))
+ (preformatted-contents (newsticker--preformatted-contents item))
+ (preformatted-title (newsticker--preformatted-title item)))
+ (cond ((and preformatted-contents
+ (not (eq (aref preformatted-contents 0) ?\n));; we must
+ ;; NOT have a line
+ ;; break!
+ (eq type 'desc))
+ (insert preformatted-contents))
+ ((and preformatted-title
+ (not (eq (aref preformatted-title 0) ?\n));; we must NOT have a
+ ;; line break!
+ (eq type 'item))
+ (insert preformatted-title))
+ (t
+ ;; item was not formatted before.
+ ;; Let's go.
+ (if (eq type 'item)
+ (setq format newsticker-item-format)
+ (if (eq type 'feed)
+ (setq format newsticker-heading-format)))
+
+ (while (> (length format) 0)
+ (let ((prefix (if (> (length format) 1)
+ (substring format 0 2)
+ "")))
+ (cond ((string= "%c" prefix)
+ ;; contents
+ (when (newsticker--desc item)
+ (setq pos-text-start (point-marker))
+ (insert (newsticker--desc item))
+ (setq pos-text-end (point-marker)))
+ (setq format (substring format 2)))
+ ((string= "%d" prefix)
+ ;; date
+ (setq pos-date-start (point-marker))
+ (if (newsticker--time item)
+ (insert (format-time-string newsticker-date-format
+ (newsticker--time item))))
+ (setq pos-date-end (point-marker))
+ (setq format (substring format 2)))
+ ((string= "%l" prefix)
+ ;; logo
+ (let ((disabled (cond ((eq (newsticker--age item) 'feed)
+ (= (newsticker--stat-num-items
+ feed-name-symbol 'new) 0))
+ (t
+ (not (eq (newsticker--age item)
+ 'new))))))
+ (let ((img (newsticker--image-read feed-name-symbol
+ disabled)))
+ (when img
+ (newsticker--insert-image img (car item)))))
+ (setq format (substring format 2)))
+ ((string= "%L" prefix)
+ ;; logo or title
+ (let ((disabled (cond ((eq (newsticker--age item) 'feed)
+ (= (newsticker--stat-num-items
+ feed-name-symbol 'new) 0))
+ (t
+ (not (eq (newsticker--age item)
+ 'new))))))
+ (let ((img (newsticker--image-read feed-name-symbol
+ disabled)))
+ (if img
+ (newsticker--insert-image img (car item))
+ (when (car item)
+ (setq pos-text-start (point-marker))
+ (if (eq (newsticker--age item) 'feed)
+ (insert (newsticker--title item))
+ ;; FIXME: This is not the "real" title!
+ (insert (format "%s"
+ (car (newsticker--cache-get-feed
+ feed-name-symbol)))))
+ (setq pos-text-end (point-marker))))))
+ (setq format (substring format 2)))
+ ((string= "%s" prefix)
+ ;; statistics
+ (setq pos-stat-start (point-marker))
+ (if (eq (newsticker--age item) 'feed)
+ (insert (newsticker--buffer-statistics
+ feed-name-symbol)))
+ (setq pos-stat-end (point-marker))
+ (setq format (substring format 2)))
+ ((string= "%t" prefix)
+ ;; title
+ (when (car item)
+ (setq pos-text-start (point-marker))
+ (insert (car item))
+ (setq pos-text-end (point-marker)))
+ (setq format (substring format 2)))
+ ((string-match "%." prefix)
+ ;; unknown specifier!
+ (insert prefix)
+ (setq format (substring format 2)))
+ ((string-match "^\\([^%]*\\)\\(.*\\)" format) ;; FIXME!
+ ;; everything else
+ (let ((p (point)))
+ (insert (substring format
+ (match-beginning 1) (match-end 1)))
+ ;; in case that the format string contained newlines
+ (put-text-property p (point) 'hard t))
+ (setq format (substring format (match-beginning 2)))))))
+
+ ;; decode HTML if possible...
+ (let ((is-rendered-HTML nil))
+ (when (and newsticker-html-renderer pos-text-start pos-text-end)
+ (condition-case error-data
+ (save-excursion
+ ;; check whether it is necessary to call html renderer
+ ;; (regexp inspired by htmlr.el)
+ (goto-char pos-text-start)
+ (when (re-search-forward
+ "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" pos-text-end t)
+ ;; (message "%s" (newsticker--title item))
+ (let ((w3m-fill-column (if newsticker-use-full-width
+ -1 fill-column))
+ (w3-maximum-line-length
+ (if newsticker-use-full-width nil fill-column)))
+ (save-excursion
+ (funcall newsticker-html-renderer pos-text-start
+ pos-text-end)))
+ (cond ((eq newsticker-html-renderer 'w3m-region)
+ (add-text-properties pos (point-max)
+ (list 'keymap
+ w3m-minor-mode-map)))
+ ((eq newsticker-html-renderer 'w3-region)
+ (add-text-properties pos (point-max)
+ (list 'keymap w3-mode-map))))
+ (setq is-rendered-HTML t)))
+ (error
+ (message "Error: HTML rendering failed: %s, %s"
+ (car error-data) (cdr error-data)))))
+ ;; After html rendering there might be chunks of blank
+ ;; characters between rendered text and date, statistics or
+ ;; whatever. Remove it
+ (when (and (eq type 'item) is-rendered-HTML)
+ (goto-char pos)
+ (while (re-search-forward "[ \t]*\n[ \t]*" nil t)
+ (replace-match " " nil nil))
+ (goto-char (point-max)))
+ (when (and newsticker-justification
+ (memq type '(item desc))
+ (not is-rendered-HTML))
+ (condition-case nil
+ (let ((use-hard-newlines t))
+ (fill-region pos (point-max) newsticker-justification))
+ (error nil))))
+
+ ;; remove leading and trailing newlines
+ (goto-char pos)
+ (unless (= 0 (skip-chars-forward " \t\r\n"))
+ (delete-region pos (point)))
+ (goto-char (point-max))
+ (let ((end (point)))
+ (unless (= 0 (skip-chars-backward " \t\r\n" (1+ pos)))
+ (delete-region (point) end)))
+ (goto-char (point-max))
+ ;; closing newline
+ (unless nil ;;(eq pos (point))
+ (insert "\n")
+ (put-text-property (1- (point)) (point) 'hard t))
+
+ ;; insert enclosure element
+ (when (eq type 'desc)
+ (setq pos-enclosure-start (point))
+ (newsticker--insert-enclosure item newsticker--url-keymap)
+ (setq pos-enclosure-end (point)))
+
+ ;; show extra elements
+ (when (eq type 'desc)
+ (goto-char (point-max))
+ (setq pos-extra-start (point))
+ (newsticker--print-extra-elements item newsticker--url-keymap)
+ (setq pos-extra-end (point)))
+
+ ;; text properties
+ (when (memq type '(feed item))
+ (add-text-properties pos (1- (point))
+ (list 'mouse-face 'highlight
+ 'nt-link (newsticker--link item)
+ 'help-echo
+ (format "mouse-2: visit item (%s)"
+ (newsticker--link item))
+ 'keymap newsticker--url-keymap))
+ (add-text-properties pos (point)
+ (list 'nt-title (newsticker--title item)
+ 'nt-desc (newsticker--desc item))))
+
+ (add-text-properties pos (point)
+ (list 'nt-type type
+ 'nt-face type
+ 'nt-age age
+ 'nt-guid (newsticker--guid item)))
+ (when (and pos-date-start pos-date-end)
+ (put-text-property pos-date-start pos-date-end 'nt-face 'date))
+ (when (and pos-stat-start pos-stat-end)
+ (put-text-property pos-stat-start pos-stat-end 'nt-face 'stat))
+ (when (and pos-extra-start pos-extra-end)
+ (put-text-property pos-extra-start pos-extra-end
+ 'nt-face 'extra)
+ (put-text-property pos-extra-start pos-extra-end
+ 'nt-type 'extra))
+ (when (and pos-enclosure-start pos-enclosure-end
+ (> pos-enclosure-end pos-enclosure-start))
+ (put-text-property pos-enclosure-start (1- pos-enclosure-end)
+ 'nt-face 'enclosure))
+
+ ;; left margin
+ ;;(unless (memq type '(feed item))
+ ;;(set-left-margin pos (1- (point)) 1))
+
+ ;; save rendered stuff
+ (cond ((eq type 'desc)
+ ;; preformatted contents
+ (newsticker--cache-set-preformatted-contents
+ item (buffer-substring pos (point))))
+ ((eq type 'item)
+ ;; preformatted title
+ (newsticker--cache-set-preformatted-title
+ item (buffer-substring pos (point)))))))))
+
+(defun newsticker--buffer-statistics (feed-name-symbol)
+ "Return a statistic string for the feed given by FEED-NAME-SYMBOL.
+See `newsticker-statistics-format'."
+ (let ((case-fold-search nil))
+ (replace-regexp-in-string
+ "%a"
+ (format "%d" (newsticker--stat-num-items feed-name-symbol))
+ (replace-regexp-in-string
+ "%i"
+ (format "%d" (newsticker--stat-num-items feed-name-symbol 'immortal))
+ (replace-regexp-in-string
+ "%n"
+ (format "%d" (newsticker--stat-num-items feed-name-symbol 'new))
+ (replace-regexp-in-string
+ "%o"
+ (format "%d" (newsticker--stat-num-items feed-name-symbol 'old))
+ (replace-regexp-in-string
+ "%O"
+ (format "%d" (newsticker--stat-num-items feed-name-symbol 'obsolete))
+ newsticker-statistics-format)))))))
+
+(defun newsticker--buffer-set-faces (start end)
+ "Add face properties according to mark property.
+Scans the buffer between START and END."
+ (save-excursion
+ (put-text-property start end 'face 'newsticker-default-face)
+ (goto-char start)
+ (let ((pos1 start)
+ (pos2 1)
+ (nt-face (get-text-property start 'nt-face))
+ (nt-age (get-text-property start 'nt-age)))
+ (when nt-face
+ (setq pos2 (next-single-property-change (point) 'nt-face))
+ (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
+ (setq nt-face (get-text-property pos2 'nt-face))
+ (setq pos1 pos2))
+ (while (and (setq pos2 (next-single-property-change pos1 'nt-face))
+ (<= pos2 end)
+ (> pos2 pos1))
+ (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
+ (setq nt-face (get-text-property pos2 'nt-face))
+ (setq nt-age (get-text-property pos2 'nt-age))
+ (setq pos1 pos2)))))
+
+(defun newsticker--buffer-set-invisibility (start end)
+ "Add invisibility properties according to nt-type property.
+Scans the buffer between START and END. Sets the 'invisible
+property to '(<nt-type>-<nt-age> <nt-type> <nt-age>)."
+ (save-excursion
+ ;; reset invisibility settings
+ (put-text-property start end 'invisible nil)
+ ;; let's go
+ (goto-char start)
+ (let ((pos1 start)
+ (pos2 1)
+ (nt-type (get-text-property start 'nt-type))
+ (nt-age (get-text-property start 'nt-age)))
+ (when nt-type
+ (setq pos2 (next-single-property-change (point) 'nt-type))
+ (put-text-property (max (point-min) pos1) (1- pos2)
+ 'invisible
+ (list (intern
+ (concat
+ (symbol-name
+ (if (eq nt-type 'extra) 'desc nt-type))
+ "-"
+ (symbol-name nt-age)))
+ nt-type
+ nt-age))
+ (setq nt-type (get-text-property pos2 'nt-type))
+ (setq pos1 pos2))
+ (while (and (setq pos2 (next-single-property-change pos1 'nt-type))
+ (<= pos2 end)
+ (> pos2 pos1))
+ ;; must shift one char to the left in order to handle inivisible
+ ;; newlines, motion in invisible text areas and all that correctly
+ (put-text-property (1- pos1) (1- pos2)
+ 'invisible
+ (list (intern
+ (concat
+ (symbol-name
+ (if (eq nt-type 'extra) 'desc nt-type))
+ "-"
+ (symbol-name nt-age)))
+ nt-type
+ nt-age))
+ (setq nt-type (get-text-property pos2 'nt-type))
+ (setq nt-age (get-text-property pos2 'nt-age))
+ (setq pos1 pos2)))))
+
+(defun newsticker--set-face-properties (pos1 pos2 nt-face age)
+ "Set the face for the text between the positions POS1 and POS2.
+The face is chosen according the values of NT-FACE and AGE."
+ (let ((face (cond ((eq nt-face 'feed)
+ 'newsticker-feed-face)
+ ((eq nt-face 'item)
+ (cond ((eq age 'new)
+ 'newsticker-new-item-face)
+ ((eq age 'old)
+ 'newsticker-old-item-face)
+ ((eq age 'immortal)
+ 'newsticker-immortal-item-face)
+ ((eq age 'obsolete)
+ 'newsticker-obsolete-item-face)))
+ ((eq nt-face 'date)
+ 'newsticker-date-face)
+ ((eq nt-face 'stat)
+ 'newsticker-statistics-face)
+ ((eq nt-face 'extra)
+ 'newsticker-extra-face)
+ ((eq nt-face 'enclosure)
+ 'newsticker-enclosure-face))))
+ (when face
+ (put-text-property pos1 (max pos1 pos2) 'face face))))
+
+;; ======================================================================
+;;; Functions working on the *newsticker* buffer
+;; ======================================================================
+(defun newsticker--buffer-make-item-completely-visible ()
+ "Scroll buffer until current item is completely visible."
+ (when newsticker--auto-narrow-to-feed
+ (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-feed))
+ (point-min)))
+ (max (or (save-excursion (newsticker--buffer-end-of-feed))
+ (point-max))))
+ (narrow-to-region min max)))
+ (when newsticker--auto-narrow-to-item
+ (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-item))
+ (point-min)))
+ (max (or (save-excursion (newsticker--buffer-end-of-item))
+ (point-max))))
+ (narrow-to-region min max)))
+ (sit-for 0)
+ ;; do not count lines and stuff because that does not work when images
+ ;; are displayed. Do it the simple way:
+ (save-excursion
+ (newsticker--buffer-end-of-item)
+ (unless (pos-visible-in-window-p)
+ (recenter -1)))
+ (unless (pos-visible-in-window-p)
+ (recenter 0)))
+
+(defun newsticker--buffer-get-feed-title-at-point ()
+ "Return feed symbol of headline at point."
+ (format "%s" (or (get-text-property (point) 'feed) " ")))
+
+(defun newsticker--buffer-get-item-title-at-point ()
+ "Return feed symbol of headline at point."
+ (format "%s" (or (get-text-property (point) 'nt-title) " ")))
+
+(defun newsticker--buffer-goto (types &optional age backwards)
+ "Search next occurrence of TYPES in current buffer.
+TYPES is a list of symbols. If TYPES is found point is moved, if
+not point is left unchanged. If optional parameter AGE is not
+nil, the type AND the age must match. If BACKWARDS is t, search
+backwards."
+ (let ((pos (save-excursion
+ (save-restriction
+ (widen)
+ (catch 'found
+ (let ((tpos (point)))
+ (while (setq tpos
+ (if backwards
+ (if (eq tpos (point-min))
+ nil
+ (or (previous-single-property-change
+ tpos 'nt-type)
+ (point-min)))
+ (next-single-property-change
+ tpos 'nt-type)))
+ (and (memq (get-text-property tpos 'nt-type) types)
+ (or (not age)
+ (eq (get-text-property tpos 'nt-age) age))
+ (throw 'found tpos)))))))))
+ (when pos
+ (goto-char pos))
+ pos))
+
+(defun newsticker--buffer-hideshow (mark-age onoff)
+ "Hide or show items of type MARK-AGE.
+If ONOFF is nil the item is hidden, otherwise it is shown."
+ (if onoff
+ (remove-from-invisibility-spec mark-age)
+ (add-to-invisibility-spec mark-age)))
+
+(defun newsticker--buffer-beginning-of-item ()
+ "Move point to the beginning of the item at point.
+Return new position."
+ (if (bobp)
+ (point)
+ (let ((type (get-text-property (point) 'nt-type))
+ (typebefore (get-text-property (1- (point)) 'nt-type)))
+ (if (and (memq type '(item feed))
+ (not (eq type typebefore)))
+ (point)
+ (newsticker--buffer-goto '(item feed) nil t)
+ (point)))))
+
+(defun newsticker--buffer-beginning-of-feed ()
+ "Move point to the beginning of the feed at point.
+Return new position."
+ (if (bobp)
+ (point)
+ (let ((type (get-text-property (point) 'nt-type))
+ (typebefore (get-text-property (1- (point)) 'nt-type)))
+ (if (and (memq type '(feed))
+ (not (eq type typebefore)))
+ (point)
+ (newsticker--buffer-goto '(feed) nil t)
+ (point)))))
+
+(defun newsticker--buffer-end-of-item ()
+ "Move point to the end of the item at point.
+Take care: end of item is at the end of its last line!"
+ (when (newsticker--buffer-goto '(item feed nil))
+ (point)))
+
+(defun newsticker--buffer-end-of-feed ()
+ "Move point to the end of the last item of the feed at point.
+Take care: end of item is at the end of its last line!"
+ (when (newsticker--buffer-goto '(feed nil))
+ (backward-char 1)
+ (point)))
+
+;; ======================================================================
+;;; misc
+;; ======================================================================
+
+(defun newsticker-mouse-browse-url (event)
+ "Call `browse-url' for the link of the item at which the EVENT occurred."
+ (interactive "e")
+ (save-excursion
+ (switch-to-buffer (window-buffer (posn-window (event-end event))))
+ (let ((url (get-text-property (posn-point (event-end event))
+ 'nt-link)))
+ (when url
+ (browse-url url)
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
+ (if newsticker-automatically-mark-visited-items-as-old
+ (newsticker-mark-item-at-point-as-read t)))))))
+
+(defun newsticker-browse-url ()
+ "Call `browse-url' for the link of the item at point."
+ (interactive)
+ (let ((url (get-text-property (point) 'nt-link)))
+ (when url
+ (browse-url url)
+ (if newsticker-automatically-mark-visited-items-as-old
+ (newsticker-mark-item-at-point-as-read t)))))
+
+(defvar newsticker-open-url-history
+ '("wget" "xmms" "realplay")
+ "...")
+
+(defun newsticker-handle-url ()
+ "Ask for a program to open the link of the item at point."
+ (interactive)
+ (let ((url (get-text-property (point) 'nt-link)))
+ (when url
+ (let ((prog (read-string "Open url with: " nil
+ 'newsticker-open-url-history)))
+ (when prog
+ (message "%s %s" prog url)
+ (start-process prog prog prog url)
+ (if newsticker-automatically-mark-visited-items-as-old
+ (newsticker-mark-item-at-point-as-read t)))))))
+
+
+;; ======================================================================
+;;; Misc
+;; ======================================================================
+
+(defun newsticker--cache-sort ()
+ "Sort the newsticker cache data."
+ (let ((sort-fun (cond ((eq newsticker-sort-method 'sort-by-time)
+ 'newsticker--cache-item-compare-by-time)
+ ((eq newsticker-sort-method 'sort-by-title)
+ 'newsticker--cache-item-compare-by-title)
+ ((eq newsticker-sort-method 'sort-by-original-order)
+ 'newsticker--cache-item-compare-by-position))))
+ (mapc (lambda (feed-list)
+ (setcdr feed-list (sort (cdr feed-list)
+ sort-fun)))
+ newsticker--cache)))
+
+(provide 'newsticker-plainview)
+
+;; arch-tag: 4e48b683-d48b-48dd-a13e-fe45baf41184
+;;; newst-plainview.el ends here
--- /dev/null
+;;; newst-reader.el --- Generic RSS reader functions.
+
+;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+;; Free Software Foundation, Inc.
+
+;; Author: Ulf Jasper <ulf.jasper@web.de>
+;; Filename: newst-reader.el
+;; URL: http://www.nongnu.org/newsticker
+;; Time-stamp: "13. Juni 2008, 17:45:36 (ulf)"
+
+;; ======================================================================
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;; ======================================================================
+;;; Commentary:
+
+;; See newsticker.el
+
+;; ======================================================================
+;;; Code:
+
+(require 'newsticker-backend)
+
+;; ======================================================================
+;;; Customization
+;; ======================================================================
+(defun newsticker--set-customvar-formatting (symbol value)
+ "Set newsticker-variable SYMBOL value to VALUE.
+Calls all actions which are necessary in order to make the new
+value effective."
+ (if (or (not (boundp symbol))
+ (equal (symbol-value symbol) value))
+ (set symbol value)
+ ;; something must have changed
+ (set symbol value)
+ (when (fboundp 'newsticker--forget-preformatted)
+ (newsticker--forget-preformatted))))
+
+;; ======================================================================
+;; reader
+(defgroup newsticker-reader nil
+ "Settings for the feed reader."
+ :group 'newsticker)
+
+(defcustom newsticker-frontend
+ 'newsticker-treeview
+ "Newsticker frontend for reading news.
+This must be one of the functions `newsticker-plainview' or
+`newsticker-treeview'."
+ :type '(choice :tag "Frontend"
+ (const :tag "Single buffer (plainview)" newsticker-plainview)
+ (const :tag "Tree view (treeview)" newsticker-treeview))
+ :group 'newsticker-reader)
+
+;; image related things
+(defcustom newsticker-enable-logo-manipulations
+ t
+ "If non-nil newsticker manipulates logo images.
+This enables the following image properties: heuristic mask for all
+logos, and laplace-conversion for images without new items."
+ :type 'boolean
+ :group 'newsticker-reader)
+
+(defcustom newsticker-justification
+ 'left
+ "How to fill item descriptions.
+If non-nil newsticker calls `fill-region' to wrap long lines in
+item descriptions. However, if an item description contains HTML
+text and `newsticker-html-renderer' is non-nil, filling is not
+done."
+ :type '(choice :tag "Justification"
+ (const :tag "No filling" nil)
+ (const :tag "Left" left)
+ (const :tag "Right" right)
+ (const :tag "Center" center)
+ (const :tag "Full" full))
+ :set 'newsticker--set-customvar-formatting
+ :group 'newsticker-reader)
+
+(defcustom newsticker-use-full-width
+ t
+ "Decides whether to use the full window width when filling.
+If non-nil newsticker sets `fill-column' so that the whole
+window is used when filling. See also `newsticker-justification'."
+ :type 'boolean
+ :set 'newsticker--set-customvar-formatting
+ :group 'newsticker-reader)
+
+(defcustom newsticker-html-renderer
+ nil
+ "Function for rendering HTML contents.
+If non-nil, newsticker.el will call this function whenever it finds
+HTML-like tags in item descriptions. Possible functions are, for
+example, `w3m-region', `w3-region', and (if you have htmlr.el installed)
+`newsticker-htmlr-render'.
+
+In order to make sure that the HTML renderer is loaded when you
+run newsticker, you should add one of the following statements to
+your .emacs. If you use w3m,
+
+ (autoload 'w3m-region \"w3m\"
+ \"Render region in current buffer and replace with result.\" t)
+
+ (autoload 'w3m-toggle-inline-image \"w3m\"
+ \"Toggle the visibility of an image under point.\" t)
+
+or, if you use w3,
+
+ (require 'w3-auto)
+
+or, if you use htmlr
+
+ (require 'htmlr)"
+ :type '(choice :tag "Function"
+ (const :tag "None" nil)
+ (const :tag "w3" w3-region)
+ (const :tag "w3m" w3m-region)
+ (const :tag "htmlr" newsticker-htmlr-render))
+ :set 'newsticker--set-customvar-formatting
+ :group 'newsticker-reader)
+
+(defcustom newsticker-date-format
+ "(%A, %H:%M)"
+ "Format for the date part in item and feed lines.
+See `format-time-string' for a list of valid specifiers."
+ :type 'string
+ :set 'newsticker--set-customvar-formatting
+ :group 'newsticker-reader)
+
+;; ======================================================================
+;;; Utility functions
+;; ======================================================================
+(defun newsticker--insert-enclosure (item keymap)
+ "Insert enclosure element of a news ITEM into the current buffer.
+KEYMAP will be applied."
+ (let ((enclosure (newsticker--enclosure item))
+ (beg (point)))
+ (when enclosure
+ (let ((url (cdr (assoc 'url enclosure)))
+ (length (string-to-number (or (cdr (assoc 'length enclosure))
+ "-1")))
+ (type (cdr (assoc 'type enclosure))))
+ (cond ((> length 1048576)
+ (insert (format "Enclosed file (%s, %1.2f MBytes)" type
+ (/ length 1048576))))
+ ((> length 1024)
+ (insert (format "Enclosed file (%s, %1.2f KBytes)" type
+ (/ length 1024))))
+ ((> length 0)
+ (insert (format "Enclosed file (%s, %1.2f Bytes)" type
+ length)))
+ (t
+ (insert (format "Enclosed file (%s, unknown size)" type))))
+ (add-text-properties beg (point)
+ (list 'mouse-face 'highlight
+ 'nt-link url
+ 'help-echo (format
+ "mouse-2: visit (%s)" url)
+ 'keymap keymap
+ 'nt-face 'enclosure
+ 'nt-type 'desc))
+ (insert "\n")))))
+
+(defun newsticker--print-extra-elements (item keymap)
+ "Insert extra-elements of ITEM in a pretty form into the current buffer.
+KEYMAP is applied."
+ (let ((ignored-elements '(items link title description content
+ content:encoded dc:subject
+ dc:date entry item guid pubDate
+ published updated
+ enclosure))
+ (left-column-width 1))
+ (mapc (lambda (extra-element)
+ (when (listp extra-element) ;; take care of broken xml
+ ;; data, 2007-05-25
+ (unless (memq (car extra-element) ignored-elements)
+ (setq left-column-width (max left-column-width
+ (length (symbol-name
+ (car extra-element))))))))
+ (newsticker--extra item))
+ (mapc (lambda (extra-element)
+ (when (listp extra-element) ;; take care of broken xml
+ ;; data, 2007-05-25
+ (unless (memq (car extra-element) ignored-elements)
+ (newsticker--do-print-extra-element extra-element
+ left-column-width
+ keymap))))
+ (newsticker--extra item))))
+
+(defun newsticker--do-print-extra-element (extra-element width keymap)
+ "Actually print an EXTRA-ELEMENT using the given WIDTH.
+KEYMAP is applied."
+ (let ((name (symbol-name (car extra-element))))
+ (insert (format "%s: " name))
+ (insert (make-string (- width (length name)) ? )))
+ (let (;;(attributes (cadr extra-element)) ;FIXME!!!!
+ (contents (cddr extra-element)))
+ (cond ((listp contents)
+ (mapc (lambda (i)
+ (if (and (stringp i)
+ (string-match "^http://.*" i))
+ (let ((pos (point)))
+ (insert i " ") ; avoid self-reference from the
+ ; nt-link thing
+ (add-text-properties
+ pos (point)
+ (list 'mouse-face 'highlight
+ 'nt-link i
+ 'help-echo
+ (format "mouse-2: visit (%s)" i)
+ 'keymap keymap)))
+ (insert (format "%s" i))))
+ contents))
+ (t
+ (insert (format "%s" contents))))
+ (insert "\n")))
+
+(defun newsticker--image-read (feed-name-symbol disabled)
+ "Read the cached image for FEED-NAME-SYMBOL from disk.
+If DISABLED is non-nil the image will be converted to a disabled look
+\(unless `newsticker-enable-logo-manipulations' is not t\).
+Return the image."
+ (let ((image-name (concat newsticker-imagecache-dirname "/"
+ (symbol-name feed-name-symbol)))
+ (img nil))
+ (when (file-exists-p image-name)
+ (condition-case error-data
+ (setq img (create-image
+ image-name nil nil
+ :conversion (and newsticker-enable-logo-manipulations
+ disabled
+ 'disabled)
+ :mask (and newsticker-enable-logo-manipulations
+ 'heuristic)
+ :ascent 70))
+ (error
+ (message "Error: cannot create image for %s: %s"
+ feed-name-symbol error-data))))
+ img))
+
+;; the functions we need for retrieval and display
+;;;###autoload
+(defun newsticker-show-news ()
+ "Start reading news. You may want to bind this to a key."
+ (interactive)
+ (newsticker-start t) ;; will start only if not running
+ (funcall newsticker-frontend))
+
+;; ======================================================================
+;;; Toolbar
+;; ======================================================================
+(defconst newsticker--next-item-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * next_xpm[] = {
+\"24 24 42 1\",
+\" c None\",
+\". c #000000\",
+\"+ c #7EB6DE\",
+\"@ c #82BBE2\",
+\"# c #85BEE4\",
+\"$ c #88C1E7\",
+\"% c #8AC3E8\",
+\"& c #87C1E6\",
+\"* c #8AC4E9\",
+\"= c #8CC6EA\",
+\"- c #8CC6EB\",
+\"; c #88C2E7\",
+\"> c #8BC5E9\",
+\", c #8DC7EB\",
+\"' c #87C0E6\",
+\") c #8AC4E8\",
+\"! c #8BC5EA\",
+\"~ c #8BC4E9\",
+\"{ c #88C1E6\",
+\"] c #89C3E8\",
+\"^ c #86BFE5\",
+\"/ c #83BBE2\",
+\"( c #82BBE1\",
+\"_ c #86C0E5\",
+\": c #87C0E5\",
+\"< c #83BCE2\",
+\"[ c #81B9E0\",
+\"} c #81BAE1\",
+\"| c #78B0D9\",
+\"1 c #7BB3DB\",
+\"2 c #7DB5DD\",
+\"3 c #7DB6DD\",
+\"4 c #72A9D4\",
+\"5 c #75ACD6\",
+\"6 c #76AED7\",
+\"7 c #77AFD8\",
+\"8 c #6BA1CD\",
+\"9 c #6EA4CF\",
+\"0 c #6FA6D1\",
+\"a c #6298C6\",
+\"b c #659BC8\",
+\"c c #5C91C0\",
+\" \",
+\" \",
+\" . \",
+\" .. \",
+\" .+. \",
+\" .@#. \",
+\" .#$%. \",
+\" .&*=-. \",
+\" .;>,,,. \",
+\" .;>,,,=. \",
+\" .')!==~;. \",
+\" .#{]*%;^/. \",
+\" .(#_':#<. \",
+\" .+[@</}. \",
+\" .|1232. \",
+\" .4567. \",
+\" .890. \",
+\" .ab. \",
+\" .c. \",
+\" .. \",
+\" . \",
+\" \",
+\" \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the next item button.")
+
+(defconst newsticker--previous-item-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * previous_xpm[] = {
+\"24 24 39 1\",
+\" c None\",
+\". c #000000\",
+\"+ c #7BB3DB\",
+\"@ c #83BCE2\",
+\"# c #7FB8DF\",
+\"$ c #89C2E7\",
+\"% c #86BFE5\",
+\"& c #83BBE2\",
+\"* c #8CC6EA\",
+\"= c #8BC4E9\",
+\"- c #88C2E7\",
+\"; c #85BEE4\",
+\"> c #8DC7EB\",
+\", c #89C3E8\",
+\"' c #8AC4E8\",
+\") c #8BC5EA\",
+\"! c #88C1E6\",
+\"~ c #8AC4E9\",
+\"{ c #8AC3E8\",
+\"] c #86C0E5\",
+\"^ c #87C0E6\",
+\"/ c #87C0E5\",
+\"( c #82BBE2\",
+\"_ c #81BAE1\",
+\": c #7FB7DF\",
+\"< c #7DB6DD\",
+\"[ c #7DB5DD\",
+\"} c #7CB4DC\",
+\"| c #79B1DA\",
+\"1 c #76ADD7\",
+\"2 c #77AFD8\",
+\"3 c #73AAD4\",
+\"4 c #70A7D1\",
+\"5 c #6EA5D0\",
+\"6 c #6CA2CE\",
+\"7 c #689ECB\",
+\"8 c #6399C7\",
+\"9 c #6095C4\",
+\"0 c #5C90C0\",
+\" \",
+\" \",
+\" . \",
+\" .. \",
+\" .+. \",
+\" .@#. \",
+\" .$%&. \",
+\" .*=-;. \",
+\" .>>*,%. \",
+\" .>>>*,%. \",
+\" .')**=-;. \",
+\" .;!,~{-%&. \",
+\" .;]^/;@#. \",
+\" .(@&_:+. \",
+\" .<[}|1. \",
+\" .2134. \",
+\" .567. \",
+\" .89. \",
+\" .0. \",
+\" .. \",
+\" . \",
+\" \",
+\" \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the previous item button.")
+
+(defconst newsticker--previous-feed-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * prev_feed_xpm[] = {
+\"24 24 52 1\",
+\" c None\",
+\". c #000000\",
+\"+ c #70A7D2\",
+\"@ c #75ADD6\",
+\"# c #71A8D3\",
+\"$ c #79B1DA\",
+\"% c #7BB3DB\",
+\"& c #7DB5DD\",
+\"* c #83BBE2\",
+\"= c #7EB6DE\",
+\"- c #78B0D9\",
+\"; c #7FB7DE\",
+\"> c #88C2E7\",
+\", c #85BEE4\",
+\"' c #80B9E0\",
+\") c #80B8DF\",
+\"! c #8CC6EA\",
+\"~ c #89C3E8\",
+\"{ c #86BFE5\",
+\"] c #81BAE1\",
+\"^ c #7CB4DC\",
+\"/ c #7FB8DF\",
+\"( c #8DC7EB\",
+\"_ c #7BB3DC\",
+\": c #7EB7DE\",
+\"< c #8BC4E9\",
+\"[ c #8AC4E9\",
+\"} c #8AC3E8\",
+\"| c #87C0E6\",
+\"1 c #87C0E5\",
+\"2 c #83BCE2\",
+\"3 c #75ACD6\",
+\"4 c #7FB7DF\",
+\"5 c #77AED8\",
+\"6 c #71A8D2\",
+\"7 c #70A7D1\",
+\"8 c #76ADD7\",
+\"9 c #6CA2CE\",
+\"0 c #699FCC\",
+\"a c #73AAD4\",
+\"b c #6BA1CD\",
+\"c c #669CC9\",
+\"d c #6298C5\",
+\"e c #689ECB\",
+\"f c #6499C7\",
+\"g c #6095C3\",
+\"h c #5C91C0\",
+\"i c #5E93C2\",
+\"j c #5B90C0\",
+\"k c #588CBC\",
+\"l c #578CBC\",
+\"m c #5589BA\",
+\" \",
+\" \",
+\" ... . \",
+\" .+. .. \",
+\" .@. .#. \",
+\" .$. .%@. \",
+\" .&. .*=-. \",
+\" .;. .>,'%. \",
+\" .). .!~{]^. \",
+\" ./. .(!~{]_. \",
+\" .:. .!!<>,'%. \",
+\" .&. .~[}>{*=-. \",
+\" .$. .|1,2/%@. \",
+\" .3. .*]4%56. \",
+\" .7. .^$8#9. \",
+\" .0. .a7bc. \",
+\" .d. .efg. \",
+\" .h. .ij. \",
+\" .k. .l. \",
+\" .m. .. \",
+\" ... . \",
+\" \",
+\" \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the previous feed button.")
+
+(defconst newsticker--next-feed-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * next_feed_xpm[] = {
+\"24 24 57 1\",
+\" c None\",
+\". c #000000\",
+\"+ c #6CA2CE\",
+\"@ c #75ADD6\",
+\"# c #71A8D3\",
+\"$ c #79B1DA\",
+\"% c #7EB7DE\",
+\"& c #7DB5DD\",
+\"* c #81BAE1\",
+\"= c #85BEE4\",
+\"- c #78B0D9\",
+\"; c #7FB7DE\",
+\"> c #83BCE3\",
+\", c #87C1E6\",
+\"' c #8AC4E9\",
+\") c #7BB3DB\",
+\"! c #80B8DF\",
+\"~ c #88C2E7\",
+\"{ c #8BC5E9\",
+\"] c #8DC7EB\",
+\"^ c #7CB4DC\",
+\"/ c #7FB8DF\",
+\"( c #84BDE3\",
+\"_ c #7BB3DC\",
+\": c #83BCE2\",
+\"< c #87C0E6\",
+\"[ c #8AC4E8\",
+\"} c #8BC5EA\",
+\"| c #8CC6EA\",
+\"1 c #88C1E6\",
+\"2 c #89C3E8\",
+\"3 c #8AC3E8\",
+\"4 c #7EB6DE\",
+\"5 c #82BBE1\",
+\"6 c #86C0E5\",
+\"7 c #87C0E5\",
+\"8 c #75ACD6\",
+\"9 c #7AB2DA\",
+\"0 c #81B9E0\",
+\"a c #82BBE2\",
+\"b c #71A8D2\",
+\"c c #70A7D1\",
+\"d c #74ACD6\",
+\"e c #699FCC\",
+\"f c #6EA5D0\",
+\"g c #72A9D4\",
+\"h c #669CC9\",
+\"i c #6298C5\",
+\"j c #679DCA\",
+\"k c #6BA1CD\",
+\"l c #6095C3\",
+\"m c #5C91C0\",
+\"n c #5F94C2\",
+\"o c #5B90C0\",
+\"p c #588CBC\",
+\"q c #578CBC\",
+\"r c #5589BA\",
+\" \",
+\" \",
+\" . ... \",
+\" .. .+. \",
+\" .@. .#. \",
+\" .$%. .@. \",
+\" .&*=. .-. \",
+\" .;>,'. .). \",
+\" .!=~{]. .^. \",
+\" ./(~{]]. ._. \",
+\" .%:<[}||. .). \",
+\" .&*=12'3~. .-. \",
+\" .$45=6<7. .@. \",
+\" .8940a:. .b. \",
+\" .cd-)&. .+. \",
+\" .efg8. .h. \",
+\" .ijk. .l. \",
+\" .mn. .o. \",
+\" .p. .q. \",
+\" .. .r. \",
+\" . ... \",
+\" \",
+\" \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the next feed button.")
+
+(defconst newsticker--mark-read-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * mark_read_xpm[] = {
+\"24 24 44 1\",
+\" c None\",
+\". c #C20000\",
+\"+ c #BE0000\",
+\"@ c #C70000\",
+\"# c #CE0000\",
+\"$ c #C90000\",
+\"% c #BD0000\",
+\"& c #CB0000\",
+\"* c #D10000\",
+\"= c #D70000\",
+\"- c #D30000\",
+\"; c #CD0000\",
+\"> c #C60000\",
+\", c #D40000\",
+\"' c #DA0000\",
+\") c #DE0000\",
+\"! c #DB0000\",
+\"~ c #D60000\",
+\"{ c #D00000\",
+\"] c #DC0000\",
+\"^ c #E00000\",
+\"/ c #E40000\",
+\"( c #E10000\",
+\"_ c #DD0000\",
+\": c #D80000\",
+\"< c #E50000\",
+\"[ c #E70000\",
+\"} c #E60000\",
+\"| c #E20000\",
+\"1 c #E90000\",
+\"2 c #E80000\",
+\"3 c #E30000\",
+\"4 c #DF0000\",
+\"5 c #D90000\",
+\"6 c #CC0000\",
+\"7 c #C10000\",
+\"8 c #C30000\",
+\"9 c #BF0000\",
+\"0 c #B90000\",
+\"a c #BC0000\",
+\"b c #BB0000\",
+\"c c #B80000\",
+\"d c #B50000\",
+\"e c #B70000\",
+\" \",
+\" \",
+\" \",
+\" . + \",
+\" +@# $.% \",
+\" &*= -;> \",
+\" ,') !~{ \",
+\" ]^/ (_: \",
+\" (<[ }|) \",
+\" <[1 2<| \",
+\" }222[< \",
+\" }}}< \",
+\" 333| \",
+\" _4^4)] \",
+\" ~:' 5=- \",
+\" 6{- *#$ \",
+\" 7>$ @89 \",
+\" 0a+ %bc \",
+\" ddc edd \",
+\" ddd ddd \",
+\" d d \",
+\" \",
+\" \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the mark read button.")
+
+(defconst newsticker--mark-immortal-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * mark_immortal_xpm[] = {
+\"24 24 93 2\",
+\" c None\",
+\". c #171717\",
+\"+ c #030303\",
+\"@ c #000000\",
+\"# c #181818\",
+\"$ c #090909\",
+\"% c #FFC960\",
+\"& c #FFCB61\",
+\"* c #FFCB62\",
+\"= c #FFC961\",
+\"- c #FFC75F\",
+\"; c #FFC65E\",
+\"> c #FFCA61\",
+\", c #FFCD63\",
+\"' c #FFCF65\",
+\") c #FFD065\",
+\"! c #FFCE64\",
+\"~ c #FFC35C\",
+\"{ c #FFC45D\",
+\"] c #FFD166\",
+\"^ c #FFD267\",
+\"/ c #FFD368\",
+\"( c #FFD167\",
+\"_ c #FFC05A\",
+\": c #010101\",
+\"< c #040404\",
+\"[ c #FFCC62\",
+\"} c #FFD569\",
+\"| c #FFD56A\",
+\"1 c #FFC860\",
+\"2 c #FFC25B\",
+\"3 c #FFBB56\",
+\"4 c #020202\",
+\"5 c #060606\",
+\"6 c #FFC15B\",
+\"7 c #FFC85F\",
+\"8 c #FFD469\",
+\"9 c #FFD66A\",
+\"0 c #FFBC57\",
+\"a c #1B1B1B\",
+\"b c #070707\",
+\"c c #FFBA55\",
+\"d c #FFB451\",
+\"e c #FFB954\",
+\"f c #FFB350\",
+\"g c #FFB652\",
+\"h c #FFBE58\",
+\"i c #FFCD64\",
+\"j c #FFD066\",
+\"k c #FFC059\",
+\"l c #FFB14E\",
+\"m c #0B0B0B\",
+\"n c #FFBB55\",
+\"o c #FFC15A\",
+\"p c #FFB552\",
+\"q c #FFAD4B\",
+\"r c #080808\",
+\"s c #FFAF4C\",
+\"t c #FFB853\",
+\"u c #FFA948\",
+\"v c #050505\",
+\"w c #FFB04E\",
+\"x c #FFB753\",
+\"y c #FFBC56\",
+\"z c #FFC55D\",
+\"A c #FFC55E\",
+\"B c #FFC45C\",
+\"C c #FFBD57\",
+\"D c #FFB854\",
+\"E c #FFB34F\",
+\"F c #FFAB4A\",
+\"G c #FFA545\",
+\"H c #FFAA49\",
+\"I c #FFB04D\",
+\"J c #FFB551\",
+\"K c #FFBF58\",
+\"L c #FFB24F\",
+\"M c #FFAC4A\",
+\"N c #FFA646\",
+\"O c #FFA344\",
+\"P c #FFA848\",
+\"Q c #FFB14F\",
+\"R c #FFAF4D\",
+\"S c #FFA546\",
+\"T c #FFA243\",
+\"U c #FFA445\",
+\"V c #FFAE4C\",
+\"W c #FFA444\",
+\"X c #FFA142\",
+\"Y c #FF9F41\",
+\"Z c #0A0A0A\",
+\"` c #FF9E40\",
+\" . c #FF9F40\",
+\" \",
+\" \",
+\" \",
+\" . + @ @ + # \",
+\" $ @ % & * * = - + + \",
+\" @ ; > , ' ) ' ! * - ~ @ \",
+\" @ { > ! ] ^ / / ( ' * ; _ : \",
+\" < _ ; [ ) / } | } / ] , 1 2 3 4 \",
+\" 5 6 7 , ] 8 9 9 9 } ^ ! = ~ 0 a \",
+\" b c 6 - , ] 8 9 9 9 } ^ ! % ~ 0 d 5 \",
+\" : e _ ; * ) / 8 } } / ] , 1 2 3 f 5 \",
+\" : g h { = i j ^ / ^ ] ! * ; k e l m \",
+\" : f n o ; > , ' ) ' ! * - 2 0 p q r \",
+\" : s g 0 6 ; % > * * = - ~ h t l u r \",
+\" v u w x y k ~ z A z B o C D E F G b \",
+\" 5 H I J e 0 h K h C c x L M N . \",
+\" 4 O P q Q d g x g J L R H S T < \",
+\" @ T U P F q V q M H N W X + \",
+\" @ Y T O W G G W O X Y @ \",
+\" 4 Z ` Y Y Y .` 4 4 \",
+\" 5 : : @ @ Z \",
+\" \",
+\" \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the mark immortal button.")
+
+(defconst newsticker--narrow-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * narrow_xpm[] = {
+\"24 24 48 1\",
+\" c None\",
+\". c #000000\",
+\"+ c #969696\",
+\"@ c #9E9E9E\",
+\"# c #A4A4A4\",
+\"$ c #AAAAAA\",
+\"% c #AEAEAE\",
+\"& c #B1B1B1\",
+\"* c #B3B3B3\",
+\"= c #B4B4B4\",
+\"- c #B2B2B2\",
+\"; c #AFAFAF\",
+\"> c #ABABAB\",
+\", c #A6A6A6\",
+\"' c #A0A0A0\",
+\") c #989898\",
+\"! c #909090\",
+\"~ c #73AAD4\",
+\"{ c #7AB2DA\",
+\"] c #7FB8DF\",
+\"^ c #84BDE3\",
+\"/ c #88C2E7\",
+\"( c #8BC5E9\",
+\"_ c #8DC7EB\",
+\": c #8CC6EA\",
+\"< c #89C3E8\",
+\"[ c #86BFE5\",
+\"} c #81BAE1\",
+\"| c #7BB3DC\",
+\"1 c #75ACD6\",
+\"2 c #6DA4CF\",
+\"3 c #979797\",
+\"4 c #A3A3A3\",
+\"5 c #A8A8A8\",
+\"6 c #ADADAD\",
+\"7 c #ACACAC\",
+\"8 c #A9A9A9\",
+\"9 c #A5A5A5\",
+\"0 c #9A9A9A\",
+\"a c #929292\",
+\"b c #8C8C8C\",
+\"c c #808080\",
+\"d c #818181\",
+\"e c #838383\",
+\"f c #848484\",
+\"g c #858585\",
+\"h c #868686\",
+\"i c #828282\",
+\" \",
+\" \",
+\" \",
+\" .................. \",
+\" .+@#$%&*=*-;>,')!. \",
+\" .................. \",
+\" \",
+\" \",
+\" .................. \",
+\" .~{]^/(___:<[}|12. \",
+\" .................. \",
+\" \",
+\" \",
+\" .................. \",
+\" .!3@45>666789'0ab. \",
+\" .................. \",
+\" \",
+\" \",
+\" .................. \",
+\" .cccdefghhgficccc. \",
+\" .................. \",
+\" \",
+\" \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the narrow image button.")
+
+(defconst newsticker--get-all-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * get_all_xpm[] = {
+\"24 24 70 1\",
+\" c None\",
+\". c #000000\",
+\"+ c #F3DA00\",
+\"@ c #F5DF00\",
+\"# c #F7E300\",
+\"$ c #F9E700\",
+\"% c #FAEA00\",
+\"& c #FBEC00\",
+\"* c #FBED00\",
+\"= c #FCEE00\",
+\"- c #FAEB00\",
+\"; c #F9E800\",
+\"> c #F8E500\",
+\", c #F6E000\",
+\"' c #F4DB00\",
+\") c #F1D500\",
+\"! c #EFD000\",
+\"~ c #B7CA00\",
+\"{ c #BFD100\",
+\"] c #C5D700\",
+\"^ c #CBDB00\",
+\"/ c #CFDF00\",
+\"( c #D2E200\",
+\"_ c #D4E400\",
+\": c #D3E300\",
+\"< c #D0E000\",
+\"[ c #CCDD00\",
+\"} c #C7D800\",
+\"| c #C1D300\",
+\"1 c #BACC00\",
+\"2 c #B1C500\",
+\"3 c #A8BC00\",
+\"4 c #20A900\",
+\"5 c #22AF00\",
+\"6 c #24B500\",
+\"7 c #26B900\",
+\"8 c #27BC00\",
+\"9 c #27BE00\",
+\"0 c #28BF00\",
+\"a c #27BD00\",
+\"b c #26BA00\",
+\"c c #25B600\",
+\"d c #23B100\",
+\"e c #21AB00\",
+\"f c #1FA400\",
+\"g c #1C9B00\",
+\"h c #21AA00\",
+\"i c #24B300\",
+\"j c #25B800\",
+\"k c #25B700\",
+\"l c #24B400\",
+\"m c #23B000\",
+\"n c #1FA500\",
+\"o c #1D9E00\",
+\"p c #20A800\",
+\"q c #21AC00\",
+\"r c #23B200\",
+\"s c #22AD00\",
+\"t c #1D9F00\",
+\"u c #20A700\",
+\"v c #1EA100\",
+\"w c #1C9C00\",
+\"x c #1DA000\",
+\"y c #1B9800\",
+\"z c #1A9600\",
+\"A c #1A9700\",
+\"B c #1A9500\",
+\"C c #199200\",
+\"D c #189100\",
+\"E c #178C00\",
+\" \",
+\" \",
+\" \",
+\" \",
+\" ................... \",
+\" .+@#$%&*=*&-;>,')!. \",
+\" ................... \",
+\" \",
+\" ................... \",
+\" .~{]^/(___:<[}|123. \",
+\" ................... \",
+\" \",
+\" ................... \",
+\" .45678909abcdefg. \",
+\" .h5icj7jklmeno. \",
+\" .pq5drrmshft. \",
+\" .fu4h4pnvw. \",
+\" .oxvxtwy. \",
+\" .zAAzB. \",
+\" .CCD. \",
+\" .E. \",
+\" . \",
+\" \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the get all image button.")
+
+(defconst newsticker--update-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * update_xpm[] = {
+\"24 24 37 1\",
+\" c None\",
+\". c #076D00\",
+\"+ c #0A8600\",
+\"@ c #0A8800\",
+\"# c #098400\",
+\"$ c #087200\",
+\"% c #087900\",
+\"& c #098500\",
+\"* c #098100\",
+\"= c #087600\",
+\"- c #097E00\",
+\"; c #097F00\",
+\"> c #0A8700\",
+\", c #0A8C00\",
+\"' c #097C00\",
+\") c #098300\",
+\"! c #0A8900\",
+\"~ c #0A8E00\",
+\"{ c #0B9200\",
+\"] c #087700\",
+\"^ c #076E00\",
+\"/ c #076C00\",
+\"( c #076B00\",
+\"_ c #076A00\",
+\": c #076900\",
+\"< c #076800\",
+\"[ c #066700\",
+\"} c #066500\",
+\"| c #066400\",
+\"1 c #066300\",
+\"2 c #066600\",
+\"3 c #066200\",
+\"4 c #076700\",
+\"5 c #065E00\",
+\"6 c #066100\",
+\"7 c #065F00\",
+\"8 c #066000\",
+\" \",
+\" \",
+\" \",
+\" . +@@@+# \",
+\" $% &@ +* \",
+\" =-# ; \",
+\" %*>, ' \",
+\" ')!~{ = \",
+\" ]$ \",
+\" ^ ^ \",
+\" . . \",
+\" / ( \",
+\" _ : \",
+\" < [ \",
+\" } | \",
+\" [[ \",
+\" 1 $.:23 \",
+\" 3 4}35 \",
+\" 6 655 \",
+\" 76 85 55 \",
+\" 5555555 5 \",
+\" \",
+\" \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the update button.")
+
+(defconst newsticker--browse-image
+ (and (fboundp 'image-type-available-p)
+ (image-type-available-p 'xpm)
+ (create-image "/* XPM */
+static char * visit_xpm[] = {
+\"24 24 39 1\",
+\" c None\",
+\". c #000000\",
+\"+ c #FFFFFF\",
+\"@ c #00E63D\",
+\"# c #00E83E\",
+\"$ c #00E73D\",
+\"% c #00E93E\",
+\"& c #00E63C\",
+\"* c #00E53C\",
+\"= c #00E23B\",
+\"- c #00E33B\",
+\"; c #00E83D\",
+\"> c #00E13A\",
+\", c #00DD38\",
+\"' c #00DE38\",
+\") c #00E23A\",
+\"! c #00E43C\",
+\"~ c #00DF39\",
+\"{ c #00DB37\",
+\"] c #00D634\",
+\"^ c #00D734\",
+\"/ c #00E039\",
+\"( c #00DC37\",
+\"_ c #00D835\",
+\": c #00D332\",
+\"< c #00CD2F\",
+\"[ c #00DB36\",
+\"} c #00D433\",
+\"| c #00CF30\",
+\"1 c #00DA36\",
+\"2 c #00D936\",
+\"3 c #00D533\",
+\"4 c #00D131\",
+\"5 c #00CE2F\",
+\"6 c #00CC2F\",
+\"7 c #00CA2D\",
+\"8 c #00C62B\",
+\"9 c #00C52A\",
+\"0 c #00BE27\",
+\" \",
+\" \",
+\" . \",
+\" .+. \",
+\" .+++. \",
+\" .++.++. \",
+\" .++.@.++. \",
+\" .++.##$.++. \",
+\" .++.%%%#&.++. \",
+\" .++.$%%%#*=.++. \",
+\" .++.-@;##$*>,.++. \",
+\" .++.')!&@@*=~{].++. \",
+\" .++.^{~>---)/(_:<.++. \",
+\" .++.^[,~/~'(_}|.++. \",
+\" .++.]_1[12^:|.++. \",
+\" .++.:}33:45.++. \",
+\" .++.<5567.++. \",
+\" .++.889.++. \",
+\" .++.0.++. \",
+\" .++.++. \",
+\" .+++. \",
+\" .+. \",
+\" . \",
+\" \"};
+"
+ 'xpm t))
+ "Image for the browse button.")
+
+(provide 'newsticker-reader)
+
+;; arch-tag: c604b701-bdf1-4fc1-8d05-5fabd1939533
+;;; newst-reader.el ends here
--- /dev/null
+;; newst-ticker.el --- modeline ticker for newsticker.
+
+;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+;; Free Software Foundation, Inc.
+
+;; Author: Ulf Jasper <ulf.jasper@web.de>
+;; Filename: newst-ticker.el
+;; URL: http://www.nongnu.org/newsticker
+;; Keywords: News, RSS, Atom
+;; Time-stamp: "13. Juni 2008, 17:43:29 (ulf)"
+
+;; ======================================================================
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;; ======================================================================
+
+;;; Commentary:
+
+;; See newsticker.el
+
+;; ======================================================================
+;;; Code:
+
+(require 'newsticker-backend)
+
+(defvar newsticker--ticker-timer nil
+ "Timer for newsticker ticker.")
+
+;;;###autoload
+(defun newsticker-ticker-running-p ()
+ "Check whether newsticker's actual ticker is running.
+Return t if ticker is running, nil otherwise. Newsticker is
+considered to be running if the newsticker timer list is not
+empty."
+ (timerp newsticker--ticker-timer))
+
+;; customization group ticker
+(defgroup newsticker-ticker nil
+ "Settings for the headline ticker."
+ :group 'newsticker)
+
+(defun newsticker--set-customvar-ticker (symbol value)
+ "Set newsticker-variable SYMBOL value to VALUE.
+Calls all actions which are necessary in order to make the new
+value effective."
+ (if (or (not (boundp symbol))
+ (equal (symbol-value symbol) value))
+ (set symbol value)
+ ;; something must have changed -- restart ticker
+ (when (newsticker-running-p)
+ (message "Restarting ticker")
+ (newsticker-stop-ticker)
+ (newsticker--ticker-text-setup)
+ (newsticker-start-ticker)
+ (message ""))))
+
+(defcustom newsticker-ticker-interval
+ 0.3
+ "Time interval for displaying news items in the echo area (seconds).
+If equal or less than 0 no messages are shown in the echo area. For
+smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
+reasonable. For non-smooth display a value of 10 is a good starting
+point."
+ :type 'number
+ :set 'newsticker--set-customvar-ticker
+ :group 'newsticker-ticker)
+
+(defcustom newsticker-scroll-smoothly
+ t
+ "Decides whether to flash or scroll news items.
+If t the news headlines are scrolled (more-or-less) smoothly in the echo
+area. If nil one headline after another is displayed in the echo area.
+The variable `newsticker-ticker-interval' determines how fast this
+display moves/changes and whether headlines are shown in the echo area
+at all. If you change `newsticker-scroll-smoothly' you should also change
+`newsticker-ticker-interval'."
+ :type 'boolean
+ :group 'newsticker-ticker)
+
+(defcustom newsticker-hide-immortal-items-in-echo-area
+ t
+ "Decides whether to show immortal/non-expiring news items in the ticker.
+If t the echo area will not show immortal items. See also
+`newsticker-hide-old-items-in-echo-area'."
+ :type 'boolean
+ :set 'newsticker--set-customvar-ticker
+ :group 'newsticker-ticker)
+
+(defcustom newsticker-hide-old-items-in-echo-area
+ t
+ "Decides whether to show only the newest news items in the ticker.
+If t the echo area will show only new items, i.e. only items which have
+been added between the last two retrievals."
+ :type 'boolean
+ :set 'newsticker--set-customvar-ticker
+ :group 'newsticker-ticker)
+
+(defcustom newsticker-hide-obsolete-items-in-echo-area
+ t
+ "Decides whether to show obsolete items items in the ticker.
+If t the echo area will not show obsolete items. See also
+`newsticker-hide-old-items-in-echo-area'."
+ :type 'boolean
+ :set 'newsticker--set-customvar-ticker
+ :group 'newsticker-ticker)
+
+(defun newsticker--display-tick ()
+ "Called from the display timer.
+This function calls a display function, according to the variable
+`newsticker-scroll-smoothly'."
+ (if newsticker-scroll-smoothly
+ (newsticker--display-scroll)
+ (newsticker--display-jump)))
+
+(defsubst newsticker--echo-area-clean-p ()
+ "Check whether somebody is using the echo area / minibuffer.
+Return t if echo area and minibuffer are unused."
+ (not (or (active-minibuffer-window)
+ (and (current-message)
+ (not (string= (current-message)
+ newsticker--prev-message))))))
+
+(defun newsticker--display-jump ()
+ "Called from the display timer.
+This function displays the next ticker item in the echo area, unless
+there is another message displayed or the minibuffer is active."
+ (let ((message-log-max nil));; prevents message text from being logged
+ (when (newsticker--echo-area-clean-p)
+ (setq newsticker--item-position (1+ newsticker--item-position))
+ (when (>= newsticker--item-position (length newsticker--item-list))
+ (setq newsticker--item-position 0))
+ (setq newsticker--prev-message
+ (nth newsticker--item-position newsticker--item-list))
+ (message "%s" newsticker--prev-message))))
+
+(defun newsticker--display-scroll ()
+ "Called from the display timer.
+This function scrolls the ticker items in the echo area, unless
+there is another message displayed or the minibuffer is active."
+ (when (newsticker--echo-area-clean-p)
+ (let* ((width (- (frame-width) 1))
+ (message-log-max nil);; prevents message text from being logged
+ (i newsticker--item-position)
+ subtext
+ (s-text newsticker--scrollable-text)
+ (l (length s-text)))
+ ;; don't show anything if there is nothing to show
+ (unless (< (length s-text) 1)
+ ;; repeat the ticker string if it is shorter than frame width
+ (while (< (length s-text) width)
+ (setq s-text (concat s-text s-text)))
+ ;; get the width of the printed string
+ (setq l (length s-text))
+ (cond ((< i (- l width))
+ (setq subtext (substring s-text i (+ i width))))
+ (t
+ (setq subtext (concat
+ (substring s-text i l)
+ (substring s-text 0 (- width (- l i)))))))
+ ;; Take care of multibyte strings, for which (string-width) is
+ ;; larger than (length).
+ ;; Actually, such strings may be smaller than (frame-width)
+ ;; because return values of (string-width) are too large:
+ ;; (string-width "<japanese character>") => 2
+ (let ((t-width (1- (length subtext))))
+ (while (> (string-width subtext) width)
+ (setq subtext (substring subtext 0 t-width))
+ (setq t-width (1- t-width))))
+ ;; show the ticker text and save current position
+ (message "%s" subtext)
+ (setq newsticker--prev-message subtext)
+ (setq newsticker--item-position (1+ i))
+ (when (>= newsticker--item-position l)
+ (setq newsticker--item-position 0))))))
+
+;;;###autoload
+(defun newsticker-start-ticker ()
+ "Start newsticker's ticker (but not the news retrieval).
+Start display timer for the actual ticker if wanted and not
+running already."
+ (interactive)
+ (if (and (> newsticker-ticker-interval 0)
+ (not newsticker--ticker-timer))
+ (setq newsticker--ticker-timer
+ (run-at-time newsticker-ticker-interval
+ newsticker-ticker-interval
+ 'newsticker--display-tick))))
+
+(defun newsticker-stop-ticker ()
+ "Stop newsticker's ticker (but not the news retrieval)."
+ (interactive)
+ (when newsticker--ticker-timer
+ (cancel-timer newsticker--ticker-timer)
+ (setq newsticker--ticker-timer nil)))
+
+;; ======================================================================
+;;; Manipulation of ticker text
+;; ======================================================================
+(defun newsticker--ticker-text-setup ()
+ "Build the ticker text which is scrolled or flashed in the echo area."
+ ;; reset scrollable text
+ (setq newsticker--scrollable-text "")
+ (setq newsticker--item-list nil)
+ (setq newsticker--item-position 0)
+ ;; build scrollable text from cache data
+ (let ((have-something nil))
+ (mapc
+ (lambda (feed)
+ (let ((feed-name (symbol-name (car feed))))
+ (let ((num-new (newsticker--stat-num-items (car feed) 'new))
+ (num-old (newsticker--stat-num-items (car feed) 'old))
+ (num-imm (newsticker--stat-num-items (car feed) 'immortal))
+ (num-obs (newsticker--stat-num-items (car feed) 'obsolete)))
+ (when (or (> num-new 0)
+ (and (> num-old 0)
+ (not newsticker-hide-old-items-in-echo-area))
+ (and (> num-imm 0)
+ (not newsticker-hide-immortal-items-in-echo-area))
+ (and (> num-obs 0)
+ (not newsticker-hide-obsolete-items-in-echo-area)))
+ (setq have-something t)
+ (mapc
+ (lambda (item)
+ (let ((title (replace-regexp-in-string
+ "[\r\n]+" " "
+ (newsticker--title item)))
+ (age (newsticker--age item)))
+ (unless (string= title newsticker--error-headline)
+ (when
+ (or (eq age 'new)
+ (and (eq age 'old)
+ (not newsticker-hide-old-items-in-echo-area))
+ (and (eq age 'obsolete)
+ (not
+ newsticker-hide-obsolete-items-in-echo-area))
+ (and (eq age 'immortal)
+ (not
+ newsticker-hide-immortal-items-in-echo-area)))
+ (setq title (newsticker--remove-whitespace title))
+ ;; add to flash list
+ (add-to-list 'newsticker--item-list
+ (concat feed-name ": " title) t)
+ ;; and to the scrollable text
+ (setq newsticker--scrollable-text
+ (concat newsticker--scrollable-text
+ " " feed-name ": " title " +++"))))))
+ (cdr feed))))))
+ newsticker--cache)
+ (when have-something
+ (setq newsticker--scrollable-text
+ (concat "+++ "
+ (format-time-string "%A, %H:%M"
+ newsticker--latest-update-time)
+ " ++++++" newsticker--scrollable-text)))))
+
+(defun newsticker--ticker-text-remove (feed title)
+ "Remove the item of FEED with TITLE from the ticker text."
+ ;; reset scrollable text
+ (setq newsticker--item-position 0)
+ (let ((feed-name (symbol-name feed))
+ (t-title (replace-regexp-in-string "[\r\n]+" " " title)))
+ ;; remove from flash list
+ (setq newsticker--item-list (remove (concat feed-name ": " t-title)
+ newsticker--item-list))
+ ;; and from the scrollable text
+ (setq newsticker--scrollable-text
+ (replace-regexp-in-string
+ (regexp-quote (concat " " feed-name ": " t-title " +++"))
+ ""
+ newsticker--scrollable-text))
+ (if (string-match (concat "^\\+\\+\\+ [A-Z][a-z]+, "
+ "[012]?[0-9]:[0-9][0-9] \\+\\+\\+\\+\\+\\+$")
+ newsticker--scrollable-text)
+ (setq newsticker--scrollable-text ""))))
+
+(provide 'newsticker-ticker)
+
+;; arch-tag: faee3ebb-749b-4935-9835-7f36d4b700f0
+;;; newst-ticker.el ends here
--- /dev/null
+;;; newst-treeview.el --- Treeview frontend for newsticker.
+
+;; Copyright (C) 2008 Free Software Foundation, Inc.
+
+;; Author: Ulf Jasper <ulf.jasper@web.de>
+;; Filename: newst-treeview.el
+;; URL: http://www.nongnu.org/newsticker
+;; Created: 2007
+;; Keywords: News, RSS, Atom
+;; Time-stamp: "13. Juni 2008, 17:43:54 (ulf)"
+
+;; ======================================================================
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;; ======================================================================
+;;; Commentary:
+
+;; See newsticker.el
+
+;; ======================================================================
+;;; History:
+;;
+
+
+;; ======================================================================
+;;; Code:
+(require 'newsticker-reader)
+(require 'widget)
+(require 'tree-widget)
+(require 'wid-edit)
+
+;; ======================================================================
+;;; Customization
+;; ======================================================================
+(defgroup newsticker-treeview nil
+ "Settings for the tree view reader."
+ :group 'newsticker-reader)
+
+(defface newsticker-treeview-face
+ '((((class color) (background dark))
+ (:family "helvetica" :foreground "misty rose" :bold nil))
+ (((class color) (background light))
+ (:family "helvetica" :foreground "black" :bold nil)))
+ "Face for newsticker tree."
+ :group 'newsticker-treeview)
+
+(defface newsticker-treeview-new-face
+ '((((class color) (background dark))
+ (:inherit newsticker-treeview-face :bold t))
+ (((class color) (background light))
+ (:inherit newsticker-treeview-face :bold t)))
+ "Face for newsticker tree."
+ :group 'newsticker-treeview)
+
+(defface newsticker-treeview-old-face
+ '((((class color) (background dark))
+ (:inherit newsticker-treeview-face))
+ (((class color) (background light))
+ (:inherit newsticker-treeview-face)))
+ "Face for newsticker tree."
+ :group 'newsticker-treeview)
+
+(defface newsticker-treeview-immortal-face
+ '((((class color) (background dark))
+ (:inherit newsticker-treeview-face :foreground "orange" :italic t))
+ (((class color) (background light))
+ (:inherit newsticker-treeview-face :foreground "blue" :italic t)))
+ "Face for newsticker tree."
+ :group 'newsticker-treeview)
+
+(defface newsticker-treeview-obsolete-face
+ '((((class color) (background dark))
+ (:inherit newsticker-treeview-face :strike-through t))
+ (((class color) (background light))
+ (:inherit newsticker-treeview-face :strike-through t)))
+ "Face for newsticker tree."
+ :group 'newsticker-treeview)
+
+(defface newsticker-treeview-selection-face
+ '((((class color) (background dark))
+ (:background "#bbbbff"))
+ (((class color) (background light))
+ (:background "#bbbbff")))
+ "Face for newsticker selection."
+ :group 'newsticker-treeview)
+
+(defcustom newsticker-treeview-own-frame
+ t
+ "Decides whether newsticker creates and uses its own frame."
+ :type 'boolean
+ :group 'newsticker-treeview)
+
+(defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
+ t
+ "Decides whether to automatically mark displayed items as old.
+If t an item is marked as old as soon as it is displayed. This
+applies to newsticker only."
+ :type 'boolean
+ :group 'newsticker-treeview)
+
+(defvar newsticker-groups
+ '("Feeds")
+ "List of feed groups, used in the treeview frontend.
+Each element must be a list consisting of strings. The first
+element gives the title of the group, the following elements the
+names of feeds that belong to the group.
+FIXME")
+
+(defcustom newsticker-groups-filename
+ "~/.newsticker-groups"
+ "Name of the newsticker groups settings file."
+ :type 'string
+ :group 'newsticker-treeview)
+
+;; ======================================================================
+;;; internal variables
+;; ======================================================================
+(defvar newsticker--treeview-windows nil)
+(defvar newsticker--treeview-buffers nil)
+(defvar newsticker--treeview-current-feed nil)
+(defvar newsticker--treeview-current-vfeed nil)
+(defvar newsticker--treeview-list-show-feed nil)
+(defvar newsticker--saved-window-config nil)
+(defvar newsticker--window-config nil)
+;; (makunbound 'newsticker--selection-overlay) ;; FIXME
+(defvar newsticker--selection-overlay nil
+ "Highlight the selected tree node.")
+;;(makunbound 'newsticker--tree-selection-overlay) ;; FIXME
+(defvar newsticker--tree-selection-overlay nil
+ "Highlight the selected list item.")
+;;(makunbound 'newsticker--frame);; FIXME
+(defvar newsticker--frame nil "Special frame for newsticker windows.")
+(defvar newsticker--treeview-list-sort-order 'sort-by-time)
+(defvar newsticker--treeview-current-node-id nil)
+(defvar newsticker--treeview-current-tree nil)
+(defvar newsticker--treeview-feed-tree nil)
+(defvar newsticker--treeview-vfeed-tree nil)
+
+;; maps for the clickable portions
+(defvar newsticker--treeview-url-keymap
+ (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
+ (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
+ (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
+ (define-key map "\n" 'newsticker-treeview-browse-url)
+ (define-key map "\C-m" 'newsticker-treeview-browse-url)
+ (define-key map [(control return)] 'newsticker-handle-url)
+ map)
+ "Key map for click-able headings in the newsticker treeview buffers.")
+
+
+;; ======================================================================
+;;; short cuts
+;; ======================================================================
+(defsubst newsticker--treeview-tree-buffer ()
+ "Return the tree buffer of the newsticker treeview."
+ (nth 0 newsticker--treeview-buffers))
+(defsubst newsticker--treeview-list-buffer ()
+ "Return the list buffer of the newsticker treeview."
+ (nth 1 newsticker--treeview-buffers))
+(defsubst newsticker--treeview-item-buffer ()
+ "Return the item buffer of the newsticker treeview."
+ (nth 2 newsticker--treeview-buffers))
+(defsubst newsticker--treeview-tree-window ()
+ "Return the tree window of the newsticker treeview."
+ (nth 0 newsticker--treeview-windows))
+(defsubst newsticker--treeview-list-window ()
+ "Return the list window of the newsticker treeview."
+ (nth 1 newsticker--treeview-windows))
+(defsubst newsticker--treeview-item-window ()
+ "Return the item window of the newsticker treeview."
+ (nth 2 newsticker--treeview-windows))
+
+;; ======================================================================
+;;; utility functions
+;; ======================================================================
+(defun newsticker--treeview-get-id (parent i)
+ "Create an id for a newsticker treeview node.
+PARENT is the node's parent, I is an integer."
+ ;;(message "newsticker--treeview-get-id %s"
+ ;; (format "%s-%d" (widget-get parent :nt-id) i))
+ (format "%s-%d" (widget-get parent :nt-id) i))
+
+(defun newsticker--treeview-ids-eq (id1 id2)
+ "Return non-nil if ids ID1 and ID2 are equal."
+ ;;(message "%s/%s" (or id1 -1) (or id2 -1))
+ (and id1 id2 (string= id1 id2)))
+
+(defun newsticker--treeview-nodes-eq (node1 node2)
+ "Compare treeview nodes NODE1 and NODE2 for equality.
+Nodes are equal if the have the same newsticker-id. Note that
+during re-tagging and collapsing/expanding nodes change, while
+their id stays constant."
+ (let ((id1 (widget-get node1 :nt-id))
+ (id2 (widget-get node2 :nt-id)))
+ ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
+ ;; (or id1 -1) (or id2 -1))
+ (or (newsticker--treeview-ids-eq id1 id2)
+ (string= (widget-get node1 :tag) (widget-get node2 :tag)))))
+
+(defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
+ "Recursivly search node for feed FEED-NAME starting from STARTNODE."
+ ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
+ (if (string= feed-name (or (widget-get startnode :nt-feed)
+ (widget-get startnode :nt-vfeed)))
+ (throw 'found startnode)
+ (let ((children (widget-get startnode :children)))
+ (dolist (w children)
+ (newsticker--treeview-do-get-node-of-feed feed-name w)))))
+
+(defun newsticker--treeview-get-node-of-feed (feed-name)
+ "Return node for feed FEED-NAME in newsticker treeview tree."
+ (catch 'found
+ (newsticker--treeview-do-get-node-of-feed feed-name
+ newsticker--treeview-feed-tree)
+ (newsticker--treeview-do-get-node-of-feed feed-name
+ newsticker--treeview-vfeed-tree)))
+
+(defun newsticker--treeview-do-get-node (id startnode)
+ "Recursivly search node with ID starting from STARTNODE."
+ (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
+ (throw 'found startnode)
+ (let ((children (widget-get startnode :children)))
+ (dolist (w children)
+ (newsticker--treeview-do-get-node id w)))))
+
+(defun newsticker--treeview-get-node (id)
+ "Return node with ID in newsticker treeview tree."
+ (catch 'found
+ (newsticker--treeview-do-get-node id newsticker--treeview-feed-tree)
+ (newsticker--treeview-do-get-node id newsticker--treeview-vfeed-tree)))
+
+(defun newsticker--treeview-get-current-node ()
+ "Return current node in newsticker treeview tree."
+ (newsticker--treeview-get-node newsticker--treeview-current-node-id))
+
+;; ======================================================================
+
+(declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
+
+(defun newsticker--treeview-render-text (start end)
+ "Render text between markers START and END."
+ (if newsticker-html-renderer
+ (condition-case error-data
+ (save-excursion
+ (set-marker-insertion-type end t)
+ ;; check whether it is necessary to call html renderer
+ ;; (regexp inspired by htmlr.el)
+ (goto-char start)
+ (when (re-search-forward
+ "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
+ ;; (message "%s" (newsticker--title item))
+ (let ((w3m-fill-column (if newsticker-use-full-width
+ -1 fill-column))
+ (w3-maximum-line-length
+ (if newsticker-use-full-width nil fill-column)))
+ (save-excursion
+ (funcall newsticker-html-renderer start end)))
+ ;;(cond ((eq newsticker-html-renderer 'w3m-region)
+ ;; (add-text-properties start end (list 'keymap
+ ;; w3m-minor-mode-map)))
+ ;;((eq newsticker-html-renderer 'w3-region)
+ ;;(add-text-properties start end (list 'keymap w3-mode-map))))
+ (if (eq newsticker-html-renderer 'w3m-region)
+ (w3m-toggle-inline-images t))
+ t))
+ (error
+ (message "Error: HTML rendering failed: %s, %s"
+ (car error-data) (cdr error-data))
+ nil))
+ nil))
+
+;; ======================================================================
+;;; List window
+;; ======================================================================
+(defun newsticker--treeview-list-add-item (item feed &optional show-feed)
+ "Add news ITEM for FEED to newsticker treeview list window.
+If string SHOW-FEED is non-nil it is shown in the item string."
+ (setq newsticker--treeview-list-show-feed show-feed)
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (let* ((inhibit-read-only t)
+ pos1 pos2)
+ (goto-char (point-max))
+ (setq pos1 (point-marker))
+ (insert " ")
+ (insert (propertize " " 'display '(space :align-to 2)))
+ (insert (if show-feed
+ (concat
+ (substring
+ (format "%-10s" (newsticker--real-feed-name
+ feed))
+ 0 10)
+ (propertize " " 'display '(space :align-to 12)))
+ ""))
+ (insert (format-time-string "%d.%m.%y, %H:%M"
+ (newsticker--time item)))
+ (insert (propertize " " 'display
+ (list 'space :align-to (if show-feed 28 18))))
+ (setq pos2 (point-marker))
+ (insert (newsticker--title item))
+ (insert "\n")
+ (newsticker--treeview-render-text pos2 (point-marker))
+ (goto-char pos2)
+ (while (search-forward "\n" nil t)
+ (replace-match " "))
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'newsticker-treeview-tree-click)
+ (define-key map "\n" 'newsticker-treeview-show-item)
+ (define-key map "\C-m" 'newsticker-treeview-show-item)
+ (add-text-properties pos1 (point-max)
+ (list :nt-item item
+ :nt-feed feed
+ :nt-link (newsticker--link item)
+ 'mouse-face 'highlight
+ 'keymap map
+ 'help-echo "Show item")))
+ (insert "\n"))))
+
+(defun newsticker--treeview-list-clear ()
+ "Clear the newsticker treeview list window."
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (kill-all-local-variables)
+ (remove-overlays))))
+
+(defun newsticker--treeview-list-items-with-age-callback (widget
+ changed-widget
+ &rest ages)
+ "Fill newsticker treeview list window with items of certain age.
+This is a callback function for the treeview nodes.
+Argument WIDGET is the calling treeview widget.
+Argument CHANGED-WIDGET is the widget that actually has changed.
+Optional argument AGES is the list of ages that are to be shown."
+ (newsticker--treeview-list-clear)
+ (widget-put widget :nt-selected t)
+ (apply 'newsticker--treeview-list-items-with-age ages))
+
+(defun newsticker--treeview-list-items-with-age (&rest ages)
+ "Actually fill newsticker treeview list window with items of certain age.
+AGES is the list of ages that are to be shown."
+ (mapc (lambda (feed)
+ (let ((feed-name-symbol (intern (car feed))))
+ (mapc (lambda (item)
+ (when (memq (newsticker--age item) ages)
+ (newsticker--treeview-list-add-item
+ item feed-name-symbol t)))
+ (newsticker--treeview-list-sort-items
+ (cdr (newsticker--cache-get-feed feed-name-symbol))))))
+ (append newsticker-url-list-defaults newsticker-url-list))
+ (newsticker--treeview-list-update nil))
+
+(defun newsticker--treeview-list-new-items (widget changed-widget
+ &optional event)
+ "Fill newsticker treeview list window with new items.
+This is a callback function for the treeview nodes.
+Argument WIDGET FIXME.
+Argument CHANGED-WIDGET FIXME.
+Optional argument EVENT FIXME."
+ (newsticker--treeview-list-items-with-age-callback widget changed-widget
+ 'new)
+ (newsticker--treeview-item-show-text
+ "New items"
+ "This is a virtual feed containing all new items"))
+
+(defun newsticker--treeview-list-immortal-items (widget changed-widget
+ &optional event)
+ "Fill newsticker treeview list window with immortal items.
+This is a callback function for the treeview nodes.
+Argument WIDGET FIXME.
+Argument CHANGED-WIDGET FIXME.
+Optional argument EVENT FIXME."
+ (newsticker--treeview-list-items-with-age-callback widget changed-widget
+ 'immortal)
+ (newsticker--treeview-item-show-text
+ "Immortal items"
+ "This is a virtual feed containing all immortal items."))
+
+(defun newsticker--treeview-list-obsolete-items (widget changed-widget
+ &optional event)
+ "Fill newsticker treeview list window with obsolete items.
+This is a callback function for the treeview nodes.
+Argument WIDGET FIXME.
+Argument CHANGED-WIDGET FIXME.
+Optional argument EVENT FIXME."
+ (newsticker--treeview-list-items-with-age-callback widget changed-widget
+ 'obsolete)
+ (newsticker--treeview-item-show-text
+ "Obsolete items"
+ "This is a virtual feed containing all obsolete items."))
+
+(defun newsticker--treeview-list-all-items (widget changed-widget
+ &optional event)
+ "Fill newsticker treeview list window with all items.
+This is a callback function for the treeview nodes.
+Argument WIDGET FIXME.
+Argument CHANGED-WIDGET FIXME.
+Optional argument EVENT FIXME."
+ (newsticker--treeview-list-items-with-age-callback widget changed-widget
+ event 'new 'old
+ 'obsolete 'immortal)
+ (newsticker--treeview-item-show-text
+ "All items"
+ "This is a virtual feed containing all items."))
+
+(defun newsticker--treeview-list-items-v (vfeed-name)
+ "List items for virtual feed VFEED-NAME."
+ (when vfeed-name
+ (cond ((string-match "\\*new\\*" vfeed-name)
+ (newsticker--treeview-list-items-with-age 'new))
+ ((string-match "\\*immortal\\*" vfeed-name)
+ (newsticker--treeview-list-items-with-age 'immortal))
+ ((string-match "\\*old\\*" vfeed-name)
+ (newsticker--treeview-list-items-with-age 'old nil)))
+ (newsticker--treeview-list-update nil)
+ ))
+
+(defun newsticker--treeview-list-items (feed-name)
+ "List items for feed FEED-NAME."
+ (when feed-name
+ (if (newsticker--treeview-virtual-feed-p feed-name)
+ (newsticker--treeview-list-items-v feed-name)
+ (mapc (lambda (item)
+ (if (eq (newsticker--age item) 'feed)
+ (newsticker--treeview-item-show item (intern feed-name))
+ (newsticker--treeview-list-add-item item
+ (intern feed-name))))
+ (newsticker--treeview-list-sort-items
+ (cdr (newsticker--cache-get-feed (intern feed-name)))))
+ (newsticker--treeview-list-update nil))))
+
+(defun newsticker--treeview-list-feed-items (widget changed-widget
+ &optional event)
+ "Callback function for listing feed items.
+Argument WIDGET FIXME.
+Argument CHANGED-WIDGET FIXME.
+Optional argument EVENT FIXME."
+ (newsticker--treeview-list-clear)
+ (widget-put widget :nt-selected t)
+ (let ((feed-name (widget-get widget :nt-feed))
+ (vfeed-name (widget-get widget :nt-vfeed)))
+ (if feed-name
+ (newsticker--treeview-list-items feed-name)
+ (newsticker--treeview-list-items-v vfeed-name))))
+
+(defun newsticker--treeview-list-compare-item-by-age (item1 item2)
+ "Compare two news items ITEM1 and ITEM2 wrt age."
+ (catch 'result
+ (let ((age1 (newsticker--age item1))
+ (age2 (newsticker--age item2)))
+ (cond ((eq age1 'new)
+ t)
+ ((eq age1 'immortal)
+ (cond ((eq age2 'new)
+ t)
+ ((eq age2 'immortal)
+ t)
+ (t
+ nil)))
+ ((eq age1 'old)
+ (cond ((eq age2 'new)
+ nil)
+ ((eq age2 'immortal)
+ nil)
+ ((eq age2 'old)
+ nil)
+ (t
+ t)))
+ (t
+ nil)))))
+
+(defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
+ "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
+ (newsticker--treeview-list-compare-item-by-age item2 item1))
+
+(defun newsticker--treeview-list-compare-item-by-time (item1 item2)
+ "Compare two news items ITEM1 and ITEM2 wrt time values."
+ (newsticker--cache-item-compare-by-time item1 item2))
+
+(defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
+ "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
+ (newsticker--cache-item-compare-by-time item2 item1))
+
+(defun newsticker--treeview-list-compare-item-by-title (item1 item2)
+ "Compare two news items ITEM1 and ITEM2 wrt title."
+ (newsticker--cache-item-compare-by-title item1 item2))
+
+(defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
+ "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
+ (newsticker--cache-item-compare-by-title item2 item1))
+
+(defun newsticker--treeview-list-sort-items (items)
+ "Return sorted copy of list ITEMS.
+The sort function is chosen according to the value of
+`newsticker--treeview-list-sort-order'."
+ (let ((sort-fun
+ (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
+ 'newsticker--treeview-list-compare-item-by-age)
+ ((eq newsticker--treeview-list-sort-order
+ 'sort-by-age-reverse)
+ 'newsticker--treeview-list-compare-item-by-age-reverse)
+ ((eq newsticker--treeview-list-sort-order 'sort-by-time)
+ 'newsticker--treeview-list-compare-item-by-time)
+ ((eq newsticker--treeview-list-sort-order
+ 'sort-by-time-reverse)
+ 'newsticker--treeview-list-compare-item-by-time-reverse)
+ ((eq newsticker--treeview-list-sort-order 'sort-by-title)
+ 'newsticker--treeview-list-compare-item-by-title)
+ ((eq newsticker--treeview-list-sort-order
+ 'sort-by-title-reverse)
+ 'newsticker--treeview-list-compare-item-by-title-reverse)
+ (t
+ 'newsticker--treeview-list-compare-item-by-title))))
+ (sort (copy-sequence items) sort-fun)))
+
+(defun newsticker--treeview-list-update-faces ()
+ "Update faces in the treeview list buffer."
+ (let (pos-sel)
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((pos (save-excursion (end-of-line) (point)))
+ (item (get-text-property (point) :nt-item))
+ (age (newsticker--age item))
+ (selected (get-text-property (point) :nt-selected))
+ (face (cond ((eq age 'new)
+ 'newsticker-treeview-new-face)
+ ((eq age 'old)
+ 'newsticker-treeview-old-face)
+ ((eq age 'immortal)
+ 'newsticker-treeview-immortal-face)
+ ((eq age 'obsolete)
+ 'newsticker-treeview-obsolete-face)
+ (t
+ 'bold))))
+ (put-text-property (point) pos 'face face)
+ (if selected
+ (move-overlay newsticker--selection-overlay (point)
+ (1+ pos) ;include newline
+ (current-buffer)))
+ (if selected (setq pos-sel (point)))
+ (forward-line 1)
+ (beginning-of-line))))) ;; FIXME!?
+ (when pos-sel
+ (set-window-point (newsticker--treeview-list-window) pos-sel))))
+
+(defun newsticker--treeview-list-clear-highlight ()
+ "Clear the highlight in the treeview list buffer."
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (let ((inhibit-read-only t))
+ (put-text-property (point-min) (point-max) :nt-selected nil))
+ (newsticker--treeview-list-update-faces)))
+
+(defun newsticker--treeview-list-update-highlight ()
+ "Update the highlight in the treeview list buffer."
+ (newsticker--treeview-list-clear-highlight)
+ (let (pos num-lines)
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (let ((inhibit-read-only t))
+ (put-text-property (save-excursion (beginning-of-line) (point))
+ (save-excursion (end-of-line) (point))
+ :nt-selected t))
+ (newsticker--treeview-list-update-faces))))
+
+(defun newsticker--treeview-list-highlight-start ()
+ "Return position of selection in treeview list buffer."
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (goto-char (point-min))
+ (next-single-property-change (point) :nt-selected)))
+
+(defun newsticker--treeview-list-update (clear-buffer)
+ "Update the faces and highlight in the treeview list buffer.
+If CLEAR-BUFFER is non-nil the list buffer is completely erased."
+ (save-excursion
+ (set-window-buffer (newsticker--treeview-list-window)
+ (newsticker--treeview-list-buffer))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-list-window) t))
+ (set-buffer (newsticker--treeview-list-buffer))
+ (if clear-buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer)))
+ (newsticker-treeview-list-mode)
+ (newsticker--treeview-list-update-faces)
+ (goto-char (point-min))))
+
+;;(makunbound 'newsticker-treeview-list-sort-button-map);; FIXME
+(defvar newsticker-treeview-list-sort-button-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [header-line mouse-1]
+ 'newsticker--treeview-list-sort-by-column)
+ (define-key map [header-line mouse-2]
+ 'newsticker--treeview-list-sort-by-column)
+ map)
+ "Local keymap for newsticker treeview list window sort buttons.")
+
+(defun newsticker--treeview-list-sort-by-column (&optional e)
+ "Sort the newsticker list window buffer by the column clicked on.
+Optional argument E FIXME."
+ (interactive (list last-input-event))
+ (if e (mouse-select-window e))
+ (let* ((pos (event-start e))
+ (obj (posn-object pos))
+ (sort-order (if obj
+ (get-text-property (cdr obj) 'sort-order (car obj))
+ (get-text-property (posn-point pos) 'sort-order))))
+ (setq newsticker--treeview-list-sort-order
+ (cond ((eq sort-order 'sort-by-age)
+ (if (eq newsticker--treeview-list-sort-order 'sort-by-age)
+ 'sort-by-age-reverse
+ 'sort-by-age))
+ ((eq sort-order 'sort-by-time)
+ (if (eq newsticker--treeview-list-sort-order 'sort-by-time)
+ 'sort-by-time-reverse
+ 'sort-by-time))
+ ((eq sort-order 'sort-by-title)
+ (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
+ 'sort-by-title-reverse
+ 'sort-by-title))))
+ (newsticker-treeview-update)))
+
+(defun newsticker-treeview-list-make-sort-button (name sort-order)
+ "Create propertized string for headerline button.
+NAME is the button text, SORT-ORDER is the associated sort order
+for the button."
+ (let ((face (if (string-match (symbol-name sort-order)
+ (symbol-name
+ newsticker--treeview-list-sort-order))
+ 'bold
+ 'header-line)))
+ (propertize name
+ 'sort-order sort-order
+ 'help-echo (concat "Sort by " name)
+ 'mouse-face 'highlight
+ 'face face
+ 'keymap newsticker-treeview-list-sort-button-map)))
+
+;; ======================================================================
+;;; item window
+;; ======================================================================
+(defun newsticker--treeview-item-show-text (title description)
+ "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
+ (save-excursion
+ (set-buffer (newsticker--treeview-item-buffer))
+ (when (fboundp 'w3m-process-stop)
+ (w3m-process-stop (current-buffer)))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (kill-all-local-variables)
+ (remove-overlays)
+ (insert title)
+ (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
+ (insert "\n\n" description)
+ (when newsticker-justification
+ (fill-region (point-min) (point-max) newsticker-justification))
+ (newsticker-treeview-mode)
+ (goto-char (point-min)))))
+
+(defun newsticker--treeview-item-show (item feed)
+ "Show news ITEM coming from FEED in treeview item buffer."
+ (save-excursion
+ (set-buffer (newsticker--treeview-item-buffer))
+ (when (fboundp 'w3m-process-stop)
+ (w3m-process-stop (current-buffer)))
+ (let ((inhibit-read-only t)
+ (is-rendered-HTML nil)
+ pos
+ (marker1 (make-marker))
+ (marker2 (make-marker)))
+ (erase-buffer)
+ (kill-all-local-variables)
+ (remove-overlays)
+
+ (when (and item feed)
+ (let ((wwidth (1- (window-width (newsticker--treeview-item-window)))))
+ (if newsticker-use-full-width
+ (set (make-local-variable 'fill-column) wwidth))
+ (set (make-local-variable 'fill-column) (min fill-column
+ wwidth)))
+ (let ((desc (newsticker--desc item)))
+ (insert "\n" (or desc "[No Description]")))
+ (set-marker marker1 (1+ (point-min)))
+ (set-marker marker2 (point-max))
+ (setq is-rendered-HTML (newsticker--treeview-render-text marker1
+ marker2))
+ (when (and newsticker-justification
+ (not is-rendered-HTML))
+ (fill-region marker1 marker2 newsticker-justification))
+
+ (newsticker-treeview-mode)
+ (goto-char (point-min))
+ ;; insert logo at top
+ (let* ((newsticker-enable-logo-manipulations nil)
+ (img (newsticker--image-read feed nil)))
+ (if (and (display-images-p) img)
+ (newsticker--insert-image img (car item))
+ (insert (newsticker--real-feed-name feed))))
+ (add-text-properties (point-min) (point)
+ (list 'face 'newsticker-feed-face
+ 'mouse-face 'highlight
+ 'help-echo "Visit in web browser."
+ :nt-link (newsticker--link item)
+ 'keymap newsticker--treeview-url-keymap))
+ (setq pos (point))
+
+ (insert "\n\n")
+ ;; insert title
+ (setq pos (point))
+ (insert (newsticker--title item) "\n")
+ (set-marker marker1 pos)
+ (set-marker marker2 (point))
+ (newsticker--treeview-render-text marker1 marker2)
+ (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
+ (goto-char marker2)
+ (delete-char -1)
+ (insert "\n")
+ (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
+ (set-marker marker2 (point))
+ (when newsticker-justification
+ (fill-region marker1 marker2 newsticker-justification))
+ (goto-char marker2)
+ (add-text-properties marker1 (1- (point))
+ (list 'mouse-face 'highlight
+ 'help-echo "Visit in web browser."
+ :nt-link (newsticker--link item)
+ 'keymap newsticker--treeview-url-keymap))
+ (insert (format-time-string newsticker-date-format
+ (newsticker--time item)))
+ (insert "\n")
+ (setq pos (point))
+ (insert "\n")
+ ;; insert enclosures and rest at bottom
+ (goto-char (point-max))
+ (insert "\n\n")
+ (setq pos (point))
+ (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
+ (put-text-property pos (point) 'face 'newsticker-enclosure-face)
+ (setq pos (point))
+ (insert "\n")
+ (newsticker--print-extra-elements item newsticker--treeview-url-keymap)
+ (put-text-property pos (point) 'face 'newsticker-extra-face)
+ (goto-char (point-min)))))
+ (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
+ item
+ (memq (newsticker--age item) '(new obsolete)))
+ (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
+ (newsticker-treeview-mark-item-old t)
+ (newsticker--treeview-list-update-faces)))
+ (set-window-point (newsticker--treeview-item-window) 1))
+
+(defun newsticker--treeview-item-update ()
+ "Update the treeview item buffer and window."
+ (save-excursion
+ (set-window-buffer (newsticker--treeview-item-window)
+ (newsticker--treeview-item-buffer))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-item-window) t))
+ (set-buffer (newsticker--treeview-item-buffer))
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (newsticker-treeview-mode)))
+
+;; ======================================================================
+;;; Tree window
+;; ======================================================================
+(defun newsticker--treeview-tree-expand (tree)
+ "Expand TREE.
+Callback function for tree widget that adds nodes for feeds and subgroups."
+ (newsticker--group-manage-orphan-feeds)
+ (tree-widget-set-theme "folder")
+ (let ((group (widget-get tree :nt-group))
+ (i 0)
+ (nt-id ""))
+ (mapcar (lambda (g)
+ (setq nt-id (newsticker--treeview-get-id tree i))
+ (setq i (1+ i))
+ (if (listp g)
+ (let* ((g-name (car g)))
+ `(tree-widget
+ :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
+ :expander newsticker--treeview-tree-expand
+ :expander-p (lambda (&rest ignore) t)
+ :nt-group ,(cdr g)
+ :nt-feed ,g-name
+ :nt-id ,nt-id
+ :keep (:nt-feed :num-new :nt-id :open);; :nt-group
+ :open nil))
+ (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
+ `(item :tag ,tag
+ :leaf-icon newsticker--tree-widget-leaf-icon
+ :nt-feed ,g
+ :action newsticker--treeview-list-feed-items
+ :nt-id ,nt-id
+ :keep (:nt-id)
+ :open t))))
+ group)))
+
+(defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
+ event)
+ "Expand the vfeed TREE.
+Optional arguments CHANGED-WIDGET and EVENT are ignored."
+ (tree-widget-set-theme "folder")
+ (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
+ :nt-vfeed "new"
+ :action newsticker--treeview-list-new-items
+ :nt-id ,(newsticker--treeview-get-id tree 0)
+ :keep (:nt-id))
+ `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
+ :nt-vfeed "immortal"
+ :action newsticker--treeview-list-immortal-items
+ :nt-id ,(newsticker--treeview-get-id tree 1)
+ :keep (:nt-id))
+ `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
+ :nt-vfeed "obsolete"
+ :action newsticker--treeview-list-obsolete-items
+ :nt-id ,(newsticker--treeview-get-id tree 2)
+ :keep (:nt-id))
+ `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
+ :nt-vfeed "all"
+ :action newsticker--treeview-list-all-items
+ :nt-id ,(newsticker--treeview-get-id tree 3)
+ :keep (:nt-id))))
+
+(defun newsticker--treeview-virtual-feed-p (feed-name)
+ "Return non-nil if FEED-NAME is a virtual feed."
+ (string-match "\\*.*\\*" feed-name))
+
+(define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
+ "Icon for a tree-widget leaf node."
+ :tag "O"
+ :glyph-name "leaf"
+ :button-face 'default)
+
+(defun newsticker--treeview-tree-update ()
+ "Update treeview tree buffer and window."
+ (save-excursion
+ (set-window-buffer (newsticker--treeview-tree-window)
+ (newsticker--treeview-tree-buffer))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-tree-window) t))
+ (set-buffer (newsticker--treeview-tree-buffer))
+ (kill-all-local-variables)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (tree-widget-set-theme "folder")
+ (setq newsticker--treeview-feed-tree
+ (widget-create 'tree-widget
+ :tag (newsticker--treeview-propertize-tag
+ "Feeds" 0 "feeds")
+ :expander 'newsticker--treeview-tree-expand
+ :expander-p (lambda (&rest ignore) t)
+ :leaf-icon 'newsticker--tree-widget-leaf-icon
+ :nt-group (cdr newsticker-groups)
+ :nt-id "feeds"
+ :keep '(:nt-id)
+ :open t))
+ (setq newsticker--treeview-vfeed-tree
+ (widget-create 'tree-widget
+ :tag (newsticker--treeview-propertize-tag
+ "Virtual Feeds" 0 "vfeeds")
+ :expander 'newsticker--treeview-tree-expand-status
+ :expander-p (lambda (&rest ignore) t)
+ :leaf-icon 'newsticker--tree-widget-leaf-icon
+ :nt-id "vfeeds"
+ :keep '(:nt-id)
+ :open t))
+ (use-local-map widget-keymap)
+ (widget-setup))
+ (newsticker-treeview-mode)))
+
+(defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
+ vfeed)
+ "Return propertized copy of string TAG.
+Optional argument NUM-NEW is used for choosing face, other
+arguments NT-ID, FEED, and VFEED are added as properties."
+ ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
+ (let ((face 'newsticker-treeview-face)
+ (map (make-sparse-keymap)))
+ (if (and num-new (> num-new 0))
+ (setq face 'newsticker-treeview-new-face))
+ (define-key map [mouse-1] 'newsticker-treeview-tree-click)
+ (define-key map "\n" 'newsticker-treeview-tree-do-click)
+ (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
+ (propertize tag 'face face 'keymap map
+ :nt-id nt-id
+ :nt-feed feed
+ :nt-vfeed vfeed
+ 'help-echo "Clickme!"
+ 'mouse-face 'highlight)))
+
+(defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
+ &optional nt-id)
+ "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
+Optional argument NT-ID is added to the tag's properties."
+ (let (tag (num-new 0))
+ (cond (vfeed-name
+ (cond ((string= vfeed-name "new")
+ (setq num-new (newsticker--stat-num-items-total 'new))
+ (setq tag (format "New items (%d)" num-new)))
+ ((string= vfeed-name "immortal")
+ (setq num-new (newsticker--stat-num-items-total 'immortal))
+ (setq tag (format "Immortal items (%d)" num-new)))
+ ((string= vfeed-name "obsolete")
+ (setq num-new (newsticker--stat-num-items-total 'obsolete))
+ (setq tag (format "Obsolete items (%d)" num-new)))
+ ((string= vfeed-name "all")
+ (setq num-new (newsticker--stat-num-items-total))
+ (setq tag (format "All items (%d)" num-new)))))
+ (feed-name
+ (setq num-new (newsticker--stat-num-items-for-group
+ (intern feed-name) 'new 'immortal))
+ (setq tag
+ (format "%s (%d)"
+ (newsticker--real-feed-name (intern feed-name))
+ num-new))))
+ (if tag
+ (newsticker--treeview-propertize-tag tag num-new
+ nt-id
+ feed-name vfeed-name))))
+
+(defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
+ "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
+ ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
+ (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
+ (mapc (lambda (f-n)
+ (setq result (+ result
+ (apply 'newsticker--stat-num-items (intern f-n)
+ ages))))
+ (newsticker--group-get-feeds
+ (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
+ result))
+
+(defun newsticker--treeview-count-node-items (feed &optional isvirtual)
+ "Count number of relevant items for a treeview node.
+FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
+the feed is a virtual feed."
+ (let* ((num-new 0))
+ (if feed
+ (if isvirtual
+ (cond ((string= feed "new")
+ (setq num-new (newsticker--stat-num-items-total 'new)))
+ ((string= feed "immortal")
+ (setq num-new (newsticker--stat-num-items-total 'immortal)))
+ ((string= feed "obsolete")
+ (setq num-new (newsticker--stat-num-items-total 'obsolete)))
+ ((string= feed "all")
+ (setq num-new (newsticker--stat-num-items-total))))
+ (setq num-new (newsticker--stat-num-items-for-group
+ (intern feed) 'new 'immortal))))
+ num-new))
+
+(defun newsticker--treeview-tree-update-tag (w &optional recursive
+ &rest ignore)
+ "Update tag for tree widget W.
+If RECURSIVE is non-nil recursively update parent widgets as
+well. Argument IGNORE is ignored. Note that this function, if
+called recursively, makes w invalid. You should keep w's nt-id in
+that case."
+ ;;(message "newsticker--treeview-tree-update-tag %s, %s" (widget-get w :tag)
+ ;; (widget-type w))
+ (let* ((parent (widget-get w :parent))
+ (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
+ (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
+ (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
+ (num-new (newsticker--treeview-count-node-items (or feed vfeed)
+ vfeed))
+ (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
+ (n (widget-get w :node)))
+ (if parent
+ (if recursive
+ (newsticker--treeview-tree-update-tag parent)))
+ (when tag
+ (when n
+ (widget-put n :tag tag))
+ (widget-put w :num-new num-new)
+ (widget-put w :tag tag)
+ (when (marker-position (widget-get w :from))
+ (let ((p (point))
+ (notify (widget-get w :notify)))
+ ;; FIXME: This moves point!!!!
+ (save-excursion
+ (set-buffer (newsticker--treeview-tree-buffer))
+ (widget-value-set w (widget-value w)))
+ (goto-char p))))))
+
+(defun newsticker--treeview-tree-do-update-tags (widget)
+ "Actually recursively update tags for WIDGET."
+ (save-excursion
+ (let ((children (widget-get widget :children)))
+ (dolist (w children)
+ (newsticker--treeview-tree-do-update-tags w))
+ (newsticker--treeview-tree-update-tag widget))))
+
+(defun newsticker--treeview-tree-update-tags (&rest ignore)
+ "Update all tags of all trees.
+Arguments IGNORE are ignored."
+ (save-current-buffer
+ (set-buffer (newsticker--treeview-tree-buffer))
+ (let ((inhibit-read-only t))
+ (newsticker--treeview-tree-do-update-tags
+ newsticker--treeview-feed-tree)
+ (newsticker--treeview-tree-do-update-tags
+ newsticker--treeview-vfeed-tree))
+ (tree-widget-set-theme "folder")))
+
+(defun newsticker--treeview-tree-update-highlight ()
+ "Update highlight in tree buffer."
+ (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
+ (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
+ (setq pos (widget-get (widget-get
+ (newsticker--treeview-get-current-node)
+ :parent) :from)))
+ (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
+ (save-excursion
+ (set-buffer (newsticker--treeview-tree-buffer))
+ (goto-char pos)
+ (move-overlay newsticker--tree-selection-overlay
+ (save-excursion (beginning-of-line) (point))
+ (save-excursion (end-of-line) (1+ (point)))
+ (current-buffer)))
+ (set-window-point (newsticker--treeview-tree-window) pos))))
+
+;; ======================================================================
+;;; Toolbar
+;; ======================================================================
+;;(makunbound 'newsticker-treeview-tool-bar-map)
+(defvar newsticker-treeview-tool-bar-map
+ (if (featurep 'xemacs)
+ nil
+ (if (boundp 'tool-bar-map)
+ (let ((tool-bar-map (make-sparse-keymap)))
+ (define-key tool-bar-map [newsticker-sep-1]
+ (list 'menu-item "--double-line"))
+ (define-key tool-bar-map [newsticker-browse-url]
+ (list 'menu-item "newsticker-browse-url"
+ 'newsticker-browse-url
+ :visible t
+ :help "Browse URL for item at point"
+ :image newsticker--browse-image))
+ (define-key tool-bar-map [newsticker-buffer-force-update]
+ (list 'menu-item "newsticker-treeview-update"
+ 'newsticker-treeview-update
+ :visible t
+ :help "Update newsticker buffer"
+ :image newsticker--update-image
+ :enable t))
+ (define-key tool-bar-map [newsticker-get-all-news]
+ (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
+ :visible t
+ :help "Get news for all feeds"
+ :image newsticker--get-all-image))
+ (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
+ (list 'menu-item "newsticker-treeview-mark-item-old"
+ 'newsticker-treeview-mark-item-old
+ :visible t
+ :image newsticker--mark-read-image
+ :help "Mark current item as read"
+ ;;:enable '(newsticker-item-not-old-p) FIXME
+ ))
+ (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
+ (list 'menu-item "newsticker-treeview-toggle-item-immortal"
+ 'newsticker-treeview-toggle-item-immortal
+ :visible t
+ :image newsticker--mark-immortal-image
+ :help "Toggle current item as immortal"
+ :enable t
+ ;;'(newsticker-item-not-immortal-p) FIXME
+ ))
+ (define-key tool-bar-map [newsticker-next-feed]
+ (list 'menu-item "newsticker-treeview-next-feed"
+ 'newsticker-treeview-next-feed
+ :visible t
+ :help "Go to next feed"
+ :image newsticker--next-feed-image
+ :enable t
+ ;;'(newsticker-next-feed-available-p) FIXME
+ ))
+ (define-key tool-bar-map [newsticker-treeview-next-item]
+ (list 'menu-item "newsticker-treeview-next-item"
+ 'newsticker-treeview-next-item
+ :visible t
+ :help "Go to next item"
+ :image newsticker--next-item-image
+ :enable t
+ ;;'(newsticker-next-item-available-p) FIXME
+ ))
+ (define-key tool-bar-map [newsticker-treeview-prev-item]
+ (list 'menu-item "newsticker-treeview-prev-item"
+ 'newsticker-treeview-prev-item
+ :visible t
+ :help "Go to previous item"
+ :image newsticker--previous-item-image
+ :enable t
+ ;;'(newsticker-previous-item-available-p) FIXME
+ ))
+ (define-key tool-bar-map [newsticker-treeview-prev-feed]
+ (list 'menu-item "newsticker-treeview-prev-feed"
+ 'newsticker-treeview-prev-feed
+ :visible t
+ :help "Go to previous feed"
+ :image newsticker--previous-feed-image
+ :enable t
+ ;;'(newsticker-previous-feed-available-p) FIXME
+ ))
+ ;; standard icons / actions
+ (tool-bar-add-item "close"
+ 'newsticker-treeview-quit
+ 'newsticker-treeview-quit
+ :help "Close newsticker")
+ (tool-bar-add-item "preferences"
+ 'newsticker-customize
+ 'newsticker-customize
+ :help "Customize newsticker")
+ tool-bar-map))))
+
+;; ======================================================================
+;;; actions
+;; ======================================================================
+
+(defun newsticker-treeview-mouse-browse-url (event)
+ "Call `browse-url' for the link of the item at which the EVENT occurred."
+ (interactive "e")
+ (save-excursion
+ (switch-to-buffer (window-buffer (posn-window (event-end event))))
+ (let ((url (get-text-property (posn-point (event-end event))
+ :nt-link)))
+ (when url
+ (browse-url url)
+ (if newsticker-automatically-mark-visited-items-as-old
+ (newsticker-treeview-mark-item-old))))))
+
+(defun newsticker-treeview-browse-url ()
+ "Call `browse-url' for the link of the item at point."
+ (interactive)
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (let ((url (get-text-property (point) :nt-link)))
+ (when url
+ (browse-url url)
+ (if newsticker-automatically-mark-visited-items-as-old
+ (newsticker-treeview-mark-item-old))))))
+
+(defun newsticker--treeview-buffer-init ()
+ "Initialize all treeview buffers."
+ (setq newsticker--treeview-buffers nil)
+ (add-to-list 'newsticker--treeview-buffers
+ (get-buffer-create "*Newsticker Tree*") t)
+ (add-to-list 'newsticker--treeview-buffers
+ (get-buffer-create "*Newsticker List*") t)
+ (add-to-list 'newsticker--treeview-buffers
+ (get-buffer-create "*Newsticker Item*") t)
+
+ (unless newsticker--selection-overlay
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (setq newsticker--selection-overlay (make-overlay (point-min)
+ (point-max)))
+ (overlay-put newsticker--selection-overlay 'face
+ 'newsticker-treeview-selection-face)))
+ (unless newsticker--tree-selection-overlay
+ (save-excursion
+ (set-buffer (newsticker--treeview-tree-buffer))
+ (setq newsticker--tree-selection-overlay (make-overlay (point-min)
+ (point-max)))
+ (overlay-put newsticker--tree-selection-overlay 'face
+ 'newsticker-treeview-selection-face)))
+
+ (newsticker--treeview-tree-update)
+ (newsticker--treeview-list-update t)
+ (newsticker--treeview-item-update))
+
+(defun newsticker-treeview-update ()
+ "Update all treeview buffers and windows."
+ (interactive)
+ (newsticker--cache-update)
+ (newsticker--group-manage-orphan-feeds)
+ (newsticker--treeview-list-update t)
+ (newsticker--treeview-item-update)
+ (newsticker--treeview-tree-update-tags)
+ (cond (newsticker--treeview-current-feed
+ (newsticker--treeview-list-items newsticker--treeview-current-feed))
+ (newsticker--treeview-current-vfeed
+ (newsticker--treeview-list-items-with-age
+ (intern newsticker--treeview-current-vfeed))))
+ (newsticker--treeview-tree-update-highlight)
+ (newsticker--treeview-list-update-highlight))
+
+(defun newsticker-treeview-quit ()
+ "Quit newsticker treeview."
+ (interactive)
+ (newsticker-treeview-save)
+ (setq newsticker--sentinel-callback nil)
+ (setq newsticker--window-config (current-window-configuration))
+ (bury-buffer "*Newsticker Tree*")
+ (bury-buffer "*Newsticker List*")
+ (bury-buffer "*Newsticker Item*")
+ (set-window-configuration newsticker--saved-window-config)
+ (when newsticker--frame
+ (if (frame-live-p newsticker--frame)
+ (delete-frame newsticker--frame))
+ (setq newsticker--frame nil)))
+
+(defun newsticker-treeview-save ()
+ "Save newsticker data including treeview settings."
+ (interactive)
+ (newsticker--cache-save)
+ (save-excursion
+ (let ((coding-system-for-write 'utf-8)
+ (buf (find-file-noselect newsticker-groups-filename)))
+ (when buf
+ (set-buffer buf)
+ (setq buffer-undo-list t)
+ (erase-buffer)
+ (insert ";; -*- coding: utf-8 -*-\n")
+ (insert (prin1-to-string newsticker-groups))
+ (save-buffer)))))
+
+(defun newsticker--treeview-load ()
+ "Load treeview settings."
+ (let* ((coding-system-for-read 'utf-8)
+ (buf (and (file-exists-p newsticker-groups-filename)
+ (find-file-noselect newsticker-groups-filename))))
+ (when buf
+ (set-buffer buf)
+ (goto-char (point-min))
+ (condition-case nil
+ (setq newsticker-groups (read buf))
+ (error
+ (message "Error while reading newsticker groups file!")
+ (setq newsticker-groups nil))))))
+
+
+(defun newsticker-treeview-scroll-item ()
+ "Scroll current item."
+ (interactive)
+ (save-selected-window
+ (select-window (newsticker--treeview-item-window) t)
+ (scroll-up 1)))
+
+(defun newsticker-treeview-show-item ()
+ "Show current item."
+ (interactive)
+ (newsticker--treeview-list-update-highlight)
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (beginning-of-line)
+ (let ((item (get-text-property (point) :nt-item))
+ (feed (get-text-property (point) :nt-feed)))
+ (newsticker--treeview-item-show item feed)))
+ (newsticker--treeview-tree-update-tag
+ (newsticker--treeview-get-current-node) t)
+ (newsticker--treeview-tree-update-highlight))
+
+(defun newsticker-treeview-next-item ()
+ "Move to next item."
+ (interactive)
+ (newsticker--treeview-restore-buffers)
+ (save-current-buffer
+ (set-buffer (newsticker--treeview-list-buffer))
+ (if (newsticker--treeview-list-highlight-start)
+ (forward-line 1))
+ (if (eobp)
+ (forward-line -1)))
+ (newsticker-treeview-show-item))
+
+(defun newsticker-treeview-prev-item ()
+ "Move to previous item."
+ (interactive)
+ (newsticker--treeview-restore-buffers)
+ (save-current-buffer
+ (set-buffer (newsticker--treeview-list-buffer))
+ (forward-line -1))
+ (newsticker-treeview-show-item))
+
+(defun newsticker-treeview-next-new-or-immortal-item ()
+ "Move to next new or immortal item."
+ (interactive)
+ (newsticker--treeview-restore-buffers)
+ (newsticker--treeview-list-clear-highlight)
+ (catch 'found
+ (let ((index (newsticker-treeview-next-item)))
+ (while t
+ (save-current-buffer
+ (set-buffer (newsticker--treeview-list-buffer))
+ (forward-line 1)
+ (when (eobp)
+ (forward-line -1)
+ (throw 'found nil)))
+ (when (memq (newsticker--age
+ (newsticker--treeview-get-selected-item)) '(new immortal))
+ (newsticker-treeview-show-item)
+ (throw 'found t))))))
+
+(defun newsticker-treeview-prev-new-or-immortal-item ()
+ "Move to previous new or immortal item."
+ (interactive)
+ (newsticker--treeview-restore-buffers)
+ (newsticker--treeview-list-clear-highlight)
+ (catch 'found
+ (let ((index (newsticker-treeview-next-item)))
+ (while t
+ (save-current-buffer
+ (set-buffer (newsticker--treeview-list-buffer))
+ (forward-line -1)
+ (when (bobp)
+ (throw 'found nil)))
+ (when (memq (newsticker--age
+ (newsticker--treeview-get-selected-item)) '(new immortal))
+ (newsticker-treeview-show-item)
+ (throw 'found t))))))
+
+(defun newsticker--treeview-get-selected-item ()
+ "Return item that is currently selected in list buffer."
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (beginning-of-line)
+ (get-text-property (point) :nt-item)))
+
+(defun newsticker-treeview-mark-item-old (&optional dont-proceed)
+ "Mark current item as old unless it is obsolete.
+Move to next item unless DONT-PROCEED is non-nil."
+ (interactive)
+ (let ((item (newsticker--treeview-get-selected-item)))
+ (unless (eq (newsticker--age item) 'obsolete)
+ (newsticker--treeview-mark-item item 'old)))
+ (unless dont-proceed
+ (newsticker-treeview-next-item)))
+
+(defun newsticker-treeview-toggle-item-immortal ()
+ "Toggle immortality of current item."
+ (interactive)
+ (let* ((item (newsticker--treeview-get-selected-item))
+ (new-age (if (eq (newsticker--age item) 'immortal)
+ 'old
+ 'immortal)))
+ (newsticker--treeview-mark-item item new-age)
+ (newsticker-treeview-next-item)))
+
+(defun newsticker--treeview-mark-item (item new-age)
+ "Mark ITEM with NEW-AGE."
+ (when item
+ (setcar (nthcdr 4 item) new-age)
+ ;; clean up ticker FIXME
+ ))
+
+(defun newsticker-treeview-mark-list-items-old ()
+ "Mark all listed items as old."
+ (interactive)
+ (let ((current-feed (or newsticker--treeview-current-feed
+ newsticker--treeview-current-vfeed)))
+ (save-excursion
+ (set-buffer (newsticker--treeview-list-buffer))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((item (get-text-property (point) :nt-item)))
+ (unless (memq (newsticker--age item) '(immortal obsolete))
+ (newsticker--treeview-mark-item item 'old)))
+ (forward-line 1)))
+ (newsticker--treeview-tree-update-tags)
+ (if current-feed
+ (newsticker-treeview-jump current-feed))))
+
+(defun newsticker-treeview-save-item ()
+ "Save current item."
+ (interactive)
+ (newsticker-save-item (or newsticker--treeview-current-feed
+ newsticker--treeview-current-vfeed)
+ (newsticker--treeview-get-selected-item)))
+
+(defun newsticker--treeview-set-current-node (node)
+ "Make NODE the current node."
+ (save-excursion
+ (set-buffer (newsticker--treeview-tree-buffer))
+ (setq newsticker--treeview-current-node-id
+ (widget-get node :nt-id))
+ (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
+ (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
+ ;;(message "newsticker--treeview-set-current-node %s/%s" (widget-get node :tag)
+ ;; (widget-get node :nt-id))
+ ;; node)
+ (newsticker--treeview-tree-update-highlight)))
+
+(defun newsticker--treeview-get-first-child (node)
+ "Get first child of NODE."
+ (let ((children (widget-get node :children)))
+ (if children
+ (car children)
+ nil)))
+
+(defun newsticker--treeview-get-second-child (node)
+ "Get scond child of NODE."
+ (let ((children (widget-get node :children)))
+ (if children
+ (car (cdr children))
+ nil)))
+
+(defun newsticker--treeview-get-last-child (node)
+ "Get last child of NODE."
+ ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
+ (let ((children (widget-get node :children)))
+ (if children
+ (car (reverse children))
+ nil)))
+
+(defun newsticker--treeview-get-feed-vfeed (node)
+ "Get (virtual) feed of NODE."
+ (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
+
+(defun newsticker--treeview-get-next-sibling (node)
+ "Get next sibling of NODE."
+ (let ((parent (widget-get node :parent)))
+ (catch 'found
+ (let ((children (widget-get parent :children)))
+ (while children
+ (if (newsticker--treeview-nodes-eq (car children) node)
+ (throw 'found (car (cdr children))))
+ (setq children (cdr children)))))))
+
+(defun newsticker--treeview-get-prev-sibling (node)
+ "Get previous sibling of NODE."
+ (let ((parent (widget-get node :parent)))
+ (catch 'found
+ (let ((children (widget-get parent :children))
+ (prev nil))
+ (while children
+ (if (and (newsticker--treeview-nodes-eq (car children) node)
+ (widget-get prev :nt-id))
+ (throw 'found prev))
+ (setq prev (car children))
+ (setq children (cdr children)))))))
+
+(defun newsticker--treeview-get-next-uncle (node)
+ "Get next uncle of NODE, i.e. parent's next sibling."
+ (let* ((parent (widget-get node :parent))
+ (grand-parent (widget-get parent :parent)))
+ (catch 'found
+ (let ((uncles (widget-get grand-parent :children)))
+ (while uncles
+ (if (newsticker--treeview-nodes-eq (car uncles) parent)
+ (throw 'found (car (cdr uncles))))
+ (setq uncles (cdr uncles)))))))
+
+(defun newsticker--treeview-get-prev-uncle (node)
+ "Get previous uncle of NODE, i.e. parent's previous sibling."
+ (let* ((parent (widget-get node :parent))
+ (grand-parent (widget-get parent :parent)))
+ (catch 'found
+ (let ((uncles (widget-get grand-parent :children))
+ (prev nil))
+ (while uncles
+ (if (newsticker--treeview-nodes-eq (car uncles) parent)
+ (throw 'found prev))
+ (setq prev (car uncles))
+ (setq uncles (cdr uncles)))))))
+
+(defun newsticker--treeview-get-other-tree ()
+ "Get other tree."
+ (if (and (newsticker--treeview-get-current-node)
+ (widget-get (newsticker--treeview-get-current-node) :nt-feed))
+ newsticker--treeview-vfeed-tree
+ newsticker--treeview-feed-tree))
+
+(defun newsticker--treeview-activate-node (node &optional backward)
+ "Activate NODE.
+If NODE is a tree widget the node's first subnode is activated.
+If BACKWARD is non-nil the last subnode of the previous sibling
+is activated."
+ (newsticker--treeview-set-current-node node)
+ (save-current-buffer
+ (set-buffer (newsticker--treeview-tree-buffer))
+ (cond ((eq (widget-type node) 'tree-widget)
+ (unless (widget-get node :open)
+ (widget-put node :open nil)
+ (widget-apply-action node))
+ (newsticker--treeview-activate-node
+ (if backward
+ (newsticker--treeview-get-last-child node)
+ (newsticker--treeview-get-second-child node))))
+ (node
+ (widget-apply-action node)))))
+
+(defun newsticker-treeview-next-feed ()
+ "Move to next feed."
+ (interactive)
+ (newsticker--treeview-restore-buffers)
+ (let ((cur (newsticker--treeview-get-current-node)))
+ ;;(message "newsticker-treeview-next-feed from %s"
+ ;; (widget-get cur :tag))
+ (if cur
+ (let ((new (or (newsticker--treeview-get-next-sibling cur)
+ (newsticker--treeview-get-next-uncle cur)
+ (newsticker--treeview-get-other-tree))))
+ (newsticker--treeview-activate-node new))
+ (newsticker--treeview-activate-node
+ (car (widget-get newsticker--treeview-feed-tree :children)))))
+ (newsticker--treeview-tree-update-highlight))
+
+(defun newsticker-treeview-prev-feed ()
+ "Move to previous feed."
+ (interactive)
+ (newsticker--treeview-restore-buffers)
+ (let ((cur (newsticker--treeview-get-current-node)))
+ (message "newsticker-treeview-prev-feed from %s"
+ (widget-get cur :tag))
+ (if cur
+ (let ((new (or (newsticker--treeview-get-prev-sibling cur)
+ (newsticker--treeview-get-prev-uncle cur)
+ (newsticker--treeview-get-other-tree))))
+ (newsticker--treeview-activate-node new t))
+ (newsticker--treeview-activate-node
+ (car (widget-get newsticker--treeview-feed-tree :children)) t)))
+ (newsticker--treeview-tree-update-highlight))
+
+(defun newsticker-treeview-next-page ()
+ "Scroll item buffer."
+ (interactive)
+ (save-selected-window
+ (select-window (newsticker--treeview-item-window) t)
+ (condition-case nil
+ (scroll-up nil)
+ (error
+ (goto-char (point-min))))))
+
+
+(defun newsticker--treeview-unfold-node (feed-name)
+ "Recursively show subtree above the node that represents FEED-NAME."
+ (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
+ (unless node
+ (let* ((group-name (or (car (newsticker--group-find-group-for-feed
+ feed-name))
+ (newsticker--group-get-parent-group
+ feed-name))))
+ (newsticker--treeview-unfold-node group-name))
+ (setq node (newsticker--treeview-get-node-of-feed feed-name)))
+ (when node
+ (save-excursion
+ (set-buffer (newsticker--treeview-tree-buffer))
+ (widget-put node :nt-selected t)
+ (widget-apply-action node)
+ (newsticker--treeview-set-current-node node)))))
+
+(defun newsticker-treeview-jump (feed-name)
+ "Jump to feed FEED-NAME in newsticker treeview."
+ (interactive
+ (list (let ((completion-ignore-case t))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-item-window) nil))
+ (completing-read
+ "Jump to feed: "
+ (mapcar 'car (append newsticker-url-list
+ newsticker-url-list-defaults))
+ nil t))))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-item-window) t))
+ (newsticker--treeview-unfold-node feed-name))
+
+;; ======================================================================
+;;; Groups
+;; ======================================================================
+(defun newsticker--group-do-find-group-for-feed (feed-name node)
+ "Recursively find FEED-NAME in NODE."
+ (if (member feed-name (cdr node))
+ (throw 'found node)
+ (mapc (lambda (n)
+ (if (listp n)
+ (newsticker--group-do-find-group-for-feed feed-name n)))
+ (cdr node))))
+
+(defun newsticker--group-find-group-for-feed (feed-name)
+ "Find group containing FEED-NAME."
+ (catch 'found
+ (newsticker--group-do-find-group-for-feed feed-name
+ newsticker-groups)
+ nil))
+
+(defun newsticker--group-do-get-group (name node)
+ "Recursively find group with NAME below NODE."
+ (if (string= name (car node))
+ (throw 'found node)
+ (mapc (lambda (n)
+ (if (listp n)
+ (newsticker--group-do-get-group name n)))
+ (cdr node))))
+
+(defun newsticker--group-get-group (name)
+ "Find group with NAME."
+ (catch 'found
+ (mapc (lambda (n)
+ (if (listp n)
+ (newsticker--group-do-get-group name n)))
+ newsticker-groups)
+ nil))
+
+(defun newsticker--group-do-get-parent-group (name node parent)
+ "Recursively find parent group for NAME from NODE which is a child of PARENT."
+ (if (string= name (car node))
+ (throw 'found parent)
+ (mapc (lambda (n)
+ (if (listp n)
+ (newsticker--group-do-get-parent-group name n (car node))))
+ (cdr node))))
+
+(defun newsticker--group-get-parent-group (name)
+ "Find parent group for group named NAME."
+ (catch 'found
+ (mapc (lambda (n)
+ (if (listp n)
+ (newsticker--group-do-get-parent-group
+ name n (car newsticker-groups))))
+ newsticker-groups)
+ nil))
+
+
+(defun newsticker--group-get-subgroups (group &optional recursive)
+ "Return list of subgroups for GROUP.
+If RECURSIVE is non-nil recursively get subgroups and return a nested list."
+ (let ((result nil))
+ (mapc (lambda (n)
+ (when (listp n)
+ (setq result (cons (car n) result))
+ (let ((subgroups (newsticker--group-get-subgroups n recursive)))
+ (when subgroups
+ (setq result (append subgroups result))))))
+ group)
+ result))
+
+(defun newsticker--group-all-groups ()
+ "Return nested list of all groups."
+ (newsticker--group-get-subgroups newsticker-groups t))
+
+(defun newsticker--group-get-feeds (group &optional recursive)
+ "Return list of all feeds in GROUP.
+If RECURSIVE is non-nil recursively get feeds of subgroups and
+return a nested list."
+ (let ((result nil))
+ (mapc (lambda (n)
+ (if (not (listp n))
+ (setq result (cons n result))
+ (if recursive
+ (let ((subfeeds (newsticker--group-get-feeds n t)))
+ (when subfeeds
+ (setq result (append subfeeds result)))))))
+ group)
+ result))
+
+(defun newsticker-group-add-group (name parent)
+ "Add group NAME to group PARENT."
+ (interactive
+ (list (read-string "Group Name: ")
+ (let ((completion-ignore-case t))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-item-window) nil))
+ (completing-read "Parent Group: " (newsticker--group-all-groups)
+ nil t))))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-item-window) t))
+ (if (newsticker--group-get-group name)
+ (error "Group %s exists already" name))
+ (let ((p (if (and parent (not (string= parent "")))
+ (newsticker--group-get-group parent)
+ newsticker-groups)))
+ (unless p
+ (error "Parent %s does not exist" parent))
+ (setcdr p (cons (list name) (cdr p))))
+ (newsticker--treeview-tree-update))
+
+(defun newsticker-group-move-feed (name group-name &optional no-update)
+ "Move feed NAME to group GROUP-NAME.
+Update teeview afterwards unless NO-UPDATE is non-nil."
+ (interactive
+ (let ((completion-ignore-case t))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-item-window) nil))
+ (list (completing-read "Feed Name: "
+ (mapcar 'car newsticker-url-list)
+ nil t newsticker--treeview-current-feed)
+ (completing-read "Group Name: " (newsticker--group-all-groups)
+ nil t))))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-item-window) t))
+ (let ((group (if (and group-name (not (string= group-name "")))
+ (newsticker--group-get-group group-name)
+ newsticker-groups)))
+ (unless group
+ (error "Group %s does not exist" group-name))
+ (while (let ((old-group
+ (newsticker--group-find-group-for-feed name)))
+ (when old-group
+ (delete name old-group))
+ old-group))
+ (setcdr group (cons name (cdr group)))
+ (unless no-update
+ (newsticker--treeview-tree-update)
+ (newsticker-treeview-update))))
+
+(defun newsticker-group-delete-group (name)
+ "Remove group NAME."
+ (interactive
+ (let ((completion-ignore-case t))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-item-window) nil))
+ (list (completing-read "Group Name: " (newsticker--group-all-groups)
+ nil t))))
+ (if newsticker-treeview-own-frame
+ (set-window-dedicated-p (newsticker--treeview-item-window) t))
+ (let* ((g (newsticker--group-get-group name))
+ (p (or (newsticker--group-get-parent-group name)
+ newsticker-groups)))
+ (unless g
+ (error "Group %s does not exist" name))
+ (delete g p))
+ (newsticker--treeview-tree-update))
+
+(defun newsticker--count-groups (group)
+ "Recursively count number of subgroups of GROUP."
+ (let ((result 1))
+ (mapc (lambda (g)
+ (if (listp g)
+ (setq result (+ result (newsticker--count-groups g)))))
+ (cdr group))
+ result))
+
+(defun newsticker--count-grouped-feeds (group)
+ "Recursively count number of feeds in GROUP and its subgroups."
+ (let ((result 0))
+ (mapc (lambda (g)
+ (if (listp g)
+ (setq result (+ result (newsticker--count-grouped-feeds g)))
+ (setq result (1+ result))))
+ (cdr group))
+ result))
+
+(defun newsticker--group-remove-obsolete-feeds (group)
+ "Recursively remove obselete feeds from GROUP."
+ (let ((result nil)
+ (urls (append newsticker-url-list newsticker-url-list-defaults)))
+ (mapc (lambda (g)
+ (if (listp g)
+ (let ((sub-groups
+ (newsticker--group-remove-obsolete-feeds g)))
+ (if sub-groups
+ (setq result (cons sub-groups result))))
+ (if (assoc g urls)
+ (setq result (cons g result)))))
+ (cdr group))
+ (if result
+ (cons (car group) (reverse result))
+ result)))
+
+(defun newsticker--group-manage-orphan-feeds ()
+ "Put unmanaged feeds into `newsticker-groups'.
+Remove obsolete feeds as well."
+ (let ((new-feed nil)
+ (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
+ (mapc (lambda (f)
+ (unless (newsticker--group-find-group-for-feed (car f))
+ (setq new-feed t)
+ (newsticker-group-move-feed (car f) nil t)))
+ (append newsticker-url-list-defaults newsticker-url-list))
+ (setq newsticker-groups
+ (newsticker--group-remove-obsolete-feeds newsticker-groups))
+ (if (or new-feed
+ (not (= grouped-feeds
+ (newsticker--count-grouped-feeds newsticker-groups))))
+ (newsticker--treeview-tree-update))))
+
+;; ======================================================================
+;;; Modes
+;; ======================================================================
+(defun newsticker--treeview-create-groups-menu (group-list
+ excluded-group)
+ "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
+ (let ((menu (make-sparse-keymap (if (stringp (car group-list))
+ (car group-list)
+ "Move to group..."))))
+ (mapc (lambda (g)
+ (when (listp g)
+ (let ((title (if (stringp (car g))
+ (car g)
+ "Move to group...")))
+ (unless (eq g excluded-group)
+ (define-key menu (vector (intern title))
+ (list 'menu-item title
+ (newsticker--treeview-create-groups-menu
+ (cdr g) excluded-group)))))))
+ (reverse group-list))
+ menu))
+
+(defun newsticker--treeview-create-tree-menu (feed-name)
+ "Create tree menu for FEED-NAME."
+ (let ((menu (make-sparse-keymap feed-name)))
+ (define-key menu [newsticker-treeview-mark-list-items-old]
+ (list 'menu-item "Mark all items old"
+ 'newsticker-treeview-mark-list-items-old))
+ (define-key menu [move]
+ (list 'menu-item "Move to group..."
+ (newsticker--treeview-create-groups-menu
+ newsticker-groups
+ (newsticker--group-get-group feed-name))))
+ menu))
+
+;;(makunbound 'newsticker-treeview-list-menu) ;FIXME
+(defvar newsticker-treeview-list-menu
+ (let ((menu (make-sparse-keymap "Newsticker List")))
+ (define-key menu [newsticker-treeview-mark-list-items-old]
+ (list 'menu-item "Mark all items old"
+ 'newsticker-treeview-mark-list-items-old))
+ menu)
+ "Map for newsticker tree menu.")
+
+;;(makunbound 'newsticker-treeview-mode-map) ;FIXME
+(defvar newsticker-treeview-mode-map
+ (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
+ (define-key map " " 'newsticker-treeview-next-page)
+ (define-key map "a" 'newsticker-add-url)
+ (define-key map "F" 'newsticker-treeview-prev-feed)
+ (define-key map "f" 'newsticker-treeview-next-feed)
+ (define-key map "g" 'newsticker-treeview-get-news)
+ (define-key map "G" 'newsticker-get-all-news)
+ (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
+ (define-key map "j" 'newsticker-treeview-jump)
+ (define-key map "n" 'newsticker-treeview-next-item)
+ (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
+ (define-key map "O" 'newsticker-treeview-mark-list-items-old)
+ (define-key map "o" 'newsticker-treeview-mark-item-old)
+ (define-key map "p" 'newsticker-treeview-prev-item)
+ (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
+ (define-key map "q" 'newsticker-treeview-quit)
+ (define-key map "S" 'newsticker-treeview-save-item)
+ (define-key map "s" 'newsticker-treeview-save)
+ (define-key map "u" 'newsticker-treeview-update)
+ (define-key map "v" 'newsticker-treeview-browse-url)
+ ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
+ ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
+ (define-key map "\M-m" 'newsticker-group-move-feed)
+ (define-key map "\M-a" 'newsticker-group-add-group)
+ map)
+ "Mode map for newsticker treeview.")
+
+(defun newsticker-treeview-mode ()
+ "Major mode for Newsticker Treeview.
+\\{newsticker-treeview-mode-map}"
+ (kill-all-local-variables)
+ (use-local-map newsticker-treeview-mode-map)
+ (setq major-mode 'newsticker-treeview-mode)
+ (setq mode-name "Newsticker TV")
+ (if (boundp 'tool-bar-map)
+ (set (make-local-variable 'tool-bar-map)
+ newsticker-treeview-tool-bar-map))
+ (setq buffer-read-only t
+ truncate-lines t))
+
+;;(makunbound 'newsticker-treeview-list-mode-map);FIXME
+(define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
+ "Item List"
+ (let ((header (concat
+ (propertize " " 'display '(space :align-to 0))
+ (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
+ (propertize " " 'display '(space :align-to 2))
+ (if newsticker--treeview-list-show-feed
+ (concat "Feed"
+ (propertize " " 'display '(space :align-to 12)))
+ "")
+ (newsticker-treeview-list-make-sort-button "Date"
+ 'sort-by-time)
+ (if newsticker--treeview-list-show-feed
+ (propertize " " 'display '(space :align-to 28))
+ (propertize " " 'display '(space :align-to 18)))
+ (newsticker-treeview-list-make-sort-button "Title"
+ 'sort-by-title))))
+ (setq header-line-format header))
+ (define-key newsticker-treeview-list-mode-map [down-mouse-3]
+ newsticker-treeview-list-menu))
+
+(defun newsticker-treeview-tree-click (event)
+ "Handle click EVENT on a tag in the newsticker tree."
+ (interactive "e")
+ (save-excursion
+ (switch-to-buffer (window-buffer (posn-window (event-end event))))
+ (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
+
+(defun newsticker-treeview-tree-do-click (&optional pos event)
+ "Actually handle click event.
+POS gives the position where EVENT occurred."
+ (interactive)
+ (unless pos (setq pos (point)))
+ (let ((pos (or pos (point)))
+ (nt-id (get-text-property pos :nt-id))
+ (item (get-text-property pos :nt-item)))
+ (cond (item
+ ;; click in list buffer
+ (newsticker-treeview-show-item))
+ (t
+ ;; click in tree buffer
+ (let ((w (newsticker--treeview-get-node nt-id)))
+ (when w
+ (newsticker--treeview-tree-update-tag w t t)
+ (setq w (newsticker--treeview-get-node nt-id))
+ (widget-put w :nt-selected t)
+ (widget-apply w :action event)
+ (newsticker--treeview-set-current-node w))))))
+ (newsticker--treeview-tree-update-highlight))
+
+(defun newsticker--treeview-restore-buffers ()
+ "Restore treeview buffers."
+ (catch 'error
+ (dotimes (i 3)
+ (let ((win (nth i newsticker--treeview-windows))
+ (buf (nth i newsticker--treeview-buffers)))
+ (unless (window-live-p win)
+ (newsticker--treeview-window-init)
+ (newsticker--treeview-buffer-init)
+ (throw 'error t))
+ (unless (eq (window-buffer win) buf)
+ (set-window-buffer win buf t))))))
+
+(defun newsticker--treeview-frame-init ()
+ "Initialize treeview frame."
+ (when newsticker-treeview-own-frame
+ (unless (and newsticker--frame (frame-live-p newsticker--frame))
+ (setq newsticker--frame (make-frame '((name . "Newsticker")))))
+ (select-frame-set-input-focus newsticker--frame)
+ (raise-frame newsticker--frame)))
+
+(defun newsticker--treeview-window-init ()
+ "Initialize treeview windows."
+ (setq newsticker--saved-window-config (current-window-configuration))
+ (setq newsticker--treeview-windows nil)
+ (setq newsticker--treeview-buffers nil)
+ (delete-other-windows)
+ (split-window-horizontally 25)
+ (add-to-list 'newsticker--treeview-windows (selected-window) t)
+ (other-window 1)
+ (split-window-vertically 10)
+ (add-to-list 'newsticker--treeview-windows (selected-window) t)
+ (other-window 1)
+ (add-to-list 'newsticker--treeview-windows (selected-window) t)
+ (other-window 1))
+
+;;;###autoload
+(defun newsticker-treeview ()
+ "Start newsticker treeview."
+ (interactive)
+ (newsticker--treeview-load)
+ (setq newsticker--sentinel-callback 'newsticker-treeview-update)
+ (newsticker--treeview-frame-init)
+ (newsticker--treeview-window-init)
+ (newsticker--treeview-buffer-init)
+ (newsticker--group-manage-orphan-feeds)
+ (if newsticker--window-config
+ (set-window-configuration newsticker--window-config))
+ (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
+ (newsticker-start t) ;; will start only if not running
+ (newsticker-treeview-update)
+ (newsticker--treeview-item-show-text
+ "Newsticker"
+ "Welcome to newsticker!"))
+
+(defun newsticker-treeview-get-news ()
+ "Get news for current feed."
+ (interactive)
+ (when newsticker--treeview-current-feed
+ (newsticker-get-news newsticker--treeview-current-feed)))
+
+(provide 'newsticker-treeview)
+
+;; arch-tag: 5dbaff48-1f3e-4fc6-8ebd-e966fc90d2d4
+;;; newst-treeview.el ends here
+++ /dev/null
-;;; newsticker-backend.el --- Retrieval backend for newsticker.
-
-;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
-
-;; Author: Ulf Jasper <ulf.jasper@web.de>
-;; Filename: newsticker-backend.el
-;; URL: http://www.nongnu.org/newsticker
-;; Keywords: News, RSS, Atom
-;; Time-stamp: "8. Juni 2008, 17:18:04 (ulf)"
-
-;; ======================================================================
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; ======================================================================
-
-;;; Commentary:
-
-;; See newsticker.el
-
-;; ======================================================================
-;;; Code:
-
-(require 'derived)
-(require 'xml)
-
-;; Silence warnings
-(defvar w3-mode-map)
-(defvar w3m-minor-mode-map)
-
-
-(defvar newsticker--retrieval-timer-list nil
- "List of timers for news retrieval.
-This is an alist, each element consisting of (feed-name . timer).")
-
-(defvar newsticker--download-logos nil
- "If non-nil download feed logos if available.")
-
-(defvar newsticker--sentinel-callback nil
- "Function called at end of `newsticker--sentinel'.")
-
-;;;###autoload
-(defun newsticker-running-p ()
- "Check whether newsticker is running.
-Return t if newsticker is running, nil otherwise. Newsticker is
-considered to be running if the newsticker timer list is not empty."
- (> (length newsticker--retrieval-timer-list) 0))
-
-;; ======================================================================
-;;; Customization
-;; ======================================================================
-(defgroup newsticker nil
- "Aggregator for RSS and Atom feeds."
- :group 'applications)
-
-(defconst newsticker--raw-url-list-defaults
- '(("CNET News.com"
- "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
- ("Debian Security Advisories"
- "http://www.debian.org/security/dsa.en.rdf")
- ("Debian Security Advisories - Long format"
- "http://www.debian.org/security/dsa-long.en.rdf")
- ("Emacs Wiki"
- "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
- nil
- 3600)
- ("Freshmeat.net"
- "http://freshmeat.net/backend/fm.rdf")
- ("Kuro5hin.org"
- "http://www.kuro5hin.org/backend.rdf")
- ("LWN (Linux Weekly News)"
- "http://lwn.net/headlines/rss")
- ("NewsForge"
- "http://newsforge.com/index.rss")
- ("NY Times: Technology"
- "http://partners.userland.com/nytRss/technology.xml")
- ("NY Times"
- "http://partners.userland.com/nytRss/nytHomepage.xml")
- ("Quote of the day"
- "http://www.quotationspage.com/data/qotd.rss"
- "07:00"
- 86400)
- ("The Register"
- "http://www.theregister.co.uk/tonys/slashdot.rdf")
- ("slashdot"
- "http://slashdot.org/index.rss"
- nil
- 3600) ;/. will ban you if under 3600 seconds!
- ("Wired News"
- "http://www.wired.com/news_drop/netcenter/netcenter.rdf")
- ("Heise News (german)"
- "http://www.heise.de/newsticker/heise.rdf")
- ("Tagesschau (german)"
- "http://www.tagesschau.de/newsticker.rdf"
- nil
- 1800)
- ("Telepolis (german)"
- "http://www.heise.de/tp/news.rdf"))
- "Default URL list in raw form.
-This list is fed into defcustom via `newsticker--splicer'.")
-
-(defun newsticker--splicer (item)
- "Convert ITEM for splicing into `newsticker-url-list-defaults'."
- (let ((result (list 'list :tag (nth 0 item) (list 'const (nth 0 item))))
- (element (cdr item)))
- (while element
- (setq result (append result (list (list 'const (car element)))))
- (setq element (cdr element)))
- result))
-
-(defun newsticker--set-customvar-retrieval (symbol value)
- "Set retrieval related newsticker-variable SYMBOL value to VALUE.
-Calls all actions which are necessary in order to make the new
-value effective."
- (if (or (not (boundp symbol))
- (equal (symbol-value symbol) value))
- (set symbol value)
- ;; something must have changed
- (let ((need-restart nil)
- (new-or-changed-feeds nil)
- (removed-feeds))
- (cond ((eq symbol 'newsticker-retrieval-interval)
- (setq need-restart t))
- ((memq symbol '(newsticker-url-list-defaults newsticker-url-list))
- (dolist (elt value)
- (unless (member elt (symbol-value symbol))
- (setq new-or-changed-feeds (cons elt new-or-changed-feeds))))
- (dolist (elt (symbol-value symbol))
- (unless (member elt value)
- (setq removed-feeds (cons elt removed-feeds))))))
- (cond (need-restart
- (set symbol value)
- (when (newsticker-running-p)
- (message "Restarting newsticker")
- (newsticker-stop)
- (newsticker-start)))
- (t
- (dolist (feed removed-feeds)
- (message "Stopping feed `%s'" (car feed))
- (newsticker--stop-feed (car feed)))
- (dolist (feed new-or-changed-feeds)
- (message "Starting feed `%s'" (car feed))
- (newsticker--stop-feed (car feed))
- (newsticker--start-feed feed))
- (unless new-or-changed-feeds
- (when newsticker--sentinel-callback
- (funcall newsticker--sentinel-callback)))))
- (set symbol value))))
-
-;; ======================================================================
-;; retrieval
-(defgroup newsticker-retrieval nil
- "Settings for news retrieval."
- :group 'newsticker)
-
-(defcustom newsticker-url-list-defaults
- '(("Emacs Wiki"
- "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
- nil
- 3600))
- "A customizable list of news feeds to select from.
-These were mostly extracted from the Radio Community Server at
-http://subhonker6.userland.com/rcsPublic/rssHotlist.
-
-You may add other entries in `newsticker-url-list'."
- :type `(set ,@(mapcar `newsticker--splicer
- newsticker--raw-url-list-defaults))
- :set 'newsticker--set-customvar-retrieval
- :group 'newsticker-retrieval)
-
-(defcustom newsticker-url-list nil
- "The news feeds which you like to watch.
-
-This alist will be used in addition to selection made customizing
-`newsticker-url-list-defaults'.
-
-This is an alist. Each element consists of two items: a LABEL and a URL,
-optionally followed by a START-TIME, INTERVAL specifier and WGET-ARGUMENTS.
-
-The LABEL gives the name of the news feed. It can be an arbitrary string.
-
-The URL gives the location of the news feed. It must point to a valid
-RSS or Atom file. The file is retrieved by calling wget, or whatever you
-specify as `newsticker-wget-name'.
-
-URL may also be a function which returns news data. In this case
-`newsticker-retrieval-method' etc. are ignored for this feed.
-
-The START-TIME can be either a string, or nil. If it is a string it
-specifies a fixed time at which this feed shall be retrieved for the
-first time. (Examples: \"11:00pm\", \"23:00\".) If it is nil (or
-unspecified), this feed will be retrieved immediately after calling
-`newsticker-start'.
-
-The INTERVAL specifies the time between retrievals for this feed. If it
-is nil (or unspecified) the default interval value as set in
-`newsticker-retrieval-interval' is used.
-
-\(newsticker.el calls `run-at-time'. The newsticker-parameters START-TIME
-and INTERVAL correspond to the `run-at-time'-parameters TIME and REPEAT.)
-
-WGET-ARGUMENTS specifies arguments for wget (see `newsticker-wget-name')
-which apply for this feed only, overriding the value of
-`newsticker-wget-arguments'."
- :type '(repeat (list :tag "News feed"
- (string :tag "Label")
- (choice :tag "URI"
- (string :tag "String")
- (function :tag "Function"))
- (choice :tag "Start"
- (const :tag "Default" nil)
- (string :tag "Fixed Time"))
- (choice :tag "Interval"
- (const :tag "Default" nil)
- (const :tag "Hourly" 3600)
- (const :tag "Daily" 86400)
- (const :tag "Weekly" 604800)
- (integer :tag "Interval"))
- (choice :tag "Wget Arguments"
- (const :tag "Default arguments" nil)
- (repeat :tag "Special arguments" string))))
- :set 'newsticker--set-customvar-retrieval
- :group 'newsticker-retrieval)
-
-(defcustom newsticker-retrieval-method
- 'intern
- "Method for retrieving news from the web, either `intern' or `extern'.
-Default value `intern' uses Emacs' built-in asynchronous download
-capabilities ('url-retrieve'). If set to `extern' the external
-program wget is used, see `newsticker-wget-name'."
- :type '(choice :tag "Method"
- (const :tag "Intern" intern)
- (const :tag "Extern" extern))
- :group 'newsticker-retrieval)
-
-(defcustom newsticker-wget-name
- "wget"
- "Name of the program which is called to retrieve news from the web.
-The canonical choice is wget but you may take any other program which is
-able to return the contents of a news feed file on stdout."
- :type 'string
- :group 'newsticker-retrieval)
-
-(defcustom newsticker-wget-arguments
- '("-q" "-O" "-")
- "Arguments which are passed to wget.
-There is probably no reason to change the default settings, unless you
-are living behind a firewall."
- :type '(repeat (string :tag "Argument"))
- :group 'newsticker-retrieval)
-
-(defcustom newsticker-retrieval-interval
- 3600
- "Time interval for retrieving new news items (seconds).
-If this value is not positive (i.e. less than or equal to 0)
-items are retrieved only once!
-Please note that some feeds, e.g. Slashdot, will ban you if you
-make it less than 1800 seconds (30 minutes)!"
- :type '(choice :tag "Interval"
- (const :tag "No automatic retrieval" 0)
- (const :tag "Hourly" 3600)
- (const :tag "Daily" 86400)
- (const :tag "Weekly" 604800)
- (integer :tag "Interval"))
- :set 'newsticker--set-customvar-retrieval
- :group 'newsticker-retrieval)
-
-(defcustom newsticker-desc-comp-max
- 100
- "Relevant length of headline descriptions.
-This value gives the maximum number of characters which will be
-taken into account when newsticker compares two headline
-descriptions."
- :type 'integer
- :group 'newsticker-retrieval)
-
-;; ======================================================================
-;; headline processing
-(defgroup newsticker-headline-processing nil
- "Settings for the automatic processing of headlines."
- :group 'newsticker)
-
-(defcustom newsticker-automatically-mark-items-as-old
- t
- "Decides whether to automatically mark items as old.
-If t a new item is considered as new only after its first retrieval. As
-soon as it is retrieved a second time, it becomes old. If not t all
-items stay new until you mark them as old. This is done in the
-*newsticker* buffer."
- :type 'boolean
- :group 'newsticker-headline-processing)
-
-(defcustom newsticker-automatically-mark-visited-items-as-old
- t
- "Decides whether to automatically mark visited items as old.
-If t an item is marked as old as soon as the associated link is
-visited, i.e. after pressing RET or mouse2 on the item's
-headline."
-
- :type 'boolean
- :group 'newsticker-headline-processing)
-
-(defcustom newsticker-keep-obsolete-items
- t
- "Decides whether to keep unread items which have been removed from feed.
-If t a new item, which has been removed from the feed, is kept in
-the cache until it is marked as read."
- :type 'boolean
- :group 'newsticker-headline-processing)
-
-(defcustom newsticker-obsolete-item-max-age
- (* 60 60 24)
- "Maximal age of obsolete items, in seconds.
-Obsolete items which are older than this value will be silently
-deleted at the next retrieval."
- :type 'integer
- :group 'newsticker-headline-processing)
-
-(defcustom newsticker-auto-mark-filter-list
- nil
- "A list of filters for automatically marking headlines.
-
-This is an alist of the form (FEED-NAME PATTERN-LIST). I.e. each
-element consists of a FEED-NAME a PATTERN-LIST. Each element of
-the pattern-list has the form (AGE TITLE-OR-DESCRIPTION REGEXP).
-AGE must be one of the symbols 'old or 'immortal.
-TITLE-OR-DESCRIPTION must be on of the symbols 'title,
-'description, or 'all. REGEXP is a regular expression, i.e. a
-string.
-
-This filter is checked after a new headline has been retrieved.
-If FEED-NAME matches the name of the corresponding news feed, the
-pattern-list is checked: The new headline will be marked as AGE
-if REGEXP matches the headline's TITLE-OR-DESCRIPTION.
-
-If, for example, `newsticker-auto-mark-filter-list' looks like
- \((slashdot ('old 'title \"^Forget me!$\") ('immortal 'title \"Read me\")
- \('immortal 'all \"important\"))))
-
-then all articles from slashdot are marked as old if they have
-the title \"Forget me!\". All articles with a title containing
-the string \"Read me\" are marked as immortal. All articles which
-contain the string \"important\" in their title or their
-description are marked as immortal."
- :type '(repeat (list :tag "Auto mark filter"
- (string :tag "Feed name")
- (repeat
- (list :tag "Filter element"
- (choice
- :tag "Auto-assigned age"
- (const :tag "Old" old)
- (const :tag "Immortal" immortal))
- (choice
- :tag "Title/Description"
- (const :tag "Title" title)
- (const :tag "Description" description)
- (const :tag "All" all))
- (string :tag "Regexp")))))
- :group 'newsticker-headline-processing)
-
-;; ======================================================================
-;; hooks
-(defgroup newsticker-hooks nil
- "Settings for newsticker hooks."
- :group 'newsticker)
-
-(defcustom newsticker-start-hook
- nil
- "Hook run when starting newsticker.
-This hook is run at the very end of `newsticker-start'."
- :options '(newsticker-start-ticker)
- :type 'hook
- :group 'newsticker-hooks)
-
-(defcustom newsticker-stop-hook
- nil
- "Hook run when stopping newsticker.
-This hook is run at the very end of `newsticker-stop'."
- :options nil
- :type 'hook
- :group 'newsticker-hooks)
-
-(defcustom newsticker-new-item-functions
- nil
- "List of functions run after a new headline has been retrieved.
-Each function is called with the following three arguments:
-FEED the name of the corresponding news feed,
-TITLE the title of the headline,
-DESC the decoded description of the headline.
-
-See `newsticker-download-images', and
-`newsticker-download-enclosures' for sample functions.
-
-Please note that these functions are called only once for a
-headline after it has been retrieved for the first time."
- :type 'hook
- :options '(newsticker-download-images
- newsticker-download-enclosures)
- :group 'newsticker-hooks)
-
-;; ======================================================================
-;; miscellaneous
-(defgroup newsticker-miscellaneous nil
- "Miscellaneous newsticker settings."
- :group 'newsticker)
-
-(defcustom newsticker-cache-filename
- "~/.newsticker-cache"
- "Name of the newsticker cache file."
- :type 'string
- :group 'newsticker-miscellaneous)
-
-(defcustom newsticker-imagecache-dirname
- "~/.newsticker-images"
- "Name of the directory where newsticker stores cached images."
- :type 'string
- :group 'newsticker-miscellaneous)
-
-;; debugging
-(defcustom newsticker-debug
- nil
- "Enables some features needed for debugging newsticker.el.
-
-If set to t newsticker.el will print lots of debugging messages, and the
-buffers *newsticker-wget-<feed>* will not be closed."
- :type 'boolean
- :group 'newsticker-miscellaneous)
-
-;; ======================================================================
-;;; Compatibility section, XEmacs, Emacs
-;; ======================================================================
-(unless (fboundp 'time-add)
- (require 'time-date);;FIXME
- (defun time-add (t1 t2)
- (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))
-
-(unless (fboundp 'match-string-no-properties)
- (defalias 'match-string-no-properties 'match-string))
-
-(when (featurep 'xemacs)
- (unless (fboundp 'replace-regexp-in-string)
- (defun replace-regexp-in-string (re rp st)
- (save-match-data ;; apparently XEmacs needs save-match-data
- (replace-in-string st re rp)))))
-
-;; copied from subr.el
-(unless (fboundp 'add-to-invisibility-spec)
- (defun add-to-invisibility-spec (arg)
- "Add elements to `buffer-invisibility-spec'.
-See documentation for `buffer-invisibility-spec' for the kind of elements
-that can be added."
- (if (eq buffer-invisibility-spec t)
- (setq buffer-invisibility-spec (list t)))
- (setq buffer-invisibility-spec
- (cons arg buffer-invisibility-spec))))
-
-;; copied from subr.el
-(unless (fboundp 'remove-from-invisibility-spec)
- (defun remove-from-invisibility-spec (arg)
- "Remove elements from `buffer-invisibility-spec'."
- (if (consp buffer-invisibility-spec)
- (setq buffer-invisibility-spec
- (delete arg buffer-invisibility-spec)))))
-
-;; ======================================================================
-;;; Internal variables
-;; ======================================================================
-(defvar newsticker--item-list nil
- "List of newsticker items.")
-(defvar newsticker--item-position 0
- "Actual position in list of newsticker items.")
-(defvar newsticker--prev-message "There was no previous message yet!"
- "Last message that the newsticker displayed.")
-(defvar newsticker--scrollable-text ""
- "The text which is scrolled smoothly in the echo area.")
-(defvar newsticker--buffer-uptodate-p nil
- "Tells whether the newsticker buffer is up to date.")
-(defvar newsticker--latest-update-time (current-time)
- "The time at which the latest news arrived.")
-(defvar newsticker--process-ids nil
- "List of PIDs of active newsticker processes.")
-
-(defvar newsticker--cache nil "Cached newsticker data.
-This is a list of the form
-
- ((label1
- (title description link time age index preformatted-contents
- preformatted-title extra-elements)
- ...)
- (label2
- (title description link time age index preformatted-contents
- preformatted-title extra-elements)
- ...)
- ...)
-
-where LABEL is a symbol. TITLE, DESCRIPTION, and LINK are
-strings. TIME is a time value as returned by `current-time'.
-AGE is a symbol: 'new, 'old, 'immortal, and 'obsolete denote
-ordinary news items, whereas 'feed denotes an item which is not a
-headline but describes the feed itself. INDEX denotes the
-original position of the item -- used for restoring the original
-order. PREFORMATTED-CONTENTS and PREFORMATTED-TITLE hold the
-formatted contents of the item's description and title. This
-speeds things up if HTML rendering is used, which is rather
-slow. EXTRA-ELEMENTS is an alist containing additional elements.")
-
-(defvar newsticker--auto-narrow-to-feed nil
- "Automatically narrow to current news feed.
-If non-nil only the items of the current news feed are visible.")
-
-(defvar newsticker--auto-narrow-to-item nil
- "Automatically narrow to current news item.
-If non-nil only the current headline is visible.")
-
-(defconst newsticker--error-headline
- "[COULD NOT DOWNLOAD HEADLINES!]"
- "Title of error headline which will be inserted if news retrieval fails.")
-
-;; ======================================================================
-;;; Shortcuts
-;; ======================================================================
-(defsubst newsticker--title (item)
- "Return title of ITEM."
- (nth 0 item))
-(defsubst newsticker--desc (item)
- "Return description of ITEM."
- (nth 1 item))
-(defsubst newsticker--link (item)
- "Return link of ITEM."
- (nth 2 item))
-(defsubst newsticker--time (item)
- "Return time of ITEM."
- (nth 3 item))
-(defsubst newsticker--age (item)
- "Return age of ITEM."
- (nth 4 item))
-(defsubst newsticker--pos (item)
- "Return position/index of ITEM."
- (nth 5 item))
-(defsubst newsticker--preformatted-contents (item)
- "Return pre-formatted text of ITEM."
- (nth 6 item))
-(defsubst newsticker--preformatted-title (item)
- "Return pre-formatted title of ITEM."
- (nth 7 item))
-(defsubst newsticker--extra (item)
- "Return extra attributes of ITEM."
- (nth 8 item))
-(defsubst newsticker--guid-to-string (guid)
- "Return string representation of GUID."
- (if (stringp guid)
- guid
- (car (xml-node-children guid))))
-(defsubst newsticker--guid (item)
- "Return guid of ITEM."
- (newsticker--guid-to-string (assoc 'guid (newsticker--extra item))))
-(defsubst newsticker--enclosure (item)
- "Return enclosure element of ITEM in the form \(...FIXME...\) or nil."
- (let ((enclosure (assoc 'enclosure (newsticker--extra item))))
- (if enclosure
- (xml-node-attributes enclosure))))
-(defun newsticker--real-feed-name (feed)
- "Return real name of FEED."
- (catch 'name
- (mapc (lambda (item)
- (if (eq (newsticker--age item) 'feed)
- (throw 'name (newsticker--title item))))
- (cdr (newsticker--cache-get-feed feed)))
- (symbol-name feed)))
-
-
-;; ======================================================================
-;;; User fun
-;; ======================================================================
-
-(defun newsticker--start-feed (feed &optional do-not-complain-if-running)
- "Start retrieval timer for FEED.
-If timer is running already a warning message is printed unless
-DO-NOT-COMPLAIN-IF-RUNNING is not nil. Add the started
-name/timer pair to `newsticker--retrieval-timer-list'."
- (let* ((feed-name (car feed))
- (start-time (nth 2 feed))
- (interval (or (nth 3 feed)
- newsticker-retrieval-interval))
- (timer (assoc (car feed)
- newsticker--retrieval-timer-list)))
- (if timer
- (or do-not-complain-if-running
- (message "Timer for %s is running already!"
- feed-name))
- (newsticker--debug-msg "Starting timer for %s: %s, %d"
- feed-name start-time interval)
- ;; do not repeat retrieval if interval not positive
- (if (<= interval 0)
- (setq interval nil))
- ;; Suddenly XEmacs doesn't like start-time 0
- (if (or (not start-time)
- (and (numberp start-time) (= start-time 0)))
- (setq start-time 1))
- ;; (message "start-time %s" start-time)
- (setq timer (run-at-time start-time interval
- 'newsticker-get-news feed-name))
- (if interval
- (add-to-list 'newsticker--retrieval-timer-list
- (cons feed-name timer))))))
-
-;;;###autoload
-(defun newsticker-start (&optional do-not-complain-if-running)
- "Start the newsticker.
-Start the timers for display and retrieval. If the newsticker, i.e. the
-timers, are running already a warning message is printed unless
-DO-NOT-COMPLAIN-IF-RUNNING is not nil.
-Run `newsticker-start-hook' if newsticker was not running already."
- (interactive)
- (let ((running (newsticker-running-p)))
- ;; read old cache if it exists and newsticker is not running
- (unless running
- (let ((coding-system-for-read 'utf-8))
- (when (file-exists-p newsticker-cache-filename)
- (with-temp-buffer
- (insert-file-contents newsticker-cache-filename)
- (goto-char (point-min))
- (condition-case nil
- (setq newsticker--cache (read (current-buffer)))
- (error
- (message "Error while reading newsticker cache file!")
- (setq newsticker--cache nil)))))))
- ;; start retrieval timers -- one timer for each feed
- (dolist (feed (append newsticker-url-list-defaults newsticker-url-list))
- (newsticker--start-feed feed))
- (unless running
- (run-hooks 'newsticker-start-hook)
- (message "Newsticker started!"))))
-
-(defun newsticker--stop-feed (feed-name)
- "Stop retrieval for feed FEED-NAME.
-Delete the stopped name/timer pair from `newsticker--retrieval-timer-list'."
- (let ((name-and-timer (assoc feed-name newsticker--retrieval-timer-list)))
- (when name-and-timer
- (cancel-timer (cdr name-and-timer))
- (setq newsticker--retrieval-timer-list
- (delete name-and-timer newsticker--retrieval-timer-list)))))
-
-(defun newsticker-stop ()
- "Stop the newsticker and the newsticker-ticker.
-Cancel the timers for display and retrieval. Run `newsticker-stop-hook'
-if newsticker has been running."
- (interactive)
- (newsticker--cache-update t)
- (when (fboundp 'newsticker-stop-ticker) ; silence compiler warnings
- (newsticker-stop-ticker))
- (when (newsticker-running-p)
- (mapc (lambda (name-and-timer)
- (newsticker--stop-feed (car name-and-timer)))
- newsticker--retrieval-timer-list)
- (setq newsticker--retrieval-timer-list nil)
- (run-hooks 'newsticker-stop-hook)
- (message "Newsticker stopped!")))
-
-(defun newsticker-get-all-news ()
- "Launch retrieval of news from all configured newsticker sites.
-This does NOT start the retrieval timers."
- (interactive)
- ;; launch retrieval of news
- (mapc (lambda (item)
- (newsticker-get-news (car item)))
- (append newsticker-url-list-defaults newsticker-url-list)))
-
-(defun newsticker-save-item (feed item)
- "Save FEED ITEM."
- (interactive)
- (let ((filename (read-string "Filename: "
- (concat feed ":_"
- (replace-regexp-in-string
- " " "_" (newsticker--title item))
- ".html"))))
- (with-temp-buffer
- (insert (newsticker--desc item))
- (write-file filename t))))
-
-(defun newsticker-add-url (url name)
- "Add given URL under given NAME to `newsticker-url-list'.
-If URL is nil it is searched at point."
- (interactive
- (list
- (read-string "URL: "
- (save-excursion
- (end-of-line)
- (and
- (re-search-backward
- "http://"
- (if (> (point) (+ (point-min) 100))
- (- (point) 100)
- (point-min))
- t)
- (re-search-forward
- "http://[-a-zA-Z0-9&/_.]*"
- (if (< (point) (- (point-max) 200))
- (+ (point) 200)
- (point-max))
- t)
- (buffer-substring-no-properties (match-beginning 0)
- (match-end 0)))))
- (read-string "Name: ")))
- (add-to-list 'newsticker-url-list (list name url nil nil nil) t)
- (customize-variable 'newsticker-url-list))
-
-(defun newsticker-customize ()
- "Open the newsticker customization group."
- (interactive)
- (customize-group "newsticker"))
-
-;; ======================================================================
-;;; Local stuff
-;; ======================================================================
-(defun newsticker--get-news-by-funcall (feed-name function)
- "Get news for the site FEED-NAME by calling FUNCTION.
-See `newsticker-get-news'."
- (let ((buffername (concat " *newsticker-funcall-" feed-name "*")))
- (save-excursion
- (set-buffer (get-buffer-create buffername))
- (erase-buffer)
- (insert (string-to-multibyte (funcall function feed-name)))
- (newsticker--sentinel-work nil t feed-name function
- (current-buffer)))))
-
-(defun newsticker--get-news-by-url (feed-name url)
- "Get news for the site FEED-NAME from address URL using `url-retrieve'.
-See `newsticker-get-news'."
- (let ((coding-system-for-read 'no-conversion))
- (url-retrieve url 'newsticker--get-news-by-url-callback (list feed-name)))
- (force-mode-line-update))
-
-(defun newsticker--get-news-by-url-callback (status feed-name)
- "Callback function for `newsticker--get-news-by-url'.
-STATUS is the return status as delivered by `url-retrieve', and
-FEED-NAME is the name of the feed that the news were retrieved
-from."
- (let ((buf (get-buffer-create (concat " *newsticker-url-" feed-name "*")))
- (result (string-to-multibyte (buffer-string))))
- (set-buffer buf)
- (erase-buffer)
- (insert result)
- ;; remove MIME header
- (goto-char (point-min))
- (search-forward "\n\n")
- (delete-region (point-min) (point))
- ;; read the rss/atom contents
- (newsticker--sentinel-work nil t feed-name "url-retrieve" (current-buffer))
- (when status
- (let ((status-type (car status))
- (status-details (cdr status)))
- (cond ((eq status-type :redirect)
- ;; don't care about redirects
- )
- ((eq status-type :error)
- (message "%s: Error while retrieving news from %s: %s: \"%s\""
- (format-time-string "%A, %H:%M" (current-time))
- feed-name
- (car status-details) (cdr status-details))))))))
-
-(defun newsticker--get-news-by-wget (feed-name url wget-arguments)
- "Get news for the site FEED-NAME from address URL using wget.
-WGET-ARGUMENTS is a list of arguments for wget.
-See `newsticker-get-news'."
- (let ((buffername (concat " *newsticker-wget-" feed-name "*")))
- (save-excursion
- (set-buffer (get-buffer-create buffername))
- (erase-buffer)
- ;; throw an error if there is an old wget-process around
- (if (get-process feed-name)
- (error "Another wget-process is running for %s" feed-name))
- ;; start wget
- (let* ((args (append wget-arguments (list url)))
- (proc (apply 'start-process feed-name buffername
- newsticker-wget-name args)))
- (set-process-coding-system proc 'no-conversion 'no-conversion)
- (set-process-sentinel proc 'newsticker--sentinel)
- (setq newsticker--process-ids (cons (process-id proc)
- newsticker--process-ids))
- (force-mode-line-update)))))
-
-(defun newsticker-get-news (feed-name)
- "Get news from the site FEED-NAME and load feed logo.
-FEED-NAME must be a string which occurs as the label (i.e. the first element)
-in an element of `newsticker-url-list' or `newsticker-url-list-defaults'."
- (newsticker--debug-msg "%s: Getting news for %s"
- (format-time-string "%A, %H:%M" (current-time))
- feed-name)
- (let* ((item (or (assoc feed-name newsticker-url-list)
- (assoc feed-name newsticker-url-list-defaults)
- (error
- "Cannot get news for %s: Check newsticker-url-list"
- feed-name)))
- (url (cadr item))
- (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
- newsticker-wget-arguments)))
- (if (functionp url)
- (newsticker--get-news-by-funcall feed-name url)
- (if (eq newsticker-retrieval-method 'intern)
- (newsticker--get-news-by-url feed-name url)
- (newsticker--get-news-by-wget feed-name url wget-arguments)))))
-
-;; ======================================================================
-;; Parsing
-;; ======================================================================
-
-(defun newsticker--sentinel (process event)
- "Sentinel for extracting news titles from an RDF buffer.
-Argument PROCESS is the process which has just changed its state.
-Argument EVENT tells what has happened to the process."
- (let ((p-status (process-status process))
- (exit-status (process-exit-status process))
- (name (process-name process))
- (command (process-command process))
- (buffer (process-buffer process)))
- (newsticker--sentinel-work event
- (and (eq p-status 'exit)
- (= exit-status 0))
- name command buffer)))
-
-(defun newsticker--sentinel-work (event status-ok name command buffer)
- "Actually do the sentinel work.
-Argument EVENT tells what has happened to the retrieval process.
-Argument STATUS-OK is the final status of the retrieval process,
-non-nil meaning retrieval was successful.
-Argument NAME is the name of the retrieval process.
-Argument COMMAND is the command of the retrieval process.
-Argument BUFFER is the buffer of the retrieval process."
- (let ((time (current-time))
- (name-symbol (intern name))
- (something-was-added nil))
- ;; catch known errors (zombie processes, rubbish-xml etc.
- ;; if an error occurs the news feed is not updated!
- (catch 'oops
- (unless status-ok
- (setq newsticker--cache
- (newsticker--cache-add
- newsticker--cache
- name-symbol
- newsticker--error-headline
- (format
- (concat "%s: Newsticker could not retrieve news from %s.\n"
- "Return status: `%s'\n"
- "Command was `%s'")
- (format-time-string "%A, %H:%M" (current-time))
- name event command)
- ""
- (current-time)
- 'new
- 0 nil))
- (message "%s: Error while retrieving news from %s"
- (format-time-string "%A, %H:%M" (current-time))
- name)
- (throw 'oops nil))
- (let* ((coding-system 'utf-8)
- (node-list
- (save-current-buffer
- (set-buffer buffer)
- ;; a very very dirty workaround to overcome the
- ;; problems with the newest (20030621) xml.el:
- ;; remove all unnecessary whitespace
- (goto-char (point-min))
- (while (re-search-forward ">[ \t\r\n]+<" nil t)
- (replace-match "><" nil t))
- ;; and another brutal workaround (20031105)! For some
- ;; reason the xml parser does not like the colon in the
- ;; doctype name "rdf:RDF"
- (goto-char (point-min))
- (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t)
- (replace-match "<!DOCTYPE rdfColonRDF" nil t))
- ;; finally.... ~##^°!!!!!
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" nil t))
- ;; still more brutal workarounds (20040309)! The xml
- ;; parser does not like doctype rss
- (goto-char (point-min))
- (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t)
- (replace-match "" nil t))
- ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
- ;; Remove comments to avoid this xml-parsing bug:
- ;; "XML files can have only one toplevel tag"
- (goto-char (point-min))
- (while (search-forward "<!--" nil t)
- (let ((start (match-beginning 0)))
- (unless (search-forward "-->" nil t)
- (error "Can't find end of comment"))
- (delete-region start (point))))
- ;; And another one (20050702)! If description is HTML
- ;; encoded and starts with a `<', wrap the whole
- ;; description in a CDATA expression. This happened for
- ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
- (goto-char (point-min))
- (while (re-search-forward
- "<description>\\(<img.*?\\)</description>" nil t)
- (replace-match
- "<description><![CDATA[ \\1 ]]></description>"))
- ;; And another one (20051123)! XML parser does not
- ;; like this: <yweather:location city="Frankfurt/Main"
- ;; region="" country="GM" />
- ;; try to "fix" empty attributes
- ;; This happened for
- ;; http://xml.weather.yahoo.com/forecastrss?p=GMXX0040&u=f
- (goto-char (point-min))
- (while (re-search-forward "\\(<[^>]*\\)=\"\"" nil t)
- (replace-match "\\1=\" \""))
- ;;
- (set-buffer-modified-p nil)
- ;; check coding system
- (goto-char (point-min))
- (if (re-search-forward "encoding=\"\\([^\"]+\\)\""
- nil t)
- (setq coding-system (intern (downcase (match-string 1))))
- (setq coding-system
- (condition-case nil
- (check-coding-system coding-system)
- (coding-system-error
- (message
- "newsticker.el: ignoring coding system %s for %s"
- coding-system name)
- nil))))
- ;; Decode if possible
- (when coding-system
- (decode-coding-region (point-min) (point-max)
- coding-system))
- (condition-case errordata
- ;; The xml parser might fail
- ;; or the xml might be bugged
- (xml-parse-region (point-min) (point-max))
- (error (message "Could not parse %s: %s"
- (buffer-name) (cadr errordata))
- (throw 'oops nil)))))
- (topnode (car node-list))
- (channelnode (car (xml-get-children topnode 'channel)))
- (imageurl nil))
- ;; mark all items as obsolete
- (newsticker--cache-replace-age newsticker--cache
- name-symbol
- 'new 'obsolete-new)
- (newsticker--cache-replace-age newsticker--cache
- name-symbol
- 'old 'obsolete-old)
- (newsticker--cache-replace-age newsticker--cache
- name-symbol
- 'feed 'obsolete-old)
-
- ;; check Atom/RSS version and call corresponding parser
- (condition-case error-data
- (if (cond
- ;; RSS 0.91
- ((and (eq 'rss (xml-node-name topnode))
- (string= "0.91" (xml-get-attribute topnode 'version)))
- (setq imageurl (newsticker--get-logo-url-rss-0.91 topnode))
- (newsticker--parse-rss-0.91 name time topnode))
- ;; RSS 0.92
- ((and (eq 'rss (xml-node-name topnode))
- (string= "0.92" (xml-get-attribute topnode 'version)))
- (setq imageurl (newsticker--get-logo-url-rss-0.92 topnode))
- (newsticker--parse-rss-0.92 name time topnode))
- ;; RSS 1.0
- ((eq 'rdf:RDF (xml-node-name topnode))
- (setq imageurl (newsticker--get-logo-url-rss-1.0 topnode))
- (newsticker--parse-rss-1.0 name time topnode))
- ;; RSS 2.0
- ((and (eq 'rss (xml-node-name topnode))
- (string= "2.0" (xml-get-attribute topnode 'version)))
- (setq imageurl (newsticker--get-logo-url-rss-2.0 topnode))
- (newsticker--parse-rss-2.0 name time topnode))
- ;; Atom 0.3
- ((and (eq 'feed (xml-node-name topnode))
- (string= "http://purl.org/atom/ns#"
- (xml-get-attribute topnode 'xmlns)))
- (setq imageurl (newsticker--get-logo-url-atom-0.3 topnode))
- (newsticker--parse-atom-0.3 name time topnode))
- ;; Atom 1.0
- ((and (eq 'feed (xml-node-name topnode))
- (string= "http://www.w3.org/2005/Atom"
- (xml-get-attribute topnode 'xmlns)))
- (setq imageurl (newsticker--get-logo-url-atom-1.0 topnode))
- (newsticker--parse-atom-1.0 name time topnode))
- ;; unknown feed type
- (t
- (newsticker--debug-msg "Feed type unknown: %s: %s"
- (xml-node-name topnode) name)
- nil))
- (setq something-was-added t))
- (xerror (message "sentinelerror in %s: %s" name error-data)))
-
- ;; Remove those old items from cache which have been removed from
- ;; the feed
- (newsticker--cache-replace-age newsticker--cache
- name-symbol 'obsolete-old 'deleteme)
- (newsticker--cache-remove newsticker--cache name-symbol
- 'deleteme)
- ;; Remove those new items from cache which have been removed from
- ;; the feed. Or keep them as `obsolete'
- (if (not newsticker-keep-obsolete-items)
- (newsticker--cache-remove newsticker--cache
- name-symbol 'obsolete-new)
- (setq newsticker--cache
- (newsticker--cache-mark-expired
- newsticker--cache name-symbol 'obsolete 'obsolete-expired
- newsticker-obsolete-item-max-age))
- (newsticker--cache-remove newsticker--cache
- name-symbol 'obsolete-expired)
- (newsticker--cache-replace-age newsticker--cache
- name-symbol 'obsolete-new
- 'obsolete))
- (newsticker--update-process-ids)
- ;; setup scrollable text
- (when (= 0 (length newsticker--process-ids))
- (when (fboundp 'newsticker--ticker-text-setup) ;silence
- ;compiler
- ;warnings
- (newsticker--ticker-text-setup)))
- (setq newsticker--latest-update-time (current-time))
- (when something-was-added
- ;; FIXME: should we care about removed items as well?
- (newsticker--cache-update)
- (when (fboundp 'newsticker--buffer-set-uptodate) ;silence
- ;compiler
- ;warnings
- (newsticker--buffer-set-uptodate nil)))
- ;; kill the process buffer if wanted
- (unless newsticker-debug
- (kill-buffer buffer))
- ;; launch retrieval of image
- (when (and imageurl newsticker--download-logos)
- (newsticker--image-get name imageurl)))))
- (when newsticker--sentinel-callback
- (funcall newsticker--sentinel-callback)))
-
-(defun newsticker--get-logo-url-atom-1.0 (node)
- "Return logo URL from atom 1.0 data in NODE."
- (car (xml-node-children
- (car (xml-get-children node 'logo)))))
-
-(defun newsticker--get-logo-url-atom-0.3 (node)
- "Return logo URL from atom 0.3 data in NODE."
- (car (xml-node-children
- (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
-
-(defun newsticker--get-logo-url-rss-2.0 (node)
- "Return logo URL from RSS 2.0 data in NODE."
- (car (xml-node-children
- (car (xml-get-children
- (car (xml-get-children
- (car (xml-get-children node 'channel)) 'image)) 'url)))))
-
-(defun newsticker--get-logo-url-rss-1.0 (node)
- "Return logo URL from RSS 1.0 data in NODE."
- (car (xml-node-children
- (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
-
-(defun newsticker--get-logo-url-rss-0.92 (node)
- "Return logo URL from RSS 0.92 data in NODE."
- (car (xml-node-children
- (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
-
-(defun newsticker--get-logo-url-rss-0.91 (node)
- "Return logo URL from RSS 0.91 data in NODE."
- (car (xml-node-children
- (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
-
-(defun newsticker--parse-atom-0.3 (name time topnode)
- "Parse Atom 0.3 data.
-Return value as well as arguments NAME, TIME, and TOPNODE are the
-same as in `newsticker--parse-atom-1.0'."
- (newsticker--debug-msg "Parsing Atom 0.3 feed %s" name)
- (let (new-feed new-item)
- (setq new-feed (newsticker--parse-generic-feed
- name time
- ;; title
- (car (xml-node-children
- (car (xml-get-children topnode 'title))))
- ;; desc
- (car (xml-node-children
- (car (xml-get-children topnode 'content))))
- ;; link
- (xml-get-attribute
- (car (xml-get-children topnode 'link)) 'href)
- ;; extra-elements
- (xml-node-children topnode)))
- (setq new-item (newsticker--parse-generic-items
- name time (xml-get-children topnode 'entry)
- ;; title-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'title)))))
- ;; desc-fn
- (lambda (node)
- (or (car (xml-node-children
- (car (xml-get-children node 'content))))
- (car (xml-node-children
- (car (xml-get-children node 'summary))))))
- ;; link-fn
- (lambda (node)
- (xml-get-attribute
- (car (xml-get-children node 'link)) 'href))
- ;; time-fn
- (lambda (node)
- (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children node 'modified))))))
- ;; guid-fn
- (lambda (node)
- (newsticker--guid-to-string
- (assoc 'guid (xml-node-children node))))
- ;; extra-fn
- (lambda (node)
- (xml-node-children node))))
- (or new-item new-feed)))
-
-(defun newsticker--parse-atom-1.0 (name time topnode)
- "Parse Atom 1.0 data.
-Argument NAME gives the name of a news feed. TIME gives the
-system time at which the data have been retrieved. TOPNODE
-contains the feed data as returned by the xml parser.
-
-For the Atom 1.0 specification see
-http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html"
- (newsticker--debug-msg "Parsing Atom 1.0 feed %s" name)
- (let (new-feed new-item)
- (setq new-feed (newsticker--parse-generic-feed
- name time
- ;; title
- (car (xml-node-children
- (car (xml-get-children topnode 'title))))
- ;; desc
- (car (xml-node-children
- (car (xml-get-children topnode 'subtitle))))
- ;; link
- (lambda (node)
- (xml-get-attribute
- (car (xml-get-children node 'link)) 'href))
- ;; extra-elements
- (xml-node-children topnode)))
- (setq new-item (newsticker--parse-generic-items
- name time (xml-get-children topnode 'entry)
- ;; title-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'title)))))
- ;; desc-fn
- (lambda (node)
- (or (car (xml-node-children
- (car (xml-get-children node 'content))))
- (car (xml-node-children
- (car (xml-get-children node 'summary))))))
- ;; link-fn
- (lambda (node)
- (xml-get-attribute
- (car (xml-get-children node 'link)) 'href))
- ;; time-fn
- (lambda (node)
- (newsticker--decode-iso8601-date
- (or (car (xml-node-children
- (car (xml-get-children node 'updated))))
- (car (xml-node-children
- (car (xml-get-children node 'published)))))))
- ;; guid-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'id)))))
- ;; extra-fn
- (lambda (node)
- (xml-node-children node))))
- (or new-item new-feed)))
-
-(defun newsticker--parse-rss-0.91 (name time topnode)
- "Parse RSS 0.91 data.
-Return value as well as arguments NAME, TIME, and TOPNODE are the
-same as in `newsticker--parse-atom-1.0'.
-
-For the RSS 0.91 specification see http://backend.userland.com/rss091 or
-http://my.netscape.com/publish/formats/rss-spec-0.91.html."
- (newsticker--debug-msg "Parsing RSS 0.91 feed %s" name)
- (let* ((channelnode (car (xml-get-children topnode 'channel)))
- (pub-date (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children channelnode 'pubDate))))))
- is-new-feed has-new-items)
- (setq is-new-feed (newsticker--parse-generic-feed
- name time
- ;; title
- (car (xml-node-children
- (car (xml-get-children channelnode 'title))))
- ;; desc
- (car (xml-node-children
- (car (xml-get-children channelnode
- 'description))))
- ;; link
- (car (xml-node-children
- (car (xml-get-children channelnode 'link))))
- ;; extra-elements
- (xml-node-children channelnode)))
- (setq has-new-items (newsticker--parse-generic-items
- name time (xml-get-children channelnode 'item)
- ;; title-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'title)))))
- ;; desc-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'description)))))
- ;; link-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'link)))))
- ;; time-fn
- (lambda (node)
- (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children node 'pubDate))))))
- ;; guid-fn
- (lambda (node)
- nil)
- ;; extra-fn
- (lambda (node)
- (xml-node-children node))))
- (or has-new-items is-new-feed)))
-
-(defun newsticker--parse-rss-0.92 (name time topnode)
- "Parse RSS 0.92 data.
-Return value as well as arguments NAME, TIME, and TOPNODE are the
-same as in `newsticker--parse-atom-1.0'.
-
-For the RSS 0.92 specification see http://backend.userland.com/rss092."
- (newsticker--debug-msg "Parsing RSS 0.92 feed %s" name)
- (let* ((channelnode (car (xml-get-children topnode 'channel)))
- (pub-date (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children channelnode 'pubDate))))))
- is-new-feed has-new-items)
- (setq is-new-feed (newsticker--parse-generic-feed
- name time
- ;; title
- (car (xml-node-children
- (car (xml-get-children channelnode 'title))))
- ;; desc
- (car (xml-node-children
- (car (xml-get-children channelnode
- 'description))))
- ;; link
- (car (xml-node-children
- (car (xml-get-children channelnode 'link))))
- ;; extra-elements
- (xml-node-children channelnode)))
- (setq has-new-items (newsticker--parse-generic-items
- name time (xml-get-children channelnode 'item)
- ;; title-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'title)))))
- ;; desc-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'description)))))
- ;; link-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'link)))))
- ;; time-fn
- (lambda (node)
- (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children node 'pubDate))))))
- ;; guid-fn
- (lambda (node)
- nil)
- ;; extra-fn
- (lambda (node)
- (xml-node-children node))))
- (or has-new-items is-new-feed)))
-
-(defun newsticker--parse-rss-1.0 (name time topnode)
- "Parse RSS 1.0 data.
-Return value as well as arguments NAME, TIME, and TOPNODE are the
-same as in `newsticker--parse-atom-1.0'.
-
-For the RSS 1.0 specification see http://web.resource.org/rss/1.0/spec."
- (newsticker--debug-msg "Parsing RSS 1.0 feed %s" name)
- (let* ((channelnode (car (xml-get-children topnode 'channel)))
- is-new-feed has-new-items)
- (setq is-new-feed (newsticker--parse-generic-feed
- name time
- ;; title
- (car (xml-node-children
- (car (xml-get-children channelnode 'title))))
- ;; desc
- (car (xml-node-children
- (car (xml-get-children channelnode
- 'description))))
- ;; link
- (car (xml-node-children
- (car (xml-get-children channelnode 'link))))
- ;; extra-elements
- (xml-node-children channelnode)))
- (setq has-new-items (newsticker--parse-generic-items
- name time (xml-get-children topnode 'item)
- ;; title-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'title)))))
- ;; desc-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node
- 'description)))))
- ;; link-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'link)))))
- ;; time-fn
- (lambda (node)
- (newsticker--decode-iso8601-date
- (car (xml-node-children
- (car (xml-get-children node 'dc:date))))))
- ;; guid-fn
- (lambda (node)
- nil)
- ;; extra-fn
- (lambda (node)
- (xml-node-children node))))
- (or has-new-items is-new-feed)))
-
-(defun newsticker--parse-rss-2.0 (name time topnode)
- "Parse RSS 2.0 data.
-Return value as well as arguments NAME, TIME, and TOPNODE are the
-same as in `newsticker--parse-atom-1.0'.
-
-For the RSS 2.0 specification see http://blogs.law.harvard.edu/tech/rss."
- (newsticker--debug-msg "Parsing RSS 2.0 feed %s" name)
- (let* ((channelnode (car (xml-get-children topnode 'channel)))
- is-new-feed has-new-items)
- (setq is-new-feed (newsticker--parse-generic-feed
- name time
- ;; title
- (car (xml-node-children
- (car (xml-get-children channelnode 'title))))
- ;; desc
- (car (xml-node-children
- (car (xml-get-children channelnode
- 'description))))
- ;; link
- (car (xml-node-children
- (car (xml-get-children channelnode 'link))))
- ;; extra-elements
- (xml-node-children channelnode)))
- (setq has-new-items (newsticker--parse-generic-items
- name time (xml-get-children channelnode 'item)
- ;; title-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'title)))))
- ;; desc-fn
- (lambda (node)
- (or (car (xml-node-children
- (car (xml-get-children node
- 'content:encoded))))
- (car (xml-node-children
- (car (xml-get-children node
- 'description))))))
- ;; link-fn
- (lambda (node)
- (car (xml-node-children
- (car (xml-get-children node 'link)))))
- ;; time-fn
- (lambda (node)
- (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children node 'pubDate))))))
- ;; guid-fn
- (lambda (node)
- (newsticker--guid-to-string
- (assoc 'guid (xml-node-children node))))
- ;; extra-fn
- (lambda (node)
- (xml-node-children node))))
- (or has-new-items is-new-feed)))
-
-(defun newsticker--parse-generic-feed (name time title desc link
- extra-elements)
- "Parse generic news feed data.
-Argument NAME gives the name of a news feed. TIME gives the
-system time at which the data have been retrieved.
-
-The arguments TITLE, DESC, LINK, and EXTRA-ELEMENTS give the feed's title,
-description, link, and extra elements resp."
- (let ((title (or title "[untitled]"))
- (link (or link ""))
- (old-item nil)
- (position 0)
- (something-was-added nil))
- ;; decode numeric entities
- (setq title (newsticker--decode-numeric-entities title))
- (setq desc (newsticker--decode-numeric-entities desc))
- (setq link (newsticker--decode-numeric-entities link))
- ;; remove whitespace from title, desc, and link
- (setq title (newsticker--remove-whitespace title))
- (setq desc (newsticker--remove-whitespace desc))
- (setq link (newsticker--remove-whitespace link))
-
- ;; handle the feed itself
- (unless (newsticker--cache-contains newsticker--cache
- (intern name) title
- desc link 'feed)
- (setq something-was-added t))
- (setq newsticker--cache
- (newsticker--cache-add newsticker--cache (intern name)
- title desc link time 'feed position
- extra-elements time 'feed))
- something-was-added))
-
-(defun newsticker--parse-generic-items (name time itemlist
- title-fn desc-fn
- link-fn time-fn
- guid-fn extra-fn)
- "Parse generic news feed data.
-Argument NAME gives the name of a news feed. TIME gives the
-system time at which the data have been retrieved. ITEMLIST
-contains the news items returned by the xml parser.
-
-The arguments TITLE-FN, DESC-FN, LINK-FN, TIME-FN, GUID-FN, and
-EXTRA-FN give functions for extracting title, description, link,
-time, guid, and extra-elements resp. They are called with one
-argument, which is one of the items in ITEMLIST."
- (let (title desc link
- (old-item nil)
- (position 0)
- (something-was-added nil))
- ;; gather all items for this feed
- (mapc (lambda (node)
- (setq position (1+ position))
- (setq title (or (funcall title-fn node) "[untitled]"))
- (setq desc (funcall desc-fn node))
- (setq link (or (funcall link-fn node) ""))
- (setq time (or (funcall time-fn node) time))
- ;; It happened that the title or description
- ;; contained evil HTML code that confused the
- ;; xml parser. Therefore:
- (unless (stringp title)
- (setq title (prin1-to-string title)))
- (unless (or (stringp desc) (not desc))
- (setq desc (prin1-to-string desc)))
- ;; ignore items with empty title AND empty desc
- (when (or (> (length title) 0)
- (> (length desc) 0))
- ;; decode numeric entities
- (setq title (newsticker--decode-numeric-entities title))
- (when desc
- (setq desc (newsticker--decode-numeric-entities desc)))
- (setq link (newsticker--decode-numeric-entities link))
- ;; remove whitespace from title, desc, and link
- (setq title (newsticker--remove-whitespace title))
- (setq desc (newsticker--remove-whitespace desc))
- (setq link (newsticker--remove-whitespace link))
- ;; add data to cache
- ;; do we have this item already?
- (let* ((guid (funcall guid-fn node)))
- ;;(message "guid=%s" guid)
- (setq old-item
- (newsticker--cache-contains newsticker--cache
- (intern name) title
- desc link nil guid)))
- ;; add this item, or mark it as old, or do nothing
- (let ((age1 'new)
- (age2 'old)
- (item-new-p nil))
- (if old-item
- (let ((prev-age (newsticker--age old-item)))
- (unless newsticker-automatically-mark-items-as-old
- ;; Some feeds deliver items multiply, the
- ;; first time we find an 'obsolete-old one the
- ;; cache, the following times we find an 'old
- ;; one
- (if (memq prev-age '(obsolete-old old))
- (setq age2 'old)
- (setq age2 'new)))
- (if (eq prev-age 'immortal)
- (setq age2 'immortal))
- (setq time (newsticker--time old-item)))
- ;; item was not there
- (setq item-new-p t)
- (setq something-was-added t))
- (setq newsticker--cache
- (newsticker--cache-add
- newsticker--cache (intern name) title desc link
- time age1 position (funcall extra-fn node)
- time age2))
- (when item-new-p
- (let ((item (newsticker--cache-contains
- newsticker--cache (intern name) title
- desc link nil)))
- (if newsticker-auto-mark-filter-list
- (newsticker--run-auto-mark-filter name item))
- (run-hook-with-args
- 'newsticker-new-item-functions name item))))))
- itemlist)
- something-was-added))
-
-;; ======================================================================
-;;; Misc
-;; ======================================================================
-(defun newsticker--decode-numeric-entities (string)
- "Decode SGML numeric entities by their respective utf characters.
-This function replaces numeric entities in the input STRING and
-returns the modified string. For example \"*\" gets replaced
-by \"*\"."
- (if (and string (stringp string))
- (let ((start 0))
- (while (string-match "&#\\([0-9]+\\);" string start)
- (condition-case nil
- (setq string (replace-match
- (string (read (substring string
- (match-beginning 1)
- (match-end 1))))
- nil nil string))
- (error nil))
- (setq start (1+ (match-beginning 0))))
- string)
- nil))
-
-(defun newsticker--remove-whitespace (string)
- "Remove leading and trailing whitespace from STRING."
- ;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
- ;; endlessly...
- (when (and string (stringp string))
- (replace-regexp-in-string
- "[ \t\r\n]+$" ""
- (replace-regexp-in-string "^[ \t\r\n]+" "" string))))
-
-(defun newsticker--do-forget-preformatted (item)
- "Forget pre-formatted data for ITEM.
-Remove the pre-formatted from `newsticker--cache'."
- (if (nthcdr 7 item)
- (setcar (nthcdr 7 item) nil))
- (if (nthcdr 6 item)
- (setcar (nthcdr 6 item) nil)))
-
-(defun newsticker--forget-preformatted ()
- "Forget all cached pre-formatted data.
-Remove the pre-formatted from `newsticker--cache'."
- (mapc (lambda (feed)
- (mapc 'newsticker--do-forget-preformatted
- (cdr feed)))
- newsticker--cache)
- (when (fboundp 'newsticker--buffer-set-uptodate)
- (newsticker--buffer-set-uptodate nil)))
-
-(defun newsticker--debug-msg (string &rest args)
- "Print newsticker debug messages.
-This function calls `message' with arguments STRING and ARGS, if
-`newsticker-debug' is non-nil."
- (and newsticker-debug
- ;;(not (active-minibuffer-window))
- ;;(not (current-message))
- (apply 'message string args)))
-
-(defun newsticker--decode-iso8601-date (iso8601-string)
- "Return ISO8601-STRING in format like `decode-time'.
-Converts from ISO-8601 to Emacs representation.
-Examples:
-2004-09-17T05:09:49.001+00:00
-2004-09-17T05:09:49+00:00
-2004-09-17T05:09+00:00
-2004-09-17T05:09:49
-2004-09-17T05:09
-2004-09-17
-2004-09
-2004"
- (if iso8601-string
- (when (string-match
- (concat
- "^ *\\([0-9]\\{4\\}\\)" ;year
- "\\(-\\([0-9]\\{2\\}\\)" ;month
- "\\(-\\([0-9]\\{2\\}\\)" ;day
- "\\(T"
- "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" ;hour:minute
- "\\(:\\([0-9]\\{2\\}\\)\\(\\.[0-9]+\\)?\\)?" ;second
- ;timezone
- "\\(\\([-+Z]\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)?"
- "\\)?\\)?\\)? *$")
- iso8601-string)
- (let ((year (read (match-string 1 iso8601-string)))
- (month (read (or (match-string 3 iso8601-string)
- "1")))
- (day (read (or (match-string 5 iso8601-string)
- "1")))
- (hour (read (or (match-string 7 iso8601-string)
- "0")))
- (minute (read (or (match-string 8 iso8601-string)
- "0")))
- (second (read (or (match-string 10 iso8601-string)
- "0")))
- (sign (match-string 13 iso8601-string))
- (offset-hour (read (or (match-string 15 iso8601-string)
- "0")))
- (offset-minute (read (or (match-string 16 iso8601-string)
- "0"))))
- (cond ((string= sign "+")
- (setq hour (- hour offset-hour))
- (setq minute (- minute offset-minute)))
- ((string= sign "-")
- (setq hour (+ hour offset-hour))
- (setq minute (+ minute offset-minute))))
- ;; if UTC subtract current-time-zone offset
- ;;(setq second (+ (car (current-time-zone)) second)))
-
- (condition-case nil
- (encode-time second minute hour day month year t)
- (error
- (message "Cannot decode \"%s\"" iso8601-string)
- nil))))
- nil))
-
-(defun newsticker--decode-rfc822-date (rfc822-string)
- "Return RFC822-STRING in format like `decode-time'.
-Converts from RFC822 to Emacs representation.
-Examples:
-Sat, 07 September 2002 00:00:01 +0100
-Sat, 07 September 2002 00:00:01 MET
-Sat, 07 Sep 2002 00:00:01 GMT
-07 Sep 2002 00:00:01 GMT
-07 Sep 2002"
- (if (and rfc822-string (stringp rfc822-string))
- (when (string-match
- (concat
- "\\s-*"
- ;; week day
- "\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)?\\s-*"
- ;; day
- "\\([0-9]\\{1,2\\}\\)\\s-+"
- ;; month
- "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|"
- "Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\).*?\\s-+"
- ;; year
- "\\([0-9]\\{2,4\\}\\)"
- ;; time may be missing
- "\\(\\s-+"
- ;; hour
- "\\([0-9]\\{2\\}\\)"
- ;; minute
- ":\\([0-9]\\{2\\}\\)"
- ;; second
- "\\(:\\([0-9]\\{2\\}\\)\\)?"
- ;; zone -- fixme
- "\\(\\s-+\\("
- "UT\\|GMT\\|EST\\|EDT\\|CST\\|CDT\\|MST\\|MDT\\|PST\\|PDT"
- "\\|\\([-+]\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)"
- "\\)\\)?"
- "\\)?")
- rfc822-string)
- (let ((day (read (match-string 3 rfc822-string)))
- (month-name (match-string 4 rfc822-string))
- (month 0)
- (year (read (match-string 5 rfc822-string)))
- (hour (read (or (match-string 7 rfc822-string) "0")))
- (minute (read (or (match-string 8 rfc822-string) "0")))
- (second (read (or (match-string 10 rfc822-string) "0")))
- (zone (match-string 12 rfc822-string))
- (sign (match-string 13 rfc822-string))
- (offset-hour (read (or (match-string 14 rfc822-string)
- "0")))
- (offset-minute (read (or (match-string 15 rfc822-string)
- "0")))
- ;;FIXME
- )
- (when zone
- (cond ((string= sign "+")
- (setq hour (- hour offset-hour))
- (setq minute (- minute offset-minute)))
- ((string= sign "-")
- (setq hour (+ hour offset-hour))
- (setq minute (+ minute offset-minute)))))
- (condition-case error-data
- (let ((i 1))
- (mapc (lambda (m)
- (if (string= month-name m)
- (setq month i))
- (setq i (1+ i)))
- '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
- "Sep" "Oct" "Nov" "Dec"))
- (encode-time second minute hour day month year t))
- (error
- (message "Cannot decode \"%s\": %s %s" rfc822-string
- (car error-data) (cdr error-data))
- nil))))
- nil))
-
-(defun newsticker--lists-intersect-p (list1 list2)
- "Return t if LIST1 and LIST2 share elements."
- (let ((result nil))
- (mapc (lambda (elt)
- (if (memq elt list2)
- (setq result t)))
- list1)
- result))
-
-(defun newsticker--update-process-ids ()
- "Update list of ids of active newsticker processes.
-Checks list of active processes against list of newsticker processes."
- (let ((active-procs (process-list))
- (new-list nil))
- (mapc (lambda (proc)
- (let ((id (process-id proc)))
- (if (memq id newsticker--process-ids)
- (setq new-list (cons id new-list)))))
- active-procs)
- (setq newsticker--process-ids new-list))
- (force-mode-line-update))
-
-;; ======================================================================
-;;; Images
-;; ======================================================================
-(defun newsticker--image-get (feed-name url)
- "Get image of the news site FEED-NAME from URL.
-If the image has been downloaded in the last 24h do nothing."
- (let ((image-name (concat newsticker-imagecache-dirname "/"
- feed-name)))
- (if (and (file-exists-p image-name)
- (time-less-p (current-time)
- (time-add (nth 5 (file-attributes image-name))
- (seconds-to-time 86400))))
- (newsticker--debug-msg "%s: Getting image for %s skipped"
- (format-time-string "%A, %H:%M" (current-time))
- feed-name)
- ;; download
- (newsticker--debug-msg "%s: Getting image for %s"
- (format-time-string "%A, %H:%M" (current-time))
- feed-name)
- (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*"))
- (item (or (assoc feed-name newsticker-url-list)
- (assoc feed-name newsticker-url-list-defaults)
- (error
- "Cannot get news for %s: Check newsticker-url-list"
- feed-name)))
- (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
- newsticker-wget-arguments)))
- (save-excursion
- (set-buffer (get-buffer-create buffername))
- (erase-buffer)
- ;; throw an error if there is an old wget-process around
- (if (get-process feed-name)
- (error "Another wget-process is running for image %s"
- feed-name))
- ;; start wget
- (let* ((args (append wget-arguments (list url)))
- (proc (apply 'start-process feed-name buffername
- newsticker-wget-name args)))
- (set-process-coding-system proc 'no-conversion 'no-conversion)
- (set-process-sentinel proc 'newsticker--image-sentinel)))))))
-
-(defun newsticker--image-sentinel (process event)
- "Sentinel for image-retrieving PROCESS caused by EVENT."
- (let* ((p-status (process-status process))
- (exit-status (process-exit-status process))
- (feed-name (process-name process)))
- ;; catch known errors (zombie processes, rubbish-xml, etc.)
- ;; if an error occurs the news feed is not updated!
- (catch 'oops
- (unless (and (eq p-status 'exit)
- (= exit-status 0))
- (message "%s: Error while retrieving image from %s"
- (format-time-string "%A, %H:%M" (current-time))
- feed-name)
- (throw 'oops nil))
- (let (image-name)
- (save-excursion
- (set-buffer (process-buffer process))
- (setq image-name (concat newsticker-imagecache-dirname "/"
- feed-name))
- (set-buffer-file-coding-system 'no-conversion)
- ;; make sure the cache dir exists
- (unless (file-directory-p newsticker-imagecache-dirname)
- (make-directory newsticker-imagecache-dirname))
- ;; write and close buffer
- (let ((require-final-newline nil)
- (backup-inhibited t)
- (coding-system-for-write 'no-conversion))
- (write-region nil nil image-name nil 'quiet))
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer)))))))
-
-
-
-(defun newsticker--insert-image (img string)
- "Insert IMG with STRING at point."
- (insert-image img string))
-
-;; ======================================================================
-;;; HTML rendering
-;; ======================================================================
-(defun newsticker-htmlr-render (pos1 pos2) ;
- "Replacement for `htmlr-render'.
-Renders the HTML code in the region POS1 to POS2 using htmlr."
- (let ((str (buffer-substring-no-properties pos1 pos2)))
- (delete-region pos1 pos2)
- (insert
- (with-temp-buffer
- (insert str)
- (goto-char (point-min))
- ;; begin original htmlr-render
- (when (fboundp 'htmlr-reset) (htmlr-reset))
- ;; something omitted here...
- (when (fboundp 'htmlr-step)
- (while (< (point) (point-max))
- (htmlr-step)))
- ;; end original htmlr-render
- (newsticker--remove-whitespace (buffer-string))))))
-
-;; ======================================================================
-;;; Manipulation of cached data
-;; ======================================================================
-(defun newsticker--cache-set-preformatted-contents (item contents)
- "Set preformatted contents of ITEM to CONTENTS."
- (if (nthcdr 6 item)
- (setcar (nthcdr 6 item) contents)
- (setcdr (nthcdr 5 item) (list contents))))
-
-(defun newsticker--cache-set-preformatted-title (item title)
- "Set preformatted title of ITEM to TITLE."
- (if (nthcdr 7 item)
- (setcar (nthcdr 7 item) title)
- (setcdr (nthcdr 6 item) title)))
-
-(defun newsticker--cache-replace-age (data feed old-age new-age)
- "Mark all items in DATA in FEED which carry age OLD-AGE with NEW-AGE.
-If FEED is 'any it applies to all feeds. If OLD-AGE is 'any,
-all marks are replaced by NEW-AGE. Removes all pre-formatted contents."
- (mapc (lambda (a-feed)
- (when (or (eq feed 'any)
- (eq (car a-feed) feed))
- (let ((items (cdr a-feed)))
- (mapc (lambda (item)
- (when (or (eq old-age 'any)
- (eq (newsticker--age item) old-age))
- (setcar (nthcdr 4 item) new-age)
- (newsticker--do-forget-preformatted item)))
- items))))
- data)
- data)
-
-(defun newsticker--cache-mark-expired (data feed old-age new-age time)
- "Mark all expired entries.
-This function sets the age entries in DATA in the feed FEED. If
-an item's age is OLD-AGE it is set to NEW-AGE if the item is
-older than TIME."
- (mapc
- (lambda (a-feed)
- (when (or (eq feed 'any)
- (eq (car a-feed) feed))
- (let ((items (cdr a-feed)))
- (mapc
- (lambda (item)
- (when (eq (newsticker--age item) old-age)
- (let ((exp-time (time-add (newsticker--time item)
- (seconds-to-time time))))
- (when (time-less-p exp-time (current-time))
- (newsticker--debug-msg
- "Item `%s' from %s has expired on %s"
- (newsticker--title item)
- (format-time-string "%Y-%02m-%d, %H:%M"
- (newsticker--time item))
- (format-time-string "%Y-%02m-%d, %H:%M" exp-time))
- (setcar (nthcdr 4 item) new-age)))))
- items))))
- data)
- data)
-
-(defun newsticker--cache-contains (data feed title desc link age
- &optional guid)
- "Check DATA whether FEED contains an item with the given properties.
-This function returns the contained item or nil if it is not
-contained.
-The properties which are checked are TITLE, DESC, LINK, AGE, and
-GUID. In general all properties must match in order to return a
-certain item, except for the following cases.
-
-If AGE equals 'feed the TITLE, DESCription and LINK do not
-matter. If DESC is nil it is ignored as well. If
-`newsticker-desc-comp-max' is non-nil, only the first
-`newsticker-desc-comp-max' characters of DESC are taken into
-account.
-
-If GUID is non-nil it is sufficient to match this value, and the
-other properties are ignored."
- ;;(newsticker--debug-msg "Looking for %s guid=%s" title guid)
- (condition-case nil
- (catch 'found
- (when (and desc newsticker-desc-comp-max
- (> (length desc) newsticker-desc-comp-max))
- (setq desc (substring desc 0 newsticker-desc-comp-max)))
- (mapc
- (lambda (this-feed)
- (when (eq (car this-feed) feed)
- (mapc (lambda (anitem)
- (when (cond (guid
- ;; global unique id can match
- (string= guid (newsticker--guid anitem)))
- (t;;FIXME?
- (or
- ;; or title, desc, etc.
- (and
- ;;(or (not (eq age 'feed))
- ;; (eq (newsticker--age anitem) 'feed))
- (string= (newsticker--title anitem)
- title)
- (or (not link)
- (string= (newsticker--link anitem)
- link))
- (or (not desc)
- (if (and desc newsticker-desc-comp-max
- (> (length (newsticker--desc
- anitem))
- newsticker-desc-comp-max))
- (string= (substring
- (newsticker--desc anitem)
- 0
- newsticker-desc-comp-max)
- desc)
- (string= (newsticker--desc anitem)
- desc)))))))
- ;;(newsticker--debug-msg "Found %s guid=%s"
- ;; (newsticker--title anitem)
- ;; (newsticker--guid anitem))
- (throw 'found anitem)))
- (cdr this-feed))))
- data)
- ;;(newsticker--debug-msg "Found nothing")
- nil)
- (error nil)))
-
-(defun newsticker--cache-add (data feed-name-symbol title desc link time age
- position extra-elements
- &optional updated-time updated-age
- preformatted-contents
- preformatted-title)
- "Add another item to cache data.
-Add to DATA in the FEED-NAME-SYMBOL an item with TITLE, DESC,
-LINK, TIME, AGE, POSITION, and EXTRA-ELEMENTS. If this item is
-contained already, its time is set to UPDATED-TIME, its mark is
-set to UPDATED-AGE, and its pre-formatted contents is set to
-PREFORMATTED-CONTENTS and PREFORMATTED-TITLE. Returns the age
-which the item got."
- (let* ((guid (newsticker--guid-to-string (assoc 'guid extra-elements)))
- (item (newsticker--cache-contains data feed-name-symbol title desc link
- age guid)))
- ;;(message "guid=%s" guid)
- (if item
- ;; does exist already -- change age, update time and position
- (progn
- ;;(newsticker--debug-msg "Updating item %s %s %s %s %s -> %s %s
- ;; (guid %s -> %s)"
- ;; feed-name-symbol title link time age
- ;; updated-time updated-age
- ;; guid (newsticker--guid item))
- (if (nthcdr 5 item)
- (setcar (nthcdr 5 item) position)
- (setcdr (nthcdr 4 item) (list position)))
- (setcar (nthcdr 4 item) updated-age)
- (if updated-time
- (setcar (nthcdr 3 item) updated-time))
- ;; replace cached pre-formatted contents
- (newsticker--cache-set-preformatted-contents
- item preformatted-contents)
- (newsticker--cache-set-preformatted-title
- item preformatted-title))
- ;; did not exist or age equals 'feed-name-symbol
- (setq item (list title desc link time age position preformatted-contents
- preformatted-title extra-elements))
- ;;(newsticker--debug-msg "Adding item %s" item)
- (catch 'found
- (mapc (lambda (this-feed)
- (when (eq (car this-feed) feed-name-symbol)
- (setcdr this-feed (nconc (cdr this-feed) (list item)))
- (throw 'found this-feed)))
- data)
- ;; the feed is not contained
- (add-to-list 'data (list feed-name-symbol item) t))))
- data)
-
-(defun newsticker--cache-remove (data feed-symbol age)
- "Remove all entries from DATA in the feed FEED-SYMBOL with AGE.
-FEED-SYMBOL may be 'any. Entries from old feeds, which are no longer in
-`newsticker-url-list' or `newsticker-url-list-defaults', are removed as
-well."
- (let* ((pos data)
- (feed (car pos))
- (last-pos nil))
- (while feed
- (if (or (assoc (symbol-name (car feed)) newsticker-url-list)
- (assoc (symbol-name (car feed)) newsticker-url-list-defaults))
- ;; feed is still valid=active
- ;; (message "Keeping feed %s" (car feed))
- (if (or (eq feed-symbol 'any)
- (eq feed-symbol (car feed)))
- (let* ((item-pos (cdr feed))
- (item (car item-pos))
- (prev-pos nil))
- (while item
- ;;(message "%s" (car item))
- (if (eq age (newsticker--age item))
- ;; remove this item
- (progn
- ;;(message "Removing item %s" (car item))
- (if prev-pos
- (setcdr prev-pos (cdr item-pos))
- (setcdr feed (cdr item-pos))))
- ;;(message "Keeping item %s" (car item))
- (setq prev-pos item-pos))
- (setq item-pos (cdr item-pos))
- (setq item (car item-pos)))))
- ;; feed is not active anymore
- ;; (message "Removing feed %s" (car feed))
- (if last-pos
- (setcdr last-pos (cdr pos))
- (setq data (cdr pos))))
- (setq last-pos pos)
- (setq pos (cdr pos))
- (setq feed (car pos)))))
-
-;; ======================================================================
-;;; Sorting
-;; ======================================================================
-(defun newsticker--cache-item-compare-by-time (item1 item2)
- "Compare two news items ITEM1 and ITEM2 by comparing their time values."
- (catch 'result
- (let ((age1 (newsticker--age item1))
- (age2 (newsticker--age item2)))
- (if (not (eq age1 age2))
- (cond ((eq age1 'obsolete)
- (throw 'result nil))
- ((eq age2 'obsolete)
- (throw 'result t)))))
- (let* ((time1 (newsticker--time item1))
- (time2 (newsticker--time item2)))
- (cond ((< (nth 0 time1) (nth 0 time2))
- nil)
- ((> (nth 0 time1) (nth 0 time2))
- t)
- ((< (nth 1 time1) (nth 1 time2))
- nil)
- ((> (nth 1 time1) (nth 1 time2))
- t)
- ((< (or (nth 2 time1) 0) (or (nth 2 time2) 0))
- nil)
- ((> (or (nth 2 time1) 0) (or (nth 2 time2) 0))
- t)
- (t
- nil)))))
-
-(defun newsticker--cache-item-compare-by-title (item1 item2)
- "Compare ITEM1 and ITEM2 by comparing their titles."
- (catch 'result
- (let ((age1 (newsticker--age item1))
- (age2 (newsticker--age item2)))
- (if (not (eq age1 age2))
- (cond ((eq age1 'obsolete)
- (throw 'result nil))
- ((eq age2 'obsolete)
- (throw 'result t)))))
- (string< (newsticker--title item1) (newsticker--title item2))))
-
-(defun newsticker--cache-item-compare-by-position (item1 item2)
- "Compare ITEM1 and ITEM2 by comparing their original positions."
- (catch 'result
- (let ((age1 (newsticker--age item1))
- (age2 (newsticker--age item2)))
- (if (not (eq age1 age2))
- (cond ((eq age1 'obsolete)
- (throw 'result nil))
- ((eq age2 'obsolete)
- (throw 'result t)))))
- (< (or (newsticker--pos item1) 0) (or (newsticker--pos item2) 0))))
-
-
-
-(defun newsticker--cache-save ()
- "Update and save newsticker cache file."
- (interactive)
- (newsticker--cache-update t))
-
-(defun newsticker--cache-update (&optional save)
- "Update newsticker cache file.
-If optional argument SAVE is not nil the cache file is saved to disk."
- (save-excursion
- (let ((coding-system-for-write 'utf-8))
- (with-temp-buffer
- (setq buffer-undo-list t)
- (erase-buffer)
- (insert ";; -*- coding: utf-8 -*-\n")
- (insert (prin1-to-string newsticker--cache))
- (when save
- (set-visited-file-name newsticker-cache-filename)
- (save-buffer))))))
-
-(defun newsticker--cache-get-feed (feed)
- "Return the cached data for the feed FEED.
-FEED is a symbol!"
- (assoc feed newsticker--cache))
-
-;; ======================================================================
-;;; Statistics
-;; ======================================================================
-(defun newsticker--stat-num-items (feed &rest ages)
- "Return number of items in the given FEED which have one of the given AGES.
-If AGES is nil, the total number of items is returned."
- (let ((items (cdr (newsticker--cache-get-feed feed)))
- (num 0))
- (while items
- (if ages
- (if (memq (newsticker--age (car items)) ages)
- (setq num (1+ num)))
- (if (memq (newsticker--age (car items)) '(new old immortal obsolete))
- (setq num (1+ num))))
- (setq items (cdr items)))
- num))
-
-(defun newsticker--stat-num-items-total (&optional age)
- "Return total number of items in all feeds which have the given AGE.
-If AGE is nil, the total number of items is returned."
- (apply '+
- (mapcar (lambda (feed)
- (if age
- (newsticker--stat-num-items (intern (car feed)) age)
- (newsticker--stat-num-items (intern (car feed)))))
- (append newsticker-url-list-defaults newsticker-url-list))))
-
-;; ======================================================================
-;;; OPML
-;; ======================================================================
-(defun newsticker-opml-export ()
- "OPML subscription export.
-Export subscriptions to a buffer in OPML Format."
- (interactive)
- (with-current-buffer (get-buffer-create "*OPML Export*")
- (set-buffer-file-coding-system 'utf-8)
- (insert (concat
- "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
- "<!-- OPML generated by Emacs newsticker.el -->\n"
- "<opml version=\"1.0\">\n"
- " <head>\n"
- " <title>mySubscriptions</title>\n"
- " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
- "</dateCreated>\n"
- " <ownerEmail>" user-mail-address "</ownerEmail>\n"
- " <ownerName>" (user-full-name) "</ownerName>\n"
- " </head>\n"
- " <body>\n"))
- (mapc (lambda (sub)
- (insert " <outline text=\"")
- (insert (newsticker--title sub))
- (insert "\" xmlUrl=\"")
- (insert (cadr sub))
- (insert "\"/>\n"))
- (append newsticker-url-list newsticker-url-list-defaults))
- (insert " </body>\n</opml>\n"))
- (pop-to-buffer "*OPML Export*")
- (when (fboundp 'sgml-mode)
- (sgml-mode)))
-
-(defun newsticker--opml-import-outlines (outlines)
- "Recursively import OUTLINES from OPML data.
-Note that nested outlines are currently flattened -- i.e. grouping is
-removed."
- (mapc (lambda (outline)
- (let ((name (xml-get-attribute outline 'text))
- (url (xml-get-attribute outline 'xmlUrl))
- (children (xml-get-children outline 'outline)))
- (unless (string= "" url)
- (add-to-list 'newsticker-url-list
- (list name url nil nil nil) t))
- (if children
- (newsticker--opml-import-outlines children))))
- outlines))
-
-(defun newsticker-opml-import (filename)
- "Import OPML data from FILENAME."
- (interactive "fOPML file: ")
- (set-buffer (find-file-noselect filename))
- (goto-char (point-min))
- (let* ((node-list (xml-parse-region (point-min) (point-max)))
- (body (car (xml-get-children (car node-list) 'body)))
- (outlines (xml-get-children body 'outline)))
- (newsticker--opml-import-outlines outlines))
- (customize-variable 'newsticker-url-list))
-
-;; ======================================================================
-;;; Auto marking
-;; ======================================================================
-(defun newsticker--run-auto-mark-filter (feed item)
- "Automatically mark an item as old or immortal.
-This function checks the variable `newsticker-auto-mark-filter-list'
-for an entry that matches FEED and ITEM."
- (let ((case-fold-search t))
- (mapc (lambda (filter)
- (let ((filter-feed (car filter))
- (pattern-list (cadr filter)))
- (when (string-match filter-feed feed)
- (newsticker--do-run-auto-mark-filter item pattern-list))))
- newsticker-auto-mark-filter-list)))
-
-(defun newsticker--do-run-auto-mark-filter (item list)
- "Actually compare ITEM against the pattern-LIST.
-LIST must be an element of `newsticker-auto-mark-filter-list'."
- (mapc (lambda (pattern)
- (let ((age (nth 0 pattern))
- (place (nth 1 pattern))
- (regexp (nth 2 pattern))
- (title (newsticker--title item))
- (desc (newsticker--desc item)))
- (when (or (eq place 'title) (eq place 'all))
- (when (and title (string-match regexp title))
- (newsticker--debug-msg "Auto-marking as %s: `%s'"
- age (newsticker--title item))
- (setcar (nthcdr 4 item) age)))
- (when (or (eq place 'description) (eq place 'all))
- (when (and desc (string-match regexp desc))
- (newsticker--debug-msg "Auto-marking as %s: `%s'"
- age (newsticker--title item))
- (setcar (nthcdr 4 item) age)))))
- list))
-
-
-;; ======================================================================
-;;; Hook samples
-;; ======================================================================
-(defun newsticker-new-item-functions-sample (feed item)
- "Demonstrate the use of the `newsticker-new-item-functions' hook.
-This function just prints out the values of the FEED and title of the ITEM."
- (message (concat "newsticker-new-item-functions-sample: feed=`%s', "
- "title=`%s'")
- feed (newsticker--title item)))
-
-(defun newsticker-download-images (feed item)
- "Download the first image.
-If FEED equals \"imagefeed\" download the first image URL found
-in the description=contents of ITEM to the directory
-\"~/tmp/newsticker/FEED/TITLE\" where TITLE is the title of the item."
- (when (string= feed "imagefeed")
- (let ((title (newsticker--title item))
- (desc (newsticker--desc item)))
- (when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc)
- (let ((url (substring desc (match-beginning 1) (match-end 1)))
- (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
- (org-dir default-directory))
- (unless (file-directory-p temp-dir)
- (make-directory temp-dir t))
- (cd temp-dir)
- (message "Getting image %s" url)
- (apply 'start-process "wget-image"
- " *newsticker-wget-download-images*"
- newsticker-wget-name
- (list url))
- (cd org-dir))))))
-
-(defun newsticker-download-enclosures (feed item)
- "In all FEEDs download the enclosed object of the news ITEM.
-The object is saved to the directory \"~/tmp/newsticker/FEED/TITLE\", which
-is created if it does not exist. TITLE is the title of the news
-item. Argument FEED is ignored.
-This function is suited for adding it to `newsticker-new-item-functions'."
- (let ((title (newsticker--title item))
- (enclosure (newsticker--enclosure item)))
- (when enclosure
- (let ((url (cdr (assoc 'url enclosure)))
- (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
- (org-dir default-directory))
- (unless (file-directory-p temp-dir)
- (make-directory temp-dir t))
- (cd temp-dir)
- (message "Getting enclosure %s" url)
- (apply 'start-process "wget-enclosure"
- " *newsticker-wget-download-enclosures*"
- newsticker-wget-name
- (list url))
- (cd org-dir)))))
-
-;; ======================================================================
-;;; Retrieve samples
-;; ======================================================================
-(defun newsticker-retrieve-random-message (feed-name)
- "Return an artificial RSS string under the name FEED-NAME."
- (concat "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?><rss version=\"0.91\">"
- "<channel>"
- "<title>newsticker-retrieve-random-message</title>"
- "<description>Sample retrieval function</description>"
- "<pubDate>FIXME Sat, 07 Sep 2005 00:00:01 GMT</pubDate>"
- "<item><title>" (format "Your lucky number is %d" (random 10000))
- "</title><description>" (format "Or maybe it is %d" (random 10000))
- "</description></item></channel></rss>"))
-
-(provide 'newsticker-backend)
-
-;; arch-tag: 0e37b658-56e9-49ab-90f9-f2df57e1a659
-;;; newsticker-backend.el ends here
+++ /dev/null
-;;; newsticker-plainview.el --- Single buffer frontend for newsticker.
-
-;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
-
-;; Author: Ulf Jasper <ulf.jasper@web.de>
-;; Filename: newsticker-plainview.el
-;; URL: http://www.nongnu.org/newsticker
-;; Time-stamp: "8. Juni 2008, 20:39:46 (ulf)"
-
-;; ======================================================================
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; ======================================================================
-;;; Commentary:
-
-;; See newsticker.el
-
-;; ======================================================================
-;;; Code:
-
-(require 'newsticker-ticker)
-(require 'newsticker-reader)
-(require 'derived)
-(require 'xml)
-
-;; Silence warnings
-(defvar w3-mode-map)
-(defvar w3m-minor-mode-map)
-
-;; ======================================================================
-;;; Customization
-;; ======================================================================
-(defgroup newsticker-plainview nil
- "Settings for the simple plain view reader.
-See also `newsticker-plainview-hooks'."
- :group 'newsticker-reader)
-
-
-(defun newsticker--set-customvar-buffer (symbol value)
- "Set newsticker-variable SYMBOL value to VALUE.
-Calls all actions which are necessary in order to make the new
-value effective."
- (if (or (not (boundp symbol))
- (equal (symbol-value symbol) value))
- (set symbol value)
- ;; something must have changed
- (set symbol value)
- (newsticker--buffer-set-uptodate nil)))
-
-(defun newsticker--set-customvar-sorting (symbol value)
- "Set newsticker-variable SYMBOL value to VALUE.
-Calls all actions which are necessary in order to make the new
-value effective."
- (if (or (not (boundp symbol))
- (equal (symbol-value symbol) value))
- (set symbol value)
- ;; something must have changed
- (set symbol value)
- (message "Applying new sort method...")
- (when (fboundp 'newsticker--cache-sort) (newsticker--cache-sort))
- (when (fboundp 'newsticker--buffer-set-uptodate)
- (newsticker--buffer-set-uptodate nil))
- (message "Applying new sort method...done")))
-
-(defcustom newsticker-sort-method
- 'sort-by-original-order
- "Sort method for news items.
-The following sort methods are available:
-* `sort-by-original-order' keeps the order in which the items
- appear in the headline file (please note that for immortal items,
- which have been removed from the news feed, there is no original
- order),
-* `sort-by-time' looks at the time at which an item has been seen
- the first time. The most recent item is put at top,
-* `sort-by-title' will put the items in an alphabetical order."
- :type '(choice
- (const :tag "Keep original order" sort-by-original-order)
- (const :tag "Sort by time" sort-by-time)
- (const :tag "Sort by title" sort-by-title))
- :set 'newsticker--set-customvar-sorting
- :group 'newsticker-plainview)
-
-(defcustom newsticker-heading-format
- "%l
-%t %d %s"
- "Format string for feed headings.
-The following printf-like specifiers can be used:
-%d The date the feed was retrieved. See `newsticker-date-format'.
-%l The logo (image) of the feed. Most news feeds provide a small
- image as logo. Newsticker can display them, if Emacs can --
- see `image-types' for a list of supported image types.
-%L The logo (image) of the feed. If the logo is not available
- the title of the feed is used.
-%s The statistical data of the feed. See `newsticker-statistics-format'.
-%t The title of the feed, i.e. its name."
- :type 'string
- :set 'newsticker--set-customvar-formatting
- :group 'newsticker-plainview)
-
-(defcustom newsticker-item-format
- "%t %d"
- "Format string for news item headlines.
-The following printf-like specifiers can be used:
-%d The date the item was (first) retrieved. See `newsticker-date-format'.
-%l The logo (image) of the feed. Most news feeds provide a small
- image as logo. Newsticker can display them, if Emacs can --
- see `image-types' for a list of supported image types.
-%L The logo (image) of the feed. If the logo is not available
- the title of the feed is used.
-%t The title of the item."
- :type 'string
- :set 'newsticker--set-customvar-formatting
- :group 'newsticker-plainview)
-
-(defcustom newsticker-desc-format
- "%d %c"
- "Format string for news descriptions (contents).
-The following printf-like specifiers can be used:
-%c The contents (description) of the item.
-%d The date the item was (first) retrieved. See
- `newsticker-date-format'."
- :type 'string
- :set 'newsticker--set-customvar-formatting
- :group 'newsticker-plainview)
-
-(defcustom newsticker-statistics-format
- "[%n + %i + %o + %O = %a]"
- "Format for the statistics part in feed lines.
-The following printf-like specifiers can be used:
-%a The number of all items in the feed.
-%i The number of immortal items in the feed.
-%n The number of new items in the feed.
-%o The number of old items in the feed.
-%O The number of obsolete items in the feed."
- :type 'string
- :set 'newsticker--set-customvar-formatting
- :group 'newsticker-plainview)
-
-
-;; ======================================================================
-;; faces
-(defgroup newsticker-faces nil
- "Settings for the faces of the feed reader."
- :group 'newsticker-plainview)
-
-(defface newsticker-feed-face
- '((((class color) (background dark))
- (:family "helvetica" :bold t :height 1.2 :foreground "misty rose"))
- (((class color) (background light))
- (:family "helvetica" :bold t :height 1.2 :foreground "black")))
- "Face for news feeds."
- :group 'newsticker-faces)
-
-(defface newsticker-new-item-face
- '((((class color) (background dark))
- (:family "helvetica" :bold t))
- (((class color) (background light))
- (:family "helvetica" :bold t)))
- "Face for new news items."
- :group 'newsticker-faces)
-
-(defface newsticker-old-item-face
- '((((class color) (background dark))
- (:family "helvetica" :bold t :foreground "orange3"))
- (((class color) (background light))
- (:family "helvetica" :bold t :foreground "red4")))
- "Face for old news items."
- :group 'newsticker-faces)
-
-(defface newsticker-immortal-item-face
- '((((class color) (background dark))
- (:family "helvetica" :bold t :italic t :foreground "orange"))
- (((class color) (background light))
- (:family "helvetica" :bold t :italic t :foreground "blue")))
- "Face for immortal news items."
- :group 'newsticker-faces)
-
-(defface newsticker-obsolete-item-face
- '((((class color) (background dark))
- (:family "helvetica" :bold t :strike-through t))
- (((class color) (background light))
- (:family "helvetica" :bold t :strike-through t)))
- "Face for old news items."
- :group 'newsticker-faces)
-
-(defface newsticker-date-face
- '((((class color) (background dark))
- (:family "helvetica" :italic t :height 0.8))
- (((class color) (background light))
- (:family "helvetica" :italic t :height 0.8)))
- "Face for newsticker dates."
- :group 'newsticker-faces)
-
-(defface newsticker-statistics-face
- '((((class color) (background dark))
- (:family "helvetica" :italic t :height 0.8))
- (((class color) (background light))
- (:family "helvetica" :italic t :height 0.8)))
- "Face for newsticker dates."
- :group 'newsticker-faces)
-
-(defface newsticker-enclosure-face
- '((((class color) (background dark))
- (:bold t :background "orange"))
- (((class color) (background light))
- (:bold t :background "orange")))
- "Face for enclosed elements."
- :group 'newsticker-faces)
-
-(defface newsticker-extra-face
- '((((class color) (background dark))
- (:italic t :foreground "gray50" :height 0.8))
- (((class color) (background light))
- (:italic t :foreground "gray50" :height 0.8)))
- "Face for newsticker dates."
- :group 'newsticker-faces)
-
-(defface newsticker-default-face
- '((((class color) (background dark))
- (:inherit default))
- (((class color) (background light))
- (:inherit default)))
- "Face for the description of news items."
- ;;:set 'newsticker--set-customvar
- :group 'newsticker-faces)
-
-(defcustom newsticker-hide-old-items-in-newsticker-buffer
- nil
- "Decides whether to automatically hide old items in the *newsticker* buffer.
-If set to t old items will be completely folded and only new
-items will show up in the *newsticker* buffer. Otherwise old as
-well as new items will be visible."
- :type 'boolean
- :set 'newsticker--set-customvar-buffer
- :group 'newsticker-plainview)
-
-(defcustom newsticker-show-descriptions-of-new-items
- t
- "Whether to automatically show descriptions of new items in *newsticker*.
-If set to t old items will be folded and new items will be
-unfolded. Otherwise old as well as new items will be folded."
- :type 'boolean
- :set 'newsticker--set-customvar-buffer
- :group 'newsticker-plainview)
-
-(defcustom newsticker-show-all-news-elements
- nil
- "Show all news elements."
- :type 'boolean
- ;;:set 'newsticker--set-customvar
- :group 'newsticker-plainview)
-
-;; ======================================================================
-;; hooks
-(defgroup newsticker-plainview-hooks nil
- "Settings for newsticker hooks which apply to plainview only."
- :group 'newsticker-hooks)
-
-(defcustom newsticker-select-item-hook
- 'newsticker--buffer-make-item-completely-visible
- "List of functions run after a headline has been selected.
-Each function is called after one of `newsticker-next-item',
-`newsticker-next-new-item', `newsticker-previous-item',
-`newsticker-previous-new-item' has been called.
-
-The default value 'newsticker--buffer-make-item-completely-visible
-assures that the current item is always completely visible."
- :type 'hook
- :options '(newsticker--buffer-make-item-completely-visible)
- :group 'newsticker-plainview-hooks)
-
-(defcustom newsticker-select-feed-hook
- 'newsticker--buffer-make-item-completely-visible
- "List of functions run after a feed has been selected.
-Each function is called after one of `newsticker-next-feed', and
-`newsticker-previous-feed' has been called.
-
-The default value 'newsticker--buffer-make-item-completely-visible
-assures that the current feed is completely visible."
- :type 'hook
- :options '(newsticker--buffer-make-item-completely-visible)
- :group 'newsticker-plainview-hooks)
-
-(defcustom newsticker-buffer-change-hook
- 'newsticker-w3m-show-inline-images
- "List of functions run after the newsticker buffer has been updated.
-Each function is called after `newsticker-buffer-update' has been called.
-
-The default value '`newsticker-w3m-show-inline-images' loads inline
-images."
- :type 'hook
- :group 'newsticker-plainview-hooks)
-
-(defcustom newsticker-narrow-hook
- 'newsticker-w3m-show-inline-images
- "List of functions run after narrowing in newsticker buffer has changed.
-Each function is called after
-`newsticker-toggle-auto-narrow-to-feed' or
-`newsticker-toggle-auto-narrow-to-item' has been called.
-
-The default value '`newsticker-w3m-show-inline-images' loads inline
-images."
- :type 'hook
- :group 'newsticker-plainview-hooks)
-
-;; ======================================================================
-;;; Toolbar
-;; ======================================================================
-
-(defvar newsticker--plainview-tool-bar-map
- (if (featurep 'xemacs)
- nil
- (if (boundp 'tool-bar-map)
- (let ((tool-bar-map (make-sparse-keymap)))
- (define-key tool-bar-map [newsticker-sep-1]
- (list 'menu-item "--double-line"))
- (define-key tool-bar-map [newsticker-browse-url]
- (list 'menu-item "newsticker-browse-url" 'newsticker-browse-url
- :visible t
- :help "Browse URL for item at point"
- :image newsticker--browse-image))
- (define-key tool-bar-map [newsticker-buffer-force-update]
- (list 'menu-item "newsticker-buffer-force-update"
- 'newsticker-buffer-force-update
- :visible t
- :help "Update newsticker buffer"
- :image newsticker--update-image
- :enable '(not newsticker--buffer-uptodate-p)))
- (define-key tool-bar-map [newsticker-get-all-news]
- (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
- :visible t
- :help "Get news for all feeds"
- :image newsticker--get-all-image))
- (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
- (list 'menu-item "newsticker-mark-item-at-point-as-read"
- 'newsticker-mark-item-at-point-as-read
- :visible t
- :image newsticker--mark-read-image
- :help "Mark current item as read"
- :enable '(newsticker-item-not-old-p)))
- (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
- (list 'menu-item "newsticker-mark-item-at-point-as-immortal"
- 'newsticker-mark-item-at-point-as-immortal
- :visible t
- :image newsticker--mark-immortal-image
- :help "Mark current item as immortal"
- :enable '(newsticker-item-not-immortal-p)))
- (define-key tool-bar-map [newsticker-toggle-auto-narrow-to-feed]
- (list 'menu-item "newsticker-toggle-auto-narrow-to-feed"
- 'newsticker-toggle-auto-narrow-to-feed
- :visible t
- :help "Toggle visibility of other feeds"
- :image newsticker--narrow-image))
- (define-key tool-bar-map [newsticker-next-feed]
- (list 'menu-item "newsticker-next-feed" 'newsticker-next-feed
- :visible t
- :help "Go to next feed"
- :image newsticker--next-feed-image
- :enable '(newsticker-next-feed-available-p)))
- (define-key tool-bar-map [newsticker-next-item]
- (list 'menu-item "newsticker-next-item" 'newsticker-next-item
- :visible t
- :help "Go to next item"
- :image newsticker--next-item-image
- :enable '(newsticker-next-item-available-p)))
- (define-key tool-bar-map [newsticker-previous-item]
- (list 'menu-item "newsticker-previous-item" 'newsticker-previous-item
- :visible t
- :help "Go to previous item"
- :image newsticker--previous-item-image
- :enable '(newsticker-previous-item-available-p)))
- (define-key tool-bar-map [newsticker-previous-feed]
- (list 'menu-item "newsticker-previous-feed" 'newsticker-previous-feed
- :visible t
- :help "Go to previous feed"
- :image newsticker--previous-feed-image
- :enable '(newsticker-previous-feed-available-p)))
- ;; standard icons / actions
- (tool-bar-add-item "close"
- 'newsticker-close-buffer
- 'newsticker-close-buffer
- :help "Close newsticker buffer")
- (tool-bar-add-item "preferences"
- 'newsticker-customize
- 'newsticker-customize
- :help "Customize newsticker")
- tool-bar-map))))
-
-;; ======================================================================
-;;; Newsticker mode
-;; ======================================================================
-
-(define-derived-mode newsticker-mode fundamental-mode
- "NewsTicker"
- "Viewing news feeds in Emacs."
- (if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map)
- newsticker--plainview-tool-bar-map))
- (set (make-local-variable 'imenu-sort-function) nil)
- (set (make-local-variable 'scroll-conservatively) 999)
- (setq imenu-create-index-function 'newsticker--imenu-create-index)
- (setq imenu-default-goto-function 'newsticker--imenu-goto)
- (setq buffer-read-only t)
- (auto-fill-mode -1) ;; turn auto-fill off!
- (font-lock-mode -1) ;; turn off font-lock!!
- (set (make-local-variable 'font-lock-defaults) nil)
- (set (make-local-variable 'line-move-ignore-invisible) t)
- (setq mode-line-format
- (list "-"
- 'mode-line-mule-info
- 'mode-line-modified
- 'mode-line-frame-identification
- " Newsticker ("
- '(newsticker--buffer-uptodate-p
- "up to date"
- "NEED UPDATE")
- ") "
- '(:eval (format "[%d]" (length newsticker--process-ids)))
- " -- "
- '(:eval (newsticker--buffer-get-feed-title-at-point))
- ": "
- '(:eval (newsticker--buffer-get-item-title-at-point))
- " %-"))
- (add-to-invisibility-spec 't)
- (unless newsticker-show-all-news-elements
- (add-to-invisibility-spec 'extra))
- (newsticker--buffer-set-uptodate nil))
-
-;; refine its mode-map
-(define-key newsticker-mode-map "sO" 'newsticker-show-old-items)
-(define-key newsticker-mode-map "hO" 'newsticker-hide-old-items)
-(define-key newsticker-mode-map "sa" 'newsticker-show-all-desc)
-(define-key newsticker-mode-map "ha" 'newsticker-hide-all-desc)
-(define-key newsticker-mode-map "sf" 'newsticker-show-feed-desc)
-(define-key newsticker-mode-map "hf" 'newsticker-hide-feed-desc)
-(define-key newsticker-mode-map "so" 'newsticker-show-old-item-desc)
-(define-key newsticker-mode-map "ho" 'newsticker-hide-old-item-desc)
-(define-key newsticker-mode-map "sn" 'newsticker-show-new-item-desc)
-(define-key newsticker-mode-map "hn" 'newsticker-hide-new-item-desc)
-(define-key newsticker-mode-map "se" 'newsticker-show-entry)
-(define-key newsticker-mode-map "he" 'newsticker-hide-entry)
-(define-key newsticker-mode-map "sx" 'newsticker-show-extra)
-(define-key newsticker-mode-map "hx" 'newsticker-hide-extra)
-
-(define-key newsticker-mode-map " " 'scroll-up)
-(define-key newsticker-mode-map "q" 'newsticker-close-buffer)
-(define-key newsticker-mode-map "p" 'newsticker-previous-item)
-(define-key newsticker-mode-map "P" 'newsticker-previous-new-item)
-(define-key newsticker-mode-map "F" 'newsticker-previous-feed)
-(define-key newsticker-mode-map "\t" 'newsticker-next-item)
-(define-key newsticker-mode-map "n" 'newsticker-next-item)
-(define-key newsticker-mode-map "N" 'newsticker-next-new-item)
-(define-key newsticker-mode-map "f" 'newsticker-next-feed)
-(define-key newsticker-mode-map "M" 'newsticker-mark-all-items-as-read)
-(define-key newsticker-mode-map "m"
- 'newsticker-mark-all-items-at-point-as-read-and-redraw)
-(define-key newsticker-mode-map "o"
- 'newsticker-mark-item-at-point-as-read)
-(define-key newsticker-mode-map "O"
- 'newsticker-mark-all-items-at-point-as-read)
-(define-key newsticker-mode-map "G" 'newsticker-get-all-news)
-(define-key newsticker-mode-map "g" 'newsticker-get-news-at-point)
-(define-key newsticker-mode-map "u" 'newsticker-buffer-update)
-(define-key newsticker-mode-map "U" 'newsticker-buffer-force-update)
-(define-key newsticker-mode-map "a" 'newsticker-add-url)
-
-(define-key newsticker-mode-map "i"
- 'newsticker-mark-item-at-point-as-immortal)
-
-(define-key newsticker-mode-map "xf"
- 'newsticker-toggle-auto-narrow-to-feed)
-(define-key newsticker-mode-map "xi"
- 'newsticker-toggle-auto-narrow-to-item)
-
-;; maps for the clickable portions
-(defvar newsticker--url-keymap (make-sparse-keymap)
- "Key map for click-able headings in the newsticker buffer.")
-(define-key newsticker--url-keymap [mouse-1]
- 'newsticker-mouse-browse-url)
-(define-key newsticker--url-keymap [mouse-2]
- 'newsticker-mouse-browse-url)
-(define-key newsticker--url-keymap "\n"
- 'newsticker-browse-url)
-(define-key newsticker--url-keymap "\C-m"
- 'newsticker-browse-url)
-(define-key newsticker--url-keymap [(control return)]
- 'newsticker-handle-url)
-
-;; newsticker menu
-(defvar newsticker-menu (make-sparse-keymap "Newsticker"))
-
-(define-key newsticker-menu [newsticker-browse-url]
- '("Browse URL for item at point" . newsticker-browse-url))
-(define-key newsticker-menu [newsticker-separator-1]
- '("--"))
-(define-key newsticker-menu [newsticker-buffer-update]
- '("Update buffer" . newsticker-buffer-update))
-(define-key newsticker-menu [newsticker-separator-2]
- '("--"))
-(define-key newsticker-menu [newsticker-get-all-news]
- '("Get news from all feeds" . newsticker-get-all-news))
-(define-key newsticker-menu [newsticker-get-news-at-point]
- '("Get news from feed at point" . newsticker-get-news-at-point))
-(define-key newsticker-menu [newsticker-separator-3]
- '("--"))
-(define-key newsticker-menu [newsticker-mark-all-items-as-read]
- '("Mark all items as read" . newsticker-mark-all-items-as-read))
-(define-key newsticker-menu [newsticker-mark-all-items-at-point-as-read]
- '("Mark all items in feed at point as read" .
- newsticker-mark-all-items-at-point-as-read))
-(define-key newsticker-menu [newsticker-mark-item-at-point-as-read]
- '("Mark item at point as read" .
- newsticker-mark-item-at-point-as-read))
-(define-key newsticker-menu [newsticker-mark-item-at-point-as-immortal]
- '("Toggle immortality for item at point" .
- newsticker-mark-item-at-point-as-immortal))
-(define-key newsticker-menu [newsticker-separator-4]
- '("--"))
-(define-key newsticker-menu [newsticker-toggle-auto-narrow-to-item]
- '("Narrow to single item" . newsticker-toggle-auto-narrow-to-item))
-(define-key newsticker-menu [newsticker-toggle-auto-narrow-to-feed]
- '("Narrow to single news feed" . newsticker-toggle-auto-narrow-to-feed))
-(define-key newsticker-menu [newsticker-hide-old-items]
- '("Hide old items" . newsticker-hide-old-items))
-(define-key newsticker-menu [newsticker-show-old-items]
- '("Show old items" . newsticker-show-old-items))
-(define-key newsticker-menu [newsticker-next-item]
- '("Go to next item" . newsticker-next-item))
-(define-key newsticker-menu [newsticker-previous-item]
- '("Go to previous item" . newsticker-previous-item))
-
-;; bind menu to mouse
-(define-key newsticker-mode-map [down-mouse-3] newsticker-menu)
-;; Put menu in menu-bar
-(define-key newsticker-mode-map [menu-bar Newsticker]
- (cons "Newsticker" newsticker-menu))
-
-
-;; ======================================================================
-;;; User fun
-;; ======================================================================
-;;;###autoload
-(defun newsticker-plainview ()
- "Start newsticker plainview."
- (interactive)
- (newsticker-buffer-update t)
- (switch-to-buffer "*newsticker*"))
-
-(defun newsticker-buffer-force-update ()
- "Update the newsticker buffer, even if not necessary."
- (interactive)
- (newsticker-buffer-update t))
-
-(defun newsticker-buffer-update (&optional force)
- "Update the *newsticker* buffer.
-Unless FORCE is t this is done only if necessary, i.e. when the
-*newsticker* buffer is not up-to-date."
- (interactive)
- ;; bring cache data into proper order....
- (newsticker--cache-sort)
- ;; fill buffer
- (save-excursion
- (let ((buf (get-buffer "*newsticker*")))
- (if buf
- (switch-to-buffer buf)
- (switch-to-buffer (get-buffer-create "*newsticker*"))
- (newsticker--buffer-set-uptodate nil)))
- (when (or force
- (not newsticker--buffer-uptodate-p))
- (message "Preparing newsticker buffer...")
- (setq buffer-undo-list t)
- (let ((inhibit-read-only t))
- (set-buffer-modified-p nil)
- (erase-buffer)
- (newsticker-mode)
- ;; Emacs 21.3.50 does not care if we turn off auto-fill in the
- ;; definition of newsticker-mode, so we do it here (again)
- (auto-fill-mode -1)
-
- (set-buffer-file-coding-system 'utf-8)
-
- (if newsticker-use-full-width
- (set (make-local-variable 'fill-column) (1- (window-width))))
- (newsticker--buffer-insert-all-items)
-
- ;; FIXME: needed for methods buffer in ecb
- ;; (set-visited-file-name "*newsticker*")
-
- (set-buffer-modified-p nil)
- (newsticker-hide-all-desc)
- (if newsticker-hide-old-items-in-newsticker-buffer
- (newsticker-hide-old-items))
- (if newsticker-show-descriptions-of-new-items
- (newsticker-show-new-item-desc))
- )
- (message ""))
- (newsticker--buffer-set-uptodate t)
- (run-hooks 'newsticker-buffer-change-hook)))
-
-(defun newsticker-get-news-at-point ()
- "Launch retrieval of news for the feed point is in.
-This does NOT start the retrieval timers."
- (interactive)
- ;; launch retrieval of news
- (let ((feed (get-text-property (point) 'feed)))
- (when feed
- (newsticker--debug-msg "Getting news for %s" (symbol-name feed))
- (newsticker-get-news (symbol-name feed)))))
-
-(declare-function w3m-toggle-inline-image "ext:w3m" (&optional force no-cache))
-
-(defun newsticker-w3m-show-inline-images ()
- "Show inline images in visible text ranges.
-In-line images in invisible text ranges are hidden. This function
-calls `w3m-toggle-inline-image'. It works only if
-`newsticker-html-renderer' is set to `w3m-region'."
- (interactive)
- (if (eq newsticker-html-renderer 'w3m-region)
- (let ((inhibit-read-only t))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((pos (point)))
- (while pos
- (setq pos (next-single-property-change pos 'w3m-image))
- (when pos
- (goto-char pos)
- (when (get-text-property pos 'w3m-image)
- (let ((invis (newsticker--lists-intersect-p
- (get-text-property (1- (point))
- 'invisible)
- buffer-invisibility-spec)))
- (unless (car (get-text-property (1- (point))
- 'display))
- (unless invis
- (w3m-toggle-inline-image t)))))))))))))
-
-;; ======================================================================
-;;; Keymap stuff
-;; ======================================================================
-(defun newsticker-close-buffer ()
- "Close the newsticker buffer."
- (interactive)
- (newsticker--cache-update t)
- (bury-buffer))
-
-(defun newsticker-next-new-item (&optional do-not-wrap-at-eob)
- "Go to next new news item.
-If no new item is found behind point, search is continued at
-beginning of buffer unless optional argument DO-NOT-WRAP-AT-EOB
-is non-nil."
- (interactive)
- (widen)
- (let ((go-ahead t))
- (while go-ahead
- (unless (newsticker--buffer-goto '(item) 'new)
- ;; found nothing -- wrap
- (unless do-not-wrap-at-eob
- (goto-char (point-min))
- (newsticker-next-new-item t))
- (setq go-ahead nil))
- (unless (newsticker--lists-intersect-p
- (get-text-property (point) 'invisible)
- buffer-invisibility-spec)
- ;; this item is invisible -- continue search
- (setq go-ahead nil))))
- (run-hooks 'newsticker-select-item-hook)
- (point))
-
-(defun newsticker-previous-new-item (&optional do-not-wrap-at-bob)
- "Go to previous new news item.
-If no new item is found before point, search is continued at
-beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
-is non-nil."
- (interactive)
- (widen)
- (let ((go-ahead t))
- (while go-ahead
- (unless (newsticker--buffer-goto '(item) 'new t)
- (unless do-not-wrap-at-bob
- (goto-char (point-max))
- (newsticker--buffer-goto '(item) 'new t)))
- (unless (newsticker--lists-intersect-p
- (get-text-property (point) 'invisible)
- buffer-invisibility-spec)
- (setq go-ahead nil))))
- (run-hooks 'newsticker-select-item-hook)
- (point))
-
-(defun newsticker-next-item (&optional do-not-wrap-at-eob)
- "Go to next news item.
-Return new buffer position.
-If no item is found below point, search is continued at beginning
-of buffer unless optional argument DO-NOT-WRAP-AT-EOB is
-non-nil."
- (interactive)
- (widen)
- (let ((go-ahead t)
- (search-list '(item)))
- (if newsticker--auto-narrow-to-item
- (setq search-list '(item feed)))
- (while go-ahead
- (unless (newsticker--buffer-goto search-list)
- ;; found nothing -- wrap
- (unless do-not-wrap-at-eob
- (goto-char (point-min)))
- (setq go-ahead nil))
- (unless (newsticker--lists-intersect-p
- (get-text-property (point) 'invisible)
- buffer-invisibility-spec)
- (setq go-ahead nil))))
- (run-hooks 'newsticker-select-item-hook)
- (force-mode-line-update)
- (point))
-
-(defun newsticker-next-item-same-feed ()
- "Go to next news item in the same feed.
-Return new buffer position. If no item is found below point or if
-auto-narrow-to-item is enabled, nil is returned."
- (interactive)
- (if newsticker--auto-narrow-to-item
- nil
- (let ((go-ahead t)
- (current-pos (point))
- (end-of-feed (save-excursion (newsticker--buffer-end-of-feed))))
- (while go-ahead
- (unless (newsticker--buffer-goto '(item))
- (setq go-ahead nil))
- (unless (newsticker--lists-intersect-p
- (get-text-property (point) 'invisible)
- buffer-invisibility-spec)
- (setq go-ahead nil)))
- (if (and (> (point) current-pos)
- (< (point) end-of-feed))
- (point)
- (goto-char current-pos)
- nil))))
-
-(defun newsticker-previous-item (&optional do-not-wrap-at-bob)
- "Go to previous news item.
-Return new buffer position.
-If no item is found before point, search is continued at
-beginning of buffer unless optional argument DO-NOT-WRAP-AT-BOB
-is non-nil."
- (interactive)
- (widen)
- (let ((go-ahead t)
- (search-list '(item)))
- (if newsticker--auto-narrow-to-item
- (setq search-list '(item feed)))
- (when (bobp)
- (unless do-not-wrap-at-bob
- (goto-char (point-max))))
- (while go-ahead
- (if (newsticker--buffer-goto search-list nil t)
- (unless (newsticker--lists-intersect-p
- (get-text-property (point) 'invisible)
- buffer-invisibility-spec)
- (setq go-ahead nil))
- (goto-char (point-min))
- (setq go-ahead nil))))
- (run-hooks 'newsticker-select-item-hook)
- (force-mode-line-update)
- (point))
-
-(defun newsticker-next-feed ()
- "Go to next news feed.
-Return new buffer position."
- (interactive)
- (widen)
- (newsticker--buffer-goto '(feed))
- (run-hooks 'newsticker-select-feed-hook)
- (force-mode-line-update)
- (point))
-
-(defun newsticker-previous-feed ()
- "Go to previous news feed.
-Return new buffer position."
- (interactive)
- (widen)
- (newsticker--buffer-goto '(feed) nil t)
- (run-hooks 'newsticker-select-feed-hook)
- (force-mode-line-update)
- (point))
-
-(defun newsticker-mark-all-items-at-point-as-read-and-redraw ()
- "Mark all items as read and clear ticker contents."
- (interactive)
- (when (or newsticker--buffer-uptodate-p
- (y-or-n-p
- "Buffer is not up to date -- really mark items as read? "))
- (newsticker-mark-all-items-of-feed-as-read
- (get-text-property (point) 'feed))))
-
-(defun newsticker-mark-all-items-of-feed-as-read (feed)
- "Mark all items of FEED as read, clear ticker, and redraw buffer."
- (when feed
- (let ((pos (point)))
- (message "Marking all items as read for %s" (symbol-name feed))
- (newsticker--cache-replace-age newsticker--cache feed 'new 'old)
- (newsticker--cache-replace-age newsticker--cache feed 'obsolete
- 'old)
- (newsticker--cache-update)
- (newsticker--buffer-set-uptodate nil)
- (newsticker--ticker-text-setup)
- (newsticker-buffer-update)
- ;; go back to where we came frome
- (goto-char pos)
- (end-of-line)
- (newsticker--buffer-goto '(feed) nil t))))
-
-(defun newsticker-mark-all-items-at-point-as-read ()
- "Mark all items as read and clear ticker contents."
- (interactive)
- (when (or newsticker--buffer-uptodate-p
- (y-or-n-p
- "Buffer is not up to date -- really mark items as read? "))
- (newsticker--do-mark-item-at-point-as-read t)
- (while (newsticker-next-item-same-feed)
- (newsticker--do-mark-item-at-point-as-read t))
- (newsticker-next-item t)))
-
-(defun newsticker-mark-item-at-point-as-read (&optional respect-immortality)
- "Mark item at point as read and move to next item.
-If optional argument RESPECT-IMMORTALITY is not nil immortal items do
-not get changed."
- (interactive)
- (when (or newsticker--buffer-uptodate-p
- (y-or-n-p
- "Buffer is not up to date -- really mark this item as read? "))
- (newsticker--do-mark-item-at-point-as-read respect-immortality)
- ;; move forward
- (newsticker-next-item t)))
-
-(defun newsticker--do-mark-item-at-point-as-read (&optional respect-immortality)
- "Mark item at point as read.
-If optional argument RESPECT-IMMORTALITY is not nil immortal items do
-not get changed."
- (let ((feed (get-text-property (point) 'feed)))
- (when feed
- (save-excursion
- (newsticker--buffer-beginning-of-item)
- (let ((inhibit-read-only t)
- (age (get-text-property (point) 'nt-age))
- (title (get-text-property (point) 'nt-title))
- (guid (get-text-property (point) 'nt-guid))
- (nt-desc (get-text-property (point) 'nt-desc))
- (pos (save-excursion (newsticker--buffer-end-of-item)))
- item)
- (when (or (eq age 'new)
- (eq age 'obsolete)
- (and (eq age 'immortal)
- (not respect-immortality)))
- ;; find item
- (setq item (newsticker--cache-contains newsticker--cache
- feed title nt-desc
- nil nil guid))
- ;; mark as old
- (when item
- (setcar (nthcdr 4 item) 'old)
- (newsticker--do-forget-preformatted item))
- ;; clean up ticker
- (if (or (and (eq age 'new)
- newsticker-hide-immortal-items-in-echo-area)
- (and (memq age '(old immortal))
- (not
- (eq newsticker-hide-old-items-in-newsticker-buffer
- newsticker-hide-immortal-items-in-echo-area))))
- (newsticker--ticker-text-remove feed title))
- ;; set faces etc.
- (save-excursion
- (save-restriction
- (widen)
- (put-text-property (point) pos 'nt-age 'old)
- (newsticker--buffer-set-faces (point) pos)))
- (set-buffer-modified-p nil)))))))
-
-(defun newsticker-mark-item-at-point-as-immortal ()
- "Mark item at point as read."
- (interactive)
- (when (or newsticker--buffer-uptodate-p
- (y-or-n-p
- "Buffer is not up to date -- really mark this item as read? "))
- (let ((feed (get-text-property (point) 'feed))
- (item nil))
- (when feed
- (save-excursion
- (newsticker--buffer-beginning-of-item)
- (let ((inhibit-read-only t)
- (oldage (get-text-property (point) 'nt-age))
- (title (get-text-property (point) 'nt-title))
- (guid (get-text-property (point) 'nt-guid))
- (pos (save-excursion (newsticker--buffer-end-of-item))))
- (let ((newage 'immortal))
- (if (eq oldage 'immortal)
- (setq newage 'old))
- (setq item (newsticker--cache-contains newsticker--cache
- feed title nil nil nil
- guid))
- ;; change age
- (when item
- (setcar (nthcdr 4 item) newage)
- (newsticker--do-forget-preformatted item))
- (if (or (and (eq newage 'immortal)
- newsticker-hide-immortal-items-in-echo-area)
- (and (eq newage 'obsolete)
- newsticker-hide-obsolete-items-in-echo-area)
- (and (eq oldage 'immortal)
- (not
- (eq newsticker-hide-old-items-in-newsticker-buffer
- newsticker-hide-immortal-items-in-echo-area))))
- (newsticker--ticker-text-remove feed title)
- (newsticker--ticker-text-setup))
- (save-excursion
- (save-restriction
- (widen)
- (put-text-property (point) pos 'nt-age newage)
- (if (eq newage 'immortal)
- (put-text-property (point) pos 'nt-age 'immortal)
- (put-text-property (point) pos 'nt-age 'old))
- (newsticker--buffer-set-faces (point) pos))))))
- (if item
- (newsticker-next-item t))))))
-
-(defun newsticker-mark-all-items-as-read ()
- "Mark all items as read and clear ticker contents."
- (interactive)
- (when (or newsticker--buffer-uptodate-p
- (y-or-n-p
- "Buffer is not up to date -- really mark items as read? "))
- (newsticker--cache-replace-age newsticker--cache 'any 'new 'old)
- (newsticker--buffer-set-uptodate nil)
- (newsticker--ticker-text-setup)
- (newsticker--cache-update)
- (newsticker-buffer-update)))
-
-(defun newsticker-hide-extra ()
- "Hide the extra elements of items."
- (interactive)
- (newsticker--buffer-hideshow 'extra nil)
- (newsticker--buffer-redraw))
-
-(defun newsticker-show-extra ()
- "Show the extra elements of items."
- (interactive)
- (newsticker--buffer-hideshow 'extra t)
- (newsticker--buffer-redraw))
-
-(defun newsticker-hide-old-item-desc ()
- "Hide the description of old items."
- (interactive)
- (newsticker--buffer-hideshow 'desc-old nil)
- (newsticker--buffer-redraw))
-
-(defun newsticker-show-old-item-desc ()
- "Show the description of old items."
- (interactive)
- (newsticker--buffer-hideshow 'item-old t)
- (newsticker--buffer-hideshow 'desc-old t)
- (newsticker--buffer-redraw))
-
-(defun newsticker-hide-new-item-desc ()
- "Hide the description of new items."
- (interactive)
- (newsticker--buffer-hideshow 'desc-new nil)
- (newsticker--buffer-hideshow 'desc-immortal nil)
- (newsticker--buffer-hideshow 'desc-obsolete nil)
- (newsticker--buffer-redraw))
-
-(defun newsticker-show-new-item-desc ()
- "Show the description of new items."
- (interactive)
- (newsticker--buffer-hideshow 'desc-new t)
- (newsticker--buffer-hideshow 'desc-immortal t)
- (newsticker--buffer-hideshow 'desc-obsolete t)
- (newsticker--buffer-redraw))
-
-(defun newsticker-hide-feed-desc ()
- "Hide the description of feeds."
- (interactive)
- (newsticker--buffer-hideshow 'desc-feed nil)
- (newsticker--buffer-redraw))
-
-(defun newsticker-show-feed-desc ()
- "Show the description of old items."
- (interactive)
- (newsticker--buffer-hideshow 'desc-feed t)
- (newsticker--buffer-redraw))
-
-(defun newsticker-hide-all-desc ()
- "Hide the descriptions of feeds and all items."
- (interactive)
- (newsticker--buffer-hideshow 'desc-feed nil)
- (newsticker--buffer-hideshow 'desc-immortal nil)
- (newsticker--buffer-hideshow 'desc-obsolete nil)
- (newsticker--buffer-hideshow 'desc-new nil)
- (newsticker--buffer-hideshow 'desc-old nil)
- (newsticker--buffer-redraw))
-
-(defun newsticker-show-all-desc ()
- "Show the descriptions of feeds and all items."
- (interactive)
- (newsticker--buffer-hideshow 'desc-feed t)
- (newsticker--buffer-hideshow 'desc-immortal t)
- (newsticker--buffer-hideshow 'desc-obsolete t)
- (newsticker--buffer-hideshow 'desc-new t)
- (newsticker--buffer-hideshow 'desc-old t)
- (newsticker--buffer-redraw))
-
-(defun newsticker-hide-old-items ()
- "Hide old items."
- (interactive)
- (newsticker--buffer-hideshow 'desc-old nil)
- (newsticker--buffer-hideshow 'item-old nil)
- (newsticker--buffer-redraw))
-
-(defun newsticker-show-old-items ()
- "Show old items."
- (interactive)
- (newsticker--buffer-hideshow 'item-old t)
- (newsticker--buffer-redraw))
-
-(defun newsticker-hide-entry ()
- "Hide description of entry at point."
- (interactive)
- (save-excursion
- (let* (pos1 pos2
- (inhibit-read-only t)
- inv-prop org-inv-prop
- is-invisible)
- (newsticker--buffer-beginning-of-item)
- (newsticker--buffer-goto '(desc))
- (setq pos1 (max (point-min) (1- (point))))
- (newsticker--buffer-goto '(extra feed item nil))
- (setq pos2 (max (point-min) (1- (point))))
- (setq inv-prop (get-text-property pos1 'invisible))
- (setq org-inv-prop (get-text-property pos1 'org-invisible))
- (cond ((eq inv-prop t)
- ;; do nothing
- )
- ((eq org-inv-prop nil)
- (add-text-properties pos1 pos2
- (list 'invisible (list t)
- 'org-invisible inv-prop)))
- (t
- ;; toggle
- (add-text-properties pos1 pos2
- (list 'invisible org-inv-prop))
- (remove-text-properties pos1 pos2 '(org-invisible))))))
- (newsticker--buffer-redraw))
-
-(defun newsticker-show-entry ()
- "Show description of entry at point."
- (interactive)
- (save-excursion
- (let* (pos1 pos2
- (inhibit-read-only t)
- inv-prop org-inv-prop
- is-invisible)
- (newsticker--buffer-beginning-of-item)
- (newsticker--buffer-goto '(desc))
- (setq pos1 (max (point-min) (1- (point))))
- (newsticker--buffer-goto '(extra feed item))
- (setq pos2 (max (point-min) (1- (point))))
- (setq inv-prop (get-text-property pos1 'invisible))
- (setq org-inv-prop (get-text-property pos1 'org-invisible))
- (cond ((eq org-inv-prop nil)
- (add-text-properties pos1 pos2
- (list 'invisible nil
- 'org-invisible inv-prop)))
- (t
- ;; toggle
- (add-text-properties pos1 pos2
- (list 'invisible org-inv-prop))
- (remove-text-properties pos1 pos2 '(org-invisible))))))
- (newsticker--buffer-redraw))
-
-(defun newsticker-toggle-auto-narrow-to-feed ()
- "Toggle narrowing to current news feed.
-If auto-narrowing is active, only news item of the current feed
-are visible."
- (interactive)
- (newsticker-set-auto-narrow-to-feed
- (not newsticker--auto-narrow-to-feed)))
-
-(defun newsticker-set-auto-narrow-to-feed (value)
- "Turn narrowing to current news feed on or off.
-If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
- (interactive)
- (setq newsticker--auto-narrow-to-item nil)
- (setq newsticker--auto-narrow-to-feed value)
- (widen)
- (newsticker--buffer-make-item-completely-visible)
- (run-hooks 'newsticker-narrow-hook))
-
-(defun newsticker-toggle-auto-narrow-to-item ()
- "Toggle narrowing to current news item.
-If auto-narrowing is active, only one item of the current feed
-is visible."
- (interactive)
- (newsticker-set-auto-narrow-to-item
- (not newsticker--auto-narrow-to-item)))
-
-(defun newsticker-set-auto-narrow-to-item (value)
- "Turn narrowing to current news item on or off.
-If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
- (interactive)
- (setq newsticker--auto-narrow-to-feed nil)
- (setq newsticker--auto-narrow-to-item value)
- (widen)
- (newsticker--buffer-make-item-completely-visible)
- (run-hooks 'newsticker-narrow-hook))
-
-(defun newsticker-next-feed-available-p ()
- "Return t if position is before last feed, nil otherwise."
- (save-excursion
- (let ((p (point)))
- (newsticker--buffer-goto '(feed))
- (not (= p (point))))))
-
-(defun newsticker-previous-feed-available-p ()
- "Return t if position is behind first feed, nil otherwise."
- (save-excursion
- (let ((p (point)))
- (newsticker--buffer-goto '(feed) nil t)
- (not (= p (point))))))
-
-(defun newsticker-next-item-available-p ()
- "Return t if position is before last feed, nil otherwise."
- (save-excursion
- (catch 'result
- (while (< (point) (point-max))
- (unless (newsticker--buffer-goto '(item))
- (throw 'result nil))
- (unless (newsticker--lists-intersect-p
- (get-text-property (point) 'invisible)
- buffer-invisibility-spec)
- (throw 'result t))))))
-
-(defun newsticker-previous-item-available-p ()
- "Return t if position is behind first item, nil otherwise."
- (save-excursion
- (catch 'result
- (while (> (point) (point-min))
- (unless (newsticker--buffer-goto '(item) nil t)
- (throw 'result nil))
- (unless (newsticker--lists-intersect-p
- (get-text-property (point) 'invisible)
- buffer-invisibility-spec)
- (throw 'result t))))))
-
-(defun newsticker-item-not-old-p ()
- "Return t if there is an item at point which is not old, nil otherwise."
- (when (get-text-property (point) 'feed)
- (save-excursion
- (newsticker--buffer-beginning-of-item)
- (let ((age (get-text-property (point) 'nt-age)))
- (and (memq age '(new immortal obsolete)) t)))))
-
-(defun newsticker-item-not-immortal-p ()
- "Return t if there is an item at point which is not immortal, nil otherwise."
- (when (get-text-property (point) 'feed)
- (save-excursion
- (newsticker--buffer-beginning-of-item)
- (let ((age (get-text-property (point) 'nt-age)))
- (and (memq age '(new old obsolete)) t)))))
-
-;; ======================================================================
-;;; Imenu stuff
-;; ======================================================================
-(defun newsticker--imenu-create-index ()
- "Scan newsticker buffer and return an index for imenu."
- (save-excursion
- (goto-char (point-min))
- (let ((index-alist nil)
- (feed-list nil)
- (go-ahead t))
- (while go-ahead
- (let ((type (get-text-property (point) 'nt-type))
- (title (get-text-property (point) 'nt-title)))
- (cond ((eq type 'feed)
- ;; we're on a feed heading
- (when feed-list
- (if index-alist
- (nconc index-alist (list feed-list))
- (setq index-alist (list feed-list))))
- (setq feed-list (list title)))
- (t
- (nconc feed-list
- (list (cons title (point)))))))
- (setq go-ahead (newsticker--buffer-goto '(item feed))))
- (if index-alist
- (nconc index-alist (list feed-list))
- (setq index-alist (list feed-list)))
- index-alist)))
-
-(defun newsticker--imenu-goto (name pos &rest args)
- "Go to item NAME at position POS and show item.
-ARGS are ignored."
- (goto-char pos)
- ;; show headline
- (newsticker--buffer-goto '(desc extra feed item))
- (let* ((inhibit-read-only t)
- (pos1 (max (point-min) (1- pos)))
- (pos2 (max pos1 (1- (point))))
- (inv-prop (get-text-property pos 'invisible))
- (org-inv-prop (get-text-property pos 'org-invisible)))
- (when (eq org-inv-prop nil)
- (add-text-properties pos1 pos2 (list 'invisible nil
- 'org-invisible inv-prop))))
- ;; show desc
- (newsticker-show-entry))
-
-;; ======================================================================
-;;; Buffer stuff
-;; ======================================================================
-(defun newsticker--buffer-set-uptodate (value)
- "Set the uptodate-status of the newsticker buffer to VALUE.
-The mode-line is changed accordingly."
- (setq newsticker--buffer-uptodate-p value)
- (let ((b (get-buffer "*newsticker*")))
- (when b
- (save-excursion
- (set-buffer b)
- (if value
- (setq mode-name "Newsticker -- up to date -- ")
- (setq mode-name "Newsticker -- NEED UPDATE -- ")))
- (force-mode-line-update 0))))
-
-(defun newsticker--buffer-redraw ()
- "Redraw the newsticker window."
- (if (fboundp 'force-window-update)
- (force-window-update (current-buffer))
- (redraw-frame (selected-frame)))
- (run-hooks 'newsticker-buffer-change-hook)
- (sit-for 0))
-
-(defun newsticker--buffer-insert-all-items ()
- "Insert all cached newsticker items into the current buffer.
-Keeps order of feeds as given in `newsticker-url-list' and
-`newsticker-url-list-defaults'."
- (goto-char (point-min))
- (mapc (lambda (url-item)
- (let* ((feed-name (car url-item))
- (feed-name-symbol (intern feed-name))
- (feed (assoc feed-name-symbol newsticker--cache))
- (items (cdr feed))
- (pos (point)))
- (when feed
- ;; insert the feed description
- (mapc (lambda (item)
- (when (eq (newsticker--age item) 'feed)
- (newsticker--buffer-insert-item item
- feed-name-symbol)))
- items)
- ;;insert the items
- (mapc (lambda (item)
- (if (memq (newsticker--age item) '(new immortal old
- obsolete))
- (newsticker--buffer-insert-item item
- feed-name-symbol)))
- items)
- (put-text-property pos (point) 'feed (car feed))
-
- ;; insert empty line between feeds
- (let ((p (point)))
- (insert "\n")
- (put-text-property p (point) 'hard t)))))
- (append newsticker-url-list newsticker-url-list-defaults))
-
- (newsticker--buffer-set-faces (point-min) (point-max))
- (newsticker--buffer-set-invisibility (point-min) (point-max))
- (goto-char (point-min)))
-
-(defun newsticker--buffer-insert-item (item &optional feed-name-symbol)
- "Insert a news item in the current buffer.
-Insert a formatted representation of the ITEM. The optional parameter
-FEED-NAME-SYMBOL determines how the item is formatted and whether the
-item-retrieval time is added as well."
- ;; insert headline
- (if (eq (newsticker--age item) 'feed)
- (newsticker--buffer-do-insert-text item 'feed feed-name-symbol)
- (newsticker--buffer-do-insert-text item 'item feed-name-symbol))
- ;; insert the description
- (newsticker--buffer-do-insert-text item 'desc feed-name-symbol))
-
-(defun newsticker--buffer-do-insert-text (item type feed-name-symbol)
- "Actually insert contents of news item, format it, render it and all that.
-ITEM is a news item, TYPE tells which part of the item shall be inserted,
-FEED-NAME-SYMBOL tells to which feed this item belongs."
- (let* ((pos (point))
- (format newsticker-desc-format)
- (pos-date-start nil)
- (pos-date-end nil)
- (pos-stat-start nil)
- (pos-stat-end nil)
- (pos-text-start nil)
- (pos-text-end nil)
- (pos-extra-start nil)
- (pos-extra-end nil)
- (pos-enclosure-start nil)
- (pos-enclosure-end nil)
- (age (newsticker--age item))
- (preformatted-contents (newsticker--preformatted-contents item))
- (preformatted-title (newsticker--preformatted-title item)))
- (cond ((and preformatted-contents
- (not (eq (aref preformatted-contents 0) ?\n));; we must
- ;; NOT have a line
- ;; break!
- (eq type 'desc))
- (insert preformatted-contents))
- ((and preformatted-title
- (not (eq (aref preformatted-title 0) ?\n));; we must NOT have a
- ;; line break!
- (eq type 'item))
- (insert preformatted-title))
- (t
- ;; item was not formatted before.
- ;; Let's go.
- (if (eq type 'item)
- (setq format newsticker-item-format)
- (if (eq type 'feed)
- (setq format newsticker-heading-format)))
-
- (while (> (length format) 0)
- (let ((prefix (if (> (length format) 1)
- (substring format 0 2)
- "")))
- (cond ((string= "%c" prefix)
- ;; contents
- (when (newsticker--desc item)
- (setq pos-text-start (point-marker))
- (insert (newsticker--desc item))
- (setq pos-text-end (point-marker)))
- (setq format (substring format 2)))
- ((string= "%d" prefix)
- ;; date
- (setq pos-date-start (point-marker))
- (if (newsticker--time item)
- (insert (format-time-string newsticker-date-format
- (newsticker--time item))))
- (setq pos-date-end (point-marker))
- (setq format (substring format 2)))
- ((string= "%l" prefix)
- ;; logo
- (let ((disabled (cond ((eq (newsticker--age item) 'feed)
- (= (newsticker--stat-num-items
- feed-name-symbol 'new) 0))
- (t
- (not (eq (newsticker--age item)
- 'new))))))
- (let ((img (newsticker--image-read feed-name-symbol
- disabled)))
- (when img
- (newsticker--insert-image img (car item)))))
- (setq format (substring format 2)))
- ((string= "%L" prefix)
- ;; logo or title
- (let ((disabled (cond ((eq (newsticker--age item) 'feed)
- (= (newsticker--stat-num-items
- feed-name-symbol 'new) 0))
- (t
- (not (eq (newsticker--age item)
- 'new))))))
- (let ((img (newsticker--image-read feed-name-symbol
- disabled)))
- (if img
- (newsticker--insert-image img (car item))
- (when (car item)
- (setq pos-text-start (point-marker))
- (if (eq (newsticker--age item) 'feed)
- (insert (newsticker--title item))
- ;; FIXME: This is not the "real" title!
- (insert (format "%s"
- (car (newsticker--cache-get-feed
- feed-name-symbol)))))
- (setq pos-text-end (point-marker))))))
- (setq format (substring format 2)))
- ((string= "%s" prefix)
- ;; statistics
- (setq pos-stat-start (point-marker))
- (if (eq (newsticker--age item) 'feed)
- (insert (newsticker--buffer-statistics
- feed-name-symbol)))
- (setq pos-stat-end (point-marker))
- (setq format (substring format 2)))
- ((string= "%t" prefix)
- ;; title
- (when (car item)
- (setq pos-text-start (point-marker))
- (insert (car item))
- (setq pos-text-end (point-marker)))
- (setq format (substring format 2)))
- ((string-match "%." prefix)
- ;; unknown specifier!
- (insert prefix)
- (setq format (substring format 2)))
- ((string-match "^\\([^%]*\\)\\(.*\\)" format) ;; FIXME!
- ;; everything else
- (let ((p (point)))
- (insert (substring format
- (match-beginning 1) (match-end 1)))
- ;; in case that the format string contained newlines
- (put-text-property p (point) 'hard t))
- (setq format (substring format (match-beginning 2)))))))
-
- ;; decode HTML if possible...
- (let ((is-rendered-HTML nil))
- (when (and newsticker-html-renderer pos-text-start pos-text-end)
- (condition-case error-data
- (save-excursion
- ;; check whether it is necessary to call html renderer
- ;; (regexp inspired by htmlr.el)
- (goto-char pos-text-start)
- (when (re-search-forward
- "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" pos-text-end t)
- ;; (message "%s" (newsticker--title item))
- (let ((w3m-fill-column (if newsticker-use-full-width
- -1 fill-column))
- (w3-maximum-line-length
- (if newsticker-use-full-width nil fill-column)))
- (save-excursion
- (funcall newsticker-html-renderer pos-text-start
- pos-text-end)))
- (cond ((eq newsticker-html-renderer 'w3m-region)
- (add-text-properties pos (point-max)
- (list 'keymap
- w3m-minor-mode-map)))
- ((eq newsticker-html-renderer 'w3-region)
- (add-text-properties pos (point-max)
- (list 'keymap w3-mode-map))))
- (setq is-rendered-HTML t)))
- (error
- (message "Error: HTML rendering failed: %s, %s"
- (car error-data) (cdr error-data)))))
- ;; After html rendering there might be chunks of blank
- ;; characters between rendered text and date, statistics or
- ;; whatever. Remove it
- (when (and (eq type 'item) is-rendered-HTML)
- (goto-char pos)
- (while (re-search-forward "[ \t]*\n[ \t]*" nil t)
- (replace-match " " nil nil))
- (goto-char (point-max)))
- (when (and newsticker-justification
- (memq type '(item desc))
- (not is-rendered-HTML))
- (condition-case nil
- (let ((use-hard-newlines t))
- (fill-region pos (point-max) newsticker-justification))
- (error nil))))
-
- ;; remove leading and trailing newlines
- (goto-char pos)
- (unless (= 0 (skip-chars-forward " \t\r\n"))
- (delete-region pos (point)))
- (goto-char (point-max))
- (let ((end (point)))
- (unless (= 0 (skip-chars-backward " \t\r\n" (1+ pos)))
- (delete-region (point) end)))
- (goto-char (point-max))
- ;; closing newline
- (unless nil ;;(eq pos (point))
- (insert "\n")
- (put-text-property (1- (point)) (point) 'hard t))
-
- ;; insert enclosure element
- (when (eq type 'desc)
- (setq pos-enclosure-start (point))
- (newsticker--insert-enclosure item newsticker--url-keymap)
- (setq pos-enclosure-end (point)))
-
- ;; show extra elements
- (when (eq type 'desc)
- (goto-char (point-max))
- (setq pos-extra-start (point))
- (newsticker--print-extra-elements item newsticker--url-keymap)
- (setq pos-extra-end (point)))
-
- ;; text properties
- (when (memq type '(feed item))
- (add-text-properties pos (1- (point))
- (list 'mouse-face 'highlight
- 'nt-link (newsticker--link item)
- 'help-echo
- (format "mouse-2: visit item (%s)"
- (newsticker--link item))
- 'keymap newsticker--url-keymap))
- (add-text-properties pos (point)
- (list 'nt-title (newsticker--title item)
- 'nt-desc (newsticker--desc item))))
-
- (add-text-properties pos (point)
- (list 'nt-type type
- 'nt-face type
- 'nt-age age
- 'nt-guid (newsticker--guid item)))
- (when (and pos-date-start pos-date-end)
- (put-text-property pos-date-start pos-date-end 'nt-face 'date))
- (when (and pos-stat-start pos-stat-end)
- (put-text-property pos-stat-start pos-stat-end 'nt-face 'stat))
- (when (and pos-extra-start pos-extra-end)
- (put-text-property pos-extra-start pos-extra-end
- 'nt-face 'extra)
- (put-text-property pos-extra-start pos-extra-end
- 'nt-type 'extra))
- (when (and pos-enclosure-start pos-enclosure-end
- (> pos-enclosure-end pos-enclosure-start))
- (put-text-property pos-enclosure-start (1- pos-enclosure-end)
- 'nt-face 'enclosure))
-
- ;; left margin
- ;;(unless (memq type '(feed item))
- ;;(set-left-margin pos (1- (point)) 1))
-
- ;; save rendered stuff
- (cond ((eq type 'desc)
- ;; preformatted contents
- (newsticker--cache-set-preformatted-contents
- item (buffer-substring pos (point))))
- ((eq type 'item)
- ;; preformatted title
- (newsticker--cache-set-preformatted-title
- item (buffer-substring pos (point)))))))))
-
-(defun newsticker--buffer-statistics (feed-name-symbol)
- "Return a statistic string for the feed given by FEED-NAME-SYMBOL.
-See `newsticker-statistics-format'."
- (let ((case-fold-search nil))
- (replace-regexp-in-string
- "%a"
- (format "%d" (newsticker--stat-num-items feed-name-symbol))
- (replace-regexp-in-string
- "%i"
- (format "%d" (newsticker--stat-num-items feed-name-symbol 'immortal))
- (replace-regexp-in-string
- "%n"
- (format "%d" (newsticker--stat-num-items feed-name-symbol 'new))
- (replace-regexp-in-string
- "%o"
- (format "%d" (newsticker--stat-num-items feed-name-symbol 'old))
- (replace-regexp-in-string
- "%O"
- (format "%d" (newsticker--stat-num-items feed-name-symbol 'obsolete))
- newsticker-statistics-format)))))))
-
-(defun newsticker--buffer-set-faces (start end)
- "Add face properties according to mark property.
-Scans the buffer between START and END."
- (save-excursion
- (put-text-property start end 'face 'newsticker-default-face)
- (goto-char start)
- (let ((pos1 start)
- (pos2 1)
- (nt-face (get-text-property start 'nt-face))
- (nt-age (get-text-property start 'nt-age)))
- (when nt-face
- (setq pos2 (next-single-property-change (point) 'nt-face))
- (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
- (setq nt-face (get-text-property pos2 'nt-face))
- (setq pos1 pos2))
- (while (and (setq pos2 (next-single-property-change pos1 'nt-face))
- (<= pos2 end)
- (> pos2 pos1))
- (newsticker--set-face-properties pos1 pos2 nt-face nt-age)
- (setq nt-face (get-text-property pos2 'nt-face))
- (setq nt-age (get-text-property pos2 'nt-age))
- (setq pos1 pos2)))))
-
-(defun newsticker--buffer-set-invisibility (start end)
- "Add invisibility properties according to nt-type property.
-Scans the buffer between START and END. Sets the 'invisible
-property to '(<nt-type>-<nt-age> <nt-type> <nt-age>)."
- (save-excursion
- ;; reset invisibility settings
- (put-text-property start end 'invisible nil)
- ;; let's go
- (goto-char start)
- (let ((pos1 start)
- (pos2 1)
- (nt-type (get-text-property start 'nt-type))
- (nt-age (get-text-property start 'nt-age)))
- (when nt-type
- (setq pos2 (next-single-property-change (point) 'nt-type))
- (put-text-property (max (point-min) pos1) (1- pos2)
- 'invisible
- (list (intern
- (concat
- (symbol-name
- (if (eq nt-type 'extra) 'desc nt-type))
- "-"
- (symbol-name nt-age)))
- nt-type
- nt-age))
- (setq nt-type (get-text-property pos2 'nt-type))
- (setq pos1 pos2))
- (while (and (setq pos2 (next-single-property-change pos1 'nt-type))
- (<= pos2 end)
- (> pos2 pos1))
- ;; must shift one char to the left in order to handle inivisible
- ;; newlines, motion in invisible text areas and all that correctly
- (put-text-property (1- pos1) (1- pos2)
- 'invisible
- (list (intern
- (concat
- (symbol-name
- (if (eq nt-type 'extra) 'desc nt-type))
- "-"
- (symbol-name nt-age)))
- nt-type
- nt-age))
- (setq nt-type (get-text-property pos2 'nt-type))
- (setq nt-age (get-text-property pos2 'nt-age))
- (setq pos1 pos2)))))
-
-(defun newsticker--set-face-properties (pos1 pos2 nt-face age)
- "Set the face for the text between the positions POS1 and POS2.
-The face is chosen according the values of NT-FACE and AGE."
- (let ((face (cond ((eq nt-face 'feed)
- 'newsticker-feed-face)
- ((eq nt-face 'item)
- (cond ((eq age 'new)
- 'newsticker-new-item-face)
- ((eq age 'old)
- 'newsticker-old-item-face)
- ((eq age 'immortal)
- 'newsticker-immortal-item-face)
- ((eq age 'obsolete)
- 'newsticker-obsolete-item-face)))
- ((eq nt-face 'date)
- 'newsticker-date-face)
- ((eq nt-face 'stat)
- 'newsticker-statistics-face)
- ((eq nt-face 'extra)
- 'newsticker-extra-face)
- ((eq nt-face 'enclosure)
- 'newsticker-enclosure-face))))
- (when face
- (put-text-property pos1 (max pos1 pos2) 'face face))))
-
-;; ======================================================================
-;;; Functions working on the *newsticker* buffer
-;; ======================================================================
-(defun newsticker--buffer-make-item-completely-visible ()
- "Scroll buffer until current item is completely visible."
- (when newsticker--auto-narrow-to-feed
- (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-feed))
- (point-min)))
- (max (or (save-excursion (newsticker--buffer-end-of-feed))
- (point-max))))
- (narrow-to-region min max)))
- (when newsticker--auto-narrow-to-item
- (let* ((min (or (save-excursion (newsticker--buffer-beginning-of-item))
- (point-min)))
- (max (or (save-excursion (newsticker--buffer-end-of-item))
- (point-max))))
- (narrow-to-region min max)))
- (sit-for 0)
- ;; do not count lines and stuff because that does not work when images
- ;; are displayed. Do it the simple way:
- (save-excursion
- (newsticker--buffer-end-of-item)
- (unless (pos-visible-in-window-p)
- (recenter -1)))
- (unless (pos-visible-in-window-p)
- (recenter 0)))
-
-(defun newsticker--buffer-get-feed-title-at-point ()
- "Return feed symbol of headline at point."
- (format "%s" (or (get-text-property (point) 'feed) " ")))
-
-(defun newsticker--buffer-get-item-title-at-point ()
- "Return feed symbol of headline at point."
- (format "%s" (or (get-text-property (point) 'nt-title) " ")))
-
-(defun newsticker--buffer-goto (types &optional age backwards)
- "Search next occurrence of TYPES in current buffer.
-TYPES is a list of symbols. If TYPES is found point is moved, if
-not point is left unchanged. If optional parameter AGE is not
-nil, the type AND the age must match. If BACKWARDS is t, search
-backwards."
- (let ((pos (save-excursion
- (save-restriction
- (widen)
- (catch 'found
- (let ((tpos (point)))
- (while (setq tpos
- (if backwards
- (if (eq tpos (point-min))
- nil
- (or (previous-single-property-change
- tpos 'nt-type)
- (point-min)))
- (next-single-property-change
- tpos 'nt-type)))
- (and (memq (get-text-property tpos 'nt-type) types)
- (or (not age)
- (eq (get-text-property tpos 'nt-age) age))
- (throw 'found tpos)))))))))
- (when pos
- (goto-char pos))
- pos))
-
-(defun newsticker--buffer-hideshow (mark-age onoff)
- "Hide or show items of type MARK-AGE.
-If ONOFF is nil the item is hidden, otherwise it is shown."
- (if onoff
- (remove-from-invisibility-spec mark-age)
- (add-to-invisibility-spec mark-age)))
-
-(defun newsticker--buffer-beginning-of-item ()
- "Move point to the beginning of the item at point.
-Return new position."
- (if (bobp)
- (point)
- (let ((type (get-text-property (point) 'nt-type))
- (typebefore (get-text-property (1- (point)) 'nt-type)))
- (if (and (memq type '(item feed))
- (not (eq type typebefore)))
- (point)
- (newsticker--buffer-goto '(item feed) nil t)
- (point)))))
-
-(defun newsticker--buffer-beginning-of-feed ()
- "Move point to the beginning of the feed at point.
-Return new position."
- (if (bobp)
- (point)
- (let ((type (get-text-property (point) 'nt-type))
- (typebefore (get-text-property (1- (point)) 'nt-type)))
- (if (and (memq type '(feed))
- (not (eq type typebefore)))
- (point)
- (newsticker--buffer-goto '(feed) nil t)
- (point)))))
-
-(defun newsticker--buffer-end-of-item ()
- "Move point to the end of the item at point.
-Take care: end of item is at the end of its last line!"
- (when (newsticker--buffer-goto '(item feed nil))
- (point)))
-
-(defun newsticker--buffer-end-of-feed ()
- "Move point to the end of the last item of the feed at point.
-Take care: end of item is at the end of its last line!"
- (when (newsticker--buffer-goto '(feed nil))
- (backward-char 1)
- (point)))
-
-;; ======================================================================
-;;; misc
-;; ======================================================================
-
-(defun newsticker-mouse-browse-url (event)
- "Call `browse-url' for the link of the item at which the EVENT occurred."
- (interactive "e")
- (save-excursion
- (switch-to-buffer (window-buffer (posn-window (event-end event))))
- (let ((url (get-text-property (posn-point (event-end event))
- 'nt-link)))
- (when url
- (browse-url url)
- (save-excursion
- (goto-char (posn-point (event-end event)))
- (if newsticker-automatically-mark-visited-items-as-old
- (newsticker-mark-item-at-point-as-read t)))))))
-
-(defun newsticker-browse-url ()
- "Call `browse-url' for the link of the item at point."
- (interactive)
- (let ((url (get-text-property (point) 'nt-link)))
- (when url
- (browse-url url)
- (if newsticker-automatically-mark-visited-items-as-old
- (newsticker-mark-item-at-point-as-read t)))))
-
-(defvar newsticker-open-url-history
- '("wget" "xmms" "realplay")
- "...")
-
-(defun newsticker-handle-url ()
- "Ask for a program to open the link of the item at point."
- (interactive)
- (let ((url (get-text-property (point) 'nt-link)))
- (when url
- (let ((prog (read-string "Open url with: " nil
- 'newsticker-open-url-history)))
- (when prog
- (message "%s %s" prog url)
- (start-process prog prog prog url)
- (if newsticker-automatically-mark-visited-items-as-old
- (newsticker-mark-item-at-point-as-read t)))))))
-
-
-;; ======================================================================
-;;; Misc
-;; ======================================================================
-
-(defun newsticker--cache-sort ()
- "Sort the newsticker cache data."
- (let ((sort-fun (cond ((eq newsticker-sort-method 'sort-by-time)
- 'newsticker--cache-item-compare-by-time)
- ((eq newsticker-sort-method 'sort-by-title)
- 'newsticker--cache-item-compare-by-title)
- ((eq newsticker-sort-method 'sort-by-original-order)
- 'newsticker--cache-item-compare-by-position))))
- (mapc (lambda (feed-list)
- (setcdr feed-list (sort (cdr feed-list)
- sort-fun)))
- newsticker--cache)))
-
-(provide 'newsticker-plainview)
-
-;; arch-tag: 4e48b683-d48b-48dd-a13e-fe45baf41184
-;;; newsticker-plainview.el ends here
+++ /dev/null
-;;; newsticker-reader.el --- Generic RSS reader functions.
-
-;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
-
-;; Author: Ulf Jasper <ulf.jasper@web.de>
-;; Filename: newsticker-reader.el
-;; URL: http://www.nongnu.org/newsticker
-;; Time-stamp: "7. Juni 2008, 15:34:08 (ulf)"
-
-;; ======================================================================
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; ======================================================================
-;;; Commentary:
-
-;; See newsticker.el
-
-;; ======================================================================
-;;; Code:
-
-(require 'newsticker-backend)
-
-;; ======================================================================
-;;; Customization
-;; ======================================================================
-(defun newsticker--set-customvar-formatting (symbol value)
- "Set newsticker-variable SYMBOL value to VALUE.
-Calls all actions which are necessary in order to make the new
-value effective."
- (if (or (not (boundp symbol))
- (equal (symbol-value symbol) value))
- (set symbol value)
- ;; something must have changed
- (set symbol value)
- (when (fboundp 'newsticker--forget-preformatted)
- (newsticker--forget-preformatted))))
-
-;; ======================================================================
-;; reader
-(defgroup newsticker-reader nil
- "Settings for the feed reader."
- :group 'newsticker)
-
-(defcustom newsticker-frontend
- 'newsticker-treeview
- "Newsticker frontend for reading news.
-This must be one of the functions `newsticker-plainview' or
-`newsticker-treeview'."
- :type '(choice :tag "Frontend"
- (const :tag "Single buffer (plainview)" newsticker-plainview)
- (const :tag "Tree view (treeview)" newsticker-treeview))
- :group 'newsticker-reader)
-
-;; image related things
-(defcustom newsticker-enable-logo-manipulations
- t
- "If non-nil newsticker manipulates logo images.
-This enables the following image properties: heuristic mask for all
-logos, and laplace-conversion for images without new items."
- :type 'boolean
- :group 'newsticker-reader)
-
-(defcustom newsticker-justification
- 'left
- "How to fill item descriptions.
-If non-nil newsticker calls `fill-region' to wrap long lines in
-item descriptions. However, if an item description contains HTML
-text and `newsticker-html-renderer' is non-nil, filling is not
-done."
- :type '(choice :tag "Justification"
- (const :tag "No filling" nil)
- (const :tag "Left" left)
- (const :tag "Right" right)
- (const :tag "Center" center)
- (const :tag "Full" full))
- :set 'newsticker--set-customvar-formatting
- :group 'newsticker-reader)
-
-(defcustom newsticker-use-full-width
- t
- "Decides whether to use the full window width when filling.
-If non-nil newsticker sets `fill-column' so that the whole
-window is used when filling. See also `newsticker-justification'."
- :type 'boolean
- :set 'newsticker--set-customvar-formatting
- :group 'newsticker-reader)
-
-(defcustom newsticker-html-renderer
- nil
- "Function for rendering HTML contents.
-If non-nil, newsticker.el will call this function whenever it finds
-HTML-like tags in item descriptions. Possible functions are, for
-example, `w3m-region', `w3-region', and (if you have htmlr.el installed)
-`newsticker-htmlr-render'.
-
-In order to make sure that the HTML renderer is loaded when you
-run newsticker, you should add one of the following statements to
-your .emacs. If you use w3m,
-
- (autoload 'w3m-region \"w3m\"
- \"Render region in current buffer and replace with result.\" t)
-
- (autoload 'w3m-toggle-inline-image \"w3m\"
- \"Toggle the visibility of an image under point.\" t)
-
-or, if you use w3,
-
- (require 'w3-auto)
-
-or, if you use htmlr
-
- (require 'htmlr)"
- :type '(choice :tag "Function"
- (const :tag "None" nil)
- (const :tag "w3" w3-region)
- (const :tag "w3m" w3m-region)
- (const :tag "htmlr" newsticker-htmlr-render))
- :set 'newsticker--set-customvar-formatting
- :group 'newsticker-reader)
-
-(defcustom newsticker-date-format
- "(%A, %H:%M)"
- "Format for the date part in item and feed lines.
-See `format-time-string' for a list of valid specifiers."
- :type 'string
- :set 'newsticker--set-customvar-formatting
- :group 'newsticker-reader)
-
-;; ======================================================================
-;;; Utility functions
-;; ======================================================================
-(defun newsticker--insert-enclosure (item keymap)
- "Insert enclosure element of a news ITEM into the current buffer.
-KEYMAP will be applied."
- (let ((enclosure (newsticker--enclosure item))
- (beg (point)))
- (when enclosure
- (let ((url (cdr (assoc 'url enclosure)))
- (length (string-to-number (or (cdr (assoc 'length enclosure))
- "-1")))
- (type (cdr (assoc 'type enclosure))))
- (cond ((> length 1048576)
- (insert (format "Enclosed file (%s, %1.2f MBytes)" type
- (/ length 1048576))))
- ((> length 1024)
- (insert (format "Enclosed file (%s, %1.2f KBytes)" type
- (/ length 1024))))
- ((> length 0)
- (insert (format "Enclosed file (%s, %1.2f Bytes)" type
- length)))
- (t
- (insert (format "Enclosed file (%s, unknown size)" type))))
- (add-text-properties beg (point)
- (list 'mouse-face 'highlight
- 'nt-link url
- 'help-echo (format
- "mouse-2: visit (%s)" url)
- 'keymap keymap
- 'nt-face 'enclosure
- 'nt-type 'desc))
- (insert "\n")))))
-
-(defun newsticker--print-extra-elements (item keymap)
- "Insert extra-elements of ITEM in a pretty form into the current buffer.
-KEYMAP is applied."
- (let ((ignored-elements '(items link title description content
- content:encoded dc:subject
- dc:date entry item guid pubDate
- published updated
- enclosure))
- (left-column-width 1))
- (mapc (lambda (extra-element)
- (when (listp extra-element) ;; take care of broken xml
- ;; data, 2007-05-25
- (unless (memq (car extra-element) ignored-elements)
- (setq left-column-width (max left-column-width
- (length (symbol-name
- (car extra-element))))))))
- (newsticker--extra item))
- (mapc (lambda (extra-element)
- (when (listp extra-element) ;; take care of broken xml
- ;; data, 2007-05-25
- (unless (memq (car extra-element) ignored-elements)
- (newsticker--do-print-extra-element extra-element
- left-column-width
- keymap))))
- (newsticker--extra item))))
-
-(defun newsticker--do-print-extra-element (extra-element width keymap)
- "Actually print an EXTRA-ELEMENT using the given WIDTH.
-KEYMAP is applied."
- (let ((name (symbol-name (car extra-element))))
- (insert (format "%s: " name))
- (insert (make-string (- width (length name)) ? )))
- (let (;;(attributes (cadr extra-element)) ;FIXME!!!!
- (contents (cddr extra-element)))
- (cond ((listp contents)
- (mapc (lambda (i)
- (if (and (stringp i)
- (string-match "^http://.*" i))
- (let ((pos (point)))
- (insert i " ") ; avoid self-reference from the
- ; nt-link thing
- (add-text-properties
- pos (point)
- (list 'mouse-face 'highlight
- 'nt-link i
- 'help-echo
- (format "mouse-2: visit (%s)" i)
- 'keymap keymap)))
- (insert (format "%s" i))))
- contents))
- (t
- (insert (format "%s" contents))))
- (insert "\n")))
-
-(defun newsticker--image-read (feed-name-symbol disabled)
- "Read the cached image for FEED-NAME-SYMBOL from disk.
-If DISABLED is non-nil the image will be converted to a disabled look
-\(unless `newsticker-enable-logo-manipulations' is not t\).
-Return the image."
- (let ((image-name (concat newsticker-imagecache-dirname "/"
- (symbol-name feed-name-symbol)))
- (img nil))
- (when (file-exists-p image-name)
- (condition-case error-data
- (setq img (create-image
- image-name nil nil
- :conversion (and newsticker-enable-logo-manipulations
- disabled
- 'disabled)
- :mask (and newsticker-enable-logo-manipulations
- 'heuristic)
- :ascent 70))
- (error
- (message "Error: cannot create image for %s: %s"
- feed-name-symbol error-data))))
- img))
-
-;; the functions we need for retrieval and display
-;;;###autoload
-(defun newsticker-show-news ()
- "Start reading news. You may want to bind this to a key."
- (interactive)
- (newsticker-start t) ;; will start only if not running
- (funcall newsticker-frontend))
-
-;; ======================================================================
-;;; Toolbar
-;; ======================================================================
-(defconst newsticker--next-item-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * next_xpm[] = {
-\"24 24 42 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #7EB6DE\",
-\"@ c #82BBE2\",
-\"# c #85BEE4\",
-\"$ c #88C1E7\",
-\"% c #8AC3E8\",
-\"& c #87C1E6\",
-\"* c #8AC4E9\",
-\"= c #8CC6EA\",
-\"- c #8CC6EB\",
-\"; c #88C2E7\",
-\"> c #8BC5E9\",
-\", c #8DC7EB\",
-\"' c #87C0E6\",
-\") c #8AC4E8\",
-\"! c #8BC5EA\",
-\"~ c #8BC4E9\",
-\"{ c #88C1E6\",
-\"] c #89C3E8\",
-\"^ c #86BFE5\",
-\"/ c #83BBE2\",
-\"( c #82BBE1\",
-\"_ c #86C0E5\",
-\": c #87C0E5\",
-\"< c #83BCE2\",
-\"[ c #81B9E0\",
-\"} c #81BAE1\",
-\"| c #78B0D9\",
-\"1 c #7BB3DB\",
-\"2 c #7DB5DD\",
-\"3 c #7DB6DD\",
-\"4 c #72A9D4\",
-\"5 c #75ACD6\",
-\"6 c #76AED7\",
-\"7 c #77AFD8\",
-\"8 c #6BA1CD\",
-\"9 c #6EA4CF\",
-\"0 c #6FA6D1\",
-\"a c #6298C6\",
-\"b c #659BC8\",
-\"c c #5C91C0\",
-\" \",
-\" \",
-\" . \",
-\" .. \",
-\" .+. \",
-\" .@#. \",
-\" .#$%. \",
-\" .&*=-. \",
-\" .;>,,,. \",
-\" .;>,,,=. \",
-\" .')!==~;. \",
-\" .#{]*%;^/. \",
-\" .(#_':#<. \",
-\" .+[@</}. \",
-\" .|1232. \",
-\" .4567. \",
-\" .890. \",
-\" .ab. \",
-\" .c. \",
-\" .. \",
-\" . \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the next item button.")
-
-(defconst newsticker--previous-item-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * previous_xpm[] = {
-\"24 24 39 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #7BB3DB\",
-\"@ c #83BCE2\",
-\"# c #7FB8DF\",
-\"$ c #89C2E7\",
-\"% c #86BFE5\",
-\"& c #83BBE2\",
-\"* c #8CC6EA\",
-\"= c #8BC4E9\",
-\"- c #88C2E7\",
-\"; c #85BEE4\",
-\"> c #8DC7EB\",
-\", c #89C3E8\",
-\"' c #8AC4E8\",
-\") c #8BC5EA\",
-\"! c #88C1E6\",
-\"~ c #8AC4E9\",
-\"{ c #8AC3E8\",
-\"] c #86C0E5\",
-\"^ c #87C0E6\",
-\"/ c #87C0E5\",
-\"( c #82BBE2\",
-\"_ c #81BAE1\",
-\": c #7FB7DF\",
-\"< c #7DB6DD\",
-\"[ c #7DB5DD\",
-\"} c #7CB4DC\",
-\"| c #79B1DA\",
-\"1 c #76ADD7\",
-\"2 c #77AFD8\",
-\"3 c #73AAD4\",
-\"4 c #70A7D1\",
-\"5 c #6EA5D0\",
-\"6 c #6CA2CE\",
-\"7 c #689ECB\",
-\"8 c #6399C7\",
-\"9 c #6095C4\",
-\"0 c #5C90C0\",
-\" \",
-\" \",
-\" . \",
-\" .. \",
-\" .+. \",
-\" .@#. \",
-\" .$%&. \",
-\" .*=-;. \",
-\" .>>*,%. \",
-\" .>>>*,%. \",
-\" .')**=-;. \",
-\" .;!,~{-%&. \",
-\" .;]^/;@#. \",
-\" .(@&_:+. \",
-\" .<[}|1. \",
-\" .2134. \",
-\" .567. \",
-\" .89. \",
-\" .0. \",
-\" .. \",
-\" . \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the previous item button.")
-
-(defconst newsticker--previous-feed-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * prev_feed_xpm[] = {
-\"24 24 52 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #70A7D2\",
-\"@ c #75ADD6\",
-\"# c #71A8D3\",
-\"$ c #79B1DA\",
-\"% c #7BB3DB\",
-\"& c #7DB5DD\",
-\"* c #83BBE2\",
-\"= c #7EB6DE\",
-\"- c #78B0D9\",
-\"; c #7FB7DE\",
-\"> c #88C2E7\",
-\", c #85BEE4\",
-\"' c #80B9E0\",
-\") c #80B8DF\",
-\"! c #8CC6EA\",
-\"~ c #89C3E8\",
-\"{ c #86BFE5\",
-\"] c #81BAE1\",
-\"^ c #7CB4DC\",
-\"/ c #7FB8DF\",
-\"( c #8DC7EB\",
-\"_ c #7BB3DC\",
-\": c #7EB7DE\",
-\"< c #8BC4E9\",
-\"[ c #8AC4E9\",
-\"} c #8AC3E8\",
-\"| c #87C0E6\",
-\"1 c #87C0E5\",
-\"2 c #83BCE2\",
-\"3 c #75ACD6\",
-\"4 c #7FB7DF\",
-\"5 c #77AED8\",
-\"6 c #71A8D2\",
-\"7 c #70A7D1\",
-\"8 c #76ADD7\",
-\"9 c #6CA2CE\",
-\"0 c #699FCC\",
-\"a c #73AAD4\",
-\"b c #6BA1CD\",
-\"c c #669CC9\",
-\"d c #6298C5\",
-\"e c #689ECB\",
-\"f c #6499C7\",
-\"g c #6095C3\",
-\"h c #5C91C0\",
-\"i c #5E93C2\",
-\"j c #5B90C0\",
-\"k c #588CBC\",
-\"l c #578CBC\",
-\"m c #5589BA\",
-\" \",
-\" \",
-\" ... . \",
-\" .+. .. \",
-\" .@. .#. \",
-\" .$. .%@. \",
-\" .&. .*=-. \",
-\" .;. .>,'%. \",
-\" .). .!~{]^. \",
-\" ./. .(!~{]_. \",
-\" .:. .!!<>,'%. \",
-\" .&. .~[}>{*=-. \",
-\" .$. .|1,2/%@. \",
-\" .3. .*]4%56. \",
-\" .7. .^$8#9. \",
-\" .0. .a7bc. \",
-\" .d. .efg. \",
-\" .h. .ij. \",
-\" .k. .l. \",
-\" .m. .. \",
-\" ... . \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the previous feed button.")
-
-(defconst newsticker--next-feed-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * next_feed_xpm[] = {
-\"24 24 57 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #6CA2CE\",
-\"@ c #75ADD6\",
-\"# c #71A8D3\",
-\"$ c #79B1DA\",
-\"% c #7EB7DE\",
-\"& c #7DB5DD\",
-\"* c #81BAE1\",
-\"= c #85BEE4\",
-\"- c #78B0D9\",
-\"; c #7FB7DE\",
-\"> c #83BCE3\",
-\", c #87C1E6\",
-\"' c #8AC4E9\",
-\") c #7BB3DB\",
-\"! c #80B8DF\",
-\"~ c #88C2E7\",
-\"{ c #8BC5E9\",
-\"] c #8DC7EB\",
-\"^ c #7CB4DC\",
-\"/ c #7FB8DF\",
-\"( c #84BDE3\",
-\"_ c #7BB3DC\",
-\": c #83BCE2\",
-\"< c #87C0E6\",
-\"[ c #8AC4E8\",
-\"} c #8BC5EA\",
-\"| c #8CC6EA\",
-\"1 c #88C1E6\",
-\"2 c #89C3E8\",
-\"3 c #8AC3E8\",
-\"4 c #7EB6DE\",
-\"5 c #82BBE1\",
-\"6 c #86C0E5\",
-\"7 c #87C0E5\",
-\"8 c #75ACD6\",
-\"9 c #7AB2DA\",
-\"0 c #81B9E0\",
-\"a c #82BBE2\",
-\"b c #71A8D2\",
-\"c c #70A7D1\",
-\"d c #74ACD6\",
-\"e c #699FCC\",
-\"f c #6EA5D0\",
-\"g c #72A9D4\",
-\"h c #669CC9\",
-\"i c #6298C5\",
-\"j c #679DCA\",
-\"k c #6BA1CD\",
-\"l c #6095C3\",
-\"m c #5C91C0\",
-\"n c #5F94C2\",
-\"o c #5B90C0\",
-\"p c #588CBC\",
-\"q c #578CBC\",
-\"r c #5589BA\",
-\" \",
-\" \",
-\" . ... \",
-\" .. .+. \",
-\" .@. .#. \",
-\" .$%. .@. \",
-\" .&*=. .-. \",
-\" .;>,'. .). \",
-\" .!=~{]. .^. \",
-\" ./(~{]]. ._. \",
-\" .%:<[}||. .). \",
-\" .&*=12'3~. .-. \",
-\" .$45=6<7. .@. \",
-\" .8940a:. .b. \",
-\" .cd-)&. .+. \",
-\" .efg8. .h. \",
-\" .ijk. .l. \",
-\" .mn. .o. \",
-\" .p. .q. \",
-\" .. .r. \",
-\" . ... \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the next feed button.")
-
-(defconst newsticker--mark-read-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * mark_read_xpm[] = {
-\"24 24 44 1\",
-\" c None\",
-\". c #C20000\",
-\"+ c #BE0000\",
-\"@ c #C70000\",
-\"# c #CE0000\",
-\"$ c #C90000\",
-\"% c #BD0000\",
-\"& c #CB0000\",
-\"* c #D10000\",
-\"= c #D70000\",
-\"- c #D30000\",
-\"; c #CD0000\",
-\"> c #C60000\",
-\", c #D40000\",
-\"' c #DA0000\",
-\") c #DE0000\",
-\"! c #DB0000\",
-\"~ c #D60000\",
-\"{ c #D00000\",
-\"] c #DC0000\",
-\"^ c #E00000\",
-\"/ c #E40000\",
-\"( c #E10000\",
-\"_ c #DD0000\",
-\": c #D80000\",
-\"< c #E50000\",
-\"[ c #E70000\",
-\"} c #E60000\",
-\"| c #E20000\",
-\"1 c #E90000\",
-\"2 c #E80000\",
-\"3 c #E30000\",
-\"4 c #DF0000\",
-\"5 c #D90000\",
-\"6 c #CC0000\",
-\"7 c #C10000\",
-\"8 c #C30000\",
-\"9 c #BF0000\",
-\"0 c #B90000\",
-\"a c #BC0000\",
-\"b c #BB0000\",
-\"c c #B80000\",
-\"d c #B50000\",
-\"e c #B70000\",
-\" \",
-\" \",
-\" \",
-\" . + \",
-\" +@# $.% \",
-\" &*= -;> \",
-\" ,') !~{ \",
-\" ]^/ (_: \",
-\" (<[ }|) \",
-\" <[1 2<| \",
-\" }222[< \",
-\" }}}< \",
-\" 333| \",
-\" _4^4)] \",
-\" ~:' 5=- \",
-\" 6{- *#$ \",
-\" 7>$ @89 \",
-\" 0a+ %bc \",
-\" ddc edd \",
-\" ddd ddd \",
-\" d d \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the mark read button.")
-
-(defconst newsticker--mark-immortal-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * mark_immortal_xpm[] = {
-\"24 24 93 2\",
-\" c None\",
-\". c #171717\",
-\"+ c #030303\",
-\"@ c #000000\",
-\"# c #181818\",
-\"$ c #090909\",
-\"% c #FFC960\",
-\"& c #FFCB61\",
-\"* c #FFCB62\",
-\"= c #FFC961\",
-\"- c #FFC75F\",
-\"; c #FFC65E\",
-\"> c #FFCA61\",
-\", c #FFCD63\",
-\"' c #FFCF65\",
-\") c #FFD065\",
-\"! c #FFCE64\",
-\"~ c #FFC35C\",
-\"{ c #FFC45D\",
-\"] c #FFD166\",
-\"^ c #FFD267\",
-\"/ c #FFD368\",
-\"( c #FFD167\",
-\"_ c #FFC05A\",
-\": c #010101\",
-\"< c #040404\",
-\"[ c #FFCC62\",
-\"} c #FFD569\",
-\"| c #FFD56A\",
-\"1 c #FFC860\",
-\"2 c #FFC25B\",
-\"3 c #FFBB56\",
-\"4 c #020202\",
-\"5 c #060606\",
-\"6 c #FFC15B\",
-\"7 c #FFC85F\",
-\"8 c #FFD469\",
-\"9 c #FFD66A\",
-\"0 c #FFBC57\",
-\"a c #1B1B1B\",
-\"b c #070707\",
-\"c c #FFBA55\",
-\"d c #FFB451\",
-\"e c #FFB954\",
-\"f c #FFB350\",
-\"g c #FFB652\",
-\"h c #FFBE58\",
-\"i c #FFCD64\",
-\"j c #FFD066\",
-\"k c #FFC059\",
-\"l c #FFB14E\",
-\"m c #0B0B0B\",
-\"n c #FFBB55\",
-\"o c #FFC15A\",
-\"p c #FFB552\",
-\"q c #FFAD4B\",
-\"r c #080808\",
-\"s c #FFAF4C\",
-\"t c #FFB853\",
-\"u c #FFA948\",
-\"v c #050505\",
-\"w c #FFB04E\",
-\"x c #FFB753\",
-\"y c #FFBC56\",
-\"z c #FFC55D\",
-\"A c #FFC55E\",
-\"B c #FFC45C\",
-\"C c #FFBD57\",
-\"D c #FFB854\",
-\"E c #FFB34F\",
-\"F c #FFAB4A\",
-\"G c #FFA545\",
-\"H c #FFAA49\",
-\"I c #FFB04D\",
-\"J c #FFB551\",
-\"K c #FFBF58\",
-\"L c #FFB24F\",
-\"M c #FFAC4A\",
-\"N c #FFA646\",
-\"O c #FFA344\",
-\"P c #FFA848\",
-\"Q c #FFB14F\",
-\"R c #FFAF4D\",
-\"S c #FFA546\",
-\"T c #FFA243\",
-\"U c #FFA445\",
-\"V c #FFAE4C\",
-\"W c #FFA444\",
-\"X c #FFA142\",
-\"Y c #FF9F41\",
-\"Z c #0A0A0A\",
-\"` c #FF9E40\",
-\" . c #FF9F40\",
-\" \",
-\" \",
-\" \",
-\" . + @ @ + # \",
-\" $ @ % & * * = - + + \",
-\" @ ; > , ' ) ' ! * - ~ @ \",
-\" @ { > ! ] ^ / / ( ' * ; _ : \",
-\" < _ ; [ ) / } | } / ] , 1 2 3 4 \",
-\" 5 6 7 , ] 8 9 9 9 } ^ ! = ~ 0 a \",
-\" b c 6 - , ] 8 9 9 9 } ^ ! % ~ 0 d 5 \",
-\" : e _ ; * ) / 8 } } / ] , 1 2 3 f 5 \",
-\" : g h { = i j ^ / ^ ] ! * ; k e l m \",
-\" : f n o ; > , ' ) ' ! * - 2 0 p q r \",
-\" : s g 0 6 ; % > * * = - ~ h t l u r \",
-\" v u w x y k ~ z A z B o C D E F G b \",
-\" 5 H I J e 0 h K h C c x L M N . \",
-\" 4 O P q Q d g x g J L R H S T < \",
-\" @ T U P F q V q M H N W X + \",
-\" @ Y T O W G G W O X Y @ \",
-\" 4 Z ` Y Y Y .` 4 4 \",
-\" 5 : : @ @ Z \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the mark immortal button.")
-
-(defconst newsticker--narrow-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * narrow_xpm[] = {
-\"24 24 48 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #969696\",
-\"@ c #9E9E9E\",
-\"# c #A4A4A4\",
-\"$ c #AAAAAA\",
-\"% c #AEAEAE\",
-\"& c #B1B1B1\",
-\"* c #B3B3B3\",
-\"= c #B4B4B4\",
-\"- c #B2B2B2\",
-\"; c #AFAFAF\",
-\"> c #ABABAB\",
-\", c #A6A6A6\",
-\"' c #A0A0A0\",
-\") c #989898\",
-\"! c #909090\",
-\"~ c #73AAD4\",
-\"{ c #7AB2DA\",
-\"] c #7FB8DF\",
-\"^ c #84BDE3\",
-\"/ c #88C2E7\",
-\"( c #8BC5E9\",
-\"_ c #8DC7EB\",
-\": c #8CC6EA\",
-\"< c #89C3E8\",
-\"[ c #86BFE5\",
-\"} c #81BAE1\",
-\"| c #7BB3DC\",
-\"1 c #75ACD6\",
-\"2 c #6DA4CF\",
-\"3 c #979797\",
-\"4 c #A3A3A3\",
-\"5 c #A8A8A8\",
-\"6 c #ADADAD\",
-\"7 c #ACACAC\",
-\"8 c #A9A9A9\",
-\"9 c #A5A5A5\",
-\"0 c #9A9A9A\",
-\"a c #929292\",
-\"b c #8C8C8C\",
-\"c c #808080\",
-\"d c #818181\",
-\"e c #838383\",
-\"f c #848484\",
-\"g c #858585\",
-\"h c #868686\",
-\"i c #828282\",
-\" \",
-\" \",
-\" \",
-\" .................. \",
-\" .+@#$%&*=*-;>,')!. \",
-\" .................. \",
-\" \",
-\" \",
-\" .................. \",
-\" .~{]^/(___:<[}|12. \",
-\" .................. \",
-\" \",
-\" \",
-\" .................. \",
-\" .!3@45>666789'0ab. \",
-\" .................. \",
-\" \",
-\" \",
-\" .................. \",
-\" .cccdefghhgficccc. \",
-\" .................. \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the narrow image button.")
-
-(defconst newsticker--get-all-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * get_all_xpm[] = {
-\"24 24 70 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #F3DA00\",
-\"@ c #F5DF00\",
-\"# c #F7E300\",
-\"$ c #F9E700\",
-\"% c #FAEA00\",
-\"& c #FBEC00\",
-\"* c #FBED00\",
-\"= c #FCEE00\",
-\"- c #FAEB00\",
-\"; c #F9E800\",
-\"> c #F8E500\",
-\", c #F6E000\",
-\"' c #F4DB00\",
-\") c #F1D500\",
-\"! c #EFD000\",
-\"~ c #B7CA00\",
-\"{ c #BFD100\",
-\"] c #C5D700\",
-\"^ c #CBDB00\",
-\"/ c #CFDF00\",
-\"( c #D2E200\",
-\"_ c #D4E400\",
-\": c #D3E300\",
-\"< c #D0E000\",
-\"[ c #CCDD00\",
-\"} c #C7D800\",
-\"| c #C1D300\",
-\"1 c #BACC00\",
-\"2 c #B1C500\",
-\"3 c #A8BC00\",
-\"4 c #20A900\",
-\"5 c #22AF00\",
-\"6 c #24B500\",
-\"7 c #26B900\",
-\"8 c #27BC00\",
-\"9 c #27BE00\",
-\"0 c #28BF00\",
-\"a c #27BD00\",
-\"b c #26BA00\",
-\"c c #25B600\",
-\"d c #23B100\",
-\"e c #21AB00\",
-\"f c #1FA400\",
-\"g c #1C9B00\",
-\"h c #21AA00\",
-\"i c #24B300\",
-\"j c #25B800\",
-\"k c #25B700\",
-\"l c #24B400\",
-\"m c #23B000\",
-\"n c #1FA500\",
-\"o c #1D9E00\",
-\"p c #20A800\",
-\"q c #21AC00\",
-\"r c #23B200\",
-\"s c #22AD00\",
-\"t c #1D9F00\",
-\"u c #20A700\",
-\"v c #1EA100\",
-\"w c #1C9C00\",
-\"x c #1DA000\",
-\"y c #1B9800\",
-\"z c #1A9600\",
-\"A c #1A9700\",
-\"B c #1A9500\",
-\"C c #199200\",
-\"D c #189100\",
-\"E c #178C00\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ................... \",
-\" .+@#$%&*=*&-;>,')!. \",
-\" ................... \",
-\" \",
-\" ................... \",
-\" .~{]^/(___:<[}|123. \",
-\" ................... \",
-\" \",
-\" ................... \",
-\" .45678909abcdefg. \",
-\" .h5icj7jklmeno. \",
-\" .pq5drrmshft. \",
-\" .fu4h4pnvw. \",
-\" .oxvxtwy. \",
-\" .zAAzB. \",
-\" .CCD. \",
-\" .E. \",
-\" . \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the get all image button.")
-
-(defconst newsticker--update-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * update_xpm[] = {
-\"24 24 37 1\",
-\" c None\",
-\". c #076D00\",
-\"+ c #0A8600\",
-\"@ c #0A8800\",
-\"# c #098400\",
-\"$ c #087200\",
-\"% c #087900\",
-\"& c #098500\",
-\"* c #098100\",
-\"= c #087600\",
-\"- c #097E00\",
-\"; c #097F00\",
-\"> c #0A8700\",
-\", c #0A8C00\",
-\"' c #097C00\",
-\") c #098300\",
-\"! c #0A8900\",
-\"~ c #0A8E00\",
-\"{ c #0B9200\",
-\"] c #087700\",
-\"^ c #076E00\",
-\"/ c #076C00\",
-\"( c #076B00\",
-\"_ c #076A00\",
-\": c #076900\",
-\"< c #076800\",
-\"[ c #066700\",
-\"} c #066500\",
-\"| c #066400\",
-\"1 c #066300\",
-\"2 c #066600\",
-\"3 c #066200\",
-\"4 c #076700\",
-\"5 c #065E00\",
-\"6 c #066100\",
-\"7 c #065F00\",
-\"8 c #066000\",
-\" \",
-\" \",
-\" \",
-\" . +@@@+# \",
-\" $% &@ +* \",
-\" =-# ; \",
-\" %*>, ' \",
-\" ')!~{ = \",
-\" ]$ \",
-\" ^ ^ \",
-\" . . \",
-\" / ( \",
-\" _ : \",
-\" < [ \",
-\" } | \",
-\" [[ \",
-\" 1 $.:23 \",
-\" 3 4}35 \",
-\" 6 655 \",
-\" 76 85 55 \",
-\" 5555555 5 \",
-\" \",
-\" \",
-\" \"};
-"
- 'xpm t))
- "Image for the update button.")
-
-(defconst newsticker--browse-image
- (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm)
- (create-image "/* XPM */
-static char * visit_xpm[] = {
-\"24 24 39 1\",
-\" c None\",
-\". c #000000\",
-\"+ c #FFFFFF\",
-\"@ c #00E63D\",
-\"# c #00E83E\",
-\"$ c #00E73D\",
-\"% c #00E93E\",
-\"& c #00E63C\",
-\"* c #00E53C\",
-\"= c #00E23B\",
-\"- c #00E33B\",
-\"; c #00E83D\",
-\"> c #00E13A\",
-\", c #00DD38\",
-\"' c #00DE38\",
-\") c #00E23A\",
-\"! c #00E43C\",
-\"~ c #00DF39\",
-\"{ c #00DB37\",
-\"] c #00D634\",
-\"^ c #00D734\",
-\"/ c #00E039\",
-\"( c #00DC37\",
-\"_ c #00D835\",
-\": c #00D332\",
-\"< c #00CD2F\",
-\"[ c #00DB36\",
-\"} c #00D433\",
-\"| c #00CF30\",
-\"1 c #00DA36\",
-\"2 c #00D936\",
-\"3 c #00D533\",
-\"4 c #00D131\",
-\"5 c #00CE2F\",
-\"6 c #00CC2F\",
-\"7 c #00CA2D\",
-\"8 c #00C62B\",
-\"9 c #00C52A\",
-\"0 c #00BE27\",
-\" \",
-\" \",
-\" . \",
-\" .+. \",
-\" .+++. \",
-\" .++.++. \",
-\" .++.@.++. \",
-\" .++.##$.++. \",
-\" .++.%%%#&.++. \",
-\" .++.$%%%#*=.++. \",
-\" .++.-@;##$*>,.++. \",
-\" .++.')!&@@*=~{].++. \",
-\" .++.^{~>---)/(_:<.++. \",
-\" .++.^[,~/~'(_}|.++. \",
-\" .++.]_1[12^:|.++. \",
-\" .++.:}33:45.++. \",
-\" .++.<5567.++. \",
-\" .++.889.++. \",
-\" .++.0.++. \",
-\" .++.++. \",
-\" .+++. \",
-\" .+. \",
-\" . \",
-\" \"};
-"
- 'xpm t))
- "Image for the browse button.")
-
-(provide 'newsticker-reader)
-
-;; arch-tag: c604b701-bdf1-4fc1-8d05-5fabd1939533
-;;; newsticker-reader.el ends here
+++ /dev/null
-;; newsticker-ticker.el --- modeline ticker for newsticker.
-
-;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
-
-;; Author: Ulf Jasper <ulf.jasper@web.de>
-;; Filename: newsticker-ticker.el
-;; URL: http://www.nongnu.org/newsticker
-;; Keywords: News, RSS, Atom
-;; Time-stamp: "7. Juni 2008, 15:12:27 (ulf)"
-
-;; ======================================================================
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; ======================================================================
-
-;;; Commentary:
-
-;; See newsticker.el
-
-;; ======================================================================
-;;; Code:
-
-(require 'newsticker-backend)
-
-(defvar newsticker--ticker-timer nil
- "Timer for newsticker ticker.")
-
-;;;###autoload
-(defun newsticker-ticker-running-p ()
- "Check whether newsticker's actual ticker is running.
-Return t if ticker is running, nil otherwise. Newsticker is
-considered to be running if the newsticker timer list is not
-empty."
- (timerp newsticker--ticker-timer))
-
-;; customization group ticker
-(defgroup newsticker-ticker nil
- "Settings for the headline ticker."
- :group 'newsticker)
-
-(defun newsticker--set-customvar-ticker (symbol value)
- "Set newsticker-variable SYMBOL value to VALUE.
-Calls all actions which are necessary in order to make the new
-value effective."
- (if (or (not (boundp symbol))
- (equal (symbol-value symbol) value))
- (set symbol value)
- ;; something must have changed -- restart ticker
- (when (newsticker-running-p)
- (message "Restarting ticker")
- (newsticker-stop-ticker)
- (newsticker--ticker-text-setup)
- (newsticker-start-ticker)
- (message ""))))
-
-(defcustom newsticker-ticker-interval
- 0.3
- "Time interval for displaying news items in the echo area (seconds).
-If equal or less than 0 no messages are shown in the echo area. For
-smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
-reasonable. For non-smooth display a value of 10 is a good starting
-point."
- :type 'number
- :set 'newsticker--set-customvar-ticker
- :group 'newsticker-ticker)
-
-(defcustom newsticker-scroll-smoothly
- t
- "Decides whether to flash or scroll news items.
-If t the news headlines are scrolled (more-or-less) smoothly in the echo
-area. If nil one headline after another is displayed in the echo area.
-The variable `newsticker-ticker-interval' determines how fast this
-display moves/changes and whether headlines are shown in the echo area
-at all. If you change `newsticker-scroll-smoothly' you should also change
-`newsticker-ticker-interval'."
- :type 'boolean
- :group 'newsticker-ticker)
-
-(defcustom newsticker-hide-immortal-items-in-echo-area
- t
- "Decides whether to show immortal/non-expiring news items in the ticker.
-If t the echo area will not show immortal items. See also
-`newsticker-hide-old-items-in-echo-area'."
- :type 'boolean
- :set 'newsticker--set-customvar-ticker
- :group 'newsticker-ticker)
-
-(defcustom newsticker-hide-old-items-in-echo-area
- t
- "Decides whether to show only the newest news items in the ticker.
-If t the echo area will show only new items, i.e. only items which have
-been added between the last two retrievals."
- :type 'boolean
- :set 'newsticker--set-customvar-ticker
- :group 'newsticker-ticker)
-
-(defcustom newsticker-hide-obsolete-items-in-echo-area
- t
- "Decides whether to show obsolete items items in the ticker.
-If t the echo area will not show obsolete items. See also
-`newsticker-hide-old-items-in-echo-area'."
- :type 'boolean
- :set 'newsticker--set-customvar-ticker
- :group 'newsticker-ticker)
-
-(defun newsticker--display-tick ()
- "Called from the display timer.
-This function calls a display function, according to the variable
-`newsticker-scroll-smoothly'."
- (if newsticker-scroll-smoothly
- (newsticker--display-scroll)
- (newsticker--display-jump)))
-
-(defsubst newsticker--echo-area-clean-p ()
- "Check whether somebody is using the echo area / minibuffer.
-Return t if echo area and minibuffer are unused."
- (not (or (active-minibuffer-window)
- (and (current-message)
- (not (string= (current-message)
- newsticker--prev-message))))))
-
-(defun newsticker--display-jump ()
- "Called from the display timer.
-This function displays the next ticker item in the echo area, unless
-there is another message displayed or the minibuffer is active."
- (let ((message-log-max nil));; prevents message text from being logged
- (when (newsticker--echo-area-clean-p)
- (setq newsticker--item-position (1+ newsticker--item-position))
- (when (>= newsticker--item-position (length newsticker--item-list))
- (setq newsticker--item-position 0))
- (setq newsticker--prev-message
- (nth newsticker--item-position newsticker--item-list))
- (message "%s" newsticker--prev-message))))
-
-(defun newsticker--display-scroll ()
- "Called from the display timer.
-This function scrolls the ticker items in the echo area, unless
-there is another message displayed or the minibuffer is active."
- (when (newsticker--echo-area-clean-p)
- (let* ((width (- (frame-width) 1))
- (message-log-max nil);; prevents message text from being logged
- (i newsticker--item-position)
- subtext
- (s-text newsticker--scrollable-text)
- (l (length s-text)))
- ;; don't show anything if there is nothing to show
- (unless (< (length s-text) 1)
- ;; repeat the ticker string if it is shorter than frame width
- (while (< (length s-text) width)
- (setq s-text (concat s-text s-text)))
- ;; get the width of the printed string
- (setq l (length s-text))
- (cond ((< i (- l width))
- (setq subtext (substring s-text i (+ i width))))
- (t
- (setq subtext (concat
- (substring s-text i l)
- (substring s-text 0 (- width (- l i)))))))
- ;; Take care of multibyte strings, for which (string-width) is
- ;; larger than (length).
- ;; Actually, such strings may be smaller than (frame-width)
- ;; because return values of (string-width) are too large:
- ;; (string-width "<japanese character>") => 2
- (let ((t-width (1- (length subtext))))
- (while (> (string-width subtext) width)
- (setq subtext (substring subtext 0 t-width))
- (setq t-width (1- t-width))))
- ;; show the ticker text and save current position
- (message "%s" subtext)
- (setq newsticker--prev-message subtext)
- (setq newsticker--item-position (1+ i))
- (when (>= newsticker--item-position l)
- (setq newsticker--item-position 0))))))
-
-;;;###autoload
-(defun newsticker-start-ticker ()
- "Start newsticker's ticker (but not the news retrieval).
-Start display timer for the actual ticker if wanted and not
-running already."
- (interactive)
- (if (and (> newsticker-ticker-interval 0)
- (not newsticker--ticker-timer))
- (setq newsticker--ticker-timer
- (run-at-time newsticker-ticker-interval
- newsticker-ticker-interval
- 'newsticker--display-tick))))
-
-(defun newsticker-stop-ticker ()
- "Stop newsticker's ticker (but not the news retrieval)."
- (interactive)
- (when newsticker--ticker-timer
- (cancel-timer newsticker--ticker-timer)
- (setq newsticker--ticker-timer nil)))
-
-;; ======================================================================
-;;; Manipulation of ticker text
-;; ======================================================================
-(defun newsticker--ticker-text-setup ()
- "Build the ticker text which is scrolled or flashed in the echo area."
- ;; reset scrollable text
- (setq newsticker--scrollable-text "")
- (setq newsticker--item-list nil)
- (setq newsticker--item-position 0)
- ;; build scrollable text from cache data
- (let ((have-something nil))
- (mapc
- (lambda (feed)
- (let ((feed-name (symbol-name (car feed))))
- (let ((num-new (newsticker--stat-num-items (car feed) 'new))
- (num-old (newsticker--stat-num-items (car feed) 'old))
- (num-imm (newsticker--stat-num-items (car feed) 'immortal))
- (num-obs (newsticker--stat-num-items (car feed) 'obsolete)))
- (when (or (> num-new 0)
- (and (> num-old 0)
- (not newsticker-hide-old-items-in-echo-area))
- (and (> num-imm 0)
- (not newsticker-hide-immortal-items-in-echo-area))
- (and (> num-obs 0)
- (not newsticker-hide-obsolete-items-in-echo-area)))
- (setq have-something t)
- (mapc
- (lambda (item)
- (let ((title (replace-regexp-in-string
- "[\r\n]+" " "
- (newsticker--title item)))
- (age (newsticker--age item)))
- (unless (string= title newsticker--error-headline)
- (when
- (or (eq age 'new)
- (and (eq age 'old)
- (not newsticker-hide-old-items-in-echo-area))
- (and (eq age 'obsolete)
- (not
- newsticker-hide-obsolete-items-in-echo-area))
- (and (eq age 'immortal)
- (not
- newsticker-hide-immortal-items-in-echo-area)))
- (setq title (newsticker--remove-whitespace title))
- ;; add to flash list
- (add-to-list 'newsticker--item-list
- (concat feed-name ": " title) t)
- ;; and to the scrollable text
- (setq newsticker--scrollable-text
- (concat newsticker--scrollable-text
- " " feed-name ": " title " +++"))))))
- (cdr feed))))))
- newsticker--cache)
- (when have-something
- (setq newsticker--scrollable-text
- (concat "+++ "
- (format-time-string "%A, %H:%M"
- newsticker--latest-update-time)
- " ++++++" newsticker--scrollable-text)))))
-
-(defun newsticker--ticker-text-remove (feed title)
- "Remove the item of FEED with TITLE from the ticker text."
- ;; reset scrollable text
- (setq newsticker--item-position 0)
- (let ((feed-name (symbol-name feed))
- (t-title (replace-regexp-in-string "[\r\n]+" " " title)))
- ;; remove from flash list
- (setq newsticker--item-list (remove (concat feed-name ": " t-title)
- newsticker--item-list))
- ;; and from the scrollable text
- (setq newsticker--scrollable-text
- (replace-regexp-in-string
- (regexp-quote (concat " " feed-name ": " t-title " +++"))
- ""
- newsticker--scrollable-text))
- (if (string-match (concat "^\\+\\+\\+ [A-Z][a-z]+, "
- "[012]?[0-9]:[0-9][0-9] \\+\\+\\+\\+\\+\\+$")
- newsticker--scrollable-text)
- (setq newsticker--scrollable-text ""))))
-
-(provide 'newsticker-ticker)
-
-;; arch-tag: faee3ebb-749b-4935-9835-7f36d4b700f0
-;;; newsticker-ticker.el ends here
+++ /dev/null
-;;; newsticker-treeview.el --- Treeview frontend for newsticker.
-
-;; Copyright (C) 2008 Free Software Foundation, Inc.
-
-;; Author: Ulf Jasper <ulf.jasper@web.de>
-;; Filename: newsticker-treeview.el
-;; URL: http://www.nongnu.org/newsticker
-;; Created: 2007
-;; Keywords: News, RSS, Atom
-;; Time-stamp: "8. Juni 2008, 20:42:16 (ulf)"
-
-;; ======================================================================
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; ======================================================================
-;;; Commentary:
-
-;; See newsticker.el
-
-;; ======================================================================
-;;; History:
-;;
-
-
-;; ======================================================================
-;;; Code:
-(require 'newsticker-reader)
-(require 'widget)
-(require 'tree-widget)
-(require 'wid-edit)
-
-;; ======================================================================
-;;; Customization
-;; ======================================================================
-(defgroup newsticker-treeview nil
- "Settings for the tree view reader."
- :group 'newsticker-reader)
-
-(defface newsticker-treeview-face
- '((((class color) (background dark))
- (:family "helvetica" :foreground "misty rose" :bold nil))
- (((class color) (background light))
- (:family "helvetica" :foreground "black" :bold nil)))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
-
-(defface newsticker-treeview-new-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face :bold t))
- (((class color) (background light))
- (:inherit newsticker-treeview-face :bold t)))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
-
-(defface newsticker-treeview-old-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face))
- (((class color) (background light))
- (:inherit newsticker-treeview-face)))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
-
-(defface newsticker-treeview-immortal-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face :foreground "orange" :italic t))
- (((class color) (background light))
- (:inherit newsticker-treeview-face :foreground "blue" :italic t)))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
-
-(defface newsticker-treeview-obsolete-face
- '((((class color) (background dark))
- (:inherit newsticker-treeview-face :strike-through t))
- (((class color) (background light))
- (:inherit newsticker-treeview-face :strike-through t)))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
-
-(defface newsticker-treeview-selection-face
- '((((class color) (background dark))
- (:background "#bbbbff"))
- (((class color) (background light))
- (:background "#bbbbff")))
- "Face for newsticker selection."
- :group 'newsticker-treeview)
-
-(defcustom newsticker-treeview-own-frame
- t
- "Decides whether newsticker creates and uses its own frame."
- :type 'boolean
- :group 'newsticker-treeview)
-
-(defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
- t
- "Decides whether to automatically mark displayed items as old.
-If t an item is marked as old as soon as it is displayed. This
-applies to newsticker only."
- :type 'boolean
- :group 'newsticker-treeview)
-
-(defvar newsticker-groups
- '("Feeds")
- "List of feed groups, used in the treeview frontend.
-Each element must be a list consisting of strings. The first
-element gives the title of the group, the following elements the
-names of feeds that belong to the group.
-FIXME")
-
-(defcustom newsticker-groups-filename
- "~/.newsticker-groups"
- "Name of the newsticker groups settings file."
- :type 'string
- :group 'newsticker-treeview)
-
-;; ======================================================================
-;;; internal variables
-;; ======================================================================
-(defvar newsticker--treeview-windows nil)
-(defvar newsticker--treeview-buffers nil)
-(defvar newsticker--treeview-current-feed nil)
-(defvar newsticker--treeview-current-vfeed nil)
-(defvar newsticker--treeview-list-show-feed nil)
-(defvar newsticker--saved-window-config nil)
-(defvar newsticker--window-config nil)
-;; (makunbound 'newsticker--selection-overlay) ;; FIXME
-(defvar newsticker--selection-overlay nil
- "Highlight the selected tree node.")
-;;(makunbound 'newsticker--tree-selection-overlay) ;; FIXME
-(defvar newsticker--tree-selection-overlay nil
- "Highlight the selected list item.")
-;;(makunbound 'newsticker--frame);; FIXME
-(defvar newsticker--frame nil "Special frame for newsticker windows.")
-(defvar newsticker--treeview-list-sort-order 'sort-by-time)
-(defvar newsticker--treeview-current-node-id nil)
-(defvar newsticker--treeview-current-tree nil)
-(defvar newsticker--treeview-feed-tree nil)
-(defvar newsticker--treeview-vfeed-tree nil)
-
-;; maps for the clickable portions
-(defvar newsticker--treeview-url-keymap
- (let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
- (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
- (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
- (define-key map "\n" 'newsticker-treeview-browse-url)
- (define-key map "\C-m" 'newsticker-treeview-browse-url)
- (define-key map [(control return)] 'newsticker-handle-url)
- map)
- "Key map for click-able headings in the newsticker treeview buffers.")
-
-
-;; ======================================================================
-;;; short cuts
-;; ======================================================================
-(defsubst newsticker--treeview-tree-buffer ()
- "Return the tree buffer of the newsticker treeview."
- (nth 0 newsticker--treeview-buffers))
-(defsubst newsticker--treeview-list-buffer ()
- "Return the list buffer of the newsticker treeview."
- (nth 1 newsticker--treeview-buffers))
-(defsubst newsticker--treeview-item-buffer ()
- "Return the item buffer of the newsticker treeview."
- (nth 2 newsticker--treeview-buffers))
-(defsubst newsticker--treeview-tree-window ()
- "Return the tree window of the newsticker treeview."
- (nth 0 newsticker--treeview-windows))
-(defsubst newsticker--treeview-list-window ()
- "Return the list window of the newsticker treeview."
- (nth 1 newsticker--treeview-windows))
-(defsubst newsticker--treeview-item-window ()
- "Return the item window of the newsticker treeview."
- (nth 2 newsticker--treeview-windows))
-
-;; ======================================================================
-;;; utility functions
-;; ======================================================================
-(defun newsticker--treeview-get-id (parent i)
- "Create an id for a newsticker treeview node.
-PARENT is the node's parent, I is an integer."
- ;;(message "newsticker--treeview-get-id %s"
- ;; (format "%s-%d" (widget-get parent :nt-id) i))
- (format "%s-%d" (widget-get parent :nt-id) i))
-
-(defun newsticker--treeview-ids-eq (id1 id2)
- "Return non-nil if ids ID1 and ID2 are equal."
- ;;(message "%s/%s" (or id1 -1) (or id2 -1))
- (and id1 id2 (string= id1 id2)))
-
-(defun newsticker--treeview-nodes-eq (node1 node2)
- "Compare treeview nodes NODE1 and NODE2 for equality.
-Nodes are equal if the have the same newsticker-id. Note that
-during re-tagging and collapsing/expanding nodes change, while
-their id stays constant."
- (let ((id1 (widget-get node1 :nt-id))
- (id2 (widget-get node2 :nt-id)))
- ;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
- ;; (or id1 -1) (or id2 -1))
- (or (newsticker--treeview-ids-eq id1 id2)
- (string= (widget-get node1 :tag) (widget-get node2 :tag)))))
-
-(defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
- "Recursivly search node for feed FEED-NAME starting from STARTNODE."
- ;;(message "%s/%s" feed-name (widget-get startnode :nt-feed))
- (if (string= feed-name (or (widget-get startnode :nt-feed)
- (widget-get startnode :nt-vfeed)))
- (throw 'found startnode)
- (let ((children (widget-get startnode :children)))
- (dolist (w children)
- (newsticker--treeview-do-get-node-of-feed feed-name w)))))
-
-(defun newsticker--treeview-get-node-of-feed (feed-name)
- "Return node for feed FEED-NAME in newsticker treeview tree."
- (catch 'found
- (newsticker--treeview-do-get-node-of-feed feed-name
- newsticker--treeview-feed-tree)
- (newsticker--treeview-do-get-node-of-feed feed-name
- newsticker--treeview-vfeed-tree)))
-
-(defun newsticker--treeview-do-get-node (id startnode)
- "Recursivly search node with ID starting from STARTNODE."
- (if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
- (throw 'found startnode)
- (let ((children (widget-get startnode :children)))
- (dolist (w children)
- (newsticker--treeview-do-get-node id w)))))
-
-(defun newsticker--treeview-get-node (id)
- "Return node with ID in newsticker treeview tree."
- (catch 'found
- (newsticker--treeview-do-get-node id newsticker--treeview-feed-tree)
- (newsticker--treeview-do-get-node id newsticker--treeview-vfeed-tree)))
-
-(defun newsticker--treeview-get-current-node ()
- "Return current node in newsticker treeview tree."
- (newsticker--treeview-get-node newsticker--treeview-current-node-id))
-
-;; ======================================================================
-
-(declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
-
-(defun newsticker--treeview-render-text (start end)
- "Render text between markers START and END."
- (if newsticker-html-renderer
- (condition-case error-data
- (save-excursion
- (set-marker-insertion-type end t)
- ;; check whether it is necessary to call html renderer
- ;; (regexp inspired by htmlr.el)
- (goto-char start)
- (when (re-search-forward
- "</?[A-Za-z1-6]*\\|&#?[A-Za-z0-9]+;" end t)
- ;; (message "%s" (newsticker--title item))
- (let ((w3m-fill-column (if newsticker-use-full-width
- -1 fill-column))
- (w3-maximum-line-length
- (if newsticker-use-full-width nil fill-column)))
- (save-excursion
- (funcall newsticker-html-renderer start end)))
- ;;(cond ((eq newsticker-html-renderer 'w3m-region)
- ;; (add-text-properties start end (list 'keymap
- ;; w3m-minor-mode-map)))
- ;;((eq newsticker-html-renderer 'w3-region)
- ;;(add-text-properties start end (list 'keymap w3-mode-map))))
- (if (eq newsticker-html-renderer 'w3m-region)
- (w3m-toggle-inline-images t))
- t))
- (error
- (message "Error: HTML rendering failed: %s, %s"
- (car error-data) (cdr error-data))
- nil))
- nil))
-
-;; ======================================================================
-;;; List window
-;; ======================================================================
-(defun newsticker--treeview-list-add-item (item feed &optional show-feed)
- "Add news ITEM for FEED to newsticker treeview list window.
-If string SHOW-FEED is non-nil it is shown in the item string."
- (setq newsticker--treeview-list-show-feed show-feed)
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (let* ((inhibit-read-only t)
- pos1 pos2)
- (goto-char (point-max))
- (setq pos1 (point-marker))
- (insert " ")
- (insert (propertize " " 'display '(space :align-to 2)))
- (insert (if show-feed
- (concat
- (substring
- (format "%-10s" (newsticker--real-feed-name
- feed))
- 0 10)
- (propertize " " 'display '(space :align-to 12)))
- ""))
- (insert (format-time-string "%d.%m.%y, %H:%M"
- (newsticker--time item)))
- (insert (propertize " " 'display
- (list 'space :align-to (if show-feed 28 18))))
- (setq pos2 (point-marker))
- (insert (newsticker--title item))
- (insert "\n")
- (newsticker--treeview-render-text pos2 (point-marker))
- (goto-char pos2)
- (while (search-forward "\n" nil t)
- (replace-match " "))
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'newsticker-treeview-tree-click)
- (define-key map "\n" 'newsticker-treeview-show-item)
- (define-key map "\C-m" 'newsticker-treeview-show-item)
- (add-text-properties pos1 (point-max)
- (list :nt-item item
- :nt-feed feed
- :nt-link (newsticker--link item)
- 'mouse-face 'highlight
- 'keymap map
- 'help-echo "Show item")))
- (insert "\n"))))
-
-(defun newsticker--treeview-list-clear ()
- "Clear the newsticker treeview list window."
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (kill-all-local-variables)
- (remove-overlays))))
-
-(defun newsticker--treeview-list-items-with-age-callback (widget
- changed-widget
- &rest ages)
- "Fill newsticker treeview list window with items of certain age.
-This is a callback function for the treeview nodes.
-Argument WIDGET is the calling treeview widget.
-Argument CHANGED-WIDGET is the widget that actually has changed.
-Optional argument AGES is the list of ages that are to be shown."
- (newsticker--treeview-list-clear)
- (widget-put widget :nt-selected t)
- (apply 'newsticker--treeview-list-items-with-age ages))
-
-(defun newsticker--treeview-list-items-with-age (&rest ages)
- "Actually fill newsticker treeview list window with items of certain age.
-AGES is the list of ages that are to be shown."
- (mapc (lambda (feed)
- (let ((feed-name-symbol (intern (car feed))))
- (mapc (lambda (item)
- (when (memq (newsticker--age item) ages)
- (newsticker--treeview-list-add-item
- item feed-name-symbol t)))
- (newsticker--treeview-list-sort-items
- (cdr (newsticker--cache-get-feed feed-name-symbol))))))
- (append newsticker-url-list-defaults newsticker-url-list))
- (newsticker--treeview-list-update nil))
-
-(defun newsticker--treeview-list-new-items (widget changed-widget
- &optional event)
- "Fill newsticker treeview list window with new items.
-This is a callback function for the treeview nodes.
-Argument WIDGET FIXME.
-Argument CHANGED-WIDGET FIXME.
-Optional argument EVENT FIXME."
- (newsticker--treeview-list-items-with-age-callback widget changed-widget
- 'new)
- (newsticker--treeview-item-show-text
- "New items"
- "This is a virtual feed containing all new items"))
-
-(defun newsticker--treeview-list-immortal-items (widget changed-widget
- &optional event)
- "Fill newsticker treeview list window with immortal items.
-This is a callback function for the treeview nodes.
-Argument WIDGET FIXME.
-Argument CHANGED-WIDGET FIXME.
-Optional argument EVENT FIXME."
- (newsticker--treeview-list-items-with-age-callback widget changed-widget
- 'immortal)
- (newsticker--treeview-item-show-text
- "Immortal items"
- "This is a virtual feed containing all immortal items."))
-
-(defun newsticker--treeview-list-obsolete-items (widget changed-widget
- &optional event)
- "Fill newsticker treeview list window with obsolete items.
-This is a callback function for the treeview nodes.
-Argument WIDGET FIXME.
-Argument CHANGED-WIDGET FIXME.
-Optional argument EVENT FIXME."
- (newsticker--treeview-list-items-with-age-callback widget changed-widget
- 'obsolete)
- (newsticker--treeview-item-show-text
- "Obsolete items"
- "This is a virtual feed containing all obsolete items."))
-
-(defun newsticker--treeview-list-all-items (widget changed-widget
- &optional event)
- "Fill newsticker treeview list window with all items.
-This is a callback function for the treeview nodes.
-Argument WIDGET FIXME.
-Argument CHANGED-WIDGET FIXME.
-Optional argument EVENT FIXME."
- (newsticker--treeview-list-items-with-age-callback widget changed-widget
- event 'new 'old
- 'obsolete 'immortal)
- (newsticker--treeview-item-show-text
- "All items"
- "This is a virtual feed containing all items."))
-
-(defun newsticker--treeview-list-items-v (vfeed-name)
- "List items for virtual feed VFEED-NAME."
- (when vfeed-name
- (cond ((string-match "\\*new\\*" vfeed-name)
- (newsticker--treeview-list-items-with-age 'new))
- ((string-match "\\*immortal\\*" vfeed-name)
- (newsticker--treeview-list-items-with-age 'immortal))
- ((string-match "\\*old\\*" vfeed-name)
- (newsticker--treeview-list-items-with-age 'old nil)))
- (newsticker--treeview-list-update nil)
- ))
-
-(defun newsticker--treeview-list-items (feed-name)
- "List items for feed FEED-NAME."
- (when feed-name
- (if (newsticker--treeview-virtual-feed-p feed-name)
- (newsticker--treeview-list-items-v feed-name)
- (mapc (lambda (item)
- (if (eq (newsticker--age item) 'feed)
- (newsticker--treeview-item-show item (intern feed-name))
- (newsticker--treeview-list-add-item item
- (intern feed-name))))
- (newsticker--treeview-list-sort-items
- (cdr (newsticker--cache-get-feed (intern feed-name)))))
- (newsticker--treeview-list-update nil))))
-
-(defun newsticker--treeview-list-feed-items (widget changed-widget
- &optional event)
- "Callback function for listing feed items.
-Argument WIDGET FIXME.
-Argument CHANGED-WIDGET FIXME.
-Optional argument EVENT FIXME."
- (newsticker--treeview-list-clear)
- (widget-put widget :nt-selected t)
- (let ((feed-name (widget-get widget :nt-feed))
- (vfeed-name (widget-get widget :nt-vfeed)))
- (if feed-name
- (newsticker--treeview-list-items feed-name)
- (newsticker--treeview-list-items-v vfeed-name))))
-
-(defun newsticker--treeview-list-compare-item-by-age (item1 item2)
- "Compare two news items ITEM1 and ITEM2 wrt age."
- (catch 'result
- (let ((age1 (newsticker--age item1))
- (age2 (newsticker--age item2)))
- (cond ((eq age1 'new)
- t)
- ((eq age1 'immortal)
- (cond ((eq age2 'new)
- t)
- ((eq age2 'immortal)
- t)
- (t
- nil)))
- ((eq age1 'old)
- (cond ((eq age2 'new)
- nil)
- ((eq age2 'immortal)
- nil)
- ((eq age2 'old)
- nil)
- (t
- t)))
- (t
- nil)))))
-
-(defun newsticker--treeview-list-compare-item-by-age-reverse (item1 item2)
- "Compare two news items ITEM1 and ITEM2 wrt age in reverse order."
- (newsticker--treeview-list-compare-item-by-age item2 item1))
-
-(defun newsticker--treeview-list-compare-item-by-time (item1 item2)
- "Compare two news items ITEM1 and ITEM2 wrt time values."
- (newsticker--cache-item-compare-by-time item1 item2))
-
-(defun newsticker--treeview-list-compare-item-by-time-reverse (item1 item2)
- "Compare two news items ITEM1 and ITEM2 wrt time values in reverse order."
- (newsticker--cache-item-compare-by-time item2 item1))
-
-(defun newsticker--treeview-list-compare-item-by-title (item1 item2)
- "Compare two news items ITEM1 and ITEM2 wrt title."
- (newsticker--cache-item-compare-by-title item1 item2))
-
-(defun newsticker--treeview-list-compare-item-by-title-reverse (item1 item2)
- "Compare two news items ITEM1 and ITEM2 wrt title in reverse order."
- (newsticker--cache-item-compare-by-title item2 item1))
-
-(defun newsticker--treeview-list-sort-items (items)
- "Return sorted copy of list ITEMS.
-The sort function is chosen according to the value of
-`newsticker--treeview-list-sort-order'."
- (let ((sort-fun
- (cond ((eq newsticker--treeview-list-sort-order 'sort-by-age)
- 'newsticker--treeview-list-compare-item-by-age)
- ((eq newsticker--treeview-list-sort-order
- 'sort-by-age-reverse)
- 'newsticker--treeview-list-compare-item-by-age-reverse)
- ((eq newsticker--treeview-list-sort-order 'sort-by-time)
- 'newsticker--treeview-list-compare-item-by-time)
- ((eq newsticker--treeview-list-sort-order
- 'sort-by-time-reverse)
- 'newsticker--treeview-list-compare-item-by-time-reverse)
- ((eq newsticker--treeview-list-sort-order 'sort-by-title)
- 'newsticker--treeview-list-compare-item-by-title)
- ((eq newsticker--treeview-list-sort-order
- 'sort-by-title-reverse)
- 'newsticker--treeview-list-compare-item-by-title-reverse)
- (t
- 'newsticker--treeview-list-compare-item-by-title))))
- (sort (copy-sequence items) sort-fun)))
-
-(defun newsticker--treeview-list-update-faces ()
- "Update faces in the treeview list buffer."
- (let (pos-sel)
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((pos (save-excursion (end-of-line) (point)))
- (item (get-text-property (point) :nt-item))
- (age (newsticker--age item))
- (selected (get-text-property (point) :nt-selected))
- (face (cond ((eq age 'new)
- 'newsticker-treeview-new-face)
- ((eq age 'old)
- 'newsticker-treeview-old-face)
- ((eq age 'immortal)
- 'newsticker-treeview-immortal-face)
- ((eq age 'obsolete)
- 'newsticker-treeview-obsolete-face)
- (t
- 'bold))))
- (put-text-property (point) pos 'face face)
- (if selected
- (move-overlay newsticker--selection-overlay (point)
- (1+ pos) ;include newline
- (current-buffer)))
- (if selected (setq pos-sel (point)))
- (forward-line 1)
- (beginning-of-line))))) ;; FIXME!?
- (when pos-sel
- (set-window-point (newsticker--treeview-list-window) pos-sel))))
-
-(defun newsticker--treeview-list-clear-highlight ()
- "Clear the highlight in the treeview list buffer."
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (let ((inhibit-read-only t))
- (put-text-property (point-min) (point-max) :nt-selected nil))
- (newsticker--treeview-list-update-faces)))
-
-(defun newsticker--treeview-list-update-highlight ()
- "Update the highlight in the treeview list buffer."
- (newsticker--treeview-list-clear-highlight)
- (let (pos num-lines)
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (let ((inhibit-read-only t))
- (put-text-property (save-excursion (beginning-of-line) (point))
- (save-excursion (end-of-line) (point))
- :nt-selected t))
- (newsticker--treeview-list-update-faces))))
-
-(defun newsticker--treeview-list-highlight-start ()
- "Return position of selection in treeview list buffer."
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (goto-char (point-min))
- (next-single-property-change (point) :nt-selected)))
-
-(defun newsticker--treeview-list-update (clear-buffer)
- "Update the faces and highlight in the treeview list buffer.
-If CLEAR-BUFFER is non-nil the list buffer is completely erased."
- (save-excursion
- (set-window-buffer (newsticker--treeview-list-window)
- (newsticker--treeview-list-buffer))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-list-window) t))
- (set-buffer (newsticker--treeview-list-buffer))
- (if clear-buffer
- (let ((inhibit-read-only t))
- (erase-buffer)))
- (newsticker-treeview-list-mode)
- (newsticker--treeview-list-update-faces)
- (goto-char (point-min))))
-
-;;(makunbound 'newsticker-treeview-list-sort-button-map);; FIXME
-(defvar newsticker-treeview-list-sort-button-map
- (let ((map (make-sparse-keymap)))
- (define-key map [header-line mouse-1]
- 'newsticker--treeview-list-sort-by-column)
- (define-key map [header-line mouse-2]
- 'newsticker--treeview-list-sort-by-column)
- map)
- "Local keymap for newsticker treeview list window sort buttons.")
-
-(defun newsticker--treeview-list-sort-by-column (&optional e)
- "Sort the newsticker list window buffer by the column clicked on.
-Optional argument E FIXME."
- (interactive (list last-input-event))
- (if e (mouse-select-window e))
- (let* ((pos (event-start e))
- (obj (posn-object pos))
- (sort-order (if obj
- (get-text-property (cdr obj) 'sort-order (car obj))
- (get-text-property (posn-point pos) 'sort-order))))
- (setq newsticker--treeview-list-sort-order
- (cond ((eq sort-order 'sort-by-age)
- (if (eq newsticker--treeview-list-sort-order 'sort-by-age)
- 'sort-by-age-reverse
- 'sort-by-age))
- ((eq sort-order 'sort-by-time)
- (if (eq newsticker--treeview-list-sort-order 'sort-by-time)
- 'sort-by-time-reverse
- 'sort-by-time))
- ((eq sort-order 'sort-by-title)
- (if (eq newsticker--treeview-list-sort-order 'sort-by-title)
- 'sort-by-title-reverse
- 'sort-by-title))))
- (newsticker-treeview-update)))
-
-(defun newsticker-treeview-list-make-sort-button (name sort-order)
- "Create propertized string for headerline button.
-NAME is the button text, SORT-ORDER is the associated sort order
-for the button."
- (let ((face (if (string-match (symbol-name sort-order)
- (symbol-name
- newsticker--treeview-list-sort-order))
- 'bold
- 'header-line)))
- (propertize name
- 'sort-order sort-order
- 'help-echo (concat "Sort by " name)
- 'mouse-face 'highlight
- 'face face
- 'keymap newsticker-treeview-list-sort-button-map)))
-
-;; ======================================================================
-;;; item window
-;; ======================================================================
-(defun newsticker--treeview-item-show-text (title description)
- "Show text in treeview item buffer consisting of TITLE and DESCRIPTION."
- (save-excursion
- (set-buffer (newsticker--treeview-item-buffer))
- (when (fboundp 'w3m-process-stop)
- (w3m-process-stop (current-buffer)))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (kill-all-local-variables)
- (remove-overlays)
- (insert title)
- (put-text-property (point-min) (point) 'face 'newsticker-feed-face)
- (insert "\n\n" description)
- (when newsticker-justification
- (fill-region (point-min) (point-max) newsticker-justification))
- (newsticker-treeview-mode)
- (goto-char (point-min)))))
-
-(defun newsticker--treeview-item-show (item feed)
- "Show news ITEM coming from FEED in treeview item buffer."
- (save-excursion
- (set-buffer (newsticker--treeview-item-buffer))
- (when (fboundp 'w3m-process-stop)
- (w3m-process-stop (current-buffer)))
- (let ((inhibit-read-only t)
- (is-rendered-HTML nil)
- pos
- (marker1 (make-marker))
- (marker2 (make-marker)))
- (erase-buffer)
- (kill-all-local-variables)
- (remove-overlays)
-
- (when (and item feed)
- (let ((wwidth (1- (window-width (newsticker--treeview-item-window)))))
- (if newsticker-use-full-width
- (set (make-local-variable 'fill-column) wwidth))
- (set (make-local-variable 'fill-column) (min fill-column
- wwidth)))
- (let ((desc (newsticker--desc item)))
- (insert "\n" (or desc "[No Description]")))
- (set-marker marker1 (1+ (point-min)))
- (set-marker marker2 (point-max))
- (setq is-rendered-HTML (newsticker--treeview-render-text marker1
- marker2))
- (when (and newsticker-justification
- (not is-rendered-HTML))
- (fill-region marker1 marker2 newsticker-justification))
-
- (newsticker-treeview-mode)
- (goto-char (point-min))
- ;; insert logo at top
- (let* ((newsticker-enable-logo-manipulations nil)
- (img (newsticker--image-read feed nil)))
- (if (and (display-images-p) img)
- (newsticker--insert-image img (car item))
- (insert (newsticker--real-feed-name feed))))
- (add-text-properties (point-min) (point)
- (list 'face 'newsticker-feed-face
- 'mouse-face 'highlight
- 'help-echo "Visit in web browser."
- :nt-link (newsticker--link item)
- 'keymap newsticker--treeview-url-keymap))
- (setq pos (point))
-
- (insert "\n\n")
- ;; insert title
- (setq pos (point))
- (insert (newsticker--title item) "\n")
- (set-marker marker1 pos)
- (set-marker marker2 (point))
- (newsticker--treeview-render-text marker1 marker2)
- (put-text-property pos (point) 'face 'newsticker-treeview-new-face)
- (goto-char marker2)
- (delete-char -1)
- (insert "\n")
- (put-text-property marker2 (point) 'face 'newsticker-treeview-face)
- (set-marker marker2 (point))
- (when newsticker-justification
- (fill-region marker1 marker2 newsticker-justification))
- (goto-char marker2)
- (add-text-properties marker1 (1- (point))
- (list 'mouse-face 'highlight
- 'help-echo "Visit in web browser."
- :nt-link (newsticker--link item)
- 'keymap newsticker--treeview-url-keymap))
- (insert (format-time-string newsticker-date-format
- (newsticker--time item)))
- (insert "\n")
- (setq pos (point))
- (insert "\n")
- ;; insert enclosures and rest at bottom
- (goto-char (point-max))
- (insert "\n\n")
- (setq pos (point))
- (newsticker--insert-enclosure item newsticker--treeview-url-keymap)
- (put-text-property pos (point) 'face 'newsticker-enclosure-face)
- (setq pos (point))
- (insert "\n")
- (newsticker--print-extra-elements item newsticker--treeview-url-keymap)
- (put-text-property pos (point) 'face 'newsticker-extra-face)
- (goto-char (point-min)))))
- (if (and newsticker-treeview-automatically-mark-displayed-items-as-old
- item
- (memq (newsticker--age item) '(new obsolete)))
- (let ((newsticker-treeview-automatically-mark-displayed-items-as-old nil))
- (newsticker-treeview-mark-item-old t)
- (newsticker--treeview-list-update-faces)))
- (set-window-point (newsticker--treeview-item-window) 1))
-
-(defun newsticker--treeview-item-update ()
- "Update the treeview item buffer and window."
- (save-excursion
- (set-window-buffer (newsticker--treeview-item-window)
- (newsticker--treeview-item-buffer))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-item-window) t))
- (set-buffer (newsticker--treeview-item-buffer))
- (let ((inhibit-read-only t))
- (erase-buffer))
- (newsticker-treeview-mode)))
-
-;; ======================================================================
-;;; Tree window
-;; ======================================================================
-(defun newsticker--treeview-tree-expand (tree)
- "Expand TREE.
-Callback function for tree widget that adds nodes for feeds and subgroups."
- (newsticker--group-manage-orphan-feeds)
- (tree-widget-set-theme "folder")
- (let ((group (widget-get tree :nt-group))
- (i 0)
- (nt-id ""))
- (mapcar (lambda (g)
- (setq nt-id (newsticker--treeview-get-id tree i))
- (setq i (1+ i))
- (if (listp g)
- (let* ((g-name (car g)))
- `(tree-widget
- :tag ,(newsticker--treeview-tree-get-tag g-name nil nt-id)
- :expander newsticker--treeview-tree-expand
- :expander-p (lambda (&rest ignore) t)
- :nt-group ,(cdr g)
- :nt-feed ,g-name
- :nt-id ,nt-id
- :keep (:nt-feed :num-new :nt-id :open);; :nt-group
- :open nil))
- (let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
- `(item :tag ,tag
- :leaf-icon newsticker--tree-widget-leaf-icon
- :nt-feed ,g
- :action newsticker--treeview-list-feed-items
- :nt-id ,nt-id
- :keep (:nt-id)
- :open t))))
- group)))
-
-(defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
- event)
- "Expand the vfeed TREE.
-Optional arguments CHANGED-WIDGET and EVENT are ignored."
- (tree-widget-set-theme "folder")
- (list `(item :tag ,(newsticker--treeview-tree-get-tag nil "new")
- :nt-vfeed "new"
- :action newsticker--treeview-list-new-items
- :nt-id ,(newsticker--treeview-get-id tree 0)
- :keep (:nt-id))
- `(item :tag ,(newsticker--treeview-tree-get-tag nil "immortal")
- :nt-vfeed "immortal"
- :action newsticker--treeview-list-immortal-items
- :nt-id ,(newsticker--treeview-get-id tree 1)
- :keep (:nt-id))
- `(item :tag ,(newsticker--treeview-tree-get-tag nil "obsolete")
- :nt-vfeed "obsolete"
- :action newsticker--treeview-list-obsolete-items
- :nt-id ,(newsticker--treeview-get-id tree 2)
- :keep (:nt-id))
- `(item :tag ,(newsticker--treeview-tree-get-tag nil "all")
- :nt-vfeed "all"
- :action newsticker--treeview-list-all-items
- :nt-id ,(newsticker--treeview-get-id tree 3)
- :keep (:nt-id))))
-
-(defun newsticker--treeview-virtual-feed-p (feed-name)
- "Return non-nil if FEED-NAME is a virtual feed."
- (string-match "\\*.*\\*" feed-name))
-
-(define-widget 'newsticker--tree-widget-leaf-icon 'tree-widget-icon
- "Icon for a tree-widget leaf node."
- :tag "O"
- :glyph-name "leaf"
- :button-face 'default)
-
-(defun newsticker--treeview-tree-update ()
- "Update treeview tree buffer and window."
- (save-excursion
- (set-window-buffer (newsticker--treeview-tree-window)
- (newsticker--treeview-tree-buffer))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-tree-window) t))
- (set-buffer (newsticker--treeview-tree-buffer))
- (kill-all-local-variables)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (tree-widget-set-theme "folder")
- (setq newsticker--treeview-feed-tree
- (widget-create 'tree-widget
- :tag (newsticker--treeview-propertize-tag
- "Feeds" 0 "feeds")
- :expander 'newsticker--treeview-tree-expand
- :expander-p (lambda (&rest ignore) t)
- :leaf-icon 'newsticker--tree-widget-leaf-icon
- :nt-group (cdr newsticker-groups)
- :nt-id "feeds"
- :keep '(:nt-id)
- :open t))
- (setq newsticker--treeview-vfeed-tree
- (widget-create 'tree-widget
- :tag (newsticker--treeview-propertize-tag
- "Virtual Feeds" 0 "vfeeds")
- :expander 'newsticker--treeview-tree-expand-status
- :expander-p (lambda (&rest ignore) t)
- :leaf-icon 'newsticker--tree-widget-leaf-icon
- :nt-id "vfeeds"
- :keep '(:nt-id)
- :open t))
- (use-local-map widget-keymap)
- (widget-setup))
- (newsticker-treeview-mode)))
-
-(defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
- vfeed)
- "Return propertized copy of string TAG.
-Optional argument NUM-NEW is used for choosing face, other
-arguments NT-ID, FEED, and VFEED are added as properties."
- ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
- (let ((face 'newsticker-treeview-face)
- (map (make-sparse-keymap)))
- (if (and num-new (> num-new 0))
- (setq face 'newsticker-treeview-new-face))
- (define-key map [mouse-1] 'newsticker-treeview-tree-click)
- (define-key map "\n" 'newsticker-treeview-tree-do-click)
- (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
- (propertize tag 'face face 'keymap map
- :nt-id nt-id
- :nt-feed feed
- :nt-vfeed vfeed
- 'help-echo "Clickme!"
- 'mouse-face 'highlight)))
-
-(defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
- &optional nt-id)
- "Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
-Optional argument NT-ID is added to the tag's properties."
- (let (tag (num-new 0))
- (cond (vfeed-name
- (cond ((string= vfeed-name "new")
- (setq num-new (newsticker--stat-num-items-total 'new))
- (setq tag (format "New items (%d)" num-new)))
- ((string= vfeed-name "immortal")
- (setq num-new (newsticker--stat-num-items-total 'immortal))
- (setq tag (format "Immortal items (%d)" num-new)))
- ((string= vfeed-name "obsolete")
- (setq num-new (newsticker--stat-num-items-total 'obsolete))
- (setq tag (format "Obsolete items (%d)" num-new)))
- ((string= vfeed-name "all")
- (setq num-new (newsticker--stat-num-items-total))
- (setq tag (format "All items (%d)" num-new)))))
- (feed-name
- (setq num-new (newsticker--stat-num-items-for-group
- (intern feed-name) 'new 'immortal))
- (setq tag
- (format "%s (%d)"
- (newsticker--real-feed-name (intern feed-name))
- num-new))))
- (if tag
- (newsticker--treeview-propertize-tag tag num-new
- nt-id
- feed-name vfeed-name))))
-
-(defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
- "Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
- ;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
- (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
- (mapc (lambda (f-n)
- (setq result (+ result
- (apply 'newsticker--stat-num-items (intern f-n)
- ages))))
- (newsticker--group-get-feeds
- (newsticker--group-get-group (symbol-name feed-name-symbol)) t))
- result))
-
-(defun newsticker--treeview-count-node-items (feed &optional isvirtual)
- "Count number of relevant items for a treeview node.
-FEED gives the name of the feed or group. If ISVIRTUAL is non-nil
-the feed is a virtual feed."
- (let* ((num-new 0))
- (if feed
- (if isvirtual
- (cond ((string= feed "new")
- (setq num-new (newsticker--stat-num-items-total 'new)))
- ((string= feed "immortal")
- (setq num-new (newsticker--stat-num-items-total 'immortal)))
- ((string= feed "obsolete")
- (setq num-new (newsticker--stat-num-items-total 'obsolete)))
- ((string= feed "all")
- (setq num-new (newsticker--stat-num-items-total))))
- (setq num-new (newsticker--stat-num-items-for-group
- (intern feed) 'new 'immortal))))
- num-new))
-
-(defun newsticker--treeview-tree-update-tag (w &optional recursive
- &rest ignore)
- "Update tag for tree widget W.
-If RECURSIVE is non-nil recursively update parent widgets as
-well. Argument IGNORE is ignored. Note that this function, if
-called recursively, makes w invalid. You should keep w's nt-id in
-that case."
- ;;(message "newsticker--treeview-tree-update-tag %s, %s" (widget-get w :tag)
- ;; (widget-type w))
- (let* ((parent (widget-get w :parent))
- (feed (or (widget-get w :nt-feed) (widget-get parent :nt-feed)))
- (vfeed (or (widget-get w :nt-vfeed) (widget-get parent :nt-vfeed)))
- (nt-id (or (widget-get w :nt-id) (widget-get parent :nt-id)))
- (num-new (newsticker--treeview-count-node-items (or feed vfeed)
- vfeed))
- (tag (newsticker--treeview-tree-get-tag feed vfeed nt-id))
- (n (widget-get w :node)))
- (if parent
- (if recursive
- (newsticker--treeview-tree-update-tag parent)))
- (when tag
- (when n
- (widget-put n :tag tag))
- (widget-put w :num-new num-new)
- (widget-put w :tag tag)
- (when (marker-position (widget-get w :from))
- (let ((p (point))
- (notify (widget-get w :notify)))
- ;; FIXME: This moves point!!!!
- (save-excursion
- (set-buffer (newsticker--treeview-tree-buffer))
- (widget-value-set w (widget-value w)))
- (goto-char p))))))
-
-(defun newsticker--treeview-tree-do-update-tags (widget)
- "Actually recursively update tags for WIDGET."
- (save-excursion
- (let ((children (widget-get widget :children)))
- (dolist (w children)
- (newsticker--treeview-tree-do-update-tags w))
- (newsticker--treeview-tree-update-tag widget))))
-
-(defun newsticker--treeview-tree-update-tags (&rest ignore)
- "Update all tags of all trees.
-Arguments IGNORE are ignored."
- (save-current-buffer
- (set-buffer (newsticker--treeview-tree-buffer))
- (let ((inhibit-read-only t))
- (newsticker--treeview-tree-do-update-tags
- newsticker--treeview-feed-tree)
- (newsticker--treeview-tree-do-update-tags
- newsticker--treeview-vfeed-tree))
- (tree-widget-set-theme "folder")))
-
-(defun newsticker--treeview-tree-update-highlight ()
- "Update highlight in tree buffer."
- (let ((pos (widget-get (newsticker--treeview-get-current-node) :from)))
- (unless (or (integerp pos) (and (markerp pos) (marker-position pos)))
- (setq pos (widget-get (widget-get
- (newsticker--treeview-get-current-node)
- :parent) :from)))
- (when (or (integerp pos) (and (markerp pos) (marker-position pos)))
- (save-excursion
- (set-buffer (newsticker--treeview-tree-buffer))
- (goto-char pos)
- (move-overlay newsticker--tree-selection-overlay
- (save-excursion (beginning-of-line) (point))
- (save-excursion (end-of-line) (1+ (point)))
- (current-buffer)))
- (set-window-point (newsticker--treeview-tree-window) pos))))
-
-;; ======================================================================
-;;; Toolbar
-;; ======================================================================
-;;(makunbound 'newsticker-treeview-tool-bar-map)
-(defvar newsticker-treeview-tool-bar-map
- (if (featurep 'xemacs)
- nil
- (if (boundp 'tool-bar-map)
- (let ((tool-bar-map (make-sparse-keymap)))
- (define-key tool-bar-map [newsticker-sep-1]
- (list 'menu-item "--double-line"))
- (define-key tool-bar-map [newsticker-browse-url]
- (list 'menu-item "newsticker-browse-url"
- 'newsticker-browse-url
- :visible t
- :help "Browse URL for item at point"
- :image newsticker--browse-image))
- (define-key tool-bar-map [newsticker-buffer-force-update]
- (list 'menu-item "newsticker-treeview-update"
- 'newsticker-treeview-update
- :visible t
- :help "Update newsticker buffer"
- :image newsticker--update-image
- :enable t))
- (define-key tool-bar-map [newsticker-get-all-news]
- (list 'menu-item "newsticker-get-all-news" 'newsticker-get-all-news
- :visible t
- :help "Get news for all feeds"
- :image newsticker--get-all-image))
- (define-key tool-bar-map [newsticker-mark-item-at-point-as-read]
- (list 'menu-item "newsticker-treeview-mark-item-old"
- 'newsticker-treeview-mark-item-old
- :visible t
- :image newsticker--mark-read-image
- :help "Mark current item as read"
- ;;:enable '(newsticker-item-not-old-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-mark-item-at-point-as-immortal]
- (list 'menu-item "newsticker-treeview-toggle-item-immortal"
- 'newsticker-treeview-toggle-item-immortal
- :visible t
- :image newsticker--mark-immortal-image
- :help "Toggle current item as immortal"
- :enable t
- ;;'(newsticker-item-not-immortal-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-next-feed]
- (list 'menu-item "newsticker-treeview-next-feed"
- 'newsticker-treeview-next-feed
- :visible t
- :help "Go to next feed"
- :image newsticker--next-feed-image
- :enable t
- ;;'(newsticker-next-feed-available-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-treeview-next-item]
- (list 'menu-item "newsticker-treeview-next-item"
- 'newsticker-treeview-next-item
- :visible t
- :help "Go to next item"
- :image newsticker--next-item-image
- :enable t
- ;;'(newsticker-next-item-available-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-treeview-prev-item]
- (list 'menu-item "newsticker-treeview-prev-item"
- 'newsticker-treeview-prev-item
- :visible t
- :help "Go to previous item"
- :image newsticker--previous-item-image
- :enable t
- ;;'(newsticker-previous-item-available-p) FIXME
- ))
- (define-key tool-bar-map [newsticker-treeview-prev-feed]
- (list 'menu-item "newsticker-treeview-prev-feed"
- 'newsticker-treeview-prev-feed
- :visible t
- :help "Go to previous feed"
- :image newsticker--previous-feed-image
- :enable t
- ;;'(newsticker-previous-feed-available-p) FIXME
- ))
- ;; standard icons / actions
- (tool-bar-add-item "close"
- 'newsticker-treeview-quit
- 'newsticker-treeview-quit
- :help "Close newsticker")
- (tool-bar-add-item "preferences"
- 'newsticker-customize
- 'newsticker-customize
- :help "Customize newsticker")
- tool-bar-map))))
-
-;; ======================================================================
-;;; actions
-;; ======================================================================
-
-(defun newsticker-treeview-mouse-browse-url (event)
- "Call `browse-url' for the link of the item at which the EVENT occurred."
- (interactive "e")
- (save-excursion
- (switch-to-buffer (window-buffer (posn-window (event-end event))))
- (let ((url (get-text-property (posn-point (event-end event))
- :nt-link)))
- (when url
- (browse-url url)
- (if newsticker-automatically-mark-visited-items-as-old
- (newsticker-treeview-mark-item-old))))))
-
-(defun newsticker-treeview-browse-url ()
- "Call `browse-url' for the link of the item at point."
- (interactive)
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (let ((url (get-text-property (point) :nt-link)))
- (when url
- (browse-url url)
- (if newsticker-automatically-mark-visited-items-as-old
- (newsticker-treeview-mark-item-old))))))
-
-(defun newsticker--treeview-buffer-init ()
- "Initialize all treeview buffers."
- (setq newsticker--treeview-buffers nil)
- (add-to-list 'newsticker--treeview-buffers
- (get-buffer-create "*Newsticker Tree*") t)
- (add-to-list 'newsticker--treeview-buffers
- (get-buffer-create "*Newsticker List*") t)
- (add-to-list 'newsticker--treeview-buffers
- (get-buffer-create "*Newsticker Item*") t)
-
- (unless newsticker--selection-overlay
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (setq newsticker--selection-overlay (make-overlay (point-min)
- (point-max)))
- (overlay-put newsticker--selection-overlay 'face
- 'newsticker-treeview-selection-face)))
- (unless newsticker--tree-selection-overlay
- (save-excursion
- (set-buffer (newsticker--treeview-tree-buffer))
- (setq newsticker--tree-selection-overlay (make-overlay (point-min)
- (point-max)))
- (overlay-put newsticker--tree-selection-overlay 'face
- 'newsticker-treeview-selection-face)))
-
- (newsticker--treeview-tree-update)
- (newsticker--treeview-list-update t)
- (newsticker--treeview-item-update))
-
-(defun newsticker-treeview-update ()
- "Update all treeview buffers and windows."
- (interactive)
- (newsticker--cache-update)
- (newsticker--group-manage-orphan-feeds)
- (newsticker--treeview-list-update t)
- (newsticker--treeview-item-update)
- (newsticker--treeview-tree-update-tags)
- (cond (newsticker--treeview-current-feed
- (newsticker--treeview-list-items newsticker--treeview-current-feed))
- (newsticker--treeview-current-vfeed
- (newsticker--treeview-list-items-with-age
- (intern newsticker--treeview-current-vfeed))))
- (newsticker--treeview-tree-update-highlight)
- (newsticker--treeview-list-update-highlight))
-
-(defun newsticker-treeview-quit ()
- "Quit newsticker treeview."
- (interactive)
- (newsticker-treeview-save)
- (setq newsticker--sentinel-callback nil)
- (setq newsticker--window-config (current-window-configuration))
- (bury-buffer "*Newsticker Tree*")
- (bury-buffer "*Newsticker List*")
- (bury-buffer "*Newsticker Item*")
- (set-window-configuration newsticker--saved-window-config)
- (when newsticker--frame
- (if (frame-live-p newsticker--frame)
- (delete-frame newsticker--frame))
- (setq newsticker--frame nil)))
-
-(defun newsticker-treeview-save ()
- "Save newsticker data including treeview settings."
- (interactive)
- (newsticker--cache-save)
- (save-excursion
- (let ((coding-system-for-write 'utf-8)
- (buf (find-file-noselect newsticker-groups-filename)))
- (when buf
- (set-buffer buf)
- (setq buffer-undo-list t)
- (erase-buffer)
- (insert ";; -*- coding: utf-8 -*-\n")
- (insert (prin1-to-string newsticker-groups))
- (save-buffer)))))
-
-(defun newsticker--treeview-load ()
- "Load treeview settings."
- (let* ((coding-system-for-read 'utf-8)
- (buf (and (file-exists-p newsticker-groups-filename)
- (find-file-noselect newsticker-groups-filename))))
- (when buf
- (set-buffer buf)
- (goto-char (point-min))
- (condition-case nil
- (setq newsticker-groups (read buf))
- (error
- (message "Error while reading newsticker groups file!")
- (setq newsticker-groups nil))))))
-
-
-(defun newsticker-treeview-scroll-item ()
- "Scroll current item."
- (interactive)
- (save-selected-window
- (select-window (newsticker--treeview-item-window) t)
- (scroll-up 1)))
-
-(defun newsticker-treeview-show-item ()
- "Show current item."
- (interactive)
- (newsticker--treeview-list-update-highlight)
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (beginning-of-line)
- (let ((item (get-text-property (point) :nt-item))
- (feed (get-text-property (point) :nt-feed)))
- (newsticker--treeview-item-show item feed)))
- (newsticker--treeview-tree-update-tag
- (newsticker--treeview-get-current-node) t)
- (newsticker--treeview-tree-update-highlight))
-
-(defun newsticker-treeview-next-item ()
- "Move to next item."
- (interactive)
- (newsticker--treeview-restore-buffers)
- (save-current-buffer
- (set-buffer (newsticker--treeview-list-buffer))
- (if (newsticker--treeview-list-highlight-start)
- (forward-line 1))
- (if (eobp)
- (forward-line -1)))
- (newsticker-treeview-show-item))
-
-(defun newsticker-treeview-prev-item ()
- "Move to previous item."
- (interactive)
- (newsticker--treeview-restore-buffers)
- (save-current-buffer
- (set-buffer (newsticker--treeview-list-buffer))
- (forward-line -1))
- (newsticker-treeview-show-item))
-
-(defun newsticker-treeview-next-new-or-immortal-item ()
- "Move to next new or immortal item."
- (interactive)
- (newsticker--treeview-restore-buffers)
- (newsticker--treeview-list-clear-highlight)
- (catch 'found
- (let ((index (newsticker-treeview-next-item)))
- (while t
- (save-current-buffer
- (set-buffer (newsticker--treeview-list-buffer))
- (forward-line 1)
- (when (eobp)
- (forward-line -1)
- (throw 'found nil)))
- (when (memq (newsticker--age
- (newsticker--treeview-get-selected-item)) '(new immortal))
- (newsticker-treeview-show-item)
- (throw 'found t))))))
-
-(defun newsticker-treeview-prev-new-or-immortal-item ()
- "Move to previous new or immortal item."
- (interactive)
- (newsticker--treeview-restore-buffers)
- (newsticker--treeview-list-clear-highlight)
- (catch 'found
- (let ((index (newsticker-treeview-next-item)))
- (while t
- (save-current-buffer
- (set-buffer (newsticker--treeview-list-buffer))
- (forward-line -1)
- (when (bobp)
- (throw 'found nil)))
- (when (memq (newsticker--age
- (newsticker--treeview-get-selected-item)) '(new immortal))
- (newsticker-treeview-show-item)
- (throw 'found t))))))
-
-(defun newsticker--treeview-get-selected-item ()
- "Return item that is currently selected in list buffer."
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (beginning-of-line)
- (get-text-property (point) :nt-item)))
-
-(defun newsticker-treeview-mark-item-old (&optional dont-proceed)
- "Mark current item as old unless it is obsolete.
-Move to next item unless DONT-PROCEED is non-nil."
- (interactive)
- (let ((item (newsticker--treeview-get-selected-item)))
- (unless (eq (newsticker--age item) 'obsolete)
- (newsticker--treeview-mark-item item 'old)))
- (unless dont-proceed
- (newsticker-treeview-next-item)))
-
-(defun newsticker-treeview-toggle-item-immortal ()
- "Toggle immortality of current item."
- (interactive)
- (let* ((item (newsticker--treeview-get-selected-item))
- (new-age (if (eq (newsticker--age item) 'immortal)
- 'old
- 'immortal)))
- (newsticker--treeview-mark-item item new-age)
- (newsticker-treeview-next-item)))
-
-(defun newsticker--treeview-mark-item (item new-age)
- "Mark ITEM with NEW-AGE."
- (when item
- (setcar (nthcdr 4 item) new-age)
- ;; clean up ticker FIXME
- ))
-
-(defun newsticker-treeview-mark-list-items-old ()
- "Mark all listed items as old."
- (interactive)
- (let ((current-feed (or newsticker--treeview-current-feed
- newsticker--treeview-current-vfeed)))
- (save-excursion
- (set-buffer (newsticker--treeview-list-buffer))
- (goto-char (point-min))
- (while (not (eobp))
- (let ((item (get-text-property (point) :nt-item)))
- (unless (memq (newsticker--age item) '(immortal obsolete))
- (newsticker--treeview-mark-item item 'old)))
- (forward-line 1)))
- (newsticker--treeview-tree-update-tags)
- (if current-feed
- (newsticker-treeview-jump current-feed))))
-
-(defun newsticker-treeview-save-item ()
- "Save current item."
- (interactive)
- (newsticker-save-item (or newsticker--treeview-current-feed
- newsticker--treeview-current-vfeed)
- (newsticker--treeview-get-selected-item)))
-
-(defun newsticker--treeview-set-current-node (node)
- "Make NODE the current node."
- (save-excursion
- (set-buffer (newsticker--treeview-tree-buffer))
- (setq newsticker--treeview-current-node-id
- (widget-get node :nt-id))
- (setq newsticker--treeview-current-feed (widget-get node :nt-feed))
- (setq newsticker--treeview-current-vfeed (widget-get node :nt-vfeed))
- ;;(message "newsticker--treeview-set-current-node %s/%s" (widget-get node :tag)
- ;; (widget-get node :nt-id))
- ;; node)
- (newsticker--treeview-tree-update-highlight)))
-
-(defun newsticker--treeview-get-first-child (node)
- "Get first child of NODE."
- (let ((children (widget-get node :children)))
- (if children
- (car children)
- nil)))
-
-(defun newsticker--treeview-get-second-child (node)
- "Get scond child of NODE."
- (let ((children (widget-get node :children)))
- (if children
- (car (cdr children))
- nil)))
-
-(defun newsticker--treeview-get-last-child (node)
- "Get last child of NODE."
- ;;(message "newsticker--treeview-get-last-child %s" (widget-get node :tag))
- (let ((children (widget-get node :children)))
- (if children
- (car (reverse children))
- nil)))
-
-(defun newsticker--treeview-get-feed-vfeed (node)
- "Get (virtual) feed of NODE."
- (or (widget-get node :nt-feed) (widget-get node :nt-vfeed)))
-
-(defun newsticker--treeview-get-next-sibling (node)
- "Get next sibling of NODE."
- (let ((parent (widget-get node :parent)))
- (catch 'found
- (let ((children (widget-get parent :children)))
- (while children
- (if (newsticker--treeview-nodes-eq (car children) node)
- (throw 'found (car (cdr children))))
- (setq children (cdr children)))))))
-
-(defun newsticker--treeview-get-prev-sibling (node)
- "Get previous sibling of NODE."
- (let ((parent (widget-get node :parent)))
- (catch 'found
- (let ((children (widget-get parent :children))
- (prev nil))
- (while children
- (if (and (newsticker--treeview-nodes-eq (car children) node)
- (widget-get prev :nt-id))
- (throw 'found prev))
- (setq prev (car children))
- (setq children (cdr children)))))))
-
-(defun newsticker--treeview-get-next-uncle (node)
- "Get next uncle of NODE, i.e. parent's next sibling."
- (let* ((parent (widget-get node :parent))
- (grand-parent (widget-get parent :parent)))
- (catch 'found
- (let ((uncles (widget-get grand-parent :children)))
- (while uncles
- (if (newsticker--treeview-nodes-eq (car uncles) parent)
- (throw 'found (car (cdr uncles))))
- (setq uncles (cdr uncles)))))))
-
-(defun newsticker--treeview-get-prev-uncle (node)
- "Get previous uncle of NODE, i.e. parent's previous sibling."
- (let* ((parent (widget-get node :parent))
- (grand-parent (widget-get parent :parent)))
- (catch 'found
- (let ((uncles (widget-get grand-parent :children))
- (prev nil))
- (while uncles
- (if (newsticker--treeview-nodes-eq (car uncles) parent)
- (throw 'found prev))
- (setq prev (car uncles))
- (setq uncles (cdr uncles)))))))
-
-(defun newsticker--treeview-get-other-tree ()
- "Get other tree."
- (if (and (newsticker--treeview-get-current-node)
- (widget-get (newsticker--treeview-get-current-node) :nt-feed))
- newsticker--treeview-vfeed-tree
- newsticker--treeview-feed-tree))
-
-(defun newsticker--treeview-activate-node (node &optional backward)
- "Activate NODE.
-If NODE is a tree widget the node's first subnode is activated.
-If BACKWARD is non-nil the last subnode of the previous sibling
-is activated."
- (newsticker--treeview-set-current-node node)
- (save-current-buffer
- (set-buffer (newsticker--treeview-tree-buffer))
- (cond ((eq (widget-type node) 'tree-widget)
- (unless (widget-get node :open)
- (widget-put node :open nil)
- (widget-apply-action node))
- (newsticker--treeview-activate-node
- (if backward
- (newsticker--treeview-get-last-child node)
- (newsticker--treeview-get-second-child node))))
- (node
- (widget-apply-action node)))))
-
-(defun newsticker-treeview-next-feed ()
- "Move to next feed."
- (interactive)
- (newsticker--treeview-restore-buffers)
- (let ((cur (newsticker--treeview-get-current-node)))
- ;;(message "newsticker-treeview-next-feed from %s"
- ;; (widget-get cur :tag))
- (if cur
- (let ((new (or (newsticker--treeview-get-next-sibling cur)
- (newsticker--treeview-get-next-uncle cur)
- (newsticker--treeview-get-other-tree))))
- (newsticker--treeview-activate-node new))
- (newsticker--treeview-activate-node
- (car (widget-get newsticker--treeview-feed-tree :children)))))
- (newsticker--treeview-tree-update-highlight))
-
-(defun newsticker-treeview-prev-feed ()
- "Move to previous feed."
- (interactive)
- (newsticker--treeview-restore-buffers)
- (let ((cur (newsticker--treeview-get-current-node)))
- (message "newsticker-treeview-prev-feed from %s"
- (widget-get cur :tag))
- (if cur
- (let ((new (or (newsticker--treeview-get-prev-sibling cur)
- (newsticker--treeview-get-prev-uncle cur)
- (newsticker--treeview-get-other-tree))))
- (newsticker--treeview-activate-node new t))
- (newsticker--treeview-activate-node
- (car (widget-get newsticker--treeview-feed-tree :children)) t)))
- (newsticker--treeview-tree-update-highlight))
-
-(defun newsticker-treeview-next-page ()
- "Scroll item buffer."
- (interactive)
- (save-selected-window
- (select-window (newsticker--treeview-item-window) t)
- (condition-case nil
- (scroll-up nil)
- (error
- (goto-char (point-min))))))
-
-
-(defun newsticker--treeview-unfold-node (feed-name)
- "Recursively show subtree above the node that represents FEED-NAME."
- (let ((node (newsticker--treeview-get-node-of-feed feed-name)))
- (unless node
- (let* ((group-name (or (car (newsticker--group-find-group-for-feed
- feed-name))
- (newsticker--group-get-parent-group
- feed-name))))
- (newsticker--treeview-unfold-node group-name))
- (setq node (newsticker--treeview-get-node-of-feed feed-name)))
- (when node
- (save-excursion
- (set-buffer (newsticker--treeview-tree-buffer))
- (widget-put node :nt-selected t)
- (widget-apply-action node)
- (newsticker--treeview-set-current-node node)))))
-
-(defun newsticker-treeview-jump (feed-name)
- "Jump to feed FEED-NAME in newsticker treeview."
- (interactive
- (list (let ((completion-ignore-case t))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-item-window) nil))
- (completing-read
- "Jump to feed: "
- (mapcar 'car (append newsticker-url-list
- newsticker-url-list-defaults))
- nil t))))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-item-window) t))
- (newsticker--treeview-unfold-node feed-name))
-
-;; ======================================================================
-;;; Groups
-;; ======================================================================
-(defun newsticker--group-do-find-group-for-feed (feed-name node)
- "Recursively find FEED-NAME in NODE."
- (if (member feed-name (cdr node))
- (throw 'found node)
- (mapc (lambda (n)
- (if (listp n)
- (newsticker--group-do-find-group-for-feed feed-name n)))
- (cdr node))))
-
-(defun newsticker--group-find-group-for-feed (feed-name)
- "Find group containing FEED-NAME."
- (catch 'found
- (newsticker--group-do-find-group-for-feed feed-name
- newsticker-groups)
- nil))
-
-(defun newsticker--group-do-get-group (name node)
- "Recursively find group with NAME below NODE."
- (if (string= name (car node))
- (throw 'found node)
- (mapc (lambda (n)
- (if (listp n)
- (newsticker--group-do-get-group name n)))
- (cdr node))))
-
-(defun newsticker--group-get-group (name)
- "Find group with NAME."
- (catch 'found
- (mapc (lambda (n)
- (if (listp n)
- (newsticker--group-do-get-group name n)))
- newsticker-groups)
- nil))
-
-(defun newsticker--group-do-get-parent-group (name node parent)
- "Recursively find parent group for NAME from NODE which is a child of PARENT."
- (if (string= name (car node))
- (throw 'found parent)
- (mapc (lambda (n)
- (if (listp n)
- (newsticker--group-do-get-parent-group name n (car node))))
- (cdr node))))
-
-(defun newsticker--group-get-parent-group (name)
- "Find parent group for group named NAME."
- (catch 'found
- (mapc (lambda (n)
- (if (listp n)
- (newsticker--group-do-get-parent-group
- name n (car newsticker-groups))))
- newsticker-groups)
- nil))
-
-
-(defun newsticker--group-get-subgroups (group &optional recursive)
- "Return list of subgroups for GROUP.
-If RECURSIVE is non-nil recursively get subgroups and return a nested list."
- (let ((result nil))
- (mapc (lambda (n)
- (when (listp n)
- (setq result (cons (car n) result))
- (let ((subgroups (newsticker--group-get-subgroups n recursive)))
- (when subgroups
- (setq result (append subgroups result))))))
- group)
- result))
-
-(defun newsticker--group-all-groups ()
- "Return nested list of all groups."
- (newsticker--group-get-subgroups newsticker-groups t))
-
-(defun newsticker--group-get-feeds (group &optional recursive)
- "Return list of all feeds in GROUP.
-If RECURSIVE is non-nil recursively get feeds of subgroups and
-return a nested list."
- (let ((result nil))
- (mapc (lambda (n)
- (if (not (listp n))
- (setq result (cons n result))
- (if recursive
- (let ((subfeeds (newsticker--group-get-feeds n t)))
- (when subfeeds
- (setq result (append subfeeds result)))))))
- group)
- result))
-
-(defun newsticker-group-add-group (name parent)
- "Add group NAME to group PARENT."
- (interactive
- (list (read-string "Group Name: ")
- (let ((completion-ignore-case t))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-item-window) nil))
- (completing-read "Parent Group: " (newsticker--group-all-groups)
- nil t))))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-item-window) t))
- (if (newsticker--group-get-group name)
- (error "Group %s exists already" name))
- (let ((p (if (and parent (not (string= parent "")))
- (newsticker--group-get-group parent)
- newsticker-groups)))
- (unless p
- (error "Parent %s does not exist" parent))
- (setcdr p (cons (list name) (cdr p))))
- (newsticker--treeview-tree-update))
-
-(defun newsticker-group-move-feed (name group-name &optional no-update)
- "Move feed NAME to group GROUP-NAME.
-Update teeview afterwards unless NO-UPDATE is non-nil."
- (interactive
- (let ((completion-ignore-case t))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-item-window) nil))
- (list (completing-read "Feed Name: "
- (mapcar 'car newsticker-url-list)
- nil t newsticker--treeview-current-feed)
- (completing-read "Group Name: " (newsticker--group-all-groups)
- nil t))))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-item-window) t))
- (let ((group (if (and group-name (not (string= group-name "")))
- (newsticker--group-get-group group-name)
- newsticker-groups)))
- (unless group
- (error "Group %s does not exist" group-name))
- (while (let ((old-group
- (newsticker--group-find-group-for-feed name)))
- (when old-group
- (delete name old-group))
- old-group))
- (setcdr group (cons name (cdr group)))
- (unless no-update
- (newsticker--treeview-tree-update)
- (newsticker-treeview-update))))
-
-(defun newsticker-group-delete-group (name)
- "Remove group NAME."
- (interactive
- (let ((completion-ignore-case t))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-item-window) nil))
- (list (completing-read "Group Name: " (newsticker--group-all-groups)
- nil t))))
- (if newsticker-treeview-own-frame
- (set-window-dedicated-p (newsticker--treeview-item-window) t))
- (let* ((g (newsticker--group-get-group name))
- (p (or (newsticker--group-get-parent-group name)
- newsticker-groups)))
- (unless g
- (error "Group %s does not exist" name))
- (delete g p))
- (newsticker--treeview-tree-update))
-
-(defun newsticker--count-groups (group)
- "Recursively count number of subgroups of GROUP."
- (let ((result 1))
- (mapc (lambda (g)
- (if (listp g)
- (setq result (+ result (newsticker--count-groups g)))))
- (cdr group))
- result))
-
-(defun newsticker--count-grouped-feeds (group)
- "Recursively count number of feeds in GROUP and its subgroups."
- (let ((result 0))
- (mapc (lambda (g)
- (if (listp g)
- (setq result (+ result (newsticker--count-grouped-feeds g)))
- (setq result (1+ result))))
- (cdr group))
- result))
-
-(defun newsticker--group-remove-obsolete-feeds (group)
- "Recursively remove obselete feeds from GROUP."
- (let ((result nil)
- (urls (append newsticker-url-list newsticker-url-list-defaults)))
- (mapc (lambda (g)
- (if (listp g)
- (let ((sub-groups
- (newsticker--group-remove-obsolete-feeds g)))
- (if sub-groups
- (setq result (cons sub-groups result))))
- (if (assoc g urls)
- (setq result (cons g result)))))
- (cdr group))
- (if result
- (cons (car group) (reverse result))
- result)))
-
-(defun newsticker--group-manage-orphan-feeds ()
- "Put unmanaged feeds into `newsticker-groups'.
-Remove obsolete feeds as well."
- (let ((new-feed nil)
- (grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
- (mapc (lambda (f)
- (unless (newsticker--group-find-group-for-feed (car f))
- (setq new-feed t)
- (newsticker-group-move-feed (car f) nil t)))
- (append newsticker-url-list-defaults newsticker-url-list))
- (setq newsticker-groups
- (newsticker--group-remove-obsolete-feeds newsticker-groups))
- (if (or new-feed
- (not (= grouped-feeds
- (newsticker--count-grouped-feeds newsticker-groups))))
- (newsticker--treeview-tree-update))))
-
-;; ======================================================================
-;;; Modes
-;; ======================================================================
-(defun newsticker--treeview-create-groups-menu (group-list
- excluded-group)
- "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
- (let ((menu (make-sparse-keymap (if (stringp (car group-list))
- (car group-list)
- "Move to group..."))))
- (mapc (lambda (g)
- (when (listp g)
- (let ((title (if (stringp (car g))
- (car g)
- "Move to group...")))
- (unless (eq g excluded-group)
- (define-key menu (vector (intern title))
- (list 'menu-item title
- (newsticker--treeview-create-groups-menu
- (cdr g) excluded-group)))))))
- (reverse group-list))
- menu))
-
-(defun newsticker--treeview-create-tree-menu (feed-name)
- "Create tree menu for FEED-NAME."
- (let ((menu (make-sparse-keymap feed-name)))
- (define-key menu [newsticker-treeview-mark-list-items-old]
- (list 'menu-item "Mark all items old"
- 'newsticker-treeview-mark-list-items-old))
- (define-key menu [move]
- (list 'menu-item "Move to group..."
- (newsticker--treeview-create-groups-menu
- newsticker-groups
- (newsticker--group-get-group feed-name))))
- menu))
-
-;;(makunbound 'newsticker-treeview-list-menu) ;FIXME
-(defvar newsticker-treeview-list-menu
- (let ((menu (make-sparse-keymap "Newsticker List")))
- (define-key menu [newsticker-treeview-mark-list-items-old]
- (list 'menu-item "Mark all items old"
- 'newsticker-treeview-mark-list-items-old))
- menu)
- "Map for newsticker tree menu.")
-
-;;(makunbound 'newsticker-treeview-mode-map) ;FIXME
-(defvar newsticker-treeview-mode-map
- (let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
- (define-key map " " 'newsticker-treeview-next-page)
- (define-key map "a" 'newsticker-add-url)
- (define-key map "F" 'newsticker-treeview-prev-feed)
- (define-key map "f" 'newsticker-treeview-next-feed)
- (define-key map "g" 'newsticker-treeview-get-news)
- (define-key map "G" 'newsticker-get-all-news)
- (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
- (define-key map "j" 'newsticker-treeview-jump)
- (define-key map "n" 'newsticker-treeview-next-item)
- (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
- (define-key map "O" 'newsticker-treeview-mark-list-items-old)
- (define-key map "o" 'newsticker-treeview-mark-item-old)
- (define-key map "p" 'newsticker-treeview-prev-item)
- (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
- (define-key map "q" 'newsticker-treeview-quit)
- (define-key map "S" 'newsticker-treeview-save-item)
- (define-key map "s" 'newsticker-treeview-save)
- (define-key map "u" 'newsticker-treeview-update)
- (define-key map "v" 'newsticker-treeview-browse-url)
- ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
- ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
- (define-key map "\M-m" 'newsticker-group-move-feed)
- (define-key map "\M-a" 'newsticker-group-add-group)
- map)
- "Mode map for newsticker treeview.")
-
-(defun newsticker-treeview-mode ()
- "Major mode for Newsticker Treeview.
-\\{newsticker-treeview-mode-map}"
- (kill-all-local-variables)
- (use-local-map newsticker-treeview-mode-map)
- (setq major-mode 'newsticker-treeview-mode)
- (setq mode-name "Newsticker TV")
- (if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map)
- newsticker-treeview-tool-bar-map))
- (setq buffer-read-only t
- truncate-lines t))
-
-;;(makunbound 'newsticker-treeview-list-mode-map);FIXME
-(define-derived-mode newsticker-treeview-list-mode newsticker-treeview-mode
- "Item List"
- (let ((header (concat
- (propertize " " 'display '(space :align-to 0))
- (newsticker-treeview-list-make-sort-button "*" 'sort-by-age)
- (propertize " " 'display '(space :align-to 2))
- (if newsticker--treeview-list-show-feed
- (concat "Feed"
- (propertize " " 'display '(space :align-to 12)))
- "")
- (newsticker-treeview-list-make-sort-button "Date"
- 'sort-by-time)
- (if newsticker--treeview-list-show-feed
- (propertize " " 'display '(space :align-to 28))
- (propertize " " 'display '(space :align-to 18)))
- (newsticker-treeview-list-make-sort-button "Title"
- 'sort-by-title))))
- (setq header-line-format header))
- (define-key newsticker-treeview-list-mode-map [down-mouse-3]
- newsticker-treeview-list-menu))
-
-(defun newsticker-treeview-tree-click (event)
- "Handle click EVENT on a tag in the newsticker tree."
- (interactive "e")
- (save-excursion
- (switch-to-buffer (window-buffer (posn-window (event-end event))))
- (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
-
-(defun newsticker-treeview-tree-do-click (&optional pos event)
- "Actually handle click event.
-POS gives the position where EVENT occurred."
- (interactive)
- (unless pos (setq pos (point)))
- (let ((pos (or pos (point)))
- (nt-id (get-text-property pos :nt-id))
- (item (get-text-property pos :nt-item)))
- (cond (item
- ;; click in list buffer
- (newsticker-treeview-show-item))
- (t
- ;; click in tree buffer
- (let ((w (newsticker--treeview-get-node nt-id)))
- (when w
- (newsticker--treeview-tree-update-tag w t t)
- (setq w (newsticker--treeview-get-node nt-id))
- (widget-put w :nt-selected t)
- (widget-apply w :action event)
- (newsticker--treeview-set-current-node w))))))
- (newsticker--treeview-tree-update-highlight))
-
-(defun newsticker--treeview-restore-buffers ()
- "Restore treeview buffers."
- (catch 'error
- (dotimes (i 3)
- (let ((win (nth i newsticker--treeview-windows))
- (buf (nth i newsticker--treeview-buffers)))
- (unless (window-live-p win)
- (newsticker--treeview-window-init)
- (newsticker--treeview-buffer-init)
- (throw 'error t))
- (unless (eq (window-buffer win) buf)
- (set-window-buffer win buf t))))))
-
-(defun newsticker--treeview-frame-init ()
- "Initialize treeview frame."
- (when newsticker-treeview-own-frame
- (unless (and newsticker--frame (frame-live-p newsticker--frame))
- (setq newsticker--frame (make-frame '((name . "Newsticker")))))
- (select-frame-set-input-focus newsticker--frame)
- (raise-frame newsticker--frame)))
-
-(defun newsticker--treeview-window-init ()
- "Initialize treeview windows."
- (setq newsticker--saved-window-config (current-window-configuration))
- (setq newsticker--treeview-windows nil)
- (setq newsticker--treeview-buffers nil)
- (delete-other-windows)
- (split-window-horizontally 25)
- (add-to-list 'newsticker--treeview-windows (selected-window) t)
- (other-window 1)
- (split-window-vertically 10)
- (add-to-list 'newsticker--treeview-windows (selected-window) t)
- (other-window 1)
- (add-to-list 'newsticker--treeview-windows (selected-window) t)
- (other-window 1))
-
-;;;###autoload
-(defun newsticker-treeview ()
- "Start newsticker treeview."
- (interactive)
- (newsticker--treeview-load)
- (setq newsticker--sentinel-callback 'newsticker-treeview-update)
- (newsticker--treeview-frame-init)
- (newsticker--treeview-window-init)
- (newsticker--treeview-buffer-init)
- (newsticker--group-manage-orphan-feeds)
- (if newsticker--window-config
- (set-window-configuration newsticker--window-config))
- (newsticker--treeview-set-current-node newsticker--treeview-feed-tree)
- (newsticker-start t) ;; will start only if not running
- (newsticker-treeview-update)
- (newsticker--treeview-item-show-text
- "Newsticker"
- "Welcome to newsticker!"))
-
-(defun newsticker-treeview-get-news ()
- "Get news for current feed."
- (interactive)
- (when newsticker--treeview-current-feed
- (newsticker-get-news newsticker--treeview-current-feed)))
-
-(provide 'newsticker-treeview)
-
-;; arch-tag: 5dbaff48-1f3e-4fc6-8ebd-e966fc90d2d4
-;;; newsticker-treeview.el ends here
;; URL: http://www.nongnu.org/newsticker
;; Created: 17. June 2003
;; Keywords: News, RSS, Atom
-;; Time-stamp: "7. Juni 2008, 14:04:59 (ulf)"
+;; Time-stamp: "13. Juni 2008, 17:46:44 (ulf)"
;; ======================================================================
;; ======================================================================
;;; Code:
-(require 'newsticker-backend)
-(require 'newsticker-ticker)
-(require 'newsticker-reader)
-(require 'newsticker-plainview)
-(require 'newsticker-treeview)
+(require 'newsticker-backend "newst-backend.el")
+(require 'newsticker-ticker "newst-ticker.el")
+(require 'newsticker-reader "newst-reader.el")
+(require 'newsticker-plainview "newst-plainview.el")
+(require 'newsticker-treeview "newst-treeview.el")
(provide 'newsticker)
projects / emacs.git / commitdiff