1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00

Merge changes made in Gnus trunk.

message.texi (Insertion Variables): Document message-cite-style.
nnimap.el (nnimap-open-connection-1): Allow `network-only', too.
gssapi.el: New file separated out from imap.el to provide a general Kerberos 5 connection facility for Emacs.
message.el (message-elide-ellipsis): Document the format spec ellipsis.
message.el (message-elide-region): Allow the ellipsis to say how many lines were removed.
gnus-win.el (gnus-configure-frame): Protect against trying to restore window configurations containing buffers that are now dead.
nnimap.el (nnimap-parse-flags): Remove all MODSEQ entries before parsing to avoid integer overflows.
 (nnimap-parse-flags): Simplify the last change.
 (nnimap-parse-flags): Store HIGHESTMODSEQ as a string, since it may be too large for 32-bit Emacsen.
gnus-art.el (gnus-article-treat-body-boundary): Fix boundary width on XEmacs, which was one character too wide.
gnus-sum.el (gnus-articles-to-read): Use gnus-large-newsgroup as default number of articles to display.
 (gnus-articles-to-read): Use pretty names for prompt.
gnus-int.el (gnus-open-server): Ditto.
gnus-start.el (gnus-activate-group): Give a backtrace if debug-on-quit is set and the user hits `C-g'.
 (gnus-read-active-file): Ditto.
gnus-group.el (gnus-group-read-ephemeral-group): Ditto.
This commit is contained in:
Gnus developers 2011-03-15 22:38:41 +00:00 committed by Katsumi Yamaoka
parent 2dab465b9e
commit a123622dc4
12 changed files with 227 additions and 37 deletions

View File

@ -1,3 +1,7 @@
2011-03-15 Antoine Levitt <antoine.levitt@gmail.com>
* message.texi (Insertion Variables): Document message-cite-style.
2011-03-14 Michael Albinus <michael.albinus@gmx.de> 2011-03-14 Michael Albinus <michael.albinus@gmx.de>
* tramp.texi (Remote processes): New subsection "Running shell on * tramp.texi (Remote processes): New subsection "Running shell on

View File

@ -1930,6 +1930,25 @@ posting a prepared news message.
@section Insertion Variables @section Insertion Variables
@table @code @table @code
@item message-cite-style
@vindex message-cite-style
The overall style to be used when replying to messages. This controls
things like where the reply should be put relative to the original,
how the citation is formatted, where the signature goes, etc.
Value is either @code{nil} (no variable overrides) or a let-style list
of pairs @code{(VARIABLE VALUE)} to override default values.
See @code{gnus-posting-styles} to set this variable for specific
groups. Presets to impersonate popular mail agents are available in the
@code{message-cite-style-*} variables.
@item message-cite-reply-position
@vindex message-cite-reply-position
Where the reply should be positioned. Available styles are
@code{traditional} to reply inline, @code{above} for top-posting, and
@code{below} for bottom-posting
@item message-ignored-cited-headers @item message-ignored-cited-headers
@vindex message-ignored-cited-headers @vindex message-ignored-cited-headers
All headers that match this regexp will be removed from yanked All headers that match this regexp will be removed from yanked

View File

