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