procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from gnus--devo--0

Browse source 
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-992
This commit is contained in:
Miles Bader 2008-01-10 14:18:23 +00:00
parent 11f6a31de4
commit 95838435c8
5 changed files with 206 additions and 64 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
doc/misc/ChangeLog
View file

@ -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.

17
doc/misc/gnus.texi
View file

@ -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

36
lisp/gnus/ChangeLog
View file

@ -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

118
lisp/gnus/gnus-art.el
View file

@ -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,

92
lisp/gnus/gnus-group.el
View file

@ -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")
(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:
;; - Add documentation, menu, key bindings, ...
;; FIXME: Make gnus-group-gmane-group-download-format customizable. 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 <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.