;;; newst-backend.el --- Retrieval backend for newsticker.
-;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-backend.el
;; URL: http://www.nongnu.org/newsticker
;; Keywords: News, RSS, Atom
-;; Time-stamp: "7. Juli 2008, 19:20:10 (ulf)"
+;; Time-stamp: "13. Mai 2011, 20:47:05 (ulf)"
+;; Package: newsticker
;; ======================================================================
nil
3600)
("Freshmeat.net"
- "http://freshmeat.net/backend/fm.rdf")
+ "http://freshmeat.net/index.atom")
("Kuro5hin.org"
"http://www.kuro5hin.org/backend.rdf")
("LWN (Linux Weekly News)"
"http://lwn.net/headlines/rss")
- ("NewsForge"
- "http://newsforge.com/index.rss")
("NY Times: Technology"
"http://partners.userland.com/nytRss/technology.xml")
("NY Times"
"Name of the newsticker cache file."
:type 'string
:group 'newsticker-miscellaneous)
+(make-obsolete 'newsticker-cache-filename 'newsticker-dir "23.1")
-(defcustom newsticker-imagecache-dirname
- "~/.newsticker-images"
- "Name of the directory where newsticker stores cached images."
- :type 'string
+(defcustom newsticker-dir
+ (locate-user-emacs-file "newsticker/" ".newsticker/")
+ "Directory where newsticker saves data."
+ :type 'directory
:group 'newsticker-miscellaneous)
;; debugging
;; ======================================================================
;;; Compatibility section, XEmacs, Emacs
;; ======================================================================
+
+;; FIXME It is bad practice to define compat functions with such generic names.
+
+;; This is not needed in Emacs >= 22.1.
(unless (fboundp 'time-add)
(require 'time-date);;FIXME
(defun time-add (t1 t2)
- (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2)))))
+ (with-no-warnings ; don't warn about obsolete time-to-seconds in 23.2
+ (seconds-to-time (+ (time-to-seconds t1) (time-to-seconds t2))))))
(unless (fboundp 'match-string-no-properties)
(defalias 'match-string-no-properties 'match-string))
(let ((running (newsticker-running-p)))
;; read old cache if it exists and newsticker is not running
(unless running
- (let ((coding-system-for-read 'utf-8))
- (when (file-exists-p newsticker-cache-filename)
- (with-temp-buffer
- (insert-file-contents newsticker-cache-filename)
- (goto-char (point-min))
- (condition-case nil
- (setq newsticker--cache (read (current-buffer)))
- (error
- (message "Error while reading newsticker cache file!")
- (setq newsticker--cache nil)))))))
+ (newsticker--cache-read))
;; start retrieval timers -- one timer for each feed
(dolist (feed (append newsticker-url-list-defaults newsticker-url-list))
(newsticker--start-feed feed))
Cancel the timers for display and retrieval. Run `newsticker-stop-hook'
if newsticker has been running."
(interactive)
- (newsticker--cache-update t)
+ (newsticker--cache-save)
(when (fboundp 'newsticker-stop-ticker) ; silence compiler warnings
(newsticker-stop-ticker))
(when (newsticker-running-p)
(defun newsticker-customize ()
"Open the newsticker customization group."
(interactive)
+ (delete-other-windows)
(customize-group "newsticker"))
;; ======================================================================
"Get news for the site FEED-NAME by calling FUNCTION.
See `newsticker-get-news'."
(let ((buffername (concat " *newsticker-funcall-" feed-name "*")))
- (save-excursion
- (set-buffer (get-buffer-create buffername))
+ (with-current-buffer (get-buffer-create buffername)
(erase-buffer)
(insert (string-to-multibyte (funcall function feed-name)))
(newsticker--sentinel-work nil t feed-name function
See `newsticker-get-news'."
(let ((coding-system-for-read 'no-conversion))
(condition-case error-data
- (url-retrieve url 'newsticker--get-news-by-url-callback
+ (url-retrieve url 'newsticker--get-news-by-url-callback
(list feed-name))
(error (message "Error retrieving news from %s: %s" feed-name
error-data))))
WGET-ARGUMENTS is a list of arguments for wget.
See `newsticker-get-news'."
(let ((buffername (concat " *newsticker-wget-" feed-name "*")))
- (save-excursion
- (set-buffer (get-buffer-create buffername))
+ (with-current-buffer (get-buffer-create buffername)
(erase-buffer)
;; throw an error if there is an old wget-process around
(if (get-process feed-name)
(setq newsticker--latest-update-time (current-time))
(when something-was-added
;; FIXME: should we care about removed items as well?
- (newsticker--cache-update)
+ (newsticker--cache-save-feed
+ (newsticker--cache-get-feed name-symbol))
(when (fboundp 'newsticker--buffer-set-uptodate) ;silence
;compiler
;warnings
contains the feed data as returned by the xml parser.
For the Atom 1.0 specification see
-http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html"
+URL `http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html'"
(newsticker--debug-msg "Parsing Atom 1.0 feed %s" name)
(let (new-feed new-item)
(setq new-feed (newsticker--parse-generic-feed
Return value as well as arguments NAME, TIME, and TOPNODE are the
same as in `newsticker--parse-atom-1.0'.
-For the RSS 0.91 specification see http://backend.userland.com/rss091 or
-http://my.netscape.com/publish/formats/rss-spec-0.91.html."
+For the RSS 0.91 specification see URL `http://backend.userland.com/rss091'
+or URL `http://my.netscape.com/publish/formats/rss-spec-0.91.html'."
(newsticker--debug-msg "Parsing RSS 0.91 feed %s" name)
(let* ((channelnode (car (xml-get-children topnode 'channel)))
(pub-date (newsticker--decode-rfc822-date
Return value as well as arguments NAME, TIME, and TOPNODE are the
same as in `newsticker--parse-atom-1.0'.
-For the RSS 0.92 specification see http://backend.userland.com/rss092."
+For the RSS 0.92 specification see URL `http://backend.userland.com/rss092'."
(newsticker--debug-msg "Parsing RSS 0.92 feed %s" name)
(let* ((channelnode (car (xml-get-children topnode 'channel)))
(pub-date (newsticker--decode-rfc822-date
Return value as well as arguments NAME, TIME, and TOPNODE are the
same as in `newsticker--parse-atom-1.0'.
-For the RSS 1.0 specification see http://web.resource.org/rss/1.0/spec."
+For the RSS 1.0 specification see URL `http://web.resource.org/rss/1.0/spec'."
(newsticker--debug-msg "Parsing RSS 1.0 feed %s" name)
(let* ((channelnode (car (xml-get-children topnode 'channel)))
is-new-feed has-new-items)
Return value as well as arguments NAME, TIME, and TOPNODE are the
same as in `newsticker--parse-atom-1.0'.
-For the RSS 2.0 specification see http://blogs.law.harvard.edu/tech/rss."
+For the RSS 2.0 specification see URL `http://blogs.law.harvard.edu/tech/rss'."
(newsticker--debug-msg "Parsing RSS 2.0 feed %s" name)
(let* ((channelnode (car (xml-get-children topnode 'channel)))
is-new-feed has-new-items)
(position 0)
(something-was-added nil))
;; decode numeric entities
- (setq title (newsticker--decode-numeric-entities title))
- (setq desc (newsticker--decode-numeric-entities desc))
- (setq link (newsticker--decode-numeric-entities link))
+ (setq title (xml-substitute-numeric-entities title))
+ (setq desc (xml-substitute-numeric-entities desc))
+ (setq link (xml-substitute-numeric-entities link))
;; remove whitespace from title, desc, and link
(setq title (newsticker--remove-whitespace title))
(setq desc (newsticker--remove-whitespace desc))
(when (or (> (length title) 0)
(> (length desc) 0))
;; decode numeric entities
- (setq title (newsticker--decode-numeric-entities title))
+ (setq title (xml-substitute-numeric-entities title))
(when desc
- (setq desc (newsticker--decode-numeric-entities desc)))
- (setq link (newsticker--decode-numeric-entities link))
+ (setq desc (xml-substitute-numeric-entities desc)))
+ (setq link (xml-substitute-numeric-entities link))
;; remove whitespace from title, desc, and link
(setq title (newsticker--remove-whitespace title))
(setq desc (newsticker--remove-whitespace desc))
;; ======================================================================
;;; Misc
;; ======================================================================
-(defun newsticker--decode-numeric-entities (string)
- "Decode SGML numeric entities by their respective utf characters.
-This function replaces numeric entities in the input STRING and
-returns the modified string. For example \"*\" gets replaced
-by \"*\"."
- (if (and string (stringp string))
- (let ((start 0))
- (while (string-match "&#\\([0-9]+\\);" string start)
- (condition-case nil
- (setq string (replace-match
- (string (read (substring string
- (match-beginning 1)
- (match-end 1))))
- nil nil string))
- (error nil))
- (setq start (1+ (match-beginning 0))))
- string)
- nil))
(defun newsticker--remove-whitespace (string)
"Remove leading and trailing whitespace from STRING."
;; ======================================================================
;;; Images
;; ======================================================================
+(defun newsticker--images-dir ()
+ "Return directory where feed images are saved."
+ (concat newsticker-dir "/images"))
+
(defun newsticker--image-get (feed-name url)
"Get image of the news site FEED-NAME from URL.
If the image has been downloaded in the last 24h do nothing."
- (let ((image-name (concat newsticker-imagecache-dirname "/"
- feed-name)))
+ (let ((image-name (concat (newsticker--images-dir) feed-name)))
(if (and (file-exists-p image-name)
(time-less-p (current-time)
(time-add (nth 5 (file-attributes image-name))
feed-name)))
(wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
newsticker-wget-arguments)))
- (save-excursion
- (set-buffer (get-buffer-create buffername))
+ (with-current-buffer (get-buffer-create buffername)
(erase-buffer)
;; throw an error if there is an old wget-process around
(if (get-process feed-name)
feed-name)
(throw 'oops nil))
(let (image-name)
- (save-excursion
- (set-buffer (process-buffer process))
- (setq image-name (concat newsticker-imagecache-dirname "/"
- feed-name))
+ (with-current-buffer (process-buffer process)
+ (setq image-name (concat (newsticker--images-dir) feed-name))
(set-buffer-file-coding-system 'no-conversion)
;; make sure the cache dir exists
- (unless (file-directory-p newsticker-imagecache-dirname)
- (make-directory newsticker-imagecache-dirname))
+ (unless (file-directory-p (newsticker--images-dir))
+ (make-directory (newsticker--images-dir)))
;; write and close buffer
(let ((require-final-newline nil)
(backup-inhibited t)
(set-buffer-modified-p nil)
(kill-buffer (current-buffer)))))))
-
-
(defun newsticker--insert-image (img string)
"Insert IMG with STRING at point."
(insert-image img string))
newsticker-desc-comp-max))
(string= (substring
(newsticker--desc anitem)
- 0
+ 0
newsticker-desc-comp-max)
desc)
(string= (newsticker--desc anitem)
desc)))))))
- ;;(newsticker--debug-msg "Found %s guid=%s"
+ ;;(newsticker--debug-msg "Found %s guid=%s"
;; (newsticker--title anitem)
;; (newsticker--guid anitem))
(throw 'found anitem)))
(if item
;; does exist already -- change age, update time and position
(progn
- ;;(newsticker--debug-msg "Updating item %s %s %s %s %s -> %s %s
+ ;;(newsticker--debug-msg "Updating item %s %s %s %s %s -> %s %s
;; (guid %s -> %s)"
;; feed-name-symbol title link time age
;; updated-time updated-age
(throw 'result t)))))
(< (or (newsticker--pos item1) 0) (or (newsticker--pos item2) 0))))
-
-
-(defun newsticker--cache-save ()
+(defun newsticker--cache-save-version1 ()
"Update and save newsticker cache file."
(interactive)
(newsticker--cache-update t))
"Update newsticker cache file.
If optional argument SAVE is not nil the cache file is saved to disk."
(save-excursion
- (let ((coding-system-for-write 'utf-8))
- (with-temp-buffer
+ (unless (file-directory-p newsticker-dir)
+ (make-directory newsticker-dir t))
+ (let ((coding-system-for-write 'utf-8)
+ (buf (find-file-noselect newsticker-cache-filename)))
+ (when buf
+ (set-buffer buf)
(setq buffer-undo-list t)
(erase-buffer)
(insert ";; -*- coding: utf-8 -*-\n")
(insert (prin1-to-string newsticker--cache))
(when save
- (set-visited-file-name newsticker-cache-filename)
(save-buffer))))))
(defun newsticker--cache-get-feed (feed)
FEED is a symbol!"
(assoc feed newsticker--cache))
+(defun newsticker--cache-dir ()
+ "Return directory for saving cache data."
+ (concat newsticker-dir "/feeds"))
+
+(defun newsticker--cache-save ()
+ "Save cache data for all feeds."
+ (unless (file-directory-p newsticker-dir)
+ (make-directory newsticker-dir t))
+ (mapc 'newsticker--cache-save-feed newsticker--cache)
+ nil)
+
+(defun newsticker--cache-save-feed (feed)
+ "Save cache data for FEED."
+ (let ((dir (concat (newsticker--cache-dir) "/" (symbol-name (car feed)))))
+ (unless (file-directory-p dir)
+ (make-directory dir t))
+ (let ((coding-system-for-write 'utf-8))
+ (with-temp-file (concat dir "/data")
+ (insert ";; -*- coding: utf-8 -*-\n")
+ (insert (prin1-to-string (cdr feed)))))))
+
+(defun newsticker--cache-read-version1 ()
+ "Read version1 cache data."
+ (let ((coding-system-for-read 'utf-8))
+ (when (file-exists-p newsticker-cache-filename)
+ (with-temp-buffer
+ (insert-file-contents newsticker-cache-filename)
+ (goto-char (point-min))
+ (condition-case nil
+ (setq newsticker--cache (read (current-buffer)))
+ (error
+ (message "Error while reading newsticker cache file!")
+ (setq newsticker--cache nil)))))))
+
+(defun newsticker--cache-read ()
+ "Read cache data."
+ (setq newsticker--cache nil)
+ (if (file-exists-p newsticker-cache-filename)
+ (progn
+ (when (y-or-n-p "Old newsticker cache file exists. Read it? ")
+ (newsticker--cache-read-version1))
+ (when (y-or-n-p (format "Delete old newsticker cache file? "))
+ (delete-file newsticker-cache-filename)))
+ (mapc (lambda (f)
+ (newsticker--cache-read-feed (car f)))
+ (append newsticker-url-list-defaults newsticker-url-list))))
+
+(defun newsticker--cache-read-feed (feed-name)
+ "Read cache data for feed named FEED-NAME."
+ (let ((file-name (concat (newsticker--cache-dir) "/" feed-name "/data"))
+ (coding-system-for-read 'utf-8))
+ (when (file-exists-p file-name)
+ (with-temp-buffer
+ (insert-file-contents file-name)
+ (goto-char (point-min))
+ (condition-case nil
+ (add-to-list 'newsticker--cache (cons (intern feed-name)
+ (read (current-buffer))))
+ (error
+ (message "Error while reading newsticker cache file %s!"
+ file-name)
+ (setq newsticker--cache nil)))))))
+
;; ======================================================================
;;; Statistics
;; ======================================================================
"Actually compare ITEM against the pattern-LIST.
LIST must be an element of `newsticker-auto-mark-filter-list'."
(mapc (lambda (pattern)
- (let ((age (nth 0 pattern))
- (place (nth 1 pattern))
+ (let ((place (nth 1 pattern))
(regexp (nth 2 pattern))
(title (newsticker--title item))
(desc (newsticker--desc item)))
(when (or (eq place 'title) (eq place 'all))
(when (and title (string-match regexp title))
- (newsticker--debug-msg "Auto-marking as %s: `%s'"
- age (newsticker--title item))
- (setcar (nthcdr 4 item) age)))
+ (newsticker--process-auto-mark-filter-match item pattern)))
(when (or (eq place 'description) (eq place 'all))
(when (and desc (string-match regexp desc))
- (newsticker--debug-msg "Auto-marking as %s: `%s'"
- age (newsticker--title item))
- (setcar (nthcdr 4 item) age)))))
+ (newsticker--process-auto-mark-filter-match item pattern)))))
list))
+(defun newsticker--process-auto-mark-filter-match (item pattern)
+ "Process ITEM that matches an auto-mark-filter PATTERN."
+ (let ((age (nth 0 pattern))
+ (place (nth 1 pattern))
+ (regexp (nth 2 pattern)))
+ (newsticker--debug-msg "Auto-mark-filter %s matches `%s'"
+ pattern (newsticker--title item))
+ (setcar (nthcdr 4 item) age)
+ (nconc (newsticker--extra item)
+ (list (list 'newsticker-auto-mark nil
+ (format "age=%s, title/desc=%s, regexp=%s"
+ age place regexp))))))
;; ======================================================================
;;; Hook samples
"</title><description>" (format "Or maybe it is %d" (random 10000))
"</description></item></channel></rss>"))
-(provide 'newsticker-backend)
+(provide 'newst-backend)
-;; arch-tag: 0e37b658-56e9-49ab-90f9-f2df57e1a659
-;;; newsticker-backend.el ends here
+;;; newst-backend.el ends here
HCoop / bpt / emacs.git / blobdiff