1 |
;;; newsticker.el --- A news-ticker for Emacs. |
;;; newsticker.el --- A Newsticker for Emacs. |
2 |
|
|
3 |
;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc. |
;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc. |
4 |
|
|
8 |
;; Filename: newsticker.el |
;; Filename: newsticker.el |
9 |
;; URL: http://www.nongnu.org/newsticker |
;; URL: http://www.nongnu.org/newsticker |
10 |
;; Created: 17. June 2003 |
;; Created: 17. June 2003 |
11 |
;; Keywords: News, RSS |
;; Keywords: News, RSS, Atom |
12 |
|
;; Time-stamp: "1. November 2005, 21:16:53 (ulf)" |
13 |
|
|
14 |
|
;; ====================================================================== |
15 |
|
|
16 |
;; This program is free software; you can redistribute it and/or modify |
;; This program is free software; you can redistribute it and/or modify |
17 |
;; it under the terms of the GNU General Public License as published by |
;; it under the terms of the GNU General Public License as published by |
27 |
;; along with this program; if not, write to the Free Software Foundation, |
;; along with this program; if not, write to the Free Software Foundation, |
28 |
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. |
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. |
29 |
|
|
30 |
(defconst newsticker-version "1.8" "Version number of newsticker.el.") |
(defconst newsticker-version "1.9" "Version number of newsticker.el.") |
31 |
|
|
32 |
;; ====================================================================== |
;; ====================================================================== |
|
|
|
33 |
;;; Commentary: |
;;; Commentary: |
34 |
|
|
35 |
;; Overview |
;; Overview |
36 |
;; -------- |
;; -------- |
37 |
|
|
38 |
;; Newsticker provides a newsticker for Emacs. A newsticker is a thing that |
;; Newsticker provides a newsticker for Emacs. A newsticker is a thing |
39 |
;; asynchronously retrieves headlines from a list of news sites, prepares |
;; that asynchronously retrieves headlines from a list of news sites, |
40 |
;; these headlines for reading, and allows for loading the corresponding |
;; prepares these headlines for reading, and allows for loading the |
41 |
;; articles in a web browser. |
;; corresponding articles in a web browser. |
42 |
|
|
43 |
;; Headlines consist of a title and (possibly) a small description. They |
;; Headlines consist of a title and (possibly) a small description. They |
44 |
;; are contained in RSS (RDF Site Summary) files. Newsticker should work |
;; are contained in "RSS" (RDF Site Summary) or "Atom" files. Newsticker |
45 |
;; with all RSS files that follow the RDF Rich Site Summary 1.0 |
;; should work with the following RSS formats: |
46 |
;; specification. It should also work with version 2.0 as well as |
;; * RSS 0.91 |
47 |
;; other/older/alternative RSS formats (like 0.9<something> or such). In |
;; (see http://backend.userland.com/rss091 or |
48 |
;; other words: Newsticker is a "RSS reader" or "RSS aggregator". |
;; http://my.netscape.com/publish/formats/rss-spec-0.91.html) |
49 |
|
;; * RSS 0.92 |
50 |
|
;; (see http://backend.userland.com/rss092) |
51 |
|
;; * RSS 1.0 |
52 |
|
;; (see http://purl.org/rss/1.0/spec) |
53 |
|
;; * RSS 2.0 |
54 |
|
;; (see http://blogs.law.harvard.edu/tech/rss) |
55 |
|
;; as well as the following Atom formats: |
56 |
|
;; * Atom 0.3 |
57 |
|
;; * Atom 1.0 |
58 |
|
;; (see http://www.ietf.org/internet-drafts/draft-ietf-atompub-format-11.txt) |
59 |
|
;; That makes Newsticker.el an "Atom aggregator, "RSS reader", "RSS |
60 |
|
;; aggregator", and "Feed Reader". |
61 |
|
|
62 |
;; Newsticker provides several commands for reading headlines, navigating |
;; Newsticker provides several commands for reading headlines, navigating |
63 |
;; through them, marking them as read/unread, hiding old headlines |
;; through them, marking them as read/unread, hiding old headlines |
64 |
;; etc. Headlines can be displayed as plain text or as rendered HTML. |
;; etc. Headlines can be displayed as plain text or as rendered HTML. |
65 |
|
|
66 |
;; Headlines can be displayed in the echo area, either scrolling like |
;; Headlines can be displayed in the echo area, either scrolling like |
67 |
;; messages in a stock-quote ticker, or just changing. |
;; messages in a stock-quote ticker, or just changing. |
70 |
;; hooks and (sample) functions for automatically downloading images and |
;; hooks and (sample) functions for automatically downloading images and |
71 |
;; enclosed files (as delivered by podcasts, e.g.). |
;; enclosed files (as delivered by podcasts, e.g.). |
72 |
|
|
|
|
|
|
|
|
73 |
;; Requirements |
;; Requirements |
74 |
;; ------------ |
;; ------------ |
75 |
;; Newsticker can be used with Emacs version 21.1 or later as well as |
;; Newsticker can be used with GNU Emacs version 21.1 or later as well as |
76 |
;; XEmacs. It requires an XML-parser (`xml.el') which is part of |
;; XEmacs. It requires an XML-parser (`xml.el') which is part of GNU |
77 |
;; Emacs. If you are using XEmacs you want to get the `net-utils' package |
;; Emacs. If you are using XEmacs you want to get the `net-utils' package |
78 |
;; which contains `xml.el' for XEmacs. |
;; which contains `xml.el' for XEmacs. |
79 |
|
|
80 |
;; Newsticker requires a program which can retrieve files via http and |
;; Newsticker requires a program which can retrieve files via http and |
81 |
;; prints them to stdout. By default Newsticker will use wget for this |
;; prints them to stdout. By default Newsticker will use wget for this |
82 |
;; task. |
;; task. |
83 |
|
|
84 |
|
;; Installation |
85 |
|
;; ------------ |
86 |
|
|
87 |
|
;; If you are using Newsticker as part of GNU Emacs there is no need to |
88 |
|
;; perform any installation steps in order to use Newsticker. Otherwise |
89 |
|
;; place Newsticker in a directory where Emacs can find it. Add the |
90 |
|
;; following line to your Emacs startup file (`~/.emacs'). |
91 |
|
;; (add-to-list 'load-path "/path/to/newsticker/") |
92 |
|
;; (autoload 'newsticker-start "newsticker" "Emacs Newsticker" t) |
93 |
|
;; (autoload 'newsticker-show-news "newsticker" "Emacs Newsticker" t) |
94 |
|
|
95 |
|
;; If you are using `imenu', which allows for navigating with the help of a |
96 |
|
;; menu, you should add the following to your Emacs startup file |
97 |
|
;; (`~/.emacs'). |
98 |
|
;; (add-hook 'newsticker-mode-hook 'imenu-add-menubar-index) |
99 |
|
|
100 |
|
;; That's it. |
101 |
|
|
102 |
;; Usage |
;; Usage |
103 |
;; ----- |
;; ----- |
104 |
;; The command newsticker-show-news will display all available headlines in |
;; The command newsticker-show-news will display all available headlines in |
105 |
;; a special buffer, called `*newsticker*'. It will also start the |
;; a special buffer, called `*newsticker*'. It will also start the |
106 |
;; asynchronous download of headlines. The modeline in the `*newsticker*' |
;; asynchronous download of headlines. The modeline in the `*newsticker*' |
107 |
;; buffer informs whenever new headlines have arrived. Clicking |
;; buffer informs whenever new headlines have arrived. Clicking |
108 |
;; mouse-button 2 or pressing RET in this buffer on a headline will call |
;; mouse-button 2 or pressing RET in this buffer on a headline will call |
109 |
;; browse-url to load the corresponding news story in your favourite web |
;; browse-url to load the corresponding news story in your favourite web |
110 |
;; browser. |
;; browser. |
111 |
|
|
112 |
;; The scrolling, or flashing of headlines in the echo area, can be started |
;; The scrolling, or flashing of headlines in the echo area, can be started |
113 |
;; with the command newsticker-start-ticker. It can be stopped with |
;; with the command newsticker-start-ticker. It can be stopped with |
114 |
;; newsticker-stop-ticker. |
;; newsticker-stop-ticker. |
115 |
|
|
116 |
;; If you just want to start the periodic download of headlines use the |
;; If you just want to start the periodic download of headlines use the |
117 |
;; command newsticker-start. Calling newsticker-stop will stop the periodic |
;; command newsticker-start. Calling newsticker-stop will stop the |
118 |
;; download, but will call newsticker-stop-ticker as well. |
;; periodic download, but will call newsticker-stop-ticker as well. |
119 |
|
|
120 |
;; Configuration |
;; Configuration |
121 |
;; ------------- |
;; ------------- |
140 |
;; o newsticker-keep-obsolete-items decides whether unread headlines that |
;; o newsticker-keep-obsolete-items decides whether unread headlines that |
141 |
;; have been removed from the feed are kept in the Newsticker cache. |
;; have been removed from the feed are kept in the Newsticker cache. |
142 |
;; * newsticker-layout contains options that define how the buffer for |
;; * newsticker-layout contains options that define how the buffer for |
143 |
;; reading RSS headlines is formatted. |
;; reading news headlines is formatted. |
144 |
;; o newsticker-item-format defines how the title of a headline is |
;; o newsticker-item-format defines how the title of a headline is |
145 |
;; formatted. |
;; formatted. |
146 |
;; * newsticker-ticker contains options that define how headlines are shown |
;; * newsticker-ticker contains options that define how headlines are shown |
150 |
;; * newsticker-hooks contains options for hooking other Emacs commands to |
;; * newsticker-hooks contains options for hooking other Emacs commands to |
151 |
;; newsticker functions. |
;; newsticker functions. |
152 |
;; o newsticker-new-item-functions allows for automatic processing of |
;; o newsticker-new-item-functions allows for automatic processing of |
153 |
;; headlines. See `newsticker-download-images', and |
;; headlines. See `newsticker-download-images', and |
154 |
;; `newsticker-download-enclosures' for sample functions. |
;; `newsticker-download-enclosures' for sample functions. |
155 |
;; * newsticker-miscellaneous contains other Newsticker options. |
;; * newsticker-miscellaneous contains other Newsticker options. |
156 |
|
|
164 |
;; such a tool from slightly attenuating your Editor's responsiveness every |
;; such a tool from slightly attenuating your Editor's responsiveness every |
165 |
;; once in a while. |
;; once in a while. |
166 |
|
|
167 |
;; Newsticker-mode supports imenu. It allows for navigating with the help |
;; Byte-compiling newsticker.el is recommended. |
|
;; of a menu. In order to use this feature you should also add the |
|
|
;; following. |
|
|
;; (add-hook 'newsticker-mode-hook 'imenu-add-menubar-index) |
|
168 |
|
|
169 |
;; ====================================================================== |
;; ====================================================================== |
170 |
;;; History: |
;;; History: |
171 |
|
|
172 |
|
;; 1.9 (2005-11-01) |
173 |
|
;; * Rewrote feed parsing part. Newsticker now supports RSS 0.91, |
174 |
|
;; 0.92, 1.0, 2.0 as well as Atom 0.3 and 1.0 -- thanks to Thien-Thi |
175 |
|
;; Nguyen. |
176 |
|
;; * Changed auto-marking mechanism: Replaced variable |
177 |
|
;; `newsticker-auto-mark-filter' with new variable |
178 |
|
;; `newsticker-auto-mark-filter-list', which allows for looking not |
179 |
|
;; only at the title but also at the description of a headline. |
180 |
|
;; * Call `newsticker--ticker-text-setup' only after all pending |
181 |
|
;; downloads processes have finished. |
182 |
|
;; * Improved handling of coding systems. |
183 |
|
;; * Added magic autoload comments. |
184 |
|
;; * Bugfixes: |
185 |
|
;; - `hide-entry' was hiding too much when called for the last |
186 |
|
;; headline, |
187 |
|
;; - update mode-line and menu-bar when necessary, |
188 |
|
;; - repaired `newsticker--imenu-goto', |
189 |
|
;; - other minor things. |
190 |
|
|
191 |
;; 1.8 (2005-08-26) |
;; 1.8 (2005-08-26) |
192 |
;; * Added commands `newsticker-show-extra' and `newsticker-hide-extra' |
;; * Added commands `newsticker-show-extra' and `newsticker-hide-extra' |
193 |
;; to show and hide extra RSS elements, bound to "sx" and "hx" |
;; to show and hide extra RSS elements, bound to "sx" and "hx" |
202 |
;; * Tool-bar support: most important commands can be called from |
;; * Tool-bar support: most important commands can be called from |
203 |
;; tool-bar buttons. |
;; tool-bar buttons. |
204 |
;; * Auto-Narrowing introduced: *newsticker* buffer can be narrowed to |
;; * Auto-Narrowing introduced: *newsticker* buffer can be narrowed to |
205 |
;; a single item (bound to key `xi') or a single feed (bound to `xf'). |
;; a single item (bound to key `xi') or a single feed (bound to |
206 |
|
;; `xf'). |
207 |
;; * Enclosure support: enclosed items are shown (see |
;; * Enclosure support: enclosed items are shown (see |
208 |
;; `newsticker-enclosure-face') and can be (automatically) downloaded |
;; `newsticker-enclosure-face') and can be (automatically) downloaded |
209 |
;; (see below). For those of you who read "podcasts". |
;; (see below). For those of you who read "podcasts". |
226 |
;; * Better support for w3, added command |
;; * Better support for w3, added command |
227 |
;; `newsticker-w3m-show-inline-images' for displaying all inline |
;; `newsticker-w3m-show-inline-images' for displaying all inline |
228 |
;; images. |
;; images. |
229 |
;; * Insert an artificial headline which notifies about failed retrievals. |
;; * Insert an artificial headline which notifies about failed |
230 |
|
;; retrievals. |
231 |
;; * Use pubDate element (RSS 2.0) instead of retrieval time when |
;; * Use pubDate element (RSS 2.0) instead of retrieval time when |
232 |
;; available. |
;; available. |
233 |
;; * Customizable options grouped. |
;; * Customizable options grouped. |
234 |
;; * Bugfixes: `newsticker--imenu-create-index'; strip whitespace |
;; * Bugfixes: `newsticker--imenu-create-index'; strip whitespace |
235 |
;; from links; apply coding-system to extra-elements; time-comparison |
;; from links; apply coding-system to extra-elements; time-comparison |
236 |
;; for obsolete items; and others which I have forgotten. |
;; for obsolete items; and others which I have forgotten. |
237 |
;; * Workaround for another bug in xml-parse-region -- thanks to anonymous |
;; * Workaround for another bug in xml-parse-region -- thanks to |
238 |
;; for sending patch. |
;; anonymous for sending patch. |
239 |
;; * Renamed invisible buffers ` *wget-newsticker-<feed>*' to |
;; * Renamed invisible buffers ` *wget-newsticker-<feed>*' to |
240 |
;; ` *newsticker-wget-<feed>*'. |
;; ` *newsticker-wget-<feed>*'. |
241 |
;; * Tested with Emacs versions 21.3 and 22.0 and XEmacs 21.something. |
;; * Tested with GNU Emacs versions 21.3 and 22.0 and XEmacs |
242 |
|
;; 21.something. |
243 |
|
|
244 |
;; 1.6 * Support for (some) optional RSS elements: guid, dc:date. See |
;; 1.6 * Support for (some) optional RSS elements: guid, dc:date. See |
245 |
;; `newsticker-show-all-rss-elements' `newsticker-extra-face'. |
;; `newsticker-show-all-rss-elements' `newsticker-extra-face'. |
246 |
;; * Better support for w3m -- `newsticker-default-face' is obsolete |
;; * Better support for w3m -- `newsticker-default-face' is obsolete |
247 |
;; now, removed `newsticker-w3m-toggle-inline-image'. |
;; now, removed `newsticker-w3m-toggle-inline-image'. |
248 |
;; * Added `newsticker-desc-comp-max' -- comparison of item descriptions |
;; * Added `newsticker-desc-comp-max' -- comparison of item |
249 |
;; can take quite some time. |
;; descriptions can take quite some time. |
250 |
;; * Added `newsticker--buffer-make-item-completely-visible' to |
;; * Added `newsticker--buffer-make-item-completely-visible' to |
251 |
;; ensure that the current item is fully visible. |
;; ensure that the current item is fully visible. |
252 |
;; * Allow for non-positive retrieval-interval, which make newsticker |
;; * Allow for non-positive retrieval-interval, which make newsticker |
395 |
;;; Customizables |
;;; Customizables |
396 |
;; ====================================================================== |
;; ====================================================================== |
397 |
(defgroup newsticker nil |
(defgroup newsticker nil |
398 |
"RSS aggregator." |
"Aggregator for RSS and Atom feeds." |
399 |
:group 'applications) |
:group 'applications) |
400 |
|
|
401 |
(defconst newsticker--raw-url-list-defaults |
(defconst newsticker--raw-url-list-defaults |
525 |
|
|
526 |
;; customization group feed |
;; customization group feed |
527 |
(defgroup newsticker-feed nil |
(defgroup newsticker-feed nil |
528 |
"Settings for the RSS feeds." |
"Settings for news feeds." |
529 |
:group 'newsticker) |
:group 'newsticker) |
530 |
|
|
531 |
(defcustom newsticker-url-list-defaults |
(defcustom newsticker-url-list-defaults |
555 |
The LABEL gives the name of the news feed. It can be an arbitrary string. |
The LABEL gives the name of the news feed. It can be an arbitrary string. |
556 |
|
|
557 |
The URL gives the location of the news feed. It must point to a valid |
The URL gives the location of the news feed. It must point to a valid |
558 |
RSS file. The RSS file is retrieved by calling wget, or whatever you |
RSS or Atom file. The file is retrieved by calling wget, or whatever you |
559 |
specify as `newsticker-wget-name'. |
specify as `newsticker-wget-name'. |
560 |
|
|
561 |
The START-TIME can be either a string, or nil. If it is a string it |
The START-TIME can be either a string, or nil. If it is a string it |
584 |
(const :tag "Default" nil) |
(const :tag "Default" nil) |
585 |
(const :tag "Hourly" 3600) |
(const :tag "Hourly" 3600) |
586 |
(const :tag "Daily" 86400) |
(const :tag "Daily" 86400) |
587 |
|
(const :tag "Weekly" 604800) |
588 |
(integer :tag "Interval")) |
(integer :tag "Interval")) |
589 |
(choice :tag "Wget Arguments" |
(choice :tag "Wget Arguments" |
590 |
(const :tag "Default arguments" nil) |
(const :tag "Default arguments" nil) |
619 |
(const :tag "No automatic retrieval" 0) |
(const :tag "No automatic retrieval" 0) |
620 |
(const :tag "Hourly" 3600) |
(const :tag "Hourly" 3600) |
621 |
(const :tag "Daily" 86400) |
(const :tag "Daily" 86400) |
622 |
|
(const :tag "Weekly" 604800) |
623 |
(integer :tag "Interval")) |
(integer :tag "Interval")) |
624 |
:set 'newsticker--set-customvar |
:set 'newsticker--set-customvar |
625 |
:group 'newsticker-feed) |
:group 'newsticker-feed) |
635 |
|
|
636 |
;; customization group behaviour |
;; customization group behaviour |
637 |
(defgroup newsticker-headline-processing nil |
(defgroup newsticker-headline-processing nil |
638 |
"Settings for the automatic processing of RSS headlines." |
"Settings for the automatic processing of headlines." |
639 |
:group 'newsticker) |
:group 'newsticker) |
640 |
|
|
641 |
(defcustom newsticker-automatically-mark-items-as-old |
(defcustom newsticker-automatically-mark-items-as-old |
674 |
:type 'integer |
:type 'integer |
675 |
:group 'newsticker-headline-processing) |
:group 'newsticker-headline-processing) |
676 |
|
|
677 |
(defcustom newsticker-auto-mark-filter |
(defcustom newsticker-auto-mark-filter-list |
678 |
nil |
nil |
679 |
"A filter for automatically marking headlines. |
"A list of filters for automatically marking headlines. |
680 |
|
|
681 |
This is an alist of the form (FEED-NAME OLD-LIST IMMORTAL-LIST). I.e. each |
This is an alist of the form (FEED-NAME PATTERN-LIST). I.e. each |
682 |
element consists of a FEED-NAME and two lists. Each list consists a set of |
element consists of a FEED-NAME a PATTERN-LIST. Each element of |
683 |
regular expressions. The first list contains patterns of headlines which |
the pattern-list has the form (AGE TITLE-OR-DESCRIPTION REGEXP). |
684 |
will be marked as old. The second list contains patterns of headlines which |
AGE must be one of the symbols 'old or 'immortal. |
685 |
will be marked as immortal. |
TITLE-OR-DESCRIPTION must be on of the symbols 'title, |
686 |
|
'description, or 'all. REGEXP is a regular expression, i.e. a |
687 |
This filter is checked after a new headline has been retrieved. If |
string. |
688 |
FEED-NAME matches the name of the corresponding news feed, both sublists |
|
689 |
are checked: If the title of the headline matches any of the regular |
This filter is checked after a new headline has been retrieved. |
690 |
expressions in OLD-LIST, this headline is marked as old, if it matches any |
If FEED-NAME matches the name of the corresponding news feed, the |
691 |
of the expressions in IMMORTAL-LIST it is marked as immortal. |
pattern-list is checked: The new headline will be marked as AGE |
692 |
|
if REGEXP matches the headline's TITLE-OR-DESCRIPTION. |
693 |
If, for example, `newsticker-auto-mark-filter' looks like |
|
694 |
\((slashdot (\"^Forget me!$\") (\"^Read me$\" \"important\"))) |
If, for example, `newsticker-auto-mark-filter-list' looks like |
695 |
then all articles from slashdot are marked as old if they have the title |
\((slashdot ('old 'title \"^Forget me!$\") ('immortal 'title \"Read me\") |
696 |
\"Forget me!\". All articles which have the title \"Read me\" and all |
\('immortal 'all \"important\")))) |
697 |
articles which contain the string \"important\" in their title are marked |
|
698 |
as immortal." |
then all articles from slashdot are marked as old if they have |
699 |
:type '(repeat (list :tag "Feed filter rule" |
the title \"Forget me!\". All articles with a title containing |
700 |
|
the string \"Read me\" are marked as immortal. All articles which |
701 |
|
contain the string \"important\" in their title or their |
702 |
|
description are marked as immortal." |
703 |
|
:type '(repeat (list :tag "Auto mark filter" |
704 |
(string :tag "Feed name") |
(string :tag "Feed name") |
705 |
;;(choice ,@(mapcar (lambda (i) |
(repeat |
706 |
;; (list :tag (car i) (car i))) |
(list :tag "Filter element" |
707 |
;; newsticker-url-list)) |
(choice |
708 |
(repeat :tag "Mark as old" string) |
:tag "Auto-assigned age" |
709 |
(repeat :tag "Mark as immortal" string))) |
(const :tag "Old" old) |
710 |
|
(const :tag "Immortal" immortal)) |
711 |
|
(choice |
712 |
|
:tag "Title/Description" |
713 |
|
(const :tag "Title" title) |
714 |
|
(const :tag "Description" description) |
715 |
|
(const :tag "All" all)) |
716 |
|
(string :tag "Regexp"))))) |
717 |
:group 'newsticker-headline-processing) |
:group 'newsticker-headline-processing) |
718 |
|
|
719 |
;; customization group layout |
;; customization group layout |
720 |
(defgroup newsticker-layout nil |
(defgroup newsticker-layout nil |
721 |
"Settings for layout of the RSS reader." |
"Settings for layout of the feed reader." |
722 |
:group 'newsticker) |
:group 'newsticker) |
723 |
|
|
724 |
(defcustom newsticker-sort-method |
(defcustom newsticker-sort-method |
726 |
"Sort method for news items. |
"Sort method for news items. |
727 |
The following sort methods are available: |
The following sort methods are available: |
728 |
* `sort-by-original-order' keeps the order in which the items |
* `sort-by-original-order' keeps the order in which the items |
729 |
appear in the RSS file (please note that for immortal items, |
appear in the headline file (please note that for immortal items, |
730 |
which have been removed from the news feed, there is no original |
which have been removed from the news feed, there is no original |
731 |
order), |
order), |
732 |
* `sort-by-time' looks at the time at which an item has been seen |
* `sort-by-time' looks at the time at which an item has been seen |
742 |
(defcustom newsticker-hide-old-items-in-newsticker-buffer |
(defcustom newsticker-hide-old-items-in-newsticker-buffer |
743 |
nil |
nil |
744 |
"Decides whether to automatically hide old items in the *newsticker* buffer. |
"Decides whether to automatically hide old items in the *newsticker* buffer. |
745 |
If set to t old items will be completely folded and only new items |
If set to t old items will be completely folded and only new |
746 |
will show up in the *newsticker* buffer. Otherwise old as well as new |
items will show up in the *newsticker* buffer. Otherwise old as |
747 |
items will be visible." |
well as new items will be visible." |
748 |
:type 'boolean |
:type 'boolean |
749 |
:set 'newsticker--set-customvar |
:set 'newsticker--set-customvar |
750 |
:group 'newsticker-layout) |
:group 'newsticker-layout) |
764 |
"Format string for feed headings. |
"Format string for feed headings. |
765 |
The following printf-like specifiers can be used: |
The following printf-like specifiers can be used: |
766 |
%d The date the feed was retrieved. See `newsticker-date-format'. |
%d The date the feed was retrieved. See `newsticker-date-format'. |
767 |
%l The logo (image) of the feed. Most RSS feeds provide a small |
%l The logo (image) of the feed. Most news feeds provide a small |
768 |
image as logo. Newsticker can display them, if Emacs can -- |
image as logo. Newsticker can display them, if Emacs can -- |
769 |
see `image-types' for a list of supported image types. |
see `image-types' for a list of supported image types. |
770 |
%L The logo (image) of the feed. If the logo is not available |
%L The logo (image) of the feed. If the logo is not available |
780 |
"Format string for news item headlines. |
"Format string for news item headlines. |
781 |
The following printf-like specifiers can be used: |
The following printf-like specifiers can be used: |
782 |
%d The date the item was (first) retrieved. See `newsticker-date-format'. |
%d The date the item was (first) retrieved. See `newsticker-date-format'. |
783 |
%l The logo (image) of the feed. Most RSS feeds provide a small |
%l The logo (image) of the feed. Most news feeds provide a small |
784 |
image as logo. Newsticker can display them, if Emacs can -- |
image as logo. Newsticker can display them, if Emacs can -- |
785 |
see `image-types' for a list of supported image types. |
see `image-types' for a list of supported image types. |
786 |
%L The logo (image) of the feed. If the logo is not available |
%L The logo (image) of the feed. If the logo is not available |
795 |
"Format string for news descriptions (contents). |
"Format string for news descriptions (contents). |
796 |
The following printf-like specifiers can be used: |
The following printf-like specifiers can be used: |
797 |
%c The contents (description) of the item. |
%c The contents (description) of the item. |
798 |
%d The date the item was (first) retrieved. See `newsticker-date-format'." |
%d The date the item was (first) retrieved. See |
799 |
|
`newsticker-date-format'." |
800 |
:type 'string |
:type 'string |
801 |
:set 'newsticker--set-customvar |
:set 'newsticker--set-customvar |
802 |
:group 'newsticker-layout) |
:group 'newsticker-layout) |
822 |
:set 'newsticker--set-customvar |
:set 'newsticker--set-customvar |
823 |
:group 'newsticker-layout) |
:group 'newsticker-layout) |
824 |
|
|
825 |
(defcustom newsticker-show-all-rss-elements |
(defcustom newsticker-show-all-news-elements |
826 |
nil |
nil |
827 |
"Show all RSS elements." |
"Show all news elements." |
828 |
:type 'boolean |
:type 'boolean |
829 |
;;:set 'newsticker--set-customvar |
;;:set 'newsticker--set-customvar |
830 |
:group 'newsticker-layout) |
:group 'newsticker-layout) |
898 |
|
|
899 |
;; faces |
;; faces |
900 |
(defgroup newsticker-faces nil |
(defgroup newsticker-faces nil |
901 |
"Settings for the faces of the RSS reader." |
"Settings for the faces of the feed reader." |
902 |
:group 'newsticker-layout) |
:group 'newsticker-layout) |
903 |
|
|
904 |
(defface newsticker-feed-face |
(defface newsticker-feed-face |
985 |
|
|
986 |
;; customization group ticker |
;; customization group ticker |
987 |
(defgroup newsticker-ticker nil |
(defgroup newsticker-ticker nil |
988 |
"Settings for the RSS ticker." |
"Settings for the headline ticker." |
989 |
:group 'newsticker) |
:group 'newsticker) |
990 |
|
|
991 |
(defcustom newsticker-display-interval |
(defcustom newsticker-display-interval |
1182 |
(defun remove-from-invisibility-spec (arg) |
(defun remove-from-invisibility-spec (arg) |
1183 |
"Remove elements from `buffer-invisibility-spec'." |
"Remove elements from `buffer-invisibility-spec'." |
1184 |
(if (consp buffer-invisibility-spec) |
(if (consp buffer-invisibility-spec) |
1185 |
(setq buffer-invisibility-spec (delete arg buffer-invisibility-spec))))) |
(setq buffer-invisibility-spec |
1186 |
|
(delete arg buffer-invisibility-spec))))) |
1187 |
|
|
1188 |
;; ====================================================================== |
;; ====================================================================== |
1189 |
;;; Internal variables |
;;; Internal variables |
1205 |
"Tells whether the newsticker buffer is up to date.") |
"Tells whether the newsticker buffer is up to date.") |
1206 |
(defvar newsticker--latest-update-time (current-time) |
(defvar newsticker--latest-update-time (current-time) |
1207 |
"The time at which the latest news arrived.") |
"The time at which the latest news arrived.") |
1208 |
|
(defvar newsticker--process-ids nil |
1209 |
|
"List of PIDs of active newsticker processes.") |
1210 |
|
|
1211 |
(defvar newsticker--cache nil "Cached newsticker data. |
(defvar newsticker--cache nil "Cached newsticker data. |
1212 |
This is a list of the form |
This is a list of the form |
2185 |
|
|
2186 |
(define-derived-mode newsticker-mode fundamental-mode |
(define-derived-mode newsticker-mode fundamental-mode |
2187 |
"NewsTicker" |
"NewsTicker" |
2188 |
"Viewing RSS news feeds in Emacs." |
"Viewing news feeds in Emacs." |
2189 |
(set (make-local-variable 'tool-bar-map) newsticker-tool-bar-map) |
(set (make-local-variable 'tool-bar-map) newsticker-tool-bar-map) |
2190 |
(set (make-local-variable 'imenu-sort-function) nil) |
(set (make-local-variable 'imenu-sort-function) nil) |
2191 |
(set (make-local-variable 'scroll-conservatively) 999) |
(set (make-local-variable 'scroll-conservatively) 999) |
2205 |
'(newsticker--buffer-uptodate-p |
'(newsticker--buffer-uptodate-p |
2206 |
"up to date" |
"up to date" |
2207 |
"NEED UPDATE") |
"NEED UPDATE") |
2208 |
") -- " |
") " |
2209 |
|
'(:eval (format "[%d]" (length newsticker--process-ids))) |
2210 |
|
" -- " |
2211 |
'(:eval (newsticker--buffer-get-feed-title-at-point)) |
'(:eval (newsticker--buffer-get-feed-title-at-point)) |
2212 |
": " |
": " |
2213 |
'(:eval (newsticker--buffer-get-item-title-at-point)) |
'(:eval (newsticker--buffer-get-item-title-at-point)) |
2214 |
" %-")) |
" %-")) |
2215 |
(unless newsticker-show-all-rss-elements |
(unless newsticker-show-all-news-elements |
2216 |
(add-to-invisibility-spec 'extra)) |
(add-to-invisibility-spec 'extra)) |
2217 |
(newsticker--buffer-set-uptodate nil)) |
(newsticker--buffer-set-uptodate nil)) |
2218 |
|
|
2244 |
(define-key newsticker-mode-map "M" 'newsticker-mark-all-items-as-read) |
(define-key newsticker-mode-map "M" 'newsticker-mark-all-items-as-read) |
2245 |
(define-key newsticker-mode-map "m" |
(define-key newsticker-mode-map "m" |
2246 |
'newsticker-mark-all-items-at-point-as-read) |
'newsticker-mark-all-items-at-point-as-read) |
2247 |
(define-key newsticker-mode-map "o" 'newsticker-mark-item-at-point-as-read) |
(define-key newsticker-mode-map "o" |
2248 |
|
'newsticker-mark-item-at-point-as-read) |
2249 |
(define-key newsticker-mode-map "G" 'newsticker-get-all-news) |
(define-key newsticker-mode-map "G" 'newsticker-get-all-news) |
2250 |
(define-key newsticker-mode-map "g" 'newsticker-get-news-at-point) |
(define-key newsticker-mode-map "g" 'newsticker-get-news-at-point) |
2251 |
(define-key newsticker-mode-map "u" 'newsticker-buffer-update) |
(define-key newsticker-mode-map "u" 'newsticker-buffer-update) |
2255 |
(define-key newsticker-mode-map "i" |
(define-key newsticker-mode-map "i" |
2256 |
'newsticker-mark-item-at-point-as-immortal) |
'newsticker-mark-item-at-point-as-immortal) |
2257 |
|
|
2258 |
(define-key newsticker-mode-map "xf" 'newsticker-toggle-auto-narrow-to-feed) |
(define-key newsticker-mode-map "xf" |
2259 |
(define-key newsticker-mode-map "xi" 'newsticker-toggle-auto-narrow-to-item) |
'newsticker-toggle-auto-narrow-to-feed) |
2260 |
|
(define-key newsticker-mode-map "xi" |
2261 |
|
'newsticker-toggle-auto-narrow-to-item) |
2262 |
|
|
2263 |
;; maps for the clickable portions |
;; maps for the clickable portions |
2264 |
(defvar newsticker--url-keymap (make-sparse-keymap) |
(defvar newsticker--url-keymap (make-sparse-keymap) |
2407 |
(if (or (not start-time) |
(if (or (not start-time) |
2408 |
(and (numberp start-time) (= start-time 0))) |
(and (numberp start-time) (= start-time 0))) |
2409 |
(setq start-time 1)) |
(setq start-time 1)) |
2410 |
(message "start-time %s" start-time) |
;; (message "start-time %s" start-time) |
2411 |
(setq timer (run-at-time start-time interval |
(setq timer (run-at-time start-time interval |
2412 |
'newsticker-get-news feed-name)) |
'newsticker-get-news feed-name)) |
2413 |
(if interval |
(if interval |
2418 |
(run-hooks 'newsticker-start-hook) |
(run-hooks 'newsticker-start-hook) |
2419 |
(message "Newsticker started!")))) |
(message "Newsticker started!")))) |
2420 |
|
|
2421 |
|
;;;###autoload |
2422 |
(defun newsticker-start-ticker () |
(defun newsticker-start-ticker () |
2423 |
"Start newsticker's ticker (but not the news retrieval. |
"Start newsticker's ticker (but not the news retrieval). |
2424 |
Start display timer for the actual ticker if wanted and not |
Start display timer for the actual ticker if wanted and not |
2425 |
running already." |
running already." |
2426 |
(interactive) |
(interactive) |
2578 |
(goto-char pos) |
(goto-char pos) |
2579 |
(when (get-text-property pos 'w3m-image) |
(when (get-text-property pos 'w3m-image) |
2580 |
(let ((invis (newsticker--lists-intersect-p |
(let ((invis (newsticker--lists-intersect-p |
2581 |
(get-text-property (1- (point)) 'invisible) |
(get-text-property (1- (point)) |
2582 |
|
'invisible) |
2583 |
buffer-invisibility-spec))) |
buffer-invisibility-spec))) |
2584 |
(if invis |
(if invis |
2585 |
(w3m-remove-image |
(w3m-remove-image |
2586 |
pos (next-single-property-change pos 'w3m-image)) |
pos (next-single-property-change pos |
2587 |
|
'w3m-image)) |
2588 |
(w3m-toggle-inline-image t)))))))))))) |
(w3m-toggle-inline-image t)))))))))))) |
2589 |
|
|
2590 |
;; ====================================================================== |
;; ====================================================================== |
2662 |
buffer-invisibility-spec) |
buffer-invisibility-spec) |
2663 |
(setq go-ahead nil)))) |
(setq go-ahead nil)))) |
2664 |
(run-hooks 'newsticker-select-item-hook) |
(run-hooks 'newsticker-select-item-hook) |
2665 |
|
(force-mode-line-update) |
2666 |
(point)) |
(point)) |
2667 |
|
|
2668 |
(defun newsticker-previous-item (&optional do-not-wrap-at-bob) |
(defun newsticker-previous-item (&optional do-not-wrap-at-bob) |
2689 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2690 |
(setq go-ahead nil)))) |
(setq go-ahead nil)))) |
2691 |
(run-hooks 'newsticker-select-item-hook) |
(run-hooks 'newsticker-select-item-hook) |
2692 |
|
(force-mode-line-update) |
2693 |
(point)) |
(point)) |
2694 |
|
|
2695 |
(defun newsticker-next-feed () |
(defun newsticker-next-feed () |
2699 |
(widen) |
(widen) |
2700 |
(newsticker--buffer-goto '(feed)) |
(newsticker--buffer-goto '(feed)) |
2701 |
(run-hooks 'newsticker-select-feed-hook) |
(run-hooks 'newsticker-select-feed-hook) |
2702 |
|
(force-mode-line-update) |
2703 |
(point)) |
(point)) |
2704 |
|
|
2705 |
(defun newsticker-previous-feed () |
(defun newsticker-previous-feed () |
2709 |
(widen) |
(widen) |
2710 |
(newsticker--buffer-goto '(feed) nil t) |
(newsticker--buffer-goto '(feed) nil t) |
2711 |
(run-hooks 'newsticker-select-feed-hook) |
(run-hooks 'newsticker-select-feed-hook) |
2712 |
|
(force-mode-line-update) |
2713 |
(point)) |
(point)) |
2714 |
|
|
2715 |
(defun newsticker-mark-all-items-at-point-as-read () |
(defun newsticker-mark-all-items-at-point-as-read () |
2723 |
(when feed |
(when feed |
2724 |
(message "Marking all items as read for %s" (symbol-name feed)) |
(message "Marking all items as read for %s" (symbol-name feed)) |
2725 |
(newsticker--cache-replace-age newsticker--cache feed 'new 'old) |
(newsticker--cache-replace-age newsticker--cache feed 'new 'old) |
2726 |
(newsticker--cache-replace-age newsticker--cache feed 'obsolete 'old) |
(newsticker--cache-replace-age newsticker--cache feed 'obsolete |
2727 |
|
'old) |
2728 |
(newsticker--cache-update) |
(newsticker--cache-update) |
2729 |
(newsticker--buffer-set-uptodate nil) |
(newsticker--buffer-set-uptodate nil) |
2730 |
(newsticker--ticker-text-setup) |
(newsticker--ticker-text-setup) |
2925 |
(defun newsticker-show-old-items () |
(defun newsticker-show-old-items () |
2926 |
"Show old items." |
"Show old items." |
2927 |
(interactive) |
(interactive) |
|
(newsticker--buffer-hideshow 'desc-old t) |
|
2928 |
(newsticker--buffer-hideshow 'item-old t) |
(newsticker--buffer-hideshow 'item-old t) |
2929 |
(newsticker--buffer-redraw)) |
(newsticker--buffer-redraw)) |
2930 |
|
|
2939 |
(newsticker--buffer-beginning-of-item) |
(newsticker--buffer-beginning-of-item) |
2940 |
(newsticker--buffer-goto '(desc)) |
(newsticker--buffer-goto '(desc)) |
2941 |
(setq pos1 (max (point-min) (1- (point)))) |
(setq pos1 (max (point-min) (1- (point)))) |
2942 |
(newsticker--buffer-goto '(extra feed item)) |
(newsticker--buffer-goto '(extra feed item nil)) |
2943 |
(setq pos2 (max (point-min) (1- (point)))) |
(setq pos2 (max (point-min) (1- (point)))) |
2944 |
(setq inv-prop (get-text-property pos1 'invisible)) |
(setq inv-prop (get-text-property pos1 'invisible)) |
2945 |
(setq org-inv-prop (get-text-property pos1 'org-invisible)) |
(setq org-inv-prop (get-text-property pos1 'org-invisible)) |
2947 |
;; do nothing |
;; do nothing |
2948 |
) |
) |
2949 |
((eq org-inv-prop nil) |
((eq org-inv-prop nil) |
2950 |
(add-text-properties pos1 pos2 (list 'invisible t |
(add-text-properties pos1 pos2 |
2951 |
'org-invisible inv-prop))) |
(list 'invisible t |
2952 |
|
'org-invisible inv-prop))) |
2953 |
(t |
(t |
2954 |
;; toggle |
;; toggle |
2955 |
(add-text-properties pos1 pos2 (list 'invisible org-inv-prop)) |
(add-text-properties pos1 pos2 |
2956 |
|
(list 'invisible org-inv-prop)) |
2957 |
(remove-text-properties pos1 pos2 '(org-invisible)))))) |
(remove-text-properties pos1 pos2 '(org-invisible)))))) |
2958 |
(newsticker--buffer-redraw)) |
(newsticker--buffer-redraw)) |
2959 |
|
|
2973 |
(setq inv-prop (get-text-property pos1 'invisible)) |
(setq inv-prop (get-text-property pos1 'invisible)) |
2974 |
(setq org-inv-prop (get-text-property pos1 'org-invisible)) |
(setq org-inv-prop (get-text-property pos1 'org-invisible)) |
2975 |
(cond ((eq org-inv-prop nil) |
(cond ((eq org-inv-prop nil) |
2976 |
(add-text-properties pos1 pos2 (list 'invisible nil |
(add-text-properties pos1 pos2 |
2977 |
'org-invisible inv-prop))) |
(list 'invisible nil |
2978 |
|
'org-invisible inv-prop))) |
2979 |
(t |
(t |
2980 |
;; toggle |
;; toggle |
2981 |
(add-text-properties pos1 pos2 (list 'invisible org-inv-prop)) |
(add-text-properties pos1 pos2 |
2982 |
|
(list 'invisible org-inv-prop)) |
2983 |
(remove-text-properties pos1 pos2 '(org-invisible)))))) |
(remove-text-properties pos1 pos2 '(org-invisible)))))) |
2984 |
(newsticker--buffer-redraw)) |
(newsticker--buffer-redraw)) |
2985 |
|
|
2988 |
If auto-narrowing is active, only news item of the current feed |
If auto-narrowing is active, only news item of the current feed |
2989 |
are visible." |
are visible." |
2990 |
(interactive) |
(interactive) |
2991 |
(newsticker-set-auto-narrow-to-feed (not newsticker--auto-narrow-to-feed))) |
(newsticker-set-auto-narrow-to-feed |
2992 |
|
(not newsticker--auto-narrow-to-feed))) |
2993 |
|
|
2994 |
(defun newsticker-set-auto-narrow-to-feed (value) |
(defun newsticker-set-auto-narrow-to-feed (value) |
2995 |
"Turn narrowing to current news feed on or off. |
"Turn narrowing to current news feed on or off. |
2998 |
(setq newsticker--auto-narrow-to-item nil) |
(setq newsticker--auto-narrow-to-item nil) |
2999 |
(setq newsticker--auto-narrow-to-feed value) |
(setq newsticker--auto-narrow-to-feed value) |
3000 |
(widen) |
(widen) |
3001 |
|
(newsticker--buffer-make-item-completely-visible) |
3002 |
(run-hooks 'newsticker-narrow-hook)) |
(run-hooks 'newsticker-narrow-hook)) |
3003 |
|
|
3004 |
(defun newsticker-toggle-auto-narrow-to-item () |
(defun newsticker-toggle-auto-narrow-to-item () |
3006 |
If auto-narrowing is active, only one item of the current feed |
If auto-narrowing is active, only one item of the current feed |
3007 |
is visible." |
is visible." |
3008 |
(interactive) |
(interactive) |
3009 |
(newsticker-set-auto-narrow-to-item (not newsticker--auto-narrow-to-item))) |
(newsticker-set-auto-narrow-to-item |
3010 |
|
(not newsticker--auto-narrow-to-item))) |
3011 |
|
|
3012 |
(defun newsticker-set-auto-narrow-to-item (value) |
(defun newsticker-set-auto-narrow-to-item (value) |
3013 |
"Turn narrowing to current news item on or off. |
"Turn narrowing to current news item on or off. |
3016 |
(setq newsticker--auto-narrow-to-feed nil) |
(setq newsticker--auto-narrow-to-feed nil) |
3017 |
(setq newsticker--auto-narrow-to-item value) |
(setq newsticker--auto-narrow-to-item value) |
3018 |
(widen) |
(widen) |
3019 |
|
(newsticker--buffer-make-item-completely-visible) |
3020 |
(run-hooks 'newsticker-narrow-hook)) |
(run-hooks 'newsticker-narrow-hook)) |
3021 |
|
|
3022 |
(defun newsticker-customize () |
(defun newsticker-customize () |
3079 |
(and (memq age '(new old obsolete)) t))))) |
(and (memq age '(new old obsolete)) t))))) |
3080 |
|
|
3081 |
;; ====================================================================== |
;; ====================================================================== |
3082 |
;;; local stuff |
;;; Newsticker status |
3083 |
;; ====================================================================== |
;; ====================================================================== |
3084 |
|
;;;###autoload |
3085 |
(defun newsticker-running-p () |
(defun newsticker-running-p () |
3086 |
"Check whether newsticker is running. |
"Check whether newsticker is running. |
3087 |
Return t if newsticker is running, nil otherwise. Newsticker is |
Return t if newsticker is running, nil otherwise. Newsticker is |
3088 |
considered to be running if the newsticker timer list is not empty." |
considered to be running if the newsticker timer list is not empty." |
3089 |
(> (length newsticker--retrieval-timer-list) 0)) |
(> (length newsticker--retrieval-timer-list) 0)) |
3090 |
|
|
3091 |
|
;;;###autoload |
3092 |
(defun newsticker-ticker-running-p () |
(defun newsticker-ticker-running-p () |
3093 |
"Check whether newsticker's actual ticker is running. |
"Check whether newsticker's actual ticker is running. |
3094 |
Return t if ticker is running, nil otherwise. Newsticker is |
Return t if ticker is running, nil otherwise. Newsticker is |
3126 |
(proc (apply 'start-process feed-name buffername |
(proc (apply 'start-process feed-name buffername |
3127 |
newsticker-wget-name args))) |
newsticker-wget-name args))) |
3128 |
(set-process-coding-system proc 'no-conversion 'no-conversion) |
(set-process-coding-system proc 'no-conversion 'no-conversion) |
3129 |
(set-process-sentinel proc 'newsticker--sentinel))))) |
(set-process-sentinel proc 'newsticker--sentinel) |
3130 |
|
(setq newsticker--process-ids (cons (process-id proc) |
3131 |
|
newsticker--process-ids)) |
3132 |
|
(force-mode-line-update))))) |
3133 |
|
|
3134 |
(defun newsticker-mouse-browse-url (event) |
(defun newsticker-mouse-browse-url (event) |
3135 |
"Call `browse-url' for the link of the item at which the EVENT occurred." |
"Call `browse-url' for the link of the item at which the EVENT occurred." |
3205 |
(format-time-string "%A, %H:%M" (current-time)) |
(format-time-string "%A, %H:%M" (current-time)) |
3206 |
(process-name process)) |
(process-name process)) |
3207 |
(throw 'oops nil)) |
(throw 'oops nil)) |
3208 |
(let* ((coding-system nil) |
(let* ((coding-system 'utf-8) |
3209 |
(node-list |
(node-list |
3210 |
(save-current-buffer |
(save-current-buffer |
3211 |
(set-buffer (process-buffer process)) |
(set-buffer (process-buffer process)) |
3250 |
"<description><![CDATA[ \\1 ]]></description>")) |
"<description><![CDATA[ \\1 ]]></description>")) |
3251 |
;; |
;; |
3252 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
3253 |
|
;; check coding system |
3254 |
(goto-char (point-min)) |
(goto-char (point-min)) |
3255 |
(if (re-search-forward "encoding=\"\\([^\"]+\\)\"" |
(if (re-search-forward "encoding=\"\\([^\"]+\\)\"" |
3256 |
nil t) |
nil t) |
3257 |
(setq coding-system (intern |
(setq coding-system (intern (downcase (match-string 1)))) |
3258 |
(downcase(match-string 1))))) |
(setq coding-system |
3259 |
|
(condition-case nil |
3260 |
|
(check-coding-system coding-system) |
3261 |
|
(coding-system-error |
3262 |
|
(message |
3263 |
|
"newsticker.el: ignoring coding system %s for %s" |
3264 |
|
coding-system name) |
3265 |
|
nil)))) |
3266 |
|
;; Decode if possible |
3267 |
|
(when coding-system |
3268 |
|
(decode-coding-region (point-min) (point-max) |
3269 |
|
coding-system)) |
3270 |
(condition-case errordata |
(condition-case errordata |
3271 |
;; The xml parser might fail |
;; The xml parser might fail |
3272 |
;; or the xml might be bugged |
;; or the xml might be bugged |
3276 |
(throw 'oops nil))))) |
(throw 'oops nil))))) |
3277 |
(topnode (car node-list)) |
(topnode (car node-list)) |
3278 |
(channelnode (car (xml-get-children topnode 'channel))) |
(channelnode (car (xml-get-children topnode 'channel))) |
3279 |
(imageurl nil) |
(imageurl nil)) |
|
(position 0)) |
|
3280 |
;; mark all items as obsolete |
;; mark all items as obsolete |
3281 |
(newsticker--cache-replace-age newsticker--cache |
(newsticker--cache-replace-age newsticker--cache |
3282 |
name-symbol |
name-symbol |
3287 |
(newsticker--cache-replace-age newsticker--cache |
(newsticker--cache-replace-age newsticker--cache |
3288 |
name-symbol |
name-symbol |
3289 |
'feed 'obsolete-old) |
'feed 'obsolete-old) |
3290 |
;; gather the news |
|
3291 |
(if (eq (xml-node-name topnode) 'rss) |
;; check Atom/RSS version and call corresponding parser |
3292 |
;; this is RSS 0.91 or something similar |
(condition-case error-data |
3293 |
;; all items are inside the channel node |
(if (cond |
3294 |
(setq topnode channelnode)) |
;; RSS 0.91 |
3295 |
(setq imageurl |
((and (eq 'rss (xml-node-name topnode)) |
3296 |
(car (xml-node-children |
(string= "0.91" (xml-get-attribute topnode 'version))) |
3297 |
(car (xml-get-children |
(setq imageurl (newsticker--get-logo-url-rss-0.91 topnode)) |
3298 |
(car (xml-get-children |
(newsticker--parse-rss-0.91 name time topnode)) |
3299 |
topnode |
;; RSS 0.92 |
3300 |
'image)) |
((and (eq 'rss (xml-node-name topnode)) |
3301 |
'url))))) |
(string= "0.92" (xml-get-attribute topnode 'version))) |
3302 |
(let ((title (or (car (xml-node-children (car (xml-get-children |
(setq imageurl (newsticker--get-logo-url-rss-0.92 topnode)) |
3303 |
channelnode 'title)))) |
(newsticker--parse-rss-0.92 name time topnode)) |
3304 |
"[untitled]")) |
;; RSS 1.0 |
3305 |
(link (or (car (xml-node-children (car (xml-get-children |
((eq 'rdf:RDF (xml-node-name topnode)) |
3306 |
channelnode 'link)))) |
(setq imageurl (newsticker--get-logo-url-rss-1.0 topnode)) |
3307 |
"")) |
(newsticker--parse-rss-1.0 name time topnode)) |
3308 |
(desc (or (car (xml-node-children (car (xml-get-children |
;; RSS 2.0 |
3309 |
channelnode |
((and (eq 'rss (xml-node-name topnode)) |
3310 |
'content:encoded)))) |
(string= "2.0" (xml-get-attribute topnode 'version))) |
3311 |
(car (xml-node-children (car (xml-get-children |
(setq imageurl (newsticker--get-logo-url-rss-2.0 topnode)) |
3312 |
channelnode |
(newsticker--parse-rss-2.0 name time topnode)) |
3313 |
'description)))) |
;; Atom 0.3 |
3314 |
"[No description available]")) |
((and (eq 'feed (xml-node-name topnode)) |
3315 |
(old-item nil)) |
(string= "http://purl.org/atom/ns#" |
3316 |
;; check coding system |
(xml-get-attribute topnode 'xmlns))) |
3317 |
(setq coding-system |
(setq imageurl (newsticker--get-logo-url-atom-0.3 topnode)) |
3318 |
(condition-case nil |
(newsticker--parse-atom-0.3 name time topnode)) |
3319 |
(check-coding-system coding-system) |
;; Atom 1.0 |
3320 |
(coding-system-error |
((and (eq 'feed (xml-node-name topnode)) |
3321 |
(message "newsticker.el: %s %s %s %s" |
(string= "http://www.w3.org/2005/Atom" |
3322 |
"ignoring coding system " |
(xml-get-attribute topnode 'xmlns))) |
3323 |
coding-system |
(setq imageurl (newsticker--get-logo-url-atom-1.0 topnode)) |
3324 |
" for " |
(newsticker--parse-atom-1.0 name time topnode)) |
3325 |
name) |
;; unknown feed type |
3326 |
nil))) |
(t |
3327 |
;; apply coding system |
(newsticker--debug-msg "Feed type unknown: %s: %s" |
3328 |
(when coding-system |
(xml-node-name topnode) name) |
3329 |
(setq title (newsticker--decode-coding-string title coding-system)) |
nil)) |
3330 |
(if desc |
(setq something-was-added t)) |
3331 |
(setq desc (newsticker--decode-coding-string desc |
(xerror (message "sentinelerror in %s: %s" name error-data))) |
3332 |
coding-system))) |
|
|
(setq link (newsticker--decode-coding-string link coding-system))) |
|
|
;; 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 |
|
|
name-symbol title |
|
|
desc link 'feed) |
|
|
(setq something-was-added t)) |
|
|
(setq newsticker--cache |
|
|
(newsticker--cache-add |
|
|
newsticker--cache name-symbol |
|
|
title desc link time 'feed position |
|
|
(xml-node-children channelnode) |
|
|
'feed time)) |
|
|
;; gather all items for this feed |
|
|
(mapc (lambda (node) |
|
|
(when (eq (xml-node-name node) 'item) |
|
|
(setq position (1+ position)) |
|
|
(setq title (or (car (xml-node-children |
|
|
(car (xml-get-children |
|
|
node 'title)))) |
|
|
"[untitled]")) |
|
|
(setq link (or (car (xml-node-children |
|
|
(car (xml-get-children |
|
|
node 'link)))) |
|
|
"")) |
|
|
(setq desc (or |
|
|
(car (xml-node-children |
|
|
(car (xml-get-children |
|
|
node 'content:encoded)))) |
|
|
(car (xml-node-children |
|
|
(car (xml-get-children |
|
|
node 'description)))))) |
|
|
;; use pubDate value if present |
|
|
(setq time (or (newsticker--decode-rfc822-date |
|
|
(car (xml-node-children |
|
|
(car (xml-get-children |
|
|
node 'pubDate))))) |
|
|
time)) |
|
|
;; use dc:date value if present |
|
|
(setq time (or (newsticker--decode-iso8601-date |
|
|
(car (xml-node-children |
|
|
(car (xml-get-children |
|
|
node 'dc:date))))) |
|
|
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)) |
|
|
;; apply coding system |
|
|
(when coding-system |
|
|
(setq title (newsticker--decode-coding-string |
|
|
title coding-system)) |
|
|
(if desc |
|
|
(setq desc (newsticker--decode-coding-string desc |
|
|
coding-system))) |
|
|
(setq link (newsticker--decode-coding-string |
|
|
link coding-system))) |
|
|
;; 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* ((tguid (assoc 'guid (xml-node-children node))) |
|
|
(guid (if (stringp tguid) |
|
|
tguid |
|
|
(car (xml-node-children tguid))))) |
|
|
;;(message "guid=%s" guid) |
|
|
(setq old-item |
|
|
(newsticker--cache-contains newsticker--cache |
|
|
name-symbol 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 |
|
|
(if (eq prev-age 'obsolete-old) |
|
|
(setq age2 'old) |
|
|
(setq age2 'new))) |
|
|
(if (eq prev-age 'immortal) |
|
|
(setq age2 'immortal))) |
|
|
;; item was not there |
|
|
(setq item-new-p t) |
|
|
(setq something-was-added t)) |
|
|
(setq newsticker--cache |
|
|
(newsticker--cache-add |
|
|
newsticker--cache name-symbol title desc link |
|
|
time age1 position (xml-node-children node) |
|
|
age2)) |
|
|
(when item-new-p |
|
|
(let ((item (newsticker--cache-contains |
|
|
newsticker--cache |
|
|
name-symbol title |
|
|
desc link nil))) |
|
|
(if newsticker-auto-mark-filter |
|
|
(newsticker--run-auto-mark-filter name item)) |
|
|
(run-hook-with-args |
|
|
'newsticker-new-item-functions name item))))))) |
|
|
(xml-get-children topnode 'item))) |
|
3333 |
;; Remove those old items from cache which have been removed from |
;; Remove those old items from cache which have been removed from |
3334 |
;; the feed |
;; the feed |
3335 |
(newsticker--cache-replace-age newsticker--cache |
(newsticker--cache-replace-age newsticker--cache |
3350 |
(newsticker--cache-replace-age newsticker--cache |
(newsticker--cache-replace-age newsticker--cache |
3351 |
name-symbol 'obsolete-new |
name-symbol 'obsolete-new |
3352 |
'obsolete)) |
'obsolete)) |
3353 |
;; bring cache data into proper order.... |
(newsticker--update-process-ids) |
|
;; (newsticker--cache-sort) |
|
3354 |
;; setup scrollable text |
;; setup scrollable text |
3355 |
(newsticker--ticker-text-setup) |
(when (= 0 (length newsticker--process-ids)) |
3356 |
|
(newsticker--ticker-text-setup)) |
3357 |
(setq newsticker--latest-update-time (current-time)) |
(setq newsticker--latest-update-time (current-time)) |
3358 |
(when something-was-added |
(when something-was-added |
3359 |
;; FIXME: should we care about removed items as well? |
;; FIXME: should we care about removed items as well? |
3367 |
(string-match "%l" newsticker-heading-format)) |
(string-match "%l" newsticker-heading-format)) |
3368 |
(newsticker--image-get name imageurl)))))) |
(newsticker--image-get name imageurl)))))) |
3369 |
|
|
3370 |
|
(defun newsticker--get-logo-url-atom-1.0 (node) |
3371 |
|
"Return logo URL from atom 1.0 data in NODE." |
3372 |
|
(car (xml-node-children |
3373 |
|
(car (xml-get-children node 'logo))))) |
3374 |
|
|
3375 |
|
(defun newsticker--get-logo-url-atom-0.3 (node) |
3376 |
|
"Return logo URL from atom 0.3 data in NODE." |
3377 |
|
(car (xml-node-children |
3378 |
|
(car (xml-get-children (car (xml-get-children node 'image)) 'url))))) |
3379 |
|
|
3380 |
|
(defun newsticker--get-logo-url-rss-2.0 (node) |
3381 |
|
"Return logo URL from RSS 2.0 data in NODE." |
3382 |
|
(car (xml-node-children |
3383 |
|
(car (xml-get-children |
3384 |
|
(car (xml-get-children |
3385 |
|
(car (xml-get-children node 'channel)) 'image)) 'url))))) |
3386 |
|
|
3387 |
|
(defun newsticker--get-logo-url-rss-1.0 (node) |
3388 |
|
"Return logo URL from RSS 1.0 data in NODE." |
3389 |
|
(car (xml-node-children |
3390 |
|
(car (xml-get-children (car (xml-get-children node 'image)) 'url))))) |
3391 |
|
|
3392 |
|
(defun newsticker--get-logo-url-rss-0.92 (node) |
3393 |
|
"Return logo URL from RSS 0.92 data in NODE." |
3394 |
|
(car (xml-node-children |
3395 |
|
(car (xml-get-children (car (xml-get-children node 'image)) 'url))))) |
3396 |
|
|
3397 |
|
(defun newsticker--get-logo-url-rss-0.91 (node) |
3398 |
|
"Return logo URL from RSS 0.91 data in NODE." |
3399 |
|
(car (xml-node-children |
3400 |
|
(car (xml-get-children (car (xml-get-children node 'image)) 'url))))) |
3401 |
|
|
3402 |
|
(defun newsticker--parse-atom-0.3 (name time topnode) |
3403 |
|
"Parse Atom 0.3 data. |
3404 |
|
Return value as well as arguments NAME, TIME, and TOPNODE are the |
3405 |
|
same as in `newsticker--parse-generic-rss'." |
3406 |
|
(newsticker--debug-msg "Parsing Atom 0.3 feed %s" name) |
3407 |
|
(let (new-feed new-item) |
3408 |
|
(setq new-feed (newsticker--parse-generic-feed |
3409 |
|
name time |
3410 |
|
;; title |
3411 |
|
(car (xml-node-children |
3412 |
|
(car (xml-get-children topnode 'title)))) |
3413 |
|
;; desc |
3414 |
|
(car (xml-node-children |
3415 |
|
(car (xml-get-children topnode 'content)))) |
3416 |
|
;; link |
3417 |
|
(xml-get-attribute |
3418 |
|
(car (xml-get-children topnode 'link)) 'href) |
3419 |
|
;; extra-elements |
3420 |
|
(xml-node-children topnode))) |
3421 |
|
(setq new-item (newsticker--parse-generic-items |
3422 |
|
name time (xml-get-children topnode 'entry) |
3423 |
|
;; title-fn |
3424 |
|
(lambda (node) |
3425 |
|
(car (xml-node-children |
3426 |
|
(car (xml-get-children node 'title))))) |
3427 |
|
;; desc-fn |
3428 |
|
(lambda (node) |
3429 |
|
(or (car (xml-node-children |
3430 |
|
(car (xml-get-children node 'content)))) |
3431 |
|
(car (xml-node-children |
3432 |
|
(car (xml-get-children node 'summary)))))) |
3433 |
|
;; link-fn |
3434 |
|
(lambda (node) |
3435 |
|
(xml-get-attribute |
3436 |
|
(car (xml-get-children node 'link)) 'href)) |
3437 |
|
;; time-fn |
3438 |
|
(lambda (node) |
3439 |
|
(newsticker--decode-rfc822-date |
3440 |
|
(car (xml-node-children |
3441 |
|
(car (xml-get-children node 'modified)))))) |
3442 |
|
;; guid-fn |
3443 |
|
(lambda (node) |
3444 |
|
(let ((tguid (assoc 'guid (xml-node-children node)))) |
3445 |
|
(if (stringp tguid) |
3446 |
|
tguid |
3447 |
|
(car (xml-node-children tguid))))) |
3448 |
|
;; extra-fn |
3449 |
|
(lambda (node) |
3450 |
|
(xml-node-children node)))) |
3451 |
|
(or new-item new-feed))) |
3452 |
|
|
3453 |
|
(defun newsticker--parse-atom-1.0 (name time topnode) |
3454 |
|
"Parse Atom 1.0 data. |
3455 |
|
Argument NAME gives the name of a news feed. TIME gives the |
3456 |
|
system time at which the data have been retrieved. TOPNODE |
3457 |
|
contains the feed data as returned by the xml parser. |
3458 |
|
|
3459 |
|
For the Atom 1.0 specification see |
3460 |
|
http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html" |
3461 |
|
(newsticker--debug-msg "Parsing Atom 1.0 feed %s" name) |
3462 |
|
(let (new-feed new-item) |
3463 |
|
(setq new-feed (newsticker--parse-generic-feed |
3464 |
|
name time |
3465 |
|
;; title |
3466 |
|
(car (xml-node-children |
3467 |
|
(car (xml-get-children topnode 'title)))) |
3468 |
|
;; desc |
3469 |
|
(car (xml-node-children |
3470 |
|
(car (xml-get-children topnode 'subtitle)))) |
3471 |
|
;; link |
3472 |
|
(car (xml-node-children |
3473 |
|
(car (xml-get-children topnode 'link)))) |
3474 |
|
;; extra-elements |
3475 |
|
(xml-node-children topnode))) |
3476 |
|
(setq new-item (newsticker--parse-generic-items |
3477 |
|
name time (xml-get-children topnode 'entry) |
3478 |
|
;; title-fn |
3479 |
|
(lambda (node) |
3480 |
|
(car (xml-node-children |
3481 |
|
(car (xml-get-children node 'title))))) |
3482 |
|
;; desc-fn |
3483 |
|
(lambda (node) |
3484 |
|
(or (car (xml-node-children |
3485 |
|
(car (xml-get-children node 'content)))) |
3486 |
|
(car (xml-node-children |
3487 |
|
(car (xml-get-children node 'summary)))))) |
3488 |
|
;; link-fn |
3489 |
|
(lambda (node) |
3490 |
|
(car (xml-node-children |
3491 |
|
(car (xml-get-children node 'link))))) |
3492 |
|
;; time-fn |
3493 |
|
(lambda (node) |
3494 |
|
(newsticker--decode-iso8601-date |
3495 |
|
(or (car (xml-node-children |
3496 |
|
(car (xml-get-children node 'updated)))) |
3497 |
|
(car (xml-node-children |
3498 |
|
(car (xml-get-children node 'published))))))) |
3499 |
|
;; guid-fn |
3500 |
|
(lambda (node) |
3501 |
|
(car (xml-node-children |
3502 |
|
(car (xml-get-children node 'id))))) |
3503 |
|
;; extra-fn |
3504 |
|
(lambda (node) |
3505 |
|
(xml-node-children node)))) |
3506 |
|
(or new-item new-feed))) |
3507 |
|
|
3508 |
|
(defun newsticker--parse-rss-0.91 (name time topnode) |
3509 |
|
"Parse RSS 0.91 data. |
3510 |
|
Return value as well as arguments NAME, TIME, and TOPNODE are the |
3511 |
|
same as in `newsticker--parse-atom-1.0'. |
3512 |
|
|
3513 |
|
For the RSS 0.91 specification see http://backend.userland.com/rss091 or |
3514 |
|
http://my.netscape.com/publish/formats/rss-spec-0.91.html." |
3515 |
|
(newsticker--debug-msg "Parsing RSS 0.91 feed %s" name) |
3516 |
|
(let* ((channelnode (car (xml-get-children topnode 'channel))) |
3517 |
|
(pub-date (newsticker--decode-rfc822-date |
3518 |
|
(car (xml-node-children |
3519 |
|
(car (xml-get-children channelnode 'pubDate)))))) |
3520 |
|
is-new-feed has-new-items) |
3521 |
|
(setq is-new-feed (newsticker--parse-generic-feed |
3522 |
|
name time |
3523 |
|
;; title |
3524 |
|
(car (xml-node-children |
3525 |
|
(car (xml-get-children channelnode 'title)))) |
3526 |
|
;; desc |
3527 |
|
(car (xml-node-children |
3528 |
|
(car (xml-get-children channelnode |
3529 |
|
'description)))) |
3530 |
|
;; link |
3531 |
|
(car (xml-node-children |
3532 |
|
(car (xml-get-children channelnode 'link)))) |
3533 |
|
;; extra-elements |
3534 |
|
(xml-node-children channelnode))) |
3535 |
|
(setq has-new-items (newsticker--parse-generic-items |
3536 |
|
name time (xml-get-children channelnode 'item) |
3537 |
|
;; title-fn |
3538 |
|
(lambda (node) |
3539 |
|
(car (xml-node-children |
3540 |
|
(car (xml-get-children node 'title))))) |
3541 |
|
;; desc-fn |
3542 |
|
(lambda (node) |
3543 |
|
(car (xml-node-children |
3544 |
|
(car (xml-get-children node 'description))))) |
3545 |
|
;; link-fn |
3546 |
|
(lambda (node) |
3547 |
|
(car (xml-node-children |
3548 |
|
(car (xml-get-children node 'link))))) |
3549 |
|
;; time-fn |
3550 |
|
(lambda (node) |
3551 |
|
pub-date) |
3552 |
|
;; guid-fn |
3553 |
|
(lambda (node) |
3554 |
|
nil) |
3555 |
|
;; extra-fn |
3556 |
|
(lambda (node) |
3557 |
|
(xml-node-children node)))) |
3558 |
|
(or has-new-items is-new-feed))) |
3559 |
|
|
3560 |
|
(defun newsticker--parse-rss-0.92 (name time topnode) |
3561 |
|
"Parse RSS 0.92 data. |
3562 |
|
Return value as well as arguments NAME, TIME, and TOPNODE are the |
3563 |
|
same as in `newsticker--parse-atom-1.0'. |
3564 |
|
|
3565 |
|
For the RSS 0.92 specification see http://backend.userland.com/rss092." |
3566 |
|
(newsticker--debug-msg "Parsing RSS 0.92 feed %s" name) |
3567 |
|
(let* ((channelnode (car (xml-get-children topnode 'channel))) |
3568 |
|
(pub-date (newsticker--decode-rfc822-date |
3569 |
|
(car (xml-node-children |
3570 |
|
(car (xml-get-children channelnode 'pubDate)))))) |
3571 |
|
is-new-feed has-new-items) |
3572 |
|
(setq is-new-feed (newsticker--parse-generic-feed |
3573 |
|
name time |
3574 |
|
;; title |
3575 |
|
(car (xml-node-children |
3576 |
|
(car (xml-get-children channelnode 'title)))) |
3577 |
|
;; desc |
3578 |
|
(car (xml-node-children |
3579 |
|
(car (xml-get-children channelnode |
3580 |
|
'description)))) |
3581 |
|
;; link |
3582 |
|
(car (xml-node-children |
3583 |
|
(car (xml-get-children channelnode 'link)))) |
3584 |
|
;; extra-elements |
3585 |
|
(xml-node-children channelnode))) |
3586 |
|
(setq has-new-items (newsticker--parse-generic-items |
3587 |
|
name time (xml-get-children channelnode 'item) |
3588 |
|
;; title-fn |
3589 |
|
(lambda (node) |
3590 |
|
(car (xml-node-children |
3591 |
|
(car (xml-get-children node 'title))))) |
3592 |
|
;; desc-fn |
3593 |
|
(lambda (node) |
3594 |
|
(car (xml-node-children |
3595 |
|
(car (xml-get-children node 'description))))) |
3596 |
|
;; link-fn |
3597 |
|
(lambda (node) |
3598 |
|
(car (xml-node-children |
3599 |
|
(car (xml-get-children node 'link))))) |
3600 |
|
;; time-fn |
3601 |
|
(lambda (node) |
3602 |
|
pub-date) |
3603 |
|
;; guid-fn |
3604 |
|
(lambda (node) |
3605 |
|
nil) |
3606 |
|
;; extra-fn |
3607 |
|
(lambda (node) |
3608 |
|
(xml-node-children node)))) |
3609 |
|
(or has-new-items is-new-feed))) |
3610 |
|
|
3611 |
|
(defun newsticker--parse-rss-1.0 (name time topnode) |
3612 |
|
"Parse RSS 1.0 data. |
3613 |
|
Return value as well as arguments NAME, TIME, and |
3614 |
|
TOPNODE are the same as in `newsticker--parse-atom-1.0'. |
3615 |
|
|
3616 |
|
For the RSS 1.0 specification see http://web.resource.org/rss/1.0/spec." |
3617 |
|
(newsticker--debug-msg "Parsing RSS 1.0 feed %s" name) |
3618 |
|
(let* ((channelnode (car (xml-get-children topnode 'channel))) |
3619 |
|
is-new-feed has-new-items) |
3620 |
|
(setq is-new-feed (newsticker--parse-generic-feed |
3621 |
|
name time |
3622 |
|
;; title |
3623 |
|
(car (xml-node-children |
3624 |
|
(car (xml-get-children channelnode 'title)))) |
3625 |
|
;; desc |
3626 |
|
(car (xml-node-children |
3627 |
|
(car (xml-get-children channelnode |
3628 |
|
'description)))) |
3629 |
|
;; link |
3630 |
|
(car (xml-node-children |
3631 |
|
(car (xml-get-children channelnode 'link)))) |
3632 |
|
;; extra-elements |
3633 |
|
(xml-node-children channelnode))) |
3634 |
|
(setq has-new-items (newsticker--parse-generic-items |
3635 |
|
name time (xml-get-children topnode 'item) |
3636 |
|
;; title-fn |
3637 |
|
(lambda (node) |
3638 |
|
(car (xml-node-children |
3639 |
|
(car (xml-get-children node 'title))))) |
3640 |
|
;; desc-fn |
3641 |
|
(lambda (node) |
3642 |
|
(car (xml-node-children |
3643 |
|
(car (xml-get-children node |
3644 |
|
'description))))) |
3645 |
|
;; link-fn |
3646 |
|
(lambda (node) |
3647 |
|
(car (xml-node-children |
3648 |
|
(car (xml-get-children node 'link))))) |
3649 |
|
;; time-fn |
3650 |
|
(lambda (node) |
3651 |
|
(newsticker--decode-iso8601-date |
3652 |
|
(car (xml-node-children |
3653 |
|
(car (xml-get-children node 'dc:date)))))) |
3654 |
|
;; guid-fn |
3655 |
|
(lambda (node) |
3656 |
|
nil) |
3657 |
|
;; extra-fn |
3658 |
|
(lambda (node) |
3659 |
|
(xml-node-children node)))) |
3660 |
|
(or has-new-items is-new-feed))) |
3661 |
|
|
3662 |
|
(defun newsticker--parse-rss-2.0 (name time topnode) |
3663 |
|
"Parse RSS 2.0 data. |
3664 |
|
Return value as well as arguments NAME, TIME, and TOPNODE are the |
3665 |
|
same as in `newsticker--parse-atom-1.0'. |
3666 |
|
|
3667 |
|
For the RSS 2.0 specification see http://blogs.law.harvard.edu/tech/rss." |
3668 |
|
(newsticker--debug-msg "Parsing RSS 2.0 feed %s" name) |
3669 |
|
(let* ((channelnode (car (xml-get-children topnode 'channel))) |
3670 |
|
is-new-feed has-new-items) |
3671 |
|
(setq is-new-feed (newsticker--parse-generic-feed |
3672 |
|
name time |
3673 |
|
;; title |
3674 |
|
(car (xml-node-children |
3675 |
|
(car (xml-get-children channelnode 'title)))) |
3676 |
|
;; desc |
3677 |
|
(car (xml-node-children |
3678 |
|
(car (xml-get-children channelnode |
3679 |
|
'description)))) |
3680 |
|
;; link |
3681 |
|
(car (xml-node-children |
3682 |
|
(car (xml-get-children channelnode 'link)))) |
3683 |
|
;; extra-elements |
3684 |
|
(xml-node-children channelnode))) |
3685 |
|
(setq has-new-items (newsticker--parse-generic-items |
3686 |
|
name time (xml-get-children channelnode 'item) |
3687 |
|
;; title-fn |
3688 |
|
(lambda (node) |
3689 |
|
(car (xml-node-children |
3690 |
|
(car (xml-get-children node 'title))))) |
3691 |
|
;; desc-fn |
3692 |
|
(lambda (node) |
3693 |
|
(or (car (xml-node-children |
3694 |
|
(car (xml-get-children node |
3695 |
|
'content:encoded)))) |
3696 |
|
(car (xml-node-children |
3697 |
|
(car (xml-get-children node |
3698 |
|
'description)))))) |
3699 |
|
;; link-fn |
3700 |
|
(lambda (node) |
3701 |
|
(car (xml-node-children |
3702 |
|
(car (xml-get-children node 'link))))) |
3703 |
|
;; time-fn |
3704 |
|
(lambda (node) |
3705 |
|
(newsticker--decode-rfc822-date |
3706 |
|
(car (xml-node-children |
3707 |
|
(car (xml-get-children node 'pubDate)))))) |
3708 |
|
;; guid-fn |
3709 |
|
(lambda (node) |
3710 |
|
(let* ((tguid (assoc 'guid |
3711 |
|
(xml-node-children node)))) |
3712 |
|
(if (stringp tguid) |
3713 |
|
tguid |
3714 |
|
(car (xml-node-children tguid))))) |
3715 |
|
;; extra-fn |
3716 |
|
(lambda (node) |
3717 |
|
(xml-node-children node)))) |
3718 |
|
(or has-new-items is-new-feed))) |
3719 |
|
|
3720 |
|
(defun newsticker--parse-generic-feed (name time title desc link |
3721 |
|
extra-elements) |
3722 |
|
"Parse generic news feed data. |
3723 |
|
Argument NAME gives the name of a news feed. TIME gives the |
3724 |
|
system time at which the data have been retrieved. CHANNELNODE |
3725 |
|
is the node in the feed data which contains the description, link |
3726 |
|
etc. of the feed itself. |
3727 |
|
|
3728 |
|
The arguments TITLE, DESC, LINK, and EXTRA-ELEMENTS give the feed's title, |
3729 |
|
description, link, and extra elements resp." |
3730 |
|
(let ((title (or title "[untitled]")) |
3731 |
|
(link (or link "")) |
3732 |
|
(old-item nil) |
3733 |
|
(position 0) |
3734 |
|
(something-was-added nil)) |
3735 |
|
;; decode numeric entities |
3736 |
|
(setq title (newsticker--decode-numeric-entities title)) |
3737 |
|
(setq desc (newsticker--decode-numeric-entities desc)) |
3738 |
|
(setq link (newsticker--decode-numeric-entities link)) |
3739 |
|
;; remove whitespace from title, desc, and link |
3740 |
|
(setq title (newsticker--remove-whitespace title)) |
3741 |
|
(setq desc (newsticker--remove-whitespace desc)) |
3742 |
|
(setq link (newsticker--remove-whitespace link)) |
3743 |
|
|
3744 |
|
;; handle the feed itself |
3745 |
|
(unless (newsticker--cache-contains newsticker--cache |
3746 |
|
(intern name) title |
3747 |
|
desc link 'feed) |
3748 |
|
(setq something-was-added t)) |
3749 |
|
(setq newsticker--cache |
3750 |
|
(newsticker--cache-add newsticker--cache (intern name) |
3751 |
|
title desc link time 'feed position |
3752 |
|
extra-elements 'feed time)) |
3753 |
|
something-was-added)) |
3754 |
|
|
3755 |
|
(defun newsticker--parse-generic-items (name time itemlist |
3756 |
|
title-fn desc-fn |
3757 |
|
link-fn time-fn |
3758 |
|
guid-fn extra-fn) |
3759 |
|
"Parse generic news feed data. |
3760 |
|
Argument NAME gives the name of a news feed. TIME gives the |
3761 |
|
system time at which the data have been retrieved. ITEMLIST |
3762 |
|
contains the news items returned by the xml parser. |
3763 |
|
|
3764 |
|
The arguments TITLE-FN, DESC-FN, LINK-FN, TIME-FN, GUID-FN, and |
3765 |
|
EXTRA-FN give functions for extracting title, description, link, |
3766 |
|
time, guid, and extra-elements resp. They are called with one |
3767 |
|
argument, which is one of the items in ITEMLIST." |
3768 |
|
(let (title desc link |
3769 |
|
(old-item nil) |
3770 |
|
(position 0) |
3771 |
|
(something-was-added nil)) |
3772 |
|
;; gather all items for this feed |
3773 |
|
(mapc (lambda (node) |
3774 |
|
(setq position (1+ position)) |
3775 |
|
(setq title (or (funcall title-fn node) "[untitled]")) |
3776 |
|
(setq desc (funcall desc-fn node)) |
3777 |
|
(setq link (or (funcall link-fn node) "")) |
3778 |
|
(setq time (or (funcall time-fn node) time)) |
3779 |
|
;; It happened that the title or description |
3780 |
|
;; contained evil HTML code that confused the |
3781 |
|
;; xml parser. Therefore: |
3782 |
|
(unless (stringp title) |
3783 |
|
(setq title (prin1-to-string title))) |
3784 |
|
(unless (or (stringp desc) (not desc)) |
3785 |
|
(setq desc (prin1-to-string desc))) |
3786 |
|
;; ignore items with empty title AND empty desc |
3787 |
|
(when (or (> (length title) 0) |
3788 |
|
(> (length desc) 0)) |
3789 |
|
;; decode numeric entities |
3790 |
|
(setq title (newsticker--decode-numeric-entities title)) |
3791 |
|
(when desc |
3792 |
|
(setq desc (newsticker--decode-numeric-entities desc))) |
3793 |
|
(setq link (newsticker--decode-numeric-entities link)) |
3794 |
|
;; remove whitespace from title, desc, and link |
3795 |
|
(setq title (newsticker--remove-whitespace title)) |
3796 |
|
(setq desc (newsticker--remove-whitespace desc)) |
3797 |
|
(setq link (newsticker--remove-whitespace link)) |
3798 |
|
;; add data to cache |
3799 |
|
;; do we have this item already? |
3800 |
|
(let* ((guid (funcall guid-fn node))) |
3801 |
|
;;(message "guid=%s" guid) |
3802 |
|
(setq old-item |
3803 |
|
(newsticker--cache-contains newsticker--cache |
3804 |
|
(intern name) title |
3805 |
|
desc link nil guid))) |
3806 |
|
;; add this item, or mark it as old, or do nothing |
3807 |
|
(let ((age1 'new) |
3808 |
|
(age2 'old) |
3809 |
|
(item-new-p nil)) |
3810 |
|
(if old-item |
3811 |
|
(let ((prev-age (newsticker--age old-item))) |
3812 |
|
(unless |
3813 |
|
newsticker-automatically-mark-items-as-old |
3814 |
|
(if (eq prev-age 'obsolete-old) |
3815 |
|
(setq age2 'old) |
3816 |
|
(setq age2 'new))) |
3817 |
|
(if (eq prev-age 'immortal) |
3818 |
|
(setq age2 'immortal))) |
3819 |
|
;; item was not there |
3820 |
|
(setq item-new-p t) |
3821 |
|
(setq something-was-added t)) |
3822 |
|
(setq newsticker--cache |
3823 |
|
(newsticker--cache-add |
3824 |
|
newsticker--cache (intern name) title desc link |
3825 |
|
time age1 position (funcall extra-fn node) |
3826 |
|
age2)) |
3827 |
|
(when item-new-p |
3828 |
|
(let ((item (newsticker--cache-contains |
3829 |
|
newsticker--cache (intern name) title |
3830 |
|
desc link nil))) |
3831 |
|
(if newsticker-auto-mark-filter-list |
3832 |
|
(newsticker--run-auto-mark-filter name item)) |
3833 |
|
(run-hook-with-args |
3834 |
|
'newsticker-new-item-functions name item)))))) |
3835 |
|
itemlist) |
3836 |
|
something-was-added)) |
3837 |
|
|
3838 |
(defun newsticker--display-tick () |
(defun newsticker--display-tick () |
3839 |
"Called from the display timer. |
"Called from the display timer. |
3840 |
This function calls a display function, according to the variable |
This function calls a display function, according to the variable |
3907 |
;; ====================================================================== |
;; ====================================================================== |
3908 |
;;; misc |
;;; misc |
3909 |
;; ====================================================================== |
;; ====================================================================== |
|
(defun newsticker--decode-coding-string (string coding-system) |
|
|
"Wrapper around `decode-coding-string'. |
|
|
This functions passes the arguments STRING and CODING-SYSTEM to |
|
|
`decode-coding-string'. If the decoding is successful the |
|
|
decoded string is returned, otherwise the unmodified input string |
|
|
is returned." |
|
|
(condition-case nil |
|
|
(decode-coding-string string coding-system) |
|
|
(error |
|
|
(message "Cannot decode encoded string `%s'" string) |
|
|
string))) |
|
|
|
|
3910 |
(defun newsticker--decode-numeric-entities (string) |
(defun newsticker--decode-numeric-entities (string) |
3911 |
"Decode SGML numeric entities by their respective utf characters. |
"Decode SGML numeric entities by their respective utf characters. |
3912 |
This function replaces numeric entities in the input STRING and |
This function replaces numeric entities in the input STRING and |
3913 |
returns the modified string. For example \"*\" gets replaced |
returns the modified string. For example \"*\" gets replaced |
3914 |
by \"*\"." |
by \"*\"." |
3915 |
(let ((start 0)) |
(if (and string (stringp string)) |
3916 |
(while (string-match "&#\\([0-9]+\\);" string start) |
(let ((start 0)) |
3917 |
(condition-case nil |
(while (string-match "&#\\([0-9]+\\);" string start) |
3918 |
(setq string (replace-match |
(condition-case nil |
3919 |
(string (read (substring string (match-beginning 1) |
(setq string (replace-match |
3920 |
(match-end 1)))) |
(string (read (substring string |
3921 |
nil nil string)) |
(match-beginning 1) |
3922 |
(error nil)) |
(match-end 1)))) |
3923 |
(setq start (1+ (match-beginning 0)))) |
nil nil string)) |
3924 |
string)) |
(error nil)) |
3925 |
|
(setq start (1+ (match-beginning 0)))) |
3926 |
|
string) |
3927 |
|
nil)) |
3928 |
|
|
3929 |
(defun newsticker--remove-whitespace (string) |
(defun newsticker--remove-whitespace (string) |
3930 |
"Remove leading and trailing whitespace from STRING." |
"Remove leading and trailing whitespace from STRING." |
3931 |
;; we must have ...+ but not ...* in the regexps otherwise xemacs loops |
;; we must have ...+ but not ...* in the regexps otherwise xemacs loops |
3932 |
;; endlessly... |
;; endlessly... |
3933 |
(when string |
(when (and string (stringp string)) |
3934 |
(replace-regexp-in-string |
(replace-regexp-in-string |
3935 |
"[ \t\r\n]+$" "" |
"[ \t\r\n]+$" "" |
3936 |
(replace-regexp-in-string "^[ \t\r\n]+" "" string)))) |
(replace-regexp-in-string "^[ \t\r\n]+" "" string)))) |
3937 |
|
|
3938 |
(defun newsticker--do-forget-preformatted (item) |
(defun newsticker--do-forget-preformatted (item) |
3939 |
"Forget all cached pre-formatted data. |
"Forget pre-formatted data for ITEM. |
3940 |
Remove the pre-formatted from `newsticker--cache'." |
Remove the pre-formatted from `newsticker--cache'." |
3941 |
(if (nthcdr 7 item) |
(if (nthcdr 7 item) |
3942 |
(setcar (nthcdr 7 item) nil)) |
(setcar (nthcdr 7 item) nil)) |
4020 |
Converts from RFC822 to Emacs representation. |
Converts from RFC822 to Emacs representation. |
4021 |
Examples: |
Examples: |
4022 |
Sat, 07 Sep 2002 00:00:01 GMT |
Sat, 07 Sep 2002 00:00:01 GMT |
4023 |
07 Sep 2002 00:00:01 GMT" |
07 Sep 2002 00:00:01 GMT |
4024 |
(if rfc822-string |
07 Sep 2002" |
4025 |
|
(if (and rfc822-string (stringp rfc822-string)) |
4026 |
(when (string-match |
(when (string-match |
4027 |
(concat |
(concat |
4028 |
"\\s-*" |
"\\s-*" |
4029 |
;; week day |
;; week day |
4030 |
"\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)\\s-+" |
"\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)?\\s-*" |
4031 |
;; day |
;; day |
4032 |
"\\([0-9]\\{1,2\\}\\)\\s-+" |
"\\([0-9]\\{1,2\\}\\)\\s-+" |
4033 |
;; month |
;; month |
4034 |
"\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|" |
"\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|" |
4035 |
"Sep\\|Oct\\|Nov\\|Dec\\)\\s-+" |
"Sep\\|Oct\\|Nov\\|Dec\\)\\s-+" |
4036 |
;; year |
;; year |
4037 |
"\\([0-9]\\{2,4\\}\\)\\s-+" |
"\\([0-9]\\{2,4\\}\\)" |
4038 |
|
;; time may be missing |
4039 |
|
"\\(\\s-+" |
4040 |
;; hour |
;; hour |
4041 |
"\\([0-9]\\{2\\}\\)" |
"\\([0-9]\\{2\\}\\)" |
4042 |
;; minute |
;; minute |
4044 |
;; second |
;; second |
4045 |
"\\(:\\([0-9]\\{2\\}\\)\\)?" |
"\\(:\\([0-9]\\{2\\}\\)\\)?" |
4046 |
;; zone -- fixme |
;; zone -- fixme |
4047 |
"\\(\\s-+.*\\)?") |
"\\(\\s-+.*\\)?" |
4048 |
|
"\\)?") |
4049 |
rfc822-string) |
rfc822-string) |
4050 |
(let ((day (read (match-string 3 rfc822-string))) |
(let ((day (read (match-string 3 rfc822-string))) |
4051 |
(month-name (match-string 4 rfc822-string)) |
(month-name (match-string 4 rfc822-string)) |
4052 |
(month 0) |
(month 0) |
4053 |
(year (read (match-string 5 rfc822-string))) |
(year (read (match-string 5 rfc822-string))) |
4054 |
(hour (read (match-string 6 rfc822-string))) |
(hour (read (or (match-string 7 rfc822-string) "0"))) |
4055 |
(minute (read (match-string 7 rfc822-string))) |
(minute (read (or (match-string 8 rfc822-string) "0"))) |
4056 |
(second (read (or (match-string 9 rfc822-string) |
(second (read (or (match-string 10 rfc822-string) "0"))) |
4057 |
"0"))) |
;;(zone (match-string 11 rfc822-string)) |
|
;;(zone (match-string 10 rfc822-string)) |
|
4058 |
) |
) |
4059 |
(condition-case error-data |
(condition-case error-data |
4060 |
(let ((i 1)) |
(let ((i 1)) |
4080 |
list1) |
list1) |
4081 |
result)) |
result)) |
4082 |
|
|
4083 |
|
(defun newsticker--update-process-ids () |
4084 |
|
"Update list of ids of active newsticker processes. |
4085 |
|
Checks list of active processes against list of newsticker processes." |
4086 |
|
(let ((active-procs (process-list)) |
4087 |
|
(new-list nil)) |
4088 |
|
(mapc (lambda (proc) |
4089 |
|
(let ((id (process-id proc))) |
4090 |
|
(if (memq id newsticker--process-ids) |
4091 |
|
(setq new-list (cons id new-list))))) |
4092 |
|
active-procs) |
4093 |
|
(setq newsticker--process-ids new-list)) |
4094 |
|
(force-mode-line-update)) |
4095 |
|
|
4096 |
;; ====================================================================== |
;; ====================================================================== |
4097 |
;;; images |
;;; images |
4098 |
;; ====================================================================== |
;; ====================================================================== |
4139 |
(let* ((p-status (process-status process)) |
(let* ((p-status (process-status process)) |
4140 |
(exit-status (process-exit-status process)) |
(exit-status (process-exit-status process)) |
4141 |
(feed-name (process-name process))) |
(feed-name (process-name process))) |
4142 |
;; catch known errors (zombie processes, rubbish-xml etc. |
;; catch known errors (zombie processes, rubbish-xml, etc.) |
4143 |
;; if an error occurs the news feed is not updated! |
;; if an error occurs the news feed is not updated! |
4144 |
(catch 'oops |
(catch 'oops |
4145 |
(unless (and (eq p-status 'exit) |
(unless (and (eq p-status 'exit) |
4184 |
'heuristic) |
'heuristic) |
4185 |
:ascent 70)) |
:ascent 70)) |
4186 |
(error |
(error |
4187 |
(message "Error: cannot create image: %s" |
(message "Error: cannot create image for %s: %s" |
4188 |
(cadr error-data))))) |
feed-name-symbol error-data)))) |
4189 |
img)) |
img)) |
4190 |
|
|
4191 |
;; ====================================================================== |
;; ====================================================================== |
4218 |
index-alist))) |
index-alist))) |
4219 |
|
|
4220 |
(defun newsticker--imenu-goto (name pos &rest args) |
(defun newsticker--imenu-goto (name pos &rest args) |
4221 |
"Go item NAME at position POS and show item. |
"Go to item NAME at position POS and show item. |
4222 |
ARGS are ignored." |
ARGS are ignored." |
4223 |
(goto-char pos) |
(goto-char pos) |
4224 |
|
;; show headline |
4225 |
|
(newsticker--buffer-goto '(desc extra feed item)) |
4226 |
|
(let* ((inhibit-read-only t) |
4227 |
|
(pos1 (max (point-min) (1- pos))) |
4228 |
|
(pos2 (max pos1 (1- (point)))) |
4229 |
|
(inv-prop (get-text-property pos 'invisible)) |
4230 |
|
(org-inv-prop (get-text-property pos 'org-invisible))) |
4231 |
|
(when (eq org-inv-prop nil) |
4232 |
|
(add-text-properties pos1 pos2 (list 'invisible nil |
4233 |
|
'org-invisible inv-prop)))) |
4234 |
|
;; show desc |
4235 |
(newsticker-show-entry)) |
(newsticker-show-entry)) |
4236 |
|
|
4237 |
;; ====================================================================== |
;; ====================================================================== |
4248 |
(if value |
(if value |
4249 |
(setq mode-name "Newsticker -- up to date -- ") |
(setq mode-name "Newsticker -- up to date -- ") |
4250 |
(setq mode-name "Newsticker -- NEED UPDATE -- "))) |
(setq mode-name "Newsticker -- NEED UPDATE -- "))) |
4251 |
(sit-for 0)))) |
(force-mode-line-update 0)))) |
4252 |
|
|
4253 |
(defun newsticker--buffer-redraw () |
(defun newsticker--buffer-redraw () |
4254 |
"Sometimes (CVS) Emacs forgets to update the window..." |
"Sometimes (CVS) Emacs forgets to update the window..." |
4457 |
(error |
(error |
4458 |
(message "Error: HTML rendering failed: %s, %s" |
(message "Error: HTML rendering failed: %s, %s" |
4459 |
(car error-data) (cdr error-data))))) |
(car error-data) (cdr error-data))))) |
4460 |
|
;; After html rendering there might be chunks of blank |
4461 |
|
;; characters between rendered text and date, statistics or |
4462 |
|
;; whatever. Remove it |
4463 |
|
(when (and (eq type 'item) is-rendered-HTML) |
4464 |
|
(goto-char pos) |
4465 |
|
(while (re-search-forward "[ \t]*\n[ \t]*" nil t) |
4466 |
|
(replace-match " " nil nil)) |
4467 |
|
(goto-char (point-max))) |
4468 |
(when (and newsticker-justification |
(when (and newsticker-justification |
4469 |
(eq type 'desc) |
(eq type 'desc) |
4470 |
(not is-rendered-HTML)) |
(not is-rendered-HTML)) |
4473 |
(fill-region pos (point-max) newsticker-justification)) |
(fill-region pos (point-max) newsticker-justification)) |
4474 |
(error nil)))) |
(error nil)))) |
4475 |
|
|
4476 |
;; remove leading and trailing newlines |
;; remove leading and trailing newlines |
4477 |
(goto-char pos) |
(goto-char pos) |
4478 |
(unless (= 0 (skip-chars-forward " \t\r\n")) |
(unless (= 0 (skip-chars-forward " \t\r\n")) |
4479 |
(delete-region pos (point))) |
(delete-region pos (point))) |
4482 |
(unless (= 0 (skip-chars-backward " \t\r\n" (1+ pos))) |
(unless (= 0 (skip-chars-backward " \t\r\n" (1+ pos))) |
4483 |
(delete-region (point) end))) |
(delete-region (point) end))) |
4484 |
(goto-char (point-max)) |
(goto-char (point-max)) |
|
|
|
4485 |
;; closing newline |
;; closing newline |
4486 |
(unless nil ;;(eq pos (point)) |
(unless nil ;;(eq pos (point)) |
4487 |
(insert "\n") |
(insert "\n") |
4497 |
(when (eq type 'desc) |
(when (eq type 'desc) |
4498 |
(goto-char (point-max)) |
(goto-char (point-max)) |
4499 |
(setq pos-extra-start (point)) |
(setq pos-extra-start (point)) |
4500 |
(mapc (lambda (extra-element) |
(newsticker--buffer-print-extra-elements item) |
|
(unless (memq (car extra-element) |
|
|
'(items link title description |
|
|
content:encoded |
|
|
dc:subject dc:date item guid |
|
|
pubDate |
|
|
enclosure)) |
|
|
(newsticker--buffer-print-extra-element |
|
|
extra-element))) |
|
|
(newsticker--extra item)) |
|
4501 |
(setq pos-extra-end (point))) |
(setq pos-extra-end (point))) |
4502 |
|
|
4503 |
;; text properties |
;; text properties |
4546 |
(newsticker--cache-set-preformatted-title |
(newsticker--cache-set-preformatted-title |
4547 |
item (buffer-substring pos (point))))))))) |
item (buffer-substring pos (point))))))))) |
4548 |
|
|
4549 |
(defun newsticker--buffer-print-extra-element (extra-element) |
(defun newsticker--buffer-print-extra-elements (item) |
4550 |
"Insert EXTRA-ELEMENT in a pretty form into the current buffer." |
"Insert extra-elements of ITEM in a pretty form into the current buffer." |
4551 |
(insert (format "%s:\t" (car extra-element))) |
(let ((ignored-elements '(items link title description |
4552 |
|
content:encoded |
4553 |
|
dc:subject dc:date item guid |
4554 |
|
pubDate enclosure)) |
4555 |
|
(left-column-width 1)) |
4556 |
|
(mapc (lambda (extra-element) |
4557 |
|
(unless (memq (car extra-element) ignored-elements) |
4558 |
|
(setq left-column-width (max left-column-width |
4559 |
|
(length (symbol-name |
4560 |
|
(car extra-element))))))) |
4561 |
|
(newsticker--extra item)) |
4562 |
|
(mapc (lambda (extra-element) |
4563 |
|
(unless (memq (car extra-element) ignored-elements) |
4564 |
|
(newsticker--buffer-do-print-extra-element extra-element |
4565 |
|
left-column-width))) |
4566 |
|
(newsticker--extra item)))) |
4567 |
|
|
4568 |
|
(defun newsticker--buffer-do-print-extra-element (extra-element width) |
4569 |
|
"Actually print an EXTRA-ELEMENT using the given WIDTH." |
4570 |
|
(let ((name (symbol-name (car extra-element)))) |
4571 |
|
(insert (format "%s: " name)) |
4572 |
|
(insert (make-string (- width (length name)) ? ))) |
4573 |
(let (;;(attributes (cadr extra-element)) ;FIXME!!!! |
(let (;;(attributes (cadr extra-element)) ;FIXME!!!! |
4574 |
(contents (cddr extra-element))) |
(contents (cddr extra-element))) |
4575 |
(cond ((listp contents) |
(cond ((listp contents) |
4593 |
(insert "\n"))) |
(insert "\n"))) |
4594 |
|
|
4595 |
(defun newsticker--buffer-insert-enclosure (item) |
(defun newsticker--buffer-insert-enclosure (item) |
4596 |
"Insert enclosure element of an RSS ITEM into the current buffer." |
"Insert enclosure element of a news ITEM into the current buffer." |
4597 |
(let ((enclosure (newsticker--enclosure item)) |
(let ((enclosure (newsticker--enclosure item)) |
4598 |
(beg (point))) |
(beg (point))) |
4599 |
(when enclosure |
(when enclosure |
4600 |
(let ((url (cdr (assoc 'url enclosure))) |
(let ((url (cdr (assoc 'url enclosure))) |
4601 |
(length (cdr (assoc 'length enclosure))) |
(length (string-to-number (cdr (assoc 'length enclosure)))) |
4602 |
(type (cdr (assoc 'type enclosure)))) |
(type (cdr (assoc 'type enclosure)))) |
4603 |
(insert (format "Enclosed file (%s, %1.2f kBytes)" type |
(cond ((> length 1048576) |
4604 |
(/ (string-to-number length) 1024))) |
(insert (format "Enclosed file (%s, %1.2f MBytes)" type |
4605 |
|
(/ length 1048576)))) |
4606 |
|
((> length 1024) |
4607 |
|
(insert (format "Enclosed file (%s, %1.2f KBytes)" type |
4608 |
|
(/ length 1024))))) |
4609 |
(add-text-properties beg (point) |
(add-text-properties beg (point) |
4610 |
(list 'mouse-face 'highlight |
(list 'mouse-face 'highlight |
4611 |
'nt-link url |
'nt-link url |
5315 |
;; ====================================================================== |
;; ====================================================================== |
5316 |
(defun newsticker--run-auto-mark-filter (feed item) |
(defun newsticker--run-auto-mark-filter (feed item) |
5317 |
"Automatically mark an item as old or immortal. |
"Automatically mark an item as old or immortal. |
5318 |
This function checks the variable `newsticker-auto-mark-filter' |
This function checks the variable `newsticker-auto-mark-filter-list' |
5319 |
for an entry that matches FEED and ITEM." |
for an entry that matches FEED and ITEM." |
5320 |
(let ((case-fold-search t)) |
(let ((case-fold-search t)) |
5321 |
(mapc (lambda (filter) |
(mapc (lambda (filter) |
5322 |
(let ((filter-feed (car filter)) |
(let ((filter-feed (car filter)) |
5323 |
(old-list (nth 1 filter)) |
(pattern-list (cadr filter))) |
|
(imm-list (nth 2 filter))) |
|
5324 |
(when (string-match filter-feed feed) |
(when (string-match filter-feed feed) |
5325 |
(newsticker--do-run-auto-mark-filter item 'old old-list) |
(newsticker--do-run-auto-mark-filter item pattern-list)))) |
5326 |
(newsticker--do-run-auto-mark-filter item 'immortal imm-list)))) |
newsticker-auto-mark-filter-list))) |
|
newsticker-auto-mark-filter))) |
|
5327 |
|
|
5328 |
(defun newsticker--do-run-auto-mark-filter (item age list) |
(defun newsticker--do-run-auto-mark-filter (item list) |
5329 |
"Actually compare ITEM AGE LIST against `newsticker-auto-mark-filter'." |
"Actually compare ITEM AGE LIST against `newsticker-auto-mark-filter-list'." |
5330 |
(mapc (lambda (pattern) |
(mapc (lambda (pattern) |
5331 |
(when (string-match pattern (newsticker--title item)) |
(let ((age (nth 0 pattern)) |
5332 |
(setcar (nthcdr 4 item) age))) |
(place (nth 1 pattern)) |
5333 |
|
(regexp (nth 2 pattern)) |
5334 |
|
(title (newsticker--title item)) |
5335 |
|
(desc (newsticker--desc item))) |
5336 |
|
(when (or (eq place 'title) (eq place 'all)) |
5337 |
|
(when (and title (string-match regexp title)) |
5338 |
|
(newsticker--debug-msg "Auto-marking as %s: `%s'" |
5339 |
|
age (newsticker--title item)) |
5340 |
|
(setcar (nthcdr 4 item) age))) |
5341 |
|
(when (or (eq place 'description) (eq place 'all)) |
5342 |
|
(when (and desc (string-match regexp desc)) |
5343 |
|
(newsticker--debug-msg "Auto-marking as %s: `%s'" |
5344 |
|
age (newsticker--title item)) |
5345 |
|
(setcar (nthcdr 4 item) age))))) |
5346 |
list)) |
list)) |
5347 |
|
|
5348 |
|
|