X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnweb.el;h=6802484266de867e99273102edff428f8cf702c4;hb=2b20527a87e8e056ed22892bd6e0d249424a0403;hp=15583f13c41d6670719c0ad31615d6e96a935d8f;hpb=9eff993b664cdcb67f7c7ddd008f0bed342cefd7;p=gnus diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 15583f13c..680248426 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -1,17 +1,16 @@ ;;; 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-2014 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; 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 @@ -19,17 +18,10 @@ ;; 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 . ;;; 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)) @@ -44,7 +36,6 @@ (eval-and-compile (ignore-errors (require 'url))) -(autoload 'w3-parse-buffer "w3-parse") (nnoo-declare nnweb) @@ -82,7 +73,7 @@ Valid types include `google', `dejanews', and `gmane'.") (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.") @@ -99,7 +90,7 @@ Valid types include `google', `dejanews', and `gmane'.") (defvoo nnweb-articles nil) (defvoo nnweb-buffer nil) -(defvar nnweb-group-alist nil) +(defvoo nnweb-group-alist nil) (defvoo nnweb-group nil) (defvoo nnweb-hashtb nil) @@ -109,8 +100,7 @@ Valid types include `google', `dejanews', and `gmane'.") (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 @@ -130,7 +120,7 @@ Valid types include `google', `dejanews', and `gmane'.") (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 @@ -152,16 +142,14 @@ Valid types include `google', `dejanews', and `gmane'.") (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 @@ -174,7 +162,8 @@ Valid types include `google', `dejanews', and `gmane'.") (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) @@ -189,21 +178,18 @@ Valid types include `google', `dejanews', and `gmane'.") (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) @@ -217,7 +203,7 @@ Valid types include `google', `dejanews', and `gmane'.") (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) @@ -296,12 +282,12 @@ Valid types include `google', `dejanews', and `gmane'.") "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 @@ -309,22 +295,26 @@ Valid types include `google', `dejanews', and `gmane'.") (defun nnweb-google-wash-article () ;; We have Google's masked e-mail addresses here. :-/ - (let ((case-fold-search t)) + (let ((case-fold-search t) + (start-re "
[\r\n ]*")
+	(end-re "[\r\n ]*
")) (goto-char (point-min)) (if (save-excursion (or (re-search-forward "The requested message.*could not be found." nil t) - (not (and (re-search-forward "^
" nil t)
-			(re-search-forward "^
" nil t))))) + (not (and (re-search-forward start-re nil t) + (re-search-forward end-re nil t))))) ;; FIXME: Don't know how to indicate "not found". ;; Should this function throw an error? --rsteib (progn (gnus-message 3 "Requested article not found") (erase-buffer)) (delete-region (point-min) - (1+ (re-search-forward "^
" nil t)))
+		     (re-search-forward start-re))
       (goto-char (point-min))
-      (delete-region (- (re-search-forward "^
" nil t) (length "")) + (delete-region (progn + (re-search-forward end-re) + (match-beginning 0)) (point-max)) (mm-url-decode-entities)))) @@ -358,22 +348,24 @@ Valid types include `google', `dejanews', and `gmane'.") (goto-char (point-max)) (widen) (narrow-to-region (point) - (search-forward "\"]+\\)\">]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*]+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)))))) @@ -432,7 +427,8 @@ Valid types include `google', `dejanews', and `gmane'.") "?" (mm-url-encode-www-form-urlencoded `(("q" . ,search) - ("num" . "100") + ("num" . ,(number-to-string + (min 100 nnweb-max-hits))) ("hq" . "") ("hl" . "en") ("lr" . "") @@ -442,7 +438,7 @@ Valid types include `google', `dejanews', and `gmane'.") t) (defun nnweb-google-identity (url) - "Return an unique identifier based on URL." + "Return a unique identifier based on URL." (if (string-match "selm=\\([^ &>]+\\)" url) (match-string 1 url) url)) @@ -452,48 +448,59 @@ Valid types include `google', `dejanews', and `gmane'.") ;;; (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 - (goto-char (point-min)) - (search-forward "Search Results
    " nil t) - (delete-region (point-min) (point)) + (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)) - ;; 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 "" nil t) - (delete-region (point-min) (point)) - (goto-char (point-min)) - (while (looking-at "^
  • \\([^ ]+\\).*
    • ") - (replace-match "\\1\\2" t) - (forward-line 1)) - (mm-url-remove-markup))) + (when (search-forward "" nil t) + (delete-region (point-min) (point)) + (goto-char (point-min)) + (while (looking-at "^
  • \\([^ ]+\\).*
    • ") + (replace-match "\\1\\2" t) + (forward-line 1)) + (mm-url-remove-markup)))) (defun nnweb-gmane-search (search) (mm-url-insert @@ -501,11 +508,15 @@ Valid types include `google', `dejanews', and `gmane'.") (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) @@ -513,13 +524,17 @@ Valid types include `google', `dejanews', and `gmane'.") url)) ;;; -;;; General web/w3 interface utility functions +;;; General web interface utility functions ;;; (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) @@ -585,5 +600,4 @@ Valid types include `google', `dejanews', and `gmane'.") (provide 'nnweb) -;;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697 ;;; nnweb.el ends here