;;; 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:
(reference . identity)
(map . nnweb-gmane-create-mapping)
(search . nnweb-gmane-search)
- (address . "http://search.gmane.org/cgi-bin/omega.cgi")
+ (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)
(goto-char (point-min))
(incf i 100)
(if (or (not (re-search-forward
- "<a href=\"\n\\([^>\"]+\\)\"><img src=\"[^\"]+next"
+ "<a [^>]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*<img[^>]+src=[^>]+next"
nil t))
(>= i nnweb-max-hits))
(setq more nil)
"?"
(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)
+ (with-current-buffer nnweb-buffer
(let ((case-fold-search t)
(active (or (cadr (assoc nnweb-group nnweb-group-alist))
(cons 1 0)))
(forward-line 1)
;; Thanks to Olly Betts we now have NOV lines in our buffer!
(while (not (eobp))
- (unless (eolp)
+ (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)
+ (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
(mail-header-set-xref
header
(format "http://article.gmane.org/%s/%s/raw"
(rfc2047-encode-string subject))
(unless (nnweb-get-hashtb (mail-header-xref header))
- (push
- (list
- (incf (cdr active))
- header)
- map)
+ (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")
"?"
(mm-url-encode-www-form-urlencoded
`(("query" . ,search)
- ("FMT" . "nov")
- ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))))))
+ ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))
+ ;;("TOPDOC" . "1000")
+ ))))
(setq buffer-file-name nil)
- (set-buffer-multibyte t)
+ (unless (featurep 'xemacs) (set-buffer-multibyte t))
(mm-decode-coding-region (point-min) (point-max) 'utf-8)
t)
(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