;;; newst-backend.el --- Retrieval backend for newsticker.
-;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009
-;; 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: "23. Januar 2009, 19:39:22 (ulf)"
+;; Time-stamp: "13. Mai 2011, 20:47:05 (ulf)"
+;; Package: newsticker
;; ======================================================================
(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
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)
(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."
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))
+ (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
(read (current-buffer))))
(error
(message "Error while reading newsticker cache file %s!"
- file-name))
- (setq newsticker--cache nil))))))
+ 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
;;; newst-backend.el ends here
HCoop / bpt / emacs.git / blobdiff