@ -1,8 +1,55 @@
2011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-open-connection-1): Allow `network-only', too.
* gssapi.el: New file separated out from imap.el to provide a general
Kerberos 5 connection facility for Emacs.
* message.el (message-elide-ellipsis): Document the format spec
ellipsis.
2011-03-15 Reiner Steib <Reiner.Steib@gmx.de>
* message.el (message-elide-region): Allow the ellipsis to say how many
lines were removed.
2011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-win.el (gnus-configure-frame): Protect against trying to restore
window configurations containing buffers that are now dead.
* nnimap.el (nnimap-parse-flags): Remove all MODSEQ entries before
parsing to avoid integer overflows.
(nnimap-parse-flags): Simplify the last change.
(nnimap-parse-flags): Store HIGHESTMODSEQ as a string, since it may be
too large for 32-bit Emacsen.
2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> 2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
* auth-source.el (auth-source-netrc-create): * auth-source.el (auth-source-netrc-create):
* message.el (message-yank-original): Fix use of `case'. * message.el (message-yank-original): Fix use of `case'.
2011-03-15 Nelson Ferreira <nelson.ferreira@ieee.org> (tiny change)
* gnus-art.el (gnus-article-treat-body-boundary): Fix boundary width on
XEmacs, which was one character too wide.
2011-03-09 Antoine Levitt <antoine.levitt@gmail.com>
* gnus-sum.el (gnus-articles-to-read): Use gnus-large-newsgroup as
default number of articles to display.
(gnus-articles-to-read): Use pretty names for prompt.
2011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-int.el (gnus-open-server): Ditto.
* gnus-start.el (gnus-activate-group): Give a backtrace if
debug-on-quit is set and the user hits `C-g'.
(gnus-read-active-file): Ditto.
* gnus-group.el (gnus-group-read-ephemeral-group): Ditto.
2011-03-15 Teodor Zlatanov <tzz@lifelogs.com> 2011-03-15 Teodor Zlatanov <tzz@lifelogs.com>
* message.el (message-yank-original): Use cond instead of CL case. * message.el (message-yank-original): Use cond instead of CL case.

View File

@ -2337,10 +2337,12 @@ long lines if and only if arg is positive."
(let ((start (point))) (let ((start (point)))
(insert "X-Boundary: ") (insert "X-Boundary: ")
(gnus-add-text-properties start (point) '(invisible t intangible t)) (gnus-add-text-properties start (point) '(invisible t intangible t))
(insert (let (str) (insert (let (str (max (window-width)))
(while (>= (window-width) (length str)) (if (featurep 'xemacs)
(setq max (1- max)))
(while (>= max (length str))
(setq str (concat str gnus-body-boundary-delimiter))) (setq str (concat str gnus-body-boundary-delimiter)))
(substring str 0 (window-width))) (substring str 0 max))
"\n") "\n")
(gnus-put-text-property start (point) 'gnus-decoration 'header))))) (gnus-put-text-property start (point) 'gnus-decoration 'header)))))

View File

@ -2313,9 +2313,10 @@ Return the name of the group if selection was successful."
gnus-fetch-old-ephemeral-headers)) gnus-fetch-old-ephemeral-headers))
(gnus-group-read-group (or number t) t group select-articles)) (gnus-group-read-group (or number t) t group select-articles))
group) group)
;;(error nil)
(quit (quit
(message "Quit reading the ephemeral group") (if debug-on-quit
(debug "Quit")
(message "Quit reading the ephemeral group"))
nil))))) nil)))))
(defcustom gnus-gmane-group-download-format (defcustom gnus-gmane-group-download-format

View File

@ -270,7 +270,9 @@ If it is down, start it up (again)."
server (error-message-string err)) server (error-message-string err))
nil) nil)
(quit (quit
(gnus-message 1 "Quit trying to open server %s" server) (if debug-on-quit
(debug "Quit")
(gnus-message 1 "Quit trying to open server %s" server))
nil))) nil)))
open-offline) open-offline)
;; If this hasn't been opened before, we add it to the list. ;; If this hasn't been opened before, we add it to the list.

View File

@ -1462,9 +1462,10 @@ If SCAN, request a scan of that group as well."
(inline (gnus-request-group group (or dont-sub-check dont-check) (inline (gnus-request-group group (or dont-sub-check dont-check)
method method
(gnus-get-info group))) (gnus-get-info group)))
;;(error nil)
(quit (quit
(message "Quit activating %s" group) (if debug-on-quit
(debug "Quit")
(message "Quit activating %s" group))
nil))) nil)))
(unless dont-check (unless dont-check
(setq active (gnus-parse-active)) (setq active (gnus-parse-active))
@ -2004,7 +2005,9 @@ If SCAN, request a scan of that group as well."
;; We catch C-g so that we can continue past servers ;; We catch C-g so that we can continue past servers
;; that do not respond. ;; that do not respond.
(quit (quit
(message "Quit reading the active file") (if debug-on-quit
(debug "Quit")
(message "Quit reading the active file"))
nil)))))))) nil))))))))
(defun gnus-read-active-file-1 (method force) (defun gnus-read-active-file-1 (method force)

View File

@ -5848,13 +5848,13 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(input (input
(read-string (read-string
(format (format
"How many articles from %s (%s %d): " "How many articles from %s (available %d, default %d): "
(gnus-group-decoded-name gnus-newsgroup-name) (gnus-group-decoded-name (gnus-group-real-name gnus-newsgroup-name))
(if initial "max" "default") number
number) (or initial gnus-large-newsgroup))
(if initial nil
(cons (number-to-string initial) nil
0))))) (number-to-string (or initial gnus-large-newsgroup)))))
(if (string-match "^[ \t]*$" input) number input))) (if (string-match "^[ \t]*$" input) number input)))
((and (> scored marked) (< scored number) ((and (> scored marked) (< scored number)
(> (- scored number) 20)) (> (- scored number) 20))
@ -5862,7 +5862,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(read-string (read-string
(format "%s %s (%d scored, %d total): " (format "%s %s (%d scored, %d total): "
"How many articles from" "How many articles from"
(gnus-group-decoded-name group) (gnus-group-decoded-name (gnus-group-real-name gnus-newsgroup-name))
scored number)))) scored number))))
(if (string-match "^[ \t]*$" input) (if (string-match "^[ \t]*$" input)
number input))) number input)))

View File

@ -268,8 +268,10 @@ See the Gnus manual for an explanation of the syntax used.")
(error "Invalid buffer type: %s" type)) (error "Invalid buffer type: %s" type))
(let ((buf (gnus-get-buffer-create (let ((buf (gnus-get-buffer-create
(gnus-window-to-buffer-helper buffer)))) (gnus-window-to-buffer-helper buffer))))
(if (eq buf (window-buffer (selected-window))) (set-buffer buf) (when (buffer-name buf)
(switch-to-buffer buf))) (if (eq buf (window-buffer (selected-window)))
(set-buffer buf)
(switch-to-buffer buf))))
(when (memq 'frame-focus split) (when (memq 'frame-focus split)
(setq gnus-window-frame-focus window)) (setq gnus-window-frame-focus window))
;; We return the window if it has the `point' spec. ;; We return the window if it has the `point' spec.

