1 ;;; newst-backend.el --- Retrieval backend for newsticker -*- lexical-binding:t -*-
3 ;; Copyright (C) 2003-2018 Free Software Foundation, Inc.
5 ;; Author: Ulf Jasper <ulf.jasper@web.de>
6 ;; Filename: newst-backend.el
7 ;; URL: http://www.nongnu.org/newsticker
8 ;; Keywords: News, RSS, Atom
11 ;; ======================================================================
13 ;; This file is part of GNU Emacs.
15 ;; GNU Emacs is free software: you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation, either version 3 of the License, or
18 ;; (at your option) any later version.
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
28 ;; ======================================================================
34 ;; ======================================================================
43 (defvar w3m-minor-mode-map
)
46 (defvar newsticker--retrieval-timer-list nil
47 "List of timers for news retrieval.
48 This is an alist, each element consisting of (feed-name . timer).")
50 (defvar newsticker--sentinel-callback nil
51 "Function called at end of `newsticker--sentinel'.")
54 (defun newsticker-running-p ()
55 "Check whether newsticker is running.
56 Return t if newsticker is running, nil otherwise. Newsticker is
57 considered to be running if the newsticker timer list is not empty."
58 (> (length newsticker--retrieval-timer-list
) 0))
60 ;; ======================================================================
62 ;; ======================================================================
63 (defgroup newsticker nil
64 "Aggregator for RSS and Atom feeds."
67 ;; Hard-coding URLs like this is a recipe for propagating obsolete info.
68 (defconst newsticker--raw-url-list-defaults
70 ;; 2017/12: no response.
72 ;;; "http://export.cnet.com/export/feeds/news/rss/1,11176,,00.xml")
73 ("Debian Security Advisories"
74 "http://www.debian.org/security/dsa.en.rdf")
75 ("Debian Security Advisories - Long format"
76 "http://www.debian.org/security/dsa-long.en.rdf")
78 "https://www.emacswiki.org/emacs?action=rss"
81 ("LWN (Linux Weekly News)"
82 "https://lwn.net/headlines/rss")
83 ;; Not updated since 2010.
84 ;;; ("NY Times: Technology"
85 ;;; "http://www.nytimes.com/services/xml/rss/userland/Technology.xml")
87 ;;; "http://www.nytimes.com/services/xml/rss/userland/HomePage.xml")
89 "http://feeds.feedburner.com/quotationspage/qotd"
93 "https://www.theregister.co.uk/headlines.rss")
95 "http://rss.slashdot.org/Slashdot/slashdot"
97 3600) ;/. will ban you if under 3600 seconds!
99 "https://www.wired.com/feed/rss")
100 ("Heise News (german)"
101 "http://www.heise.de/newsticker/heise.rdf")
102 ("Tagesschau (german)"
103 "http://www.tagesschau.de/newsticker.rdf"
106 "Default URL list in raw form.
107 This list is fed into defcustom via `newsticker--splicer'.")
109 (defun newsticker--splicer (item)
110 "Convert ITEM for splicing into `newsticker-url-list-defaults'."
111 (let ((result (list 'list
:tag
(nth 0 item
) (list 'const
(nth 0 item
))))
112 (element (cdr item
)))
114 (setq result
(append result
(list (list 'const
(car element
)))))
115 (setq element
(cdr element
)))
118 (defun newsticker--set-customvar-retrieval (symbol value
)
119 "Set retrieval related newsticker-variable SYMBOL value to VALUE.
120 Calls all actions which are necessary in order to make the new
122 (if (or (not (boundp symbol
))
123 (equal (symbol-value symbol
) value
))
125 ;; something must have changed
126 (let ((need-restart nil
)
127 (new-or-changed-feeds nil
)
129 (cond ((eq symbol
'newsticker-retrieval-interval
)
130 (setq need-restart t
))
131 ((memq symbol
'(newsticker-url-list-defaults newsticker-url-list
))
133 (unless (member elt
(symbol-value symbol
))
134 (setq new-or-changed-feeds
(cons elt new-or-changed-feeds
))))
135 (dolist (elt (symbol-value symbol
))
136 (unless (member elt value
)
137 (setq removed-feeds
(cons elt removed-feeds
))))))
140 (when (newsticker-running-p)
141 (message "Restarting newsticker")
145 (dolist (feed removed-feeds
)
146 (message "Stopping feed `%s'" (car feed
))
147 (newsticker--stop-feed (car feed
)))
148 (dolist (feed new-or-changed-feeds
)
149 (message "Starting feed `%s'" (car feed
))
150 (newsticker--stop-feed (car feed
))
151 (newsticker--start-feed feed
))
152 (unless new-or-changed-feeds
153 (when newsticker--sentinel-callback
154 (funcall newsticker--sentinel-callback
)))))
155 (set symbol value
))))
157 ;; ======================================================================
159 (defgroup newsticker-retrieval nil
160 "Settings for news retrieval."
163 (defcustom newsticker-url-list-defaults
165 "https://www.emacswiki.org/emacs?action=rss"
168 "A customizable list of news feeds to select from.
169 These were mostly extracted from the Radio Community Server at
170 http://subhonker6.userland.com/rcsPublic/rssHotlist.
172 You may add other entries in `newsticker-url-list'."
173 :type
`(set ,@(mapcar `newsticker--splicer
174 newsticker--raw-url-list-defaults
))
175 :set
'newsticker--set-customvar-retrieval
176 :group
'newsticker-retrieval
)
178 (defcustom newsticker-url-list nil
179 "The news feeds which you like to watch.
181 This alist will be used in addition to selection made customizing
182 `newsticker-url-list-defaults'.
184 This is an alist. Each element consists of two items: a LABEL and a URL,
185 optionally followed by a START-TIME, INTERVAL specifier and WGET-ARGUMENTS.
187 The LABEL gives the name of the news feed. It can be an arbitrary string.
189 The URL gives the location of the news feed. It must point to a valid
190 RSS or Atom file. The file is retrieved by calling wget, or whatever you
191 specify as `newsticker-wget-name'.
193 URL may also be a function which returns news data. In this case
194 `newsticker-retrieval-method' etc. are ignored for this feed.
196 The START-TIME can be either a string, or nil. If it is a string it
197 specifies a fixed time at which this feed shall be retrieved for the
198 first time. (Examples: \"11:00pm\", \"23:00\".) If it is nil (or
199 unspecified), this feed will be retrieved immediately after calling
202 The INTERVAL specifies the time between retrievals for this feed. If it
203 is nil (or unspecified) the default interval value as set in
204 `newsticker-retrieval-interval' is used.
206 \(newsticker.el calls `run-at-time'. The newsticker-parameters START-TIME
207 and INTERVAL correspond to the `run-at-time'-parameters TIME and REPEAT.)
209 WGET-ARGUMENTS specifies arguments for wget (see `newsticker-wget-name')
210 which apply for this feed only, overriding the value of
211 `newsticker-wget-arguments'."
212 :type
'(repeat (list :tag
"News feed"
213 (string :tag
"Label")
215 (string :tag
"String")
216 (function :tag
"Function"))
218 (const :tag
"Default" nil
)
219 (string :tag
"Fixed Time"))
220 (choice :tag
"Interval"
221 (const :tag
"Default" nil
)
222 (const :tag
"Hourly" 3600)
223 (const :tag
"Daily" 86400)
224 (const :tag
"Weekly" 604800)
225 (integer :tag
"Interval"))
226 (choice :tag
"Wget Arguments"
227 (const :tag
"Default arguments" nil
)
228 (repeat :tag
"Special arguments" string
))))
229 :set
'newsticker--set-customvar-retrieval
230 :group
'newsticker-retrieval
)
232 (defcustom newsticker-retrieval-method
234 "Method for retrieving news from the web, either `intern' or `extern'.
235 Default value `intern' uses Emacs' built-in asynchronous download
236 capabilities (`url-retrieve'). If set to `extern' the external
237 program wget is used, see `newsticker-wget-name'."
238 :type
'(choice :tag
"Method"
239 (const :tag
"Intern" intern
)
240 (const :tag
"Extern" extern
))
241 :group
'newsticker-retrieval
)
243 (defcustom newsticker-wget-name
245 "Name of the program which is called to retrieve news from the web.
246 The canonical choice is wget but you may take any other program which is
247 able to return the contents of a news feed file on stdout."
249 :group
'newsticker-retrieval
)
251 (defcustom newsticker-wget-arguments
253 "Arguments which are passed to wget.
254 There is probably no reason to change the default settings, unless you
255 are living behind a firewall."
256 :type
'(repeat (string :tag
"Argument"))
257 :group
'newsticker-retrieval
)
259 (defcustom newsticker-retrieval-interval
261 "Time interval for retrieving new news items (seconds).
262 If this value is not positive (i.e. less than or equal to 0)
263 items are retrieved only once!
264 Please note that some feeds, e.g. Slashdot, will ban you if you
265 make it less than 1800 seconds (30 minutes)!"
266 :type
'(choice :tag
"Interval"
267 (const :tag
"No automatic retrieval" 0)
268 (const :tag
"Hourly" 3600)
269 (const :tag
"Daily" 86400)
270 (const :tag
"Weekly" 604800)
271 (integer :tag
"Interval"))
272 :set
'newsticker--set-customvar-retrieval
273 :group
'newsticker-retrieval
)
275 (defcustom newsticker-desc-comp-max
277 "Relevant length of headline descriptions.
278 This value gives the maximum number of characters which will be
279 taken into account when newsticker compares two headline
282 :group
'newsticker-retrieval
)
284 ;; ======================================================================
285 ;; headline processing
286 (defgroup newsticker-headline-processing nil
287 "Settings for the automatic processing of headlines."
290 (defcustom newsticker-automatically-mark-items-as-old
292 "Decides whether to automatically mark items as old.
293 If t a new item is considered as new only after its first retrieval. As
294 soon as it is retrieved a second time, it becomes old. If not t all
295 items stay new until you mark them as old. This is done in the
296 *newsticker* buffer."
298 :group
'newsticker-headline-processing
)
300 (defcustom newsticker-automatically-mark-visited-items-as-old
302 "Decides whether to automatically mark visited items as old.
303 If t an item is marked as old as soon as the associated link is
304 visited, i.e. after pressing RET or mouse2 on the item's
308 :group
'newsticker-headline-processing
)
310 (defcustom newsticker-keep-obsolete-items
312 "Decides whether to keep unread items which have been removed from feed.
313 If t a new item, which has been removed from the feed, is kept in
314 the cache until it is marked as read."
316 :group
'newsticker-headline-processing
)
318 (defcustom newsticker-obsolete-item-max-age
320 "Maximal age of obsolete items, in seconds.
321 Obsolete items which are older than this value will be silently
322 deleted at the next retrieval."
324 :group
'newsticker-headline-processing
)
326 (defcustom newsticker-auto-mark-filter-list
328 "A list of filters for automatically marking headlines.
330 This is an alist of the form (FEED-NAME PATTERN-LIST). I.e. each
331 element consists of a FEED-NAME a PATTERN-LIST. Each element of
332 the pattern-list has the form (AGE TITLE-OR-DESCRIPTION REGEXP).
333 AGE must be one of the symbols `old' or `immortal'.
334 TITLE-OR-DESCRIPTION must be one of the symbols `title',
335 `description', or `all'. REGEXP is a regular expression, i.e., a
338 This filter is checked after a new headline has been retrieved.
339 If FEED-NAME matches the name of the corresponding news feed, the
340 pattern-list is checked: The new headline will be marked as AGE
341 if REGEXP matches the headline's TITLE-OR-DESCRIPTION.
343 If, for example, `newsticker-auto-mark-filter-list' looks like
344 ((slashdot (\\='old \\='title \"^Forget me!$\") (\\='immortal \\='title \"Read me\")
345 (\\='immortal \\='all \"important\"))))
347 then all articles from slashdot are marked as old if they have
348 the title \"Forget me!\". All articles with a title containing
349 the string \"Read me\" are marked as immortal. All articles which
350 contain the string \"important\" in their title or their
351 description are marked as immortal."
352 :type
'(repeat (list :tag
"Auto mark filter"
353 (string :tag
"Feed name")
355 (list :tag
"Filter element"
357 :tag
"Auto-assigned age"
358 (const :tag
"Old" old
)
359 (const :tag
"Immortal" immortal
))
361 :tag
"Title/Description"
362 (const :tag
"Title" title
)
363 (const :tag
"Description" description
)
364 (const :tag
"All" all
))
365 (string :tag
"Regexp")))))
366 :group
'newsticker-headline-processing
)
368 ;; ======================================================================
370 (defgroup newsticker-hooks nil
371 "Settings for newsticker hooks."
374 (defcustom newsticker-start-hook
376 "Hook run when starting newsticker.
377 This hook is run at the very end of `newsticker-start'."
378 :options
'(newsticker-start-ticker)
380 :group
'newsticker-hooks
)
382 (defcustom newsticker-stop-hook
384 "Hook run when stopping newsticker.
385 This hook is run at the very end of `newsticker-stop'."
388 :group
'newsticker-hooks
)
390 (defcustom newsticker-new-item-functions
392 "List of functions run after a new headline has been retrieved.
393 Each function is called with the following two arguments:
394 FEEDNAME the name of the corresponding news feed,
395 ITEM the decoded headline.
397 See `newsticker-new-item-functions-sample',
398 `newsticker-download-images', and
399 `newsticker-download-enclosures' for sample functions.
401 Please note that these functions are called only once for a
402 headline after it has been retrieved for the first time."
404 :options
'(newsticker-download-images
405 newsticker-download-enclosures
)
406 :group
'newsticker-hooks
)
408 ;; ======================================================================
410 (defgroup newsticker-miscellaneous nil
411 "Miscellaneous newsticker settings."
414 (defcustom newsticker-cache-filename
415 "~/.newsticker-cache"
416 "Name of the newsticker cache file."
418 :group
'newsticker-miscellaneous
)
419 (make-obsolete-variable 'newsticker-cache-filename
'newsticker-dir
"23.1")
421 (defcustom newsticker-dir
422 (locate-user-emacs-file "newsticker/" ".newsticker/")
423 "Directory where newsticker saves data."
425 :group
'newsticker-miscellaneous
)
428 (defcustom newsticker-debug
430 "Enables some features needed for debugging newsticker.el.
432 If set to t newsticker.el will print lots of debugging messages, and the
433 buffers *newsticker-wget-<feed>* will not be closed."
435 :group
'newsticker-miscellaneous
)
437 ;; ======================================================================
438 ;;; Compatibility section, XEmacs, Emacs
439 ;; ======================================================================
441 ;; FIXME It is bad practice to define compat functions with such generic names.
443 (unless (fboundp 'match-string-no-properties
)
444 (defalias 'match-string-no-properties
'match-string
))
446 (when (featurep 'xemacs
)
447 (unless (fboundp 'replace-regexp-in-string
)
448 (defun replace-regexp-in-string (re rp st
)
449 (save-match-data ;; apparently XEmacs needs save-match-data
450 (replace-in-string st re rp
)))))
452 ;; copied from subr.el
453 (unless (fboundp 'add-to-invisibility-spec
)
454 (defun add-to-invisibility-spec (arg)
455 "Add elements to `buffer-invisibility-spec'.
456 See documentation for `buffer-invisibility-spec' for the kind of elements
458 (if (eq buffer-invisibility-spec t
)
459 (setq buffer-invisibility-spec
(list t
)))
460 (setq buffer-invisibility-spec
461 (cons arg buffer-invisibility-spec
))))
463 ;; copied from subr.el
464 (unless (fboundp 'remove-from-invisibility-spec
)
465 (defun remove-from-invisibility-spec (arg)
466 "Remove elements from `buffer-invisibility-spec'."
467 (if (consp buffer-invisibility-spec
)
468 (setq buffer-invisibility-spec
469 (delete arg buffer-invisibility-spec
)))))
471 ;; ======================================================================
472 ;;; Internal variables
473 ;; ======================================================================
474 (defvar newsticker--buffer-uptodate-p nil
475 "Tells whether the newsticker buffer is up to date.")
476 (defvar newsticker--latest-update-time
(current-time)
477 "The time at which the latest news arrived.")
478 (defvar newsticker--process-ids nil
479 "List of PIDs of active newsticker processes.")
481 (defvar newsticker--cache nil
"Cached newsticker data.
482 This is a list of the form
485 (title description link time age index preformatted-contents
486 preformatted-title extra-elements)
489 (title description link time age index preformatted-contents
490 preformatted-title extra-elements)
494 where LABEL is a symbol. TITLE, DESCRIPTION, and LINK are
495 strings. TIME is a time value as returned by `current-time'.
496 AGE is a symbol: `new', `old', `immortal', and `obsolete' denote
497 ordinary news items, whereas `feed' denotes an item which is not a
498 headline but describes the feed itself. INDEX denotes the
499 original position of the item -- used for restoring the original
500 order. PREFORMATTED-CONTENTS and PREFORMATTED-TITLE hold the
501 formatted contents of the item's description and title. This
502 speeds things up if HTML rendering is used, which is rather
503 slow. EXTRA-ELEMENTS is an alist containing additional elements.")
505 (defvar newsticker--auto-narrow-to-feed nil
506 "Automatically narrow to current news feed.
507 If non-nil only the items of the current news feed are visible.")
509 (defvar newsticker--auto-narrow-to-item nil
510 "Automatically narrow to current news item.
511 If non-nil only the current headline is visible.")
513 (defconst newsticker--error-headline
514 "[COULD NOT DOWNLOAD HEADLINES!]"
515 "Title of error headline which will be inserted if news retrieval fails.")
517 ;; ======================================================================
519 ;; ======================================================================
520 (defsubst newsticker--title
(item)
521 "Return title of ITEM."
523 (defsubst newsticker--desc
(item)
524 "Return description of ITEM."
526 (defsubst newsticker--link
(item)
527 "Return link of ITEM."
529 (defsubst newsticker--time
(item)
530 "Return time of ITEM."
532 (defsubst newsticker--age
(item)
533 "Return age of ITEM."
535 (defsubst newsticker--pos
(item)
536 "Return position/index of ITEM."
538 (defsubst newsticker--preformatted-contents
(item)
539 "Return pre-formatted text of ITEM."
541 (defsubst newsticker--preformatted-title
(item)
542 "Return pre-formatted title of ITEM."
544 (defsubst newsticker--extra
(item)
545 "Return extra attributes of ITEM."
547 (defsubst newsticker--guid-to-string
(guid)
548 "Return string representation of GUID."
551 (car (xml-node-children guid
))))
552 (defsubst newsticker--guid
(item)
553 "Return guid of ITEM."
554 (newsticker--guid-to-string (assoc 'guid
(newsticker--extra item
))))
555 (defsubst newsticker--enclosure
(item)
556 "Return enclosure element of ITEM in the form (...FIXME...) or nil."
557 (let ((enclosure (assoc 'enclosure
(newsticker--extra item
))))
559 (xml-node-attributes enclosure
))))
560 (defun newsticker--real-feed-name (feed)
561 "Return real name of FEED."
564 (if (eq (newsticker--age item
) 'feed
)
565 (throw 'name
(newsticker--title item
))))
566 (cdr (newsticker--cache-get-feed feed
)))
570 ;; ======================================================================
572 ;; ======================================================================
574 (defun newsticker--start-feed (feed &optional do-not-complain-if-running
)
575 "Start retrieval timer for FEED.
576 If timer is running already a warning message is printed unless
577 DO-NOT-COMPLAIN-IF-RUNNING is not nil. Add the started
578 name/timer pair to `newsticker--retrieval-timer-list'."
579 (let* ((feed-name (car feed
))
580 (start-time (nth 2 feed
))
581 (interval (or (nth 3 feed
)
582 newsticker-retrieval-interval
))
583 (timer (assoc (car feed
)
584 newsticker--retrieval-timer-list
)))
586 (or do-not-complain-if-running
587 (message "Timer for %s is running already!"
589 (newsticker--debug-msg "Starting timer for %s: %s, %d"
590 feed-name start-time interval
)
591 ;; do not repeat retrieval if interval not positive
594 ;; Suddenly XEmacs doesn't like start-time 0
595 (if (or (not start-time
)
596 (and (numberp start-time
) (= start-time
0)))
598 ;; (message "start-time %s" start-time)
599 (setq timer
(run-at-time start-time interval
600 'newsticker-get-news feed-name
))
602 (add-to-list 'newsticker--retrieval-timer-list
603 (cons feed-name timer
))))))
606 (defun newsticker-start (&optional _do-not-complain-if-running
)
607 "Start the newsticker.
608 Start the timers for display and retrieval. If the newsticker, i.e. the
609 timers, are running already a warning message is printed unless
610 DO-NOT-COMPLAIN-IF-RUNNING is not nil.
611 Run `newsticker-start-hook' if newsticker was not running already."
613 (let ((running (newsticker-running-p)))
614 ;; read old cache if it exists and newsticker is not running
616 (newsticker--cache-read))
617 ;; start retrieval timers -- one timer for each feed
618 (dolist (feed (append newsticker-url-list-defaults newsticker-url-list
))
619 (newsticker--start-feed feed
))
621 (run-hooks 'newsticker-start-hook
)
622 (message "Newsticker started!"))))
624 (defun newsticker--stop-feed (feed-name)
625 "Stop retrieval for feed FEED-NAME.
626 Delete the stopped name/timer pair from `newsticker--retrieval-timer-list'."
627 (let ((name-and-timer (assoc feed-name newsticker--retrieval-timer-list
)))
629 (cancel-timer (cdr name-and-timer
))
630 (setq newsticker--retrieval-timer-list
631 (delete name-and-timer newsticker--retrieval-timer-list
)))))
633 (defun newsticker-stop ()
634 "Stop the newsticker and the newsticker-ticker.
635 Cancel the timers for display and retrieval. Run `newsticker-stop-hook'
636 if newsticker has been running."
638 (newsticker--cache-save)
639 (when (fboundp 'newsticker-stop-ticker
) ; silence compiler warnings
640 (newsticker-stop-ticker))
641 (when (newsticker-running-p)
642 (dolist (name-and-timer newsticker--retrieval-timer-list
)
643 (newsticker--stop-feed (car name-and-timer
)))
644 (setq newsticker--retrieval-timer-list nil
)
645 (run-hooks 'newsticker-stop-hook
)
646 (message "Newsticker stopped!")))
648 (defun newsticker-get-all-news ()
649 "Launch retrieval of news from all configured newsticker sites.
650 This does NOT start the retrieval timers."
652 ;; launch retrieval of news
653 (dolist (item (append newsticker-url-list-defaults newsticker-url-list
))
654 (newsticker-get-news (car item
))))
656 (defun newsticker-save-item (feed item
)
659 (let ((filename (read-string "Filename: "
661 (replace-regexp-in-string
662 " " "_" (newsticker--title item
))
665 (insert (newsticker--desc item
))
666 (write-file filename t
))))
668 (defun newsticker-add-url (url name
)
669 "Add given URL under given NAME to `newsticker-url-list'.
670 If URL is nil it is searched at point."
679 (if (> (point) (+ (point-min) 100))
684 "http://[-a-zA-Z0-9&/_.]*"
685 (if (< (point) (- (point-max) 200))
689 (buffer-substring-no-properties (match-beginning 0)
691 (read-string "Name: ")))
692 (add-to-list 'newsticker-url-list
(list name url nil nil nil
) t
)
693 (customize-variable 'newsticker-url-list
))
695 (defun newsticker-customize ()
696 "Open the newsticker customization group."
698 (delete-other-windows)
699 (customize-group "newsticker"))
701 ;; ======================================================================
703 ;; ======================================================================
704 (defun newsticker--get-news-by-funcall (feed-name function
)
705 "Get news for the site FEED-NAME by calling FUNCTION.
706 See `newsticker-get-news'."
707 (let ((buffername (concat " *newsticker-funcall-" feed-name
"*")))
708 (with-current-buffer (get-buffer-create buffername
)
710 (newsticker--insert-bytes (funcall function feed-name
))
711 (newsticker--sentinel-work nil t feed-name function
714 (defun newsticker--get-news-by-url (feed-name url
)
715 "Get news for the site FEED-NAME from address URL using `url-retrieve'.
716 See `newsticker-get-news'."
717 (let ((coding-system-for-read 'no-conversion
))
718 (condition-case error-data
719 (url-retrieve url
'newsticker--get-news-by-url-callback
721 (error (message "Error retrieving news from %s: %s" feed-name
723 (force-mode-line-update))
725 (defun newsticker--get-news-by-url-callback (status feed-name
)
726 "Callback function for `newsticker--get-news-by-url'.
727 STATUS is the return status as delivered by `url-retrieve', and
728 FEED-NAME is the name of the feed that the news were retrieved
730 (let ((buf (get-buffer-create (concat " *newsticker-url-" feed-name
"*")))
731 (result (buffer-string)))
734 (newsticker--insert-bytes result
)
735 ;; remove MIME header
736 (goto-char (point-min))
737 (search-forward "\n\n" nil t
)
738 (delete-region (point-min) (point))
739 ;; read the rss/atom contents
740 (newsticker--sentinel-work nil
742 (not (eq (car status
) :error
)))
743 feed-name
"url-retrieve"
746 (let ((status-type (car status
))
747 (status-details (cdr status
)))
748 (cond ((eq status-type
:redirect
)
749 ;; don't care about redirects
751 ((eq status-type
:error
)
752 (message "%s: Error while retrieving news from %s: %s: \"%s\""
753 (format-time-string "%A, %H:%M")
755 (car status-details
) (cdr status-details
))))))))
757 (defun newsticker--get-news-by-wget (feed-name url wget-arguments
)
758 "Get news for the site FEED-NAME from address URL using wget.
759 WGET-ARGUMENTS is a list of arguments for wget.
760 See `newsticker-get-news'."
761 (let ((buffername (concat " *newsticker-wget-" feed-name
"*")))
762 (with-current-buffer (get-buffer-create buffername
)
764 ;; throw an error if there is an old wget-process around
765 (if (get-process feed-name
)
766 (error "Another wget-process is running for %s" feed-name
))
768 (let* ((args (append wget-arguments
(list url
)))
769 (proc (apply 'start-process feed-name buffername
770 newsticker-wget-name args
)))
771 (set-process-coding-system proc
'no-conversion
'no-conversion
)
772 (set-process-sentinel proc
'newsticker--sentinel
)
773 (process-put proc
'nt-feed-name feed-name
)
774 (setq newsticker--process-ids
(cons (process-id proc
)
775 newsticker--process-ids
))
776 (force-mode-line-update)))))
778 (defun newsticker-get-news (feed-name)
779 "Get news from the site FEED-NAME and load feed logo.
780 FEED-NAME must be a string which occurs as the label (i.e. the first element)
781 in an element of `newsticker-url-list' or `newsticker-url-list-defaults'."
782 (newsticker--debug-msg "%s: Getting news for %s"
783 (format-time-string "%A, %H:%M")
785 (let* ((item (or (assoc feed-name newsticker-url-list
)
786 (assoc feed-name newsticker-url-list-defaults
)
788 "Cannot get news for %s: Check newsticker-url-list"
791 (wget-arguments (or (car (cdr (cdr (cdr (cdr item
)))))
792 newsticker-wget-arguments
)))
794 (newsticker--get-news-by-funcall feed-name url
)
795 (if (eq newsticker-retrieval-method
'intern
)
796 (newsticker--get-news-by-url feed-name url
)
797 (newsticker--get-news-by-wget feed-name url wget-arguments
)))))
799 ;; ======================================================================
801 ;; ======================================================================
803 (defun newsticker--sentinel (process event
)
804 "Sentinel for extracting news titles from an RDF buffer.
805 Argument PROCESS is the process which has just changed its state.
806 Argument EVENT tells what has happened to the process."
807 (let ((p-status (process-status process
))
808 (exit-status (process-exit-status process
))
809 (feed-name (process-get process
'nt-feed-name
))
810 (command (process-command process
))
811 (buffer (process-buffer process
)))
812 (newsticker--sentinel-work event
813 (and (eq p-status
'exit
)
815 feed-name command buffer
)))
817 (defun newsticker--sentinel-work (event status-ok feed-name command buffer
)
818 "Actually do the sentinel work.
819 Argument EVENT tells what has happened to the retrieval process.
820 Argument STATUS-OK is the final status of the retrieval process,
821 non-nil meaning retrieval was successful.
822 Argument FEED-NAME is the name of the retrieved feed.
823 Argument COMMAND is the command of the retrieval process.
824 Argument BUFFER is the buffer of the retrieval process."
825 (let ((time (current-time))
826 (name-symbol (intern feed-name
))
827 (something-was-added nil
)
829 ;; catch known errors (zombie processes, rubbish-xml etc.
830 ;; if an error occurs the news feed is not updated!
833 (setq newsticker--cache
834 (newsticker--cache-add
837 newsticker--error-headline
839 (concat "%s: Newsticker could not retrieve news from %s.\n"
840 "Return status: `%s'\n"
842 (format-time-string "%A, %H:%M")
843 feed-name event command
)
847 0 '((guid nil
"newsticker--download-error"))
849 (message "%s: Error while retrieving news from %s"
850 (format-time-string "%A, %H:%M")
853 (let* ((coding-system 'utf-8
)
857 (unless (fboundp 'libxml-parse-xml-region
)
858 (newsticker--do-xml-workarounds))
859 ;; check coding system
860 (goto-char (point-min))
861 (if (re-search-forward "encoding=['\"]\\([^\"]+?\\)['\"]"
863 (setq coding-system
(intern (downcase (match-string 1))))
866 (check-coding-system coding-system
)
869 "newsticker.el: ignoring coding system %s for %s"
870 coding-system feed-name
)
872 ;; Decode if possible
874 (decode-coding-region (point-min) (point-max)
876 (condition-case errordata
877 ;; The xml parser might fail or the xml might be bugged.
878 (if (fboundp 'libxml-parse-xml-region
)
880 (xml-remove-comments (point-min) (point-max))
881 (list (libxml-parse-xml-region (point-min) (point-max)
883 (xml-parse-region (point-min) (point-max)))
884 (error (message "Could not parse %s: %s"
885 (buffer-name) (cadr errordata
))
886 (throw 'oops nil
)))))
887 (topnode (car node-list
))
890 ;; mark all items as obsolete
891 (newsticker--cache-replace-age newsticker--cache
894 (newsticker--cache-replace-age newsticker--cache
897 (newsticker--cache-replace-age newsticker--cache
901 ;; check Atom/RSS version and call corresponding parser
902 (condition-case error-data
905 ((and (eq 'rss
(xml-node-name topnode
))
906 (string= "0.91" (xml-get-attribute topnode
'version
)))
907 (setq image-url
(newsticker--get-logo-url-rss-0.91 topnode
))
908 (newsticker--parse-rss-0.91 feed-name time topnode
))
910 ((and (eq 'rss
(xml-node-name topnode
))
911 (string= "0.92" (xml-get-attribute topnode
'version
)))
912 (setq image-url
(newsticker--get-logo-url-rss-0.92 topnode
))
913 (newsticker--parse-rss-0.92 feed-name time topnode
))
915 ((or (eq 'RDF
(xml-node-name topnode
))
916 (eq 'rdf
:RDF
(xml-node-name topnode
)))
917 (setq image-url
(newsticker--get-logo-url-rss-1.0 topnode
))
918 (newsticker--parse-rss-1.0 feed-name time topnode
))
920 ((and (eq 'rss
(xml-node-name topnode
))
921 (string= "2.0" (xml-get-attribute topnode
'version
)))
922 (setq image-url
(newsticker--get-logo-url-rss-2.0 topnode
))
923 (newsticker--parse-rss-2.0 feed-name time topnode
))
925 ((and (eq 'feed
(xml-node-name topnode
))
926 (string= "http://purl.org/atom/ns#"
927 (xml-get-attribute topnode
'xmlns
)))
928 (setq image-url
(newsticker--get-logo-url-atom-0.3 topnode
))
929 (newsticker--parse-atom-0.3 feed-name time topnode
))
932 ;; The test for Atom 1.0 does not work when using
933 ;; libxml, as with libxml the namespace attribute is
934 ;; not in the xml tree. For the time being we skip
935 ;; the check and assume that we are dealing with an
938 ;; (and (eq 'feed (xml-node-name topnode))
939 ;; (string= "http://www.w3.org/2005/Atom"
940 ;; (xml-get-attribute topnode 'xmlns)))
941 (setq image-url
(newsticker--get-logo-url-atom-1.0 topnode
))
942 (setq icon-url
(newsticker--get-icon-url-atom-1.0 topnode
))
943 (newsticker--parse-atom-1.0 feed-name time topnode
))
946 ;; (newsticker--debug-msg "Feed type unknown: %s: %s"
947 ;; (xml-node-name topnode) feed-name)
950 (setq something-was-added t
))
951 (error (message "sentinelerror in %s: %s" feed-name error-data
)))
953 ;; Remove those old items from cache which have been removed from
955 (newsticker--cache-replace-age newsticker--cache
956 name-symbol
'obsolete-old
'deleteme
)
957 (newsticker--cache-remove newsticker--cache name-symbol
959 ;; Remove those new items from cache which have been removed from
960 ;; the feed. Or keep them as `obsolete'
961 (if (not newsticker-keep-obsolete-items
)
962 (newsticker--cache-remove newsticker--cache
963 name-symbol
'obsolete-new
)
964 (setq newsticker--cache
965 (newsticker--cache-mark-expired
966 newsticker--cache name-symbol
'obsolete
'obsolete-expired
967 newsticker-obsolete-item-max-age
))
968 (newsticker--cache-remove newsticker--cache
969 name-symbol
'obsolete-expired
)
970 (newsticker--cache-replace-age newsticker--cache
971 name-symbol
'obsolete-new
973 (newsticker--update-process-ids)
974 ;; setup scrollable text
975 (when (= 0 (length newsticker--process-ids
))
976 (when (fboundp 'newsticker--ticker-text-setup
) ;silence
979 (newsticker--ticker-text-setup)))
980 (setq newsticker--latest-update-time
(current-time))
981 (when something-was-added
982 ;; FIXME: should we care about removed items as well?
983 (newsticker--cache-save-feed
984 (newsticker--cache-get-feed name-symbol
))
985 (when (fboundp 'newsticker--buffer-set-uptodate
) ;silence
988 (newsticker--buffer-set-uptodate nil
)))
989 ;; kill the process buffer if wanted
990 (unless newsticker-debug
991 (kill-buffer buffer
))
992 ;; launch retrieval of images
993 (when (and (boundp 'newsticker-download-logos
)
994 newsticker-download-logos
)
997 (newsticker--image-get feed-name feed-name
(newsticker--images-dir)
1002 (let* ((feed-url (newsticker--link (cadr (newsticker--cache-get-feed
1003 (intern feed-name
)))))
1004 (uri (url-generic-parse-url feed-url
)))
1005 (when (and feed-url uri
)
1006 (setf (url-filename uri
) nil
)
1007 (setf (url-target uri
) nil
)
1008 (concat (url-recreate-url uri
) "favicon.ico")))))
1010 (newsticker--image-get feed-name
1011 (concat feed-name
"."
1012 (file-name-extension icon-url
))
1013 (newsticker--icons-dir)
1015 (when newsticker--sentinel-callback
1016 (funcall newsticker--sentinel-callback
)))
1018 (defun newsticker--do-xml-workarounds ()
1019 "Fix all issues which `xml-parse-region' could be choking on."
1021 ;; a very very dirty workaround to overcome the
1022 ;; problems with the newest (20030621) xml.el:
1023 ;; remove all unnecessary whitespace
1024 (goto-char (point-min))
1025 (while (re-search-forward ">[ \t\r\n]+<" nil t
)
1026 (replace-match "><" nil t
))
1027 ;; and another brutal workaround (20031105)! For some
1028 ;; reason the xml parser does not like the colon in the
1029 ;; doctype name "rdf:RDF"
1030 (goto-char (point-min))
1031 (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t
)
1032 (replace-match "<!DOCTYPE rdfColonRDF" nil t
))
1033 ;; finally.... ~##^°!!!!!
1034 (goto-char (point-min))
1035 (while (search-forward "\r\n" nil t
)
1036 (replace-match "\n" nil t
))
1037 ;; still more brutal workarounds (20040309)! The xml
1038 ;; parser does not like doctype rss
1039 (goto-char (point-min))
1040 (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t
)
1041 (replace-match "" nil t
))
1042 ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
1043 ;; Remove comments to avoid this xml-parsing bug:
1044 ;; "XML files can have only one toplevel tag"
1045 (goto-char (point-min))
1046 (while (search-forward "<!--" nil t
)
1047 (let ((start (match-beginning 0)))
1048 (unless (search-forward "-->" nil t
)
1049 (error "Can't find end of comment"))
1050 (delete-region start
(point))))
1051 ;; And another one (20050702)! If description is HTML
1052 ;; encoded and starts with a `<', wrap the whole
1053 ;; description in a CDATA expression. This happened for
1054 ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
1055 (goto-char (point-min))
1056 (while (re-search-forward
1057 "<description>\\(<img.*?\\)</description>" nil t
)
1059 "<description><![CDATA[ \\1 ]]></description>"))
1060 ;; And another one (20051123)! XML parser does not
1061 ;; like this: <yweather:location city="Frankfurt/Main"
1062 ;; region="" country="GM" />
1063 ;; try to "fix" empty attributes
1064 ;; This happened for
1065 ;; http://xml.weather.yahoo.com/forecastrss?p=GMXX0040&u=f
1066 (goto-char (point-min))
1067 (while (re-search-forward "\\(<[^>]*\\)=\"\"" nil t
)
1068 (replace-match "\\1=\" \""))
1070 (set-buffer-modified-p nil
))
1073 (defun newsticker--get-logo-url-atom-1.0
(node)
1074 "Return logo URL from atom 1.0 data in NODE."
1075 (car (xml-node-children
1076 (car (xml-get-children node
'logo
)))))
1078 (defun newsticker--get-icon-url-atom-1.0
(node)
1079 "Return icon URL from atom 1.0 data in NODE."
1080 (car (xml-node-children
1081 (car (xml-get-children node
'icon
)))))
1083 (defun newsticker--get-logo-url-atom-0.3
(node)
1084 "Return logo URL from atom 0.3 data in NODE."
1085 (car (xml-node-children
1086 (car (xml-get-children (car (xml-get-children node
'image
)) 'url
)))))
1088 (defun newsticker--get-logo-url-rss-2.0
(node)
1089 "Return logo URL from RSS 2.0 data in NODE."
1090 (car (xml-node-children
1091 (car (xml-get-children
1092 (car (xml-get-children
1093 (car (xml-get-children node
'channel
)) 'image
)) 'url
)))))
1095 (defun newsticker--get-logo-url-rss-1.0
(node)
1096 "Return logo URL from RSS 1.0 data in NODE."
1097 (car (xml-node-children
1098 (car (xml-get-children (car (xml-get-children node
'image
)) 'url
)))))
1100 (defun newsticker--get-logo-url-rss-0.92
(node)
1101 "Return logo URL from RSS 0.92 data in NODE."
1102 (car (xml-node-children
1103 (car (xml-get-children (car (xml-get-children node
'image
)) 'url
)))))
1105 (defun newsticker--get-logo-url-rss-0.91
(node)
1106 "Return logo URL from RSS 0.91 data in NODE."
1107 (car (xml-node-children
1108 (car (xml-get-children (car (xml-get-children node
'image
)) 'url
)))))
1110 (defun newsticker--parse-atom-0.3
(name time topnode
)
1111 "Parse Atom 0.3 data.
1112 Return value as well as arguments NAME, TIME, and TOPNODE are the
1113 same as in `newsticker--parse-atom-1.0'."
1114 (newsticker--debug-msg "Parsing Atom 0.3 feed %s" name
)
1115 (let (new-feed new-item
)
1116 (setq new-feed
(newsticker--parse-generic-feed
1119 (car (xml-node-children
1120 (car (xml-get-children topnode
'title
))))
1122 (car (xml-node-children
1123 (car (xml-get-children topnode
'content
))))
1126 (car (xml-get-children topnode
'link
)) 'href
)
1128 (xml-node-children topnode
)))
1129 (setq new-item
(newsticker--parse-generic-items
1130 name time
(xml-get-children topnode
'entry
)
1133 (car (xml-node-children
1134 (car (xml-get-children node
'title
)))))
1137 (or (car (xml-node-children
1138 (car (xml-get-children node
'content
))))
1139 (car (xml-node-children
1140 (car (xml-get-children node
'summary
))))))
1144 (car (xml-get-children node
'link
)) 'href
))
1147 (newsticker--decode-rfc822-date
1148 (car (xml-node-children
1149 (car (xml-get-children node
'modified
))))))
1152 (newsticker--guid-to-string
1153 (assoc 'guid
(xml-node-children node
))))
1156 (xml-node-children node
))))
1157 (or new-item new-feed
)))
1159 (defun newsticker--unxml (node)
1160 "Reverse parsing of an xml string.
1161 Restore an xml-string from a an xml NODE that was returned by xml-parse..."
1162 (if (or (not node
) (stringp node
))
1164 (newsticker--unxml-node node
)))
1166 (defun newsticker--unxml-node (node)
1167 "Actually restore xml-string of an xml NODE."
1168 (let ((qname (symbol-name (car node
)))
1169 (att-list (cadr node
))
1170 (children (cddr node
)))
1173 (mapconcat 'newsticker--unxml-attribute att-list
" ")
1175 (mapconcat 'newsticker--unxml children
"") "</" qname
">")))
1177 (defun newsticker--unxml-attribute (attribute)
1178 "Actually restore xml-string of an ATTRIBUTE of an xml node."
1179 (let ((name (symbol-name (car attribute
)))
1180 (value (cdr attribute
)))
1181 (concat name
"=\"" value
"\"")))
1183 (defun newsticker--parse-atom-1.0
(name time topnode
)
1184 "Parse Atom 1.0 data.
1185 Argument NAME gives the name of a news feed. TIME gives the
1186 system time at which the data have been retrieved. TOPNODE
1187 contains the feed data as returned by the xml parser.
1189 For the Atom 1.0 specification see
1190 URL `http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html'"
1191 (newsticker--debug-msg "Parsing Atom 1.0 feed %s" name
)
1192 (let (new-feed new-item
)
1193 (setq new-feed
(newsticker--parse-generic-feed
1196 (car (xml-node-children
1197 (car (xml-get-children topnode
'title
))))
1199 (car (xml-node-children
1200 (car (xml-get-children topnode
'subtitle
))))
1204 (car (xml-get-children node
'link
)) 'href
))
1206 (xml-node-children topnode
)))
1207 (setq new-item
(newsticker--parse-generic-items
1208 name time
(xml-get-children topnode
'entry
)
1211 (car (xml-node-children
1212 (car (xml-get-children node
'title
)))))
1215 ;; unxml the content or the summary node. Atom
1216 ;; allows for integrating (x)html into the atom
1217 ;; structure but we need the raw html string.
1218 ;; e.g. http://www.heise.de/open/news/news-atom.xml
1219 ;; http://feeds.feedburner.com/ru_nix_blogs
1220 (or (newsticker--unxml
1221 (car (xml-node-children
1222 (car (xml-get-children node
'content
)))))
1224 (car (xml-node-children
1225 (car (xml-get-children node
'summary
)))))
1226 (car (xml-node-children
1227 (car (xml-get-children node
'summary
))))))
1231 (car (xml-get-children node
'link
)) 'href
))
1234 (newsticker--decode-iso8601-date
1235 (or (car (xml-node-children
1236 (car (xml-get-children node
'updated
))))
1237 (car (xml-node-children
1238 (car (xml-get-children node
'published
)))))))
1241 (car (xml-node-children
1242 (car (xml-get-children node
'id
)))))
1245 (xml-node-children node
))))
1246 (or new-item new-feed
)))
1248 (defun newsticker--parse-rss-0.91
(name time topnode
)
1249 "Parse RSS 0.91 data.
1250 Return value as well as arguments NAME, TIME, and TOPNODE are the
1251 same as in `newsticker--parse-atom-1.0'.
1253 For the RSS 0.91 specification see URL `http://backend.userland.com/rss091'
1254 or URL `http://my.netscape.com/publish/formats/rss-spec-0.91.html'."
1255 (newsticker--debug-msg "Parsing RSS 0.91 feed %s" name
)
1256 (let* ((channelnode (car (xml-get-children topnode
'channel
)))
1257 is-new-feed has-new-items
)
1258 (setq is-new-feed
(newsticker--parse-generic-feed
1261 (car (xml-node-children
1262 (car (xml-get-children channelnode
'title
))))
1264 (car (xml-node-children
1265 (car (xml-get-children channelnode
1268 (car (xml-node-children
1269 (car (xml-get-children channelnode
'link
))))
1271 (xml-node-children channelnode
)))
1272 (setq has-new-items
(newsticker--parse-generic-items
1273 name time
(xml-get-children channelnode
'item
)
1276 (car (xml-node-children
1277 (car (xml-get-children node
'title
)))))
1280 (car (xml-node-children
1281 (car (xml-get-children node
'description
)))))
1284 (car (xml-node-children
1285 (car (xml-get-children node
'link
)))))
1288 (newsticker--decode-rfc822-date
1289 (car (xml-node-children
1290 (car (xml-get-children node
'pubDate
))))))
1296 (xml-node-children node
))))
1297 (or has-new-items is-new-feed
)))
1299 (defun newsticker--parse-rss-0.92
(name time topnode
)
1300 "Parse RSS 0.92 data.
1301 Return value as well as arguments NAME, TIME, and TOPNODE are the
1302 same as in `newsticker--parse-atom-1.0'.
1304 For the RSS 0.92 specification see URL `http://backend.userland.com/rss092'."
1305 (newsticker--debug-msg "Parsing RSS 0.92 feed %s" name
)
1306 (let* ((channelnode (car (xml-get-children topnode
'channel
)))
1307 is-new-feed has-new-items
)
1308 (setq is-new-feed
(newsticker--parse-generic-feed
1311 (car (xml-node-children
1312 (car (xml-get-children channelnode
'title
))))
1314 (car (xml-node-children
1315 (car (xml-get-children channelnode
1318 (car (xml-node-children
1319 (car (xml-get-children channelnode
'link
))))
1321 (xml-node-children channelnode
)))
1322 (setq has-new-items
(newsticker--parse-generic-items
1323 name time
(xml-get-children channelnode
'item
)
1326 (car (xml-node-children
1327 (car (xml-get-children node
'title
)))))
1330 (car (xml-node-children
1331 (car (xml-get-children node
'description
)))))
1334 (car (xml-node-children
1335 (car (xml-get-children node
'link
)))))
1338 (newsticker--decode-rfc822-date
1339 (car (xml-node-children
1340 (car (xml-get-children node
'pubDate
))))))
1346 (xml-node-children node
))))
1347 (or has-new-items is-new-feed
)))
1349 (defun newsticker--parse-rss-1.0
(name time topnode
)
1350 "Parse RSS 1.0 data.
1351 Return value as well as arguments NAME, TIME, and TOPNODE are the
1352 same as in `newsticker--parse-atom-1.0'.
1354 For the RSS 1.0 specification see URL `http://web.resource.org/rss/1.0/spec'."
1355 (newsticker--debug-msg "Parsing RSS 1.0 feed %s" name
)
1356 (let* ((channelnode (car (xml-get-children topnode
'channel
)))
1357 is-new-feed has-new-items
)
1358 (setq is-new-feed
(newsticker--parse-generic-feed
1361 (car (xml-node-children
1362 (car (xml-get-children channelnode
'title
))))
1364 (or (car (xml-node-children
1365 (car (xml-get-children channelnode
1367 (car (xml-node-children
1368 (car (xml-get-children channelnode
1369 'content
:encoded
))))
1370 (car (xml-node-children
1371 (car (xml-get-children channelnode
1374 (car (xml-node-children
1375 (car (xml-get-children channelnode
'link
))))
1377 (xml-node-children channelnode
)))
1378 (setq has-new-items
(newsticker--parse-generic-items
1379 name time
(xml-get-children topnode
'item
)
1382 (car (xml-node-children
1383 (car (xml-get-children node
'title
)))))
1386 (car (xml-node-children
1387 (car (xml-get-children node
1391 (car (xml-node-children
1392 (car (xml-get-children node
'link
)))))
1395 (newsticker--decode-iso8601-date
1396 (or (car (xml-node-children
1397 (car (xml-get-children node
'dc
:date
))))
1398 (car (xml-node-children
1399 (car (xml-get-children node
'date
)))))))
1405 (xml-node-children node
))))
1406 (or has-new-items is-new-feed
)))
1408 (defun newsticker--parse-rss-2.0
(name time topnode
)
1409 "Parse RSS 2.0 data.
1410 Return value as well as arguments NAME, TIME, and TOPNODE are the
1411 same as in `newsticker--parse-atom-1.0'.
1413 For the RSS 2.0 specification see URL `http://blogs.law.harvard.edu/tech/rss'."
1414 (newsticker--debug-msg "Parsing RSS 2.0 feed %s" name
)
1415 (let* ((channelnode (car (xml-get-children topnode
'channel
)))
1416 is-new-feed has-new-items
)
1417 (setq is-new-feed
(newsticker--parse-generic-feed
1420 (car (xml-node-children
1421 (car (xml-get-children channelnode
'title
))))
1423 (or (car (xml-node-children
1424 (car (xml-get-children channelnode
1426 (car (xml-node-children
1427 (car (xml-get-children channelnode
1428 'content
:encoded
))))
1429 (car (xml-node-children
1430 (car (xml-get-children channelnode
1433 (car (xml-node-children
1434 (car (xml-get-children channelnode
'link
))))
1436 (xml-node-children channelnode
)))
1437 (setq has-new-items
(newsticker--parse-generic-items
1438 name time
(xml-get-children channelnode
'item
)
1441 (car (xml-node-children
1442 (car (xml-get-children node
'title
)))))
1445 (or (car (xml-node-children
1446 (car (xml-get-children node
1448 (car (xml-node-children
1449 (car (xml-get-children node
1450 'content
:encoded
))))
1451 (car (xml-node-children
1452 (car (xml-get-children node
1456 (car (xml-node-children
1457 (car (xml-get-children node
'link
)))))
1460 (newsticker--decode-rfc822-date
1461 (car (xml-node-children
1462 (car (xml-get-children node
'pubDate
))))))
1465 (newsticker--guid-to-string
1466 (assoc 'guid
(xml-node-children node
))))
1469 (xml-node-children node
))))
1470 (or has-new-items is-new-feed
)))
1472 (defun newsticker--parse-generic-feed (name time title desc link
1474 "Parse generic news feed data.
1475 Argument NAME gives the name of a news feed. TIME gives the
1476 system time at which the data have been retrieved.
1478 The arguments TITLE, DESC, LINK, and EXTRA-ELEMENTS give the feed's title,
1479 description, link, and extra elements resp."
1480 (let ((title (or title
"[untitled]"))
1483 (something-was-added nil
))
1484 ;; decode numeric entities
1485 (setq title
(xml-substitute-numeric-entities title
))
1486 (setq desc
(xml-substitute-numeric-entities desc
))
1487 (setq link
(xml-substitute-numeric-entities link
))
1488 ;; remove whitespace from title, desc, and link
1489 (setq title
(newsticker--remove-whitespace title
))
1490 (setq desc
(newsticker--remove-whitespace desc
))
1491 (setq link
(newsticker--remove-whitespace link
))
1493 ;; handle the feed itself
1494 (unless (newsticker--cache-contains newsticker--cache
1497 (setq something-was-added t
))
1498 (setq newsticker--cache
1499 (newsticker--cache-add newsticker--cache
(intern name
)
1500 title desc link time
'feed position
1501 extra-elements time
'feed
))
1502 something-was-added
))
1504 (defun newsticker--parse-generic-items (name time itemlist
1508 "Parse generic news feed data.
1509 Argument NAME gives the name of a news feed. TIME gives the
1510 system time at which the data have been retrieved. ITEMLIST
1511 contains the news items returned by the xml parser.
1513 The arguments TITLE-FN, DESC-FN, LINK-FN, TIME-FN, GUID-FN, and
1514 EXTRA-FN give functions for extracting title, description, link,
1515 time, guid, and extra-elements resp. They are called with one
1516 argument, which is one of the items in ITEMLIST."
1518 (something-was-added nil
))
1519 ;; gather all items for this feed
1520 (dolist (node itemlist
)
1521 (setq position
(1+ position
))
1522 (let ((title (or (funcall title-fn node
) "[untitled]"))
1523 (desc (funcall desc-fn node
))
1524 (link (or (funcall link-fn node
) "")))
1525 (setq time
(or (funcall time-fn node
) time
))
1526 ;; It happened that the title or description
1527 ;; contained evil HTML code that confused the
1528 ;; xml parser. Therefore:
1529 (unless (stringp title
)
1530 (setq title
(prin1-to-string title
)))
1531 (unless (or (stringp desc
) (not desc
))
1532 (setq desc
(prin1-to-string desc
)))
1533 ;; ignore items with empty title AND empty desc
1534 (when (or (> (length title
) 0)
1535 (> (length desc
) 0))
1536 ;; decode numeric entities
1537 (setq title
(xml-substitute-numeric-entities title
))
1539 (setq desc
(xml-substitute-numeric-entities desc
)))
1540 (setq link
(xml-substitute-numeric-entities link
))
1541 ;; remove whitespace from title, desc, and link
1542 (setq title
(newsticker--remove-whitespace title
))
1543 (setq desc
(newsticker--remove-whitespace desc
))
1544 (setq link
(newsticker--remove-whitespace link
))
1545 ;; add data to cache
1546 ;; do we have this item already?
1548 (let* ((guid (funcall guid-fn node
)))
1549 ;;(message "guid=%s" guid)
1550 (newsticker--cache-contains newsticker--cache
1552 desc link nil guid
)))
1556 ;; Add this item, or mark it as old, or do nothing
1558 (let ((prev-age (newsticker--age old-item
)))
1559 (unless newsticker-automatically-mark-items-as-old
1560 ;; Some feeds deliver items multiply, the
1561 ;; first time we find an 'obsolete-old one in
1562 ;; the cache, the following times we find an
1564 (if (memq prev-age
'(obsolete-old old
))
1567 (if (eq prev-age
'immortal
)
1568 (setq age2
'immortal
))
1569 (setq time
(newsticker--time old-item
)))
1570 ;; item was not there
1572 (setq something-was-added t
))
1573 (let ((extra-elements-with-guid (funcall extra-fn node
)))
1574 (unless (assoc 'guid extra-elements-with-guid
)
1575 (setq extra-elements-with-guid
1576 (cons `(guid nil
,(funcall guid-fn node
))
1577 extra-elements-with-guid
)))
1578 (setq newsticker--cache
1579 (newsticker--cache-add
1580 newsticker--cache
(intern name
) title desc link
1581 time age1 position extra-elements-with-guid
1584 (let ((item (newsticker--cache-contains
1585 newsticker--cache
(intern name
) title
1587 (if newsticker-auto-mark-filter-list
1588 (newsticker--run-auto-mark-filter name item
))
1590 'newsticker-new-item-functions name item
)))))))
1591 something-was-added
))
1593 ;; ======================================================================
1595 ;; ======================================================================
1597 (defun newsticker--insert-bytes (bytes)
1598 (insert (decode-coding-string bytes
'binary
)))
1600 (defun newsticker--remove-whitespace (string)
1601 "Remove leading and trailing whitespace from STRING."
1602 ;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
1604 (when (and string
(stringp string
))
1605 (replace-regexp-in-string
1607 (replace-regexp-in-string "^[ \t\r\n]+" "" string
))))
1609 (defun newsticker--do-forget-preformatted (item)
1610 "Forget pre-formatted data for ITEM.
1611 Remove the pre-formatted from `newsticker--cache'."
1613 (setcar (nthcdr 7 item
) nil
))
1615 (setcar (nthcdr 6 item
) nil
)))
1617 (defun newsticker--forget-preformatted ()
1618 "Forget all cached pre-formatted data.
1619 Remove the pre-formatted from `newsticker--cache'."
1620 (mapc (lambda (feed)
1621 (mapc 'newsticker--do-forget-preformatted
1624 (when (fboundp 'newsticker--buffer-set-uptodate
)
1625 (newsticker--buffer-set-uptodate nil
)))
1627 (defun newsticker--debug-msg (string &rest args
)
1628 "Print newsticker debug messages.
1629 This function calls `message' with arguments STRING and ARGS, if
1630 `newsticker-debug' is non-nil."
1631 (and newsticker-debug
1632 ;;(not (active-minibuffer-window))
1633 ;;(not (current-message))
1634 (apply 'message string args
)))
1636 (defun newsticker--decode-iso8601-date (iso8601-string)
1637 "Return ISO8601-STRING in format like `decode-time'.
1638 Converts from ISO-8601 to Emacs representation.
1640 2004-09-17T05:09:49.001+00:00
1641 2004-09-17T05:09:49+00:00
1642 2004-09-17T05:09+00:00
1651 "^ *\\([0-9]\\{4\\}\\)" ;year
1652 "\\(-\\([0-9]\\{2\\}\\)" ;month
1653 "\\(-\\([0-9]\\{2\\}\\)" ;day
1655 "\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" ;hour:minute
1656 "\\(:\\([0-9]\\{2\\}\\)\\(\\.[0-9]+\\)?\\)?" ;second
1658 "\\(\\([-+Z]\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)?"
1661 (let ((year (read (match-string 1 iso8601-string
)))
1662 (month (read (or (match-string 3 iso8601-string
)
1664 (day (read (or (match-string 5 iso8601-string
)
1666 (hour (read (or (match-string 7 iso8601-string
)
1668 (minute (read (or (match-string 8 iso8601-string
)
1670 (second (read (or (match-string 10 iso8601-string
)
1672 (sign (match-string 13 iso8601-string
))
1673 (offset-hour (read (or (match-string 15 iso8601-string
)
1675 (offset-minute (read (or (match-string 16 iso8601-string
)
1677 (cond ((string= sign
"+")
1678 (setq hour
(- hour offset-hour
))
1679 (setq minute
(- minute offset-minute
)))
1681 (setq hour
(+ hour offset-hour
))
1682 (setq minute
(+ minute offset-minute
))))
1683 ;; if UTC subtract current-time-zone offset
1684 ;;(setq second (+ (car (current-time-zone)) second)))
1687 (encode-time second minute hour day month year t
)
1689 (message "Cannot decode \"%s\"" iso8601-string
)
1693 (defun newsticker--decode-rfc822-date (rfc822-string)
1694 "Return RFC822-STRING in format like `decode-time'.
1695 Converts from RFC822 to Emacs representation.
1697 Sat, 07 September 2002 00:00:01 +0100
1698 Sat, 07 September 2002 00:00:01 MET
1699 Sat, 07 Sep 2002 00:00:01 GMT
1700 07 Sep 2002 00:00:01 GMT
1702 (if (and rfc822-string
(stringp rfc822-string
))
1707 "\\(\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)\\s-*,?\\)?\\s-*"
1709 "\\([0-9]\\{1,2\\}\\)\\s-+"
1711 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|"
1712 "Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\).*?\\s-+"
1714 "\\([0-9]\\{2,4\\}\\)"
1715 ;; time may be missing
1718 "\\([0-9]\\{2\\}\\)"
1720 ":\\([0-9]\\{2\\}\\)"
1722 "\\(:\\([0-9]\\{2\\}\\)\\)?"
1725 "UT\\|GMT\\|EST\\|EDT\\|CST\\|CDT\\|MST\\|MDT\\|PST\\|PDT"
1726 "\\|\\([-+]\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)"
1730 (let ((day (read (match-string 3 rfc822-string
)))
1731 (month-name (match-string 4 rfc822-string
))
1733 (year (read (match-string 5 rfc822-string
)))
1734 (hour (read (or (match-string 7 rfc822-string
) "0")))
1735 (minute (read (or (match-string 8 rfc822-string
) "0")))
1736 (second (read (or (match-string 10 rfc822-string
) "0")))
1737 (zone (match-string 12 rfc822-string
))
1738 (sign (match-string 13 rfc822-string
))
1739 (offset-hour (read (or (match-string 14 rfc822-string
)
1741 (offset-minute (read (or (match-string 15 rfc822-string
)
1746 (cond ((string= sign
"+")
1747 (setq hour
(- hour offset-hour
))
1748 (setq minute
(- minute offset-minute
)))
1750 (setq hour
(+ hour offset-hour
))
1751 (setq minute
(+ minute offset-minute
)))))
1752 (condition-case error-data
1754 (dolist (m '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
1755 "Sep" "Oct" "Nov" "Dec"))
1756 (if (string= month-name m
)
1759 (encode-time second minute hour day month year t
))
1761 (message "Cannot decode \"%s\": %s %s" rfc822-string
1762 (car error-data
) (cdr error-data
))
1766 (defun newsticker--lists-intersect-p (list1 list2
)
1767 "Return t if LIST1 and LIST2 share elements."
1770 (if (memq elt list2
)
1774 (defun newsticker--update-process-ids ()
1775 "Update list of ids of active newsticker processes.
1776 Checks list of active processes against list of newsticker processes."
1777 (let ((new-list nil
))
1778 (dolist (proc (process-list))
1779 (let ((id (process-id proc
)))
1780 (if (memq id newsticker--process-ids
)
1781 (setq new-list
(cons id new-list
)))))
1782 (setq newsticker--process-ids new-list
))
1783 (force-mode-line-update))
1785 ;; ======================================================================
1787 ;; ======================================================================
1788 (defun newsticker--images-dir ()
1789 "Return directory where feed images are saved."
1790 (concat newsticker-dir
"/images/"))
1792 (defun newsticker--icons-dir ()
1793 "Return directory where feed icons are saved."
1794 (concat newsticker-dir
"/icons/"))
1796 (defun newsticker--image-get (feed-name filename directory url
)
1797 "Get image for FEED-NAME by returning FILENAME from DIRECTORY.
1798 If the file does no exist or if it is older than 24 hours
1799 download it from URL first."
1800 (let ((image-name (concat directory feed-name
)))
1801 (if (and (file-exists-p image-name
)
1803 (time-add (nth 5 (file-attributes image-name
))
1804 (seconds-to-time 86400))))
1805 (newsticker--debug-msg "%s: Getting image for %s skipped"
1806 (format-time-string "%A, %H:%M")
1809 (newsticker--debug-msg "%s: Getting image for %s"
1810 (format-time-string "%A, %H:%M")
1812 (if (eq newsticker-retrieval-method
'intern
)
1813 (newsticker--image-download-by-url feed-name filename directory url
)
1814 (newsticker--image-download-by-wget feed-name filename directory url
)))))
1816 (defun newsticker--image-download-by-wget (feed-name filename directory url
)
1817 "Download image for FEED-NAME using external program.
1818 Save image as FILENAME in DIRECTORY, download it from URL."
1819 (let* ((proc-name (concat feed-name
"-" filename
))
1820 (buffername (concat " *newsticker-wget-image-" proc-name
"*"))
1821 (item (or (assoc feed-name newsticker-url-list
)
1822 (assoc feed-name newsticker-url-list-defaults
)
1824 "Cannot get image for %s: Check newsticker-url-list"
1826 (wget-arguments (or (car (cdr (cdr (cdr (cdr item
)))))
1827 newsticker-wget-arguments
)))
1828 (with-current-buffer (get-buffer-create buffername
)
1830 ;; throw an error if there is an old wget-process around
1831 (if (get-process feed-name
)
1832 (error "Another wget-process is running for image %s"
1835 (let* ((args (append wget-arguments
(list url
)))
1836 (proc (apply 'start-process proc-name buffername
1837 newsticker-wget-name args
)))
1838 (set-process-coding-system proc
'no-conversion
'no-conversion
)
1839 (set-process-sentinel proc
'newsticker--image-sentinel
)
1840 (process-put proc
'nt-directory directory
)
1841 (process-put proc
'nt-feed-name feed-name
)
1842 (process-put proc
'nt-filename filename
)))))
1844 (defun newsticker--image-sentinel (process _event
)
1845 "Sentinel for image-retrieving PROCESS caused by EVENT."
1846 (let* ((p-status (process-status process
))
1847 (exit-status (process-exit-status process
))
1848 (feed-name (process-get process
'nt-feed-name
))
1849 (directory (process-get process
'nt-directory
))
1850 (filename (process-get process
'nt-filename
)))
1851 ;; catch known errors (zombie processes, rubbish-xml, etc.)
1852 ;; if an error occurs the news feed is not updated!
1854 (unless (and (eq p-status
'exit
)
1856 (message "%s: Error while retrieving image from %s"
1857 (format-time-string "%A, %H:%M")
1859 (newsticker--image-remove directory feed-name
)
1861 (newsticker--image-save (process-buffer process
) directory filename
))))
1863 (defun newsticker--image-save (buffer directory file-name
)
1864 "Save contents of BUFFER in DIRECTORY as FILE-NAME.
1865 Finally kill buffer."
1866 (with-current-buffer buffer
1867 (let ((image-name (concat directory file-name
)))
1868 (set-buffer-file-coding-system 'no-conversion
)
1869 ;; make sure the cache dir exists
1870 (unless (file-directory-p directory
)
1871 (make-directory directory
))
1872 ;; write and close buffer
1873 (let ((require-final-newline nil
)
1874 (backup-inhibited t
)
1875 (coding-system-for-write 'no-conversion
))
1876 (write-region nil nil image-name nil
'quiet
))
1877 (set-buffer-modified-p nil
)
1878 (kill-buffer buffer
))))
1880 (defun newsticker--image-remove (directory file-name
)
1881 "In DIRECTORY remove FILE-NAME."
1882 (let ((image-name (concat directory file-name
)))
1883 (when (file-exists-p file-name
)
1884 (delete-file image-name
))))
1886 (defun newsticker--image-download-by-url (feed-name filename directory url
)
1887 "Download image for FEED-NAME using `url-retrieve'.
1888 Save image as FILENAME in DIRECTORY, download it from URL."
1889 (let ((coding-system-for-read 'no-conversion
))
1890 (condition-case error-data
1891 (url-retrieve url
'newsticker--image-download-by-url-callback
1892 (list feed-name directory filename
))
1893 (error (message "Error retrieving image from %s: %s" feed-name
1895 (force-mode-line-update))
1897 (defun newsticker--image-download-by-url-callback (status feed-name directory filename
)
1898 "Callback function for `newsticker--image-download-by-url'.
1899 STATUS is the return status as delivered by `url-retrieve'.
1900 FEED-NAME is the name of the feed that the news were retrieved
1902 The image is saved in DIRECTORY as FILENAME."
1905 ;; (let ((status-type (car status)))
1906 ;; (cond ((eq status-type :redirect)
1907 ;; ;; don't care about redirects
1909 ;; ((eq status-type :error)
1910 ;; ;; silently ignore errors
1912 (eq (car status
) :redirect
))))
1914 (let ((buf (get-buffer-create (concat " *newsticker-url-image-" feed-name
"-"
1916 (result (buffer-string)))
1919 (newsticker--insert-bytes result
)
1920 ;; remove MIME header
1921 (goto-char (point-min))
1922 (search-forward "\n\n")
1923 (delete-region (point-min) (point))
1925 (newsticker--image-save buf directory filename
)))))
1927 (defun newsticker--insert-image (img string
)
1928 "Insert IMG with STRING at point."
1929 (insert-image img string
))
1931 ;; ======================================================================
1933 ;; ======================================================================
1934 (defun newsticker-htmlr-render (pos1 pos2
) ;
1935 "Replacement for `htmlr-render'.
1936 Renders the HTML code in the region POS1 to POS2 using htmlr."
1937 (let ((str (buffer-substring-no-properties pos1 pos2
)))
1938 (delete-region pos1 pos2
)
1942 (goto-char (point-min))
1943 ;; begin original htmlr-render
1944 (when (fboundp 'htmlr-reset
) (htmlr-reset))
1945 ;; something omitted here...
1946 (when (fboundp 'htmlr-step
)
1947 (while (< (point) (point-max))
1949 ;; end original htmlr-render
1950 (newsticker--remove-whitespace (buffer-string))))))
1952 ;; ======================================================================
1953 ;;; Manipulation of cached data
1954 ;; ======================================================================
1955 (defun newsticker--cache-set-preformatted-contents (item contents
)
1956 "Set preformatted contents of ITEM to CONTENTS."
1958 (setcar (nthcdr 6 item
) contents
)
1959 (setcdr (nthcdr 5 item
) (list contents
))))
1961 (defun newsticker--cache-set-preformatted-title (item title
)
1962 "Set preformatted title of ITEM to TITLE."
1964 (setcar (nthcdr 7 item
) title
)
1965 (setcdr (nthcdr 6 item
) title
)))
1967 (defun newsticker--cache-replace-age (data feed old-age new-age
)
1968 "Mark all items in DATA in FEED which carry age OLD-AGE with NEW-AGE.
1969 If FEED is `any' it applies to all feeds. If OLD-AGE is `any',
1970 all marks are replaced by NEW-AGE. Removes all pre-formatted contents."
1971 (mapc (lambda (a-feed)
1972 (when (or (eq feed
'any
)
1973 (eq (car a-feed
) feed
))
1974 (let ((items (cdr a-feed
)))
1975 (mapc (lambda (item)
1976 (when (or (eq old-age
'any
)
1977 (eq (newsticker--age item
) old-age
))
1978 (setcar (nthcdr 4 item
) new-age
)
1979 (newsticker--do-forget-preformatted item
)))
1984 (defun newsticker--cache-mark-expired (data feed old-age new-age time
)
1985 "Mark all expired entries.
1986 This function sets the age entries in DATA in the feed FEED. If
1987 an item's age is OLD-AGE it is set to NEW-AGE if the item is
1991 (when (or (eq feed
'any
)
1992 (eq (car a-feed
) feed
))
1993 (let ((items (cdr a-feed
)))
1996 (when (eq (newsticker--age item
) old-age
)
1997 (let ((exp-time (time-add (newsticker--time item
)
1998 (seconds-to-time time
))))
1999 (when (time-less-p exp-time nil
)
2000 (newsticker--debug-msg
2001 "Item `%s' from %s has expired on %s"
2002 (newsticker--title item
)
2003 (format-time-string "%Y-%02m-%d, %H:%M"
2004 (newsticker--time item
))
2005 (format-time-string "%Y-%02m-%d, %H:%M" exp-time
))
2006 (setcar (nthcdr 4 item
) new-age
)))))
2011 (defun newsticker--cache-contains (data feed title desc link _age
2013 "Check DATA whether FEED contains an item with the given properties.
2014 This function returns the contained item or nil if it is not
2016 The properties which are checked are TITLE, DESC, LINK, AGE, and
2017 GUID. In general all properties must match in order to return a
2018 certain item, except for the following cases.
2020 If AGE equals `feed' the TITLE, DESCription and LINK do not
2021 matter. If DESC is nil it is ignored as well. If
2022 `newsticker-desc-comp-max' is non-nil, only the first
2023 `newsticker-desc-comp-max' characters of DESC are taken into
2026 If GUID is non-nil it is sufficient to match this value, and the
2027 other properties are ignored."
2028 ;;(newsticker--debug-msg "Looking for %s guid=%s" title guid)
2031 (when (and desc newsticker-desc-comp-max
2032 (> (length desc
) newsticker-desc-comp-max
))
2033 (setq desc
(substring desc
0 newsticker-desc-comp-max
)))
2036 (when (eq (car this-feed
) feed
)
2037 (mapc (lambda (anitem)
2039 ;; global unique id can match
2040 (string= guid
(newsticker--guid anitem
)))
2043 ;; or title, desc, etc.
2045 ;;(or (not (eq age 'feed))
2046 ;; (eq (newsticker--age anitem) 'feed))
2047 (string= (newsticker--title anitem
)
2050 (string= (newsticker--link anitem
)
2053 (if (and desc newsticker-desc-comp-max
2054 (> (length (newsticker--desc
2056 newsticker-desc-comp-max
))
2058 (newsticker--desc anitem
)
2060 newsticker-desc-comp-max
)
2062 (string= (newsticker--desc anitem
)
2064 ;;(newsticker--debug-msg "Found %s guid=%s"
2065 ;; (newsticker--title anitem)
2066 ;; (newsticker--guid anitem))
2067 (throw 'found anitem
)))
2070 ;;(newsticker--debug-msg "Found nothing")
2074 (defun newsticker--cache-add (data feed-name-symbol title desc link time age
2075 position extra-elements
2076 &optional updated-time updated-age
2077 preformatted-contents
2079 "Add another item to cache data.
2080 Add to DATA in the FEED-NAME-SYMBOL an item with TITLE, DESC,
2081 LINK, TIME, AGE, POSITION, and EXTRA-ELEMENTS. If this item is
2082 contained already, its time is set to UPDATED-TIME, its mark is
2083 set to UPDATED-AGE, and its pre-formatted contents is set to
2084 PREFORMATTED-CONTENTS and PREFORMATTED-TITLE. Returns the age
2085 which the item got."
2086 (let* ((guid (newsticker--guid-to-string (assoc 'guid extra-elements
)))
2087 (item (newsticker--cache-contains data feed-name-symbol title desc link
2089 ;;(message "guid=%s" guid)
2091 ;; does exist already -- change age, update time and position
2093 ;;(newsticker--debug-msg "Updating item %s %s %s %s %s -> %s %s
2095 ;; feed-name-symbol title link time age
2096 ;; updated-time updated-age
2097 ;; guid (newsticker--guid item))
2099 (setcar (nthcdr 5 item
) position
)
2100 (setcdr (nthcdr 4 item
) (list position
)))
2101 (setcar (nthcdr 4 item
) updated-age
)
2103 (setcar (nthcdr 3 item
) updated-time
))
2104 ;; replace cached pre-formatted contents
2105 (newsticker--cache-set-preformatted-contents
2106 item preformatted-contents
)
2107 (newsticker--cache-set-preformatted-title
2108 item preformatted-title
))
2109 ;; did not exist or age equals 'feed-name-symbol
2110 (setq item
(list title desc link time age position preformatted-contents
2111 preformatted-title extra-elements
))
2112 ;;(newsticker--debug-msg "Adding item %s" item)
2113 (let ((this-feed (assq feed-name-symbol data
)))
2115 (setcdr this-feed
(nconc (cdr this-feed
) (list item
)))
2116 ;; The feed is not contained.
2117 (setq data
(append data
(list (list feed-name-symbol item
)))))))
2120 (defun newsticker--cache-remove (data feed-symbol age
)
2121 "Remove all entries from DATA in the feed FEED-SYMBOL with AGE.
2122 FEED-SYMBOL may be `any'. Entries from old feeds, which are no longer in
2123 `newsticker-url-list' or `newsticker-url-list-defaults', are removed as
2129 (if (or (assoc (symbol-name (car feed
)) newsticker-url-list
)
2130 (assoc (symbol-name (car feed
)) newsticker-url-list-defaults
))
2131 ;; feed is still valid=active
2132 ;; (message "Keeping feed %s" (car feed))
2133 (if (or (eq feed-symbol
'any
)
2134 (eq feed-symbol
(car feed
)))
2135 (let* ((item-pos (cdr feed
))
2136 (item (car item-pos
))
2139 ;;(message "%s" (car item))
2140 (if (eq age
(newsticker--age item
))
2143 ;;(message "Removing item %s" (car item))
2145 (setcdr prev-pos
(cdr item-pos
))
2146 (setcdr feed
(cdr item-pos
))))
2147 ;;(message "Keeping item %s" (car item))
2148 (setq prev-pos item-pos
))
2149 (setq item-pos
(cdr item-pos
))
2150 (setq item
(car item-pos
)))))
2151 ;; feed is not active anymore
2152 ;; (message "Removing feed %s" (car feed))
2154 (setcdr last-pos
(cdr pos
))
2155 (setq data
(cdr pos
))))
2157 (setq pos
(cdr pos
))
2158 (setq feed
(car pos
)))))
2160 ;; ======================================================================
2162 ;; ======================================================================
2163 (defun newsticker--cache-item-compare-by-time (item1 item2
)
2164 "Compare two news items ITEM1 and ITEM2 by comparing their time values."
2166 (let ((age1 (newsticker--age item1
))
2167 (age2 (newsticker--age item2
)))
2168 (if (not (eq age1 age2
))
2169 (cond ((eq age1
'obsolete
)
2170 (throw 'result nil
))
2171 ((eq age2
'obsolete
)
2172 (throw 'result t
)))))
2173 (let* ((time1 (newsticker--time item1
))
2174 (time2 (newsticker--time item2
)))
2175 (cond ((< (nth 0 time1
) (nth 0 time2
))
2177 ((> (nth 0 time1
) (nth 0 time2
))
2179 ((< (nth 1 time1
) (nth 1 time2
))
2181 ((> (nth 1 time1
) (nth 1 time2
))
2183 ((< (or (nth 2 time1
) 0) (or (nth 2 time2
) 0))
2185 ((> (or (nth 2 time1
) 0) (or (nth 2 time2
) 0))
2190 (defun newsticker--cache-item-compare-by-title (item1 item2
)
2191 "Compare ITEM1 and ITEM2 by comparing their titles."
2193 (let ((age1 (newsticker--age item1
))
2194 (age2 (newsticker--age item2
)))
2195 (if (not (eq age1 age2
))
2196 (cond ((eq age1
'obsolete
)
2197 (throw 'result nil
))
2198 ((eq age2
'obsolete
)
2199 (throw 'result t
)))))
2200 (string< (newsticker--title item1
) (newsticker--title item2
))))
2202 (defun newsticker--cache-item-compare-by-position (item1 item2
)
2203 "Compare ITEM1 and ITEM2 by comparing their original positions."
2205 (let ((age1 (newsticker--age item1
))
2206 (age2 (newsticker--age item2
)))
2207 (if (not (eq age1 age2
))
2208 (cond ((eq age1
'obsolete
)
2209 (throw 'result nil
))
2210 ((eq age2
'obsolete
)
2211 (throw 'result t
)))))
2212 (< (or (newsticker--pos item1
) 0) (or (newsticker--pos item2
) 0))))
2214 (defun newsticker--cache-save-version1 ()
2215 "Update and save newsticker cache file."
2217 (newsticker--cache-update t
))
2219 (defun newsticker--cache-update (&optional save
)
2220 "Update newsticker cache file.
2221 If optional argument SAVE is not nil the cache file is saved to disk."
2223 (unless (file-directory-p newsticker-dir
)
2224 (make-directory newsticker-dir t
))
2225 (let ((coding-system-for-write 'utf-8
)
2226 (buf (find-file-noselect newsticker-cache-filename
)))
2229 (setq buffer-undo-list t
)
2231 (insert ";; -*- coding: utf-8 -*-\n")
2232 (insert (prin1-to-string newsticker--cache
))
2236 (defun newsticker--cache-get-feed (feed)
2237 "Return the cached data for the feed FEED.
2239 (assoc feed newsticker--cache
))
2241 (defun newsticker--cache-dir ()
2242 "Return directory for saving cache data."
2243 (concat newsticker-dir
"/feeds"))
2245 (defun newsticker--cache-save ()
2246 "Save cache data for all feeds."
2247 (unless (file-directory-p newsticker-dir
)
2248 (make-directory newsticker-dir t
))
2249 (mapc 'newsticker--cache-save-feed newsticker--cache
)
2252 (defun newsticker--cache-save-feed (feed)
2253 "Save cache data for FEED."
2254 (let ((dir (concat (newsticker--cache-dir) "/" (symbol-name (car feed
)))))
2255 (unless (file-directory-p dir
)
2256 (make-directory dir t
))
2257 (let ((coding-system-for-write 'utf-8
))
2258 (with-temp-file (concat dir
"/data")
2259 (insert ";; -*- coding: utf-8 -*-\n")
2260 (insert (prin1-to-string (cdr feed
)))))))
2262 (defun newsticker--cache-read-version1 ()
2263 "Read version1 cache data."
2264 (let ((coding-system-for-read 'utf-8
))
2265 (when (file-exists-p newsticker-cache-filename
)
2267 (insert-file-contents newsticker-cache-filename
)
2268 (goto-char (point-min))
2270 (setq newsticker--cache
(read (current-buffer)))
2272 (message "Error while reading newsticker cache file!")
2273 (setq newsticker--cache nil
)))))))
2275 (defun newsticker--cache-read ()
2277 (setq newsticker--cache nil
)
2278 (if (file-exists-p newsticker-cache-filename
)
2280 (when (y-or-n-p "Old newsticker cache file exists. Read it? ")
2281 (newsticker--cache-read-version1))
2282 (when (y-or-n-p (format "Delete old newsticker cache file? "))
2283 (delete-file newsticker-cache-filename
)))
2284 (dolist (f (append newsticker-url-list-defaults newsticker-url-list
))
2285 (newsticker--cache-read-feed (car f
)))))
2287 (defun newsticker--cache-read-feed (feed-name)
2288 "Read cache data for feed named FEED-NAME."
2289 (let ((file-name (concat (newsticker--cache-dir) "/" feed-name
"/data"))
2290 (coding-system-for-read 'utf-8
))
2291 (when (file-exists-p file-name
)
2293 (insert-file-contents file-name
)
2294 (goto-char (point-min))
2296 (add-to-list 'newsticker--cache
(cons (intern feed-name
)
2297 (read (current-buffer))))
2299 (message "Error while reading newsticker cache file %s!"
2301 (setq newsticker--cache nil
)))))))
2303 ;; ======================================================================
2305 ;; ======================================================================
2306 (defun newsticker--stat-num-items (feed &rest ages
)
2307 "Return number of items in the given FEED which have one of the given AGES.
2308 If AGES is nil, the total number of items is returned."
2309 (let ((items (cdr (newsticker--cache-get-feed feed
)))
2313 (if (memq (newsticker--age (car items
)) ages
)
2314 (setq num
(1+ num
)))
2315 (if (memq (newsticker--age (car items
)) '(new old immortal obsolete
))
2316 (setq num
(1+ num
))))
2317 (setq items
(cdr items
)))
2320 (defun newsticker--stat-num-items-total (&optional age
)
2321 "Return total number of items in all feeds which have the given AGE.
2322 If AGE is nil, the total number of items is returned."
2324 (mapcar (lambda (feed)
2326 (newsticker--stat-num-items (intern (car feed
)) age
)
2327 (newsticker--stat-num-items (intern (car feed
)))))
2328 (append newsticker-url-list-defaults newsticker-url-list
))))
2330 ;; ======================================================================
2332 ;; ======================================================================
2333 (defun newsticker-opml-export ()
2334 "OPML subscription export.
2335 Export subscriptions to a buffer in OPML Format."
2336 ;; FIXME: use newsticker-groups
2338 (with-current-buffer (get-buffer-create "*OPML Export*")
2339 (set-buffer-file-coding-system 'utf-8
)
2341 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
2342 "<!-- OPML generated by Emacs newsticker.el -->\n"
2343 "<opml version=\"1.0\">\n"
2345 " <title>mySubscriptions</title>\n"
2346 " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
2348 " <ownerEmail>" user-mail-address
"</ownerEmail>\n"
2349 " <ownerName>" (user-full-name) "</ownerName>\n"
2352 (dolist (sub (append newsticker-url-list newsticker-url-list-defaults
))
2353 (insert " <outline text=\"")
2354 (insert (newsticker--title sub
))
2355 (insert "\" xmlUrl=\"")
2356 (insert (xml-escape-string (let ((url (cadr sub
)))
2357 (if (stringp url
) url
(prin1-to-string url
)))))
2359 (insert " </body>\n</opml>\n"))
2360 (pop-to-buffer "*OPML Export*")
2361 (when (fboundp 'sgml-mode
)
2364 (defun newsticker--opml-import-outlines (outlines)
2365 "Recursively import OUTLINES from OPML data.
2366 Note that nested outlines are currently flattened -- i.e. grouping is
2368 (mapc (lambda (outline)
2369 (let ((name (xml-get-attribute outline
'text
))
2370 (url (xml-get-attribute outline
'xmlUrl
))
2371 (children (xml-get-children outline
'outline
)))
2372 (unless (string= "" url
)
2373 (add-to-list 'newsticker-url-list
2374 (list name url nil nil nil
) t
))
2376 (newsticker--opml-import-outlines children
))))
2379 (defun newsticker-opml-import (filename)
2380 "Import OPML data from FILENAME."
2381 (interactive "fOPML file: ")
2382 (set-buffer (find-file-noselect filename
))
2383 (goto-char (point-min))
2384 (let* ((node-list (xml-parse-region (point-min) (point-max)))
2385 (body (car (xml-get-children (car node-list
) 'body
)))
2386 (outlines (xml-get-children body
'outline
)))
2387 (newsticker--opml-import-outlines outlines
))
2388 (customize-variable 'newsticker-url-list
))
2390 ;; ======================================================================
2392 ;; ======================================================================
2393 (defun newsticker--run-auto-mark-filter (feed item
)
2394 "Automatically mark an item as old or immortal.
2395 This function checks the variable `newsticker-auto-mark-filter-list'
2396 for an entry that matches FEED and ITEM."
2397 (let ((case-fold-search t
))
2398 (dolist (filter newsticker-auto-mark-filter-list
)
2399 (let ((filter-feed (car filter
))
2400 (pattern-list (cadr filter
)))
2401 (when (string-match filter-feed feed
)
2402 (newsticker--do-run-auto-mark-filter item pattern-list
))))))
2404 (defun newsticker--do-run-auto-mark-filter (item list
)
2405 "Actually compare ITEM against the pattern-LIST.
2406 LIST must be an element of `newsticker-auto-mark-filter-list'."
2407 (dolist (pattern list
)
2408 (let ((place (nth 1 pattern
))
2409 (regexp (nth 2 pattern
))
2410 (title (newsticker--title item
))
2411 (desc (newsticker--desc item
)))
2412 (when (or (eq place
'title
) (eq place
'all
))
2413 (when (and title
(string-match regexp title
))
2414 (newsticker--process-auto-mark-filter-match item pattern
)))
2415 (when (or (eq place
'description
) (eq place
'all
))
2416 (when (and desc
(string-match regexp desc
))
2417 (newsticker--process-auto-mark-filter-match item pattern
))))))
2419 (defun newsticker--process-auto-mark-filter-match (item pattern
)
2420 "Process ITEM that matches an auto-mark-filter PATTERN."
2421 (let ((age (nth 0 pattern
))
2422 (place (nth 1 pattern
))
2423 (regexp (nth 2 pattern
)))
2424 (newsticker--debug-msg "Auto-mark-filter %s matches `%s'"
2425 pattern
(newsticker--title item
))
2426 (setcar (nthcdr 4 item
) age
)
2427 (nconc (newsticker--extra item
)
2428 (list (list 'newsticker-auto-mark nil
2429 (format "age=%s, title/desc=%s, regexp=%s"
2430 age place regexp
))))))
2432 ;; ======================================================================
2434 ;; ======================================================================
2435 (defun newsticker-new-item-functions-sample (feedname item
)
2436 "Demonstrate the use of the `newsticker-new-item-functions' hook.
2437 This function just prints out the values of the FEEDNAME and title of the ITEM."
2438 (message (concat "newsticker-new-item-functions-sample: feed=`%s', "
2440 feedname
(newsticker--title item
)))
2442 (defun newsticker-download-images (feedname item
)
2443 "Download the first image.
2444 If FEEDNAME equals \"imagefeed\" download the first image URL
2445 found in the description=contents of ITEM to the directory
2446 \"~/tmp/newsticker/FEEDNAME/TITLE\" where TITLE is the title of
2448 (when (string= feedname
"imagefeed")
2449 (let ((title (newsticker--title item
))
2450 (desc (newsticker--desc item
)))
2451 (when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc
)
2452 (let ((url (substring desc
(match-beginning 1) (match-end 1)))
2453 (temp-dir (concat "~/tmp/newsticker/" feedname
"/" title
))
2454 (org-dir default-directory
))
2455 (unless (file-directory-p temp-dir
)
2456 (make-directory temp-dir t
))
2458 (message "Getting image %s" url
)
2459 (apply 'start-process
"wget-image"
2460 " *newsticker-wget-download-images*"
2461 newsticker-wget-name
2465 (defun newsticker-download-enclosures (feedname item
)
2466 "In all feeds download the enclosed object of the news ITEM.
2467 The object is saved to the directory \"~/tmp/newsticker/FEEDNAME/TITLE\", which
2468 is created if it does not exist. TITLE is the title of the news
2469 item. Argument FEEDNAME is ignored.
2470 This function is suited for adding it to `newsticker-new-item-functions'."
2471 (let ((title (newsticker--title item
))
2472 (enclosure (newsticker--enclosure item
)))
2474 (let ((url (cdr (assoc 'url enclosure
)))
2475 (temp-dir (concat "~/tmp/newsticker/" feedname
"/" title
))
2476 (org-dir default-directory
))
2477 (unless (file-directory-p temp-dir
)
2478 (make-directory temp-dir t
))
2480 (message "Getting enclosure %s" url
)
2481 (apply 'start-process
"wget-enclosure"
2482 " *newsticker-wget-download-enclosures*"
2483 newsticker-wget-name
2487 ;; ======================================================================
2488 ;;; Retrieve samples
2489 ;; ======================================================================
2490 (defun newsticker-retrieve-random-message (_feed-name)
2491 "Return an artificial RSS string under the name FEED-NAME."
2492 (concat "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?><rss version=\"0.91\">"
2494 "<title>newsticker-retrieve-random-message</title>"
2495 "<description>Sample retrieval function</description>"
2496 "<pubDate>FIXME Sat, 07 Sep 2005 00:00:01 GMT</pubDate>"
2497 "<item><title>" (format "Your lucky number is %d" (random 10000))
2498 "</title><description>" (format "Or maybe it is %d" (random 10000))
2499 "</description></item></channel></rss>"))
2501 (provide 'newst-backend
)
2503 ;;; newst-backend.el ends here