;;; nnweb.el --- retrieving articles via web search engines
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Note: You need to have `w3' installed for some functions to work.
-;; FIXME: Due to changes in the HTML output of Gmane, stuff related to Gmane
-;; web groups (`gnus-group-make-web-group') doesn't work anymore.
-
;;; Code:
(eval-when-compile (require 'cl))
(reference . identity)
(map . nnweb-gmane-create-mapping)
(search . nnweb-gmane-search)
- (address . "http://gmane.org/")
+ (address . "http://search.gmane.org/nov.php")
(identifier . nnweb-gmane-identity)))
"Type-definition alist.")
(deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
(nnweb-possibly-change-server group server)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(let (article header)
(mm-with-unibyte-current-buffer
(nnweb-write-active)
(nnweb-write-overview group)))
-(deffoo nnweb-request-group (group &optional server dont-check)
+(deffoo nnweb-request-group (group &optional server dont-check info)
(nnweb-possibly-change-server group server)
(unless (or nnweb-ephemeral-p
dont-check
(deffoo nnweb-close-group (group &optional server)
(nnweb-possibly-change-server group server)
(when (gnus-buffer-live-p nnweb-buffer)
- (save-excursion
- (set-buffer nnweb-buffer)
+ (with-current-buffer nnweb-buffer
(set-buffer-modified-p nil)
(kill-buffer nnweb-buffer)))
t)
(deffoo nnweb-request-article (article &optional group server buffer)
(nnweb-possibly-change-server group server)
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
+ (with-current-buffer (or buffer nntp-server-buffer)
(let* ((header (cadr (assq article nnweb-articles)))
(url (and header (mail-header-xref header))))
(when (or (and url
(when (string-match "^<\\(.*\\)>$" article)
(setq art (match-string 1 article)))
(when (and fetch art)
- (setq url (format fetch art))
+ (setq url (format fetch
+ (mm-url-form-encode-xwfu art)))
(mm-with-unibyte-current-buffer
(mm-url-insert url))
(if (nnweb-definition 'reference t)
(deffoo nnweb-close-server (&optional server)
(when (and (nnweb-server-opened server)
(gnus-buffer-live-p nnweb-buffer))
- (save-excursion
- (set-buffer nnweb-buffer)
+ (with-current-buffer nnweb-buffer
(set-buffer-modified-p nil)
(kill-buffer nnweb-buffer)))
(nnoo-close-server 'nnweb server))
(deffoo nnweb-request-list (&optional server)
(nnweb-possibly-change-server nil server)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(nnmail-generate-active (list (assoc server nnweb-group-alist)))
t))
-(deffoo nnweb-request-update-info (group info &optional server)
- (nnweb-possibly-change-server group server))
+(deffoo nnweb-request-update-info (group info &optional server))
(deffoo nnweb-asynchronous-p ()
nil)
(deffoo nnweb-request-delete-group (group &optional force server)
(nnweb-possibly-change-server group server)
- (gnus-pull group nnweb-group-alist t)
+ (gnus-alist-pull group nnweb-group-alist t)
(nnweb-write-active)
(gnus-delete-file (nnweb-overview-file group))
t)
"Initialize buffers and such."
(unless (gnus-buffer-live-p nnweb-buffer)
(setq nnweb-buffer
- (save-excursion
- (mm-with-unibyte
- (nnheader-set-temp-buffer
- (format " *nnweb %s %s %s*"
- nnweb-type nnweb-search server))
- (current-buffer))))))
+ (save-current-buffer
+ (nnheader-set-temp-buffer
+ (format " *nnweb %s %s %s*"
+ nnweb-type nnweb-search server))
+ (mm-disable-multibyte)
+ (current-buffer)))))
;;;
;;; groups.google.com
(defun nnweb-google-wash-article ()
;; We have Google's masked e-mail addresses here. :-/
(let ((case-fold-search t)
- (start-re "<pre>\n *")
- (end-re "\n *</pre>"))
+ (start-re "<pre>[\r\n ]*")
+ (end-re "[\r\n ]*</pre>"))
(goto-char (point-min))
(if (save-excursion
(or (re-search-forward "The requested message.*could not be found."
(goto-char (point-max))
(widen)
(narrow-to-region (point)
- (search-forward "</td" nil t))
+ (search-forward "</table" nil t))
(mm-url-remove-markup)
(mm-url-decode-entities)
- (search-backward " - ")
- (when (looking-at
- " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?, [^\n]+by \\([^<\n]+\\)\n")
- (setq From (match-string 4)
- Date (format "%s %s 00:00:00 %s"
- (match-string 1)
- (match-string 2)
- (or (match-string 3)
- (substring (current-time-string) -4)))))
-
+ (goto-char (point-max))
+ (when
+ (re-search-backward
+ "^\\(?:\\(\\w+\\) \\([0-9]+\\)\\|\\S-+\\)\\(?: \\([0-9]\\{4\\}\\)\\)? by ?\\(.*\\)"
+ nil t)
+ (setq Date (if (match-string 1)
+ (format "%s %s 00:00:00 %s"
+ (match-string 1)
+ (match-string 2)
+ (or (match-string 3)
+ (format-time-string "%Y")))
+ (current-time-string)))
+ (setq From (match-string 4)))
(widen)
- (forward-line 1)
(incf i)
(unless (nnweb-get-hashtb url)
(push
(defun nnweb-google-create-mapping ()
"Perform the search and create a number-to-url alist."
- (save-excursion
- (set-buffer nnweb-buffer)
+ (with-current-buffer nnweb-buffer
(erase-buffer)
+ (nnheader-message 7 "Searching google...")
(when (funcall (nnweb-definition 'search) nnweb-search)
(let ((more t)
(i 0))
(goto-char (point-min))
(incf i 100)
(if (or (not (re-search-forward
- "<td><a href=\"\n\\([^>\"]+\\)\"><img src=\"/img/nav_next" nil t))
+ "<a [^>]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*<img[^>]+src=[^>]+next"
+ nil t))
(>= i nnweb-max-hits))
(setq more nil)
;; Yup, there are more articles
(setq more (concat (nnweb-definition 'base) (match-string 1)))
(when more
(erase-buffer)
+ (nnheader-message 7 "Searching google...(%d)" i)
(mm-url-insert more))))
;; Return the articles in the right order.
+ (nnheader-message 7 "Searching google...done")
(setq nnweb-articles
(sort nnweb-articles 'car-less-than-car))))))
"?"
(mm-url-encode-www-form-urlencoded
`(("q" . ,search)
- ("num" . "100")
+ ("num" . ,(number-to-string
+ (min 100 nnweb-max-hits)))
("hq" . "")
("hl" . "en")
("lr" . "")
;;;
(defun nnweb-gmane-create-mapping ()
"Perform the search and create a number-to-url alist."
- (save-excursion
- (set-buffer nnweb-buffer)
- (erase-buffer)
- (when (funcall (nnweb-definition 'search) nnweb-search)
- (let ((more t)
- (case-fold-search t)
- (active (or (cadr (assoc nnweb-group nnweb-group-alist))
- (cons 1 0)))
- subject group url
- map)
- ;; Remove stuff from the beginning of results
+ (with-current-buffer nnweb-buffer
+ (let ((case-fold-search t)
+ (active (or (cadr (assoc nnweb-group nnweb-group-alist))
+ (cons 1 0)))
+ map)
+ (erase-buffer)
+ (nnheader-message 7 "Searching Gmane..." )
+ (when (funcall (nnweb-definition 'search) nnweb-search)
(goto-char (point-min))
- (search-forward "Search Results</h1><ul>" nil t)
- (delete-region (point-min) (point))
- (goto-char (point-min))
- ;; Iterate over the actual hits
- (while (re-search-forward ".*href=\"\\([^\"]+\\)\">\\(.*\\)" nil t)
- (setq url (concat "http://gmane.org/" (match-string 1)))
- (setq subject (match-string 2))
- (unless (nnweb-get-hashtb url)
- (push
- (list
- (incf (cdr active))
- (make-full-mail-header
- (cdr active) (concat "(" group ") " subject) nil nil
- nil nil 0 0 url))
- map)
- (nnweb-set-hashtb (cadar map) (car map))))
- ;; Return the articles in the right order.
- (setq nnweb-articles
- (sort (nconc nnweb-articles map) 'car-less-than-car))))))
+ ;; Skip the status line
+ (forward-line 1)
+ ;; Thanks to Olly Betts we now have NOV lines in our buffer!
+ (while (not (eobp))
+ (unless (or (eolp) (looking-at "\x0d"))
+ (let ((header (nnheader-parse-nov)))
+ (let ((xref (mail-header-xref header))
+ (from (mail-header-from header))
+ (subject (mail-header-subject header))
+ (rfc2047-encoding-type 'mime))
+ (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
+ (mail-header-set-xref
+ header
+ (format "http://article.gmane.org/%s/%s/raw"
+ (match-string 1 xref)
+ (match-string 2 xref))))
+
+ ;; Add host part to gmane-encrypted addresses
+ (when (string-match "@$" from)
+ (mail-header-set-from header
+ (concat from "public.gmane.org")))
+
+ (mail-header-set-subject header
+ (rfc2047-encode-string subject))
+
+ (unless (nnweb-get-hashtb (mail-header-xref header))
+ (mail-header-set-number header (incf (cdr active)))
+ (push (list (mail-header-number header) header) map)
+ (nnweb-set-hashtb (cadar map) (car map))))))
+ (forward-line 1)))
+ (nnheader-message 7 "Searching Gmane...done")
+ (setq nnweb-articles
+ (sort (nconc nnweb-articles map) 'car-less-than-car)))))
(defun nnweb-gmane-wash-article ()
(let ((case-fold-search t))
(goto-char (point-min))
- (search-forward "<!--X-Head-of-Message-->" nil t)
- (delete-region (point-min) (point))
- (goto-char (point-min))
- (while (looking-at "^<li><em>\\([^ ]+\\)</em>.*</li>")
- (replace-match "\\1\\2" t)
- (forward-line 1))
- (mm-url-remove-markup)))
+ (when (search-forward "<!--X-Head-of-Message-->" nil t)
+ (delete-region (point-min) (point))
+ (goto-char (point-min))
+ (while (looking-at "^<li><em>\\([^ ]+\\)</em>.*</li>")
+ (replace-match "\\1\\2" t)
+ (forward-line 1))
+ (mm-url-remove-markup))))
(defun nnweb-gmane-search (search)
(mm-url-insert
(nnweb-definition 'address)
"?"
(mm-url-encode-www-form-urlencoded
- `(("query" . ,search)))))
+ `(("query" . ,search)
+ ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))
+ ;;("TOPDOC" . "1000")
+ ))))
(setq buffer-file-name nil)
+ (unless (featurep 'xemacs) (set-buffer-multibyte t))
+ (mm-decode-coding-region (point-min) (point-max) 'utf-8)
t)
-
(defun nnweb-gmane-identity (url)
"Return a unique identifier based on URL."
(if (string-match "group=\\(.+\\)" url)
(defun nnweb-insert-html (parse)
"Insert HTML based on a w3 parse tree."
(if (stringp parse)
- (insert (nnheader-string-as-multibyte parse))
+ ;; We used to call nnheader-string-as-multibyte here, but it cannot
+ ;; be right, so I removed it. If a bug shows up because of this change,
+ ;; please do not blindly revert the change, but help me find the real
+ ;; cause of the bug instead. --Stef
+ (insert parse)
(insert "<" (symbol-name (car parse)) " ")
(insert (mapconcat
(lambda (param)
(provide 'nnweb)
-;;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697
;;; nnweb.el ends here
projects / gnus / blobdiff