Mercurial > emacs

changeset 87696:d5a92df16467

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from gnus--devo--0 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-992
author Miles Bader <miles@gnu.org>
date Thu, 10 Jan 2008 14:18:23 +0000
parents 5947c9dc7f6b
children e0467846347e
files doc/misc/ChangeLog doc/misc/gnus.texi lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-group.el
diffstat 5 files changed, 207 insertions(+), 65 deletions(-) [+]
line wrap: on
line diff
--- a/doc/misc/ChangeLog	Thu Jan 10 14:17:06 2008 +0000
+++ b/doc/misc/ChangeLog	Thu Jan 10 14:18:23 2008 +0000
@@ -1,3 +1,10 @@
+2008-01-09  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus.texi (Article Keymap): Add
+	gnus-article-wide-reply-with-original; fix descriptions of
+	gnus-article-reply-with-original and
+	gnus-article-followup-with-original.
+
 2008-01-09  Glenn Morris  <rgm@gnu.org>
 
 	* nxml-mode.texi: Add @copying section.
--- a/doc/misc/gnus.texi	Thu Jan 10 14:17:06 2008 +0000
+++ b/doc/misc/gnus.texi	Thu Jan 10 14:18:23 2008 +0000
@@ -11900,17 +11900,22 @@
 @kindex R (Article)
 @findex gnus-article-reply-with-original
 Send a reply to the current article and yank the current article
-(@code{gnus-article-reply-with-original}).  If given a prefix, make a
-wide reply.  If the region is active, only yank the text in the
-region.
+(@code{gnus-article-reply-with-original}).  If the region is active,
+only yank the text in the region.
+
+@item S W
+@kindex S W (Article)
+@findex gnus-article-wide-reply-with-original
+Send a wide reply to the current article and yank the current article
+(@code{gnus-article-wide-reply-with-original}).  If the region is
+active, only yank the text in the region.
 
 @item F
 @kindex F (Article)
 @findex gnus-article-followup-with-original
 Send a followup to the current article and yank the current article
-(@code{gnus-article-followup-with-original}).  If given a prefix, make
-a wide reply.  If the region is active, only yank the text in the
-region.
+(@code{gnus-article-followup-with-original}).  If the region is active,
+only yank the text in the region.
 
 
 @end table
--- a/lisp/gnus/ChangeLog	Thu Jan 10 14:17:06 2008 +0000
+++ b/lisp/gnus/ChangeLog	Thu Jan 10 14:18:23 2008 +0000
@@ -1,3 +1,39 @@
+2008-01-10  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (gnus-article-read-summary-keys): Work for `C-h' on
+	XEmacs.
+	(gnus-article-describe-key, gnus-article-describe-key-briefly): Protect
+	against non-character events.
+
+	* lpath.el: Fbind map-keymap for Emacs 21.
+
+2008-01-09  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* gnus-group.el (gnus-group-read-ephemeral-gmane-group-url): New
+	command.
+	(gnus-group-read-ephemeral-gmane-group): Use optional argument RANGE
+	instead of END.  Change name of the temp file.
+	(gnus-group-gmane-group-download-format): Add doc string.  Make it
+	customizable.
+
+2008-01-09  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (gnus-article-send-map): New keymap for `S' prefix keys;
+	bind `S W' to gnus-article-wide-reply-with-original; set default
+	binding to gnus-article-read-summary-send-keys.
+	(gnus-article-read-summary-keys): Fix the order of keys; display
+	continuation keys correctly in the echo area; describe bindings
+	correctly when keys end with `C-h'.
+	(gnus-article-read-summary-send-keys): New function.
+	(gnus-article-describe-key, gnus-article-describe-key-briefly): Work
+	for gnus-article-read-summary-send-keys; display continuation keys
+	correctly in the echo area.
+	(gnus-article-reply-with-original): Ignore prefix argument.
+	(gnus-article-wide-reply-with-original): New function.
+
+	* lpath.el: Fbind character-to-event and set-keymap-default-binding for
+	Emacs 21.
+
 2008-01-08  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* gnus-bookmark.el (gnus-bookmark-mouse-available-p): Don't test for
