mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-10 13:40:36 -08:00
upstream
This commit is contained in:
Joakim Verona
commit
b70516db12
28 changed files with 339 additions and 238 deletions
|
|
@ -1,3 +1,7 @@
|
|||
2011-10-26 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* emacs.texi (Top): Fix typo.
|
||||
|
||||
2011-10-25 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* abbrevs.texi (Saving Abbrevs):
|
||||
|
|
|
|||
|
|
@ -295,7 +295,7 @@ Help
|
|||
* Package Keywords:: Finding Lisp libraries by keywords (topics).
|
||||
* Language Help:: Help relating to international language support.
|
||||
* Misc Help:: Other help commands.
|
||||
* Help Files:: Commands to display auxilliary help files.
|
||||
* Help Files:: Commands to display auxiliary help files.
|
||||
* Help Echo:: Help on active text and tooltips (`balloon help').
|
||||
|
||||
The Mark and the Region
|
||||
|
|
|
|||
23
etc/NEWS
23
etc/NEWS
|
|
@ -1218,15 +1218,22 @@ syntactic rules.
|
|||
|
||||
** frame-local variables cannot be let-bound any more.
|
||||
|
||||
** Major and minor mode changes
|
||||
+++
|
||||
** prog-mode is a new major-mode meant to be the parent of programming mode.
|
||||
The prog-mode-hook it defines can be used to enable features for
|
||||
programming modes. For example:
|
||||
(add-hook 'prog-mode-hook 'flyspell-prog-mode)
|
||||
enables on the fly spell checking for comments and strings for
|
||||
programming modes.
|
||||
*** `prog-mode' is a new major mode from which programming modes
|
||||
should be derived.
|
||||
|
||||
** define-minor-mode accepts a new keyword :variable.
|
||||
**** `prog-mode-hook' can be used to enable features for programming
|
||||
modes, e.g. (add-hook 'prog-mode-hook 'flyspell-prog-mode) to enable
|
||||
on-the-fly spell checking for comments and strings.
|
||||
|
||||
*** New hook `change-major-mode-after-body-hook', run by
|
||||
`run-mode-hooks' just before any other mode hooks.
|
||||
|
||||
*** Enabled globalized minor modes can be disabled in specific modes,
|
||||
by running (FOO-mode-hook 0) via a mode hook.
|
||||
|
||||
*** `define-minor-mode' accepts a new keyword :variable.
|
||||
|
||||
+++
|
||||
** `delete-file' and `delete-directory' now accept optional arg TRASH.
|
||||
|
|
@ -1351,6 +1358,8 @@ with the USER_LIBS build variable.
|
|||
|
||||
** New make target `dist' to create binary distribution for MS Windows.
|
||||
|
||||
** Function `w32-default-color-map' is now obsolete.
|
||||
|
||||
** On Nextstep/OSX, the menu bar can be hidden by customizing
|
||||
ns-auto-hide-menu-bar.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2011-10-27 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* emacsclient.c (w32_getenv): Silence compiler warnings.
|
||||
|
||||
2011-09-07 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* etags.c (Fortran_functions): Handle "elemental" functions.
|
||||
|
|
|
|||
|
|
@ -359,7 +359,7 @@ w32_getenv (char *envvar)
|
|||
char *value;
|
||||
DWORD dwType;
|
||||
|
||||
if (value = getenv (envvar))
|
||||
if ((value = getenv (envvar)))
|
||||
/* Found in the environment. strdup it, because values returned
|
||||
by getenv cannot be free'd. */
|
||||
return xstrdup (value);
|
||||
|
|
@ -382,7 +382,7 @@ w32_getenv (char *envvar)
|
|||
{
|
||||
DWORD size;
|
||||
|
||||
if (size = ExpandEnvironmentStrings (value, NULL, 0))
|
||||
if ((size = ExpandEnvironmentStrings (value, NULL, 0)))
|
||||
{
|
||||
char *buffer = (char *) xmalloc (size);
|
||||
if (ExpandEnvironmentStrings (value, buffer, size))
|
||||
|
|
|
|||
|
|
@ -1,3 +1,37 @@
|
|||
2011-10-27 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* emacs-lisp/cl-extra.el (most-positive-float, most-negative-float)
|
||||
(least-positive-float, least-negative-float)
|
||||
(least-positive-normalized-float, least-negative-normalized-float)
|
||||
(float-epsilon, float-negative-epsilon):
|
||||
Remove unnecessary declarations.
|
||||
|
||||
* emacs-lisp/cl-extra.el (cl-float-limits): Add doc string.
|
||||
* emacs-lisp/cl.el (most-positive-float, most-negative-float)
|
||||
(least-positive-float, least-negative-float)
|
||||
(least-positive-normalized-float, least-negative-normalized-float)
|
||||
(float-epsilon, float-negative-epsilon): Add doc-strings,
|
||||
based on those in cl.texi.
|
||||
|
||||
* files.el (set-visited-file-name): If the major-mode changed,
|
||||
reload the local variables. (Bug#9796)
|
||||
|
||||
2011-10-27 Chong Yidong <cyd@gnu.org>
|
||||
|
||||
* subr.el (change-major-mode-after-body-hook): New hook.
|
||||
(run-mode-hooks): Run it.
|
||||
|
||||
* emacs-lisp/easy-mmode.el (define-globalized-minor-mode): Use
|
||||
change-major-mode-before-body-hook.
|
||||
|
||||
* simple.el (fundamental-mode):
|
||||
* emacs-lisp/derived.el (define-derived-mode): Revert 2010-04-28
|
||||
change introducing fundamental-mode-hook.
|
||||
|
||||
2011-10-26 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* term/w32-win.el (w32-default-color-map): Declare obsolete. (Bug#9785)
|
||||
|
||||
2011-10-26 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* ido.el (ido-file-name-all-completions-1): Do not require
|
||||
|
|
|
|||
|
|
@ -480,17 +480,13 @@ If STATE is t, return a new state object seeded from the time of day."
|
|||
(and (numberp res) (/= res (/ res 2)) res))
|
||||
(arith-error nil)))
|
||||
|
||||
(defvar most-positive-float)
|
||||
(defvar most-negative-float)
|
||||
(defvar least-positive-float)
|
||||
(defvar least-negative-float)
|
||||
(defvar least-positive-normalized-float)
|
||||
(defvar least-negative-normalized-float)
|
||||
(defvar float-epsilon)
|
||||
(defvar float-negative-epsilon)
|
||||
|
||||
;;;###autoload
|
||||
(defun cl-float-limits ()
|
||||
"Initialize the Common Lisp floating-point parameters.
|
||||
This sets the values of: `most-positive-float', `most-negative-float',
|
||||
`least-positive-float', `least-negative-float', `float-epsilon',
|
||||
`float-negative-epsilon', `least-positive-normalized-float', and
|
||||
`least-negative-normalized-float'."
|
||||
(or most-positive-float (not (numberp '2e1))
|
||||
(let ((x '2e0) y z)
|
||||
;; Find maximum exponent (first two loops are optimizations)
|
||||
|
|
|
|||
|
|
@ -333,15 +333,51 @@ always returns nil."
|
|||
|
||||
(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
|
||||
|
||||
;; The following are actually set by cl-float-limits.
|
||||
(defconst most-positive-float nil)
|
||||
(defconst most-negative-float nil)
|
||||
(defconst least-positive-float nil)
|
||||
(defconst least-negative-float nil)
|
||||
(defconst least-positive-normalized-float nil)
|
||||
(defconst least-negative-normalized-float nil)
|
||||
(defconst float-epsilon nil)
|
||||
(defconst float-negative-epsilon nil)
|
||||
(defconst most-positive-float nil
|
||||
"The largest value that a Lisp float can hold.
|
||||
If your system supports infinities, this is the largest finite value.
|
||||
For IEEE machines, this is approximately 1.79e+308.
|
||||
Call `cl-float-limits' to set this.")
|
||||
|
||||
(defconst most-negative-float nil
|
||||
"The largest negative value that a Lisp float can hold.
|
||||
This is simply -`most-negative-float'.
|
||||
Call `cl-float-limits' to set this.")
|
||||
|
||||
(defconst least-positive-float nil
|
||||
"The smallest value greater than zero that a Lisp float can hold.
|
||||
For IEEE machines, it is about 4.94e-324 if denormals are supported,
|
||||
or 2.22e-308 if they are not.
|
||||
Call `cl-float-limits' to set this.")
|
||||
|
||||
(defconst least-negative-float nil
|
||||
"The smallest value less than zero that a Lisp float can hold.
|
||||
This is simply -`least-positive-float'.
|
||||
Call `cl-float-limits' to set this.")
|
||||
|
||||
(defconst least-positive-normalized-float nil
|
||||
"The smallest normalized Lisp float greater than zero.
|
||||
This is the smallest value for which IEEE denormalization does not lose
|
||||
precision. For IEEE machines, this value is about 2.22e-308.
|
||||
For machines that do not support the concept of denormalization
|
||||
and gradual underflow, this constant equals `least-positive-float'.
|
||||
Call `cl-float-limits' to set this.")
|
||||
|
||||
(defconst least-negative-normalized-float nil
|
||||
"The smallest normalized Lisp float less than zero.
|
||||
This is simply -`least-positive-normalized-float'.
|
||||
Call `cl-float-limits' to set this.")
|
||||
|
||||
(defconst float-epsilon nil
|
||||
"The smallest positive float that adds to 1.0 to give a distinct value.
|
||||
Adding a number less than this to 1.0 returns 1.0 due to roundoff.
|
||||
For IEEE machines, epsilon is about 2.22e-16.
|
||||
Call `cl-float-limits' to set this.")
|
||||
|
||||
(defconst float-negative-epsilon nil
|
||||
"The smallest positive float that subtracts from 1.0 to give a distinct value.
|
||||
For IEEE machines, it is about 1.11e-16.
|
||||
Call `cl-float-limits' to set this.")
|
||||
|
||||
|
||||
;;; Sequence functions.
|
||||
|
|
|
|||
|
|
@ -230,7 +230,7 @@ No problems result if this variable is not bound.
|
|||
; Run the parent.
|
||||
(delay-mode-hooks
|
||||
|
||||
(,(or parent 'fundamental-mode))
|
||||
(,(or parent 'kill-all-local-variables))
|
||||
; Identify the child mode.
|
||||
(setq major-mode (quote ,child))
|
||||
(setq mode-name ,name)
|
||||
|
|
|
|||
|
|
@ -368,11 +368,13 @@ See `%s' for more information on %s."
|
|||
(progn
|
||||
(add-hook 'after-change-major-mode-hook
|
||||
',MODE-enable-in-buffers)
|
||||
(add-hook 'fundamental-mode-hook ',MODE-enable-in-buffers)
|
||||
(add-hook 'change-major-mode-after-body-hook
|
||||
',MODE-enable-in-buffers)
|
||||
(add-hook 'find-file-hook ',MODE-check-buffers)
|
||||
(add-hook 'change-major-mode-hook ',MODE-cmhh))
|
||||
(remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
|
||||
(remove-hook 'fundamental-mode-hook ',MODE-enable-in-buffers)
|
||||
(remove-hook 'change-major-mode-after-body-hook
|
||||
',MODE-enable-in-buffers)
|
||||
(remove-hook 'find-file-hook ',MODE-check-buffers)
|
||||
(remove-hook 'change-major-mode-hook ',MODE-cmhh))
|
||||
|
||||
|
|
|
|||
|
|
@ -3682,7 +3682,11 @@ the old visited file has been renamed to the new name FILENAME."
|
|||
(get major-mode 'mode-class)
|
||||
;; Don't change the mode if the local variable list specifies it.
|
||||
(hack-local-variables t)
|
||||
(set-auto-mode t))
|
||||
;; TODO consider making normal-mode handle this case.
|
||||
(let ((old major-mode))
|
||||
(set-auto-mode t)
|
||||
(or (eq old major-mode)
|
||||
(hack-local-variables))))
|
||||
(error nil)))
|
||||
|
||||
(defun write-file (filename &optional confirm)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
2011-10-26 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* message.el (message-completion-function): Make sure
|
||||
message-tab-body-function is not attempted if one of
|
||||
message-completion-alist fails to find a completion (bug#9158).
|
||||
|
||||
2011-10-26 Daiki Ueno <ueno@unixuser.org>
|
||||
|
||||
* mml.el (mml-quote-region): Quote <#secure> tag.
|
||||
|
|
@ -7,7 +13,7 @@
|
|||
|
||||
* gnus-cite.el (gnus-message-citation-mode): Doc fix (in Emacs 24,
|
||||
calling a minor mode from Lisp with nil arg enables it, so we have to
|
||||
make the working a bit ambiguous here).
|
||||
make the wording a bit ambiguous here).
|
||||
|
||||
2011-10-18 Teodor Zlatanov <tzz@lifelogs.com>
|
||||
|
||||
|
|
|
|||
|
|
@ -7888,7 +7888,11 @@ those headers."
|
|||
(let ((mail-abbrev-mode-regexp (caar alist)))
|
||||
(not (mail-abbrev-in-expansion-header-p))))
|
||||
(setq alist (cdr alist)))
|
||||
(cdar alist)))
|
||||
(when (cdar alist)
|
||||
(lexical-let ((fun (cdar alist)))
|
||||
;; Even if completion fails, return a non-nil value, so as to avoid
|
||||
;; falling back to message-tab-body-function.
|
||||
(lambda () (funcall fun) 'completion-attempted)))))
|
||||
|
||||
(eval-and-compile
|
||||
(condition-case nil
|
||||
|
|
|
|||
|
|
@ -708,7 +708,7 @@
|
|||
(define-charset-alias 'cp866u 'cp1125)
|
||||
|
||||
;; Fixme: C.f. iconv, http://czyborra.com/charsets/codepages.html
|
||||
;; shows this as not ASCII comptaible, with various graphics in
|
||||
;; shows this as not ASCII compatible, with various graphics in
|
||||
;; 0x01-0x1F.
|
||||
(define-charset 'cp437
|
||||
"CP437 (MS-DOS United States, Australia, New Zealand, South Africa)"
|
||||
|
|
|
|||
|
|
@ -1871,7 +1871,7 @@
|
|||
|
||||
* org-list.el (org-list-separating-blank-lines-number): Fix
|
||||
confusion between point and item beginning. Now, if no
|
||||
information is avalaible, truly follow user preference when it
|
||||
information is available, truly follow user preference when it
|
||||
inserts blank lines manually.
|
||||
(org-list-insert-item): Send correct argument to the preceding
|
||||
function.
|
||||
|
|
|
|||
|
|
@ -349,7 +349,8 @@ location."
|
|||
Other major modes are defined by comparison with this one."
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(run-mode-hooks 'fundamental-mode-hook))
|
||||
(unless delay-mode-hooks
|
||||
(run-hooks 'after-change-major-mode-hook)))
|
||||
|
||||
;; Special major modes to view specially formatted data rather than files.
|
||||
|
||||
|
|
|
|||
|
|
@ -1530,6 +1530,9 @@ if it is empty or a duplicate."
|
|||
(make-variable-buffer-local 'delayed-mode-hooks)
|
||||
(put 'delay-mode-hooks 'permanent-local t)
|
||||
|
||||
(defvar change-major-mode-after-body-hook nil
|
||||
"Normal hook run in major mode functions, before the mode hooks.")
|
||||
|
||||
(defvar after-change-major-mode-hook nil
|
||||
"Normal hook run at the very end of major mode functions.")
|
||||
|
||||
|
|
@ -1546,7 +1549,7 @@ FOO-mode-hook."
|
|||
;; Normal case, just run the hook as before plus any delayed hooks.
|
||||
(setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
|
||||
(setq delayed-mode-hooks nil)
|
||||
(apply 'run-hooks hooks)
|
||||
(apply 'run-hooks (cons 'change-major-mode-after-body-hook hooks))
|
||||
(run-hooks 'after-change-major-mode-hook)))
|
||||
|
||||
(defmacro delay-mode-hooks (&rest body)
|
||||
|
|
|
|||
|
|
@ -85,6 +85,7 @@
|
|||
(define-obsolete-function-alias 'w32-select-font 'x-select-font "23.1")
|
||||
|
||||
(defvar w32-color-map) ;; defined in w32fns.c
|
||||
(make-obsolete 'w32-default-color-map nil "24.1")
|
||||
|
||||
(declare-function w32-send-sys-command "w32fns.c")
|
||||
(declare-function set-message-beep "w32console.c")
|
||||
|
|
|
|||
|
|
@ -1522,7 +1522,7 @@ Valid actions are: readable, restore, read, kill, write."
|
|||
;;; (while all
|
||||
;;; (when (and (eq (car (car all)) 'bof)
|
||||
;;; (not (file-regular-p (nth 1 (car all)))))
|
||||
;;; (message "File %s in saved parse info not avalable" (cdr (car all)))
|
||||
;;; (message "File %s in saved parse info not available" (cdr (car all)))
|
||||
;;; (error "File not found"))
|
||||
;;; (setq all (cdr all))))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,36 @@
|
|||
2011-10-27 Chong Yidong <cyd@gnu.org>
|
||||
|
||||
* process.c (make_process): Set gnutls_state to NULL.
|
||||
|
||||
* gnutls.c (emacs_gnutls_deinit): Deinit the gnutls_state if it is
|
||||
non-NULL, regardless of GNUTLS_INITSTAGE.
|
||||
(Fgnutls_boot): Cleanups. Call emacs_gnutls_deinit if we signal
|
||||
an error. Set process slots as soon as we allocate them.
|
||||
|
||||
* gnutls.h (GNUTLS_LOG, GNUTLS_LOG2): Fix macros.
|
||||
|
||||
2011-10-27 Chong Yidong <cyd@gnu.org>
|
||||
|
||||
* gnutls.c (emacs_gnutls_deinit): New function. Deallocate
|
||||
credentials structures as well as calling gnutls_deinit.
|
||||
(Fgnutls_deinit, Fgnutls_boot): Use it.
|
||||
|
||||
* process.c (make_process): Initialize GnuTLS credentials to NULL.
|
||||
(deactivate_process): Call emacs_gnutls_deinit.
|
||||
|
||||
2011-10-27 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* image.c (x_create_x_image_and_pixmap):
|
||||
* w32.c (sys_rename, w32_delayed_load):
|
||||
* w32font.c (fill_in_logfont):
|
||||
* w32reg.c (x_get_string_resource): Silence compiler warnings.
|
||||
|
||||
2011-10-26 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* w32fns.c (w32_default_color_map): New function,
|
||||
extracted from Fw32_default_color_map.
|
||||
(Fw32_default_color_map, Fx_open_connection): Use it. (Bug#9785)
|
||||
|
||||
2011-10-25 Paul Eggert <eggert@cs.ucla.edu>
|
||||
|
||||
* dispextern.h (Fcontrolling_tty_p): New decl (Bug#6649 part 2).
|
||||
|
|
|
|||
315
src/gnutls.c
315
src/gnutls.c
|
|
@ -464,6 +464,44 @@ gnutls_make_error (int err)
|
|||
return make_number (err);
|
||||
}
|
||||
|
||||
Lisp_Object
|
||||
emacs_gnutls_deinit (Lisp_Object proc)
|
||||
{
|
||||
int log_level;
|
||||
|
||||
CHECK_PROCESS (proc);
|
||||
|
||||
if (XPROCESS (proc)->gnutls_p == 0)
|
||||
return Qnil;
|
||||
|
||||
log_level = XPROCESS (proc)->gnutls_log_level;
|
||||
|
||||
if (XPROCESS (proc)->gnutls_x509_cred)
|
||||
{
|
||||
GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
|
||||
fn_gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
|
||||
XPROCESS (proc)->gnutls_x509_cred = NULL;
|
||||
}
|
||||
|
||||
if (XPROCESS (proc)->gnutls_anon_cred)
|
||||
{
|
||||
GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
|
||||
fn_gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
|
||||
XPROCESS (proc)->gnutls_anon_cred = NULL;
|
||||
}
|
||||
|
||||
if (XPROCESS (proc)->gnutls_state)
|
||||
{
|
||||
fn_gnutls_deinit (XPROCESS (proc)->gnutls_state);
|
||||
XPROCESS (proc)->gnutls_state = NULL;
|
||||
if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
|
||||
}
|
||||
|
||||
XPROCESS (proc)->gnutls_p = 0;
|
||||
return Qt;
|
||||
}
|
||||
|
||||
DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
|
||||
doc: /* Return the GnuTLS init stage of process PROC.
|
||||
See also `gnutls-boot'. */)
|
||||
|
|
@ -551,18 +589,7 @@ DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
|
|||
See also `gnutls-init'. */)
|
||||
(Lisp_Object proc)
|
||||
{
|
||||
gnutls_session_t state;
|
||||
|
||||
CHECK_PROCESS (proc);
|
||||
state = XPROCESS (proc)->gnutls_state;
|
||||
|
||||
if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
|
||||
{
|
||||
fn_gnutls_deinit (state);
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
|
||||
}
|
||||
|
||||
return Qt;
|
||||
return emacs_gnutls_deinit (proc);
|
||||
}
|
||||
|
||||
DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
|
||||
|
|
@ -622,7 +649,7 @@ emacs_gnutls_global_deinit (void)
|
|||
|
||||
DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
|
||||
doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
|
||||
Currently only client mode is supported. Returns a success/failure
|
||||
Currently only client mode is supported. Return a success/failure
|
||||
value you can check with `gnutls-errorp'.
|
||||
|
||||
TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
|
||||
|
|
@ -673,23 +700,13 @@ one trustfile (usually a CA bundle). */)
|
|||
(Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
|
||||
{
|
||||
int ret = GNUTLS_E_SUCCESS;
|
||||
|
||||
int max_log_level = 0;
|
||||
|
||||
/* TODO: GNUTLS_X509_FMT_DER is also an option. */
|
||||
int file_format = GNUTLS_X509_FMT_PEM;
|
||||
|
||||
unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
|
||||
gnutls_x509_crt_t gnutls_verify_cert;
|
||||
unsigned int gnutls_verify_cert_list_size;
|
||||
const gnutls_datum_t *gnutls_verify_cert_list;
|
||||
|
||||
gnutls_session_t state;
|
||||
gnutls_certificate_credentials_t x509_cred;
|
||||
gnutls_anon_client_credentials_t anon_cred;
|
||||
gnutls_certificate_credentials_t x509_cred = NULL;
|
||||
gnutls_anon_client_credentials_t anon_cred = NULL;
|
||||
Lisp_Object global_init;
|
||||
char const *priority_string_ptr = "NORMAL"; /* default priority string. */
|
||||
Lisp_Object tail;
|
||||
unsigned int peer_verification;
|
||||
char* c_hostname;
|
||||
|
||||
|
|
@ -701,7 +718,6 @@ one trustfile (usually a CA bundle). */)
|
|||
/* Lisp_Object callbacks; */
|
||||
Lisp_Object loglevel;
|
||||
Lisp_Object hostname;
|
||||
Lisp_Object verify_flags;
|
||||
/* Lisp_Object verify_error; */
|
||||
Lisp_Object verify_hostname_error;
|
||||
Lisp_Object prime_bits;
|
||||
|
|
@ -716,26 +732,25 @@ one trustfile (usually a CA bundle). */)
|
|||
return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
|
||||
}
|
||||
|
||||
if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
|
||||
{
|
||||
error ("Invalid GnuTLS credential type");
|
||||
return gnutls_make_error (GNUTLS_EMACS_ERROR_INVALID_TYPE);
|
||||
}
|
||||
|
||||
hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname);
|
||||
priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority);
|
||||
trustfiles = Fplist_get (proplist, QCgnutls_bootprop_trustfiles);
|
||||
keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist);
|
||||
crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);
|
||||
/* callbacks = Fplist_get (proplist, QCgnutls_bootprop_callbacks); */
|
||||
loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel);
|
||||
verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
|
||||
/* verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error); */
|
||||
verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error);
|
||||
prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);
|
||||
|
||||
if (!STRINGP (hostname))
|
||||
error ("gnutls-boot: invalid :hostname parameter");
|
||||
|
||||
c_hostname = SSDATA (hostname);
|
||||
|
||||
state = XPROCESS (proc)->gnutls_state;
|
||||
XPROCESS (proc)->gnutls_p = 1;
|
||||
|
||||
if (NUMBERP (loglevel))
|
||||
{
|
||||
fn_gnutls_global_set_log_function (gnutls_log_function);
|
||||
|
|
@ -749,82 +764,56 @@ one trustfile (usually a CA bundle). */)
|
|||
if (! NILP (Fgnutls_errorp (global_init)))
|
||||
return global_init;
|
||||
|
||||
/* deinit and free resources. */
|
||||
if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_CRED_ALLOC)
|
||||
{
|
||||
GNUTLS_LOG (1, max_log_level, "deallocating credentials");
|
||||
|
||||
if (EQ (type, Qgnutls_x509pki))
|
||||
{
|
||||
GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
|
||||
x509_cred = XPROCESS (proc)->gnutls_x509_cred;
|
||||
fn_gnutls_certificate_free_credentials (x509_cred);
|
||||
}
|
||||
else if (EQ (type, Qgnutls_anon))
|
||||
{
|
||||
GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
|
||||
anon_cred = XPROCESS (proc)->gnutls_anon_cred;
|
||||
fn_gnutls_anon_free_client_credentials (anon_cred);
|
||||
}
|
||||
else
|
||||
{
|
||||
error ("unknown credential type");
|
||||
ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
|
||||
}
|
||||
|
||||
if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
|
||||
{
|
||||
GNUTLS_LOG (1, max_log_level, "deallocating x509 credentials");
|
||||
Fgnutls_deinit (proc);
|
||||
}
|
||||
}
|
||||
/* Before allocating new credentials, deallocate any credentials
|
||||
that PROC might already have. */
|
||||
emacs_gnutls_deinit (proc);
|
||||
|
||||
/* Mark PROC as a GnuTLS process. */
|
||||
XPROCESS (proc)->gnutls_p = 1;
|
||||
XPROCESS (proc)->gnutls_state = NULL;
|
||||
XPROCESS (proc)->gnutls_x509_cred = NULL;
|
||||
XPROCESS (proc)->gnutls_anon_cred = NULL;
|
||||
XPROCESS (proc)->gnutls_cred_type = type;
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
|
||||
|
||||
GNUTLS_LOG (1, max_log_level, "allocating credentials");
|
||||
|
||||
if (EQ (type, Qgnutls_x509pki))
|
||||
{
|
||||
GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
|
||||
x509_cred = XPROCESS (proc)->gnutls_x509_cred;
|
||||
fn_gnutls_certificate_allocate_credentials (&x509_cred);
|
||||
Lisp_Object verify_flags;
|
||||
unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
|
||||
|
||||
GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
|
||||
fn_gnutls_certificate_allocate_credentials (&x509_cred);
|
||||
XPROCESS (proc)->gnutls_x509_cred = x509_cred;
|
||||
|
||||
verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
|
||||
if (NUMBERP (verify_flags))
|
||||
{
|
||||
gnutls_verify_flags = XINT (verify_flags);
|
||||
GNUTLS_LOG (2, max_log_level, "setting verification flags");
|
||||
}
|
||||
else if (NILP (verify_flags))
|
||||
{
|
||||
/* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */
|
||||
GNUTLS_LOG (2, max_log_level, "using default verification flags");
|
||||
}
|
||||
GNUTLS_LOG (2, max_log_level, "using default verification flags");
|
||||
else
|
||||
{
|
||||
/* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */
|
||||
GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
|
||||
}
|
||||
GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
|
||||
|
||||
fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
|
||||
}
|
||||
else if (EQ (type, Qgnutls_anon))
|
||||
else /* Qgnutls_anon: */
|
||||
{
|
||||
GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
|
||||
anon_cred = XPROCESS (proc)->gnutls_anon_cred;
|
||||
fn_gnutls_anon_allocate_client_credentials (&anon_cred);
|
||||
XPROCESS (proc)->gnutls_anon_cred = anon_cred;
|
||||
}
|
||||
else
|
||||
{
|
||||
error ("unknown credential type");
|
||||
ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
|
||||
}
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
|
||||
|
||||
if (EQ (type, Qgnutls_x509pki))
|
||||
{
|
||||
/* TODO: GNUTLS_X509_FMT_DER is also an option. */
|
||||
int file_format = GNUTLS_X509_FMT_PEM;
|
||||
Lisp_Object tail;
|
||||
|
||||
for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
|
||||
{
|
||||
Lisp_Object trustfile = Fcar (tail);
|
||||
|
|
@ -842,8 +831,8 @@ one trustfile (usually a CA bundle). */)
|
|||
}
|
||||
else
|
||||
{
|
||||
error ("Sorry, GnuTLS can't use non-string trustfile %s",
|
||||
SDATA (trustfile));
|
||||
emacs_gnutls_deinit (proc);
|
||||
error ("Invalid trustfile");
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -855,17 +844,15 @@ one trustfile (usually a CA bundle). */)
|
|||
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
|
||||
SSDATA (crlfile));
|
||||
ret = fn_gnutls_certificate_set_x509_crl_file
|
||||
(x509_cred,
|
||||
SSDATA (crlfile),
|
||||
file_format);
|
||||
(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));
|
||||
emacs_gnutls_deinit (proc);
|
||||
error ("Invalid CRL file");
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -880,45 +867,31 @@ one trustfile (usually a CA bundle). */)
|
|||
GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
|
||||
SSDATA (certfile));
|
||||
ret = fn_gnutls_certificate_set_x509_key_file
|
||||
(x509_cred,
|
||||
SSDATA (certfile),
|
||||
SSDATA (keyfile),
|
||||
file_format);
|
||||
(x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
}
|
||||
else
|
||||
{
|
||||
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));
|
||||
emacs_gnutls_deinit (proc);
|
||||
error (STRINGP (keyfile) ? "Invalid client cert file"
|
||||
: "Invalid client key file");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
|
||||
|
||||
GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
|
||||
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
|
||||
|
||||
#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
|
||||
#else
|
||||
#endif
|
||||
/* Call gnutls_init here: */
|
||||
|
||||
GNUTLS_LOG (1, max_log_level, "gnutls_init");
|
||||
|
||||
ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
|
||||
|
||||
XPROCESS (proc)->gnutls_state = state;
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
|
||||
XPROCESS (proc)->gnutls_state = state;
|
||||
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
|
||||
|
||||
if (STRINGP (priority_string))
|
||||
|
|
@ -934,46 +907,25 @@ one trustfile (usually a CA bundle). */)
|
|||
}
|
||||
|
||||
GNUTLS_LOG (1, max_log_level, "setting the priority string");
|
||||
|
||||
ret = fn_gnutls_priority_set_direct (state,
|
||||
priority_string_ptr,
|
||||
NULL);
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
|
||||
|
||||
if (!EQ (prime_bits, Qnil))
|
||||
{
|
||||
fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
|
||||
}
|
||||
|
||||
if (EQ (type, Qgnutls_x509pki))
|
||||
{
|
||||
ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
|
||||
}
|
||||
else if (EQ (type, Qgnutls_anon))
|
||||
{
|
||||
ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
|
||||
}
|
||||
else
|
||||
{
|
||||
error ("unknown credential type");
|
||||
ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
|
||||
}
|
||||
if (INTEGERP (prime_bits))
|
||||
fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
|
||||
|
||||
ret = EQ (type, Qgnutls_x509pki)
|
||||
? fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
|
||||
: fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
|
||||
XPROCESS (proc)->gnutls_anon_cred = anon_cred;
|
||||
XPROCESS (proc)->gnutls_x509_cred = x509_cred;
|
||||
XPROCESS (proc)->gnutls_cred_type = type;
|
||||
|
||||
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
|
||||
|
||||
ret = emacs_gnutls_handshake (XPROCESS (proc));
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
|
||||
|
|
@ -984,69 +936,71 @@ one trustfile (usually a CA bundle). */)
|
|||
gnutls_x509_crt_check_hostname() against :hostname. */
|
||||
|
||||
ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
|
||||
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
|
||||
if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
|
||||
message ("%s certificate could not be verified.",
|
||||
c_hostname);
|
||||
message ("%s certificate could not be verified.", c_hostname);
|
||||
|
||||
if (peer_verification & GNUTLS_CERT_REVOKED)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
|
||||
c_hostname);
|
||||
if (peer_verification & GNUTLS_CERT_REVOKED)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
|
||||
c_hostname);
|
||||
|
||||
if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
|
||||
c_hostname);
|
||||
if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
|
||||
c_hostname);
|
||||
|
||||
if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
|
||||
c_hostname);
|
||||
if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
|
||||
c_hostname);
|
||||
|
||||
if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
|
||||
GNUTLS_LOG2 (1, max_log_level,
|
||||
"certificate was signed with an insecure algorithm:",
|
||||
c_hostname);
|
||||
if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
|
||||
GNUTLS_LOG2 (1, max_log_level,
|
||||
"certificate was signed with an insecure algorithm:",
|
||||
c_hostname);
|
||||
|
||||
if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
|
||||
c_hostname);
|
||||
if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
|
||||
c_hostname);
|
||||
|
||||
if (peer_verification & GNUTLS_CERT_EXPIRED)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
|
||||
c_hostname);
|
||||
if (peer_verification & GNUTLS_CERT_EXPIRED)
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
|
||||
c_hostname);
|
||||
|
||||
if (peer_verification != 0)
|
||||
{
|
||||
if (NILP (verify_hostname_error))
|
||||
{
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
|
||||
c_hostname);
|
||||
}
|
||||
else
|
||||
{
|
||||
error ("Certificate validation failed %s, verification code %d",
|
||||
c_hostname, peer_verification);
|
||||
}
|
||||
}
|
||||
if (peer_verification != 0)
|
||||
{
|
||||
if (NILP (verify_hostname_error))
|
||||
GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
|
||||
c_hostname);
|
||||
else
|
||||
{
|
||||
emacs_gnutls_deinit (proc);
|
||||
error ("Certificate validation failed %s, verification code %d",
|
||||
c_hostname, peer_verification);
|
||||
}
|
||||
}
|
||||
|
||||
/* Up to here the process is the same for X.509 certificates and
|
||||
OpenPGP keys. From now on X.509 certificates are assumed. This
|
||||
can be easily extended to work with openpgp keys as well. */
|
||||
if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
|
||||
{
|
||||
ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
|
||||
gnutls_x509_crt_t gnutls_verify_cert;
|
||||
const gnutls_datum_t *gnutls_verify_cert_list;
|
||||
unsigned int gnutls_verify_cert_list_size;
|
||||
|
||||
ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
|
||||
if (ret < GNUTLS_E_SUCCESS)
|
||||
return gnutls_make_error (ret);
|
||||
|
||||
gnutls_verify_cert_list =
|
||||
fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
|
||||
|
||||
if (NULL == gnutls_verify_cert_list)
|
||||
if (gnutls_verify_cert_list == NULL)
|
||||
{
|
||||
error ("No x509 certificate was found!\n");
|
||||
fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
|
||||
emacs_gnutls_deinit (proc);
|
||||
error ("No x509 certificate was found\n");
|
||||
}
|
||||
|
||||
/* We only check the first certificate in the given chain. */
|
||||
|
|
@ -1063,18 +1017,15 @@ one trustfile (usually a CA bundle). */)
|
|||
if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
|
||||
{
|
||||
if (NILP (verify_hostname_error))
|
||||
{
|
||||
GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
|
||||
c_hostname);
|
||||
}
|
||||
GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
|
||||
c_hostname);
|
||||
else
|
||||
{
|
||||
fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
|
||||
error ("The x509 certificate does not match \"%s\"",
|
||||
c_hostname);
|
||||
emacs_gnutls_deinit (proc);
|
||||
error ("The x509 certificate does not match \"%s\"", c_hostname);
|
||||
}
|
||||
}
|
||||
|
||||
fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -49,9 +49,9 @@ typedef enum
|
|||
|
||||
#define GNUTLS_PROCESS_USABLE(proc) (GNUTLS_INITSTAGE(proc) >= GNUTLS_STAGE_READY)
|
||||
|
||||
#define GNUTLS_LOG(level, max, string) if (level <= max) { gnutls_log_function (level, "(Emacs) " string); }
|
||||
#define GNUTLS_LOG(level, max, string) do { if (level <= max) { gnutls_log_function (level, "(Emacs) " string); } } while (0)
|
||||
|
||||
#define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); }
|
||||
#define GNUTLS_LOG2(level, max, string, extra) do { if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } } while (0)
|
||||
|
||||
extern EMACS_INT
|
||||
emacs_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);
|
|||
|
||||
extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
|
||||
extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
|
||||
extern Lisp_Object emacs_gnutls_deinit (Lisp_Object);
|
||||
|
||||
extern void syms_of_gnutls (void);
|
||||
|
||||
|
|
|
|||
|
|
@ -2015,7 +2015,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
|
|||
/* Bitmaps with a depth less than 16 need a palette. */
|
||||
/* BITMAPINFO structure already contains the first RGBQUAD. */
|
||||
if (depth < 16)
|
||||
palette_colors = 1 << depth - 1;
|
||||
palette_colors = 1 << (depth - 1);
|
||||
|
||||
*ximg = xmalloc (sizeof (XImage) + palette_colors * sizeof (RGBQUAD));
|
||||
|
||||
|
|
|
|||
|
|
@ -642,6 +642,9 @@ make_process (Lisp_Object name)
|
|||
p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
|
||||
p->gnutls_log_level = 0;
|
||||
p->gnutls_p = 0;
|
||||
p->gnutls_state = NULL;
|
||||
p->gnutls_x509_cred = NULL;
|
||||
p->gnutls_anon_cred = NULL;
|
||||
#endif
|
||||
|
||||
/* If name is already in use, modify it until it is unused. */
|
||||
|
|
@ -3867,6 +3870,11 @@ deactivate_process (Lisp_Object proc)
|
|||
register int inchannel, outchannel;
|
||||
register struct Lisp_Process *p = XPROCESS (proc);
|
||||
|
||||
#ifdef HAVE_GNUTLS
|
||||
/* Delete GnuTLS structures in PROC, if any. */
|
||||
emacs_gnutls_deinit (proc);
|
||||
#endif /* HAVE_GNUTLS */
|
||||
|
||||
inchannel = p->infd;
|
||||
outchannel = p->outfd;
|
||||
|
||||
|
|
|
|||
|
|
@ -2892,12 +2892,12 @@ sys_rename (const char * oldname, const char * newname)
|
|||
int i = 0;
|
||||
|
||||
oldname = map_w32_filename (oldname, NULL);
|
||||
if (o = strrchr (oldname, '\\'))
|
||||
if ((o = strrchr (oldname, '\\')))
|
||||
o++;
|
||||
else
|
||||
o = (char *) oldname;
|
||||
|
||||
if (p = strrchr (temp, '\\'))
|
||||
if ((p = strrchr (temp, '\\')))
|
||||
p++;
|
||||
else
|
||||
p = temp;
|
||||
|
|
@ -5756,7 +5756,7 @@ w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
|
|||
for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
|
||||
{
|
||||
CHECK_STRING_CAR (dlls);
|
||||
if (library_dll = LoadLibrary (SDATA (XCAR (dlls))))
|
||||
if ((library_dll = LoadLibrary (SDATA (XCAR (dlls)))))
|
||||
{
|
||||
found = XCAR (dlls);
|
||||
break;
|
||||
|
|
|
|||
15
src/w32fns.c
15
src/w32fns.c
|
|
@ -635,9 +635,8 @@ colormap_t w32_color_map[] =
|
|||
{"LightGreen" , PALETTERGB (144,238,144)},
|
||||
};
|
||||
|
||||
DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
|
||||
0, 0, 0, doc: /* Return the default color map. */)
|
||||
(void)
|
||||
static Lisp_Object
|
||||
w32_default_color_map (void)
|
||||
{
|
||||
int i;
|
||||
colormap_t *pc = w32_color_map;
|
||||
|
|
@ -658,6 +657,13 @@ DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
|
|||
return (cmap);
|
||||
}
|
||||
|
||||
DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
|
||||
0, 0, 0, doc: /* Return the default color map. */)
|
||||
(void)
|
||||
{
|
||||
return w32_default_color_map ();
|
||||
}
|
||||
|
||||
static Lisp_Object
|
||||
w32_color_map_lookup (char *colorname)
|
||||
{
|
||||
|
|
@ -683,7 +689,6 @@ w32_color_map_lookup (char *colorname)
|
|||
QUIT;
|
||||
}
|
||||
|
||||
|
||||
UNBLOCK_INPUT;
|
||||
|
||||
return ret;
|
||||
|
|
@ -4768,7 +4773,7 @@ terminate Emacs if we can't open the connection.
|
|||
UNGCPRO;
|
||||
}
|
||||
if (NILP (Vw32_color_map))
|
||||
Vw32_color_map = Fw32_default_color_map ();
|
||||
Vw32_color_map = w32_default_color_map ();
|
||||
|
||||
/* Merge in system logical colors. */
|
||||
add_system_logical_colors_to_map (&Vw32_color_map);
|
||||
|
|
|
|||
|
|
@ -1916,10 +1916,10 @@ fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec)
|
|||
int spacing = XINT (tmp);
|
||||
if (spacing < FONT_SPACING_MONO)
|
||||
logfont->lfPitchAndFamily
|
||||
= logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH;
|
||||
= (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH;
|
||||
else
|
||||
logfont->lfPitchAndFamily
|
||||
= logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH;
|
||||
= (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH;
|
||||
}
|
||||
|
||||
/* Process EXTRA info. */
|
||||
|
|
|
|||
|
|
@ -147,9 +147,9 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class)
|
|||
{
|
||||
char *resource;
|
||||
|
||||
if (resource = w32_get_rdb_resource (rdb, name))
|
||||
if ((resource = w32_get_rdb_resource (rdb, name)))
|
||||
return resource;
|
||||
if (resource = w32_get_rdb_resource (rdb, class))
|
||||
if ((resource = w32_get_rdb_resource (rdb, class)))
|
||||
return resource;
|
||||
}
|
||||
|
||||
|
|
@ -157,6 +157,5 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class)
|
|||
/* --quick was passed, so this is a no-op. */
|
||||
return NULL;
|
||||
|
||||
return (w32_get_string_resource (name, class, REG_SZ));
|
||||
return w32_get_string_resource (name, class, REG_SZ);
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue