aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/emacs/ChangeLog4
-rw-r--r--doc/emacs/emacs.texi2
-rw-r--r--etc/NEWS23
-rw-r--r--lib-src/ChangeLog4
-rw-r--r--lib-src/emacsclient.c4
-rw-r--r--lisp/ChangeLog34
-rw-r--r--lisp/emacs-lisp/cl-extra.el14
-rw-r--r--lisp/emacs-lisp/cl.el54
-rw-r--r--lisp/emacs-lisp/derived.el2
-rw-r--r--lisp/emacs-lisp/easy-mmode.el6
-rw-r--r--lisp/files.el6
-rw-r--r--lisp/gnus/ChangeLog8
-rw-r--r--lisp/gnus/message.el6
-rw-r--r--lisp/international/mule-conf.el2
-rw-r--r--lisp/org/ChangeLog2
-rw-r--r--lisp/simple.el3
-rw-r--r--lisp/subr.el5
-rw-r--r--lisp/term/w32-win.el1
-rw-r--r--lisp/textmodes/reftex.el2
-rw-r--r--src/ChangeLog33
-rw-r--r--src/gnutls.c325
-rw-r--r--src/gnutls.h5
-rw-r--r--src/image.c2
-rw-r--r--src/process.c8
-rw-r--r--src/w32.c6
-rw-r--r--src/w32fns.c15
-rw-r--r--src/w32font.c4
-rw-r--r--src/w32reg.c7
28 files changed, 344 insertions, 243 deletions
diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog
index 4b51486069c..9a501d38375 100644
--- a/doc/emacs/ChangeLog
+++ b/doc/emacs/ChangeLog
@@ -1,3 +1,7 @@
12011-10-26 Juanma Barranquero <lekktu@gmail.com>
2
3 * emacs.texi (Top): Fix typo.
4
12011-10-25 Glenn Morris <rgm@gnu.org> 52011-10-25 Glenn Morris <rgm@gnu.org>
2 6
3 * abbrevs.texi (Saving Abbrevs): 7 * abbrevs.texi (Saving Abbrevs):
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index b25c09aa29d..55fdb9ec875 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -295,7 +295,7 @@ Help
295* Package Keywords:: Finding Lisp libraries by keywords (topics). 295* Package Keywords:: Finding Lisp libraries by keywords (topics).
296* Language Help:: Help relating to international language support. 296* Language Help:: Help relating to international language support.
297* Misc Help:: Other help commands. 297* Misc Help:: Other help commands.
298* Help Files:: Commands to display auxilliary help files. 298* Help Files:: Commands to display auxiliary help files.
299* Help Echo:: Help on active text and tooltips (`balloon help'). 299* Help Echo:: Help on active text and tooltips (`balloon help').
300 300
301The Mark and the Region 301The Mark and the Region
diff --git a/etc/NEWS b/etc/NEWS
index 58f3fa492e2..9e407133e8b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1218,15 +1218,22 @@ syntactic rules.
1218 1218
1219** frame-local variables cannot be let-bound any more. 1219** frame-local variables cannot be let-bound any more.
1220 1220
1221** Major and minor mode changes
1221+++ 1222+++
1222** prog-mode is a new major-mode meant to be the parent of programming mode. 1223*** `prog-mode' is a new major mode from which programming modes
1223The prog-mode-hook it defines can be used to enable features for 1224should be derived.
1224programming modes. For example:
1225(add-hook 'prog-mode-hook 'flyspell-prog-mode)
1226enables on the fly spell checking for comments and strings for
1227programming modes.
1228 1225
1229** define-minor-mode accepts a new keyword :variable. 1226**** `prog-mode-hook' can be used to enable features for programming
1227modes, e.g. (add-hook 'prog-mode-hook 'flyspell-prog-mode) to enable
1228on-the-fly spell checking for comments and strings.
1229
1230*** New hook `change-major-mode-after-body-hook', run by
1231`run-mode-hooks' just before any other mode hooks.
1232
1233*** Enabled globalized minor modes can be disabled in specific modes,
1234by running (FOO-mode-hook 0) via a mode hook.
1235
1236*** `define-minor-mode' accepts a new keyword :variable.
1230 1237
1231+++ 1238+++
1232** `delete-file' and `delete-directory' now accept optional arg TRASH. 1239** `delete-file' and `delete-directory' now accept optional arg TRASH.
@@ -1351,6 +1358,8 @@ with the USER_LIBS build variable.
1351 1358
1352** New make target `dist' to create binary distribution for MS Windows. 1359** New make target `dist' to create binary distribution for MS Windows.
1353 1360
1361** Function `w32-default-color-map' is now obsolete.
1362
1354** On Nextstep/OSX, the menu bar can be hidden by customizing 1363** On Nextstep/OSX, the menu bar can be hidden by customizing
1355ns-auto-hide-menu-bar. 1364ns-auto-hide-menu-bar.
1356 1365
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog
index 984c4d6c880..a8f9a0ac4be 100644
--- a/lib-src/ChangeLog
+++ b/lib-src/ChangeLog
@@ -1,3 +1,7 @@
12011-10-27 Juanma Barranquero <lekktu@gmail.com>
2
3 * emacsclient.c (w32_getenv): Silence compiler warnings.
4
12011-09-07 Glenn Morris <rgm@gnu.org> 52011-09-07 Glenn Morris <rgm@gnu.org>
2 6
3 * etags.c (Fortran_functions): Handle "elemental" functions. 7 * etags.c (Fortran_functions): Handle "elemental" functions.
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index ece9dc65c49..76aa21884de 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -359,7 +359,7 @@ w32_getenv (char *envvar)
359 char *value; 359 char *value;
360 DWORD dwType; 360 DWORD dwType;
361 361
362 if (value = getenv (envvar)) 362 if ((value = getenv (envvar)))
363 /* Found in the environment. strdup it, because values returned 363 /* Found in the environment. strdup it, because values returned
364 by getenv cannot be free'd. */ 364 by getenv cannot be free'd. */
365 return xstrdup (value); 365 return xstrdup (value);
@@ -382,7 +382,7 @@ w32_getenv (char *envvar)
382 { 382 {
383 DWORD size; 383 DWORD size;
384 384
385 if (size = ExpandEnvironmentStrings (value, NULL, 0)) 385 if ((size = ExpandEnvironmentStrings (value, NULL, 0)))
386 { 386 {
387 char *buffer = (char *) xmalloc (size); 387 char *buffer = (char *) xmalloc (size);
388 if (ExpandEnvironmentStrings (value, buffer, size)) 388 if (ExpandEnvironmentStrings (value, buffer, size))
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 88248f00559..6aa1bddb9f3 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,37 @@
12011-10-27 Glenn Morris <rgm@gnu.org>
2
3 * emacs-lisp/cl-extra.el (most-positive-float, most-negative-float)
4 (least-positive-float, least-negative-float)
5 (least-positive-normalized-float, least-negative-normalized-float)
6 (float-epsilon, float-negative-epsilon):
7 Remove unnecessary declarations.
8
9 * emacs-lisp/cl-extra.el (cl-float-limits): Add doc string.
10 * emacs-lisp/cl.el (most-positive-float, most-negative-float)
11 (least-positive-float, least-negative-float)
12 (least-positive-normalized-float, least-negative-normalized-float)
13 (float-epsilon, float-negative-epsilon): Add doc-strings,
14 based on those in cl.texi.
15
16 * files.el (set-visited-file-name): If the major-mode changed,
17 reload the local variables. (Bug#9796)
18
192011-10-27 Chong Yidong <cyd@gnu.org>
20
21 * subr.el (change-major-mode-after-body-hook): New hook.
22 (run-mode-hooks): Run it.
23
24 * emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Use
25 change-major-mode-before-body-hook.
26
27 * simple.el (fundamental-mode):
28 * emacs-lisp/derived.el (define-derived-mode): Revert 2010-04-28
29 change introducing fundamental-mode-hook.
30
312011-10-26 Juanma Barranquero <lekktu@gmail.com>
32
33 * term/w32-win.el (w32-default-color-map): Declare obsolete. (Bug#9785)
34
12011-10-26 Michael Albinus <michael.albinus@gmx.de> 352011-10-26 Michael Albinus <michael.albinus@gmx.de>
2 36
3 * ido.el (ido-file-name-all-completions-1): Do not require 37 * ido.el (ido-file-name-all-completions-1): Do not require
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 7468a0237cf..8ea58b2e07c 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -480,17 +480,13 @@ If STATE is t, return a new state object seeded from the time of day."
480 (and (numberp res) (/= res (/ res 2)) res)) 480 (and (numberp res) (/= res (/ res 2)) res))
481 (arith-error nil))) 481 (arith-error nil)))
482 482
483(defvar most-positive-float)
484(defvar most-negative-float)
485(defvar least-positive-float)
486(defvar least-negative-float)
487(defvar least-positive-normalized-float)
488(defvar least-negative-normalized-float)
489(defvar float-epsilon)
490(defvar float-negative-epsilon)
491
492;;;###autoload 483;;;###autoload
493(defun cl-float-limits () 484(defun cl-float-limits ()
485 "Initialize the Common Lisp floating-point parameters.
486This sets the values of: `most-positive-float', `most-negative-float',
487`least-positive-float', `least-negative-float', `float-epsilon',
488`float-negative-epsilon', `least-positive-normalized-float', and
489`least-negative-normalized-float'."
494 (or most-positive-float (not (numberp '2e1)) 490 (or most-positive-float (not (numberp '2e1))
495 (let ((x '2e0) y z) 491 (let ((x '2e0) y z)
496 ;; Find maximum exponent (first two loops are optimizations) 492 ;; Find maximum exponent (first two loops are optimizations)
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 526475eb1bd..0b34e9f27f7 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -333,15 +333,51 @@ always returns nil."
333 333
334(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) 334(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
335 335
336;; The following are actually set by cl-float-limits. 336(defconst most-positive-float nil
337(defconst most-positive-float nil) 337 "The largest value that a Lisp float can hold.
338(defconst most-negative-float nil) 338If your system supports infinities, this is the largest finite value.
339(defconst least-positive-float nil) 339For IEEE machines, this is approximately 1.79e+308.
340(defconst least-negative-float nil) 340Call `cl-float-limits' to set this.")
341(defconst least-positive-normalized-float nil) 341
342(defconst least-negative-normalized-float nil) 342(defconst most-negative-float nil
343(defconst float-epsilon nil) 343 "The largest negative value that a Lisp float can hold.
344(defconst float-negative-epsilon nil) 344This is simply -`most-negative-float'.
345Call `cl-float-limits' to set this.")
346
347(defconst least-positive-float nil
348 "The smallest value greater than zero that a Lisp float can hold.
349For IEEE machines, it is about 4.94e-324 if denormals are supported,
350or 2.22e-308 if they are not.
351Call `cl-float-limits' to set this.")
352
353(defconst least-negative-float nil
354 "The smallest value less than zero that a Lisp float can hold.
355This is simply -`least-positive-float'.
356Call `cl-float-limits' to set this.")
357
358(defconst least-positive-normalized-float nil
359 "The smallest normalized Lisp float greater than zero.
360This is the smallest value for which IEEE denormalization does not lose
361precision. For IEEE machines, this value is about 2.22e-308.
362For machines that do not support the concept of denormalization
363and gradual underflow, this constant equals `least-positive-float'.
364Call `cl-float-limits' to set this.")
365
366(defconst least-negative-normalized-float nil
367 "The smallest normalized Lisp float less than zero.
368This is simply -`least-positive-normalized-float'.
369Call `cl-float-limits' to set this.")
370
371(defconst float-epsilon nil
372 "The smallest positive float that adds to 1.0 to give a distinct value.
373Adding a number less than this to 1.0 returns 1.0 due to roundoff.
374For IEEE machines, epsilon is about 2.22e-16.
375Call `cl-float-limits' to set this.")
376
377(defconst float-negative-epsilon nil
378 "The smallest positive float that subtracts from 1.0 to give a distinct value.
379For IEEE machines, it is about 1.11e-16.
380Call `cl-float-limits' to set this.")
345 381
346 382
347;;; Sequence functions. 383;;; Sequence functions.
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 81932f9940a..55ea102ed2a 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -230,7 +230,7 @@ No problems result if this variable is not bound.
230 ; Run the parent. 230 ; Run the parent.
231 (delay-mode-hooks 231 (delay-mode-hooks
232 232
233 (,(or parent 'fundamental-mode)) 233 (,(or parent 'kill-all-local-variables))
234 ; Identify the child mode. 234 ; Identify the child mode.
235 (setq major-mode (quote ,child)) 235 (setq major-mode (quote ,child))
236 (setq mode-name ,name) 236 (setq mode-name ,name)
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 4b6f4d634ca..bf9f2c9d6ed 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -368,11 +368,13 @@ See `%s' for more information on %s."
368 (progn 368 (progn
369 (add-hook 'after-change-major-mode-hook 369 (add-hook 'after-change-major-mode-hook
370 ',MODE-enable-in-buffers) 370 ',MODE-enable-in-buffers)
371 (add-hook 'fundamental-mode-hook ',MODE-enable-in-buffers) 371 (add-hook 'change-major-mode-after-body-hook
372 ',MODE-enable-in-buffers)
372 (add-hook 'find-file-hook ',MODE-check-buffers) 373 (add-hook 'find-file-hook ',MODE-check-buffers)
373 (add-hook 'change-major-mode-hook ',MODE-cmhh)) 374 (add-hook 'change-major-mode-hook ',MODE-cmhh))
374 (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers) 375 (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
375 (remove-hook 'fundamental-mode-hook ',MODE-enable-in-buffers) 376 (remove-hook 'change-major-mode-after-body-hook
377 ',MODE-enable-in-buffers)
376 (remove-hook 'find-file-hook ',MODE-check-buffers) 378 (remove-hook 'find-file-hook ',MODE-check-buffers)
377 (remove-hook 'change-major-mode-hook ',MODE-cmhh)) 379 (remove-hook 'change-major-mode-hook ',MODE-cmhh))
378 380
diff --git a/lisp/files.el b/lisp/files.el
index 3ed9bd5a272..40e2df14c1b 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3682,7 +3682,11 @@ the old visited file has been renamed to the new name FILENAME."
3682 (get major-mode 'mode-class) 3682 (get major-mode 'mode-class)
3683 ;; Don't change the mode if the local variable list specifies it. 3683 ;; Don't change the mode if the local variable list specifies it.
3684 (hack-local-variables t) 3684 (hack-local-variables t)
3685 (set-auto-mode t)) 3685 ;; TODO consider making normal-mode handle this case.
3686 (let ((old major-mode))
3687 (set-auto-mode t)
3688 (or (eq old major-mode)
3689 (hack-local-variables))))
3686 (error nil))) 3690 (error nil)))
3687 3691
3688(defun write-file (filename &optional confirm) 3692(defun write-file (filename &optional confirm)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 8b4e993149e..7519252f037 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,9 @@
12011-10-26 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * message.el (message-completion-function): Make sure
4 message-tab-body-function is not attempted if one of
5 message-completion-alist fails to find a completion (bug#9158).
6
12011-10-26 Daiki Ueno <ueno@unixuser.org> 72011-10-26 Daiki Ueno <ueno@unixuser.org>
2 8
3 * mml.el (mml-quote-region): Quote <#secure> tag. 9 * mml.el (mml-quote-region): Quote <#secure> tag.
@@ -7,7 +13,7 @@
7 13
8 * gnus-cite.el (gnus-message-citation-mode): Doc fix (in Emacs 24, 14 * gnus-cite.el (gnus-message-citation-mode): Doc fix (in Emacs 24,
9 calling a minor mode from Lisp with nil arg enables it, so we have to 15 calling a minor mode from Lisp with nil arg enables it, so we have to
10 make the working a bit ambiguous here). 16 make the wording a bit ambiguous here).
11 17
122011-10-18 Teodor Zlatanov <tzz@lifelogs.com> 182011-10-18 Teodor Zlatanov <tzz@lifelogs.com>
13 19
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 948892d1e13..723f8fb72b5 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -7888,7 +7888,11 @@ those headers."
7888 (let ((mail-abbrev-mode-regexp (caar alist))) 7888 (let ((mail-abbrev-mode-regexp (caar alist)))
7889 (not (mail-abbrev-in-expansion-header-p)))) 7889 (not (mail-abbrev-in-expansion-header-p))))
7890 (setq alist (cdr alist))) 7890 (setq alist (cdr alist)))
7891 (cdar alist))) 7891 (when (cdar alist)
7892 (lexical-let ((fun (cdar alist)))
7893 ;; Even if completion fails, return a non-nil value, so as to avoid
7894 ;; falling back to message-tab-body-function.
7895 (lambda () (funcall fun) 'completion-attempted)))))
7892 7896
7893(eval-and-compile 7897(eval-and-compile
7894 (condition-case nil 7898 (condition-case nil
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 9ba95e4d11a..870f2bece28 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -708,7 +708,7 @@
708(define-charset-alias 'cp866u 'cp1125) 708(define-charset-alias 'cp866u 'cp1125)
709 709
710;; Fixme: C.f. iconv, http://czyborra.com/charsets/codepages.html 710;; Fixme: C.f. iconv, http://czyborra.com/charsets/codepages.html
711;; shows this as not ASCII comptaible, with various graphics in 711;; shows this as not ASCII compatible, with various graphics in
712;; 0x01-0x1F. 712;; 0x01-0x1F.
713(define-charset 'cp437 713(define-charset 'cp437
714 "CP437 (MS-DOS United States, Australia, New Zealand, South Africa)" 714 "CP437 (MS-DOS United States, Australia, New Zealand, South Africa)"
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog
index 9fbeb9f1882..ae150621dc0 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog
@@ -1871,7 +1871,7 @@
1871 1871
1872 * org-list.el (org-list-separating-blank-lines-number): Fix 1872 * org-list.el (org-list-separating-blank-lines-number): Fix
1873 confusion between point and item beginning. Now, if no 1873 confusion between point and item beginning. Now, if no
1874 information is avalaible, truly follow user preference when it 1874 information is available, truly follow user preference when it
1875 inserts blank lines manually. 1875 inserts blank lines manually.
1876 (org-list-insert-item): Send correct argument to the preceding 1876 (org-list-insert-item): Send correct argument to the preceding
1877 function. 1877 function.
diff --git a/lisp/simple.el b/lisp/simple.el
index 79de6aea3dd..90d22c817b0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -349,7 +349,8 @@ location."
349Other major modes are defined by comparison with this one." 349Other major modes are defined by comparison with this one."
350 (interactive) 350 (interactive)
351 (kill-all-local-variables) 351 (kill-all-local-variables)
352 (run-mode-hooks 'fundamental-mode-hook)) 352 (unless delay-mode-hooks
353 (run-hooks 'after-change-major-mode-hook)))
353 354
354;; Special major modes to view specially formatted data rather than files. 355;; Special major modes to view specially formatted data rather than files.
355 356
diff --git a/lisp/subr.el b/lisp/subr.el
index 7ac287d2473..f3cd4dabe20 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1530,6 +1530,9 @@ if it is empty or a duplicate."
1530(make-variable-buffer-local 'delayed-mode-hooks) 1530(make-variable-buffer-local 'delayed-mode-hooks)
1531(put 'delay-mode-hooks 'permanent-local t) 1531(put 'delay-mode-hooks 'permanent-local t)
1532 1532
1533(defvar change-major-mode-after-body-hook nil
1534 "Normal hook run in major mode functions, before the mode hooks.")
1535
1533(defvar after-change-major-mode-hook nil 1536(defvar after-change-major-mode-hook nil
1534 "Normal hook run at the very end of major mode functions.") 1537 "Normal hook run at the very end of major mode functions.")
1535 1538
@@ -1546,7 +1549,7 @@ FOO-mode-hook."
1546 ;; Normal case, just run the hook as before plus any delayed hooks. 1549 ;; Normal case, just run the hook as before plus any delayed hooks.
1547 (setq hooks (nconc (nreverse delayed-mode-hooks) hooks)) 1550 (setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
1548 (setq delayed-mode-hooks nil) 1551 (setq delayed-mode-hooks nil)
1549 (apply 'run-hooks hooks) 1552 (apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks))
1550 (run-hooks 'after-change-major-mode-hook))) 1553 (run-hooks 'after-change-major-mode-hook)))
1551 1554
1552(defmacro delay-mode-hooks (&rest body) 1555(defmacro delay-mode-hooks (&rest body)
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index e4bf031d422..b7f2a69e77b 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -85,6 +85,7 @@
85(define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1") 85(define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1")
86 86
87(defvar w32-color-map) ;; defined in w32fns.c 87(defvar w32-color-map) ;; defined in w32fns.c
88(make-obsolete 'w32-default-color-map nil "24.1")
88 89
89(declare-function w32-send-sys-command "w32fns.c") 90(declare-function w32-send-sys-command "w32fns.c")
90(declare-function set-message-beep "w32console.c") 91(declare-function set-message-beep "w32console.c")
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index 6f6993980db..cef8a3d1548 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -1522,7 +1522,7 @@ Valid actions are: readable, restore, read, kill, write."
1522;;; (while all 1522;;; (while all
1523;;; (when (and (eq (car (car all)) 'bof) 1523;;; (when (and (eq (car (car all)) 'bof)
1524;;; (not (file-regular-p (nth 1 (car all))))) 1524;;; (not (file-regular-p (nth 1 (car all)))))
1525;;; (message "File %s in saved parse info not avalable" (cdr (car all))) 1525;;; (message "File %s in saved parse info not available" (cdr (car all)))
1526;;; (error "File not found")) 1526;;; (error "File not found"))
1527;;; (setq all (cdr all)))) 1527;;; (setq all (cdr all))))
1528 ) 1528 )
diff --git a/src/ChangeLog b/src/ChangeLog
index 854c4987be5..c3926f6024b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,36 @@
12011-10-27 Chong Yidong <cyd@gnu.org>
2
3 * process.c (make_process): Set gnutls_state to NULL.
4
5 * gnutls.c (emacs_gnutls_deinit): Deinit the gnutls_state if it is
6 non-NULL, regardless of GNUTLS_INITSTAGE.
7 (Fgnutls_boot): Cleanups. Call emacs_gnutls_deinit if we signal
8 an error. Set process slots as soon as we allocate them.
9
10 * gnutls.h (GNUTLS_LOG, GNUTLS_LOG2): Fix macros.
11
122011-10-27 Chong Yidong <cyd@gnu.org>
13
14 * gnutls.c (emacs_gnutls_deinit): New function. Deallocate
15 credentials structures as well as calling gnutls_deinit.
16 (Fgnutls_deinit, Fgnutls_boot): Use it.
17
18 * process.c (make_process): Initialize GnuTLS credentials to NULL.
19 (deactivate_process): Call emacs_gnutls_deinit.
20
212011-10-27 Juanma Barranquero <lekktu@gmail.com>
22
23 * image.c (x_create_x_image_and_pixmap):
24 * w32.c (sys_rename, w32_delayed_load):
25 * w32font.c (fill_in_logfont):
26 * w32reg.c (x_get_string_resource): Silence compiler warnings.
27
282011-10-26 Juanma Barranquero <lekktu@gmail.com>
29
30 * w32fns.c (w32_default_color_map): New function,
31 extracted from Fw32_default_color_map.
32 (Fw32_default_color_map, Fx_open_connection): Use it. (Bug#9785)
33
12011-10-25 Paul Eggert <eggert@cs.ucla.edu> 342011-10-25 Paul Eggert <eggert@cs.ucla.edu>
2 35
3 * dispextern.h (Fcontrolling_tty_p): New decl (Bug#6649 part 2). 36 * dispextern.h (Fcontrolling_tty_p): New decl (Bug#6649 part 2).
diff --git a/src/gnutls.c b/src/gnutls.c
index 0743ef3f4ee..500f09432b1 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -464,6 +464,44 @@ gnutls_make_error (int err)
464 return make_number (err); 464 return make_number (err);
465} 465}
466 466
467Lisp_Object
468emacs_gnutls_deinit (Lisp_Object proc)
469{
470 int log_level;
471
472 CHECK_PROCESS (proc);
473
474 if (XPROCESS (proc)->gnutls_p == 0)
475 return Qnil;
476
477 log_level = XPROCESS (proc)->gnutls_log_level;
478
479 if (XPROCESS (proc)->gnutls_x509_cred)
480 {
481 GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
482 fn_gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
483 XPROCESS (proc)->gnutls_x509_cred = NULL;
484 }
485
486 if (XPROCESS (proc)->gnutls_anon_cred)
487 {
488 GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
489 fn_gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
490 XPROCESS (proc)->gnutls_anon_cred = NULL;
491 }
492
493 if (XPROCESS (proc)->gnutls_state)
494 {
495 fn_gnutls_deinit (XPROCESS (proc)->gnutls_state);
496 XPROCESS (proc)->gnutls_state = NULL;
497 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
498 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
499 }
500
501 XPROCESS (proc)->gnutls_p = 0;
502 return Qt;
503}
504
467DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0, 505DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
468 doc: /* Return the GnuTLS init stage of process PROC. 506 doc: /* Return the GnuTLS init stage of process PROC.
469See also `gnutls-boot'. */) 507See also `gnutls-boot'. */)
@@ -551,18 +589,7 @@ DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
551See also `gnutls-init'. */) 589See also `gnutls-init'. */)
552 (Lisp_Object proc) 590 (Lisp_Object proc)
553{ 591{
554 gnutls_session_t state; 592 return emacs_gnutls_deinit (proc);
555
556 CHECK_PROCESS (proc);
557 state = XPROCESS (proc)->gnutls_state;
558
559 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
560 {
561 fn_gnutls_deinit (state);
562 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
563 }
564
565 return Qt;
566} 593}
567 594
568DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, 595DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
@@ -622,7 +649,7 @@ emacs_gnutls_global_deinit (void)
622 649
623DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0, 650DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
624 doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST. 651 doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
625Currently only client mode is supported. Returns a success/failure 652Currently only client mode is supported. Return a success/failure
626value you can check with `gnutls-errorp'. 653value you can check with `gnutls-errorp'.
627 654
628TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'. 655TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
@@ -673,23 +700,13 @@ one trustfile (usually a CA bundle). */)
673 (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist) 700 (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
674{ 701{
675 int ret = GNUTLS_E_SUCCESS; 702 int ret = GNUTLS_E_SUCCESS;
676
677 int max_log_level = 0; 703 int max_log_level = 0;
678 704
679 /* TODO: GNUTLS_X509_FMT_DER is also an option. */
680 int file_format = GNUTLS_X509_FMT_PEM;
681
682 unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
683 gnutls_x509_crt_t gnutls_verify_cert;
684 unsigned int gnutls_verify_cert_list_size;
685 const gnutls_datum_t *gnutls_verify_cert_list;
686
687 gnutls_session_t state; 705 gnutls_session_t state;
688 gnutls_certificate_credentials_t x509_cred; 706 gnutls_certificate_credentials_t x509_cred = NULL;
689 gnutls_anon_client_credentials_t anon_cred; 707 gnutls_anon_client_credentials_t anon_cred = NULL;
690 Lisp_Object global_init; 708 Lisp_Object global_init;
691 char const *priority_string_ptr = "NORMAL"; /* default priority string. */ 709 char const *priority_string_ptr = "NORMAL"; /* default priority string. */
692 Lisp_Object tail;
693 unsigned int peer_verification; 710 unsigned int peer_verification;
694 char* c_hostname; 711 char* c_hostname;
695 712
@@ -701,7 +718,6 @@ one trustfile (usually a CA bundle). */)
701 /* Lisp_Object callbacks; */ 718 /* Lisp_Object callbacks; */
702 Lisp_Object loglevel; 719 Lisp_Object loglevel;
703 Lisp_Object hostname; 720 Lisp_Object hostname;
704 Lisp_Object verify_flags;
705 /* Lisp_Object verify_error; */ 721 /* Lisp_Object verify_error; */
706 Lisp_Object verify_hostname_error; 722 Lisp_Object verify_hostname_error;
707 Lisp_Object prime_bits; 723 Lisp_Object prime_bits;
@@ -716,26 +732,25 @@ one trustfile (usually a CA bundle). */)
716 return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED); 732 return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
717 } 733 }
718 734
735 if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
736 {
737 error ("Invalid GnuTLS credential type");
738 return gnutls_make_error (GNUTLS_EMACS_ERROR_INVALID_TYPE);
739 }
740
719 hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname); 741 hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname);
720 priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority); 742 priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority);
721 trustfiles = Fplist_get (proplist, QCgnutls_bootprop_trustfiles); 743 trustfiles = Fplist_get (proplist, QCgnutls_bootprop_trustfiles);
722 keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist); 744 keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist);
723 crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles); 745 crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);
724 /* callbacks = Fplist_get (proplist, QCgnutls_bootprop_callbacks); */
725 loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel); 746 loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel);
726 verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
727 /* verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error); */
728 verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error); 747 verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error);
729 prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits); 748 prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);
730 749
731 if (!STRINGP (hostname)) 750 if (!STRINGP (hostname))
732 error ("gnutls-boot: invalid :hostname parameter"); 751 error ("gnutls-boot: invalid :hostname parameter");
733
734 c_hostname = SSDATA (hostname); 752 c_hostname = SSDATA (hostname);
735 753
736 state = XPROCESS (proc)->gnutls_state;
737 XPROCESS (proc)->gnutls_p = 1;
738
739 if (NUMBERP (loglevel)) 754 if (NUMBERP (loglevel))
740 { 755 {
741 fn_gnutls_global_set_log_function (gnutls_log_function); 756 fn_gnutls_global_set_log_function (gnutls_log_function);
@@ -749,82 +764,56 @@ one trustfile (usually a CA bundle). */)
749 if (! NILP (Fgnutls_errorp (global_init))) 764 if (! NILP (Fgnutls_errorp (global_init)))
750 return global_init; 765 return global_init;
751 766
752 /* deinit and free resources. */ 767 /* Before allocating new credentials, deallocate any credentials
753 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_CRED_ALLOC) 768 that PROC might already have. */
754 { 769 emacs_gnutls_deinit (proc);
755 GNUTLS_LOG (1, max_log_level, "deallocating credentials");
756
757 if (EQ (type, Qgnutls_x509pki))
758 {
759 GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
760 x509_cred = XPROCESS (proc)->gnutls_x509_cred;
761 fn_gnutls_certificate_free_credentials (x509_cred);
762 }
763 else if (EQ (type, Qgnutls_anon))
764 {
765 GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
766 anon_cred = XPROCESS (proc)->gnutls_anon_cred;
767 fn_gnutls_anon_free_client_credentials (anon_cred);
768 }
769 else
770 {
771 error ("unknown credential type");
772 ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
773 }
774
775 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
776 {
777 GNUTLS_LOG (1, max_log_level, "deallocating x509 credentials");
778 Fgnutls_deinit (proc);
779 }
780 }
781 770
771 /* Mark PROC as a GnuTLS process. */
772 XPROCESS (proc)->gnutls_p = 1;
773 XPROCESS (proc)->gnutls_state = NULL;
774 XPROCESS (proc)->gnutls_x509_cred = NULL;
775 XPROCESS (proc)->gnutls_anon_cred = NULL;
776 XPROCESS (proc)->gnutls_cred_type = type;
782 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY; 777 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
783 778
784 GNUTLS_LOG (1, max_log_level, "allocating credentials"); 779 GNUTLS_LOG (1, max_log_level, "allocating credentials");
785
786 if (EQ (type, Qgnutls_x509pki)) 780 if (EQ (type, Qgnutls_x509pki))
787 { 781 {
782 Lisp_Object verify_flags;
783 unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
784
788 GNUTLS_LOG (2, max_log_level, "allocating x509 credentials"); 785 GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
789 x509_cred = XPROCESS (proc)->gnutls_x509_cred;
790 fn_gnutls_certificate_allocate_credentials (&x509_cred); 786 fn_gnutls_certificate_allocate_credentials (&x509_cred);
787 XPROCESS (proc)->gnutls_x509_cred = x509_cred;
791 788
789 verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
792 if (NUMBERP (verify_flags)) 790 if (NUMBERP (verify_flags))
793 { 791 {
794 gnutls_verify_flags = XINT (verify_flags); 792 gnutls_verify_flags = XINT (verify_flags);
795 GNUTLS_LOG (2, max_log_level, "setting verification flags"); 793 GNUTLS_LOG (2, max_log_level, "setting verification flags");
796 } 794 }
797 else if (NILP (verify_flags)) 795 else if (NILP (verify_flags))
798 { 796 GNUTLS_LOG (2, max_log_level, "using default verification flags");
799 /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */
800 GNUTLS_LOG (2, max_log_level, "using default verification flags");
801 }
802 else 797 else
803 { 798 GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
804 /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */ 799
805 GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
806 }
807 fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags); 800 fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
808 } 801 }
809 else if (EQ (type, Qgnutls_anon)) 802 else /* Qgnutls_anon: */
810 { 803 {
811 GNUTLS_LOG (2, max_log_level, "allocating anon credentials"); 804 GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
812 anon_cred = XPROCESS (proc)->gnutls_anon_cred;
813 fn_gnutls_anon_allocate_client_credentials (&anon_cred); 805 fn_gnutls_anon_allocate_client_credentials (&anon_cred);
814 } 806 XPROCESS (proc)->gnutls_anon_cred = anon_cred;
815 else
816 {
817 error ("unknown credential type");
818 ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
819 } 807 }
820 808
821 if (ret < GNUTLS_E_SUCCESS)
822 return gnutls_make_error (ret);
823
824 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC; 809 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
825 810
826 if (EQ (type, Qgnutls_x509pki)) 811 if (EQ (type, Qgnutls_x509pki))
827 { 812 {
813 /* TODO: GNUTLS_X509_FMT_DER is also an option. */
814 int file_format = GNUTLS_X509_FMT_PEM;
815 Lisp_Object tail;
816
828 for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail)) 817 for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
829 { 818 {
830 Lisp_Object trustfile = Fcar (tail); 819 Lisp_Object trustfile = Fcar (tail);
@@ -842,8 +831,8 @@ one trustfile (usually a CA bundle). */)
842 } 831 }
843 else 832 else
844 { 833 {
845 error ("Sorry, GnuTLS can't use non-string trustfile %s", 834 emacs_gnutls_deinit (proc);
846 SDATA (trustfile)); 835 error ("Invalid trustfile");
847 } 836 }
848 } 837 }
849 838
@@ -855,17 +844,15 @@ one trustfile (usually a CA bundle). */)
855 GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ", 844 GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
856 SSDATA (crlfile)); 845 SSDATA (crlfile));
857 ret = fn_gnutls_certificate_set_x509_crl_file 846 ret = fn_gnutls_certificate_set_x509_crl_file
858 (x509_cred, 847 (x509_cred, SSDATA (crlfile), file_format);
859 SSDATA (crlfile),
860 file_format);
861 848
862 if (ret < GNUTLS_E_SUCCESS) 849 if (ret < GNUTLS_E_SUCCESS)
863 return gnutls_make_error (ret); 850 return gnutls_make_error (ret);
864 } 851 }
865 else 852 else
866 { 853 {
867 error ("Sorry, GnuTLS can't use non-string CRL file %s", 854 emacs_gnutls_deinit (proc);
868 SDATA (crlfile)); 855 error ("Invalid CRL file");
869 } 856 }
870 } 857 }
871 858
@@ -880,45 +867,31 @@ one trustfile (usually a CA bundle). */)
880 GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ", 867 GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
881 SSDATA (certfile)); 868 SSDATA (certfile));
882 ret = fn_gnutls_certificate_set_x509_key_file 869 ret = fn_gnutls_certificate_set_x509_key_file
883 (x509_cred, 870 (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
884 SSDATA (certfile),
885 SSDATA (keyfile),
886 file_format);
887 871
888 if (ret < GNUTLS_E_SUCCESS) 872 if (ret < GNUTLS_E_SUCCESS)
889 return gnutls_make_error (ret); 873 return gnutls_make_error (ret);
890 } 874 }
891 else 875 else
892 { 876 {
893 if (STRINGP (keyfile)) 877 emacs_gnutls_deinit (proc);
894 error ("Sorry, GnuTLS can't use non-string client cert file %s", 878 error (STRINGP (keyfile) ? "Invalid client cert file"
895 SDATA (certfile)); 879 : "Invalid client key file");
896 else
897 error ("Sorry, GnuTLS can't use non-string client key file %s",
898 SDATA (keyfile));
899 } 880 }
900 } 881 }
901 } 882 }
902 883
903 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES; 884 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
904
905 GNUTLS_LOG (1, max_log_level, "gnutls callbacks"); 885 GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
906
907 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS; 886 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
908 887
909#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY 888 /* Call gnutls_init here: */
910#else
911#endif
912 889
913 GNUTLS_LOG (1, max_log_level, "gnutls_init"); 890 GNUTLS_LOG (1, max_log_level, "gnutls_init");
914
915 ret = fn_gnutls_init (&state, GNUTLS_CLIENT); 891 ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
916 892 XPROCESS (proc)->gnutls_state = state;
917 if (ret < GNUTLS_E_SUCCESS) 893 if (ret < GNUTLS_E_SUCCESS)
918 return gnutls_make_error (ret); 894 return gnutls_make_error (ret);
919
920 XPROCESS (proc)->gnutls_state = state;
921
922 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT; 895 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
923 896
924 if (STRINGP (priority_string)) 897 if (STRINGP (priority_string))
@@ -934,46 +907,25 @@ one trustfile (usually a CA bundle). */)
934 } 907 }
935 908
936 GNUTLS_LOG (1, max_log_level, "setting the priority string"); 909 GNUTLS_LOG (1, max_log_level, "setting the priority string");
937
938 ret = fn_gnutls_priority_set_direct (state, 910 ret = fn_gnutls_priority_set_direct (state,
939 priority_string_ptr, 911 priority_string_ptr,
940 NULL); 912 NULL);
941
942 if (ret < GNUTLS_E_SUCCESS) 913 if (ret < GNUTLS_E_SUCCESS)
943 return gnutls_make_error (ret); 914 return gnutls_make_error (ret);
944 915
945 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY; 916 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
946 917
947 if (!EQ (prime_bits, Qnil)) 918 if (INTEGERP (prime_bits))
948 { 919 fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
949 fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
950 }
951
952 if (EQ (type, Qgnutls_x509pki))
953 {
954 ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
955 }
956 else if (EQ (type, Qgnutls_anon))
957 {
958 ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
959 }
960 else
961 {
962 error ("unknown credential type");
963 ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
964 }
965 920
921 ret = EQ (type, Qgnutls_x509pki)
922 ? fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
923 : fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
966 if (ret < GNUTLS_E_SUCCESS) 924 if (ret < GNUTLS_E_SUCCESS)
967 return gnutls_make_error (ret); 925 return gnutls_make_error (ret);
968 926
969 XPROCESS (proc)->gnutls_anon_cred = anon_cred;
970 XPROCESS (proc)->gnutls_x509_cred = x509_cred;
971 XPROCESS (proc)->gnutls_cred_type = type;
972
973 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET; 927 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
974
975 ret = emacs_gnutls_handshake (XPROCESS (proc)); 928 ret = emacs_gnutls_handshake (XPROCESS (proc));
976
977 if (ret < GNUTLS_E_SUCCESS) 929 if (ret < GNUTLS_E_SUCCESS)
978 return gnutls_make_error (ret); 930 return gnutls_make_error (ret);
979 931
@@ -984,69 +936,71 @@ one trustfile (usually a CA bundle). */)
984 gnutls_x509_crt_check_hostname() against :hostname. */ 936 gnutls_x509_crt_check_hostname() against :hostname. */
985 937
986 ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification); 938 ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
987
988 if (ret < GNUTLS_E_SUCCESS) 939 if (ret < GNUTLS_E_SUCCESS)
989 return gnutls_make_error (ret); 940 return gnutls_make_error (ret);
990 941
991 if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID) 942 if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
992 message ("%s certificate could not be verified.", 943 message ("%s certificate could not be verified.", c_hostname);
993 c_hostname); 944
994 945 if (peer_verification & GNUTLS_CERT_REVOKED)
995 if (peer_verification & GNUTLS_CERT_REVOKED) 946 GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
996 GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):", 947 c_hostname);
997 c_hostname); 948
998 949 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
999 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND) 950 GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
1000 GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:", 951 c_hostname);
1001 c_hostname); 952
1002 953 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
1003 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA) 954 GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
1004 GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:", 955 c_hostname);
1005 c_hostname); 956
1006 957 if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
1007 if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM) 958 GNUTLS_LOG2 (1, max_log_level,
1008 GNUTLS_LOG2 (1, max_log_level, 959 "certificate was signed with an insecure algorithm:",
1009 "certificate was signed with an insecure algorithm:", 960 c_hostname);
1010 c_hostname); 961
1011 962 if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
1012 if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED) 963 GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
1013 GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:", 964 c_hostname);
1014 c_hostname); 965
1015 966 if (peer_verification & GNUTLS_CERT_EXPIRED)
1016 if (peer_verification & GNUTLS_CERT_EXPIRED) 967 GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
1017 GNUTLS_LOG2 (1, max_log_level, "certificate has expired:", 968 c_hostname);
1018 c_hostname); 969
1019 970 if (peer_verification != 0)
1020 if (peer_verification != 0) 971 {
1021 { 972 if (NILP (verify_hostname_error))
1022 if (NILP (verify_hostname_error)) 973 GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
1023 { 974 c_hostname);
1024 GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:", 975 else
1025 c_hostname); 976 {
1026 } 977 emacs_gnutls_deinit (proc);
1027 else 978 error ("Certificate validation failed %s, verification code %d",
1028 { 979 c_hostname, peer_verification);
1029 error ("Certificate validation failed %s, verification code %d", 980 }
1030 c_hostname, peer_verification); 981 }
1031 }
1032 }
1033 982
1034 /* Up to here the process is the same for X.509 certificates and 983 /* Up to here the process is the same for X.509 certificates and
1035 OpenPGP keys. From now on X.509 certificates are assumed. This 984 OpenPGP keys. From now on X.509 certificates are assumed. This
1036 can be easily extended to work with openpgp keys as well. */ 985 can be easily extended to work with openpgp keys as well. */
1037 if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509) 986 if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
1038 { 987 {
1039 ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert); 988 gnutls_x509_crt_t gnutls_verify_cert;
989 const gnutls_datum_t *gnutls_verify_cert_list;
990 unsigned int gnutls_verify_cert_list_size;
1040 991
992 ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
1041 if (ret < GNUTLS_E_SUCCESS) 993 if (ret < GNUTLS_E_SUCCESS)
1042 return gnutls_make_error (ret); 994 return gnutls_make_error (ret);
1043 995
1044 gnutls_verify_cert_list = 996 gnutls_verify_cert_list =
1045 fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size); 997 fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
1046 998
1047 if (NULL == gnutls_verify_cert_list) 999 if (gnutls_verify_cert_list == NULL)
1048 { 1000 {
1049 error ("No x509 certificate was found!\n"); 1001 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1002 emacs_gnutls_deinit (proc);
1003 error ("No x509 certificate was found\n");
1050 } 1004 }
1051 1005
1052 /* We only check the first certificate in the given chain. */ 1006 /* We only check the first certificate in the given chain. */
@@ -1063,18 +1017,15 @@ one trustfile (usually a CA bundle). */)
1063 if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname)) 1017 if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
1064 { 1018 {
1065 if (NILP (verify_hostname_error)) 1019 if (NILP (verify_hostname_error))
1066 { 1020 GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
1067 GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:", 1021 c_hostname);
1068 c_hostname);
1069 }
1070 else 1022 else
1071 { 1023 {
1072 fn_gnutls_x509_crt_deinit (gnutls_verify_cert); 1024 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1073 error ("The x509 certificate does not match \"%s\"", 1025 emacs_gnutls_deinit (proc);
1074 c_hostname); 1026 error ("The x509 certificate does not match \"%s\"", c_hostname);
1075 } 1027 }
1076 } 1028 }
1077
1078 fn_gnutls_x509_crt_deinit (gnutls_verify_cert); 1029 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1079 } 1030 }
1080 1031
diff --git a/src/gnutls.h b/src/gnutls.h
index e2a9bc9eaea..076e9fdba9c 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -49,9 +49,9 @@ typedef enum
49 49
50#define GNUTLS_PROCESS_USABLE(proc) (GNUTLS_INITSTAGE(proc) >= GNUTLS_STAGE_READY) 50#define GNUTLS_PROCESS_USABLE(proc) (GNUTLS_INITSTAGE(proc) >= GNUTLS_STAGE_READY)
51 51
52#define GNUTLS_LOG(level, max, string) if (level <= max) { gnutls_log_function (level, "(Emacs) " string); } 52#define GNUTLS_LOG(level, max, string) do { if (level <= max) { gnutls_log_function (level, "(Emacs) " string); } } while (0)
53 53
54#define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } 54#define GNUTLS_LOG2(level, max, string, extra) do { if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } } while (0)
55 55
56extern EMACS_INT 56extern EMACS_INT
57emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte); 57emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte);
@@ -60,6 +60,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte);
60 60
61extern int emacs_gnutls_record_check_pending (gnutls_session_t state); 61extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
62extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); 62extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
63extern Lisp_Object emacs_gnutls_deinit (Lisp_Object);
63 64
64extern void syms_of_gnutls (void); 65extern void syms_of_gnutls (void);
65 66
diff --git a/src/image.c b/src/image.c
index ef72745a72f..14c74f10607 100644
--- a/src/image.c
+++ b/src/image.c
@@ -2015,7 +2015,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
2015 /* Bitmaps with a depth less than 16 need a palette. */ 2015 /* Bitmaps with a depth less than 16 need a palette. */
2016 /* BITMAPINFO structure already contains the first RGBQUAD. */ 2016 /* BITMAPINFO structure already contains the first RGBQUAD. */
2017 if (depth < 16) 2017 if (depth < 16)
2018 palette_colors = 1 << depth - 1; 2018 palette_colors = 1 << (depth - 1);
2019 2019
2020 *ximg = xmalloc (sizeof (XImage) + palette_colors * sizeof (RGBQUAD)); 2020 *ximg = xmalloc (sizeof (XImage) + palette_colors * sizeof (RGBQUAD));
2021 2021
diff --git a/src/process.c b/src/process.c
index 90ad9c21681..dc37ec5f961 100644
--- a/src/process.c
+++ b/src/process.c
@@ -642,6 +642,9 @@ make_process (Lisp_Object name)
642 p->gnutls_initstage = GNUTLS_STAGE_EMPTY; 642 p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
643 p->gnutls_log_level = 0; 643 p->gnutls_log_level = 0;
644 p->gnutls_p = 0; 644 p->gnutls_p = 0;
645 p->gnutls_state = NULL;
646 p->gnutls_x509_cred = NULL;
647 p->gnutls_anon_cred = NULL;
645#endif 648#endif
646 649
647 /* If name is already in use, modify it until it is unused. */ 650 /* If name is already in use, modify it until it is unused. */
@@ -3867,6 +3870,11 @@ deactivate_process (Lisp_Object proc)
3867 register int inchannel, outchannel; 3870 register int inchannel, outchannel;
3868 register struct Lisp_Process *p = XPROCESS (proc); 3871 register struct Lisp_Process *p = XPROCESS (proc);
3869 3872
3873#ifdef HAVE_GNUTLS
3874 /* Delete GnuTLS structures in PROC, if any. */
3875 emacs_gnutls_deinit (proc);
3876#endif /* HAVE_GNUTLS */
3877
3870 inchannel = p->infd; 3878 inchannel = p->infd;
3871 outchannel = p->outfd; 3879 outchannel = p->outfd;
3872 3880
diff --git a/src/w32.c b/src/w32.c
index 91893ddfc61..42546fc8d49 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -2892,12 +2892,12 @@ sys_rename (const char * oldname, const char * newname)
2892 int i = 0; 2892 int i = 0;
2893 2893
2894 oldname = map_w32_filename (oldname, NULL); 2894 oldname = map_w32_filename (oldname, NULL);
2895 if (o = strrchr (oldname, '\\')) 2895 if ((o = strrchr (oldname, '\\')))
2896 o++; 2896 o++;
2897 else 2897 else
2898 o = (char *) oldname; 2898 o = (char *) oldname;
2899 2899
2900 if (p = strrchr (temp, '\\')) 2900 if ((p = strrchr (temp, '\\')))
2901 p++; 2901 p++;
2902 else 2902 else
2903 p = temp; 2903 p = temp;
@@ -5756,7 +5756,7 @@ w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
5756 for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls)) 5756 for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
5757 { 5757 {
5758 CHECK_STRING_CAR (dlls); 5758 CHECK_STRING_CAR (dlls);
5759 if (library_dll = LoadLibrary (SDATA (XCAR (dlls)))) 5759 if ((library_dll = LoadLibrary (SDATA (XCAR (dlls)))))
5760 { 5760 {
5761 found = XCAR (dlls); 5761 found = XCAR (dlls);
5762 break; 5762 break;
diff --git a/src/w32fns.c b/src/w32fns.c
index f48e5764b4c..2ecd6e91533 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -635,9 +635,8 @@ colormap_t w32_color_map[] =
635 {"LightGreen" , PALETTERGB (144,238,144)}, 635 {"LightGreen" , PALETTERGB (144,238,144)},
636}; 636};
637 637
638DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map, 638static Lisp_Object
639 0, 0, 0, doc: /* Return the default color map. */) 639w32_default_color_map (void)
640 (void)
641{ 640{
642 int i; 641 int i;
643 colormap_t *pc = w32_color_map; 642 colormap_t *pc = w32_color_map;
@@ -658,6 +657,13 @@ DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
658 return (cmap); 657 return (cmap);
659} 658}
660 659
660DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
661 0, 0, 0, doc: /* Return the default color map. */)
662 (void)
663{
664 return w32_default_color_map ();
665}
666
661static Lisp_Object 667static Lisp_Object
662w32_color_map_lookup (char *colorname) 668w32_color_map_lookup (char *colorname)
663{ 669{
@@ -683,7 +689,6 @@ w32_color_map_lookup (char *colorname)
683 QUIT; 689 QUIT;
684 } 690 }
685 691
686
687 UNBLOCK_INPUT; 692 UNBLOCK_INPUT;
688 693
689 return ret; 694 return ret;
@@ -4768,7 +4773,7 @@ terminate Emacs if we can't open the connection.
4768 UNGCPRO; 4773 UNGCPRO;
4769 } 4774 }
4770 if (NILP (Vw32_color_map)) 4775 if (NILP (Vw32_color_map))
4771 Vw32_color_map = Fw32_default_color_map (); 4776 Vw32_color_map = w32_default_color_map ();
4772 4777
4773 /* Merge in system logical colors. */ 4778 /* Merge in system logical colors. */
4774 add_system_logical_colors_to_map (&Vw32_color_map); 4779 add_system_logical_colors_to_map (&Vw32_color_map);
diff --git a/src/w32font.c b/src/w32font.c
index 985370c15c1..f47b7a46b1e 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -1916,10 +1916,10 @@ fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec)
1916 int spacing = XINT (tmp); 1916 int spacing = XINT (tmp);
1917 if (spacing < FONT_SPACING_MONO) 1917 if (spacing < FONT_SPACING_MONO)
1918 logfont->lfPitchAndFamily 1918 logfont->lfPitchAndFamily
1919 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH; 1919 = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH;
1920 else 1920 else
1921 logfont->lfPitchAndFamily 1921 logfont->lfPitchAndFamily
1922 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH; 1922 = (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH;
1923 } 1923 }
1924 1924
1925 /* Process EXTRA info. */ 1925 /* Process EXTRA info. */
diff --git a/src/w32reg.c b/src/w32reg.c
index e1465be9e44..18374431062 100644
--- a/src/w32reg.c
+++ b/src/w32reg.c
@@ -147,9 +147,9 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class)
147 { 147 {
148 char *resource; 148 char *resource;
149 149
150 if (resource = w32_get_rdb_resource (rdb, name)) 150 if ((resource = w32_get_rdb_resource (rdb, name)))
151 return resource; 151 return resource;
152 if (resource = w32_get_rdb_resource (rdb, class)) 152 if ((resource = w32_get_rdb_resource (rdb, class)))
153 return resource; 153 return resource;
154 } 154 }
155 155
@@ -157,6 +157,5 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class)
157 /* --quick was passed, so this is a no-op. */ 157 /* --quick was passed, so this is a no-op. */
158 return NULL; 158 return NULL;
159 159
160 return (w32_get_string_resource (name, class, REG_SZ)); 160 return w32_get_string_resource (name, class, REG_SZ);
161} 161}
162