diff options
| author | Paul Eggert | 2011-10-27 11:20:24 -0700 |
|---|---|---|
| committer | Paul Eggert | 2011-10-27 11:20:24 -0700 |
| commit | 929bb973dd3faf1655f03ac758942d5b009354ad (patch) | |
| tree | 56f50bd1940eae6c9aafc5a719584a355818dcbe /src | |
| parent | dde1458174882077ca799d03f0adea91286650a3 (diff) | |
| parent | 87e68db4734d89bab693744ad210560da0c20a87 (diff) | |
| download | emacs-929bb973dd3faf1655f03ac758942d5b009354ad.tar.gz emacs-929bb973dd3faf1655f03ac758942d5b009354ad.zip | |
Merge from trunk.
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 42 | ||||
| -rw-r--r-- | src/gnutls.c | 322 | ||||
| -rw-r--r-- | src/gnutls.h | 5 | ||||
| -rw-r--r-- | src/image.c | 2 | ||||
| -rw-r--r-- | src/process.c | 8 | ||||
| -rw-r--r-- | src/w32.c | 6 | ||||
| -rw-r--r-- | src/w32fns.c | 15 | ||||
| -rw-r--r-- | src/w32font.c | 4 | ||||
| -rw-r--r-- | src/w32reg.c | 7 | ||||
| -rw-r--r-- | src/window.c | 40 |
10 files changed, 229 insertions, 222 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index bdb3434558c..a13039896dd 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | 2011-10-26 Paul Eggert <eggert@cs.ucla.edu> | 1 | 2011-10-27 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 2 | ||
| 3 | Fix integer width and related bugs (Bug#9874). | 3 | Fix integer width and related bugs (Bug#9874). |
| 4 | * alloc.c (pure_bytes_used_lisp, pure_bytes_used_non_lisp): | 4 | * alloc.c (pure_bytes_used_lisp, pure_bytes_used_non_lisp): |
| @@ -786,6 +786,46 @@ | |||
| 786 | rather than rolling our own approximation. | 786 | rather than rolling our own approximation. |
| 787 | (SCROLL_BAR_VEC_SIZE): Remove; not used. | 787 | (SCROLL_BAR_VEC_SIZE): Remove; not used. |
| 788 | 788 | ||
| 789 | 2011-10-27 Juanma Barranquero <lekktu@gmail.com> | ||
| 790 | |||
| 791 | * window.c (Fframe_root_window, Fframe_first_window, Fwindow_end) | ||
| 792 | (Fframe_selected_window, Ftemp_output_buffer_show, Fnext_window) | ||
| 793 | (Fdelete_window_internal, Fwindow_parameters): Fix typos in docstrings. | ||
| 794 | (Fmove_to_window_line): Doc fix. | ||
| 795 | |||
| 796 | 2011-10-27 Chong Yidong <cyd@gnu.org> | ||
| 797 | |||
| 798 | * process.c (make_process): Set gnutls_state to NULL. | ||
| 799 | |||
| 800 | * gnutls.c (emacs_gnutls_deinit): Deinit the gnutls_state if it is | ||
| 801 | non-NULL, regardless of GNUTLS_INITSTAGE. | ||
| 802 | (Fgnutls_boot): Cleanups. Call emacs_gnutls_deinit if we signal | ||
| 803 | an error. Set process slots as soon as we allocate them. | ||
| 804 | |||
| 805 | * gnutls.h (GNUTLS_LOG, GNUTLS_LOG2): Fix macros. | ||
| 806 | |||
| 807 | 2011-10-27 Chong Yidong <cyd@gnu.org> | ||
| 808 | |||
| 809 | * gnutls.c (emacs_gnutls_deinit): New function. Deallocate | ||
| 810 | credentials structures as well as calling gnutls_deinit. | ||
| 811 | (Fgnutls_deinit, Fgnutls_boot): Use it. | ||
| 812 | |||
| 813 | * process.c (make_process): Initialize GnuTLS credentials to NULL. | ||
| 814 | (deactivate_process): Call emacs_gnutls_deinit. | ||
| 815 | |||
| 816 | 2011-10-27 Juanma Barranquero <lekktu@gmail.com> | ||
| 817 | |||
| 818 | * image.c (x_create_x_image_and_pixmap): | ||
| 819 | * w32.c (sys_rename, w32_delayed_load): | ||
| 820 | * w32font.c (fill_in_logfont): | ||
| 821 | * w32reg.c (x_get_string_resource): Silence compiler warnings. | ||
| 822 | |||
| 823 | 2011-10-26 Juanma Barranquero <lekktu@gmail.com> | ||
| 824 | |||
| 825 | * w32fns.c (w32_default_color_map): New function, | ||
| 826 | extracted from Fw32_default_color_map. | ||
| 827 | (Fw32_default_color_map, Fx_open_connection): Use it. (Bug#9785) | ||
| 828 | |||
| 789 | 2011-10-25 Paul Eggert <eggert@cs.ucla.edu> | 829 | 2011-10-25 Paul Eggert <eggert@cs.ucla.edu> |
| 790 | 830 | ||
| 791 | * dispextern.h (Fcontrolling_tty_p): New decl (Bug#6649 part 2). | 831 | * dispextern.h (Fcontrolling_tty_p): New decl (Bug#6649 part 2). |
diff --git a/src/gnutls.c b/src/gnutls.c index f01a74dbf31..9dda184d251 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 | ||
| 467 | Lisp_Object | ||
| 468 | emacs_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 | |||
| 467 | DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0, | 505 | DEFUN ("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. |
| 469 | See also `gnutls-boot'. */) | 507 | See also `gnutls-boot'. */) |
| @@ -551,18 +589,7 @@ DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, | |||
| 551 | See also `gnutls-init'. */) | 589 | See 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 | ||
| 568 | DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, | 595 | DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, |
| @@ -622,7 +649,7 @@ emacs_gnutls_global_deinit (void) | |||
| 622 | 649 | ||
| 623 | DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0, | 650 | DEFUN ("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. |
| 625 | Currently only client mode is supported. Returns a success/failure | 652 | Currently only client mode is supported. Return a success/failure |
| 626 | value you can check with `gnutls-errorp'. | 653 | value you can check with `gnutls-errorp'. |
| 627 | 654 | ||
| 628 | TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'. | 655 | TYPE 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,21 +732,23 @@ 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; | 754 | state = XPROCESS (proc)->gnutls_state; |
| @@ -749,82 +767,56 @@ one trustfile (usually a CA bundle). */) | |||
| 749 | if (! NILP (Fgnutls_errorp (global_init))) | 767 | if (! NILP (Fgnutls_errorp (global_init))) |
| 750 | return global_init; | 768 | return global_init; |
| 751 | 769 | ||
| 752 | /* deinit and free resources. */ | 770 | /* Before allocating new credentials, deallocate any credentials |
| 753 | if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_CRED_ALLOC) | 771 | that PROC might already have. */ |
| 754 | { | 772 | 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 | 773 | ||
| 774 | /* Mark PROC as a GnuTLS process. */ | ||
| 775 | XPROCESS (proc)->gnutls_p = 1; | ||
| 776 | XPROCESS (proc)->gnutls_state = NULL; | ||
| 777 | XPROCESS (proc)->gnutls_x509_cred = NULL; | ||
| 778 | XPROCESS (proc)->gnutls_anon_cred = NULL; | ||
| 779 | XPROCESS (proc)->gnutls_cred_type = type; | ||
| 782 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY; | 780 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY; |
| 783 | 781 | ||
| 784 | GNUTLS_LOG (1, max_log_level, "allocating credentials"); | 782 | GNUTLS_LOG (1, max_log_level, "allocating credentials"); |
| 785 | |||
| 786 | if (EQ (type, Qgnutls_x509pki)) | 783 | if (EQ (type, Qgnutls_x509pki)) |
| 787 | { | 784 | { |
| 785 | Lisp_Object verify_flags; | ||
| 786 | unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT; | ||
| 787 | |||
| 788 | GNUTLS_LOG (2, max_log_level, "allocating x509 credentials"); | 788 | 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); | 789 | fn_gnutls_certificate_allocate_credentials (&x509_cred); |
| 790 | XPROCESS (proc)->gnutls_x509_cred = x509_cred; | ||
| 791 | 791 | ||
| 792 | verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags); | ||
| 792 | if (NUMBERP (verify_flags)) | 793 | if (NUMBERP (verify_flags)) |
| 793 | { | 794 | { |
| 794 | gnutls_verify_flags = XINT (verify_flags); | 795 | gnutls_verify_flags = XINT (verify_flags); |
| 795 | GNUTLS_LOG (2, max_log_level, "setting verification flags"); | 796 | GNUTLS_LOG (2, max_log_level, "setting verification flags"); |
| 796 | } | 797 | } |
| 797 | else if (NILP (verify_flags)) | 798 | else if (NILP (verify_flags)) |
| 798 | { | 799 | 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 | 800 | else |
| 803 | { | 801 | GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags"); |
| 804 | /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */ | 802 | |
| 805 | GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags"); | ||
| 806 | } | ||
| 807 | fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags); | 803 | fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags); |
| 808 | } | 804 | } |
| 809 | else if (EQ (type, Qgnutls_anon)) | 805 | else /* Qgnutls_anon: */ |
| 810 | { | 806 | { |
| 811 | GNUTLS_LOG (2, max_log_level, "allocating anon credentials"); | 807 | 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); | 808 | fn_gnutls_anon_allocate_client_credentials (&anon_cred); |
| 809 | XPROCESS (proc)->gnutls_anon_cred = anon_cred; | ||
| 814 | } | 810 | } |
| 815 | else | ||
| 816 | { | ||
| 817 | error ("unknown credential type"); | ||
| 818 | ret = GNUTLS_EMACS_ERROR_INVALID_TYPE; | ||
| 819 | } | ||
| 820 | |||
| 821 | if (ret < GNUTLS_E_SUCCESS) | ||
| 822 | return gnutls_make_error (ret); | ||
| 823 | 811 | ||
| 824 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC; | 812 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC; |
| 825 | 813 | ||
| 826 | if (EQ (type, Qgnutls_x509pki)) | 814 | if (EQ (type, Qgnutls_x509pki)) |
| 827 | { | 815 | { |
| 816 | /* TODO: GNUTLS_X509_FMT_DER is also an option. */ | ||
| 817 | int file_format = GNUTLS_X509_FMT_PEM; | ||
| 818 | Lisp_Object tail; | ||
| 819 | |||
| 828 | for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail)) | 820 | for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail)) |
| 829 | { | 821 | { |
| 830 | Lisp_Object trustfile = Fcar (tail); | 822 | Lisp_Object trustfile = Fcar (tail); |
| @@ -842,8 +834,8 @@ one trustfile (usually a CA bundle). */) | |||
| 842 | } | 834 | } |
| 843 | else | 835 | else |
| 844 | { | 836 | { |
| 845 | error ("Sorry, GnuTLS can't use non-string trustfile %s", | 837 | emacs_gnutls_deinit (proc); |
| 846 | SDATA (trustfile)); | 838 | error ("Invalid trustfile"); |
| 847 | } | 839 | } |
| 848 | } | 840 | } |
| 849 | 841 | ||
| @@ -855,17 +847,15 @@ one trustfile (usually a CA bundle). */) | |||
| 855 | GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ", | 847 | GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ", |
| 856 | SSDATA (crlfile)); | 848 | SSDATA (crlfile)); |
| 857 | ret = fn_gnutls_certificate_set_x509_crl_file | 849 | ret = fn_gnutls_certificate_set_x509_crl_file |
| 858 | (x509_cred, | 850 | (x509_cred, SSDATA (crlfile), file_format); |
| 859 | SSDATA (crlfile), | ||
| 860 | file_format); | ||
| 861 | 851 | ||
| 862 | if (ret < GNUTLS_E_SUCCESS) | 852 | if (ret < GNUTLS_E_SUCCESS) |
| 863 | return gnutls_make_error (ret); | 853 | return gnutls_make_error (ret); |
| 864 | } | 854 | } |
| 865 | else | 855 | else |
| 866 | { | 856 | { |
| 867 | error ("Sorry, GnuTLS can't use non-string CRL file %s", | 857 | emacs_gnutls_deinit (proc); |
| 868 | SDATA (crlfile)); | 858 | error ("Invalid CRL file"); |
| 869 | } | 859 | } |
| 870 | } | 860 | } |
| 871 | 861 | ||
| @@ -880,45 +870,31 @@ one trustfile (usually a CA bundle). */) | |||
| 880 | GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ", | 870 | GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ", |
| 881 | SSDATA (certfile)); | 871 | SSDATA (certfile)); |
| 882 | ret = fn_gnutls_certificate_set_x509_key_file | 872 | ret = fn_gnutls_certificate_set_x509_key_file |
| 883 | (x509_cred, | 873 | (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format); |
| 884 | SSDATA (certfile), | ||
| 885 | SSDATA (keyfile), | ||
| 886 | file_format); | ||
| 887 | 874 | ||
| 888 | if (ret < GNUTLS_E_SUCCESS) | 875 | if (ret < GNUTLS_E_SUCCESS) |
| 889 | return gnutls_make_error (ret); | 876 | return gnutls_make_error (ret); |
| 890 | } | 877 | } |
| 891 | else | 878 | else |
| 892 | { | 879 | { |
| 893 | if (STRINGP (keyfile)) | 880 | emacs_gnutls_deinit (proc); |
| 894 | error ("Sorry, GnuTLS can't use non-string client cert file %s", | 881 | error (STRINGP (keyfile) ? "Invalid client cert file" |
| 895 | SDATA (certfile)); | 882 | : "Invalid client key file"); |
| 896 | else | ||
| 897 | error ("Sorry, GnuTLS can't use non-string client key file %s", | ||
| 898 | SDATA (keyfile)); | ||
| 899 | } | 883 | } |
| 900 | } | 884 | } |
| 901 | } | 885 | } |
| 902 | 886 | ||
| 903 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES; | 887 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES; |
| 904 | |||
| 905 | GNUTLS_LOG (1, max_log_level, "gnutls callbacks"); | 888 | GNUTLS_LOG (1, max_log_level, "gnutls callbacks"); |
| 906 | |||
| 907 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS; | 889 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS; |
| 908 | 890 | ||
| 909 | #ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY | 891 | /* Call gnutls_init here: */ |
| 910 | #else | ||
| 911 | #endif | ||
| 912 | 892 | ||
| 913 | GNUTLS_LOG (1, max_log_level, "gnutls_init"); | 893 | GNUTLS_LOG (1, max_log_level, "gnutls_init"); |
| 914 | |||
| 915 | ret = fn_gnutls_init (&state, GNUTLS_CLIENT); | 894 | ret = fn_gnutls_init (&state, GNUTLS_CLIENT); |
| 916 | 895 | XPROCESS (proc)->gnutls_state = state; | |
| 917 | if (ret < GNUTLS_E_SUCCESS) | 896 | if (ret < GNUTLS_E_SUCCESS) |
| 918 | return gnutls_make_error (ret); | 897 | return gnutls_make_error (ret); |
| 919 | |||
| 920 | XPROCESS (proc)->gnutls_state = state; | ||
| 921 | |||
| 922 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT; | 898 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT; |
| 923 | 899 | ||
| 924 | if (STRINGP (priority_string)) | 900 | if (STRINGP (priority_string)) |
| @@ -934,46 +910,25 @@ one trustfile (usually a CA bundle). */) | |||
| 934 | } | 910 | } |
| 935 | 911 | ||
| 936 | GNUTLS_LOG (1, max_log_level, "setting the priority string"); | 912 | GNUTLS_LOG (1, max_log_level, "setting the priority string"); |
| 937 | |||
| 938 | ret = fn_gnutls_priority_set_direct (state, | 913 | ret = fn_gnutls_priority_set_direct (state, |
| 939 | priority_string_ptr, | 914 | priority_string_ptr, |
| 940 | NULL); | 915 | NULL); |
| 941 | |||
| 942 | if (ret < GNUTLS_E_SUCCESS) | 916 | if (ret < GNUTLS_E_SUCCESS) |
| 943 | return gnutls_make_error (ret); | 917 | return gnutls_make_error (ret); |
| 944 | 918 | ||
| 945 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY; | 919 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY; |
| 946 | 920 | ||
| 947 | if (!EQ (prime_bits, Qnil)) | 921 | if (INTEGERP (prime_bits)) |
| 948 | { | 922 | 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 | 923 | ||
| 924 | ret = EQ (type, Qgnutls_x509pki) | ||
| 925 | ? fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred) | ||
| 926 | : fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred); | ||
| 966 | if (ret < GNUTLS_E_SUCCESS) | 927 | if (ret < GNUTLS_E_SUCCESS) |
| 967 | return gnutls_make_error (ret); | 928 | return gnutls_make_error (ret); |
| 968 | 929 | ||
| 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; | 930 | GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET; |
| 974 | |||
| 975 | ret = emacs_gnutls_handshake (XPROCESS (proc)); | 931 | ret = emacs_gnutls_handshake (XPROCESS (proc)); |
| 976 | |||
| 977 | if (ret < GNUTLS_E_SUCCESS) | 932 | if (ret < GNUTLS_E_SUCCESS) |
| 978 | return gnutls_make_error (ret); | 933 | return gnutls_make_error (ret); |
| 979 | 934 | ||
| @@ -984,69 +939,71 @@ one trustfile (usually a CA bundle). */) | |||
| 984 | gnutls_x509_crt_check_hostname() against :hostname. */ | 939 | gnutls_x509_crt_check_hostname() against :hostname. */ |
| 985 | 940 | ||
| 986 | ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification); | 941 | ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification); |
| 987 | |||
| 988 | if (ret < GNUTLS_E_SUCCESS) | 942 | if (ret < GNUTLS_E_SUCCESS) |
| 989 | return gnutls_make_error (ret); | 943 | return gnutls_make_error (ret); |
| 990 | 944 | ||
| 991 | if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID) | 945 | if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID) |
| 992 | message ("%s certificate could not be verified.", | 946 | message ("%s certificate could not be verified.", c_hostname); |
| 993 | c_hostname); | 947 | |
| 994 | 948 | if (peer_verification & GNUTLS_CERT_REVOKED) | |
| 995 | if (peer_verification & GNUTLS_CERT_REVOKED) | 949 | GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):", |
| 996 | GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):", | 950 | c_hostname); |
| 997 | c_hostname); | 951 | |
| 998 | 952 | if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND) | |
| 999 | if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND) | 953 | GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:", |
| 1000 | GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:", | 954 | c_hostname); |
| 1001 | c_hostname); | 955 | |
| 1002 | 956 | if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA) | |
| 1003 | if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA) | 957 | 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:", | 958 | c_hostname); |
| 1005 | c_hostname); | 959 | |
| 1006 | 960 | if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM) | |
| 1007 | if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM) | 961 | GNUTLS_LOG2 (1, max_log_level, |
| 1008 | GNUTLS_LOG2 (1, max_log_level, | 962 | "certificate was signed with an insecure algorithm:", |
| 1009 | "certificate was signed with an insecure algorithm:", | 963 | c_hostname); |
| 1010 | c_hostname); | 964 | |
| 1011 | 965 | if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED) | |
| 1012 | if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED) | 966 | GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:", |
| 1013 | GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:", | 967 | c_hostname); |
| 1014 | c_hostname); | 968 | |
| 1015 | 969 | if (peer_verification & GNUTLS_CERT_EXPIRED) | |
| 1016 | if (peer_verification & GNUTLS_CERT_EXPIRED) | 970 | GNUTLS_LOG2 (1, max_log_level, "certificate has expired:", |
| 1017 | GNUTLS_LOG2 (1, max_log_level, "certificate has expired:", | 971 | c_hostname); |
| 1018 | c_hostname); | 972 | |
| 1019 | 973 | if (peer_verification != 0) | |
| 1020 | if (peer_verification != 0) | 974 | { |
| 1021 | { | 975 | if (NILP (verify_hostname_error)) |
| 1022 | if (NILP (verify_hostname_error)) | 976 | GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:", |
| 1023 | { | 977 | c_hostname); |
| 1024 | GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:", | 978 | else |
| 1025 | c_hostname); | 979 | { |
| 1026 | } | 980 | emacs_gnutls_deinit (proc); |
| 1027 | else | 981 | error ("Certificate validation failed %s, verification code %d", |
| 1028 | { | 982 | c_hostname, peer_verification); |
| 1029 | error ("Certificate validation failed %s, verification code %d", | 983 | } |
| 1030 | c_hostname, peer_verification); | 984 | } |
| 1031 | } | ||
| 1032 | } | ||
| 1033 | 985 | ||
| 1034 | /* Up to here the process is the same for X.509 certificates and | 986 | /* 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 | 987 | OpenPGP keys. From now on X.509 certificates are assumed. This |
| 1036 | can be easily extended to work with openpgp keys as well. */ | 988 | can be easily extended to work with openpgp keys as well. */ |
| 1037 | if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509) | 989 | if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509) |
| 1038 | { | 990 | { |
| 1039 | ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert); | 991 | gnutls_x509_crt_t gnutls_verify_cert; |
| 992 | const gnutls_datum_t *gnutls_verify_cert_list; | ||
| 993 | unsigned int gnutls_verify_cert_list_size; | ||
| 1040 | 994 | ||
| 995 | ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert); | ||
| 1041 | if (ret < GNUTLS_E_SUCCESS) | 996 | if (ret < GNUTLS_E_SUCCESS) |
| 1042 | return gnutls_make_error (ret); | 997 | return gnutls_make_error (ret); |
| 1043 | 998 | ||
| 1044 | gnutls_verify_cert_list = | 999 | gnutls_verify_cert_list = |
| 1045 | fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size); | 1000 | fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size); |
| 1046 | 1001 | ||
| 1047 | if (NULL == gnutls_verify_cert_list) | 1002 | if (gnutls_verify_cert_list == NULL) |
| 1048 | { | 1003 | { |
| 1049 | error ("No x509 certificate was found!\n"); | 1004 | fn_gnutls_x509_crt_deinit (gnutls_verify_cert); |
| 1005 | emacs_gnutls_deinit (proc); | ||
| 1006 | error ("No x509 certificate was found\n"); | ||
| 1050 | } | 1007 | } |
| 1051 | 1008 | ||
| 1052 | /* We only check the first certificate in the given chain. */ | 1009 | /* We only check the first certificate in the given chain. */ |
| @@ -1063,18 +1020,15 @@ one trustfile (usually a CA bundle). */) | |||
| 1063 | if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname)) | 1020 | if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname)) |
| 1064 | { | 1021 | { |
| 1065 | if (NILP (verify_hostname_error)) | 1022 | if (NILP (verify_hostname_error)) |
| 1066 | { | 1023 | GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:", |
| 1067 | GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:", | 1024 | c_hostname); |
| 1068 | c_hostname); | ||
| 1069 | } | ||
| 1070 | else | 1025 | else |
| 1071 | { | 1026 | { |
| 1072 | fn_gnutls_x509_crt_deinit (gnutls_verify_cert); | 1027 | fn_gnutls_x509_crt_deinit (gnutls_verify_cert); |
| 1073 | error ("The x509 certificate does not match \"%s\"", | 1028 | emacs_gnutls_deinit (proc); |
| 1074 | c_hostname); | 1029 | error ("The x509 certificate does not match \"%s\"", c_hostname); |
| 1075 | } | 1030 | } |
| 1076 | } | 1031 | } |
| 1077 | |||
| 1078 | fn_gnutls_x509_crt_deinit (gnutls_verify_cert); | 1032 | fn_gnutls_x509_crt_deinit (gnutls_verify_cert); |
| 1079 | } | 1033 | } |
| 1080 | 1034 | ||
diff --git a/src/gnutls.h b/src/gnutls.h index 83eeb7247eb..ddb47137e6e 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 | ||
| 56 | extern ptrdiff_t | 56 | extern ptrdiff_t |
| 57 | emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte); | 57 | emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte); |
| @@ -60,6 +60,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte); | |||
| 60 | 60 | ||
| 61 | extern int emacs_gnutls_record_check_pending (gnutls_session_t state); | 61 | extern int emacs_gnutls_record_check_pending (gnutls_session_t state); |
| 62 | extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); | 62 | extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); |
| 63 | extern Lisp_Object emacs_gnutls_deinit (Lisp_Object); | ||
| 63 | 64 | ||
| 64 | extern void syms_of_gnutls (void); | 65 | extern void syms_of_gnutls (void); |
| 65 | 66 | ||
diff --git a/src/image.c b/src/image.c index 8eb51942675..4453d2aa8d8 100644 --- a/src/image.c +++ b/src/image.c | |||
| @@ -2016,7 +2016,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, | |||
| 2016 | /* Bitmaps with a depth less than 16 need a palette. */ | 2016 | /* Bitmaps with a depth less than 16 need a palette. */ |
| 2017 | /* BITMAPINFO structure already contains the first RGBQUAD. */ | 2017 | /* BITMAPINFO structure already contains the first RGBQUAD. */ |
| 2018 | if (depth < 16) | 2018 | if (depth < 16) |
| 2019 | palette_colors = 1 << depth - 1; | 2019 | palette_colors = 1 << (depth - 1); |
| 2020 | 2020 | ||
| 2021 | *ximg = xmalloc (sizeof (XImage) + palette_colors * sizeof (RGBQUAD)); | 2021 | *ximg = xmalloc (sizeof (XImage) + palette_colors * sizeof (RGBQUAD)); |
| 2022 | 2022 | ||
diff --git a/src/process.c b/src/process.c index f04f4611ab7..716e74758c4 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. */ |
| @@ -3863,6 +3866,11 @@ deactivate_process (Lisp_Object proc) | |||
| 3863 | register int inchannel, outchannel; | 3866 | register int inchannel, outchannel; |
| 3864 | register struct Lisp_Process *p = XPROCESS (proc); | 3867 | register struct Lisp_Process *p = XPROCESS (proc); |
| 3865 | 3868 | ||
| 3869 | #ifdef HAVE_GNUTLS | ||
| 3870 | /* Delete GnuTLS structures in PROC, if any. */ | ||
| 3871 | emacs_gnutls_deinit (proc); | ||
| 3872 | #endif /* HAVE_GNUTLS */ | ||
| 3873 | |||
| 3866 | inchannel = p->infd; | 3874 | inchannel = p->infd; |
| 3867 | outchannel = p->outfd; | 3875 | outchannel = p->outfd; |
| 3868 | 3876 | ||
| @@ -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 5c135b2e46d..92fcac92c4e 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 | ||
| 638 | DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map, | 638 | static Lisp_Object |
| 639 | 0, 0, 0, doc: /* Return the default color map. */) | 639 | w32_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 | ||
| 660 | DEFUN ("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 | |||
| 661 | static Lisp_Object | 667 | static Lisp_Object |
| 662 | w32_color_map_lookup (char *colorname) | 668 | w32_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 | |||
diff --git a/src/window.c b/src/window.c index 389d03fc9fd..dfaef1854a4 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -175,10 +175,10 @@ WINDOW can be any window and defaults to the selected one. */) | |||
| 175 | } | 175 | } |
| 176 | 176 | ||
| 177 | DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0, | 177 | DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0, |
| 178 | doc: /* Return the root window of FRAME_OR_WINDOW. | 178 | doc: /* Return the root window of FRAME-OR-WINDOW. |
| 179 | If omitted, FRAME_OR_WINDOW defaults to the currently selected frame. | 179 | If omitted, FRAME-OR-WINDOW defaults to the currently selected frame. |
| 180 | Else if FRAME_OR_WINDOW denotes any window, return the root window of | 180 | Else if FRAME-OR-WINDOW denotes any window, return the root window of |
| 181 | that window's frame. If FRAME_OR_WINDOW denotes a live frame, return | 181 | that window's frame. If FRAME-OR-WINDOW denotes a live frame, return |
| 182 | the root window of that frame. */) | 182 | the root window of that frame. */) |
| 183 | (Lisp_Object frame_or_window) | 183 | (Lisp_Object frame_or_window) |
| 184 | { | 184 | { |
| @@ -220,10 +220,10 @@ WINDOW can be any window and defaults to the selected one. */) | |||
| 220 | 220 | ||
| 221 | /* Don't move this to window.el - this must be a safe routine. */ | 221 | /* Don't move this to window.el - this must be a safe routine. */ |
| 222 | DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0, | 222 | DEFUN ("frame-first-window", Fframe_first_window, Sframe_first_window, 0, 1, 0, |
| 223 | doc: /* Return the topmost, leftmost live window on FRAME_OR_WINDOW. | 223 | doc: /* Return the topmost, leftmost live window on FRAME-OR-WINDOW. |
| 224 | If omitted, FRAME_OR_WINDOW defaults to the currently selected frame. | 224 | If omitted, FRAME-OR-WINDOW defaults to the currently selected frame. |
| 225 | Else if FRAME_OR_WINDOW denotes any window, return the first window of | 225 | Else if FRAME-OR-WINDOW denotes any window, return the first window of |
| 226 | that window's frame. If FRAME_OR_WINDOW denotes a live frame, return | 226 | that window's frame. If FRAME-OR-WINDOW denotes a live frame, return |
| 227 | the first window of that frame. */) | 227 | the first window of that frame. */) |
| 228 | (Lisp_Object frame_or_window) | 228 | (Lisp_Object frame_or_window) |
| 229 | { | 229 | { |
| @@ -254,10 +254,10 @@ the first window of that frame. */) | |||
| 254 | 254 | ||
| 255 | DEFUN ("frame-selected-window", Fframe_selected_window, | 255 | DEFUN ("frame-selected-window", Fframe_selected_window, |
| 256 | Sframe_selected_window, 0, 1, 0, | 256 | Sframe_selected_window, 0, 1, 0, |
| 257 | doc: /* Return the selected window of FRAME_OR_WINDOW. | 257 | doc: /* Return the selected window of FRAME-OR-WINDOW. |
| 258 | If omitted, FRAME_OR_WINDOW defaults to the currently selected frame. | 258 | If omitted, FRAME-OR-WINDOW defaults to the currently selected frame. |
| 259 | Else if FRAME_OR_WINDOW denotes any window, return the selected window | 259 | Else if FRAME-OR-WINDOW denotes any window, return the selected window |
| 260 | of that window's frame. If FRAME_OR_WINDOW denotes a live frame, return | 260 | of that window's frame. If FRAME-OR-WINDOW denotes a live frame, return |
| 261 | the selected window of that frame. */) | 261 | the selected window of that frame. */) |
| 262 | (Lisp_Object frame_or_window) | 262 | (Lisp_Object frame_or_window) |
| 263 | { | 263 | { |
| @@ -1297,7 +1297,7 @@ WINDOW must be a live window and defaults to the selected one. | |||
| 1297 | This is updated by redisplay, when it runs to completion. | 1297 | This is updated by redisplay, when it runs to completion. |
| 1298 | Simply changing the buffer text or setting `window-start' | 1298 | Simply changing the buffer text or setting `window-start' |
| 1299 | does not update this value. | 1299 | does not update this value. |
| 1300 | Return nil if there is no recorded value. \(This can happen if the | 1300 | Return nil if there is no recorded value. (This can happen if the |
| 1301 | last redisplay of WINDOW was preempted, and did not finish.) | 1301 | last redisplay of WINDOW was preempted, and did not finish.) |
| 1302 | If UPDATE is non-nil, compute the up-to-date position | 1302 | If UPDATE is non-nil, compute the up-to-date position |
| 1303 | if it isn't already recorded. */) | 1303 | if it isn't already recorded. */) |
| @@ -1689,7 +1689,7 @@ DEFUN ("window-parameters", Fwindow_parameters, Swindow_parameters, | |||
| 1689 | 0, 1, 0, | 1689 | 0, 1, 0, |
| 1690 | doc: /* Return the parameters of WINDOW and their values. | 1690 | doc: /* Return the parameters of WINDOW and their values. |
| 1691 | WINDOW defaults to the selected window. The return value is a list of | 1691 | WINDOW defaults to the selected window. The return value is a list of |
| 1692 | elements of the form (PARAMETER . VALUE). */) | 1692 | elements of the form (PARAMETER . VALUE). */) |
| 1693 | (Lisp_Object window) | 1693 | (Lisp_Object window) |
| 1694 | { | 1694 | { |
| 1695 | return Fcopy_alist (decode_any_window (window)->window_parameters); | 1695 | return Fcopy_alist (decode_any_window (window)->window_parameters); |
| @@ -2194,7 +2194,7 @@ next_window (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames, in | |||
| 2194 | 2194 | ||
| 2195 | DEFUN ("next-window", Fnext_window, Snext_window, 0, 3, 0, | 2195 | DEFUN ("next-window", Fnext_window, Snext_window, 0, 3, 0, |
| 2196 | doc: /* Return window following WINDOW in cyclic ordering of windows. | 2196 | doc: /* Return window following WINDOW in cyclic ordering of windows. |
| 2197 | WINDOW must be a live window and defaults to the selected one. The | 2197 | WINDOW must be a live window and defaults to the selected one. The |
| 2198 | optional arguments MINIBUF and ALL-FRAMES specify the set of windows to | 2198 | optional arguments MINIBUF and ALL-FRAMES specify the set of windows to |
| 2199 | consider. | 2199 | consider. |
| 2200 | 2200 | ||
| @@ -3225,7 +3225,7 @@ temp_output_buffer_show (register Lisp_Object buf) | |||
| 3225 | DEFUN ("internal-temp-output-buffer-show", | 3225 | DEFUN ("internal-temp-output-buffer-show", |
| 3226 | Ftemp_output_buffer_show, Stemp_output_buffer_show, | 3226 | Ftemp_output_buffer_show, Stemp_output_buffer_show, |
| 3227 | 1, 1, 0, | 3227 | 1, 1, 0, |
| 3228 | doc: /* Internal function for `with-output-to-temp-buffer''. */) | 3228 | doc: /* Internal function for `with-output-to-temp-buffer'. */) |
| 3229 | (Lisp_Object buf) | 3229 | (Lisp_Object buf) |
| 3230 | { | 3230 | { |
| 3231 | temp_output_buffer_show (buf); | 3231 | temp_output_buffer_show (buf); |
| @@ -3846,8 +3846,8 @@ set correctly. See the code of `split-window' for how this is done. */) | |||
| 3846 | 3846 | ||
| 3847 | DEFUN ("delete-window-internal", Fdelete_window_internal, Sdelete_window_internal, 1, 1, 0, | 3847 | DEFUN ("delete-window-internal", Fdelete_window_internal, Sdelete_window_internal, 1, 1, 0, |
| 3848 | doc: /* Remove WINDOW from its frame. | 3848 | doc: /* Remove WINDOW from its frame. |
| 3849 | WINDOW defaults to the selected window. Return nil. Signal an error | 3849 | WINDOW defaults to the selected window. Return nil. |
| 3850 | when WINDOW is the only window on its frame. */) | 3850 | Signal an error when WINDOW is the only window on its frame. */) |
| 3851 | (register Lisp_Object window) | 3851 | (register Lisp_Object window) |
| 3852 | { | 3852 | { |
| 3853 | register Lisp_Object parent, sibling, frame, root; | 3853 | register Lisp_Object parent, sibling, frame, root; |
| @@ -5227,8 +5227,8 @@ any partial-height lines in the text display area. */) | |||
| 5227 | DEFUN ("move-to-window-line", Fmove_to_window_line, Smove_to_window_line, | 5227 | DEFUN ("move-to-window-line", Fmove_to_window_line, Smove_to_window_line, |
| 5228 | 1, 1, "P", | 5228 | 1, 1, "P", |
| 5229 | doc: /* Position point relative to window. | 5229 | doc: /* Position point relative to window. |
| 5230 | With no argument, position point at center of window. | 5230 | ARG nil means position point at center of window. |
| 5231 | An argument specifies vertical position within the window; | 5231 | Else, ARG specifies vertical position within the window; |
| 5232 | zero means top of window, negative means relative to bottom of window. */) | 5232 | zero means top of window, negative means relative to bottom of window. */) |
| 5233 | (Lisp_Object arg) | 5233 | (Lisp_Object arg) |
| 5234 | { | 5234 | { |