105
lisp/gnus/gssapi.el Normal file
View File

@ -0,0 +1,105 @@
;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
;; This file is part of GNU Emacs.
;; 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 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'format-spec)
(defcustom gssapi-program (list
(concat "gsasl %s %p "
"--mechanism GSSAPI "
"--authentication-id %l")
"imtest -m gssapi -u %l -p %p %s")
"List of strings containing commands for GSSAPI (krb5) authentication.
%s is replaced with server hostname, %p with port to connect to, and
%l with the value of `imap-default-user'. The program should accept
IMAP commands on stdin and return responses to stdout. Each entry in
the list is tried until a successful connection is made."
:group 'network
:type '(repeat string))
(defun open-gssapi-stream (name buffer server port)
(let ((cmds gssapi-program)
cmd done)
(with-current-buffer buffer
(while (and (not done)
(setq cmd (pop cmds)))
(message "Opening GSSAPI connection with `%s'..." cmd)
(erase-buffer)
(let* ((coding-system-for-read 'binary)
(coding-system-for-write 'binary)
(process (start-process
name buffer shell-file-name shell-command-switch
(format-spec
cmd
(format-spec-make
?s server
?p (number-to-string port)
?l imap-default-user))))
response)
(when process
(while (and (memq (process-status process) '(open run))
(goto-char (point-min))
;; Athena IMTEST can output SSL verify errors
(or (while (looking-at "^verify error:num=")
(forward-line))
t)
(or (while (looking-at "^TLS connection established")
(forward-line))
t)
;; cyrus 1.6.x (13? < x <= 22) queries capabilities
(or (while (looking-at "^C:")
(forward-line))
t)
;; cyrus 1.6 imtest print "S: " before server greeting
(or (not (looking-at "S: "))
(forward-char 3)
t)
;; GNU SASL may print 'Trying ...' first.
(or (not (looking-at "Trying "))
(forward-line)
t)
(not (and (looking-at "\\* \\(OK\\|PREAUTH\\|BYE\\) ")
;; success in imtest 1.6:
(re-search-forward
(concat "^\\(\\(Authenticat.*\\)\\|\\("
"Client authentication "
"finished.*\\)\\)")
nil t)
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
(erase-buffer)
(message "GSSAPI IMAP connection: %s" (or response "failed"))
(if (and response (let ((case-fold-search nil))
(not (string-match "failed" response))))
(setq done process)
(delete-process process)
nil))))
done)))
(provide 'gssapi)
;;; gssapi.el ends here

View File

@ -49,6 +49,7 @@
(require 'mail-parse) (require 'mail-parse)
(require 'mml) (require 'mml)
(require 'rfc822) (require 'rfc822)
(require 'format-spec)
(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
@ -438,7 +439,10 @@ whitespace)."
:group 'message-various) :group 'message-various)
(defcustom message-elide-ellipsis "\n[...]\n\n" (defcustom message-elide-ellipsis "\n[...]\n\n"
"*The string which is inserted for elided text." "*The string which is inserted for elided text.
This is a format-spec string, and you can use %l to say how many
lines were removed, and %c to say how many characters were
removed."
:type 'string :type 'string
:link '(custom-manual "(message)Various Commands") :link '(custom-manual "(message)Various Commands")
:group 'message-various) :group 'message-various)
@ -3535,8 +3539,12 @@ Note that this should not be used in newsgroups."
An ellipsis (from `message-elide-ellipsis') will be inserted where the An ellipsis (from `message-elide-ellipsis') will be inserted where the
text was killed." text was killed."
(interactive "r") (interactive "r")
(let ((lines (count-lines b e))
(chars (- e b)))
(kill-region b e) (kill-region b e)
(insert message-elide-ellipsis)) (insert (format-spec message-elide-ellipsis
`((?l . ,lines)
(?c . ,chars))))))
(defvar message-caesar-translation-table nil) (defvar message-caesar-translation-table nil)

View File

@ -340,6 +340,7 @@ textual parts.")
(ports (ports
(cond (cond
((or (eq nnimap-stream 'network) ((or (eq nnimap-stream 'network)
(eq nnimap-stream 'network-only)
(eq nnimap-stream 'starttls)) (eq nnimap-stream 'starttls))
(nnheader-message 7 "Opening connection to %s..." (nnheader-message 7 "Opening connection to %s..."
nnimap-address) nnimap-address)
@ -1452,6 +1453,11 @@ textual parts.")
;; Change \Delete etc to %Delete, so that the reader can read it. ;; Change \Delete etc to %Delete, so that the reader can read it.
(subst-char-in-region (point-min) (point-max) (subst-char-in-region (point-min) (point-max)
?\\ ?% t) ?\\ ?% t)
;; Remove any MODSEQ entries in the buffer, because they may contain
;; numbers that are too large for 32-bit Emacsen.
(while (re-search-forward " MODSEQ ([0-9]+)" nil t)
(replace-match "" t t))
(goto-char (point-min))
(let (start end articles groups uidnext elems permanent-flags (let (start end articles groups uidnext elems permanent-flags
uidvalidity vanished highestmodseq) uidvalidity vanished highestmodseq)
(dolist (elem sequences) (dolist (elem sequences)
@ -1491,9 +1497,9 @@ textual parts.")
(match-string 1))) (match-string 1)))
(goto-char start) (goto-char start)
(setq highestmodseq (setq highestmodseq
(and (search-forward "HIGHESTMODSEQ " (and (re-search-forward "HIGHESTMODSEQ \\([0-9]+\\)"
(or end (point-min)) t) (or end (point-min)) t)
(read (current-buffer)))) (match-string 1)))
(goto-char end) (goto-char end)
(forward-line -1)) (forward-line -1))
;; The UID FETCH FLAGS was successful. ;; The UID FETCH FLAGS was successful.
@ -1507,18 +1513,7 @@ textual parts.")
(goto-char end)) (goto-char end))
(while (re-search-forward "^\\* [0-9]+ FETCH " start t) (while (re-search-forward "^\\* [0-9]+ FETCH " start t)
(let ((p (point))) (let ((p (point)))
;; FIXME: For FETCH lines like "* 2971 FETCH (FLAGS (%Recent) UID (setq elems (read (current-buffer)))
;; 12509 MODSEQ (13419098521433281274))" we get an
;; overflow-error. The handler simply deletes that large number
;; and reads again. But maybe there's a better fix...
(setq elems (condition-case nil (read (current-buffer))
(overflow-error
;; After an overflow-error, point is just after
;; the too large number. So delete it and try
;; again.
(delete-region (point) (progn (backward-word) (point)))
(goto-char p)
(read (current-buffer)))))
(push (cons (cadr (memq 'UID elems)) (push (cons (cadr (memq 'UID elems))
(cadr (memq 'FLAGS elems))) (cadr (memq 'FLAGS elems)))
articles))) articles)))
@ -1674,6 +1669,8 @@ textual parts.")
(goto-char (point-max))) (goto-char (point-max)))
openp) openp)
(quit (quit
(when debug-on-quit
(debug "Quit"))
;; The user hit C-g while we were waiting: kill the process, in case ;; The user hit C-g while we were waiting: kill the process, in case
;; it's a gnutls-cli process that's stuck (tends to happen a lot behind ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind
;; NAT routers). ;; NAT routers).