Add 2012 to FSF copyright years for Emacs files

[bpt/emacs.git] / lisp / net / newst-backend.el

diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index c0797ba..c78249c 100644 (file)
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -1,13 +1,13 @@
 ;;; newst-backend.el --- Retrieval backend for newsticker.
 
 ;;; 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
 
 ;; Author:      Ulf Jasper <ulf.jasper@web.de>
 ;; Filename:    newst-backend.el
 ;; URL:         http://www.nongnu.org/newsticker
 ;; Keywords:    News, RSS, Atom

-;; Time-stamp:  "22. Dezember 2008, 19:58:01 (ulf)"
+;; Time-stamp:  "13. Mai 2011, 20:47:05 (ulf)"
+;; Package:     newsticker

 
 ;; ======================================================================
 
 
 ;; ======================================================================
 


@@ -79,13 +79,11 @@ considered to be running if the newsticker timer list is not empty."
     nil
     3600)
     ("Freshmeat.net"
     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")
     ("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"
     ("NY Times: Technology"
     "http://partners.userland.com/nytRss/technology.xml")
     ("NY Times"


@@ -423,7 +421,7 @@ headline after it has been retrieved for the first time."
   "Name of the newsticker cache file."
   :type 'string
   :group 'newsticker-miscellaneous)
   "Name of the newsticker cache file."
   :type 'string
   :group 'newsticker-miscellaneous)

-(make-obsolete 'newsticker-cache-filename 'newsticker-dir)
+(make-obsolete 'newsticker-cache-filename 'newsticker-dir "23.1")

 
 (defcustom newsticker-dir
   (locate-user-emacs-file "newsticker/" ".newsticker/")
 
 (defcustom newsticker-dir
   (locate-user-emacs-file "newsticker/" ".newsticker/")


@@ -444,10 +442,15 @@ buffers *newsticker-wget-<feed>* will not be closed."
 ;; ======================================================================
 ;;; Compatibility section, XEmacs, Emacs
 ;; ======================================================================
 ;; ======================================================================
 ;;; 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)
 (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))
 
 (unless (fboundp 'match-string-no-properties)
   (defalias 'match-string-no-properties 'match-string))


@@ -714,6 +717,7 @@ If URL is nil it is searched at point."
 (defun newsticker-customize ()
   "Open the newsticker customization group."
   (interactive)
 (defun newsticker-customize ()
   "Open the newsticker customization group."
   (interactive)

+  (delete-other-windows)

   (customize-group "newsticker"))
 
 ;; ======================================================================
   (customize-group "newsticker"))
 
 ;; ======================================================================


@@ -723,8 +727,7 @@ If URL is nil it is searched at point."
   "Get news for the site FEED-NAME by calling FUNCTION.
 See `newsticker-get-news'."
   (let ((buffername (concat " *newsticker-funcall-" feed-name "*")))
   "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
       (erase-buffer)
       (insert (string-to-multibyte (funcall function feed-name)))
       (newsticker--sentinel-work nil t feed-name function


@@ -774,8 +777,7 @@ from."
 WGET-ARGUMENTS is a list of arguments for wget.
 See `newsticker-get-news'."
   (let ((buffername (concat " *newsticker-wget-" feed-name "*")))
 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)
       (erase-buffer)
       ;; throw an error if there is an old wget-process around
       (if (get-process feed-name)


@@ -1130,7 +1132,7 @@ system time at which the data have been retrieved.  TOPNODE
 contains the feed data as returned by the xml parser.
 
 For the Atom 1.0 specification see
 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
   (newsticker--debug-msg "Parsing Atom 1.0 feed %s" name)
   (let (new-feed new-item)
     (setq new-feed (newsticker--parse-generic-feed


@@ -1184,8 +1186,8 @@ http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html"
 Return value as well as arguments NAME, TIME, and TOPNODE are the
 same as in `newsticker--parse-atom-1.0'.
 
 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
   (newsticker--debug-msg "Parsing RSS 0.91 feed %s" name)
   (let* ((channelnode (car (xml-get-children topnode 'channel)))
          (pub-date (newsticker--decode-rfc822-date


@@ -1238,7 +1240,7 @@ http://my.netscape.com/publish/formats/rss-spec-0.91.html."
 Return value as well as arguments NAME, TIME, and TOPNODE are the
 same as in `newsticker--parse-atom-1.0'.
 
 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
   (newsticker--debug-msg "Parsing RSS 0.92 feed %s" name)
   (let* ((channelnode (car (xml-get-children topnode 'channel)))
          (pub-date (newsticker--decode-rfc822-date


@@ -1291,7 +1293,7 @@ For the RSS 0.92 specification see http://backend.userland.com/rss092."
 Return value as well as arguments NAME, TIME, and TOPNODE are the
 same as in `newsticker--parse-atom-1.0'.
 
 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)
   (newsticker--debug-msg "Parsing RSS 1.0 feed %s" name)
   (let* ((channelnode (car (xml-get-children topnode 'channel)))
          is-new-feed has-new-items)


@@ -1342,7 +1344,7 @@ For the RSS 1.0 specification see http://web.resource.org/rss/1.0/spec."
 Return value as well as arguments NAME, TIME, and TOPNODE are the
 same as in `newsticker--parse-atom-1.0'.
 
 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)
   (newsticker--debug-msg "Parsing RSS 2.0 feed %s" name)
   (let* ((channelnode (car (xml-get-children topnode 'channel)))
          is-new-feed has-new-items)


@@ -1406,9 +1408,9 @@ description, link, and extra elements resp."
         (position 0)
         (something-was-added nil))
     ;; decode numeric entities
         (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))
     ;; remove whitespace from title, desc, and link
     (setq title (newsticker--remove-whitespace title))
     (setq desc (newsticker--remove-whitespace desc))


@@ -1460,10 +1462,10 @@ argument, which is one of the items in ITEMLIST."
             (when (or (> (length title) 0)
                       (> (length desc) 0))
               ;; decode numeric entities
             (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
               (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))
               ;; remove whitespace from title, desc, and link
               (setq title (newsticker--remove-whitespace title))
               (setq desc (newsticker--remove-whitespace desc))


@@ -1515,24 +1517,6 @@ argument, which is one of the items in ITEMLIST."
 ;; ======================================================================
 ;;; Misc
 ;; ======================================================================
 ;; ======================================================================
 ;;; 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 \"&#42;\" 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."
 
 (defun newsticker--remove-whitespace (string)
   "Remove leading and trailing whitespace from STRING."


@@ -1753,8 +1737,7 @@ If the image has been downloaded in the last 24h do nothing."
                         feed-name)))
              (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
                                  newsticker-wget-arguments)))
                         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)
           (erase-buffer)
           ;; throw an error if there is an old wget-process around
           (if (get-process feed-name)


@@ -1782,8 +1765,7 @@ If the image has been downloaded in the last 24h do nothing."
                  feed-name)
         (throw 'oops nil))
       (let (image-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
           (setq image-name (concat (newsticker--images-dir) feed-name))
           (set-buffer-file-coding-system 'no-conversion)
           ;; make sure the cache dir exists


@@ -2155,8 +2137,8 @@ FEED is a symbol!"
       (progn
         (when (y-or-n-p "Old newsticker cache file exists.  Read it? ")
           (newsticker--cache-read-version1))
       (progn
         (when (y-or-n-p "Old newsticker cache file exists.  Read it? ")
           (newsticker--cache-read-version1))

-        (message "Please remove/rename the old cache file (%s) now."
-                 newsticker-cache-filename))
+        (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))))
     (mapc (lambda (f)
             (newsticker--cache-read-feed (car f)))
           (append newsticker-url-list-defaults newsticker-url-list))))


@@ -2174,8 +2156,8 @@ FEED is a symbol!"
                                                   (read (current-buffer))))
           (error
            (message "Error while reading newsticker cache file %s!"
                                                   (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
 
 ;; ======================================================================
 ;;; Statistics


@@ -2282,23 +2264,30 @@ for an entry that matches FEED and ITEM."
   "Actually compare ITEM against the pattern-LIST.
 LIST must be an element of `newsticker-auto-mark-filter-list'."
   (mapc (lambda (pattern)
   "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))
                 (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))
             (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))
 
         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
 
 ;; ======================================================================
 ;;; Hook samples


@@ -2368,7 +2357,6 @@ This function is suited for adding it to `newsticker-new-item-functions'."
           "</title><description>" (format "Or maybe it is %d" (random 10000))
           "</description></item></channel></rss>"))
 
           "</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
 ;;; newst-backend.el ends here