aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorGnus developers2011-03-15 22:38:41 +0000
committerKatsumi Yamaoka2011-03-15 22:38:41 +0000
commita123622dc48a5f0e0eb32c07ce05c85e16e09c1d (patch)
tree1d2116fe692367da3625b744e980a6a8c909dd1e /lisp
parent2dab465b9edbb62db03cd5d2d9741415ba1014f6 (diff)
downloademacs-a123622dc48a5f0e0eb32c07ce05c85e16e09c1d.tar.gz
emacs-a123622dc48a5f0e0eb32c07ce05c85e16e09c1d.zip
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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/gnus/ChangeLog47
-rw-r--r--lisp/gnus/gnus-art.el8
-rw-r--r--lisp/gnus/gnus-group.el5
-rw-r--r--lisp/gnus/gnus-int.el4
-rw-r--r--lisp/gnus/gnus-start.el9
-rw-r--r--lisp/gnus/gnus-sum.el16
-rw-r--r--lisp/gnus/gnus-win.el6
-rw-r--r--lisp/gnus/gssapi.el105
-rw-r--r--lisp/gnus/message.el14
-rw-r--r--lisp/gnus/nnimap.el25
10 files changed, 203 insertions, 36 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index d806f0ac342..1b4cd186951 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,8 +1,55 @@
12011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * nnimap.el (nnimap-open-connection-1): Allow `network-only', too.
4
5 * gssapi.el: New file separated out from imap.el to provide a general
6 Kerberos 5 connection facility for Emacs.
7
8 * message.el (message-elide-ellipsis): Document the format spec
9 ellipsis.
10
112011-03-15 Reiner Steib <Reiner.Steib@gmx.de>
12
13 * message.el (message-elide-region): Allow the ellipsis to say how many
14 lines were removed.
15
162011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
17
18 * gnus-win.el (gnus-configure-frame): Protect against trying to restore
19 window configurations containing buffers that are now dead.
20
21 * nnimap.el (nnimap-parse-flags): Remove all MODSEQ entries before
22 parsing to avoid integer overflows.
23 (nnimap-parse-flags): Simplify the last change.
24 (nnimap-parse-flags): Store HIGHESTMODSEQ as a string, since it may be
25 too large for 32-bit Emacsen.
26
12011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> 272011-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
2 28
3 * auth-source.el (auth-source-netrc-create): 29 * auth-source.el (auth-source-netrc-create):
4 * message.el (message-yank-original): Fix use of `case'. 30 * message.el (message-yank-original): Fix use of `case'.
5 31
322011-03-15 Nelson Ferreira <nelson.ferreira@ieee.org> (tiny change)
33
34 * gnus-art.el (gnus-article-treat-body-boundary): Fix boundary width on
35 XEmacs, which was one character too wide.
36
372011-03-09 Antoine Levitt <antoine.levitt@gmail.com>
38
39 * gnus-sum.el (gnus-articles-to-read): Use gnus-large-newsgroup as
40 default number of articles to display.
41 (gnus-articles-to-read): Use pretty names for prompt.
42
432011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
44
45 * gnus-int.el (gnus-open-server): Ditto.
46
47 * gnus-start.el (gnus-activate-group): Give a backtrace if
48 debug-on-quit is set and the user hits `C-g'.
49 (gnus-read-active-file): Ditto.
50
51 * gnus-group.el (gnus-group-read-ephemeral-group): Ditto.
52
62011-03-15 Teodor Zlatanov <tzz@lifelogs.com> 532011-03-15 Teodor Zlatanov <tzz@lifelogs.com>
7 54
8 * message.el (message-yank-original): Use cond instead of CL case. 55 * message.el (message-yank-original): Use cond instead of CL case.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index c64138b43d7..20ffa8eed6b 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2337,10 +2337,12 @@ long lines if and only if arg is positive."
2337 (let ((start (point))) 2337 (let ((start (point)))
2338 (insert "X-Boundary: ") 2338 (insert "X-Boundary: ")
2339 (gnus-add-text-properties start (point) '(invisible t intangible t)) 2339 (gnus-add-text-properties start (point) '(invisible t intangible t))
2340 (insert (let (str) 2340 (insert (let (str (max (window-width)))
2341 (while (>= (window-width) (length str)) 2341 (if (featurep 'xemacs)
2342 (setq max (1- max)))
2343 (while (>= max (length str))
2342 (setq str (concat str gnus-body-boundary-delimiter))) 2344 (setq str (concat str gnus-body-boundary-delimiter)))
2343 (substring str 0 (window-width))) 2345 (substring str 0 max))
2344 "\n") 2346 "\n")
2345 (gnus-put-text-property start (point) 'gnus-decoration 'header))))) 2347 (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
2346 2348
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 9ed3cf02a49..e928811b558 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -2313,9 +2313,10 @@ Return the name of the group if selection was successful."
2313 gnus-fetch-old-ephemeral-headers)) 2313 gnus-fetch-old-ephemeral-headers))
2314 (gnus-group-read-group (or number t) t group select-articles)) 2314 (gnus-group-read-group (or number t) t group select-articles))
2315 group) 2315 group)
2316 ;;(error nil)
2317 (quit 2316 (quit
2318 (message "Quit reading the ephemeral group") 2317 (if debug-on-quit
2318 (debug "Quit")
2319 (message "Quit reading the ephemeral group"))
2319 nil))))) 2320 nil)))))
2320 2321
2321(defcustom gnus-gmane-group-download-format 2322(defcustom gnus-gmane-group-download-format
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index a67063bb970..ef15a479892 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -270,7 +270,9 @@ If it is down, start it up (again)."
270 server (error-message-string err)) 270 server (error-message-string err))
271 nil) 271 nil)
272 (quit 272 (quit
273 (gnus-message 1 "Quit trying to open server %s" server) 273 (if debug-on-quit
274 (debug "Quit")
275 (gnus-message 1 "Quit trying to open server %s" server))
274 nil))) 276 nil)))
275 open-offline) 277 open-offline)
276 ;; If this hasn't been opened before, we add it to the list. 278 ;; If this hasn't been opened before, we add it to the list.
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index c6ff6044b92..afded87fe37 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1462,9 +1462,10 @@ If SCAN, request a scan of that group as well."
1462 (inline (gnus-request-group group (or dont-sub-check dont-check) 1462 (inline (gnus-request-group group (or dont-sub-check dont-check)
1463 method 1463 method
1464 (gnus-get-info group))) 1464 (gnus-get-info group)))
1465 ;;(error nil)
1466 (quit 1465 (quit
1467 (message "Quit activating %s" group) 1466 (if debug-on-quit
1467 (debug "Quit")
1468 (message "Quit activating %s" group))
1468 nil))) 1469 nil)))
1469 (unless dont-check 1470 (unless dont-check
1470 (setq active (gnus-parse-active)) 1471 (setq active (gnus-parse-active))
@@ -2004,7 +2005,9 @@ If SCAN, request a scan of that group as well."
2004 ;; We catch C-g so that we can continue past servers 2005 ;; We catch C-g so that we can continue past servers
2005 ;; that do not respond. 2006 ;; that do not respond.
2006 (quit 2007 (quit
2007 (message "Quit reading the active file") 2008 (if debug-on-quit
2009 (debug "Quit")
2010 (message "Quit reading the active file"))
2008 nil)))))))) 2011 nil))))))))
2009 2012
2010(defun gnus-read-active-file-1 (method force) 2013(defun gnus-read-active-file-1 (method force)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a8786e39c7b..bc572f2f429 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5848,13 +5848,13 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5848 (input 5848 (input
5849 (read-string 5849 (read-string
5850 (format 5850 (format
5851 "How many articles from %s (%s %d): " 5851 "How many articles from %s (available %d, default %d): "
5852 (gnus-group-decoded-name gnus-newsgroup-name) 5852 (gnus-group-decoded-name (gnus-group-real-name gnus-newsgroup-name))
5853 (if initial "max" "default") 5853 number
5854 number) 5854 (or initial gnus-large-newsgroup))
5855 (if initial 5855 nil
5856 (cons (number-to-string initial) 5856 nil
5857 0))))) 5857 (number-to-string (or initial gnus-large-newsgroup)))))
5858 (if (string-match "^[ \t]*$" input) number input))) 5858 (if (string-match "^[ \t]*$" input) number input)))
5859 ((and (> scored marked) (< scored number) 5859 ((and (> scored marked) (< scored number)
5860 (> (- scored number) 20)) 5860 (> (- scored number) 20))
@@ -5862,7 +5862,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5862 (read-string 5862 (read-string
5863 (format "%s %s (%d scored, %d total): " 5863 (format "%s %s (%d scored, %d total): "
5864 "How many articles from" 5864 "How many articles from"
5865 (gnus-group-decoded-name group) 5865 (gnus-group-decoded-name (gnus-group-real-name gnus-newsgroup-name))
5866 scored number)))) 5866 scored number))))
5867 (if (string-match "^[ \t]*$" input) 5867 (if (string-match "^[ \t]*$" input)
5868 number input))) 5868 number input)))
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 156f9a020fd..c38f57d96cb 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -268,8 +268,10 @@ See the Gnus manual for an explanation of the syntax used.")
268 (error "Invalid buffer type: %s" type)) 268 (error "Invalid buffer type: %s" type))
269 (let ((buf (gnus-get-buffer-create 269 (let ((buf (gnus-get-buffer-create
270 (gnus-window-to-buffer-helper buffer)))) 270 (gnus-window-to-buffer-helper buffer))))
271 (if (eq buf (window-buffer (selected-window))) (set-buffer buf) 271 (when (buffer-name buf)
272 (switch-to-buffer buf))) 272 (if (eq buf (window-buffer (selected-window)))
273 (set-buffer buf)
274 (switch-to-buffer buf))))
273 (when (memq 'frame-focus split) 275 (when (memq 'frame-focus split)
274 (setq gnus-window-frame-focus window)) 276 (setq gnus-window-frame-focus window))
275 ;; We return the window if it has the `point' spec. 277 ;; We return the window if it has the `point' spec.
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
new file mode 100644
index 00000000000..3765fb84ee8
--- /dev/null
+++ b/lisp/gnus/gssapi.el
@@ -0,0 +1,105 @@
1;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs
2
3;; Copyright (C) 2011 Free Software Foundation, Inc.
4
5;; Author: Simon Josefsson <simon@josefsson.org>
6;; Lars Magne Ingebrigtsen <larsi@gnus.org>
7;; Keywords: network
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;;; Code:
27
28(require 'format-spec)
29
30(defcustom gssapi-program (list
31 (concat "gsasl %s %p "
32 "--mechanism GSSAPI "
33 "--authentication-id %l")
34 "imtest -m gssapi -u %l -p %p %s")
35 "List of strings containing commands for GSSAPI (krb5) authentication.
36%s is replaced with server hostname, %p with port to connect to, and
37%l with the value of `imap-default-user'. The program should accept
38IMAP commands on stdin and return responses to stdout. Each entry in
39the list is tried until a successful connection is made."
40 :group 'network
41 :type '(repeat string))
42
43(defun open-gssapi-stream (name buffer server port)
44 (let ((cmds gssapi-program)
45 cmd done)
46 (with-current-buffer buffer
47 (while (and (not done)
48 (setq cmd (pop cmds)))
49 (message "Opening GSSAPI connection with `%s'..." cmd)
50 (erase-buffer)
51 (let* ((coding-system-for-read 'binary)
52 (coding-system-for-write 'binary)
53 (process (start-process
54 name buffer shell-file-name shell-command-switch
55 (format-spec
56 cmd
57 (format-spec-make
58 ?s server
59 ?p (number-to-string port)
60 ?l imap-default-user))))
61 response)
62 (when process
63 (while (and (memq (process-status process) '(open run))
64 (goto-char (point-min))
65 ;; Athena IMTEST can output SSL verify errors
66 (or (while (looking-at "^verify error:num=")
67 (forward-line))
68 t)
69 (or (while (looking-at "^TLS connection established")
70 (forward-line))
71 t)
72 ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
73 (or (while (looking-at "^C:")
74 (forward-line))
75 t)
76 ;; cyrus 1.6 imtest print "S: " before server greeting
77 (or (not (looking-at "S: "))
78 (forward-char 3)
79 t)
80 ;; GNU SASL may print 'Trying ...' first.
81 (or (not (looking-at "Trying "))
82 (forward-line)
83 t)
84 (not (and (looking-at "\\* \\(OK\\|PREAUTH\\|BYE\\) ")
85 ;; success in imtest 1.6:
86 (re-search-forward
87 (concat "^\\(\\(Authenticat.*\\)\\|\\("
88 "Client authentication "
89 "finished.*\\)\\)")
90 nil t)
91 (setq response (match-string 1)))))
92 (accept-process-output process 1)
93 (sit-for 1))
94 (erase-buffer)
95 (message "GSSAPI IMAP connection: %s" (or response "failed"))
96 (if (and response (let ((case-fold-search nil))
97 (not (string-match "failed" response))))
98 (setq done process)
99 (delete-process process)
100 nil))))
101 done)))
102
103(provide 'gssapi)
104
105;;; gssapi.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 1d0aaffa426..bb9215aca7c 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -49,6 +49,7 @@
49(require 'mail-parse) 49(require 'mail-parse)
50(require 'mml) 50(require 'mml)
51(require 'rfc822) 51(require 'rfc822)
52(require 'format-spec)
52 53
53(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ 54(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
54 55
@@ -438,7 +439,10 @@ whitespace)."
438 :group 'message-various) 439 :group 'message-various)
439 440
440(defcustom message-elide-ellipsis "\n[...]\n\n" 441(defcustom message-elide-ellipsis "\n[...]\n\n"
441 "*The string which is inserted for elided text." 442 "*The string which is inserted for elided text.
443This is a format-spec string, and you can use %l to say how many
444lines were removed, and %c to say how many characters were
445removed."
442 :type 'string 446 :type 'string
443 :link '(custom-manual "(message)Various Commands") 447 :link '(custom-manual "(message)Various Commands")
444 :group 'message-various) 448 :group 'message-various)
@@ -3535,8 +3539,12 @@ Note that this should not be used in newsgroups."
3535An ellipsis (from `message-elide-ellipsis') will be inserted where the 3539An ellipsis (from `message-elide-ellipsis') will be inserted where the
3536text was killed." 3540text was killed."
3537 (interactive "r") 3541 (interactive "r")
3538 (kill-region b e) 3542 (let ((lines (count-lines b e))
3539 (insert message-elide-ellipsis)) 3543 (chars (- e b)))
3544 (kill-region b e)
3545 (insert (format-spec message-elide-ellipsis
3546 `((?l . ,lines)
3547 (?c . ,chars))))))
3540 3548
3541(defvar message-caesar-translation-table nil) 3549(defvar message-caesar-translation-table nil)
3542 3550
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index e76ead515c5..e0804f81e2e 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -340,6 +340,7 @@ textual parts.")
340 (ports 340 (ports
341 (cond 341 (cond
342 ((or (eq nnimap-stream 'network) 342 ((or (eq nnimap-stream 'network)
343 (eq nnimap-stream 'network-only)
343 (eq nnimap-stream 'starttls)) 344 (eq nnimap-stream 'starttls))
344 (nnheader-message 7 "Opening connection to %s..." 345 (nnheader-message 7 "Opening connection to %s..."
345 nnimap-address) 346 nnimap-address)
@@ -1452,6 +1453,11 @@ textual parts.")
1452 ;; Change \Delete etc to %Delete, so that the reader can read it. 1453 ;; Change \Delete etc to %Delete, so that the reader can read it.
1453 (subst-char-in-region (point-min) (point-max) 1454 (subst-char-in-region (point-min) (point-max)
1454 ?\\ ?% t) 1455 ?\\ ?% t)
1456 ;; Remove any MODSEQ entries in the buffer, because they may contain
1457 ;; numbers that are too large for 32-bit Emacsen.
1458 (while (re-search-forward " MODSEQ ([0-9]+)" nil t)
1459 (replace-match "" t t))
1460 (goto-char (point-min))
1455 (let (start end articles groups uidnext elems permanent-flags 1461 (let (start end articles groups uidnext elems permanent-flags
1456 uidvalidity vanished highestmodseq) 1462 uidvalidity vanished highestmodseq)
1457 (dolist (elem sequences) 1463 (dolist (elem sequences)
@@ -1491,9 +1497,9 @@ textual parts.")
1491 (match-string 1))) 1497 (match-string 1)))
1492 (goto-char start) 1498 (goto-char start)
1493 (setq highestmodseq 1499 (setq highestmodseq
1494 (and (search-forward "HIGHESTMODSEQ " 1500 (and (re-search-forward "HIGHESTMODSEQ \\([0-9]+\\)"
1495 (or end (point-min)) t) 1501 (or end (point-min)) t)
1496 (read (current-buffer)))) 1502 (match-string 1)))
1497 (goto-char end) 1503 (goto-char end)
1498 (forward-line -1)) 1504 (forward-line -1))
1499 ;; The UID FETCH FLAGS was successful. 1505 ;; The UID FETCH FLAGS was successful.
@@ -1507,18 +1513,7 @@ textual parts.")
1507 (goto-char end)) 1513 (goto-char end))
1508 (while (re-search-forward "^\\* [0-9]+ FETCH " start t) 1514 (while (re-search-forward "^\\* [0-9]+ FETCH " start t)
1509 (let ((p (point))) 1515 (let ((p (point)))
1510 ;; FIXME: For FETCH lines like "* 2971 FETCH (FLAGS (%Recent) UID 1516 (setq elems (read (current-buffer)))
1511 ;; 12509 MODSEQ (13419098521433281274))" we get an
1512 ;; overflow-error. The handler simply deletes that large number
1513 ;; and reads again. But maybe there's a better fix...
1514 (setq elems (condition-case nil (read (current-buffer))
1515 (overflow-error
1516 ;; After an overflow-error, point is just after
1517 ;; the too large number. So delete it and try
1518 ;; again.
1519 (delete-region (point) (progn (backward-word) (point)))
1520 (goto-char p)
1521 (read (current-buffer)))))
1522 (push (cons (cadr (memq 'UID elems)) 1517 (push (cons (cadr (memq 'UID elems))
1523 (cadr (memq 'FLAGS elems))) 1518 (cadr (memq 'FLAGS elems)))
1524 articles))) 1519 articles)))
@@ -1674,6 +1669,8 @@ textual parts.")
1674 (goto-char (point-max))) 1669 (goto-char (point-max)))
1675 openp) 1670 openp)
1676 (quit 1671 (quit
1672 (when debug-on-quit
1673 (debug "Quit"))
1677 ;; The user hit C-g while we were waiting: kill the process, in case 1674 ;; The user hit C-g while we were waiting: kill the process, in case
1678 ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind 1675 ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind
1679 ;; NAT routers). 1676 ;; NAT routers).