From 95838435c8ab907e292852a706a7727c8437c59a Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Thu, 10 Jan 2008 14:18:23 +0000 Subject: [PATCH] Merge from gnus--devo--0 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-992 --- doc/misc/ChangeLog | 7 +++ doc/misc/gnus.texi | 17 ++++-- lisp/gnus/ChangeLog | 36 ++++++++++++ lisp/gnus/gnus-art.el | 118 +++++++++++++++++++++++++++------------- lisp/gnus/gnus-group.el | 92 ++++++++++++++++++++++++------- 5 files changed, 206 insertions(+), 64 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 12ec5d3124..0fd7a5dbe8 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,10 @@ +2008-01-09 Katsumi Yamaoka + + * 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 * nxml-mode.texi: Add @copying section. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 690c63e446..ba61fd7224 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -11900,17 +11900,22 @@ Go to the previous button, if any (@code{gnus-article-prev-button}). @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 diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 728ea9a424..e3d4fcb0ab 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,39 @@ +2008-01-10 Katsumi Yamaoka + + * 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 + + * 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 + + * 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 * gnus-bookmark.el (gnus-bookmark-mouse-available-p): Don't test for diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index fda62bc79a..f34f8f7376 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4225,6 +4225,13 @@ If variable `gnus-use-long-file-name' is non-nil, it is (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 @@ not have a face in `gnus-article-boring-faces'." (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 @@ not have a face in `gnus-article-boring-faces'." (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 @@ the entire article will be yanked." (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, diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 2be0b6e5c8..ee5068e980 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2320,44 +2320,94 @@ Return the name of the group if selection was successful." (message "Quit reading the ephemeral group") nil))))) -(defvar gnus-group-gmane-group-download-format - "http://download.gmane.org/%s/%s/%s") -(autoload 'url-insert-file-contents "url-handlers") +(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) -;; FIXME: Make gnus-group-gmane-group-download-format customizable. Add -;; documentation, menu, key bindings... +(autoload 'url-insert-file-contents "url-handlers") +;; FIXME: +;; - Add documentation, menu, key bindings, ... -(defun gnus-group-read-ephemeral-gmane-group (group start end) +(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 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. -- 2.20.1