emacs: lisp/gnus/nnrss.el comparison

comparison lisp/gnus/nnrss.el @ 85712:a3c27999decb

Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Revision: emacs@sv.gnu.org/emacs--devo--0--patch-911

author	Miles Bader <miles@gnu.org>
date	Sun, 28 Oct 2007 09:18:39 +0000
parents	24202b793a08
children	1cdfc94602cb

comparison

equal deleted inserted replaced

-:b6f5dc84b2e1
+:a3c27999decb
 (nnoo-declare nnrss)
 (defvoo nnrss-directory (nnheader-concat gnus-directory "rss/")
 "Where nnrss will save its files.")
+(defvoo nnrss-ignore-article-fields '(slash:comments)
+"*List of fields that should be ignored when comparing RSS articles.
+Some RSS feeds update article fields during their lives, e.g. to
+indicate the number of comments or the number of times the
+articles have been seen.  However, if there is a difference
+between the local article and the distant one, the latter is
+considered to be new.  To avoid this and discard some fields, set
+this variable to the list of fields to be ignored.")
 ;; (group max rss-url)
 (defvoo nnrss-server-data nil)
 ;; (num timestamp url subject author date extra)
 (defvoo nnrss-group-data nil)
 (defvoo nnrss-group-max 0)
 (defvoo nnrss-group-min 1)
 (defvoo nnrss-group nil)
-(defvoo nnrss-group-hashtb nil)
+(defvoo nnrss-group-hashtb (make-hash-table :test 'equal))
 (defvoo nnrss-status-string "")
 (defconst nnrss-version "nnrss 1.0")
 (defvar nnrss-group-alist '()
 The arguments are (ENTRY GROUP ARTICLE).
 ENTRY is the record of the current headline.  GROUP is the group name.
 ARTICLE is the article number of the current headline.")
 (defvar nnrss-file-coding-system mm-universal-coding-system
-"Coding system used when reading and writing files.")
+"*Coding system used when reading and writing files.
+If you run Gnus with various versions of Emacsen, the value of this
+variable should be the coding system that all those Emacsen support.
+Note that you have to regenerate all the nnrss groups if you change
+the value.  Moreover, you should be patient even if you are made to
+read the same articles twice, that arises for the difference of the
+versions of xml.el.")
 (defvar nnrss-compatible-encoding-alist
 (delq nil (mapcar (lambda (elem)
 		      (if (and (mm-coding-system-p (car elem))
 			       (mm-coding-system-p (cdr elem)))
 (setq nnrss-group-alist (delq elem nnrss-group-alist))))
 (setq nnrss-server-data
 	(delq (assoc group nnrss-server-data) nnrss-server-data))
 (nnrss-save-server-data server)
 (ignore-errors
-(delete-file (nnrss-make-filename group server)))
+(let ((file-name-coding-system nnmail-pathname-coding-system))
+(delete-file (nnrss-make-filename group server))))
 t)
 (deffoo nnrss-request-list-newsgroups (&optional server)
 (nnrss-possibly-change-group nil server)
 (save-excursion
 it is used instead.  If the xml contents doesn't specify the encoding,
 return `utf-8' which is the default encoding for xml if it is available,
 otherwise return nil."
 (goto-char (point-min))
 (if (re-search-forward
-"<\\?[^>]*encoding=\\(\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)"
+"<\\?[^>]*encoding=\\(?:\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)"
 nil t)
-(let ((encoding (intern (downcase (or (match-string 2)
+(let ((encoding (intern (downcase (or (match-string 1)
-					    (match-string 3))))))
+					    (match-string 2))))))
 	(or
 	 (mm-coding-system-p (cdr (assq encoding
 					nnrss-compatible-encoding-alist)))
 	 (mm-coding-system-p encoding)
 	 (mm-coding-system-p (car (rassq encoding
 (defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
 (defun nnrss-generate-active ()
 (when (y-or-n-p "Fetch extra categories? ")
-(dolist (func nnrss-extra-categories)
+(mapc 'funcall nnrss-extra-categories))
-(funcall func)))
 (save-excursion
 (set-buffer nntp-server-buffer)
 (erase-buffer)
 (dolist (elem nnrss-group-alist)
 (insert (prin1-to-string (car elem)) " 0 1 y\n"))
 	  ((string-match
 	    (eval-when-compile
 	      (concat
 	       ;; 1. year
 	       "\\(199[0-9]\\|20[0-9][0-9]\\)"
-	       "\\(-"
+	       "\\(?:-"
-	       ;; 3. month
+	       ;; 2. month
 	       "\\([01][0-9]\\)"
-	       "\\(-"
+	       "\\(?:-"
-	       ;; 5. day
+	       ;; 3. day
 	       "\\([0-3][0-9]\\)"
-	       "\\)?\\)?\\(T"
+	       "\\)?\\)?\\(?:T"
-	       ;; 7. hh:mm
+	       ;; 4. hh:mm
 	       "\\([012][0-9]:[0-5][0-9]\\)"
-	       "\\("
+	       "\\(?:"
-	       ;; 9. :ss
+	       ;; 5. :ss
 	       "\\(:[0-5][0-9]\\)"
-	       "\\(\\.[0-9]+\\)?\\)?\\)?"
+	       "\\(?:\\.[0-9]+\\)?\\)?\\)?"
-	       ;; 13+14,15,16. zone
+	       ;; 6+7,8,9. zone
-	       "\\(\\(\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)"
+	       "\\(?:\\(?:\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)"
 	       "\\|\\([+-][012][0-9][0-5][0-9]\\)"
 	       "\\|\\(Z\\)\\)?"))
 	    date)
 	   (setq year (string-to-number (match-string 1 date))
-		 month (string-to-number (or (match-string 3 date) "1"))
+		 month (string-to-number (or (match-string 2 date) "1"))
-		 day (string-to-number (or (match-string 5 date) "1"))
+		 day (string-to-number (or (match-string 3 date) "1"))
-		 time (if (match-beginning 9)
+		 time (if (match-beginning 5)
-			  (substring date (match-beginning 7) (match-end 9))
+			  (substring date (match-beginning 4) (match-end 5))
-			(concat (or (match-string 7 date) "00:00") ":00"))
+			(concat (or (match-string 4 date) "00:00") ":00"))
-		 zone (cond ((match-beginning 13)
+		 zone (cond ((match-beginning 6)
-			     (concat (match-string 13 date)
+			     (concat (match-string 6 date)
-				     (match-string 14 date)))
+				     (match-string 7 date)))
-			    ((match-beginning 16) ;; Z
+			    ((match-beginning 9) ;; Z
 			     "+0000")
 			    (t ;; nil if zone is not provided.
-			     (match-string 15 date))))))
+			     (match-string 8 date))))))
 (if month
 	(progn
 	  (setq cts (current-time-string (encode-time 0 0 0 day month year)))
 	  (format "%s, %02d %s %04d %s%s"
 		  (substring cts 0 3) day (substring cts 4 7) year time
 ;;; data functions
 (defun nnrss-read-server-data (server)
 (setq nnrss-server-data nil)
-(let ((file (nnrss-make-filename "nnrss" server)))
+(let ((file (nnrss-make-filename "nnrss" server))
+	(file-name-coding-system nnmail-pathname-coding-system))
 (when (file-exists-p file)
 ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
 ;; file names.  So, we use `insert-file-contents' instead.
 (mm-with-multibyte-buffer
-	(let ((coding-system-for-read nnrss-file-coding-system)
+	(let ((coding-system-for-read nnrss-file-coding-system))
-	      (file-name-coding-system nnmail-pathname-coding-system))
 	  (insert-file-contents file)
 	  (eval-region (point-min) (point-max)))))))
 (defun nnrss-save-server-data (server)
 (gnus-make-directory nnrss-directory)
 (insert "\n")
 (gnus-prin1 `(setq nnrss-server-data ',nnrss-server-data)))))
 (defun nnrss-read-group-data (group server)
 (setq nnrss-group-data nil)
-(setq nnrss-group-hashtb (gnus-make-hashtable))
+(if (hash-table-p nnrss-group-hashtb)
+(clrhash nnrss-group-hashtb)
+(setq nnrss-group-hashtb (make-hash-table :test 'equal)))
 (let ((pair (assoc group nnrss-server-data)))
 (setq nnrss-group-max (or (cadr pair) 0))
 (setq nnrss-group-min (+ nnrss-group-max 1)))
-(let ((file (nnrss-make-filename group server)))
+(let ((file (nnrss-make-filename group server))
+	(file-name-coding-system nnmail-pathname-coding-system))
 (when (file-exists-p file)
 ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
 ;; file names.  So, we use `insert-file-contents' instead.
 (mm-with-multibyte-buffer
-	(let ((coding-system-for-read nnrss-file-coding-system)
+	(let ((coding-system-for-read nnrss-file-coding-system))
-	      (file-name-coding-system nnmail-pathname-coding-system))
 	  (insert-file-contents file)
 	  (eval-region (point-min) (point-max))))
 (dolist (e nnrss-group-data)
-	(gnus-sethash (or (nth 2 e) (nth 6 e)) t nnrss-group-hashtb)
+	(puthash (nth 9 e) t nnrss-group-hashtb)
 	(when (and (car e) (> nnrss-group-min (car e)))
 	  (setq nnrss-group-min (car e)))
 	(when (and (car e) (< nnrss-group-max (car e)))
 	  (setq nnrss-group-max (car e)))))))
 (delete-backward-char 1))
 (buffer-string)))
 ;;; Snarf functions
+(defun nnrss-make-hash-index (item)
+(setq item (gnus-remove-if
+	      (lambda (field)
+		(when (listp field)
+		  (memq (car field) nnrss-ignore-article-fields)))
+	      item))
+(md5 (gnus-prin1-to-string item)
+nil nil
+nnrss-file-coding-system))
 (defun nnrss-check-group (group server)
 (let (file xml subject url extra changed author date feed-subject
-	     enclosure comments rss-ns rdf-ns content-ns dc-ns)
+	     enclosure comments rss-ns rdf-ns content-ns dc-ns
+	     hash-index)
 (if (and nnrss-use-local
 	     (file-exists-p (setq file (expand-file-name
 					(nnrss-translate-file-chars
 					 (concat group ".xml"))
 					nnrss-directory))))
 	  rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/")
 	  content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/"))
 (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))
 (when (and (listp item)
 		 (string= (concat rss-ns "item") (car item))
-		 (if (setq url (nnrss-decode-entities-string
+		 (progn (setq hash-index (nnrss-make-hash-index item))
-				(nnrss-node-text rss-ns 'link (cddr item))))
+			(not (gethash hash-index nnrss-group-hashtb))))
-		     (not (gnus-gethash url nnrss-group-hashtb))
-		   (setq extra (or (nnrss-node-text content-ns 'encoded item)
-				   (nnrss-node-text rss-ns 'description item)))
-		   (not (gnus-gethash extra nnrss-group-hashtb))))
 	(setq subject (nnrss-node-text rss-ns 'title item))
-	(setq extra (or extra
+	(setq url (nnrss-decode-entities-string
-			(nnrss-node-text content-ns 'encoded item)
+		   (nnrss-node-text rss-ns 'link (cddr item))))
+	(setq extra (or (nnrss-node-text content-ns 'encoded item)
 			(nnrss-node-text rss-ns 'description item)))
 	(if (setq feed-subject (nnrss-node-text dc-ns 'subject item))
 	    (setq extra (concat feed-subject "<br /><br />" extra)))
 	(setq author (or (nnrss-node-text rss-ns 'author item)
 			 (nnrss-node-text dc-ns 'creator item)
 	  (and subject (nnrss-mime-encode-string subject))
 	  (and author (nnrss-mime-encode-string author))
 	  date
 	  (and extra (nnrss-decode-entities-string extra))
 	  enclosure
-	  comments)
+	  comments
+	  hash-index)
 	 nnrss-group-data)
-	(gnus-sethash (or url extra) t nnrss-group-hashtb)
+	(puthash hash-index t nnrss-group-hashtb)
 	(setq changed t))
 (setq extra nil))
 (when changed
 (nnrss-save-group-data group server)
 (let ((pair (assoc group nnrss-server-data)))
 BASE-URI is used to determine the location of the links and
 whether they are `offsite' or `onsite'."
 (let (rss-onsite-end  rdf-onsite-end  xml-onsite-end
 	rss-onsite-in   rdf-onsite-in   xml-onsite-in
 	rss-offsite-end rdf-offsite-end xml-offsite-end
-	rss-offsite-in  rdf-offsite-in  xml-offsite-in)
+	rss-offsite-in rdf-offsite-in xml-offsite-in)
 (dolist (href hrefs)
 (cond ((null href))
 	    ((string-match "\\.rss$" href)
 	     (nnrss-match-macro
 	      base-uri href rss-onsite-end rss-offsite-end))

Mercurial > emacs

comparison lisp/gnus/nnrss.el @ 85712:a3c27999decb