--- a/lisp/gnus/gnus-art.el	Thu Jan 10 14:17:06 2008 +0000
+++ b/lisp/gnus/gnus-art.el	Thu Jan 10 14:18:23 2008 +0000
@@ -4225,6 +4225,13 @@
 (substitute-key-definition
  'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
 
+(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
+  "W" gnus-article-wide-reply-with-original)
+(if (featurep 'xemacs)
+    (set-keymap-default-binding gnus-article-send-map
+				'gnus-article-read-summary-send-keys)
+  (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys))
+
 (defun gnus-article-make-menu-bar ()
   (unless (boundp 'gnus-article-commands-menu)
     (gnus-summary-make-menu-bar))
@@ -6243,17 +6250,37 @@
     (save-excursion
       (set-buffer gnus-article-current-summary)
       (let (gnus-pick-mode)
-	(push (or key last-command-event) unread-command-events)
-	(setq keys (if (featurep 'xemacs)
-		       (events-to-keys (read-key-sequence nil))
-		     (read-key-sequence nil)))))
+	(setq unread-command-events (nconc unread-command-events
+					   (list (or key last-command-event)))
+	      keys (if (featurep 'xemacs)
+		       (events-to-keys (read-key-sequence nil t))
+		     (read-key-sequence nil t)))))
 
     (message "")
 
     (cond
      ((eq (aref keys (1- (length keys))) ?\C-h)
-      (with-current-buffer gnus-article-current-summary
-	(describe-bindings (substring keys 0 -1))))
+      (if (featurep 'xemacs)
+	  (let ((keymap (with-current-buffer gnus-article-current-summary
+			  (copy-keymap (current-local-map)))))
+	    (map-keymap
+	     (lambda (key def)
+	       (define-key keymap (vector ?S key) def))
+	     gnus-article-send-map)
+	    (with-temp-buffer
+	      (setq major-mode 'gnus-article-mode)
+	      (use-local-map keymap)
+	      (describe-bindings (substring keys 0 -1))))
+	(let ((keymap (make-sparse-keymap))
+	      (map (copy-keymap gnus-article-send-map)))
+	  (define-key keymap "S" map)
+	  (define-key map [t] nil)
+	  (set-keymap-parent keymap
+			     (with-current-buffer gnus-article-current-summary
+			       (current-local-map)))
+	  (with-temp-buffer
+	    (use-local-map keymap)
+	    (describe-bindings (substring keys 0 -1))))))
      ((or (member keys nosaves)
 	  (member keys nosave-but-article)
 	  (member keys nosave-in-article))
@@ -6339,53 +6366,63 @@
 	      (signal (car err) (cdr err))
 	    (ding))))))))
 
+(defun gnus-article-read-summary-send-keys ()
+  (interactive)
+  (let ((unread-command-events (list (if (featurep 'xemacs)
+					 (character-to-event ?S)
+				       ?S))))
+    (gnus-article-read-summary-keys)))
+
 (defun gnus-article-describe-key (key)
-  "Display documentation of the function invoked by KEY.  KEY is a string."
-  (interactive "kDescribe key: ")
+  "Display documentation of the function invoked by KEY.
+KEY is a string or a vector."
+  (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
+		       (read-key-sequence "Describe key: "))))
   (gnus-article-check-buffer)
-  (if (eq (key-binding key) 'gnus-article-read-summary-keys)
+  (if (memq (key-binding key t) '(gnus-article-read-summary-keys
+				  gnus-article-read-summary-send-keys))
       (save-excursion
 	(set-buffer gnus-article-current-summary)
-	(let (gnus-pick-mode)
-	  (if (featurep 'xemacs)
-	      (progn
-		(push (elt key 0) unread-command-events)
-		(setq key (events-to-keys
-			   (read-key-sequence "Describe key: "))))
-	    (setq unread-command-events
-		  (mapcar
-		   (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
-		   (string-to-list key)))
-	    (setq key (read-key-sequence "Describe key: "))))
-	(describe-key key))
+	(setq unread-command-events
+	      (if (featurep 'xemacs)
+		  (append key nil)
+		(mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+					(list 'meta (- x 128))
+				      x))
+			key)))
+	(let ((cursor-in-echo-area t)
+	      gnus-pick-mode)
+	  (describe-key (read-key-sequence nil t))))
     (describe-key key)))
 
 (defun gnus-article-describe-key-briefly (key &optional insert)
-  "Display documentation of the function invoked by KEY.  KEY is a string."
-  (interactive "kDescribe key: \nP")
+  "Display documentation of the function invoked by KEY.
+KEY is a string or a vector."
+  (interactive (list (let ((cursor-in-echo-area t)) ;; better for XEmacs.
+		       (read-key-sequence "Describe key: "))
+		     current-prefix-arg))
   (gnus-article-check-buffer)
-  (if (eq (key-binding key) 'gnus-article-read-summary-keys)
+  (if (memq (key-binding key t) '(gnus-article-read-summary-keys
+				  gnus-article-read-summary-send-keys))
       (save-excursion
 	(set-buffer gnus-article-current-summary)
-	(let (gnus-pick-mode)
-	  (if (featurep 'xemacs)
-	      (progn
-		(push (elt key 0) unread-command-events)
-		(setq key (events-to-keys
-			   (read-key-sequence "Describe key: "))))
-	    (setq unread-command-events
-		  (mapcar
-		   (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
-		   (string-to-list key)))
-	    (setq key (read-key-sequence "Describe key: "))))
-	(describe-key-briefly key insert))
+	(setq unread-command-events
+	      (if (featurep 'xemacs)
+		  (append key nil)
+		(mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+					(list 'meta (- x 128))
+				      x))
+			key)))
+	(let ((cursor-in-echo-area t)
+	      gnus-pick-mode)
+	  (describe-key-briefly (read-key-sequence nil t) insert)))
     (describe-key-briefly key insert)))
 
 (defun gnus-article-reply-with-original (&optional wide)
   "Start composing a reply mail to the current message.
 The text in the region will be yanked.  If the region isn't active,
 the entire article will be yanked."
-  (interactive "P")
+  (interactive)
   (let ((article (cdr gnus-article-current))
 	contents)
     (if (not (gnus-region-active-p))
@@ -6400,6 +6437,13 @@
 	(gnus-summary-reply
 	 (list (list article contents)) wide)))))
 
+(defun gnus-article-wide-reply-with-original ()
+  "Start composing a wide reply mail to the current message.
+The text in the region will be yanked.  If the region isn't active,
+the entire article will be yanked."
+  (interactive)
+  (gnus-article-reply-with-original t))
+
 (defun gnus-article-followup-with-original ()
   "Compose a followup to the current article.
 The text in the region will be yanked.  If the region isn't active,
--- a/lisp/gnus/gnus-group.el	Thu Jan 10 14:17:06 2008 +0000
+++ b/lisp/gnus/gnus-group.el	Thu Jan 10 14:18:23 2008 +0000
@@ -2320,44 +2320,94 @@
 	 (message "Quit reading the ephemeral group")
 	 nil)))))
 
-(defvar gnus-group-gmane-group-download-format
-  "http://download.gmane.org/%s/%s/%s")
+(defcustom gnus-group-gmane-group-download-format
+  "http://download.gmane.org/%s/%s/%s"
+  "URL for downloading mbox files.
+It must contain three \"%s\".  They correspond to the group, the
+minimal and maximal article numbers, respectively."
+  :group 'gnus-group-foreign
+  :version "23.0" ;; No Gnus
+  :type 'string)
+
 (autoload 'url-insert-file-contents "url-handlers")
-
-;; FIXME: Make gnus-group-gmane-group-download-format customizable.  Add
-;; documentation, menu, key bindings...
-
-(defun gnus-group-read-ephemeral-gmane-group (group start end)
+;; FIXME:
+;; - Add documentation, menu, key bindings, ...
+
+(defun gnus-group-read-ephemeral-gmane-group (group start &optional range)
   "Read articles from Gmane group GROUP as an ephemeral group.
-START and END specify the articles range.  The articles are
-downloaded via HTTP using the URL specified by
-`gnus-group-gmane-group-download-format'."
+START is the first article.  RANGE specifies how many articles
+are fetched.  The articles are downloaded via HTTP using the URL
+specified by `gnus-group-gmane-group-download-format'."
   ;; See <http://gmane.org/export.php> for more information.
   (interactive
    (list
     (gnus-group-completing-read "Gmane group: ")
     (read-number "Start article number: ")
-    (read-number "End article number: ")))
-  (when (< (- end start) 0)
-    (error "Invalid range."))
-  (when (> (- end start)
-	   (min (or gnus-large-ephemeral-newsgroup 100) 100))
-    (unless (y-or-n-p
-	     (format "Large range (%s to %s), continue anyway? "
-		     start end))
-      (error "Range too large.  Aborted.")))
-  (let ((tmpfile (make-temp-file "gmane.gnus-temp-group-")))
+    (read-number "How many articles: ")))
+  (unless range (setq range 500))
+  (when (< range 1)
+    (error "Invalid range: %s" range))
+  (let ((tmpfile (make-temp-file
+		  (format "%s.start-%s.range-%s." group start range)))
+	(gnus-thread-sort-functions '(gnus-thread-sort-by-number)))
     (with-temp-file tmpfile
       (url-insert-file-contents
        (format gnus-group-gmane-group-download-format
-	       group start end))
+	       group start (+ start range)))
       (write-region (point-min) (point-max) tmpfile)
       (gnus-group-read-ephemeral-group
-       "rs-gnus-read-gmane"
+       (format "%s.start-%s.range-%s" group start range)
        `(nndoc ,tmpfile
 	       (nndoc-article-type guess))))
     (delete-file tmpfile)))
 
+(defun gnus-group-read-ephemeral-gmane-group-url (url)
+  "Create an ephemeral Gmane group from URL.
+
+Valid input formats include:
+\"http://thread.gmane.org/gmane.foo.bar/12300/focus=12399\",
+\"http://thread.gmane.org/gmane.foo.bar/12345/\",
+\"http://article.gmane.org/gmane.foo.bar/12345/\",
+\"http://news.gmane.org/group/gmane.foo.bar/thread=12345\""
+  ;; - Feel free to add other useful Gmane URLs here!  Maybe the URLs should
+  ;;   be customizable?
+  ;; - The URLs should be added to `gnus-button-alist'.  Probably we should
+  ;;   prompt the user to decide: "View via `browse-url' or in Gnus? "
+  ;;   (`gnus-group-read-ephemeral-gmane-group-url')
+  (interactive
+   (list (gnus-group-completing-read "Gmane URL: ")))
+  (let (group start range)
+    (cond
+     ;; URLs providing `group', `start' and `range':
+     ((string-match
+       ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525
+       "^http://thread\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$"
+       url)
+      (setq group (match-string 1 url)
+	    start (string-to-number (match-string 2 url))
+	    ;; Ensure that `range' is large enough to ensure focus article is
+	    ;; included.
+	    range (- (string-to-number (match-string 3 url))
+		     start -1)))
+     ;; URLs providing `group' and `start':
+     ((or (string-match
+	   ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584
+	   "^http://\\(?:thread\\|article\\)\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
+	   url)
+	  (string-match
+	   ;; Don't advertize these in the doc string yet:
+	   "^\\(?:nntp\\|news\\)://news\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
+	   url)
+	  (string-match
+	   ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t
+	   "^http://news\.gmane\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)"
+	   url))
+      (setq group (match-string 1 url)
+	    start (string-to-number (match-string 2 url))))
+     (t
+      (error "Can't parse URL %s" url)))
+    (gnus-group-read-ephemeral-gmane-group group start range)))
+
 (defun gnus-group-jump-to-group (group &optional prompt)
   "Jump to newsgroup GROUP.