Commit 53a35e81 authored by Paul Eggert's avatar Paul Eggert
Browse files

Merge from mainline.

parents 19548d08 f330b642
2011-05-03 Peter Münster <pmlists@free.fr>
2011-05-03 Peter Münster <pmlists@free.fr> (tiny change)
* gnus.texi (Summary Buffer Lines):
gnus-summary-user-date-format-alist does not exist.
......
2011-05-04 Glenn Morris <rgm@gnu.org>
* calendar/diary-lib.el (diary-fancy-date-pattern): Turn it into a
function, so it follows changes in calendar-date-style.
(diary-fancy-date-matcher): New function.
(diary-fancy-font-lock-keywords): Use diary-fancy-date-matcher.
(diary-fancy-font-lock-fontify-region-function):
Use diary-fancy-date-pattern as a function.
* calendar/diary-lib.el (diary-fancy-date-pattern): Do not use
non-numbers for `year' etc pseudo-variables. (Bug#8583)
2011-05-04 Teodor Zlatanov <tzz@lifelogs.com>
* net/gnutls.el (gnutls-negotiate): Use CL-style keyword arguments
instead of positional arguments. Allow :keylist and :crlfiles
arguments.
(open-gnutls-stream): Call it.
* net/network-stream.el (network-stream-open-starttls): Adjust to
call `gnutls-negotiate' with :process and :hostname arguments.
2011-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuffer.el (completion--message): New function.
(completion--do-completion, minibuffer-complete)
(minibuffer-force-complete, minibuffer-complete-word): Use it.
(completion--do-completion): Don't ignore completion-auto-help when in
icomplete-mode.
* whitespace.el (whitespace-trailing-regexp): Don't rely on the
internal encoding (e.g. tibetan zero is not whitespace).
(global-whitespace-mode): Prefer save-current-buffer.
(whitespace-trailing-regexp): Remove useless save-match-data.
(whitespace-empty-at-bob-regexp): Minor simplification.
2011-05-03 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/autoload.el (generated-autoload-file): Doc fix (Bug#7989).
......
......@@ -2090,7 +2090,7 @@ Optional symbol TYPE is either `monthly' or `yearly'."
'(day " " monthname))
(t '(monthname " " day))))
;; Iso cannot contain "-", because this form used eg by
;; insert-anniversary-diary-entry.
;; diary-insert-anniversary-entry.
(t (cond ((eq calendar-date-style 'iso)
'((format "%s %.2d %.2d" year
(string-to-number month) (string-to-number day))))
......@@ -2364,36 +2364,45 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
;;; Fancy Diary Mode.
;; FIXME does not update upon changes to the name-arrays.
(defvar diary-fancy-date-pattern
(defun diary-fancy-date-pattern ()
"Return a regexp matching the first line of a fancy diary date header.
This depends on the calendar date style."
(concat
(let ((dayname (diary-name-pattern calendar-day-name-array nil t))
(monthname (diary-name-pattern calendar-month-name-array nil t))
(day "[0-9]+")
(month "[0-9]+")
(year "-?[0-9]+"))
(mapconcat 'eval calendar-date-display-form ""))
(day "1")
(month "2")
;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for?
(year "3"))
;; This is ugly. c-d-d-form expects `day' etc to be "numbers in
;; string form"; eg the iso version calls string-to-number on some.
;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583).
;; Assumes no integers in c-day/month-name-array.
(replace-regexp-in-string "[0-9]+" "[0-9]+"
(mapconcat 'eval calendar-date-display-form "")
nil t))
;; Optional ": holiday name" after the date.
"\\(: .*\\)?")
"Regular expression matching a date header in Fancy Diary.")
"\\(: .*\\)?"))
(defun diary-fancy-date-matcher (limit)
"Search for a fancy diary data header, up to LIMIT."
;; Any number of " other holiday name" lines, followed by "==" line.
(when (re-search-forward
(format "%s\\(\n +.*\\)*\n=+$" (diary-fancy-date-pattern)) limit t)
(put-text-property (match-beginning 0) (match-end 0) 'font-lock-multiline t)
t))
(define-obsolete-variable-alias 'fancy-diary-font-lock-keywords
'diary-fancy-font-lock-keywords "23.1")
(defvar diary-fancy-font-lock-keywords
(list
(list
;; Any number of " other holiday name" lines, followed by "==" line.
(concat diary-fancy-date-pattern "\\(\n +.*\\)*\n=+$")
'(0 (progn (put-text-property (match-beginning 0) (match-end 0)
'font-lock-multiline t)
diary-face)))
'("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
'("^.*Yahrzeit.*$" . font-lock-reference-face)
'("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
'("^Day.*omer.*$" . font-lock-builtin-face)
'("^Parashat.*$" . font-lock-comment-face)
`(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
`((diary-fancy-date-matcher . diary-face)
("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
("^.*Yahrzeit.*$" . font-lock-reference-face)
("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
("^Day.*omer.*$" . font-lock-builtin-face)
("^Parashat.*$" . font-lock-comment-face)
(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
diary-time-regexp) . 'diary-time))
"Keywords to highlight in fancy diary display.")
......@@ -2409,7 +2418,7 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
(while (and (looking-at " +[^ ]")
(zerop (forward-line -1))))
;; This check not essential.
(if (looking-at diary-fancy-date-pattern)
(if (looking-at (diary-fancy-date-pattern))
(setq beg (line-beginning-position)))
(goto-char end)
(forward-line 0)
......
......@@ -558,6 +558,10 @@ candidates than this number."
(defvar completion-fail-discreetly nil
"If non-nil, stay quiet when there is no match.")
(defun completion--message (msg)
(if completion-show-inline-help
(minibuffer-message msg)))
(defun completion--do-completion (&optional try-completion-function)
"Do the completion and return a summary of what happened.
M = completion was performed, the text was Modified.
......@@ -585,9 +589,9 @@ E = after completion we now have an Exact match.
(cond
((null comp)
(minibuffer-hide-completions)
(when (and (not completion-fail-discreetly) completion-show-inline-help)
(unless completion-fail-discreetly
(ding)
(minibuffer-message "No match"))
(completion--message "No match"))
(minibuffer--bitset nil nil nil))
((eq t comp)
(minibuffer-hide-completions)
......@@ -657,15 +661,13 @@ E = after completion we now have an Exact match.
(minibuffer-hide-completions))
;; Show the completion table, if requested.
((not exact)
(if (cond (icomplete-mode t)
((null completion-show-inline-help) t)
((eq completion-auto-help 'lazy)
(eq this-command last-command))
(t completion-auto-help))
(if (case completion-auto-help
(lazy (eq this-command last-command))
(t completion-auto-help))
(minibuffer-completion-help)
(minibuffer-message "Next char not unique")))
(completion--message "Next char not unique")))
;; If the last exact completion and this one were the same, it
;; means we've already given a "Next char not unique" message
;; means we've already given a "Complete, but not unique" message
;; and the user's hit TAB again, so now we give him help.
((eq this-command last-command)
(if completion-auto-help (minibuffer-completion-help))))
......@@ -703,11 +705,9 @@ scroll the window of possible completions."
t)
(t (case (completion--do-completion)
(#b000 nil)
(#b001 (if completion-show-inline-help
(minibuffer-message "Sole completion"))
(#b001 (completion--message "Sole completion")
t)
(#b011 (if completion-show-inline-help
(minibuffer-message "Complete, but not unique"))
(#b011 (completion--message "Complete, but not unique")
t)
(t t)))))
......@@ -765,9 +765,8 @@ Repeated uses step through the possible completions."
(end (field-end))
(all (completion-all-sorted-completions)))
(if (not (consp all))
(if completion-show-inline-help
(minibuffer-message
(if all "No more completions" "No completions")))
(completion--message
(if all "No more completions" "No completions"))
(setq completion-cycling t)
(goto-char end)
(insert (car all))
......@@ -955,11 +954,9 @@ Return nil if there is no valid completion, else t."
(interactive)
(case (completion--do-completion 'completion--try-word-completion)
(#b000 nil)
(#b001 (if completion-show-inline-help
(minibuffer-message "Sole completion"))
(#b001 (completion--message "Sole completion")
t)
(#b011 (if completion-show-inline-help
(minibuffer-message "Complete, but not unique"))
(#b011 (completion--message "Complete, but not unique")
t)
(t t)))
......
......@@ -35,6 +35,8 @@
;;; Code:
(eval-when-compile (require 'cl))
(defgroup gnutls nil
"Emacs interface to the GnuTLS library."
:prefix "gnutls-"
......@@ -72,9 +74,9 @@ This is a very simple wrapper around `gnutls-negotiate'. See its
documentation for the specific parameters you can use to open a
GnuTLS connection, including specifying the credential type,
trust and key files, and priority string."
(gnutls-negotiate (open-network-stream name buffer host service)
'gnutls-x509pki
host))
(gnutls-negotiate :process (open-network-stream name buffer host service)
:type 'gnutls-x509pki
:hostname host))
(put 'gnutls-error
'error-conditions
......@@ -85,16 +87,23 @@ trust and key files, and priority string."
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
(declare-function gnutls-errorp "gnutls.c" (error))
(defun gnutls-negotiate (proc type hostname &optional priority-string
trustfiles keyfiles verify-flags
verify-error verify-hostname-error)
(defun* gnutls-negotiate
(&rest spec
&key process type hostname priority-string
trustfiles crlfiles keylist verify-flags
verify-error verify-hostname-error
&allow-other-keys)
"Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error.
Note arguments are passed CL style, :type TYPE instead of just TYPE.
TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default.
PROC is a process returned by `open-network-stream'.
PROCESS is a process returned by `open-network-stream'.
HOSTNAME is the remote hostname. It must be a valid string.
PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
TRUSTFILES is a list of CA bundles.
KEYFILES is a list of client keys.
CRLFILES is a list of CRL files.
KEYLIST is an alist of (client key file, client cert file) pairs.
When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
when the hostname does not match the presented certificate's host
......@@ -141,7 +150,8 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
:hostname ,hostname
:loglevel ,gnutls-log-level
:trustfiles ,trustfiles
:keyfiles ,keyfiles
:crlfiles ,crlfiles
:keylist ,keylist
:verify-flags ,verify-flags
:verify-error ,verify-error
:verify-hostname-error ,verify-hostname-error
......@@ -149,14 +159,14 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
ret)
(gnutls-message-maybe
(setq ret (gnutls-boot proc type params))
(setq ret (gnutls-boot process type params))
"boot: %s" params)
(when (gnutls-errorp ret)
;; This is a error from the underlying C code.
(signal 'gnutls-error (list proc ret)))
(signal 'gnutls-error (list process ret)))
proc))
process))
(declare-function gnutls-error-string "gnutls.c" (error))
......
......@@ -45,9 +45,7 @@
(require 'tls)
(require 'starttls)
(declare-function gnutls-negotiate "gnutls"
(proc type host &optional priority-string trustfiles keyfiles
verify-flags verify-error verify-hostname-error))
(declare-function gnutls-negotiate "gnutls" (&rest spec))
;;;###autoload
(defun open-network-stream (name buffer host service &rest parameters)
......@@ -203,7 +201,7 @@ asynchronously, if possible."
(network-stream-command stream starttls-command eoc))
;; The server said it was OK to begin STARTTLS negotiations.
(if (fboundp 'open-gnutls-stream)
(gnutls-negotiate stream nil host)
(gnutls-negotiate :process stream :hostname host)
(unless (starttls-negotiate stream)
(delete-process stream)))
(if (memq (process-status stream) '(open run))
......
......@@ -492,7 +492,7 @@ This varies according to the value of LINE-LENGTH.
This is used to fontify fixed-format Fortran comments."
;; This results in a non-byte-compiled function. We could pass it through
;; `byte-compile', but simple benchmarks indicate that it's probably not
;; worth the trouble (about ½% of slow down).
;; worth the trouble (about 0.5% of slow down).
(eval ;I hate `eval', but it's hard to avoid it here.
`(syntax-propertize-rules
("^[cd\\*]" (0 "<"))
......
......@@ -800,13 +800,12 @@ Used when `whitespace-style' includes `tabs'."
(defcustom whitespace-trailing-regexp
"\\(\\(\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)$"
"\\([\t \u00A0]+\\)$"
"Specify trailing characters regexp.
If you're using `mule' package, there may be other characters besides:
\" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
\"\\xF20\"
\" \" \"\\t\" \"\\u00A0\"
that should be considered blank.
......@@ -1133,7 +1132,7 @@ See also `whitespace-style', `whitespace-newline' and
(noninteractive ; running a batch job
(setq global-whitespace-mode nil))
(global-whitespace-mode ; global-whitespace-mode on
(save-excursion
(save-current-buffer
(add-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
(add-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled)
(dolist (buffer (buffer-list)) ; adjust all local mode
......@@ -1141,7 +1140,7 @@ See also `whitespace-style', `whitespace-newline' and
(unless whitespace-mode
(whitespace-turn-on-if-enabled)))))
(t ; global-whitespace-mode off
(save-excursion
(save-current-buffer
(remove-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
(remove-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled)
(dolist (buffer (buffer-list)) ; adjust all local mode
......@@ -1526,7 +1525,7 @@ documentation."
;; whole buffer
(t
(save-excursion
(save-match-data
(save-match-data ;FIXME: Why?
;; PROBLEM 1: empty lines at bob
;; PROBLEM 2: empty lines at eob
;; ACTION: remove all empty lines at bob and/or eob
......@@ -1598,7 +1597,7 @@ documentation."
overwrite-mode ; enforce no overwrite
tmp)
(save-excursion
(save-match-data
(save-match-data ;FIXME: Why?
;; PROBLEM 1: 8 or more SPACEs at bol
(cond
;; ACTION: replace 8 or more SPACEs at bol by TABs, if
......@@ -1870,7 +1869,7 @@ cleaning up these problems."
(interactive "r")
(setq force (or current-prefix-arg force))
(save-excursion
(save-match-data
(save-match-data ;FIXME: Why?
(let* ((has-bogus nil)
(rstart (min start end))
(rend (max start end))
......@@ -2412,9 +2411,8 @@ resultant list will be returned."
"Match trailing spaces which do not contain the point at end of line."
(let ((status t))
(while (if (re-search-forward whitespace-trailing-regexp limit t)
(save-match-data
(= whitespace-point (match-end 1))) ;; loop if point at eol
(setq status nil))) ;; end of buffer
(= whitespace-point (match-end 1)) ;; Loop if point at eol.
(setq status nil))) ;; End of buffer.
status))
......@@ -2428,9 +2426,7 @@ beginning of buffer."
((= b 1)
(setq r (and (/= whitespace-point 1)
(looking-at whitespace-empty-at-bob-regexp)))
(if r
(set-marker whitespace-bob-marker (match-end 1))
(set-marker whitespace-bob-marker b)))
(set-marker whitespace-bob-marker (if r (match-end 1) b)))
;; inside bob empty region
((<= limit whitespace-bob-marker)
(setq r (looking-at whitespace-empty-at-bob-regexp))
......@@ -2441,9 +2437,7 @@ beginning of buffer."
;; intersection with end of bob empty region
((<= b whitespace-bob-marker)
(setq r (looking-at whitespace-empty-at-bob-regexp))
(if r
(set-marker whitespace-bob-marker (match-end 1))
(set-marker whitespace-bob-marker b)))
(set-marker whitespace-bob-marker (if r (match-end 1) b)))
;; it is not inside bob empty region
(t
(setq r nil)))
......
......@@ -108,6 +108,12 @@
* fns.c (Frandom): Let EMACS_UINT be wider than unsigned long.
2011-05-04 Teodor Zlatanov <tzz@lifelogs.com>
* gnutls.c (Fgnutls_boot): Support :keylist and :crlfiles options
instead of :keyfiles. Give GnuTLS the keylist and the CRL lists
as passed in.
2011-05-03 Jan Djärv <jan.h.d@swipnet.se>
* xterm.c (x_set_frame_alpha): Do not set property on anything
......
......@@ -44,7 +44,8 @@ static int gnutls_global_initialized;
/* The following are for the property list of `gnutls-boot'. */
static Lisp_Object Qgnutls_bootprop_priority;
static Lisp_Object Qgnutls_bootprop_trustfiles;
static Lisp_Object Qgnutls_bootprop_keyfiles;
static Lisp_Object Qgnutls_bootprop_keylist;
static Lisp_Object Qgnutls_bootprop_crlfiles;
static Lisp_Object Qgnutls_bootprop_callbacks;
static Lisp_Object Qgnutls_bootprop_loglevel;
static Lisp_Object Qgnutls_bootprop_hostname;
......@@ -412,7 +413,10 @@ PROPLIST is a property list with the following keys:
:trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
:keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
:crlfiles is a list of PEM-encoded CRL lists for `gnutls-x509pki'.
:keylist is an alist of PEM-encoded key files and PEM-encoded
certificates for `gnutls-x509pki'.
:callbacks is an alist of callback functions, see below.
......@@ -471,7 +475,8 @@ one trustfile (usually a CA bundle). */)
/* Placeholders for the property list elements. */
Lisp_Object priority_string;
Lisp_Object trustfiles;
Lisp_Object keyfiles;
Lisp_Object crlfiles;
Lisp_Object keylist;
/* Lisp_Object callbacks; */
Lisp_Object loglevel;
Lisp_Object hostname;
......@@ -486,7 +491,8 @@ one trustfile (usually a CA bundle). */)
hostname = Fplist_get (proplist, Qgnutls_bootprop_hostname);
priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
keyfiles = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
keylist = Fplist_get (proplist, Qgnutls_bootprop_keylist);
crlfiles = Fplist_get (proplist, Qgnutls_bootprop_crlfiles);
/* callbacks = Fplist_get (proplist, Qgnutls_bootprop_callbacks); */
loglevel = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
verify_flags = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
......@@ -614,15 +620,41 @@ one trustfile (usually a CA bundle). */)
}
}
for (tail = keyfiles; !NILP (tail); tail = Fcdr (tail))
for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
{
Lisp_Object keyfile = Fcar (tail);
if (STRINGP (keyfile))
Lisp_Object crlfile = Fcar (tail);
if (STRINGP (crlfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the keyfile: ",
SSDATA (keyfile));
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
SSDATA (crlfile));
ret = gnutls_certificate_set_x509_crl_file
(x509_cred,
SSDATA (crlfile),
file_format);
if (ret < GNUTLS_E_SUCCESS)
return gnutls_make_error (ret);
}
else
{
error ("Sorry, GnuTLS can't use non-string CRL file %s",
SDATA (crlfile));
}
}
for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
{
Lisp_Object keyfile = Fcar (Fcar (tail));
Lisp_Object certfile = Fcar (Fcdr (tail));
if (STRINGP (keyfile) && STRINGP (certfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
SSDATA (keyfile));
GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
SSDATA (certfile));
ret = gnutls_certificate_set_x509_key_file
(x509_cred,
SSDATA (certfile),
SSDATA (keyfile),
file_format);
......@@ -631,8 +663,12 @@ one trustfile (usually a CA bundle). */)
}
else
{
error ("Sorry, GnuTLS can't use non-string keyfile %s",
SDATA (keyfile));
if (STRINGP (keyfile))
error ("Sorry, GnuTLS can't use non-string client cert file %s",
SDATA (certfile));
else
error ("Sorry, GnuTLS can't use non-string client key file %s",
SDATA (keyfile));
}
}
}
......@@ -868,8 +904,11 @@ syms_of_gnutls (void)
Qgnutls_bootprop_trustfiles = intern_c_string (":trustfiles");
staticpro (&Qgnutls_bootprop_trustfiles);
Qgnutls_bootprop_keyfiles = intern_c_string (":keyfiles");
staticpro (&Qgnutls_bootprop_keyfiles);
Qgnutls_bootprop_keylist = intern_c_string (":keylist");
staticpro (&Qgnutls_bootprop_keylist);
Qgnutls_bootprop_crlfiles = intern_c_string (":crlfiles");
staticpro (&Qgnutls_bootprop_crlfiles);
Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
staticpro (&Qgnutls_bootprop_callbacks);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment