(require 'mime-view)
(eval-when-compile
(ignore-errors
- (require 'xml)))
+ (require 'xml)))
(eval '(require 'xml))
;; Reload mm-util emulating macros for compiling.
(defvar nnrss-file-coding-system nnheader-auto-save-coding-system
"Coding system used when reading and writing files.")
+(defvar nnrss-compatible-encoding-alist '((iso-8859-1 . windows-1252))
+ "Alist of encodings and those supersets.
+The cdr of each element is used to decode data if it is available when
+the car is what the data specify as the encoding. Or, the car is used
+for decoding when the cdr that the data specify is not available.")
+
(nnoo-define-basics nnrss)
;;; Interface functions
(deffoo nnrss-request-group (group &optional server dont-check)
(setq group (nnrss-decode-group-name group))
+ (nnheader-message 6 "nnrss: Requesting %s..." group)
(nnrss-possibly-change-group group server)
- (if dont-check
- t
- (nnrss-check-group group server)
- (nnheader-report 'nnrss "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max
- (prin1-to-string group)
- t)))
+ (prog1
+ (if dont-check
+ t
+ (nnrss-check-group group server)
+ (nnheader-report 'nnrss "Opened group %s" group)
+ (nnheader-insert
+ "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max
+ (prin1-to-string group)
+ t))
+ (nnheader-message 6 "nnrss: Requesting %s...done" group)))
(deffoo nnrss-close-group (group &optional server)
t)
(delq (assoc group nnrss-server-data) nnrss-server-data))
(nnrss-save-server-data server)
(ignore-errors
- (delete-file (nnrss-make-filename group server)))
+ (delete-file (nnrss-make-filename group server)))
t)
(deffoo nnrss-request-list-newsgroups (&optional server)
(eval-when-compile (defun xml-rpc-method-call (&rest args)))
(defun nnrss-get-encoding ()
- "Return an encoding attribute specified in the current xml contents."
+ "Return an encoding attribute specified in the current xml contents.
+If `nnrss-compatible-encoding-alist' specifies the compatible encoding,
+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))
- (mm-coding-system-p
- (if (re-search-forward
- "<\\?[^>]*encoding=\\(?:\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)"
- nil t)
- (intern-soft (downcase (or (match-string-no-properties 1)
- (match-string-no-properties 2))))
- ;; The default encoding for xml.
- 'utf-8)))
+ (if (re-search-forward
+ "<\\?[^>]*encoding=\\(?:\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)"
+ nil t)
+ (let ((encoding (intern (downcase (or (match-string 1)
+ (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
+ nnrss-compatible-encoding-alist)))))
+ (mm-coding-system-p 'utf-8)))
(defun nnrss-fetch (url &optional local)
"Fetch URL and put it in a the expected Lisp structure."
(second (assoc group nnrss-group-alist))))
(unless url
(setq url
- (cdr
- (assoc 'href
- (nnrss-discover-feed
- (read-string
- (format "URL to search for %s: " group) "http://")))))
+ (cdr
+ (assoc 'href
+ (nnrss-discover-feed
+ (read-string
+ (format "URL to search for %s: " group) "http://")))))
(let ((pair (assoc group nnrss-server-data)))
(if pair
(setcdr (cdr pair) (list url))
nnrss-group-data)
(puthash (or url extra) t nnrss-group-hashtb)
(setq changed t))
- (setq extra nil))
+ (setq extra nil))
(when changed
(nnrss-save-group-data group server)
(let ((pair (assoc group nnrss-server-data)))
(interactive "fImport file: ")
(mapcar
(lambda (node) (gnus-group-make-rss-group
- (cdr (assq 'xmlUrl (cadr node)))))
+ (cdr (assq 'xmlUrl (cadr node)))))
(nnrss-find-el 'outline
- (progn
- (find-file opml-file)
- (xml-parse-region (point-min)
- (point-max))))))
+ (progn
+ (find-file opml-file)
+ (xml-parse-region (point-min)
+ (point-max))))))
(defun nnrss-opml-export ()
"OPML subscription export.
(interactive)
(with-current-buffer (get-buffer-create "*OPML Export*")
(mm-set-buffer-file-coding-system 'utf-8)
- (insert (concat
- "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
- "<!-- OPML generated by Emacs Gnus' nnrss.el -->\n"
- "<opml version=\"1.1\">\n"
- " <head>\n"
- " <title>mySubscriptions</title>\n"
- " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
- "</dateCreated>\n"
- " <ownerEmail>" user-mail-address "</ownerEmail>\n"
- " <ownerName>" (user-full-name) "</ownerName>\n"
- " </head>\n"
- " <body>\n"))
- (mapc (lambda (sub)
- (insert (concat
- " <outline text=\"" (car sub) "\" xmlUrl=\""
- (cadr sub) "\"/>\n")))
- nnrss-group-alist)
- (insert (concat
- " </body>\n"
- "</opml>\n")))
+ (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
+ "<!-- OPML generated by Emacs Gnus' nnrss.el -->\n"
+ "<opml version=\"1.1\">\n"
+ " <head>\n"
+ " <title>mySubscriptions</title>\n"
+ " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
+ "</dateCreated>\n"
+ " <ownerEmail>" user-mail-address "</ownerEmail>\n"
+ " <ownerName>" (user-full-name) "</ownerName>\n"
+ " </head>\n"
+ " <body>\n")
+ (dolist (sub nnrss-group-alist)
+ (insert " <outline text=\"" (car sub)
+ "\" xmlUrl=\"" (cadr sub) "\"/>\n"))
+ (insert " </body>\n"
+ "</opml>\n"))
(pop-to-buffer "*OPML Export*")
(when (fboundp 'sgml-mode)
(sgml-mode)))
(text (if (and node (listp node))
(nnrss-node-just-text node)
node))
- (cleaned-text (if text (gnus-replace-in-string
- text "^[\000-\037\177]+\\|^ +\\| +$" ""))))
+ (cleaned-text (if text
+ (gnus-replace-in-string
+ (gnus-replace-in-string
+ text "^[\000-\037\177]+\\|^ +\\| +$" "")
+ "\r\n" "\n"))))
(if (string-equal "" cleaned-text)
nil
cleaned-text)))
(defun nnrss-find-el (tag data &optional found-list)
"Find the all matching elements in the data.
Careful with this on large documents!"
- (when (listp data)
- (mapc (lambda (bit)
- (when (car-safe bit)
- (when (equal tag (car bit))
- ;; Old xml.el may return a list of string.
- (when (consp (caddr bit))
- (setcar (cddr bit) (caaddr bit)))
- (setq found-list
- (append found-list
- (list bit))))
- (if (and (listp (car-safe (caddr bit)))
- (not (stringp (caddr bit))))
- (setq found-list
- (append found-list
- (nnrss-find-el
- tag (caddr bit))))
- (setq found-list
- (append found-list
- (nnrss-find-el
- tag (cddr bit)))))))
- data))
+ (when (consp data)
+ (dolist (bit data)
+ (when (car-safe bit)
+ (when (equal tag (car bit))
+ ;; Old xml.el may return a list of string.
+ (when (and (consp (caddr bit))
+ (stringp (caaddr bit)))
+ (setcar (cddr bit) (caaddr bit)))
+ (setq found-list
+ (append found-list
+ (list bit))))
+ (if (and (consp (car-safe (caddr bit)))
+ (not (stringp (caddr bit))))
+ (setq found-list
+ (append found-list
+ (nnrss-find-el
+ tag (caddr bit))))
+ (setq found-list
+ (append found-list
+ (nnrss-find-el
+ tag (cddr bit))))))))
found-list)
(defun nnrss-rsslink-p (el)
(cdr (assoc 'href (cadr ahref))))
(nnrss-find-el 'a data)))
-(defmacro nnrss-match-macro (base-uri item
- onsite-list offsite-list)
+(defmacro nnrss-match-macro (base-uri item onsite-list offsite-list)
`(cond ((or (string-match (concat "^" ,base-uri) ,item)
- (not (string-match "://" ,item)))
- (setq ,onsite-list (append ,onsite-list (list ,item))))
- (t (setq ,offsite-list (append ,offsite-list (list ,item))))))
+ (not (string-match "://" ,item)))
+ (setq ,onsite-list (append ,onsite-list (list ,item))))
+ (t (setq ,offsite-list (append ,offsite-list (list ,item))))))
(defun nnrss-order-hrefs (base-uri hrefs)
"Given a list of hrefs, sort them using the following priorities:
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)
- (mapc (lambda (href)
- (if (not (null href))
- (cond ((string-match "\\.rss$" href)
- (nnrss-match-macro
- base-uri href rss-onsite-end rss-offsite-end))
- ((string-match "\\.rdf$" href)
- (nnrss-match-macro
- base-uri href rdf-onsite-end rdf-offsite-end))
- ((string-match "\\.xml$" href)
- (nnrss-match-macro
- base-uri href xml-onsite-end xml-offsite-end))
- ((string-match "rss" href)
- (nnrss-match-macro
- base-uri href rss-onsite-in rss-offsite-in))
- ((string-match "rdf" href)
- (nnrss-match-macro
- base-uri href rdf-onsite-in rdf-offsite-in))
- ((string-match "xml" href)
- (nnrss-match-macro
- base-uri href xml-onsite-in xml-offsite-in)))))
- hrefs)
+ (dolist (href hrefs)
+ (cond ((null href))
+ ((string-match "\\.rss$" href)
+ (nnrss-match-macro
+ base-uri href rss-onsite-end rss-offsite-end))
+ ((string-match "\\.rdf$" href)
+ (nnrss-match-macro
+ base-uri href rdf-onsite-end rdf-offsite-end))
+ ((string-match "\\.xml$" href)
+ (nnrss-match-macro
+ base-uri href xml-onsite-end xml-offsite-end))
+ ((string-match "rss" href)
+ (nnrss-match-macro
+ base-uri href rss-onsite-in rss-offsite-in))
+ ((string-match "rdf" href)
+ (nnrss-match-macro
+ base-uri href rdf-onsite-in rdf-offsite-in))
+ ((string-match "xml" href)
+ (nnrss-match-macro
+ base-uri href xml-onsite-in xml-offsite-in))))
(append
rss-onsite-end rdf-onsite-end xml-onsite-end
rss-onsite-in rdf-onsite-in xml-onsite-in
(hrefs (nnrss-order-hrefs
base-uri (nnrss-extract-hrefs parsed-page)))
(rss-link nil))
- (while (and (eq rss-link nil) (not (eq hrefs nil)))
- (let ((href-data (nnrss-fetch (car hrefs))))
- (if (nnrss-rss-p href-data)
- (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/")))
- (setq rss-link (nnrss-rss-title-description
- rss-ns href-data (car hrefs))))
- (setq hrefs (cdr hrefs)))))
- (if rss-link rss-link
+ (while (and (eq rss-link nil) (not (eq hrefs nil)))
+ (let ((href-data (nnrss-fetch (car hrefs))))
+ (if (nnrss-rss-p href-data)
+ (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/")))
+ (setq rss-link (nnrss-rss-title-description
+ rss-ns href-data (car hrefs))))
+ (setq hrefs (cdr hrefs)))))
+ (if rss-link rss-link
;; 4. check syndic8
- (nnrss-find-rss-via-syndic8 url))))))))
+ (nnrss-find-rss-via-syndic8 url))))))))
(defun nnrss-find-rss-via-syndic8 (url)
"Query syndic8 for the rss feeds it has for URL."
projects / elisp / gnus.git- / blobdiff