Mercurial > emacs

changeset 69247:6580c61aced7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-134 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 43-48) - Munge arch explicit ids in etc/images to match Emacs - Update from CVS
author Miles Bader <miles@gnu.org>
date Fri, 03 Mar 2006 07:45:27 +0000
parents 6e1a513dfa3b
children ff3786e89e65 5754737d1e04
files lisp/gnus/ChangeLog lisp/gnus/dns.el lisp/gnus/gnus-draft.el lisp/gnus/gnus-int.el lisp/gnus/gnus-sum.el lisp/gnus/mm-decode.el lisp/gnus/mm-util.el lisp/gnus/mml.el lisp/gnus/nnweb.el
diffstat 9 files changed, 164 insertions(+), 66 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Fri Mar 03 00:29:23 2006 +0000
+++ b/lisp/gnus/ChangeLog	Fri Mar 03 07:45:27 2006 +0000
@@ -1,3 +1,56 @@
+2006-03-03  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* mm-decode.el (mm-get-part): Don't use
+	mm-with-unibyte-current-buffer.
+
+	* gnus-sum.el (gnus-summary-set-display-table): Don't nix out
+	characters 160 through 255 in Emacs 23.
+
+2006-03-02  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* mml.el (mml-generate-mime-1): Encode parts other than text/* or
+	message/* containing non-ASCII text properly.
+
+2006-02-28  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* mm-util.el (mm-with-unibyte-current-buffer): Add note.
+
+2006-02-28  Andreas Seltenreich  <uwi7@rz.uni-karlsruhe.de>
+
+	* nnweb.el (nnweb-gmane-create-mapping): Don't choke on ^M.
+
+2006-02-28  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* nnweb.el (nnweb-type-definition, nnweb-gmane-search): Use new
+	nov.php.
+
+2006-02-28  Andreas Seltenreich  <uwi7@stud.uni-karlsruhe.de>
+
+	* nnweb.el (nnweb-type-definition, nnweb-gmane-create-mapping)
+	(nnweb-gmane-wash-article, nnweb-gmane-search): Fix Gmane web
+	groups.  Kudos to Olly Betts <olly@survex.com> for providing NOV
+	output on the server side.
+	(nnweb-google-create-mapping): Update regexps and add some
+	progress indication.
+
+2006-02-28  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* message.el (message-user-fqdn): Remove useless * in doc string.
+
+	* gnus-draft.el (gnus-draft-send): Bind message-signature to avoid
+	unnecessary interaction when sending queued mails.  Reported by
+	TAKAHASHI Yoshio <tkh@jp.fujitsu.com>.
+
+2006-02-28  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* gnus-int.el (gnus-open-server): Respect gnus-batch-mode.
+	Merge of 2006-02-20 change from the trunk.
+
+2006-02-28  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* dns.el (query-dns): Protect more against buggy tcp output.
+	Merge of 2006-02-20 change from the trunk.
+
 2006-02-27  Reiner Steib  <Reiner.Steib@gmx.de>
 
 	* gnus-sum.el (gnus-sequence-of-unread-articles): Return nil if
--- a/lisp/gnus/dns.el	Fri Mar 03 00:29:23 2006 +0000
+++ b/lisp/gnus/dns.el	Fri Mar 03 07:45:27 2006 +0000
@@ -347,7 +347,7 @@
 		     (>= (buffer-size) 2))
 	    (goto-char (point-min))
 	    (delete-region (point) (+ (point) 2)))
-	  (unless (zerop (buffer-size))
+	  (when (>= (buffer-size) 2)
 	    (let ((result (dns-read (buffer-string))))
 	      (if fullp
 		  result
--- a/lisp/gnus/gnus-draft.el	Fri Mar 03 00:29:23 2006 +0000
+++ b/lisp/gnus/gnus-draft.el	Fri Mar 03 07:45:27 2006 +0000
@@ -146,6 +146,8 @@
                                  message-send-hook))
          (message-setup-hook (and (not is-queue)
                                   message-setup-hook))
+	 (message-signature (and (not is-queue)
+				 message-signature))
          (gnus-agent-queue-mail (and (not is-queue)
                                      gnus-agent-queue-mail))
 	 (rfc2047-encode-encoded-words nil)
--- a/lisp/gnus/gnus-int.el	Fri Mar 03 00:29:23 2006 +0000
+++ b/lisp/gnus/gnus-int.el	Fri Mar 03 07:45:27 2006 +0000
@@ -250,10 +250,12 @@
                               ;; recurse to open the agent's backend.
                               (setq open-offline (eq gnus-server-unopen-status 'offline))
                               gnus-server-unopen-status)
-                             ((gnus-y-or-n-p
-                               (format "Unable to open %s:%s, go offline? "
-                                       (car gnus-command-method)
-                                       (cadr gnus-command-method)))
+                             ((and
+			       (not gnus-batch-mode)
+			       (gnus-y-or-n-p
+				(format "Unable to open %s:%s, go offline? "
+					(car gnus-command-method)
+					(cadr gnus-command-method))))
                               (setq open-offline t)
                               'offline)
                              (t
--- a/lisp/gnus/gnus-sum.el	Fri Mar 03 00:29:23 2006 +0000
+++ b/lisp/gnus/gnus-sum.el	Fri Mar 03 07:45:27 2006 +0000
@@ -3098,8 +3098,11 @@
     (aset table ?\r nil)
     ;; We keep TAB as well.
     (aset table ?\t nil)
-    ;; We nix out any glyphs over 126 that are not set already.
-    (let ((i 256))
+    ;; We nix out any glyphs 127 through 255, or 127 through 159 in
+    ;; Emacs 23, that are not set already.
+    (let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160))
+		 160
+	       256)))
       (while (>= (setq i (1- i)) 127)
 	;; Only modify if the entry is nil.
 	(unless (aref table i)
--- a/lisp/gnus/mm-decode.el	Fri Mar 03 00:29:23 2006 +0000
+++ b/lisp/gnus/mm-decode.el	Fri Mar 03 07:45:27 2006 +0000
@@ -1084,14 +1084,16 @@
 
 (defun mm-get-part (handle)
   "Return the contents of HANDLE as a string."
-  (mm-with-unibyte-buffer
-    (insert (with-current-buffer (mm-handle-buffer handle)
-	      (mm-with-unibyte-current-buffer
-		(buffer-string))))
-    (mm-decode-content-transfer-encoding
-     (mm-handle-encoding handle)
-     (mm-handle-media-type handle))
-    (buffer-string)))
+  (let ((default-enable-multibyte-characters
+	  (with-current-buffer (mm-handle-buffer handle)
+	    (mm-multibyte-p))))
+    (with-temp-buffer
+      (insert-buffer-substring (mm-handle-buffer handle))
+      (mm-disable-multibyte)
+      (mm-decode-content-transfer-encoding
+       (mm-handle-encoding handle)
+       (mm-handle-media-type handle))
+      (buffer-string))))
 
 (defun mm-insert-part (handle)
   "Insert the contents of HANDLE in the current buffer."
--- a/lisp/gnus/mm-util.el	Fri Mar 03 00:29:23 2006 +0000
+++ b/lisp/gnus/mm-util.el	Fri Mar 03 07:45:27 2006 +0000
@@ -796,11 +796,17 @@
 (defmacro mm-with-unibyte-current-buffer (&rest forms)
   "Evaluate FORMS with current buffer temporarily made unibyte.
 Also bind `default-enable-multibyte-characters' to nil.
-Equivalent to `progn' in XEmacs"
+Equivalent to `progn' in XEmacs
+
+NOTE: Use this macro with caution in multibyte buffers (it is not
+worth using this macro in unibyte buffers of course).  Use of
+`(set-buffer-multibyte t)', which is run finally, is generally
+harmful since it is likely to modify existing data in the buffer.
+For instance, it converts \"\\300\\255\" into \"\\255\" in Emacs 23."
   (let ((multibyte (make-symbol "multibyte"))
 	(buffer (make-symbol "buffer")))
     `(if mm-emacs-mule
- 	 (let ((,multibyte enable-multibyte-characters)
+	 (let ((,multibyte enable-multibyte-characters)
 	       (,buffer (current-buffer)))
 	   (unwind-protect
 	       (let (default-enable-multibyte-characters)
--- a/lisp/gnus/mml.el	Fri Mar 03 00:29:23 2006 +0000
+++ b/lisp/gnus/mml.el	Fri Mar 03 07:45:27 2006 +0000
@@ -507,7 +507,15 @@
 		(let ((coding-system-for-read mm-binary-coding-system))
 		  (mm-insert-file-contents filename nil nil nil nil t)))
 	       (t
-		(insert (cdr (assq 'contents cont)))))
+		(let ((contents (cdr (assq 'contents cont))))
+		  (if (if (featurep 'xemacs)
+			  (string-match "[^\000-\377]" contents)
+			(mm-multibyte-string-p contents))
+		      (progn
+			(mm-enable-multibyte)
+			(insert contents)
+			(setq charset (mm-encode-body)))
+		    (insert contents)))))
 	      (setq encoding (mm-encode-buffer type)
 		    coded (mm-string-as-multibyte (buffer-string))))
 	    (mml-insert-mime-headers cont type charset encoding nil)
--- a/lisp/gnus/nnweb.el	Fri Mar 03 00:29:23 2006 +0000
+++ b/lisp/gnus/nnweb.el	Fri Mar 03 07:45:27 2006 +0000
@@ -27,9 +27,6 @@
 
 ;; 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))
@@ -82,7 +79,7 @@
      (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 +96,7 @@
 
 (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)
 
@@ -309,22 +306,26 @@
 
 (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 "<pre>\n *")
+	(end-re "\n *</pre>"))
     (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 "^<pre>" nil t)
-			(re-search-forward "^</pre>" 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 "^<pre>" nil t)))
+		     (re-search-forward start-re))
       (goto-char (point-min))
-      (delete-region (- (re-search-forward "^</pre>" nil t) (length "</pre>"))
+      (delete-region (progn
+		       (re-search-forward end-re)
+		       (match-beginning 0))
 		     (point-max))
       (mm-url-decode-entities))))
 
@@ -403,6 +404,7 @@
   (save-excursion
     (set-buffer nnweb-buffer)
     (erase-buffer)
+    (nnheader-message 7 "Searching google...")
     (when (funcall (nnweb-definition 'search) nnweb-search)
 	(let ((more t)
 	      (i 0))
@@ -413,15 +415,18 @@
 	    (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\\([^>\"]+\\)\"><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))))))
 
@@ -454,46 +459,61 @@
   "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</h1><ul>" nil t)
-	(delete-region (point-min) (point))
+    (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))
+		  (push
+		   (list
+		    (incf (cdr active))
+		    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))
-    (re-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
@@ -501,11 +521,13 @@
     (nnweb-definition 'address)
     "?"
     (mm-url-encode-www-form-urlencoded
-     `(("query" . ,search)))))
+     `(("query" . ,search)
+       ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))))))
   (setq buffer-file-name nil)
+  (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)