95675
|
1 ;;; newsticker-backend.el --- Retrieval backend for newsticker.
|
|
2
|
|
3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; This file is part of GNU Emacs.
|
|
6
|
|
7 ;; Author: Ulf Jasper <ulf.jasper@web.de>
|
|
8 ;; Filename: newsticker-backend.el
|
|
9 ;; URL: http://www.nongnu.org/newsticker
|
|
10 ;; Keywords: News, RSS, Atom
|
|
11 ;; Time-stamp: "8. Juni 2008, 17:18:04 (ulf)"
|
|
12 ;; CVS-Version: $Id: newsticker-backend.el,v 1.16 2008/05/09 17:42:22 u11 Exp $
|
|
13
|
|
14 ;; ======================================================================
|
|
15
|
|
16 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
17 ;; it under the terms of the GNU General Public License as published by
|
|
18 ;; the Free Software Foundation, either version 3 of the License, or
|
|
19 ;; (at your option) any later version.
|
|
20
|
|
21 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
24 ;; GNU General Public License for more details.
|
|
25
|
|
26 ;; You should have received a copy of the GNU General Public License
|
|
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
28
|
|
29 ;; ======================================================================
|
|
30
|
|
31 ;;; Commentary:
|
|
32
|
|
33 ;; See newsticker.el
|
|
34
|
|
35 ;; ======================================================================
|
|
36 ;;; Code:
|
|
37
|
|
38 (require 'derived)
|
|
39 (require 'xml)
|
|
40
|
|
41 ;; Silence warnings
|
|
42 (defvar tool-bar-map)
|
|
43 (defvar w3-mode-map)
|
|
44 (defvar w3m-minor-mode-map)
|
|
45
|
|
46
|
|
47 (defvar newsticker--retrieval-timer-list nil
|
|
48 "List of timers for news retrieval.
|
|
49 This is an alist, each element consisting of (feed-name . timer).")
|
|
50
|
|
51 (defvar newsticker--download-logos nil
|
|
52 "If non-nil download feed logos if available.")
|
|
53
|
|
54 (defvar newsticker--sentinel-callback nil
|
|
55 "Function called at end of `newsticker--sentinel'.")
|
|
56
|
|
57 ;;;###autoload
|
|
58 (defun newsticker-running-p ()
|
|
59 "Check whether newsticker is running.
|
|
60 Return t if newsticker is running, nil otherwise. Newsticker is
|
|
61 considered to be running if the newsticker timer list is not empty."
|
|
62 (> (length newsticker--retrieval-timer-list) 0))
|
|
63
|
|
64 ;; ======================================================================
|
|
65 ;;; Customization
|
|
66 ;; ======================================================================
|
|
67 (defgroup newsticker nil
|
|
68 "Aggregator for RSS and Atom feeds."
|
|
69 :group 'applications)
|
|
70
|
|
71 (defconst newsticker--raw-url-list-defaults
|
|
72 '(("CNET News.com"
|
|
73 "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
|
|
74 ("Debian Security Advisories"
|
|
75 "http://www.debian.org/security/dsa.en.rdf")
|
|
76 ("Debian Security Advisories - Long format"
|
|
77 "http://www.debian.org/security/dsa-long.en.rdf")
|
|
78 ("Emacs Wiki"
|
|
79 "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
|
|
80 nil
|
|
81 3600)
|
|
82 ("Freshmeat.net"
|
|
83 "http://freshmeat.net/backend/fm.rdf")
|
|
84 ("Kuro5hin.org"
|
|
85 "http://www.kuro5hin.org/backend.rdf")
|
|
86 ("LWN (Linux Weekly News)"
|
|
87 "http://lwn.net/headlines/rss")
|
|
88 ("NewsForge"
|
|
89 "http://newsforge.com/index.rss")
|
|
90 ("NY Times: Technology"
|
|
91 "http://partners.userland.com/nytRss/technology.xml")
|
|
92 ("NY Times"
|
|
93 "http://partners.userland.com/nytRss/nytHomepage.xml")
|
|
94 ("Quote of the day"
|
|
95 "http://www.quotationspage.com/data/qotd.rss"
|
|
96 "07:00"
|
|
97 86400)
|
|
98 ("The Register"
|
|
99 "http://www.theregister.co.uk/tonys/slashdot.rdf")
|
|
100 ("slashdot"
|
|
101 "http://slashdot.org/index.rss"
|
|
102 nil
|
|
103 3600) ;/. will ban you if under 3600 seconds!
|
|
104 ("Wired News"
|
|
105 "http://www.wired.com/news_drop/netcenter/netcenter.rdf")
|
|
106 ("Heise News (german)"
|
|
107 "http://www.heise.de/newsticker/heise.rdf")
|
|
108 ("Tagesschau (german)"
|
|
109 "http://www.tagesschau.de/newsticker.rdf"
|
|
110 nil
|
|
111 1800)
|
|
112 ("Telepolis (german)"
|
|
113 "http://www.heise.de/tp/news.rdf"))
|
|
114 "Default URL list in raw form.
|
|
115 This list is fed into defcustom via `newsticker--splicer'.")
|
|
116
|
|
117 (defun newsticker--splicer (item)
|
|
118 "Convert ITEM for splicing into `newsticker-url-list-defaults'."
|
|
119 (let ((result (list 'list :tag (nth 0 item) (list 'const (nth 0 item))))
|
|
120 (element (cdr item)))
|
|
121 (while element
|
|
122 (setq result (append result (list (list 'const (car element)))))
|
|
123 (setq element (cdr element)))
|
|
124 result))
|
|
125
|
|
126 (defun newsticker--set-customvar-retrieval (symbol value)
|
|
127 "Set retrieval related newsticker-variable SYMBOL value to VALUE.
|
|
128 Calls all actions which are necessary in order to make the new
|
|
129 value effective."
|
|
130 (if (or (not (boundp symbol))
|
|
131 (equal (symbol-value symbol) value))
|
|
132 (set symbol value)
|
|
133 ;; something must have changed
|
|
134 (let ((need-restart nil)
|
|
135 (new-or-changed-feeds nil)
|
|
136 (removed-feeds))
|
|
137 (cond ((eq symbol 'newsticker-retrieval-interval)
|
|
138 (setq need-restart t))
|
|
139 ((memq symbol '(newsticker-url-list-defaults newsticker-url-list))
|
|
140 (dolist (elt value)
|
|
141 (unless (member elt (symbol-value symbol))
|
|
142 (setq new-or-changed-feeds (cons elt new-or-changed-feeds))))
|
|
143 (dolist (elt (symbol-value symbol))
|
|
144 (unless (member elt value)
|
|
145 (setq removed-feeds (cons elt removed-feeds))))))
|
|
146 (cond (need-restart
|
|
147 (set symbol value)
|
|
148 (when (newsticker-running-p)
|
|
149 (message "Restarting newsticker")
|
|
150 (newsticker-stop)
|
|
151 (newsticker-start)))
|
|
152 (t
|
|
153 (dolist (feed removed-feeds)
|
|
154 (message "Stopping feed `%s'" (car feed))
|
|
155 (newsticker--stop-feed (car feed)))
|
|
156 (dolist (feed new-or-changed-feeds)
|
|
157 (message "Starting feed `%s'" (car feed))
|
|
158 (newsticker--stop-feed (car feed))
|
|
159 (newsticker--start-feed feed))
|
|
160 (unless new-or-changed-feeds
|
|
161 (when newsticker--sentinel-callback
|
|
162 (funcall newsticker--sentinel-callback)))))
|
|
163 (set symbol value))))
|
|
164
|
|
165 ;; ======================================================================
|
|
166 ;; retrieval
|
|
167 (defgroup newsticker-retrieval nil
|
|
168 "Settings for news retrieval."
|
|
169 :group 'newsticker)
|
|
170
|
|
171 (defcustom newsticker-url-list-defaults
|
|
172 '(("Emacs Wiki"
|
|
173 "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
|
|
174 nil
|
|
175 3600))
|
|
176 "A customizable list of news feeds to select from.
|
|
177 These were mostly extracted from the Radio Community Server at
|
|
178 http://subhonker6.userland.com/rcsPublic/rssHotlist.
|
|
179
|
|
180 You may add other entries in `newsticker-url-list'."
|
|
181 :type `(set ,@(mapcar `newsticker--splicer
|
|
182 newsticker--raw-url-list-defaults))
|
|
183 :set 'newsticker--set-customvar-retrieval
|
|
184 :group 'newsticker-retrieval)
|
|
185
|
|
186 (defcustom newsticker-url-list nil
|
|
187 "The news feeds which you like to watch.
|
|
188
|
|
189 This alist will be used in addition to selection made customizing
|
|
190 `newsticker-url-list-defaults'.
|
|
191
|
|
192 This is an alist. Each element consists of two items: a LABEL and a URL,
|
|
193 optionally followed by a START-TIME, INTERVAL specifier and WGET-ARGUMENTS.
|
|
194
|
|
195 The LABEL gives the name of the news feed. It can be an arbitrary string.
|
|
196
|
|
197 The URL gives the location of the news feed. It must point to a valid
|
|
198 RSS or Atom file. The file is retrieved by calling wget, or whatever you
|
|
199 specify as `newsticker-wget-name'.
|
|
200
|
|
201 URL may also be a function which returns news data. In this case
|
|
202 `newsticker-retrieval-method' etc. are ignored for this feed.
|
|
203
|
|
204 The START-TIME can be either a string, or nil. If it is a string it
|
|
205 specifies a fixed time at which this feed shall be retrieved for the
|
|
206 first time. (Examples: \"11:00pm\", \"23:00\".) If it is nil (or
|
|
207 unspecified), this feed will be retrieved immediately after calling
|
|
208 `newsticker-start'.
|
|
209
|
|
210 The INTERVAL specifies the time between retrievals for this feed. If it
|
|
211 is nil (or unspecified) the default interval value as set in
|
|
212 `newsticker-retrieval-interval' is used.
|
|
213
|
|
214 \(newsticker.el calls `run-at-time'. The newsticker-parameters START-TIME
|
|
215 and INTERVAL correspond to the `run-at-time'-parameters TIME and REPEAT.)
|
|
216
|
|
217 WGET-ARGUMENTS specifies arguments for wget (see `newsticker-wget-name')
|
|
218 which apply for this feed only, overriding the value of
|
|
219 `newsticker-wget-arguments'."
|
|
220 :type '(repeat (list :tag "News feed"
|
|
221 (string :tag "Label")
|
|
222 (choice :tag "URI"
|
|
223 (string :tag "String")
|
|
224 (function :tag "Function"))
|
|
225 (choice :tag "Start"
|
|
226 (const :tag "Default" nil)
|
|
227 (string :tag "Fixed Time"))
|
|
228 (choice :tag "Interval"
|
|
229 (const :tag "Default" nil)
|
|
230 (const :tag "Hourly" 3600)
|
|
231 (const :tag "Daily" 86400)
|
|
232 (const :tag "Weekly" 604800)
|
|
233 (integer :tag "Interval"))
|
|
234 (choice :tag "Wget Arguments"
|
|
235 (const :tag "Default arguments" nil)
|
|
236 (repeat :tag "Special arguments" string))))
|
|
237 :set 'newsticker--set-customvar-retrieval
|
|
238 :group 'newsticker-retrieval)
|
|
239
|
|
240 (defcustom newsticker-retrieval-method
|
|
241 'intern
|
|
242 "Method for retrieving news from the web, either `intern' or `extern'.
|
|
243 Default value `intern' uses Emacs' built-in asynchronous download
|
|
244 capabilities ('url-retrieve'). If set to `extern' the external
|
|
245 program wget is used, see `newsticker-wget-name'."
|
|
246 :type '(choice :tag "Method"
|
|
247 (const :tag "Intern" intern)
|
|
248 (const :tag "Extern" extern))
|
|
249 :group 'newsticker-retrieval)
|
|
250
|
|
251 (defcustom newsticker-wget-name
|
|
252 "wget"
|
|
253 "Name of the program which is called to retrieve news from the web.
|
|
254 The canonical choice is wget but you may take any other program which is
|
|
255 able to return the contents of a news feed file on stdout."
|
|
256 :type 'string
|
|
257 :group 'newsticker-retrieval)
|
|
258
|
|
259 (defcustom newsticker-wget-arguments
|
|
260 '("-q" "-O" "-")
|
|
261 "Arguments which are passed to wget.
|
|
262 There is probably no reason to change the default settings, unless you
|
|
263 are living behind a firewall."
|
|
264 :type '(repeat (string :tag "Argument"))
|
|
265 :group 'newsticker-retrieval)
|
|
266
|
|
267 (defcustom newsticker-retrieval-interval
|
|
268 3600
|
|
269 "Time interval for retrieving new news items (seconds).
|
|
270 If this value is not positive (i.e. less than or equal to 0)
|
|
271 items are retrieved only once!
|
|
272 Please note that some feeds, e.g. Slashdot, will ban you if you
|
|
273 make it less than 1800 seconds (30 minutes)!"
|
|
274 :type '(choice :tag "Interval"
|
|
275 (const :tag "No automatic retrieval" 0)
|
|
276 (const :tag "Hourly" 3600)
|
|
277 (const :tag "Daily" 86400)
|
|
278 (const :tag "Weekly" 604800)
|
|
279 (integer :tag "Interval"))
|
|
280 :set 'newsticker--set-customvar-retrieval
|
|
281 :group 'newsticker-retrieval)
|
|
282
|
|
283 (defcustom newsticker-desc-comp-max
|
|
284 100
|
|
285 "Relevant length of headline descriptions.
|
|
286 This value gives the maximum number of characters which will be
|
|
287 taken into account when newsticker compares two headline
|
|
288 descriptions."
|
|
289 :type 'integer
|
|
290 :group 'newsticker-retrieval)
|
|
291
|
|
292 ;; ======================================================================
|
|
293 ;; headline processing
|
|
294 (defgroup newsticker-headline-processing nil
|
|
295 "Settings for the automatic processing of headlines."
|
|
296 :group 'newsticker)
|
|
297
|
|
298 (defcustom newsticker-automatically-mark-items-as-old
|
|
299 t
|
|
300 "Decides whether to automatically mark items as old.
|
|
301 If t a new item is considered as new only after its first retrieval. As
|
|
302 soon as it is retrieved a second time, it becomes old. If not t all
|
|
303 items stay new until you mark them as old. This is done in the
|
|
304 *newsticker* buffer."
|
|
305 :type 'boolean
|
|
306 :group 'newsticker-headline-processing)
|
|
307
|
|
308 (defcustom newsticker-automatically-mark-visited-items-as-old
|
|
309 t
|
|
310 "Decides whether to automatically mark visited items as old.
|
|
311 If t an item is marked as old as soon as the associated link is
|
|
312 visited, i.e. after pressing RET or mouse2 on the item's
|
|
313 headline."
|
|
314
|
|
315 :type 'boolean
|
|
316 :group 'newsticker-headline-processing)
|
|
317
|
|
318 (defcustom newsticker-keep-obsolete-items
|
|
319 t
|
|
320 "Decides whether to keep unread items which have been removed from feed.
|
|
321 If t a new item, which has been removed from the feed, is kept in
|
|
322 the cache until it is marked as read."
|
|
323 :type 'boolean
|
|
324 :group 'newsticker-headline-processing)
|
|
325
|
|
326 (defcustom newsticker-obsolete-item-max-age
|
|
327 (* 60 60 24)
|
|
328 "Maximal age of obsolete items, in seconds.
|
|
329 Obsolete items which are older than this value will be silently
|
|
330 deleted at the next retrieval."
|
|
331 :type 'integer
|
|
332 :group 'newsticker-headline-processing)
|
|
333
|
|
334 (defcustom newsticker-auto-mark-filter-list
|
|
335 nil
|
|
336 "A list of filters for automatically marking headlines.
|
|
337
|
|
338 This is an alist of the form (FEED-NAME PATTERN-LIST). I.e. each
|
|
339 element consists of a FEED-NAME a PATTERN-LIST. Each element of
|
|
340 the pattern-list has the form (AGE TITLE-OR-DESCRIPTION REGEXP).
|
|
341 AGE must be one of the symbols 'old or 'immortal.
|
|
342 TITLE-OR-DESCRIPTION must be on of the symbols 'title,
|
|
343 'description, or 'all. REGEXP is a regular expression, i.e. a
|
|
344 string.
|
|
345
|
|
346 This filter is checked after a new headline has been retrieved.
|
|
347 If FEED-NAME matches the name of the corresponding news feed, the
|
|
348 pattern-list is checked: The new headline will be marked as AGE
|
|
349 if REGEXP matches the headline's TITLE-OR-DESCRIPTION.
|
|
350
|
|
351 If, for example, `newsticker-auto-mark-filter-list' looks like
|
|
352 \((slashdot ('old 'title \"^Forget me!$\") ('immortal 'title \"Read me\")
|
|
353 \('immortal 'all \"important\"))))
|
|
354
|
|
355 then all articles from slashdot are marked as old if they have
|
|
356 the title \"Forget me!\". All articles with a title containing
|
|
357 the string \"Read me\" are marked as immortal. All articles which
|
|
358 contain the string \"important\" in their title or their
|
|
359 description are marked as immortal."
|
|
360 :type '(repeat (list :tag "Auto mark filter"
|
|
361 (string :tag "Feed name")
|
|
362 (repeat
|
|
363 (list :tag "Filter element"
|
|
364 (choice
|
|
365 :tag "Auto-assigned age"
|
|
366 (const :tag "Old" old)
|
|
367 (const :tag "Immortal" immortal))
|
|
368 (choice
|
|
369 :tag "Title/Description"
|
|
370 (const :tag "Title" title)
|
|
371 (const :tag "Description" description)
|
|
372 (const :tag "All" all))
|
|
373 (string :tag "Regexp")))))
|
|
374 :group 'newsticker-headline-processing)
|
|
375
|
|
376 ;; ======================================================================
|
|
377 ;; hooks
|
|
378 (defgroup newsticker-hooks nil
|
|
379 "Settings for newsticker hooks."
|
|
380 :group 'newsticker)
|
|
381
|
|
382 (defcustom newsticker-start-hook
|
|
383 nil
|
|
384 "Hook run when starting newsticker.
|
|
385 This hook is run at the very end of `newsticker-start'."
|
|
386 :options '(newsticker-start-ticker)
|
|
387 :type 'hook
|
|
388 :group 'newsticker-hooks)
|
|
389
|
|
390 (defcustom newsticker-stop-hook
|
|
391 nil
|
|
392 "Hook run when stopping newsticker.
|
|
393 This hook is run at the very end of `newsticker-stop'."
|
|
394 :options nil
|
|
395 :type 'hook
|
|
396 :group 'newsticker-hooks)
|
|
397
|
|
398 (defcustom newsticker-new-item-functions
|
|
399 nil
|
|
400 "List of functions run after a new headline has been retrieved.
|
|
401 Each function is called with the following three arguments:
|
|
402 FEED the name of the corresponding news feed,
|
|
403 TITLE the title of the headline,
|
|
404 DESC the decoded description of the headline.
|
|
405
|
|
406 See `newsticker-download-images', and
|
|
407 `newsticker-download-enclosures' for sample functions.
|
|
408
|
|
409 Please note that these functions are called only once for a
|
|
410 headline after it has been retrieved for the first time."
|
|
411 :type 'hook
|
|
412 :options '(newsticker-download-images
|
|
413 newsticker-download-enclosures)
|
|
414 :group 'newsticker-hooks)
|
|
415
|
|
416 ;; ======================================================================
|
|
417 ;; miscellaneous
|
|
418 (defgroup newsticker-miscellaneous nil
|
|
419 "Miscellaneous newsticker settings."
|
|
420 :group 'newsticker)
|
|
421
|
|
422 (defcustom newsticker-cache-filename
|
|
423 "~/.newsticker-cache"
|
|
424 "Name of the newsticker cache file."
|
|
425 :type 'string
|
|
426 :group 'newsticker-miscellaneous)
|
|
427
|
|
428 (defcustom newsticker-imagecache-dirname
|
|
429 "~/.newsticker-images"
|
|
430 "Name of the directory where newsticker stores cached images."
|
|
431 :type 'string
|
|
432 :group 'newsticker-miscellaneous)
|
|
433
|
|
434 ;; debugging
|
|
435 (defcustom newsticker-debug
|
|
436 nil
|
|
437 "Enables some features needed for debugging newsticker.el.
|
|
438
|
|
439 If set to t newsticker.el will print lots of debugging messages, and the
|
|
440 buffers *newsticker-wget-<feed>* will not be closed."
|
|
441 :type 'boolean
|
|
442 :group 'newsticker-miscellaneous)
|
|
443
|
|
444 ;; ======================================================================
|
|
445 ;;; Compatibility section, XEmacs, Emacs
|
|
446 ;; ======================================================================
|
|
447 (unless (fboundp 'time-add)
|
|
448 (require 'time-date);;FIXME
|
|
449 (defun time-add (t1 t2)
|
|
450 (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))
|
|
451
|
|
452 (unless (fboundp 'match-string-no-properties)
|
|
453 (defalias 'match-string-no-properties 'match-string))
|
|
454
|
|
455 (when (featurep 'xemacs)
|
|
456 (unless (fboundp 'replace-regexp-in-string)
|
|
457 (defun replace-regexp-in-string (re rp st)
|
|
458 (save-match-data ;; apparently XEmacs needs save-match-data
|
|
459 (replace-in-string st re rp)))))
|
|
460
|
|
461 ;; copied from subr.el
|
|
462 (unless (fboundp 'add-to-invisibility-spec)
|
|
463 (defun add-to-invisibility-spec (arg)
|
|
464 "Add elements to `buffer-invisibility-spec'.
|
|
465 See documentation for `buffer-invisibility-spec' for the kind of elements
|
|
466 that can be added."
|
|
467 (if (eq buffer-invisibility-spec t)
|
|
468 (setq buffer-invisibility-spec (list t)))
|
|
469 (setq buffer-invisibility-spec
|
|
470 (cons arg buffer-invisibility-spec))))
|
|
471
|
|
472 ;; copied from subr.el
|
|
473 (unless (fboundp 'remove-from-invisibility-spec)
|
|
474 (defun remove-from-invisibility-spec (arg)
|
|
475 "Remove elements from `buffer-invisibility-spec'."
|
|
476 (if (consp buffer-invisibility-spec)
|
|
477 (setq buffer-invisibility-spec
|
|
478 (delete arg buffer-invisibility-spec)))))
|
|
479
|
|
480 ;; ======================================================================
|
|
481 ;;; Internal variables
|
|
482 ;; ======================================================================
|
|
483 (defvar newsticker--item-list nil
|
|
484 "List of newsticker items.")
|
|
485 (defvar newsticker--item-position 0
|
|
486 "Actual position in list of newsticker items.")
|
|
487 (defvar newsticker--prev-message "There was no previous message yet!"
|
|
488 "Last message that the newsticker displayed.")
|
|
489 (defvar newsticker--scrollable-text ""
|
|
490 "The text which is scrolled smoothly in the echo area.")
|
|
491 (defvar newsticker--buffer-uptodate-p nil
|
|
492 "Tells whether the newsticker buffer is up to date.")
|
|
493 (defvar newsticker--latest-update-time (current-time)
|
|
494 "The time at which the latest news arrived.")
|
|
495 (defvar newsticker--process-ids nil
|
|
496 "List of PIDs of active newsticker processes.")
|
|
497
|
|
498 (defvar newsticker--cache nil "Cached newsticker data.
|
|
499 This is a list of the form
|
|
500
|
|
501 ((label1
|
|
502 (title description link time age index preformatted-contents
|
|
503 preformatted-title extra-elements)
|
|
504 ...)
|
|
505 (label2
|
|
506 (title description link time age index preformatted-contents
|
|
507 preformatted-title extra-elements)
|
|
508 ...)
|
|
509 ...)
|
|
510
|
|
511 where LABEL is a symbol. TITLE, DESCRIPTION, and LINK are
|
|
512 strings. TIME is a time value as returned by `current-time'.
|
|
513 AGE is a symbol: 'new, 'old, 'immortal, and 'obsolete denote
|
|
514 ordinary news items, whereas 'feed denotes an item which is not a
|
|
515 headline but describes the feed itself. INDEX denotes the
|
|
516 original position of the item -- used for restoring the original
|
|
517 order. PREFORMATTED-CONTENTS and PREFORMATTED-TITLE hold the
|
|
518 formatted contents of the item's description and title. This
|
|
519 speeds things up if HTML rendering is used, which is rather
|
|
520 slow. EXTRA-ELEMENTS is an alist containing additional elements.")
|
|
521
|
|
522 (defvar newsticker--auto-narrow-to-feed nil
|
|
523 "Automatically narrow to current news feed.
|
|
524 If non-nil only the items of the current news feed are visible.")
|
|
525
|
|
526 (defvar newsticker--auto-narrow-to-item nil
|
|
527 "Automatically narrow to current news item.
|
|
528 If non-nil only the current headline is visible.")
|
|
529
|
|
530 (defconst newsticker--error-headline
|
|
531 "[COULD NOT DOWNLOAD HEADLINES!]"
|
|
532 "Title of error headline which will be inserted if news retrieval fails.")
|
|
533
|
|
534 ;; ======================================================================
|
|
535 ;;; Shortcuts
|
|
536 ;; ======================================================================
|
|
537 (defsubst newsticker--title (item)
|
|
538 "Return title of ITEM."
|
|
539 (nth 0 item))
|
|
540 (defsubst newsticker--desc (item)
|
|
541 "Return description of ITEM."
|
|
542 (nth 1 item))
|
|
543 (defsubst newsticker--link (item)
|
|
544 "Return link of ITEM."
|
|
545 (nth 2 item))
|
|
546 (defsubst newsticker--time (item)
|
|
547 "Return time of ITEM."
|
|
548 (nth 3 item))
|
|
549 (defsubst newsticker--age (item)
|
|
550 "Return age of ITEM."
|
|
551 (nth 4 item))
|
|
552 (defsubst newsticker--pos (item)
|
|
553 "Return position/index of ITEM."
|
|
554 (nth 5 item))
|
|
555 (defsubst newsticker--preformatted-contents (item)
|
|
556 "Return pre-formatted text of ITEM."
|
|
557 (nth 6 item))
|
|
558 (defsubst newsticker--preformatted-title (item)
|
|
559 "Return pre-formatted title of ITEM."
|
|
560 (nth 7 item))
|
|
561 (defsubst newsticker--extra (item)
|
|
562 "Return extra attributes of ITEM."
|
|
563 (nth 8 item))
|
|
564 (defsubst newsticker--guid-to-string (guid)
|
|
565 "Return string representation of GUID."
|
|
566 (if (stringp guid)
|
|
567 guid
|
|
568 (car (xml-node-children guid))))
|
|
569 (defsubst newsticker--guid (item)
|
|
570 "Return guid of ITEM."
|
|
571 (newsticker--guid-to-string (assoc 'guid (newsticker--extra item))))
|
|
572 (defsubst newsticker--enclosure (item)
|
|
573 "Return enclosure element of ITEM in the form \(...FIXME...\) or nil."
|
|
574 (let ((enclosure (assoc 'enclosure (newsticker--extra item))))
|
|
575 (if enclosure
|
|
576 (xml-node-attributes enclosure))))
|
|
577 (defun newsticker--real-feed-name (feed)
|
|
578 "Return real name of FEED."
|
|
579 (catch 'name
|
|
580 (mapc (lambda (item)
|
|
581 (if (eq (newsticker--age item) 'feed)
|
|
582 (throw 'name (newsticker--title item))))
|
|
583 (cdr (newsticker--cache-get-feed feed)))
|
|
584 (symbol-name feed)))
|
|
585
|
|
586
|
|
587 ;; ======================================================================
|
|
588 ;;; User fun
|
|
589 ;; ======================================================================
|
|
590
|
|
591 (defun newsticker--start-feed (feed &optional do-not-complain-if-running)
|
|
592 "Start retrieval timer for FEED.
|
|
593 If timer is running already a warning message is printed unless
|
|
594 DO-NOT-COMPLAIN-IF-RUNNING is not nil. Add the started
|
|
595 name/timer pair to `newsticker--retrieval-timer-list'."
|
|
596 (let* ((feed-name (car feed))
|
|
597 (start-time (nth 2 feed))
|
|
598 (interval (or (nth 3 feed)
|
|
599 newsticker-retrieval-interval))
|
|
600 (timer (assoc (car feed)
|
|
601 newsticker--retrieval-timer-list)))
|
|
602 (if timer
|
|
603 (or do-not-complain-if-running
|
|
604 (message "Timer for %s is running already!"
|
|
605 feed-name))
|
|
606 (newsticker--debug-msg "Starting timer for %s: %s, %d"
|
|
607 feed-name start-time interval)
|
|
608 ;; do not repeat retrieval if interval not positive
|
|
609 (if (<= interval 0)
|
|
610 (setq interval nil))
|
|
611 ;; Suddenly XEmacs doesn't like start-time 0
|
|
612 (if (or (not start-time)
|
|
613 (and (numberp start-time) (= start-time 0)))
|
|
614 (setq start-time 1))
|
|
615 ;; (message "start-time %s" start-time)
|
|
616 (setq timer (run-at-time start-time interval
|
|
617 'newsticker-get-news feed-name))
|
|
618 (if interval
|
|
619 (add-to-list 'newsticker--retrieval-timer-list
|
|
620 (cons feed-name timer))))))
|
|
621
|
|
622 ;;;###autoload
|
|
623 (defun newsticker-start (&optional do-not-complain-if-running)
|
|
624 "Start the newsticker.
|
|
625 Start the timers for display and retrieval. If the newsticker, i.e. the
|
|
626 timers, are running already a warning message is printed unless
|
|
627 DO-NOT-COMPLAIN-IF-RUNNING is not nil.
|
|
628 Run `newsticker-start-hook' if newsticker was not running already."
|
|
629 (interactive)
|
|
630 (let ((running (newsticker-running-p)))
|
|
631 ;; read old cache if it exists and newsticker is not running
|
|
632 (unless running
|
|
633 (let ((coding-system-for-read 'utf-8))
|
|
634 (when (file-exists-p newsticker-cache-filename)
|
|
635 (with-temp-buffer
|
|
636 (insert-file-contents newsticker-cache-filename)
|
|
637 (goto-char (point-min))
|
|
638 (condition-case nil
|
|
639 (setq newsticker--cache (read (current-buffer)))
|
|
640 (error
|
|
641 (message "Error while reading newsticker cache file!")
|
|
642 (setq newsticker--cache nil)))))))
|
|
643 ;; start retrieval timers -- one timer for each feed
|
|
644 (dolist (feed (append newsticker-url-list-defaults newsticker-url-list))
|
|
645 (newsticker--start-feed feed))
|
|
646 (unless running
|
|
647 (run-hooks 'newsticker-start-hook)
|
|
648 (message "Newsticker started!"))))
|
|
649
|
|
650 (defun newsticker--stop-feed (feed-name)
|
|
651 "Stop retrieval for feed FEED-NAME.
|
|
652 Delete the stopped name/timer pair from `newsticker--retrieval-timer-list'."
|
|
653 (let ((name-and-timer (assoc feed-name newsticker--retrieval-timer-list)))
|
|
654 (when name-and-timer
|
|
655 (cancel-timer (cdr name-and-timer))
|
|
656 (setq newsticker--retrieval-timer-list
|
|
657 (delete name-and-timer newsticker--retrieval-timer-list)))))
|
|
658
|
|
659 (defun newsticker-stop ()
|
|
660 "Stop the newsticker and the newsticker-ticker.
|
|
661 Cancel the timers for display and retrieval. Run `newsticker-stop-hook'
|
|
662 if newsticker has been running."
|
|
663 (interactive)
|
|
664 (newsticker--cache-update t)
|
|
665 (when (fboundp 'newsticker-stop-ticker) ; silence compiler warnings
|
|
666 (newsticker-stop-ticker))
|
|
667 (when (newsticker-running-p)
|
|
668 (mapc (lambda (name-and-timer)
|
|
669 (newsticker--stop-feed (car name-and-timer)))
|
|
670 newsticker--retrieval-timer-list)
|
|
671 (setq newsticker--retrieval-timer-list nil)
|
|
672 (run-hooks 'newsticker-stop-hook)
|
|
673 (message "Newsticker stopped!")))
|
|
674
|
|
675 (defun newsticker-get-all-news ()
|
|
676 "Launch retrieval of news from all configured newsticker sites.
|
|
677 This does NOT start the retrieval timers."
|
|
678 (interactive)
|
|
679 ;; launch retrieval of news
|
|
680 (mapc (lambda (item)
|
|
681 (newsticker-get-news (car item)))
|
|
682 (append newsticker-url-list-defaults newsticker-url-list)))
|
|
683
|
|
684 (defun newsticker-save-item (feed item)
|
|
685 "Save FEED ITEM."
|
|
686 (interactive)
|
|
687 (let ((filename (read-string "Filename: "
|
|
688 (concat feed ":_"
|
|
689 (replace-regexp-in-string
|
|
690 " " "_" (newsticker--title item))
|
|
691 ".html"))))
|
|
692 (with-temp-buffer
|
|
693 (insert (newsticker--desc item))
|
|
694 (write-file filename t))))
|
|
695
|
|
696 (defun newsticker-add-url (url name)
|
|
697 "Add given URL under given NAME to `newsticker-url-list'.
|
|
698 If URL is nil it is searched at point."
|
|
699 (interactive
|
|
700 (list
|
|
701 (read-string "URL: "
|
|
702 (save-excursion
|
|
703 (end-of-line)
|
|
704 (and
|
|
705 (re-search-backward
|
|
706 "http://"
|
|
707 (if (> (point) (+ (point-min) 100))
|
|
708 (- (point) 100)
|
|
709 (point-min))
|
|
710 t)
|
|
711 (re-search-forward
|
|
712 "http://[-a-zA-Z0-9&/_.]*"
|
|
713 (if (< (point) (- (point-max) 200))
|
|
714 (+ (point) 200)
|
|
715 (point-max))
|
|
716 t)
|
|
717 (buffer-substring-no-properties (match-beginning 0)
|
|
718 (match-end 0)))))
|
|
719 (read-string "Name: ")))
|
|
720 (add-to-list 'newsticker-url-list (list name url nil nil nil) t)
|
|
721 (customize-variable 'newsticker-url-list))
|
|
722
|
|
723 (defun newsticker-customize ()
|
|
724 "Open the newsticker customization group."
|
|
725 (interactive)
|
|
726 (customize-group "newsticker"))
|
|
727
|
|
728 ;; ======================================================================
|
|
729 ;;; Local stuff
|
|
730 ;; ======================================================================
|
|
731 (defun newsticker--get-news-by-funcall (feed-name function)
|
|
732 "Get news for the site FEED-NAME by calling FUNCTION.
|
|
733 See `newsticker-get-news'."
|
|
734 (let ((buffername (concat " *newsticker-funcall-" feed-name "*")))
|
|
735 (save-excursion
|
|
736 (set-buffer (get-buffer-create buffername))
|
|
737 (erase-buffer)
|
|
738 (insert (string-to-multibyte (funcall function feed-name)))
|
|
739 (newsticker--sentinel-work nil t feed-name function
|
|
740 (current-buffer)))))
|
|
741
|
|
742 (defun newsticker--get-news-by-url (feed-name url)
|
|
743 "Get news for the site FEED-NAME from address URL using `url-retrieve'.
|
|
744 See `newsticker-get-news'."
|
|
745 (let ((coding-system-for-read 'no-conversion))
|
|
746 (url-retrieve url 'newsticker--get-news-by-url-callback (list feed-name)))
|
|
747 (force-mode-line-update))
|
|
748
|
|
749 (defun newsticker--get-news-by-url-callback (status feed-name)
|
|
750 "Callback function for `newsticker--get-news-by-url'.
|
|
751 STATUS is the return status as delivered by `url-retrieve', and
|
|
752 FEED-NAME is the name of the feed that the news were retrieved
|
|
753 from."
|
|
754 (let ((buf (get-buffer-create (concat " *newsticker-url-" feed-name "*")))
|
|
755 (result (string-to-multibyte (buffer-string))))
|
|
756 (set-buffer buf)
|
|
757 (erase-buffer)
|
|
758 (insert result)
|
|
759 ;; remove MIME header
|
|
760 (goto-char (point-min))
|
|
761 (search-forward "\n\n")
|
|
762 (delete-region (point-min) (point))
|
|
763 ;; read the rss/atom contents
|
|
764 (newsticker--sentinel-work nil t feed-name "url-retrieve" (current-buffer))
|
|
765 (when status
|
|
766 (let ((status-type (car status))
|
|
767 (status-details (cdr status)))
|
|
768 (cond ((eq status-type :redirect)
|
|
769 ;; don't care about redirects
|
|
770 )
|
|
771 ((eq status-type :error)
|
|
772 (message "%s: Error while retrieving news from %s: %s: \"%s\""
|
|
773 (format-time-string "%A, %H:%M" (current-time))
|
|
774 feed-name
|
|
775 (car status-details) (cdr status-details))))))))
|
|
776
|
|
777 (defun newsticker--get-news-by-wget (feed-name url wget-arguments)
|
|
778 "Get news for the site FEED-NAME from address URL using wget.
|
|
779 WGET-ARGUMENTS is a list of arguments for wget.
|
|
780 See `newsticker-get-news'."
|
|
781 (let ((buffername (concat " *newsticker-wget-" feed-name "*")))
|
|
782 (save-excursion
|
|
783 (set-buffer (get-buffer-create buffername))
|
|
784 (erase-buffer)
|
|
785 ;; throw an error if there is an old wget-process around
|
|
786 (if (get-process feed-name)
|
|
787 (error "Another wget-process is running for %s" feed-name))
|
|
788 ;; start wget
|
|
789 (let* ((args (append wget-arguments (list url)))
|
|
790 (proc (apply 'start-process feed-name buffername
|
|
791 newsticker-wget-name args)))
|
|
792 (set-process-coding-system proc 'no-conversion 'no-conversion)
|
|
793 (set-process-sentinel proc 'newsticker--sentinel)
|
|
794 (setq newsticker--process-ids (cons (process-id proc)
|
|
795 newsticker--process-ids))
|
|
796 (force-mode-line-update)))))
|
|
797
|
|
798 (defun newsticker-get-news (feed-name)
|
|
799 "Get news from the site FEED-NAME and load feed logo.
|
|
800 FEED-NAME must be a string which occurs as the label (i.e. the first element)
|
|
801 in an element of `newsticker-url-list' or `newsticker-url-list-defaults'."
|
|
802 (newsticker--debug-msg "%s: Getting news for %s"
|
|
803 (format-time-string "%A, %H:%M" (current-time))
|
|
804 feed-name)
|
|
805 (let* ((item (or (assoc feed-name newsticker-url-list)
|
|
806 (assoc feed-name newsticker-url-list-defaults)
|
|
807 (error
|
|
808 "Cannot get news for %s: Check newsticker-url-list"
|
|
809 feed-name)))
|
|
810 (url (cadr item))
|
|
811 (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
|
|
812 newsticker-wget-arguments)))
|
|
813 (if (functionp url)
|
|
814 (newsticker--get-news-by-funcall feed-name url)
|
|
815 (if (eq newsticker-retrieval-method 'intern)
|
|
816 (newsticker--get-news-by-url feed-name url)
|
|
817 (newsticker--get-news-by-wget feed-name url wget-arguments)))))
|
|
818
|
|
819 ;; ======================================================================
|
|
820 ;; Parsing
|
|
821 ;; ======================================================================
|
|
822
|
|
823 (defun newsticker--sentinel (process event)
|
|
824 "Sentinel for extracting news titles from an RDF buffer.
|
|
825 Argument PROCESS is the process which has just changed its state.
|
|
826 Argument EVENT tells what has happened to the process."
|
|
827 (let ((p-status (process-status process))
|
|
828 (exit-status (process-exit-status process))
|
|
829 (name (process-name process))
|
|
830 (command (process-command process))
|
|
831 (buffer (process-buffer process)))
|
|
832 (newsticker--sentinel-work event
|
|
833 (and (eq p-status 'exit)
|
|
834 (= exit-status 0))
|
|
835 name command buffer)))
|
|
836
|
|
837 (defun newsticker--sentinel-work (event status-ok name command buffer)
|
|
838 "Actually do the sentinel work.
|
|
839 Argument EVENT tells what has happened to the retrieval process.
|
|
840 Argument STATUS-OK is the final status of the retrieval process,
|
|
841 non-nil meaning retrieval was successful.
|
|
842 Argument NAME is the name of the retrieval process.
|
|
843 Argument COMMAND is the command of the retrieval process.
|
|
844 Argument BUFFER is the buffer of the retrieval process."
|
|
845 (let ((time (current-time))
|
|
846 (name-symbol (intern name))
|
|
847 (something-was-added nil))
|
|
848 ;; catch known errors (zombie processes, rubbish-xml etc.
|
|
849 ;; if an error occurs the news feed is not updated!
|
|
850 (catch 'oops
|
|
851 (unless status-ok
|
|
852 (setq newsticker--cache
|
|
853 (newsticker--cache-add
|
|
854 newsticker--cache
|
|
855 name-symbol
|
|
856 newsticker--error-headline
|
|
857 (format
|
|
858 (concat "%s: Newsticker could not retrieve news from %s.\n"
|
|
859 "Return status: `%s'\n"
|
|
860 "Command was `%s'")
|
|
861 (format-time-string "%A, %H:%M" (current-time))
|
|
862 name event command)
|
|
863 ""
|
|
864 (current-time)
|
|
865 'new
|
|
866 0 nil))
|
|
867 (message "%s: Error while retrieving news from %s"
|
|
868 (format-time-string "%A, %H:%M" (current-time))
|
|
869 name)
|
|
870 (throw 'oops nil))
|
|
871 (let* ((coding-system 'utf-8)
|
|
872 (node-list
|
|
873 (save-current-buffer
|
|
874 (set-buffer buffer)
|
|
875 ;; a very very dirty workaround to overcome the
|
|
876 ;; problems with the newest (20030621) xml.el:
|
|
877 ;; remove all unnecessary whitespace
|
|
878 (goto-char (point-min))
|
|
879 (while (re-search-forward ">[ \t\r\n]+<" nil t)
|
|
880 (replace-match "><" nil t))
|
|
881 ;; and another brutal workaround (20031105)! For some
|
|
882 ;; reason the xml parser does not like the colon in the
|
|
883 ;; doctype name "rdf:RDF"
|
|
884 (goto-char (point-min))
|
|
885 (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t)
|
|
886 (replace-match "<!DOCTYPE rdfColonRDF" nil t))
|
|
887 ;; finally.... ~##^°!!!!!
|
|
888 (goto-char (point-min))
|
|
889 (while (search-forward "\r\n" nil t)
|
|
890 (replace-match "\n" nil t))
|
|
891 ;; still more brutal workarounds (20040309)! The xml
|
|
892 ;; parser does not like doctype rss
|
|
893 (goto-char (point-min))
|
|
894 (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t)
|
|
895 (replace-match "" nil t))
|
|
896 ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
|
|
897 ;; Remove comments to avoid this xml-parsing bug:
|
|
898 ;; "XML files can have only one toplevel tag"
|
|
899 (goto-char (point-min))
|
|
900 (while (search-forward "<!--" nil t)
|
|
901 (let ((start (match-beginning 0)))
|
|
902 (unless (search-forward "-->" nil t)
|
|
903 (error "Can't find end of comment"))
|
|
904 (delete-region start (point))))
|
|
905 ;; And another one (20050702)! If description is HTML
|
|
906 ;; encoded and starts with a `<', wrap the whole
|
|
907 ;; description in a CDATA expression. This happened for
|
|
908 ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
|
|
909 (goto-char (point-min))
|
|
910 (while (re-search-forward
|
|
911 "<description>\\(<img.*?\\)</description>" nil t)
|
|
912 (replace-match
|
|
913 "<description><![CDATA[ \\1 ]]></description>"))
|
|
914 ;; And another one (20051123)! XML parser does not
|
|
915 ;; like this: <yweather:location city="Frankfurt/Main"
|
|
916 ;; region="" country="GM" />
|
|
917 ;; try to "fix" empty attributes
|
|
918 ;; This happened for
|
|
919 ;; http://xml.weather.yahoo.com/forecastrss?p=GMXX0040&u=f
|
|
920 (goto-char (point-min))
|
|
921 (while (re-search-forward "\\(<[^>]*\\)=\"\"" nil t)
|
|
922 (replace-match "\\1=\" \""))
|
|
923 ;;
|
|
924 (set-buffer-modified-p nil)
|
|
925 ;; check coding system
|
|
926 (goto-char (point-min))
|
|
927 (if (re-search-forward "encoding=\"\\([^\"]+\\)\""
|
|
928 nil t)
|
|
929 (setq coding-system (intern (downcase (match-string 1))))
|
|
930 (setq coding-system
|
|
931 (condition-case nil
|
|
932 (check-coding-system coding-system)
|
|
933 (coding-system-error
|
|
934 (message
|
|
935 "newsticker.el: ignoring coding system %s for %s"
|
|
936 coding-system name)
|
|
937 nil))))
|
|
938 ;; Decode if possible
|
|
939 (when coding-system
|
|
940 (decode-coding-region (point-min) (point-max)
|
|
941 coding-system))
|
|
942 (condition-case errordata
|
|
943 ;; The xml parser might fail
|
|
944 ;; or the xml might be bugged
|
|
945 (xml-parse-region (point-min) (point-max))
|
|
946 (error (message "Could not parse %s: %s"
|
|
947 (buffer-name) (cadr errordata))
|
|
948 (throw 'oops nil)))))
|
|
949 (topnode (car node-list))
|
|
950 (channelnode (car (xml-get-children topnode 'channel)))
|
|
951 (imageurl nil))
|
|
952 ;; mark all items as obsolete
|
|
953 (newsticker--cache-replace-age newsticker--cache
|
|
954 name-symbol
|
|
955 'new 'obsolete-new)
|
|
956 (newsticker--cache-replace-age newsticker--cache
|
|
957 name-symbol
|
|
958 'old 'obsolete-old)
|
|
959 (newsticker--cache-replace-age newsticker--cache
|
|
960 name-symbol
|
|
961 'feed 'obsolete-old)
|
|
962
|
|
963 ;; check Atom/RSS version and call corresponding parser
|
|
964 (condition-case error-data
|
|
965 (if (cond
|
|
966 ;; RSS 0.91
|
|
967 ((and (eq 'rss (xml-node-name topnode))
|
|
968 (string= "0.91" (xml-get-attribute topnode 'version)))
|
|
969 (setq imageurl (newsticker--get-logo-url-rss-0.91 topnode))
|
|
970 (newsticker--parse-rss-0.91 name time topnode))
|
|
971 ;; RSS 0.92
|
|
972 ((and (eq 'rss (xml-node-name topnode))
|
|
973 (string= "0.92" (xml-get-attribute topnode 'version)))
|
|
974 (setq imageurl (newsticker--get-logo-url-rss-0.92 topnode))
|
|
975 (newsticker--parse-rss-0.92 name time topnode))
|
|
976 ;; RSS 1.0
|
|
977 ((eq 'rdf:RDF (xml-node-name topnode))
|
|
978 (setq imageurl (newsticker--get-logo-url-rss-1.0 topnode))
|
|
979 (newsticker--parse-rss-1.0 name time topnode))
|
|
980 ;; RSS 2.0
|
|
981 ((and (eq 'rss (xml-node-name topnode))
|
|
982 (string= "2.0" (xml-get-attribute topnode 'version)))
|
|
983 (setq imageurl (newsticker--get-logo-url-rss-2.0 topnode))
|
|
984 (newsticker--parse-rss-2.0 name time topnode))
|
|
985 ;; Atom 0.3
|
|
986 ((and (eq 'feed (xml-node-name topnode))
|
|
987 (string= "http://purl.org/atom/ns#"
|
|
988 (xml-get-attribute topnode 'xmlns)))
|
|
989 (setq imageurl (newsticker--get-logo-url-atom-0.3 topnode))
|
|
990 (newsticker--parse-atom-0.3 name time topnode))
|
|
991 ;; Atom 1.0
|
|
992 ((and (eq 'feed (xml-node-name topnode))
|
|
993 (string= "http://www.w3.org/2005/Atom"
|
|
994 (xml-get-attribute topnode 'xmlns)))
|
|
995 (setq imageurl (newsticker--get-logo-url-atom-1.0 topnode))
|
|
996 (newsticker--parse-atom-1.0 name time topnode))
|
|
997 ;; unknown feed type
|
|
998 (t
|
|
999 (newsticker--debug-msg "Feed type unknown: %s: %s"
|
|
1000 (xml-node-name topnode) name)
|
|
1001 nil))
|
|
1002 (setq something-was-added t))
|
|
1003 (xerror (message "sentinelerror in %s: %s" name error-data)))
|
|
1004
|
|
1005 ;; Remove those old items from cache which have been removed from
|
|
1006 ;; the feed
|
|
1007 (newsticker--cache-replace-age newsticker--cache
|
|
1008 name-symbol 'obsolete-old 'deleteme)
|
|
1009 (newsticker--cache-remove newsticker--cache name-symbol
|
|
1010 'deleteme)
|
|
1011 ;; Remove those new items from cache which have been removed from
|
|
1012 ;; the feed. Or keep them as `obsolete'
|
|
1013 (if (not newsticker-keep-obsolete-items)
|
|
1014 (newsticker--cache-remove newsticker--cache
|
|
1015 name-symbol 'obsolete-new)
|
|
1016 (setq newsticker--cache
|
|
1017 (newsticker--cache-mark-expired
|
|
1018 newsticker--cache name-symbol 'obsolete 'obsolete-expired
|
|
1019 newsticker-obsolete-item-max-age))
|
|
1020 (newsticker--cache-remove newsticker--cache
|
|
1021 name-symbol 'obsolete-expired)
|
|
1022 (newsticker--cache-replace-age newsticker--cache
|
|
1023 name-symbol 'obsolete-new
|
|
1024 'obsolete))
|
|
1025 (newsticker--update-process-ids)
|
|
1026 ;; setup scrollable text
|
|
1027 (when (= 0 (length newsticker--process-ids))
|
|
1028 (when (fboundp 'newsticker--ticker-text-setup) ;silence
|
|
1029 ;compiler
|
|
1030 ;warnings
|
|
1031 (newsticker--ticker-text-setup)))
|
|
1032 (setq newsticker--latest-update-time (current-time))
|
|
1033 (when something-was-added
|
|
1034 ;; FIXME: should we care about removed items as well?
|
|
1035 (newsticker--cache-update)
|
|
1036 (when (fboundp 'newsticker--buffer-set-uptodate) ;silence
|
|
1037 ;compiler
|
|
1038 ;warnings
|
|
1039 (newsticker--buffer-set-uptodate nil)))
|
|
1040 ;; kill the process buffer if wanted
|
|
1041 (unless newsticker-debug
|
|
1042 (kill-buffer buffer))
|
|
1043 ;; launch retrieval of image
|
|
1044 (when (and imageurl newsticker--download-logos)
|
|
1045 (newsticker--image-get name imageurl)))))
|
|
1046 (when newsticker--sentinel-callback
|
|
1047 (funcall newsticker--sentinel-callback)))
|
|
1048
|
|
1049 (defun newsticker--get-logo-url-atom-1.0 (node)
|
|
1050 "Return logo URL from atom 1.0 data in NODE."
|
|
1051 (car (xml-node-children
|
|
1052 (car (xml-get-children node 'logo)))))
|
|
1053
|
|
1054 (defun newsticker--get-logo-url-atom-0.3 (node)
|
|
1055 "Return logo URL from atom 0.3 data in NODE."
|
|
1056 (car (xml-node-children
|
|
1057 (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
|
|
1058
|
|
1059 (defun newsticker--get-logo-url-rss-2.0 (node)
|
|
1060 "Return logo URL from RSS 2.0 data in NODE."
|
|
1061 (car (xml-node-children
|
|
1062 (car (xml-get-children
|
|
1063 (car (xml-get-children
|
|
1064 (car (xml-get-children node 'channel)) 'image)) 'url)))))
|
|
1065
|
|
1066 (defun newsticker--get-logo-url-rss-1.0 (node)
|
|
1067 "Return logo URL from RSS 1.0 data in NODE."
|
|
1068 (car (xml-node-children
|
|
1069 (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
|
|
1070
|
|
1071 (defun newsticker--get-logo-url-rss-0.92 (node)
|
|
1072 "Return logo URL from RSS 0.92 data in NODE."
|
|
1073 (car (xml-node-children
|
|
1074 (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
|
|
1075
|
|
1076 (defun newsticker--get-logo-url-rss-0.91 (node)
|
|
1077 "Return logo URL from RSS 0.91 data in NODE."
|
|
1078 (car (xml-node-children
|
|
1079 (car (xml-get-children (car (xml-get-children node 'image)) 'url)))))
|
|
1080
|
|
1081 (defun newsticker--parse-atom-0.3 (name time topnode)
|
|
1082 "Parse Atom 0.3 data.
|
|
1083 Return value as well as arguments NAME, TIME, and TOPNODE are the
|
|
1084 same as in `newsticker--parse-atom-1.0'."
|
|
1085 (newsticker--debug-msg "Parsing Atom 0.3 feed %s" name)
|
|
1086 (let (new-feed new-item)
|
|
1087 (setq new-feed (newsticker--parse-generic-feed
|
|
1088 name time
|
|
1089 ;; title
|
|
1090 (car (xml-node-children
|
|
1091 (car (xml-get-children topnode 'title))))
|
|
1092 ;; desc
|
|
1093 (car (xml-node-children
|
|
1094 (car (xml-get-children topnode 'content))))
|
|
1095 ;; link
|
|
1096 (xml-get-attribute
|
|
1097 (car (xml-get-children topnode 'link)) 'href)
|
|
1098 ;; extra-elements
|
|
1099 (xml-node-children topnode)))
|
|
1100 (setq new-item (newsticker--parse-generic-items
|
|
1101 name time (xml-get-children topnode 'entry)
|
|
1102 ;; title-fn
|
|
1103 (lambda (node)
|
|
1104 (car (xml-node-children
|
|
1105 (car (xml-get-children node 'title)))))
|
|
1106 ;; desc-fn
|
|
1107 (lambda (node)
|
|
1108 (or (car (xml-node-children
|
|
1109 (car (xml-get-children node 'content))))
|
|
1110 (car (xml-node-children
|
|
1111 (car (xml-get-children node 'summary))))))
|
|
1112 ;; link-fn
|
|
1113 (lambda (node)
|
|
1114 (xml-get-attribute
|
|
1115 (car (xml-get-children node 'link)) 'href))
|
|
1116 ;; time-fn
|
|
1117 (lambda (node)
|
|
1118 (newsticker--decode-rfc822-date
|
|
1119 (car (xml-node-children
|
|
1120 (car (xml-get-children node 'modified))))))
|
|
1121 ;; guid-fn
|
|
1122 (lambda (node)
|
|
1123 (newsticker--guid-to-string
|
|
1124 (assoc 'guid (xml-node-children node))))
|
|
1125 ;; extra-fn
|
|
1126 (lambda (node)
|
|
1127 (xml-node-children node))))
|
|
1128 (or new-item new-feed)))
|
|
1129
|
|
1130 (defun newsticker--parse-atom-1.0 (name time topnode)
|
|
1131 "Parse Atom 1.0 data.
|
|
1132 Argument NAME gives the name of a news feed. TIME gives the
|
|
1133 system time at which the data have been retrieved. TOPNODE
|
|
1134 contains the feed data as returned by the xml parser.
|
|
1135
|
|
1136 For the Atom 1.0 specification see
|
|
1137 http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html"
|
|
1138 (newsticker--debug-msg "Parsing Atom 1.0 feed %s" name)
|
|
1139 (let (new-feed new-item)
|
|
1140 (setq new-feed (newsticker--parse-generic-feed
|
|
1141 name time
|
|
1142 ;; title
|
|
1143 (car (xml-node-children
|
|
1144 (car (xml-get-children topnode 'title))))
|
|
1145 ;; desc
|
|
1146 (car (xml-node-children
|
|
1147 (car (xml-get-children topnode 'subtitle))))
|
|
1148 ;; link
|
|
1149 (lambda (node)
|
|
1150 (xml-get-attribute
|
|
1151 (car (xml-get-children node 'link)) 'href))
|
|
1152 ;; extra-elements
|
|
1153 (xml-node-children topnode)))
|
|
1154 (setq new-item (newsticker--parse-generic-items
|
|
1155 name time (xml-get-children topnode 'entry)
|
|
1156 ;; title-fn
|
|
1157 (lambda (node)
|
|
1158 (car (xml-node-children
|
|
1159 (car (xml-get-children node 'title)))))
|
|
1160 ;; desc-fn
|
|
1161 (lambda (node)
|
|
1162 (or (car (xml-node-children
|
|
1163 (car (xml-get-children node 'content))))
|
|
1164 (car (xml-node-children
|
|
1165 (car (xml-get-children node 'summary))))))
|
|
1166 ;; link-fn
|
|
1167 (lambda (node)
|
|
1168 (xml-get-attribute
|
|
1169 (car (xml-get-children node 'link)) 'href))
|
|
1170 ;; time-fn
|
|
1171 (lambda (node)
|
|
1172 (newsticker--decode-iso8601-date
|
|
1173 (or (car (xml-node-children
|
|
1174 (car (xml-get-children node 'updated))))
|
|
1175 (car (xml-node-children
|
|
1176 (car (xml-get-children node 'published)))))))
|
|
1177 ;; guid-fn
|
|
1178 (lambda (node)
|
|
1179 (car (xml-node-children
|
|
1180 (car (xml-get-children node 'id)))))
|
|
1181 ;; extra-fn
|
|
1182 (lambda (node)
|
|
1183 (xml-node-children node))))
|
|
1184 (or new-item new-feed)))
|
|
1185
|
|
1186 (defun newsticker--parse-rss-0.91 (name time topnode)
|
|
1187 "Parse RSS 0.91 data.
|
|
1188 Return value as well as arguments NAME, TIME, and TOPNODE are the
|
|
1189 same as in `newsticker--parse-atom-1.0'.
|
|
1190
|
|
1191 For the RSS 0.91 specification see http://backend.userland.com/rss091 or
|
|
1192 http://my.netscape.com/publish/formats/rss-spec-0.91.html."
|
|
1193 (newsticker--debug-msg "Parsing RSS 0.91 feed %s" name)
|
|
1194 (let* ((channelnode (car (xml-get-children topnode 'channel)))
|
|
1195 (pub-date (newsticker--decode-rfc822-date
|
|
1196 (car (xml-node-children
|
|
1197 (car (xml-get-children channelnode 'pubDate))))))
|
|
1198 is-new-feed has-new-items)
|
|
1199 (setq is-new-feed (newsticker--parse-generic-feed
|
|
1200 name time
|
|
1201 ;; title
|
|
1202 (car (xml-node-children
|
|
1203 (car (xml-get-children channelnode 'title))))
|
|
1204 ;; desc
|
|
1205 (car (xml-node-children
|
|
1206 (car (xml-get-children channelnode
|
|
1207 'description))))
|
|
1208 ;; link
|
|
1209 (car (xml-node-children
|
|
1210 (car (xml-get-children channelnode 'link))))
|
|
1211 ;; extra-elements
|
|
1212 (xml-node-children channelnode)))
|
|
1213 (setq has-new-items (newsticker--parse-generic-items
|
|
1214 name time (xml-get-children channelnode 'item)
|
|
1215 ;; title-fn
|
|
1216 (lambda (node)
|
|
1217 (car (xml-node-children
|
|
1218 (car (xml-get-children node 'title)))))
|
|
1219 ;; desc-fn
|
|
1220 (lambda (node)
|
|
1221 (car (xml-node-children
|
|
1222 (car (xml-get-children node 'description)))))
|
|
1223 ;; link-fn
|
|
1224 (lambda (node)
|
|
1225 (car (xml-node-children
|
|
1226 (car (xml-get-children node 'link)))))
|
|
1227 ;; time-fn
|
|
1228 (lambda (node)
|
|
1229 (newsticker--decode-rfc822-date
|
|
1230 (car (xml-node-children
|
|
1231 (car (xml-get-children node 'pubDate))))))
|
|
1232 ;; guid-fn
|
|
1233 (lambda (node)
|
|
1234 nil)
|
|
1235 ;; extra-fn
|
|
1236 (lambda (node)
|
|
1237 (xml-node-children node))))
|
|
1238 (or has-new-items is-new-feed)))
|
|
1239
|
|
1240 (defun newsticker--parse-rss-0.92 (name time topnode)
|
|
1241 "Parse RSS 0.92 data.
|
|
1242 Return value as well as arguments NAME, TIME, and TOPNODE are the
|
|
1243 same as in `newsticker--parse-atom-1.0'.
|
|
1244
|
|
1245 For the RSS 0.92 specification see http://backend.userland.com/rss092."
|
|
1246 (newsticker--debug-msg "Parsing RSS 0.92 feed %s" name)
|
|
1247 (let* ((channelnode (car (xml-get-children topnode 'channel)))
|
|
1248 (pub-date (newsticker--decode-rfc822-date
|
|
1249 (car (xml-node-children
|
|
1250 (car (xml-get-children channelnode 'pubDate))))))
|
|
1251 is-new-feed has-new-items)
|
|
1252 (setq is-new-feed (newsticker--parse-generic-feed
|
|
1253 name time
|
|
1254 ;; title
|
|
1255 (car (xml-node-children
|
|
1256 (car (xml-get-children channelnode 'title))))
|
|
1257 ;; desc
|
|
1258 (car (xml-node-children
|
|
1259 (car (xml-get-children channelnode
|
|
1260 'description))))
|
|
1261 ;; link
|
|
1262 (car (xml-node-children
|
|
1263 (car (xml-get-children channelnode 'link))))
|
|
1264 ;; extra-elements
|
|
1265 (xml-node-children channelnode)))
|
|
1266 (setq has-new-items (newsticker--parse-generic-items
|
|
1267 name time (xml-get-children channelnode 'item)
|
|
1268 ;; title-fn
|
|
1269 (lambda (node)
|
|
1270 (car (xml-node-children
|
|
1271 (car (xml-get-children node 'title)))))
|
|
1272 ;; desc-fn
|
|
1273 (lambda (node)
|
|
1274 (car (xml-node-children
|
|
1275 (car (xml-get-children node 'description)))))
|
|
1276 ;; link-fn
|
|
1277 (lambda (node)
|
|
1278 (car (xml-node-children
|
|
1279 (car (xml-get-children node 'link)))))
|
|
1280 ;; time-fn
|
|
1281 (lambda (node)
|
|
1282 (newsticker--decode-rfc822-date
|
|
1283 (car (xml-node-children
|
|
1284 (car (xml-get-children node 'pubDate))))))
|
|
1285 ;; guid-fn
|
|
1286 (lambda (node)
|
|
1287 nil)
|
|
1288 ;; extra-fn
|
|
1289 (lambda (node)
|
|
1290 (xml-node-children node))))
|
|
1291 (or has-new-items is-new-feed)))
|
|
1292
|
|
1293 (defun newsticker--parse-rss-1.0 (name time topnode)
|
|
1294 "Parse RSS 1.0 data.
|
|
1295 Return value as well as arguments NAME, TIME, and TOPNODE are the
|
|
1296 same as in `newsticker--parse-atom-1.0'.
|
|
1297
|
|
1298 For the RSS 1.0 specification see http://web.resource.org/rss/1.0/spec."
|
|
1299 (newsticker--debug-msg "Parsing RSS 1.0 feed %s" name)
|
|
1300 (let* ((channelnode (car (xml-get-children topnode 'channel)))
|
|
1301 is-new-feed has-new-items)
|
|
1302 (setq is-new-feed (newsticker--parse-generic-feed
|
|
1303 name time
|
|
1304 ;; title
|
|
1305 (car (xml-node-children
|
|
1306 (car (xml-get-children channelnode 'title))))
|
|
1307 ;; desc
|
|
1308 (car (xml-node-children
|
|
1309 (car (xml-get-children channelnode
|
|
1310 'description))))
|
|
1311 ;; link
|
|
1312 (car (xml-node-children
|
|
1313 (car (xml-get-children channelnode 'link))))
|
|
1314 ;; extra-elements
|
|
1315 (xml-node-children channelnode)))
|
|
1316 (setq has-new-items (newsticker--parse-generic-items
|
|
1317 name time (xml-get-children topnode 'item)
|
|
1318 ;; title-fn
|
|
1319 (lambda (node)
|
|
1320 (car (xml-node-children
|
|
1321 (car (xml-get-children node 'title)))))
|
|
1322 ;; desc-fn
|
|
1323 (lambda (node)
|
|
1324 (car (xml-node-children
|
|
1325 (car (xml-get-children node
|
|
1326 'description)))))
|
|
1327 ;; link-fn
|
|
1328 (lambda (node)
|
|
1329 (car (xml-node-children
|
|
1330 (car (xml-get-children node 'link)))))
|
|
1331 ;; time-fn
|
|
1332 (lambda (node)
|
|
1333 (newsticker--decode-iso8601-date
|
|
1334 (car (xml-node-children
|
|
1335 (car (xml-get-children node 'dc:date))))))
|
|
1336 ;; guid-fn
|
|
1337 (lambda (node)
|
|
1338 nil)
|
|
1339 ;; extra-fn
|
|
1340 (lambda (node)
|
|
1341 (xml-node-children node))))
|
|
1342 (or has-new-items is-new-feed)))
|
|
1343
|
|
1344 (defun newsticker--parse-rss-2.0 (name time topnode)
|
|
1345 "Parse RSS 2.0 data.
|
|
1346 Return value as well as arguments NAME, TIME, and TOPNODE are the
|
|
1347 same as in `newsticker--parse-atom-1.0'.
|
|
1348
|
|
1349 For the RSS 2.0 specification see http://blogs.law.harvard.edu/tech/rss."
|
|
1350 (newsticker--debug-msg "Parsing RSS 2.0 feed %s" name)
|
|
1351 (let* ((channelnode (car (xml-get-children topnode 'channel)))
|
|
1352 is-new-feed has-new-items)
|
|
1353 (setq is-new-feed (newsticker--parse-generic-feed
|
|
1354 name time
|
|
1355 ;; title
|
|
1356 (car (xml-node-children
|
|
1357 (car (xml-get-children channelnode 'title))))
|
|
1358 ;; desc
|
|
1359 (car (xml-node-children
|
|
1360 (car (xml-get-children channelnode
|
|
1361 'description))))
|
|
1362 ;; link
|
|
1363 (car (xml-node-children
|
|
1364 (car (xml-get-children channelnode 'link))))
|
|
1365 ;; extra-elements
|
|
1366 (xml-node-children channelnode)))
|
|
1367 (setq has-new-items (newsticker--parse-generic-items
|
|
1368 name time (xml-get-children channelnode 'item)
|
|
1369 ;; title-fn
|
|
1370 (lambda (node)
|
|
1371 (car (xml-node-children
|
|
1372 (car (xml-get-children node 'title)))))
|
|
1373 ;; desc-fn
|
|
1374 (lambda (node)
|
|
1375 (or (car (xml-node-children
|
|
1376 (car (xml-get-children node
|
|
1377 'content:encoded))))
|
|
1378 (car (xml-node-children
|
|
1379 (car (xml-get-children node
|
|
1380 'description))))))
|
|
1381 ;; link-fn
|
|
1382 (lambda (node)
|
|
1383 (car (xml-node-children
|
|
1384 (car (xml-get-children node 'link)))))
|
|
1385 ;; time-fn
|
|
1386 (lambda (node)
|
|
1387 (newsticker--decode-rfc822-date
|
|
1388 (car (xml-node-children
|
|
1389 (car (xml-get-children node 'pubDate))))))
|
|
1390 ;; guid-fn
|
|
1391 (lambda (node)
|
|
1392 (newsticker--guid-to-string
|
|
1393 (assoc 'guid (xml-node-children node))))
|
|
1394 ;; extra-fn
|
|
1395 (lambda (node)
|
|
1396 (xml-node-children node))))
|
|
1397 (or has-new-items is-new-feed)))
|
|
1398
|
|
1399 (defun newsticker--parse-generic-feed (name time title desc link
|
|
1400 extra-elements)
|
|
1401 "Parse generic news feed data.
|
|
1402 Argument NAME gives the name of a news feed. TIME gives the
|
|
1403 system time at which the data have been retrieved.
|
|
1404
|
|
1405 The arguments TITLE, DESC, LINK, and EXTRA-ELEMENTS give the feed's title,
|
|
1406 description, link, and extra elements resp."
|
|
1407 (let ((title (or title "[untitled]"))
|
|
1408 (link (or link ""))
|
|
1409 (old-item nil)
|
|
1410 (position 0)
|
|
1411 (something-was-added nil))
|
|
1412 ;; decode numeric entities
|
|
1413 (setq title (newsticker--decode-numeric-entities title))
|
|
1414 (setq desc (newsticker--decode-numeric-entities desc))
|
|
1415 (setq link (newsticker--decode-numeric-entities link))
|
|
1416 ;; remove whitespace from title, desc, and link
|
|
1417 (setq title (newsticker--remove-whitespace title))
|
|
1418 (setq desc (newsticker--remove-whitespace desc))
|
|
1419 (setq link (newsticker--remove-whitespace link))
|
|
1420
|
|
1421 ;; handle the feed itself
|
|
1422 (unless (newsticker--cache-contains newsticker--cache
|
|
1423 (intern name) title
|
|
1424 desc link 'feed)
|
|
1425 (setq something-was-added t))
|
|
1426 (setq newsticker--cache
|
|
1427 (newsticker--cache-add newsticker--cache (intern name)
|
|
1428 title desc link time 'feed position
|
|
1429 extra-elements time 'feed))
|
|
1430 something-was-added))
|
|
1431
|
|
1432 (defun newsticker--parse-generic-items (name time itemlist
|
|
1433 title-fn desc-fn
|
|
1434 link-fn time-fn
|
|
1435 guid-fn extra-fn)
|
|
1436 "Parse generic news feed data.
|
|
1437 Argument NAME gives the name of a news feed. TIME gives the
|
|
1438 system time at which the data have been retrieved. ITEMLIST
|
|
1439 contains the news items returned by the xml parser.
|
|
1440
|
|
1441 The arguments TITLE-FN, DESC-FN, LINK-FN, TIME-FN, GUID-FN, and
|
|
1442 EXTRA-FN give functions for extracting title, description, link,
|
|
1443 time, guid, and extra-elements resp. They are called with one
|
|
1444 argument, which is one of the items in ITEMLIST."
|
|
1445 (let (title desc link
|
|
1446 (old-item nil)
|
|
1447 (position 0)
|
|
1448 (something-was-added nil))
|
|
1449 ;; gather all items for this feed
|
|
1450 (mapc (lambda (node)
|
|
1451 (setq position (1+ position))
|
|
1452 (setq title (or (funcall title-fn node) "[untitled]"))
|
|
1453 (setq desc (funcall desc-fn node))
|
|
1454 (setq link (or (funcall link-fn node) ""))
|
|
1455 (setq time (or (funcall time-fn node) time))
|
|
1456 ;; It happened that the title or description
|
|
1457 ;; contained evil HTML code that confused the
|
|
1458 ;; xml parser. Therefore:
|
|
1459 (unless (stringp title)
|
|
1460 (setq title (prin1-to-string title)))
|
|
1461 (unless (or (stringp desc) (not desc))
|
|
1462 (setq desc (prin1-to-string desc)))
|
|
1463 ;; ignore items with empty title AND empty desc
|
|
1464 (when (or (> (length title) 0)
|
|
1465 (> (length desc) 0))
|
|
1466 ;; decode numeric entities
|
|
1467 (setq title (newsticker--decode-numeric-entities title))
|
|
1468 (when desc
|
|
1469 (setq desc (newsticker--decode-numeric-entities desc)))
|
|
1470 (setq link (newsticker--decode-numeric-entities link))
|
|
1471 ;; remove whitespace from title, desc, and link
|
|
1472 (setq title (newsticker--remove-whitespace title))
|
|
1473 (setq desc (newsticker--remove-whitespace desc))
|
|
1474 (setq link (newsticker--remove-whitespace link))
|
|
1475 ;; add data to cache
|
|
1476 ;; do we have this item already?
|
|
1477 (let* ((guid (funcall guid-fn node)))
|
|
1478 ;;(message "guid=%s" guid)
|
|
1479 (setq old-item
|
|
1480 (newsticker--cache-contains newsticker--cache
|
|
1481 (intern name) title
|
|
1482 desc link nil guid)))
|
|
1483 ;; add this item, or mark it as old, or do nothing
|
|
1484 (let ((age1 'new)
|
|
1485 (age2 'old)
|
|
1486 (item-new-p nil))
|
|
1487 (if old-item
|
|
1488 (let ((prev-age (newsticker--age old-item)))
|
|
1489 (unless newsticker-automatically-mark-items-as-old
|
|
1490 ;; Some feeds deliver items multiply, the
|
|
1491 ;; first time we find an 'obsolete-old one the
|
|
1492 ;; cache, the following times we find an 'old
|
|
1493 ;; one
|
|
1494 (if (memq prev-age '(obsolete-old old))
|
|
1495 (setq age2 'old)
|
|
1496 (setq age2 'new)))
|
|
1497 (if (eq prev-age 'immortal)
|
|
1498 (setq age2 'immortal))
|
|
1499 (setq time (newsticker--time old-item)))
|
|
1500 ;; item was not there
|
|
1501 (setq item-new-p t)
|
|
1502 (setq something-was-added t))
|
|
1503 (setq newsticker--cache
|
|
1504 (newsticker--cache-add
|
|
1505 newsticker--cache (intern name) title desc link
|
|
1506 time age1 position (funcall extra-fn node)
|
|
1507 time age2))
|
|
1508 (when item-new-p
|
|
1509 (let ((item (newsticker--cache-contains
|
|
1510 newsticker--cache (intern name) title
|
|
1511 desc link nil)))
|
|
1512 (if newsticker-auto-mark-filter-list
|
|
1513 (newsticker--run-auto-mark-filter name item))
|
|
1514 (run-hook-with-args
|
|
1515 'newsticker-new-item-functions name item))))))
|
|
1516 itemlist)
|
|
1517 something-was-added))
|
|
1518
|
|
1519 ;; ======================================================================
|
|
1520 ;;; Misc
|
|
1521 ;; ======================================================================
|
|
1522 (defun newsticker--decode-numeric-entities (string)
|
|
1523 "Decode SGML numeric entities by their respective utf characters.
|
|
1524 This function replaces numeric entities in the input STRING and
|
|
1525 returns the modified string. For example \"*\" gets replaced
|
|
1526 by \"*\"."
|
|
1527 (if (and string (stringp string))
|
|
1528 (let ((start 0))
|
|
1529 (while (string-match "&#\\([0-9]+\\);" string start)
|
|
1530 (condition-case nil
|
|
1531 (setq string (replace-match
|
|
1532 (string (read (substring string
|
|
1533 (match-beginning 1)
|
|
1534 (match-end 1))))
|
|
1535 nil nil string))
|
|
1536 (error nil))
|
|
1537 (setq start (1+ (match-beginning 0))))
|
|
1538 string)
|
|
1539 nil))
|
|
1540
|
|
1541 (defun newsticker--remove-whitespace (string)
|
|
1542 "Remove leading and trailing whitespace from STRING."
|
|
1543 ;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
|
|
1544 ;; endlessly...
|
|
1545 (when (and string (stringp string))
|
|
1546 (replace-regexp-in-string
|
|
1547 "[ \t\r\n]+$" ""
|
|
1548 (replace-regexp-in-string "^[ \t\r\n]+" "" string))))
|
|
1549
|
|
1550 (defun newsticker--do-forget-preformatted (item)
|
|
1551 "Forget pre-formatted data for ITEM.
|
|
1552 Remove the pre-formatted from `newsticker--cache'."
|
|
1553 (if (nthcdr 7 item)
|
|
1554 (setcar (nthcdr 7 item) nil))
|
|
1555 (if (nthcdr 6 item)
|
|
1556 (setcar (nthcdr 6 item) nil)))
|
|
1557
|
|
1558 (defun newsticker--forget-preformatted ()
|
|
1559 "Forget all cached pre-formatted data.
|
|
1560 Remove the pre-formatted from `newsticker--cache'."
|
|
1561 (mapc (lambda (feed)
|
|
1562 (mapc 'newsticker--do-forget-preformatted
|
|
1563 (cdr feed)))
|
|
1564 newsticker--cache)
|
|
1565 (when (fboundp 'newsticker--buffer-set-uptodate)
|
|
1566 (newsticker--buffer-set-uptodate nil)))
|
|
1567
|
|
1568 (defun newsticker--debug-msg (string &rest args)
|
|
1569 "Print newsticker debug messages.
|
|
1570 This function calls `message' with arguments STRING and ARGS, if
|
|
1571 `newsticker-debug' is non-nil."
|
|
1572 (and newsticker-debug
|
|
1573 ;;(not (active-minibuffer-window))
|
|
1574 ;;(not (current-message))
|
|
1575 (apply 'message string args)))
|
|
1576
|
|
1577 (defun newsticker--decode-iso8601-date (iso8601-string)
|
|
1578 "Return ISO8601-STRING in format like `decode-time'.
|
|
1579 Converts from ISO-8601 to Emacs representation.
|
|
1580 Examples:
|
|
1581 2004-09-17T05:09:49.001+00:00
|
|
1582 2004-09-17T05:09:49+00:00
|
|
1583 2004-09-17T05:09+00:00
|
|
1584 2004-09-17T05:09:49
|
|
1585 2004-09-17T05:09
|
|
1586 2004-09-17
|
|
1587 2004-09
|
|
1588 2004"
|
|
1589 (if iso8601-string
|
|
1590 (when (string-match
|
|
1591 (concat
|
|
1592 "^ *\\([0-9]\\{4\\}\\)" ;year
|
|
1593 "\\(-\\([0-9]\\{2\\}\\)" ;month
|
|
1594 "\\(-\\([0-9]\\{2\\}\\)" ;day
|
|
1595 "\\(T"
|
|
1596 "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" ;hour:minute
|
|
1597 "\\(:\\([0-9]\\{2\\}\\)\\(\\.[0-9]+\\)?\\)?" ;second
|
|
1598 ;timezone
|
|
1599 "\\(\\([-+Z]\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)?"
|
|
1600 "\\)?\\)?\\)? *$")
|
|
1601 iso8601-string)
|
|
1602 (let ((year (read (match-string 1 iso8601-string)))
|
|
1603 (month (read (or (match-string 3 iso8601-string)
|
|
1604 "1")))
|
|
1605 (day (read (or (match-string 5 iso8601-string)
|
|
1606 "1")))
|
|
1607 (hour (read (or (match-string 7 iso8601-string)
|
|
1608 "0")))
|
|
1609 (minute (read (or (match-string 8 iso8601-string)
|
|
1610 "0")))
|
|
1611 (second (read (or (match-string 10 iso8601-string)
|
|
1612 "0")))
|
|
1613 (sign (match-string 13 iso8601-string))
|
|
1614 (offset-hour (read (or (match-string 15 iso8601-string)
|
|
1615 "0")))
|
|
1616 (offset-minute (read (or (match-string 16 iso8601-string)
|
|
1617 "0"))))
|
|
1618 (cond ((string= sign "+")
|
|
1619 (setq hour (- hour offset-hour))
|
|
1620 (setq minute (- minute offset-minute)))
|
|
1621 ((string= sign "-")
|
|
1622 (setq hour (+ hour offset-hour))
|
|
1623 (setq minute (+ minute offset-minute))))
|
|
1624 ;; if UTC subtract current-time-zone offset
|
|
1625 ;;(setq second (+ (car (current-time-zone)) second)))
|
|
1626
|
|
1627 (condition-case nil
|
|
1628 (encode-time second minute hour day month year t)
|
|
1629 (error
|
|
1630 (message "Cannot decode \"%s\"" iso8601-string)
|
|
1631 nil))))
|
|
1632 nil))
|
|
1633
|
|
1634 (defun newsticker--decode-rfc822-date (rfc822-string)
|
|
1635 "Return RFC822-STRING in format like `decode-time'.
|
|
1636 Converts from RFC822 to Emacs representation.
|
|
1637 Examples:
|
|
1638 Sat, 07 September 2002 00:00:01 +0100
|
|
1639 Sat, 07 September 2002 00:00:01 MET
|
|
1640 Sat, 07 Sep 2002 00:00:01 GMT
|
|
1641 07 Sep 2002 00:00:01 GMT
|
|
1642 07 Sep 2002"
|
|
1643 (if (and rfc822-string (stringp rfc822-string))
|
|
1644 (when (string-match
|
|
1645 (concat
|
|
1646 "\\s-*"
|
|
1647 ;; week day
|
|
1648 "\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)?\\s-*"
|
|
1649 ;; day
|
|
1650 "\\([0-9]\\{1,2\\}\\)\\s-+"
|
|
1651 ;; month
|
|
1652 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|"
|
|
1653 "Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\).*?\\s-+"
|
|
1654 ;; year
|
|
1655 "\\([0-9]\\{2,4\\}\\)"
|
|
1656 ;; time may be missing
|
|
1657 "\\(\\s-+"
|
|
1658 ;; hour
|
|
1659 "\\([0-9]\\{2\\}\\)"
|
|
1660 ;; minute
|
|
1661 ":\\([0-9]\\{2\\}\\)"
|
|
1662 ;; second
|
|
1663 "\\(:\\([0-9]\\{2\\}\\)\\)?"
|
|
1664 ;; zone -- fixme
|
|
1665 "\\(\\s-+\\("
|
|
1666 "UT\\|GMT\\|EST\\|EDT\\|CST\\|CDT\\|MST\\|MDT\\|PST\\|PDT"
|
|
1667 "\\|\\([-+]\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)"
|
|
1668 "\\)\\)?"
|
|
1669 "\\)?")
|
|
1670 rfc822-string)
|
|
1671 (let ((day (read (match-string 3 rfc822-string)))
|
|
1672 (month-name (match-string 4 rfc822-string))
|
|
1673 (month 0)
|
|
1674 (year (read (match-string 5 rfc822-string)))
|
|
1675 (hour (read (or (match-string 7 rfc822-string) "0")))
|
|
1676 (minute (read (or (match-string 8 rfc822-string) "0")))
|
|
1677 (second (read (or (match-string 10 rfc822-string) "0")))
|
|
1678 (zone (match-string 12 rfc822-string))
|
|
1679 (sign (match-string 13 rfc822-string))
|
|
1680 (offset-hour (read (or (match-string 14 rfc822-string)
|
|
1681 "0")))
|
|
1682 (offset-minute (read (or (match-string 15 rfc822-string)
|
|
1683 "0")))
|
|
1684 ;;FIXME
|
|
1685 )
|
|
1686 (when zone
|
|
1687 (cond ((string= sign "+")
|
|
1688 (setq hour (- hour offset-hour))
|
|
1689 (setq minute (- minute offset-minute)))
|
|
1690 ((string= sign "-")
|
|
1691 (setq hour (+ hour offset-hour))
|
|
1692 (setq minute (+ minute offset-minute)))))
|
|
1693 (condition-case error-data
|
|
1694 (let ((i 1))
|
|
1695 (mapc (lambda (m)
|
|
1696 (if (string= month-name m)
|
|
1697 (setq month i))
|
|
1698 (setq i (1+ i)))
|
|
1699 '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
|
|
1700 "Sep" "Oct" "Nov" "Dec"))
|
|
1701 (encode-time second minute hour day month year t))
|
|
1702 (error
|
|
1703 (message "Cannot decode \"%s\": %s %s" rfc822-string
|
|
1704 (car error-data) (cdr error-data))
|
|
1705 nil))))
|
|
1706 nil))
|
|
1707
|
|
1708 (defun newsticker--lists-intersect-p (list1 list2)
|
|
1709 "Return t if LIST1 and LIST2 share elements."
|
|
1710 (let ((result nil))
|
|
1711 (mapc (lambda (elt)
|
|
1712 (if (memq elt list2)
|
|
1713 (setq result t)))
|
|
1714 list1)
|
|
1715 result))
|
|
1716
|
|
1717 (defun newsticker--update-process-ids ()
|
|
1718 "Update list of ids of active newsticker processes.
|
|
1719 Checks list of active processes against list of newsticker processes."
|
|
1720 (let ((active-procs (process-list))
|
|
1721 (new-list nil))
|
|
1722 (mapc (lambda (proc)
|
|
1723 (let ((id (process-id proc)))
|
|
1724 (if (memq id newsticker--process-ids)
|
|
1725 (setq new-list (cons id new-list)))))
|
|
1726 active-procs)
|
|
1727 (setq newsticker--process-ids new-list))
|
|
1728 (force-mode-line-update))
|
|
1729
|
|
1730 ;; ======================================================================
|
|
1731 ;;; Images
|
|
1732 ;; ======================================================================
|
|
1733 (defun newsticker--image-get (feed-name url)
|
|
1734 "Get image of the news site FEED-NAME from URL.
|
|
1735 If the image has been downloaded in the last 24h do nothing."
|
|
1736 (let ((image-name (concat newsticker-imagecache-dirname "/"
|
|
1737 feed-name)))
|
|
1738 (if (and (file-exists-p image-name)
|
|
1739 (time-less-p (current-time)
|
|
1740 (time-add (nth 5 (file-attributes image-name))
|
|
1741 (seconds-to-time 86400))))
|
|
1742 (newsticker--debug-msg "%s: Getting image for %s skipped"
|
|
1743 (format-time-string "%A, %H:%M" (current-time))
|
|
1744 feed-name)
|
|
1745 ;; download
|
|
1746 (newsticker--debug-msg "%s: Getting image for %s"
|
|
1747 (format-time-string "%A, %H:%M" (current-time))
|
|
1748 feed-name)
|
|
1749 (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*"))
|
|
1750 (item (or (assoc feed-name newsticker-url-list)
|
|
1751 (assoc feed-name newsticker-url-list-defaults)
|
|
1752 (error
|
|
1753 "Cannot get news for %s: Check newsticker-url-list"
|
|
1754 feed-name)))
|
|
1755 (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
|
|
1756 newsticker-wget-arguments)))
|
|
1757 (save-excursion
|
|
1758 (set-buffer (get-buffer-create buffername))
|
|
1759 (erase-buffer)
|
|
1760 ;; throw an error if there is an old wget-process around
|
|
1761 (if (get-process feed-name)
|
|
1762 (error "Another wget-process is running for image %s"
|
|
1763 feed-name))
|
|
1764 ;; start wget
|
|
1765 (let* ((args (append wget-arguments (list url)))
|
|
1766 (proc (apply 'start-process feed-name buffername
|
|
1767 newsticker-wget-name args)))
|
|
1768 (set-process-coding-system proc 'no-conversion 'no-conversion)
|
|
1769 (set-process-sentinel proc 'newsticker--image-sentinel)))))))
|
|
1770
|
|
1771 (defun newsticker--image-sentinel (process event)
|
|
1772 "Sentinel for image-retrieving PROCESS caused by EVENT."
|
|
1773 (let* ((p-status (process-status process))
|
|
1774 (exit-status (process-exit-status process))
|
|
1775 (feed-name (process-name process)))
|
|
1776 ;; catch known errors (zombie processes, rubbish-xml, etc.)
|
|
1777 ;; if an error occurs the news feed is not updated!
|
|
1778 (catch 'oops
|
|
1779 (unless (and (eq p-status 'exit)
|
|
1780 (= exit-status 0))
|
|
1781 (message "%s: Error while retrieving image from %s"
|
|
1782 (format-time-string "%A, %H:%M" (current-time))
|
|
1783 feed-name)
|
|
1784 (throw 'oops nil))
|
|
1785 (let (image-name)
|
|
1786 (save-excursion
|
|
1787 (set-buffer (process-buffer process))
|
|
1788 (setq image-name (concat newsticker-imagecache-dirname "/"
|
|
1789 feed-name))
|
|
1790 (set-buffer-file-coding-system 'no-conversion)
|
|
1791 ;; make sure the cache dir exists
|
|
1792 (unless (file-directory-p newsticker-imagecache-dirname)
|
|
1793 (make-directory newsticker-imagecache-dirname))
|
|
1794 ;; write and close buffer
|
|
1795 (let ((require-final-newline nil)
|
|
1796 (backup-inhibited t)
|
|
1797 (coding-system-for-write 'no-conversion))
|
|
1798 (write-region nil nil image-name nil 'quiet))
|
|
1799 (set-buffer-modified-p nil)
|
|
1800 (kill-buffer (current-buffer)))))))
|
|
1801
|
|
1802
|
|
1803
|
|
1804 (defun newsticker--insert-image (img string)
|
|
1805 "Insert IMG with STRING at point."
|
|
1806 (insert-image img string))
|
|
1807
|
|
1808 ;; ======================================================================
|
|
1809 ;;; HTML rendering
|
|
1810 ;; ======================================================================
|
|
1811 (defun newsticker-htmlr-render (pos1 pos2) ;
|
|
1812 "Replacement for `htmlr-render'.
|
|
1813 Renders the HTML code in the region POS1 to POS2 using htmlr."
|
|
1814 (let ((str (buffer-substring-no-properties pos1 pos2)))
|
|
1815 (delete-region pos1 pos2)
|
|
1816 (insert
|
|
1817 (with-temp-buffer
|
|
1818 (insert str)
|
|
1819 (goto-char (point-min))
|
|
1820 ;; begin original htmlr-render
|
|
1821 (when (fboundp 'htmlr-reset) (htmlr-reset))
|
|
1822 ;; something omitted here...
|
|
1823 (when (fboundp 'htmlr-step)
|
|
1824 (while (< (point) (point-max))
|
|
1825 (htmlr-step)))
|
|
1826 ;; end original htmlr-render
|
|
1827 (newsticker--remove-whitespace (buffer-string))))))
|
|
1828
|
|
1829 ;; ======================================================================
|
|
1830 ;;; Manipulation of cached data
|
|
1831 ;; ======================================================================
|
|
1832 (defun newsticker--cache-set-preformatted-contents (item contents)
|
|
1833 "Set preformatted contents of ITEM to CONTENTS."
|
|
1834 (if (nthcdr 6 item)
|
|
1835 (setcar (nthcdr 6 item) contents)
|
|
1836 (setcdr (nthcdr 5 item) (list contents))))
|
|
1837
|
|
1838 (defun newsticker--cache-set-preformatted-title (item title)
|
|
1839 "Set preformatted title of ITEM to TITLE."
|
|
1840 (if (nthcdr 7 item)
|
|
1841 (setcar (nthcdr 7 item) title)
|
|
1842 (setcdr (nthcdr 6 item) title)))
|
|
1843
|
|
1844 (defun newsticker--cache-replace-age (data feed old-age new-age)
|
|
1845 "Mark all items in DATA in FEED which carry age OLD-AGE with NEW-AGE.
|
|
1846 If FEED is 'any it applies to all feeds. If OLD-AGE is 'any,
|
|
1847 all marks are replaced by NEW-AGE. Removes all pre-formatted contents."
|
|
1848 (mapc (lambda (a-feed)
|
|
1849 (when (or (eq feed 'any)
|
|
1850 (eq (car a-feed) feed))
|
|
1851 (let ((items (cdr a-feed)))
|
|
1852 (mapc (lambda (item)
|
|
1853 (when (or (eq old-age 'any)
|
|
1854 (eq (newsticker--age item) old-age))
|
|
1855 (setcar (nthcdr 4 item) new-age)
|
|
1856 (newsticker--do-forget-preformatted item)))
|
|
1857 items))))
|
|
1858 data)
|
|
1859 data)
|
|
1860
|
|
1861 (defun newsticker--cache-mark-expired (data feed old-age new-age time)
|
|
1862 "Mark all expired entries.
|
|
1863 This function sets the age entries in DATA in the feed FEED. If
|
|
1864 an item's age is OLD-AGE it is set to NEW-AGE if the item is
|
|
1865 older than TIME."
|
|
1866 (mapc
|
|
1867 (lambda (a-feed)
|
|
1868 (when (or (eq feed 'any)
|
|
1869 (eq (car a-feed) feed))
|
|
1870 (let ((items (cdr a-feed)))
|
|
1871 (mapc
|
|
1872 (lambda (item)
|
|
1873 (when (eq (newsticker--age item) old-age)
|
|
1874 (let ((exp-time (time-add (newsticker--time item)
|
|
1875 (seconds-to-time time))))
|
|
1876 (when (time-less-p exp-time (current-time))
|
|
1877 (newsticker--debug-msg
|
|
1878 "Item `%s' from %s has expired on %s"
|
|
1879 (newsticker--title item)
|
|
1880 (format-time-string "%Y-%02m-%d, %H:%M"
|
|
1881 (newsticker--time item))
|
|
1882 (format-time-string "%Y-%02m-%d, %H:%M" exp-time))
|
|
1883 (setcar (nthcdr 4 item) new-age)))))
|
|
1884 items))))
|
|
1885 data)
|
|
1886 data)
|
|
1887
|
|
1888 (defun newsticker--cache-contains (data feed title desc link age
|
|
1889 &optional guid)
|
|
1890 "Check DATA whether FEED contains an item with the given properties.
|
|
1891 This function returns the contained item or nil if it is not
|
|
1892 contained.
|
|
1893 The properties which are checked are TITLE, DESC, LINK, AGE, and
|
|
1894 GUID. In general all properties must match in order to return a
|
|
1895 certain item, except for the following cases.
|
|
1896
|
|
1897 If AGE equals 'feed the TITLE, DESCription and LINK do not
|
|
1898 matter. If DESC is nil it is ignored as well. If
|
|
1899 `newsticker-desc-comp-max' is non-nil, only the first
|
|
1900 `newsticker-desc-comp-max' characters of DESC are taken into
|
|
1901 account.
|
|
1902
|
|
1903 If GUID is non-nil it is sufficient to match this value, and the
|
|
1904 other properties are ignored."
|
|
1905 ;;(newsticker--debug-msg "Looking for %s guid=%s" title guid)
|
|
1906 (condition-case nil
|
|
1907 (catch 'found
|
|
1908 (when (and desc newsticker-desc-comp-max
|
|
1909 (> (length desc) newsticker-desc-comp-max))
|
|
1910 (setq desc (substring desc 0 newsticker-desc-comp-max)))
|
|
1911 (mapc
|
|
1912 (lambda (this-feed)
|
|
1913 (when (eq (car this-feed) feed)
|
|
1914 (mapc (lambda (anitem)
|
|
1915 (when (cond (guid
|
|
1916 ;; global unique id can match
|
|
1917 (string= guid (newsticker--guid anitem)))
|
|
1918 (t;;FIXME?
|
|
1919 (or
|
|
1920 ;; or title, desc, etc.
|
|
1921 (and
|
|
1922 ;;(or (not (eq age 'feed))
|
|
1923 ;; (eq (newsticker--age anitem) 'feed))
|
|
1924 (string= (newsticker--title anitem)
|
|
1925 title)
|
|
1926 (or (not link)
|
|
1927 (string= (newsticker--link anitem)
|
|
1928 link))
|
|
1929 (or (not desc)
|
|
1930 (if (and desc newsticker-desc-comp-max
|
|
1931 (> (length (newsticker--desc
|
|
1932 anitem))
|
|
1933 newsticker-desc-comp-max))
|
|
1934 (string= (substring
|
|
1935 (newsticker--desc anitem)
|
|
1936 0
|
|
1937 newsticker-desc-comp-max)
|
|
1938 desc)
|
|
1939 (string= (newsticker--desc anitem)
|
|
1940 desc)))))))
|
|
1941 ;;(newsticker--debug-msg "Found %s guid=%s"
|
|
1942 ;; (newsticker--title anitem)
|
|
1943 ;; (newsticker--guid anitem))
|
|
1944 (throw 'found anitem)))
|
|
1945 (cdr this-feed))))
|
|
1946 data)
|
|
1947 ;;(newsticker--debug-msg "Found nothing")
|
|
1948 nil)
|
|
1949 (error nil)))
|
|
1950
|
|
1951 (defun newsticker--cache-add (data feed-name-symbol title desc link time age
|
|
1952 position extra-elements
|
|
1953 &optional updated-time updated-age
|
|
1954 preformatted-contents
|
|
1955 preformatted-title)
|
|
1956 "Add another item to cache data.
|
|
1957 Add to DATA in the FEED-NAME-SYMBOL an item with TITLE, DESC,
|
|
1958 LINK, TIME, AGE, POSITION, and EXTRA-ELEMENTS. If this item is
|
|
1959 contained already, its time is set to UPDATED-TIME, its mark is
|
|
1960 set to UPDATED-AGE, and its pre-formatted contents is set to
|
|
1961 PREFORMATTED-CONTENTS and PREFORMATTED-TITLE. Returns the age
|
|
1962 which the item got."
|
|
1963 (let* ((guid (newsticker--guid-to-string (assoc 'guid extra-elements)))
|
|
1964 (item (newsticker--cache-contains data feed-name-symbol title desc link
|
|
1965 age guid)))
|
|
1966 ;;(message "guid=%s" guid)
|
|
1967 (if item
|
|
1968 ;; does exist already -- change age, update time and position
|
|
1969 (progn
|
|
1970 ;;(newsticker--debug-msg "Updating item %s %s %s %s %s -> %s %s
|
|
1971 ;; (guid %s -> %s)"
|
|
1972 ;; feed-name-symbol title link time age
|
|
1973 ;; updated-time updated-age
|
|
1974 ;; guid (newsticker--guid item))
|
|
1975 (if (nthcdr 5 item)
|
|
1976 (setcar (nthcdr 5 item) position)
|
|
1977 (setcdr (nthcdr 4 item) (list position)))
|
|
1978 (setcar (nthcdr 4 item) updated-age)
|
|
1979 (if updated-time
|
|
1980 (setcar (nthcdr 3 item) updated-time))
|
|
1981 ;; replace cached pre-formatted contents
|
|
1982 (newsticker--cache-set-preformatted-contents
|
|
1983 item preformatted-contents)
|
|
1984 (newsticker--cache-set-preformatted-title
|
|
1985 item preformatted-title))
|
|
1986 ;; did not exist or age equals 'feed-name-symbol
|
|
1987 (setq item (list title desc link time age position preformatted-contents
|
|
1988 preformatted-title extra-elements))
|
|
1989 ;;(newsticker--debug-msg "Adding item %s" item)
|
|
1990 (catch 'found
|
|
1991 (mapc (lambda (this-feed)
|
|
1992 (when (eq (car this-feed) feed-name-symbol)
|
|
1993 (setcdr this-feed (nconc (cdr this-feed) (list item)))
|
|
1994 (throw 'found this-feed)))
|
|
1995 data)
|
|
1996 ;; the feed is not contained
|
|
1997 (add-to-list 'data (list feed-name-symbol item) t))))
|
|
1998 data)
|
|
1999
|
|
2000 (defun newsticker--cache-remove (data feed-symbol age)
|
|
2001 "Remove all entries from DATA in the feed FEED-SYMBOL with AGE.
|
|
2002 FEED-SYMBOL may be 'any. Entries from old feeds, which are no longer in
|
|
2003 `newsticker-url-list' or `newsticker-url-list-defaults', are removed as
|
|
2004 well."
|
|
2005 (let* ((pos data)
|
|
2006 (feed (car pos))
|
|
2007 (last-pos nil))
|
|
2008 (while feed
|
|
2009 (if (or (assoc (symbol-name (car feed)) newsticker-url-list)
|
|
2010 (assoc (symbol-name (car feed)) newsticker-url-list-defaults))
|
|
2011 ;; feed is still valid=active
|
|
2012 ;; (message "Keeping feed %s" (car feed))
|
|
2013 (if (or (eq feed-symbol 'any)
|
|
2014 (eq feed-symbol (car feed)))
|
|
2015 (let* ((item-pos (cdr feed))
|
|
2016 (item (car item-pos))
|
|
2017 (prev-pos nil))
|
|
2018 (while item
|
|
2019 ;;(message "%s" (car item))
|
|
2020 (if (eq age (newsticker--age item))
|
|
2021 ;; remove this item
|
|
2022 (progn
|
|
2023 ;;(message "Removing item %s" (car item))
|
|
2024 (if prev-pos
|
|
2025 (setcdr prev-pos (cdr item-pos))
|
|
2026 (setcdr feed (cdr item-pos))))
|
|
2027 ;;(message "Keeping item %s" (car item))
|
|
2028 (setq prev-pos item-pos))
|
|
2029 (setq item-pos (cdr item-pos))
|
|
2030 (setq item (car item-pos)))))
|
|
2031 ;; feed is not active anymore
|
|
2032 ;; (message "Removing feed %s" (car feed))
|
|
2033 (if last-pos
|
|
2034 (setcdr last-pos (cdr pos))
|
|
2035 (setq data (cdr pos))))
|
|
2036 (setq last-pos pos)
|
|
2037 (setq pos (cdr pos))
|
|
2038 (setq feed (car pos)))))
|
|
2039
|
|
2040 ;; ======================================================================
|
|
2041 ;;; Sorting
|
|
2042 ;; ======================================================================
|
|
2043 (defun newsticker--cache-item-compare-by-time (item1 item2)
|
|
2044 "Compare two news items ITEM1 and ITEM2 by comparing their time values."
|
|
2045 (catch 'result
|
|
2046 (let ((age1 (newsticker--age item1))
|
|
2047 (age2 (newsticker--age item2)))
|
|
2048 (if (not (eq age1 age2))
|
|
2049 (cond ((eq age1 'obsolete)
|
|
2050 (throw 'result nil))
|
|
2051 ((eq age2 'obsolete)
|
|
2052 (throw 'result t)))))
|
|
2053 (let* ((time1 (newsticker--time item1))
|
|
2054 (time2 (newsticker--time item2)))
|
|
2055 (cond ((< (nth 0 time1) (nth 0 time2))
|
|
2056 nil)
|
|
2057 ((> (nth 0 time1) (nth 0 time2))
|
|
2058 t)
|
|
2059 ((< (nth 1 time1) (nth 1 time2))
|
|
2060 nil)
|
|
2061 ((> (nth 1 time1) (nth 1 time2))
|
|
2062 t)
|
|
2063 ((< (or (nth 2 time1) 0) (or (nth 2 time2) 0))
|
|
2064 nil)
|
|
2065 ((> (or (nth 2 time1) 0) (or (nth 2 time2) 0))
|
|
2066 t)
|
|
2067 (t
|
|
2068 nil)))))
|
|
2069
|
|
2070 (defun newsticker--cache-item-compare-by-title (item1 item2)
|
|
2071 "Compare ITEM1 and ITEM2 by comparing their titles."
|
|
2072 (catch 'result
|
|
2073 (let ((age1 (newsticker--age item1))
|
|
2074 (age2 (newsticker--age item2)))
|
|
2075 (if (not (eq age1 age2))
|
|
2076 (cond ((eq age1 'obsolete)
|
|
2077 (throw 'result nil))
|
|
2078 ((eq age2 'obsolete)
|
|
2079 (throw 'result t)))))
|
|
2080 (string< (newsticker--title item1) (newsticker--title item2))))
|
|
2081
|
|
2082 (defun newsticker--cache-item-compare-by-position (item1 item2)
|
|
2083 "Compare ITEM1 and ITEM2 by comparing their original positions."
|
|
2084 (catch 'result
|
|
2085 (let ((age1 (newsticker--age item1))
|
|
2086 (age2 (newsticker--age item2)))
|
|
2087 (if (not (eq age1 age2))
|
|
2088 (cond ((eq age1 'obsolete)
|
|
2089 (throw 'result nil))
|
|
2090 ((eq age2 'obsolete)
|
|
2091 (throw 'result t)))))
|
|
2092 (< (or (newsticker--pos item1) 0) (or (newsticker--pos item2) 0))))
|
|
2093
|
|
2094
|
|
2095
|
|
2096 (defun newsticker--cache-save ()
|
|
2097 "Update and save newsticker cache file."
|
|
2098 (interactive)
|
|
2099 (newsticker--cache-update t))
|
|
2100
|
|
2101 (defun newsticker--cache-update (&optional save)
|
|
2102 "Update newsticker cache file.
|
|
2103 If optional argument SAVE is not nil the cache file is saved to disk."
|
|
2104 (save-excursion
|
|
2105 (let ((coding-system-for-write 'utf-8))
|
|
2106 (with-temp-buffer
|
|
2107 (setq buffer-undo-list t)
|
|
2108 (erase-buffer)
|
|
2109 (insert ";; -*- coding: utf-8 -*-\n")
|
|
2110 (insert (prin1-to-string newsticker--cache))
|
|
2111 (when save
|
|
2112 (set-visited-file-name newsticker-cache-filename)
|
|
2113 (save-buffer))))))
|
|
2114
|
|
2115 (defun newsticker--cache-get-feed (feed)
|
|
2116 "Return the cached data for the feed FEED.
|
|
2117 FEED is a symbol!"
|
|
2118 (assoc feed newsticker--cache))
|
|
2119
|
|
2120 ;; ======================================================================
|
|
2121 ;;; Statistics
|
|
2122 ;; ======================================================================
|
|
2123 (defun newsticker--stat-num-items (feed &rest ages)
|
|
2124 "Return number of items in the given FEED which have one of the given AGES.
|
|
2125 If AGES is nil, the total number of items is returned."
|
|
2126 (let ((items (cdr (newsticker--cache-get-feed feed)))
|
|
2127 (num 0))
|
|
2128 (while items
|
|
2129 (if ages
|
|
2130 (if (memq (newsticker--age (car items)) ages)
|
|
2131 (setq num (1+ num)))
|
|
2132 (if (memq (newsticker--age (car items)) '(new old immortal obsolete))
|
|
2133 (setq num (1+ num))))
|
|
2134 (setq items (cdr items)))
|
|
2135 num))
|
|
2136
|
|
2137 (defun newsticker--stat-num-items-total (&optional age)
|
|
2138 "Return total number of items in all feeds which have the given AGE.
|
|
2139 If AGE is nil, the total number of items is returned."
|
|
2140 (apply '+
|
|
2141 (mapcar (lambda (feed)
|
|
2142 (if age
|
|
2143 (newsticker--stat-num-items (intern (car feed)) age)
|
|
2144 (newsticker--stat-num-items (intern (car feed)))))
|
|
2145 (append newsticker-url-list-defaults newsticker-url-list))))
|
|
2146
|
|
2147 ;; ======================================================================
|
|
2148 ;;; OPML
|
|
2149 ;; ======================================================================
|
|
2150 (defun newsticker-opml-export ()
|
|
2151 "OPML subscription export.
|
|
2152 Export subscriptions to a buffer in OPML Format."
|
|
2153 (interactive)
|
|
2154 (with-current-buffer (get-buffer-create "*OPML Export*")
|
|
2155 (set-buffer-file-coding-system 'utf-8)
|
|
2156 (insert (concat
|
|
2157 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
|
|
2158 "<!-- OPML generated by Emacs newsticker.el -->\n"
|
|
2159 "<opml version=\"1.0\">\n"
|
|
2160 " <head>\n"
|
|
2161 " <title>mySubscriptions</title>\n"
|
|
2162 " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
|
|
2163 "</dateCreated>\n"
|
|
2164 " <ownerEmail>" user-mail-address "</ownerEmail>\n"
|
|
2165 " <ownerName>" (user-full-name) "</ownerName>\n"
|
|
2166 " </head>\n"
|
|
2167 " <body>\n"))
|
|
2168 (mapc (lambda (sub)
|
|
2169 (insert " <outline text=\"")
|
|
2170 (insert (newsticker--title sub))
|
|
2171 (insert "\" xmlUrl=\"")
|
|
2172 (insert (cadr sub))
|
|
2173 (insert "\"/>\n"))
|
|
2174 (append newsticker-url-list newsticker-url-list-defaults))
|
|
2175 (insert " </body>\n</opml>\n"))
|
|
2176 (pop-to-buffer "*OPML Export*")
|
|
2177 (when (fboundp 'sgml-mode)
|
|
2178 (sgml-mode)))
|
|
2179
|
|
2180 (defun newsticker--opml-import-outlines (outlines)
|
|
2181 "Recursively import OUTLINES from OPML data.
|
|
2182 Note that nested outlines are currently flattened -- i.e. grouping is
|
|
2183 removed."
|
|
2184 (mapc (lambda (outline)
|
|
2185 (let ((name (xml-get-attribute outline 'text))
|
|
2186 (url (xml-get-attribute outline 'xmlUrl))
|
|
2187 (children (xml-get-children outline 'outline)))
|
|
2188 (unless (string= "" url)
|
|
2189 (add-to-list 'newsticker-url-list
|
|
2190 (list name url nil nil nil) t))
|
|
2191 (if children
|
|
2192 (newsticker--opml-import-outlines children))))
|
|
2193 outlines))
|
|
2194
|
|
2195 (defun newsticker-opml-import (filename)
|
|
2196 "Import OPML data from FILENAME."
|
|
2197 (interactive "fOPML file: ")
|
|
2198 (set-buffer (find-file-noselect filename))
|
|
2199 (goto-char (point-min))
|
|
2200 (let* ((node-list (xml-parse-region (point-min) (point-max)))
|
|
2201 (body (car (xml-get-children (car node-list) 'body)))
|
|
2202 (outlines (xml-get-children body 'outline)))
|
|
2203 (newsticker--opml-import-outlines outlines))
|
|
2204 (customize-variable 'newsticker-url-list))
|
|
2205
|
|
2206 ;; ======================================================================
|
|
2207 ;;; Auto marking
|
|
2208 ;; ======================================================================
|
|
2209 (defun newsticker--run-auto-mark-filter (feed item)
|
|
2210 "Automatically mark an item as old or immortal.
|
|
2211 This function checks the variable `newsticker-auto-mark-filter-list'
|
|
2212 for an entry that matches FEED and ITEM."
|
|
2213 (let ((case-fold-search t))
|
|
2214 (mapc (lambda (filter)
|
|
2215 (let ((filter-feed (car filter))
|
|
2216 (pattern-list (cadr filter)))
|
|
2217 (when (string-match filter-feed feed)
|
|
2218 (newsticker--do-run-auto-mark-filter item pattern-list))))
|
|
2219 newsticker-auto-mark-filter-list)))
|
|
2220
|
|
2221 (defun newsticker--do-run-auto-mark-filter (item list)
|
|
2222 "Actually compare ITEM against the pattern-LIST.
|
|
2223 LIST must be an element of `newsticker-auto-mark-filter-list'."
|
|
2224 (mapc (lambda (pattern)
|
|
2225 (let ((age (nth 0 pattern))
|
|
2226 (place (nth 1 pattern))
|
|
2227 (regexp (nth 2 pattern))
|
|
2228 (title (newsticker--title item))
|
|
2229 (desc (newsticker--desc item)))
|
|
2230 (when (or (eq place 'title) (eq place 'all))
|
|
2231 (when (and title (string-match regexp title))
|
|
2232 (newsticker--debug-msg "Auto-marking as %s: `%s'"
|
|
2233 age (newsticker--title item))
|
|
2234 (setcar (nthcdr 4 item) age)))
|
|
2235 (when (or (eq place 'description) (eq place 'all))
|
|
2236 (when (and desc (string-match regexp desc))
|
|
2237 (newsticker--debug-msg "Auto-marking as %s: `%s'"
|
|
2238 age (newsticker--title item))
|
|
2239 (setcar (nthcdr 4 item) age)))))
|
|
2240 list))
|
|
2241
|
|
2242
|
|
2243 ;; ======================================================================
|
|
2244 ;;; Hook samples
|
|
2245 ;; ======================================================================
|
|
2246 (defun newsticker-new-item-functions-sample (feed item)
|
|
2247 "Demonstrate the use of the `newsticker-new-item-functions' hook.
|
|
2248 This function just prints out the values of the FEED and title of the ITEM."
|
|
2249 (message (concat "newsticker-new-item-functions-sample: feed=`%s', "
|
|
2250 "title=`%s'")
|
|
2251 feed (newsticker--title item)))
|
|
2252
|
|
2253 (defun newsticker-download-images (feed item)
|
|
2254 "Download the first image.
|
|
2255 If FEED equals \"imagefeed\" download the first image URL found
|
|
2256 in the description=contents of ITEM to the directory
|
|
2257 \"~/tmp/newsticker/FEED/TITLE\" where TITLE is the title of the item."
|
|
2258 (when (string= feed "imagefeed")
|
|
2259 (let ((title (newsticker--title item))
|
|
2260 (desc (newsticker--desc item)))
|
|
2261 (when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc)
|
|
2262 (let ((url (substring desc (match-beginning 1) (match-end 1)))
|
|
2263 (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
|
|
2264 (org-dir default-directory))
|
|
2265 (unless (file-directory-p temp-dir)
|
|
2266 (make-directory temp-dir t))
|
|
2267 (cd temp-dir)
|
|
2268 (message "Getting image %s" url)
|
|
2269 (apply 'start-process "wget-image"
|
|
2270 " *newsticker-wget-download-images*"
|
|
2271 newsticker-wget-name
|
|
2272 (list url))
|
|
2273 (cd org-dir))))))
|
|
2274
|
|
2275 (defun newsticker-download-enclosures (feed item)
|
|
2276 "In all FEEDs download the enclosed object of the news ITEM.
|
|
2277 The object is saved to the directory \"~/tmp/newsticker/FEED/TITLE\", which
|
|
2278 is created if it does not exist. TITLE is the title of the news
|
|
2279 item. Argument FEED is ignored.
|
|
2280 This function is suited for adding it to `newsticker-new-item-functions'."
|
|
2281 (let ((title (newsticker--title item))
|
|
2282 (enclosure (newsticker--enclosure item)))
|
|
2283 (when enclosure
|
|
2284 (let ((url (cdr (assoc 'url enclosure)))
|
|
2285 (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
|
|
2286 (org-dir default-directory))
|
|
2287 (unless (file-directory-p temp-dir)
|
|
2288 (make-directory temp-dir t))
|
|
2289 (cd temp-dir)
|
|
2290 (message "Getting enclosure %s" url)
|
|
2291 (apply 'start-process "wget-enclosure"
|
|
2292 " *newsticker-wget-download-enclosures*"
|
|
2293 newsticker-wget-name
|
|
2294 (list url))
|
|
2295 (cd org-dir)))))
|
|
2296
|
|
2297 ;; ======================================================================
|
|
2298 ;;; Retrieve samples
|
|
2299 ;; ======================================================================
|
|
2300 (defun newsticker-retrieve-random-message (feed-name)
|
|
2301 "Return an artificial RSS string under the name FEED-NAME."
|
|
2302 (concat "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?><rss version=\"0.91\">"
|
|
2303 "<channel>"
|
|
2304 "<title>newsticker-retrieve-random-message</title>"
|
|
2305 "<description>Sample retrieval function</description>"
|
|
2306 "<pubDate>FIXME Sat, 07 Sep 2005 00:00:01 GMT</pubDate>"
|
|
2307 "<item><title>" (format "Your lucky number is %d" (random 10000))
|
|
2308 "</title><description>" (format "Or maybe it is %d" (random 10000))
|
|
2309 "</description></item></channel></rss>"))
|
|
2310
|
|
2311 (provide 'newsticker-backend)
|
|
2312
|
|
2313 ;;; newsticker-backend.el ends here
|