Mercurial > emacs
changeset 95903:6796a536c7f9
Renamed newsticker-*.el to newst-*.el.
| author | Ulf Jasper <ulf.jasper@web.de> |
|---|---|
| date | Fri, 13 Jun 2008 17:08:25 +0000 |
| parents | 88b5804d67f4 |
| children | 594d82b81559 |
| files | lisp/net/newsticker-backend.el lisp/net/newsticker-plainview.el lisp/net/newsticker-reader.el lisp/net/newsticker-ticker.el lisp/net/newsticker-treeview.el |
| diffstat | 5 files changed, 0 insertions(+), 7554 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/net/newsticker-backend.el Fri Jun 13 17:06:47 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2313 +0,0 @@ -;;; 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
--- a/lisp/net/newsticker-plainview.el Fri Jun 13 17:06:47 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1830 +0,0 @@ -;;; 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
--- a/lisp/net/newsticker-reader.el Fri Jun 13 17:06:47 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1130 +0,0 @@ -;;; 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
--- a/lisp/net/newsticker-ticker.el Fri Jun 13 17:06:47 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,293 +0,0 @@ -;; 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
--- a/lisp/net/newsticker-treeview.el Fri Jun 13 17:06:47 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1988 +0,0 @@ -;;; 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