diff options
| author | Joakim Verona | 2015-01-15 14:54:25 +0100 |
|---|---|---|
| committer | Joakim Verona | 2015-01-15 14:54:25 +0100 |
| commit | 0298a2c6a10bc3b79cb2f45a1961dd7ac6da4e6d (patch) | |
| tree | 6c7ea25ac137f5764d931e841598a3c1ea434ab0 | |
| parent | a1124bc117e41019de49c82d13d1a72a50df977d (diff) | |
| parent | 0e97c44c3699c4606a04f589828acdf9c03f447e (diff) | |
| download | emacs-0298a2c6a10bc3b79cb2f45a1961dd7ac6da4e6d.tar.gz emacs-0298a2c6a10bc3b79cb2f45a1961dd7ac6da4e6d.zip | |
merge master
64 files changed, 2040 insertions, 609 deletions
diff --git a/admin/ChangeLog b/admin/ChangeLog index dc029a0be0c..2b04281f400 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog | |||
| @@ -1,3 +1,10 @@ | |||
| 1 | 2015-01-12 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Say "ELC foo.elc" instead of "GEN foo.elc" | ||
| 4 | * unidata/Makefile.in (AM_V_ELC, am__v_ELC_, am__v_ELC_0) | ||
| 5 | (am__v_ELC_1): New macros. | ||
| 6 | (%.elc): Use them. | ||
| 7 | |||
| 1 | 2015-01-08 Glenn Morris <rgm@gnu.org> | 8 | 2015-01-08 Glenn Morris <rgm@gnu.org> |
| 2 | 9 | ||
| 3 | * authors.el (authors-aliases): Add an entry to ignore. | 10 | * authors.el (authors-aliases): Add an entry to ignore. |
diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index 777d1270fff..1396f0926f4 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in | |||
| @@ -34,6 +34,11 @@ emacs = "${EMACS}" -batch --no-site-file --no-site-lisp | |||
| 34 | # 'make' verbosity. | 34 | # 'make' verbosity. |
| 35 | AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ | 35 | AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ |
| 36 | 36 | ||
| 37 | AM_V_ELC = $(am__v_ELC_@AM_V@) | ||
| 38 | am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@) | ||
| 39 | am__v_ELC_0 = @echo " ELC " $@; | ||
| 40 | am__v_ELC_1 = | ||
| 41 | |||
| 37 | AM_V_GEN = $(am__v_GEN_@AM_V@) | 42 | AM_V_GEN = $(am__v_GEN_@AM_V@) |
| 38 | am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) | 43 | am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) |
| 39 | am__v_GEN_0 = @echo " GEN " $@; | 44 | am__v_GEN_0 = @echo " GEN " $@; |
| @@ -58,7 +63,7 @@ ${top_srcdir}/src/macuvs.h: ${srcdir}/uvs.el ${srcdir}/IVD_Sequences.txt | \ | |||
| 58 | > $@ | 63 | > $@ |
| 59 | 64 | ||
| 60 | %.elc: %.el | 65 | %.elc: %.el |
| 61 | $(AM_V_GEN)${emacs} -f batch-byte-compile $< | 66 | $(AM_V_ELC)${emacs} -f batch-byte-compile $< |
| 62 | 67 | ||
| 63 | unidata.txt: ${srcdir}/UnicodeData.txt | 68 | unidata.txt: ${srcdir}/UnicodeData.txt |
| 64 | $(AM_V_GEN)sed -e 's/\([^;]*\);\(.*\)/(#x\1 "\2")/' -e 's/;/" "/g' \ | 69 | $(AM_V_GEN)sed -e 's/\([^;]*\);\(.*\)/(#x\1 "\2")/' -e 's/;/" "/g' \ |
| @@ -480,6 +480,8 @@ As a result of the above, these commands are now obsolete: | |||
| 480 | 480 | ||
| 481 | * New Modes and Packages in Emacs 25.1 | 481 | * New Modes and Packages in Emacs 25.1 |
| 482 | 482 | ||
| 483 | ** cl-generic.el provides CLOS-style multiple-dispatch generic functions. | ||
| 484 | |||
| 483 | ** scss-mode (a minor variant of css-mode) | 485 | ** scss-mode (a minor variant of css-mode) |
| 484 | 486 | ||
| 485 | ** let-alist is a new macro (and a package) that allows one to easily | 487 | ** let-alist is a new macro (and a package) that allows one to easily |
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 740359605fd..e9205fdd12a 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog | |||
| @@ -1,3 +1,20 @@ | |||
| 1 | 2015-01-13 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Don't say Fnext_read_file_uses_dialog_p is const | ||
| 4 | * make-docfile.c (write_globals): | ||
| 5 | Add a special hack for Fnext_read_file_uses_dialog_p. | ||
| 6 | |||
| 7 | 2015-01-13 Dmitry Antipov <dmantipov@yandex.ru> | ||
| 8 | |||
| 9 | Support DEFUN attributes. | ||
| 10 | * make-docfile.c (struct global): New field 'flags'. | ||
| 11 | (DEFUN_noreturn, DEFUN_const): New enum bitfields. | ||
| 12 | (add_global): Now return pointer to global. | ||
| 13 | (write_globals): Add _Noreturn and ATTRIBUTE_CONST attributes | ||
| 14 | if requested by global's flags. | ||
| 15 | (stream_match): New function. | ||
| 16 | (scan_c_stream): Recognize 'attributes:' of DEFUN. | ||
| 17 | |||
| 1 | 2015-01-10 Paul Eggert <eggert@cs.ucla.edu> | 18 | 2015-01-10 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 19 | ||
| 3 | Port to 32-bit --with-wide-int | 20 | Port to 32-bit --with-wide-int |
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index bc5420ea939..741fa4bfa42 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c | |||
| @@ -562,6 +562,7 @@ struct global | |||
| 562 | { | 562 | { |
| 563 | enum global_type type; | 563 | enum global_type type; |
| 564 | char *name; | 564 | char *name; |
| 565 | int flags; | ||
| 565 | union | 566 | union |
| 566 | { | 567 | { |
| 567 | int value; | 568 | int value; |
| @@ -569,13 +570,16 @@ struct global | |||
| 569 | } v; | 570 | } v; |
| 570 | }; | 571 | }; |
| 571 | 572 | ||
| 573 | /* Bit values for FLAGS field from the above. Applied for DEFUNs only. */ | ||
| 574 | enum { DEFUN_noreturn = 1, DEFUN_const = 2 }; | ||
| 575 | |||
| 572 | /* All the variable names we saw while scanning C sources in `-g' | 576 | /* All the variable names we saw while scanning C sources in `-g' |
| 573 | mode. */ | 577 | mode. */ |
| 574 | int num_globals; | 578 | int num_globals; |
| 575 | int num_globals_allocated; | 579 | int num_globals_allocated; |
| 576 | struct global *globals; | 580 | struct global *globals; |
| 577 | 581 | ||
| 578 | static void | 582 | static struct global * |
| 579 | add_global (enum global_type type, char *name, int value, char const *svalue) | 583 | add_global (enum global_type type, char *name, int value, char const *svalue) |
| 580 | { | 584 | { |
| 581 | /* Ignore the one non-symbol that can occur. */ | 585 | /* Ignore the one non-symbol that can occur. */ |
| @@ -601,7 +605,10 @@ add_global (enum global_type type, char *name, int value, char const *svalue) | |||
| 601 | globals[num_globals - 1].v.svalue = svalue; | 605 | globals[num_globals - 1].v.svalue = svalue; |
| 602 | else | 606 | else |
| 603 | globals[num_globals - 1].v.value = value; | 607 | globals[num_globals - 1].v.value = value; |
| 608 | globals[num_globals - 1].flags = 0; | ||
| 609 | return globals + num_globals - 1; | ||
| 604 | } | 610 | } |
| 611 | return NULL; | ||
| 605 | } | 612 | } |
| 606 | 613 | ||
| 607 | static int | 614 | static int |
| @@ -708,13 +715,7 @@ write_globals (void) | |||
| 708 | globals[i].name, globals[i].name, globals[i].name); | 715 | globals[i].name, globals[i].name, globals[i].name); |
| 709 | else | 716 | else |
| 710 | { | 717 | { |
| 711 | /* It would be nice to have a cleaner way to deal with these | 718 | if (globals[i].flags & DEFUN_noreturn) |
| 712 | special hacks. */ | ||
| 713 | if (strcmp (globals[i].name, "Fthrow") == 0 | ||
| 714 | || strcmp (globals[i].name, "Ftop_level") == 0 | ||
| 715 | || strcmp (globals[i].name, "Fkill_emacs") == 0 | ||
| 716 | || strcmp (globals[i].name, "Fexit_recursive_edit") == 0 | ||
| 717 | || strcmp (globals[i].name, "Fabort_recursive_edit") == 0) | ||
| 718 | fputs ("_Noreturn ", stdout); | 719 | fputs ("_Noreturn ", stdout); |
| 719 | 720 | ||
| 720 | printf ("EXFUN (%s, ", globals[i].name); | 721 | printf ("EXFUN (%s, ", globals[i].name); |
| @@ -726,37 +727,20 @@ write_globals (void) | |||
| 726 | printf ("%d", globals[i].v.value); | 727 | printf ("%d", globals[i].v.value); |
| 727 | putchar (')'); | 728 | putchar (')'); |
| 728 | 729 | ||
| 729 | /* It would be nice to have a cleaner way to deal with these | 730 | if (globals[i].flags & DEFUN_const) |
| 730 | special hacks, too. */ | ||
| 731 | if (strcmp (globals[i].name, "Fatom") == 0 | ||
| 732 | || strcmp (globals[i].name, "Fbyteorder") == 0 | ||
| 733 | || strcmp (globals[i].name, "Fcharacterp") == 0 | ||
| 734 | || strcmp (globals[i].name, "Fchar_or_string_p") == 0 | ||
| 735 | || strcmp (globals[i].name, "Fconsp") == 0 | ||
| 736 | || strcmp (globals[i].name, "Feq") == 0 | ||
| 737 | || strcmp (globals[i].name, "Fface_attribute_relative_p") == 0 | ||
| 738 | || strcmp (globals[i].name, "Fframe_windows_min_size") == 0 | ||
| 739 | || strcmp (globals[i].name, "Fgnutls_errorp") == 0 | ||
| 740 | || strcmp (globals[i].name, "Fidentity") == 0 | ||
| 741 | || strcmp (globals[i].name, "Fintegerp") == 0 | ||
| 742 | || strcmp (globals[i].name, "Finteractive") == 0 | ||
| 743 | || strcmp (globals[i].name, "Ffloatp") == 0 | ||
| 744 | || strcmp (globals[i].name, "Flistp") == 0 | ||
| 745 | || strcmp (globals[i].name, "Fmax_char") == 0 | ||
| 746 | || strcmp (globals[i].name, "Fnatnump") == 0 | ||
| 747 | || strcmp (globals[i].name, "Fnlistp") == 0 | ||
| 748 | || strcmp (globals[i].name, "Fnull") == 0 | ||
| 749 | || strcmp (globals[i].name, "Fnumberp") == 0 | ||
| 750 | || strcmp (globals[i].name, "Fstringp") == 0 | ||
| 751 | || strcmp (globals[i].name, "Fsymbolp") == 0 | ||
| 752 | || strcmp (globals[i].name, "Ftool_bar_height") == 0 | ||
| 753 | || strcmp (globals[i].name, "Fwindow__sanitize_window_sizes") == 0 | ||
| 754 | #ifndef WINDOWSNT | ||
| 755 | || strcmp (globals[i].name, "Fgnutls_available_p") == 0 | ||
| 756 | || strcmp (globals[i].name, "Fzlib_available_p") == 0 | ||
| 757 | #endif | ||
| 758 | || 0) | ||
| 759 | fputs (" ATTRIBUTE_CONST", stdout); | 731 | fputs (" ATTRIBUTE_CONST", stdout); |
| 732 | else if (strcmp (globals[i].name, "Fnext_read_file_uses_dialog_p") | ||
| 733 | == 0) | ||
| 734 | { | ||
| 735 | /* It would be nice to have a cleaner way to deal with this | ||
| 736 | special hack. */ | ||
| 737 | fputs (("\n" | ||
| 738 | "#if ! (defined USE_GTK || defined USE_MOTIF \\\n" | ||
| 739 | " || defined HAVE_NS || defined HAVE_NTGUI)\n" | ||
| 740 | "\tATTRIBUTE_CONST\n" | ||
| 741 | "#endif\n"), | ||
| 742 | stdout); | ||
| 743 | } | ||
| 760 | 744 | ||
| 761 | puts (";"); | 745 | puts (";"); |
| 762 | } | 746 | } |
| @@ -817,6 +801,23 @@ scan_c_file (char *filename, const char *mode) | |||
| 817 | return scan_c_stream (infile); | 801 | return scan_c_stream (infile); |
| 818 | } | 802 | } |
| 819 | 803 | ||
| 804 | /* Return 1 if next input from INFILE is equal to P, -1 if EOF, | ||
| 805 | 0 if input doesn't match. */ | ||
| 806 | |||
| 807 | static int | ||
| 808 | stream_match (FILE *infile, const char *p) | ||
| 809 | { | ||
| 810 | for (; *p; p++) | ||
| 811 | { | ||
| 812 | int c = getc (infile); | ||
| 813 | if (c == EOF) | ||
| 814 | return -1; | ||
| 815 | if (c != *p) | ||
| 816 | return 0; | ||
| 817 | } | ||
| 818 | return 1; | ||
| 819 | } | ||
| 820 | |||
| 820 | static int | 821 | static int |
| 821 | scan_c_stream (FILE *infile) | 822 | scan_c_stream (FILE *infile) |
| 822 | { | 823 | { |
| @@ -1033,7 +1034,63 @@ scan_c_stream (FILE *infile) | |||
| 1033 | 1034 | ||
| 1034 | if (generate_globals) | 1035 | if (generate_globals) |
| 1035 | { | 1036 | { |
| 1036 | add_global (FUNCTION, name, maxargs, 0); | 1037 | struct global *g = add_global (FUNCTION, name, maxargs, 0); |
| 1038 | |||
| 1039 | /* The following code tries to recognize function attributes | ||
| 1040 | specified after the docstring, e.g.: | ||
| 1041 | |||
| 1042 | DEFUN ("foo", Ffoo, Sfoo, X, Y, Z, | ||
| 1043 | doc: /\* doc *\/ | ||
| 1044 | attributes: attribute1 attribute2 ...) | ||
| 1045 | (Lisp_Object arg...) | ||
| 1046 | |||
| 1047 | Now only 'noreturn' and 'const' attributes are used. */ | ||
| 1048 | |||
| 1049 | /* Advance to the end of docstring. */ | ||
| 1050 | c = getc (infile); | ||
| 1051 | if (c == EOF) | ||
| 1052 | goto eof; | ||
| 1053 | int d = getc (infile); | ||
| 1054 | if (d == EOF) | ||
| 1055 | goto eof; | ||
| 1056 | while (1) | ||
| 1057 | { | ||
| 1058 | if (c == '*' && d == '/') | ||
| 1059 | break; | ||
| 1060 | c = d, d = getc (infile); | ||
| 1061 | if (d == EOF) | ||
| 1062 | goto eof; | ||
| 1063 | } | ||
| 1064 | /* Skip spaces, if any. */ | ||
| 1065 | do | ||
| 1066 | { | ||
| 1067 | c = getc (infile); | ||
| 1068 | if (c == EOF) | ||
| 1069 | goto eof; | ||
| 1070 | } | ||
| 1071 | while (c == ' ' || c == '\n' || c == '\r' || c == '\t'); | ||
| 1072 | /* Check for 'attributes:' token. */ | ||
| 1073 | if (c == 'a' && stream_match (infile, "ttributes:")) | ||
| 1074 | { | ||
| 1075 | char *p = input_buffer; | ||
| 1076 | /* Collect attributes up to ')'. */ | ||
| 1077 | while (1) | ||
| 1078 | { | ||
| 1079 | c = getc (infile); | ||
| 1080 | if (c == EOF) | ||
| 1081 | goto eof; | ||
| 1082 | if (c == ')') | ||
| 1083 | break; | ||
| 1084 | if (p - input_buffer > sizeof (input_buffer)) | ||
| 1085 | abort (); | ||
| 1086 | *p++ = c; | ||
| 1087 | } | ||
| 1088 | *p = 0; | ||
| 1089 | if (strstr (input_buffer, "noreturn")) | ||
| 1090 | g->flags |= DEFUN_noreturn; | ||
| 1091 | if (strstr (input_buffer, "const")) | ||
| 1092 | g->flags |= DEFUN_const; | ||
| 1093 | } | ||
| 1037 | continue; | 1094 | continue; |
| 1038 | } | 1095 | } |
| 1039 | 1096 | ||
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 674b26716a4..b7a38af9609 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,107 @@ | |||
| 1 | 2015-01-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/eieio-core.el: Provide support for cl-generic. | ||
| 4 | (eieio--generic-tagcode): New function. | ||
| 5 | (cl-generic-tagcode-function): Use it. | ||
| 6 | (eieio--generic-tag-types): New function. | ||
| 7 | (cl-generic-tag-types-function): Use it. | ||
| 8 | (eieio-object-p): Tighten up the test. | ||
| 9 | |||
| 10 | * emacs-lisp/cl-generic.el (cl-generic-define-method): Fix paren typo. | ||
| 11 | |||
| 12 | 2015-01-14 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 13 | |||
| 14 | * emacs-lisp/cl-generic.el: New file. | ||
| 15 | |||
| 16 | * emacs-lisp/cl-macs.el (cl-flet): Allow (FUN EXP) forms. | ||
| 17 | (cl-load-time-value, cl-labels): Use closures rather than | ||
| 18 | backquoted lambdas. | ||
| 19 | (cl-macrolet): Use `eval' to create the function value, and support CL | ||
| 20 | style arguments in for the defined macros. | ||
| 21 | |||
| 22 | 2015-01-14 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 23 | |||
| 24 | * net/eww.el: Use lexical-binding. | ||
| 25 | (eww-links-at-point): Remove unused arg. | ||
| 26 | (eww-mode-map): Inherit from special-mode-map. | ||
| 27 | (eww-mode): Derive from special-mode. Don't use `setq' on a hook. | ||
| 28 | |||
| 29 | 2015-01-13 Alan Mackenzie <acm@muc.de> | ||
| 30 | |||
| 31 | Allow compilation during loading of Modes derived from a CC Mode mode. | ||
| 32 | Fixes debbugs#19206. | ||
| 33 | |||
| 34 | * progmodes/cc-bytecomp.el (cc-bytecomp-compiling-or-loading): | ||
| 35 | New function which walks the stack to discover whether we're compiling | ||
| 36 | or loading. | ||
| 37 | (cc-bytecomp-is-compiling): Reformulate, and move towards | ||
| 38 | beginning. | ||
| 39 | (cc-bytecomp-is-loading): New defsubst. | ||
| 40 | (cc-bytecomp-setup-environment, cc-bytecomp-restore-environment): | ||
| 41 | Use the above defsubsts. | ||
| 42 | (cc-require-when-compile, cc-bytecomp-defvar) | ||
| 43 | (cc-bytecomp-defun): Simplify conditionals. | ||
| 44 | |||
| 45 | * progmodes/cc-defs.el (cc-bytecomp-compiling-or-loading): | ||
| 46 | "Borrow" this function from cc-bytecomp.el. | ||
| 47 | (c-get-current-file): Reformulate using the above. | ||
| 48 | (c-lang-defconst): Prevent duplicate entries of file names in a | ||
| 49 | symbol's 'source property. | ||
| 50 | (c-lang-const): Use cc-bytecomp-is-compiling. | ||
| 51 | |||
| 52 | * progmodes/cc-langs.el (c-make-init-lang-vars-fun): | ||
| 53 | Use cc-bytecomp-is-compiling. | ||
| 54 | |||
| 55 | 2015-01-13 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 56 | |||
| 57 | * emacs-lisp/eieio-core.el (eieio-defclass): Fix call to `defclass' | ||
| 58 | (bug#19552). | ||
| 59 | |||
| 60 | 2015-01-13 Dmitry Gutov <dgutov@yandex.ru> | ||
| 61 | |||
| 62 | * menu-bar.el (menu-bar-goto-menu): Before calling | ||
| 63 | `xref-marker-stack-empty-p', first check that `xref' is loaded. | ||
| 64 | (Bug#19554) | ||
| 65 | |||
| 66 | 2015-01-12 Martin Rudalics <rudalics@gmx.at> | ||
| 67 | |||
| 68 | * progmodes/xref.el (xref-marker-stack-empty-p): Add autoload | ||
| 69 | cookie (Bug#19554). | ||
| 70 | |||
| 71 | * frame.el (frame-notice-user-settings): Remove code dealing with | ||
| 72 | frame-initial-frame-tool-bar-height. Turn off `tool-bar-mode' | ||
| 73 | only if `window-system-frame-alist' or `default-frame-alist' ask | ||
| 74 | for it. | ||
| 75 | (make-frame): Update frame-adjust-size-history if needed. | ||
| 76 | |||
| 77 | 2015-01-12 Paul Eggert <eggert@cs.ucla.edu> | ||
| 78 | |||
| 79 | Have 'make' output better GEN names | ||
| 80 | * Makefile.in (PHONY_EXTRAS): New macro. | ||
| 81 | (.PHONY): Depend on it, and on $(lisp)/loaddefs.el, so that the | ||
| 82 | relevant files' time stamps are ignored. | ||
| 83 | (custom-deps, $(lisp)/cus-load.el, finder-data) | ||
| 84 | ($(lisp)/finder-inf.el): Use PHONY_EXTRAS. | ||
| 85 | (custom-deps, $(lisp)/cus-load.el, finder-data) | ||
| 86 | ($(lisp)/finder-inf.el, autoloads, $(lisp)/loaddefs.el) | ||
| 87 | ($(lisp)/subdirs.el, update-subdirs): | ||
| 88 | Output more-accurate destination names with GEN. | ||
| 89 | |||
| 90 | Say "ELC foo.elc" instead of "GEN foo.elc" | ||
| 91 | * Makefile.in (AM_V_ELC, am__v_ELC_, am__v_ELC_0, am__v_ELC_1): | ||
| 92 | New macros. | ||
| 93 | ($(THEFILE)c, .el.elc): Use them. | ||
| 94 | |||
| 95 | 2015-01-11 Michael Albinus <michael.albinus@gmx.de> | ||
| 96 | |||
| 97 | * files.el (directory-files-recursively): Do not include | ||
| 98 | superfluous remote file names. | ||
| 99 | |||
| 100 | 2015-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 101 | |||
| 102 | * net/eww.el (eww): Interpret anything that looks like a protocol | ||
| 103 | designator as a full URL. | ||
| 104 | |||
| 1 | 2015-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org> | 105 | 2015-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 2 | 106 | ||
| 3 | * net/shr.el (shr-urlify): Don't bother the user about | 107 | * net/shr.el (shr-urlify): Don't bother the user about |
| @@ -363,8 +467,8 @@ | |||
| 363 | to `pre-command-hook'. | 467 | to `pre-command-hook'. |
| 364 | (xref--xref-buffer-mode-map): Don't remap `next-line' and | 468 | (xref--xref-buffer-mode-map): Don't remap `next-line' and |
| 365 | `previous-line'. Additionally bind `xref-next-line' and | 469 | `previous-line'. Additionally bind `xref-next-line' and |
| 366 | `xref-prev-line' to `n' and `p' respectively. Bind | 470 | `xref-prev-line' to `n' and `p' respectively. |
| 367 | `xref-show-location-at-point' to `C-o'. | 471 | Bind `xref-show-location-at-point' to `C-o'. |
| 368 | 472 | ||
| 369 | 2015-01-01 Eli Zaretskii <eliz@gnu.org> | 473 | 2015-01-01 Eli Zaretskii <eliz@gnu.org> |
| 370 | 474 | ||
| @@ -553,15 +657,15 @@ | |||
| 553 | Add argument MSG to display user-friendly message when no process | 657 | Add argument MSG to display user-friendly message when no process |
| 554 | is running. | 658 | is running. |
| 555 | (python-shell-switch-to-shell): Call pop-to-buffer with NORECORD. | 659 | (python-shell-switch-to-shell): Call pop-to-buffer with NORECORD. |
| 556 | (python-shell-make-comint): Rename argument SHOW from POP. Use | 660 | (python-shell-make-comint): Rename argument SHOW from POP. |
| 557 | display-buffer instead of pop-to-buffer. | 661 | Use display-buffer instead of pop-to-buffer. |
| 558 | (run-python): Doc fix. Return process. | 662 | (run-python): Doc fix. Return process. |
| 559 | (python-shell-get-or-create-process): Make obsolete. | 663 | (python-shell-get-or-create-process): Make obsolete. |
| 560 | 664 | ||
| 561 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> | 665 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> |
| 562 | 666 | ||
| 563 | * progmodes/python.el (python-shell-buffer-substring): Handle | 667 | * progmodes/python.el (python-shell-buffer-substring): |
| 564 | cornercase when region sent starts at point-min. | 668 | Handle cornercase when region sent starts at point-min. |
| 565 | 669 | ||
| 566 | 2014-12-27 Eli Zaretskii <eliz@gnu.org> | 670 | 2014-12-27 Eli Zaretskii <eliz@gnu.org> |
| 567 | 671 | ||
| @@ -733,8 +837,8 @@ | |||
| 733 | 837 | ||
| 734 | 2014-12-25 Filipp Gunbin <fgunbin@fastmail.fm> | 838 | 2014-12-25 Filipp Gunbin <fgunbin@fastmail.fm> |
| 735 | 839 | ||
| 736 | * dired-aux.el (dired-maybe-insert-subdir): Make | 840 | * dired-aux.el (dired-maybe-insert-subdir): |
| 737 | dired-maybe-insert-subdir always skip trivial files. | 841 | Make dired-maybe-insert-subdir always skip trivial files. |
| 738 | 842 | ||
| 739 | 2014-12-25 Helmut Eller <eller.helmut@gmail.com> | 843 | 2014-12-25 Helmut Eller <eller.helmut@gmail.com> |
| 740 | Dmitry Gutov <dgutov@yandex.ru> | 844 | Dmitry Gutov <dgutov@yandex.ru> |
| @@ -779,8 +883,8 @@ | |||
| 779 | 883 | ||
| 780 | * window.el (mouse-autoselect-window-position-1): New variable. | 884 | * window.el (mouse-autoselect-window-position-1): New variable. |
| 781 | (mouse-autoselect-window-cancel) | 885 | (mouse-autoselect-window-cancel) |
| 782 | (mouse-autoselect-window-select, handle-select-window): With | 886 | (mouse-autoselect-window-select, handle-select-window): |
| 783 | delayed autoselection select window only if mouse moves after | 887 | With delayed autoselection select window only if mouse moves after |
| 784 | selecting its frame. | 888 | selecting its frame. |
| 785 | 889 | ||
| 786 | 2014-12-24 Michael Albinus <michael.albinus@gmx.de> | 890 | 2014-12-24 Michael Albinus <michael.albinus@gmx.de> |
diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 565ca77de3b..7bf53861e71 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in | |||
| @@ -31,6 +31,11 @@ XARGS_LIMIT = @XARGS_LIMIT@ | |||
| 31 | # 'make' verbosity. | 31 | # 'make' verbosity. |
| 32 | AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ | 32 | AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ |
| 33 | 33 | ||
| 34 | AM_V_ELC = $(am__v_ELC_@AM_V@) | ||
| 35 | am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@) | ||
| 36 | am__v_ELC_0 = @echo " ELC " $@; | ||
| 37 | am__v_ELC_1 = | ||
| 38 | |||
| 34 | AM_V_GEN = $(am__v_GEN_@AM_V@) | 39 | AM_V_GEN = $(am__v_GEN_@AM_V@) |
| 35 | am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) | 40 | am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) |
| 36 | am__v_GEN_0 = @echo " GEN " $@; | 41 | am__v_GEN_0 = @echo " GEN " $@; |
| @@ -145,7 +150,8 @@ setwins_for_subdirs=for file in `find ${srcdir} -type d -print`; do \ | |||
| 145 | # we add them here to make sure they get built. | 150 | # we add them here to make sure they get built. |
| 146 | all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el | 151 | all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el |
| 147 | 152 | ||
| 148 | .PHONY: all custom-deps finder-data autoloads update-subdirs | 153 | PHONY_EXTRAS = |
| 154 | .PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS) | ||
| 149 | 155 | ||
| 150 | # custom-deps and finder-data both used to scan _all_ the *.el files. | 156 | # custom-deps and finder-data both used to scan _all_ the *.el files. |
| 151 | # This could lead to problems in parallel builds if automatically | 157 | # This could lead to problems in parallel builds if automatically |
| @@ -161,18 +167,19 @@ all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el | |||
| 161 | # Nowadays these commands don't scan automatically generated files, | 167 | # Nowadays these commands don't scan automatically generated files, |
| 162 | # since they will never contain any useful information | 168 | # since they will never contain any useful information |
| 163 | # (see finder-no-scan-regexp and custom-dependencies-no-scan-regexp). | 169 | # (see finder-no-scan-regexp and custom-dependencies-no-scan-regexp). |
| 164 | $(lisp)/cus-load.el: | ||
| 165 | $(MAKE) custom-deps | ||
| 166 | custom-deps: | 170 | custom-deps: |
| 171 | $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/cus-load.el $(lisp)/cus-load.el | ||
| 172 | $(lisp)/cus-load.el: | ||
| 167 | $(AM_V_GEN)$(setwins_almost); \ | 173 | $(AM_V_GEN)$(setwins_almost); \ |
| 168 | echo Directories: $$wins; \ | 174 | echo Directories: $$wins; \ |
| 169 | $(emacs) -l cus-dep \ | 175 | $(emacs) -l cus-dep \ |
| 170 | --eval '(setq generated-custom-dependencies-file (unmsys--file-name "$(srcdir)/cus-load.el"))' \ | 176 | --eval '(setq generated-custom-dependencies-file (unmsys--file-name "$(srcdir)/cus-load.el"))' \ |
| 171 | -f custom-make-dependencies $$wins | 177 | -f custom-make-dependencies $$wins |
| 172 | 178 | ||
| 173 | $(lisp)/finder-inf.el: | ||
| 174 | $(MAKE) finder-data | ||
| 175 | finder-data: | 179 | finder-data: |
| 180 | $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/finder-inf.el \ | ||
| 181 | $(lisp)/finder-inf.el | ||
| 182 | $(lisp)/finder-inf.el: | ||
| 176 | $(AM_V_GEN)$(setwins_finder); \ | 183 | $(AM_V_GEN)$(setwins_finder); \ |
| 177 | echo Directories: $$wins; \ | 184 | echo Directories: $$wins; \ |
| 178 | $(emacs) -l finder \ | 185 | $(emacs) -l finder \ |
| @@ -185,21 +192,22 @@ finder-data: | |||
| 185 | # Note that we set no-update-autoloads in _generated_ leim files. | 192 | # Note that we set no-update-autoloads in _generated_ leim files. |
| 186 | # If you want to allow autoloads in such files, remove that, | 193 | # If you want to allow autoloads in such files, remove that, |
| 187 | # and make this depend on leim. | 194 | # and make this depend on leim. |
| 188 | autoloads: $(LOADDEFS) | 195 | autoloads .PHONY: $(lisp)/loaddefs.el |
| 196 | $(lisp)/loaddefs.el: $(LOADDEFS) | ||
| 189 | $(AM_V_GEN)$(setwins_almost); \ | 197 | $(AM_V_GEN)$(setwins_almost); \ |
| 190 | echo Directories: $$wins; \ | 198 | echo Directories: $$wins; \ |
| 191 | $(emacs) -l autoload \ | 199 | $(emacs) -l autoload \ |
| 192 | --eval '(setq autoload-ensure-writable t)' \ | 200 | --eval '(setq autoload-ensure-writable t)' \ |
| 193 | --eval '(setq autoload-builtin-package-versions t)' \ | 201 | --eval '(setq autoload-builtin-package-versions t)' \ |
| 194 | --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$(srcdir)/loaddefs.el")))' \ | 202 | --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$@")))' \ |
| 195 | -f batch-update-autoloads $$wins | 203 | -f batch-update-autoloads $$wins |
| 196 | 204 | ||
| 197 | # This is required by the bootstrap-emacs target in ../src/Makefile, so | 205 | # This is required by the bootstrap-emacs target in ../src/Makefile, so |
| 198 | # we know that if we have an emacs executable, we also have a subdirs.el. | 206 | # we know that if we have an emacs executable, we also have a subdirs.el. |
| 199 | $(lisp)/subdirs.el: | 207 | $(lisp)/subdirs.el: |
| 200 | $(MAKE) update-subdirs | 208 | $(AM_V_GEN)$(MAKE) update-subdirs |
| 201 | update-subdirs: | 209 | update-subdirs: |
| 202 | $(AM_V_GEN)$(setwins_for_subdirs); \ | 210 | $(AM_V_at)$(setwins_for_subdirs); \ |
| 203 | for file in $$wins; do \ | 211 | for file in $$wins; do \ |
| 204 | $(srcdir)/../build-aux/update-subdirs $$file; \ | 212 | $(srcdir)/../build-aux/update-subdirs $$file; \ |
| 205 | done; | 213 | done; |
| @@ -260,7 +268,7 @@ TAGS: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) | |||
| 260 | THEFILE = no-such-file | 268 | THEFILE = no-such-file |
| 261 | .PHONY: $(THEFILE)c | 269 | .PHONY: $(THEFILE)c |
| 262 | $(THEFILE)c: | 270 | $(THEFILE)c: |
| 263 | $(AM_V_GEN)$(emacs) $(BYTE_COMPILE_FLAGS) \ | 271 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \ |
| 264 | -l bytecomp -f byte-compile-refresh-preloaded \ | 272 | -l bytecomp -f byte-compile-refresh-preloaded \ |
| 265 | -f batch-byte-compile $(THEFILE) | 273 | -f batch-byte-compile $(THEFILE) |
| 266 | 274 | ||
| @@ -276,7 +284,7 @@ $(THEFILE)c: | |||
| 276 | # An old-fashioned suffix rule, which, according to the GNU Make manual, | 284 | # An old-fashioned suffix rule, which, according to the GNU Make manual, |
| 277 | # cannot have prerequisites. | 285 | # cannot have prerequisites. |
| 278 | .el.elc: | 286 | .el.elc: |
| 279 | $(AM_V_GEN)$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $< | 287 | $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $< |
| 280 | 288 | ||
| 281 | .PHONY: compile-first compile-main compile compile-always | 289 | .PHONY: compile-first compile-main compile compile-always |
| 282 | 290 | ||
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el new file mode 100644 index 00000000000..41a419a3c4a --- /dev/null +++ b/lisp/emacs-lisp/cl-generic.el | |||
| @@ -0,0 +1,607 @@ | |||
| 1 | ;;; cl-generic.el --- CLOS-style generic functions for Elisp -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2015 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 12 | ;; (at your option) any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 21 | |||
| 22 | ;;; Commentary: | ||
| 23 | |||
| 24 | ;; This implements the most of CLOS's multiple-dispatch generic functions. | ||
| 25 | ;; To use it you need either (require 'cl-generic) or (require 'cl-lib). | ||
| 26 | ;; The main entry points are: `cl-defgeneric' and `cl-defmethod'. | ||
| 27 | |||
| 28 | ;; Missing elements: | ||
| 29 | ;; - We don't support next-method-p, make-method, call-method, | ||
| 30 | ;; define-method-combination. | ||
| 31 | ;; - Method and generic function objects: CLOS defines methods as objects | ||
| 32 | ;; (same for generic functions), whereas we don't offer such an abstraction. | ||
| 33 | ;; - `no-next-method' should receive the "calling method" object, but since we | ||
| 34 | ;; don't have such a thing, we pass nil instead. | ||
| 35 | ;; - In defgeneric we don't support the options: | ||
| 36 | ;; declare, :method-combination, :generic-function-class, :method-class, | ||
| 37 | ;; :method. | ||
| 38 | ;; Added elements: | ||
| 39 | ;; - We support aliases to generic functions. | ||
| 40 | ;; - The kind of thing on which to dispatch can be extended. | ||
| 41 | ;; There is support in this file for (eql <val>) dispatch as well as dispatch | ||
| 42 | ;; on the type of CL structs, and eieio-core.el adds support for EIEIO | ||
| 43 | ;; defclass objects. | ||
| 44 | |||
| 45 | ;;; Code: | ||
| 46 | |||
| 47 | ;; Note: For generic functions that dispatch on several arguments (i.e. those | ||
| 48 | ;; which use the multiple-dispatch feature), we always use the same "tagcodes" | ||
| 49 | ;; and the same set of arguments on which to dispatch. This works, but is | ||
| 50 | ;; often suboptimal since after one dispatch, the remaining dispatches can | ||
| 51 | ;; usually be simplified, or even completely skipped. | ||
| 52 | |||
| 53 | (eval-when-compile (require 'cl-lib)) | ||
| 54 | (eval-when-compile (require 'pcase)) | ||
| 55 | |||
| 56 | (defvar cl-generic-tagcode-function | ||
| 57 | (lambda (type _name) | ||
| 58 | (if (eq type t) '(0 . 'cl--generic-type) | ||
| 59 | (error "Unknown specializer %S" type))) | ||
| 60 | "Function to get the Elisp code to extract the tag on which we dispatch. | ||
| 61 | Takes a \"parameter-specializer-name\" and a variable name, and returns | ||
| 62 | a pair (PRIORITY . CODE) where CODE is an Elisp expression that should be | ||
| 63 | used to extract the \"tag\" (from the object held in the named variable) | ||
| 64 | that should uniquely determine if we have a match | ||
| 65 | \(i.e. the \"tag\" is the value that will be used to dispatch to the proper | ||
| 66 | method(s)). | ||
| 67 | Such \"tagcodes\" will be or'd together. | ||
| 68 | PRIORITY is an integer from 0 to 100 which is used to sort the tagcodes | ||
| 69 | in the `or'. The higher the priority, the more specific the tag should be. | ||
| 70 | More specifically, if PRIORITY is N and we have two objects X and Y | ||
| 71 | whose tag (according to TAGCODE) is `eql', then it should be the case | ||
| 72 | that for all other (PRIORITY . TAGCODE) where PRIORITY ≤ N, then | ||
| 73 | \(eval TAGCODE) for X is `eql' to (eval TAGCODE) for Y.") | ||
| 74 | |||
| 75 | (defvar cl-generic-tag-types-function | ||
| 76 | (lambda (tag) (if (eq tag 'cl--generic-type) '(t))) | ||
| 77 | "Function to get the list of types that a given \"tag\" matches. | ||
| 78 | They should be sorted from most specific to least specific.") | ||
| 79 | |||
| 80 | (cl-defstruct (cl--generic | ||
| 81 | (:constructor nil) | ||
| 82 | (:constructor cl--generic-make | ||
| 83 | (name &optional dispatches method-table)) | ||
| 84 | (:predicate nil)) | ||
| 85 | (name nil :read-only t) ;Pointer back to the symbol. | ||
| 86 | ;; `dispatches' holds a list of (ARGNUM . TAGCODES) where ARGNUM is the index | ||
| 87 | ;; of the corresponding argument and TAGCODES is a list of (PRIORITY . EXP) | ||
| 88 | ;; where the EXPs are expressions (to be `or'd together) to compute the tag | ||
| 89 | ;; on which to dispatch and PRIORITY is the priority of each expression to | ||
| 90 | ;; decide in which order to sort them. | ||
| 91 | ;; The most important dispatch is last in the list (and the least is first). | ||
| 92 | dispatches | ||
| 93 | ;; `method-table' is a list of | ||
| 94 | ;; ((SPECIALIZERS . QUALIFIER) USES-CNM . FUNCTION), where | ||
| 95 | ;; USES-CNM is a boolean indicating if FUNCTION calls `cl-call-next-method' | ||
| 96 | ;; (and hence expects an extra argument holding the next-method). | ||
| 97 | method-table) | ||
| 98 | |||
| 99 | (defmacro cl--generic (name) | ||
| 100 | `(get ,name 'cl--generic)) | ||
| 101 | |||
| 102 | (defun cl-generic-ensure-function (name) | ||
| 103 | (let (generic | ||
| 104 | (origname name)) | ||
| 105 | (while (and (null (setq generic (cl--generic name))) | ||
| 106 | (fboundp name) | ||
| 107 | (symbolp (symbol-function name))) | ||
| 108 | (setq name (symbol-function name))) | ||
| 109 | (unless (or (not (fboundp name)) | ||
| 110 | (and (functionp name) generic)) | ||
| 111 | (error "%s is already defined as something else than a generic function" | ||
| 112 | origname)) | ||
| 113 | (if generic | ||
| 114 | (cl-assert (eq name (cl--generic-name generic))) | ||
| 115 | (setf (cl--generic name) (setq generic (cl--generic-make name))) | ||
| 116 | (defalias name (cl--generic-make-function generic))) | ||
| 117 | generic)) | ||
| 118 | |||
| 119 | (defun cl--generic-setf-rewrite (name) | ||
| 120 | (let ((setter (intern (format "cl-generic-setter--%s" name)))) | ||
| 121 | (cons setter | ||
| 122 | `(eval-and-compile | ||
| 123 | (unless (eq ',setter (get ',name 'cl-generic-setter)) | ||
| 124 | ;; (when (get ',name 'gv-expander) | ||
| 125 | ;; (error "gv-expander conflicts with (setf %S)" ',name)) | ||
| 126 | (setf (get ',name 'cl-generic-setter) ',setter) | ||
| 127 | (gv-define-setter ,name (val &rest args) | ||
| 128 | (cons ',setter (cons val args)))))))) | ||
| 129 | |||
| 130 | ;;;###autoload | ||
| 131 | (defmacro cl-defgeneric (name args &rest options-and-methods) | ||
| 132 | "Create a generic function NAME. | ||
| 133 | DOC-STRING is the base documentation for this class. A generic | ||
| 134 | function has no body, as its purpose is to decide which method body | ||
| 135 | is appropriate to use. Specific methods are defined with `defmethod'. | ||
| 136 | With this implementation the ARGS are currently ignored. | ||
| 137 | OPTIONS-AND-METHODS is currently only used to specify the docstring, | ||
| 138 | via (:documentation DOCSTRING)." | ||
| 139 | (declare (indent 2) (doc-string 3)) | ||
| 140 | (let* ((docprop (assq :documentation options-and-methods)) | ||
| 141 | (doc (cond ((stringp (car-safe options-and-methods)) | ||
| 142 | (pop options-and-methods)) | ||
| 143 | (docprop | ||
| 144 | (prog1 | ||
| 145 | (cadr docprop) | ||
| 146 | (setq options-and-methods | ||
| 147 | (delq docprop options-and-methods))))))) | ||
| 148 | `(progn | ||
| 149 | ,(when (eq 'setf (car-safe name)) | ||
| 150 | (pcase-let ((`(,setter . ,code) (cl--generic-setf-rewrite | ||
| 151 | (cadr name)))) | ||
| 152 | (setq name setter) | ||
| 153 | code)) | ||
| 154 | (defalias ',name | ||
| 155 | (cl-generic-define ',name ',args ',options-and-methods) | ||
| 156 | ,doc)))) | ||
| 157 | |||
| 158 | (defun cl--generic-mandatory-args (args) | ||
| 159 | (let ((res ())) | ||
| 160 | (while (not (memq (car args) '(nil &rest &optional &key))) | ||
| 161 | (push (pop args) res)) | ||
| 162 | (nreverse res))) | ||
| 163 | |||
| 164 | ;;;###autoload | ||
| 165 | (defun cl-generic-define (name args options-and-methods) | ||
| 166 | (let ((generic (cl-generic-ensure-function name)) | ||
| 167 | (mandatory (cl--generic-mandatory-args args)) | ||
| 168 | (apo (assq :argument-precedence-order options-and-methods))) | ||
| 169 | (setf (cl--generic-dispatches generic) nil) | ||
| 170 | (when apo | ||
| 171 | (dolist (arg (cdr apo)) | ||
| 172 | (let ((pos (memq arg mandatory))) | ||
| 173 | (unless pos (error "%S is not a mandatory argument" arg)) | ||
| 174 | (push (list (- (length mandatory) (length pos))) | ||
| 175 | (cl--generic-dispatches generic))))) | ||
| 176 | (setf (cl--generic-method-table generic) nil) | ||
| 177 | (cl--generic-make-function generic))) | ||
| 178 | |||
| 179 | (defvar cl-generic-current-method-specializers nil | ||
| 180 | ;; This is let-bound during macro-expansion of method bodies, so that those | ||
| 181 | ;; bodies can be optimized knowing that the specializers have matched. | ||
| 182 | ;; FIXME: This presumes the formal arguments aren't modified via `setq' and | ||
| 183 | ;; aren't shadowed either ;-( | ||
| 184 | ;; FIXME: This might leak outside the scope of the method if, during | ||
| 185 | ;; macroexpansion of the method, something causes some other macroexpansion | ||
| 186 | ;; (e.g. an autoload). | ||
| 187 | "List of (VAR . TYPE) where TYPE is var's specializer.") | ||
| 188 | |||
| 189 | (eval-and-compile ;Needed while compiling the cl-defmethod calls below! | ||
| 190 | (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el. | ||
| 191 | "Check which of the symbols VARS appear in SEXP." | ||
| 192 | (let ((res '())) | ||
| 193 | (while (consp sexp) | ||
| 194 | (dolist (var (cl--generic-fgrep vars (pop sexp))) | ||
| 195 | (unless (memq var res) (push var res)))) | ||
| 196 | (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) | ||
| 197 | res)) | ||
| 198 | |||
| 199 | (defun cl--generic-lambda (args body with-cnm) | ||
| 200 | "Make the lambda expression for a method with ARGS and BODY." | ||
| 201 | (let ((plain-args ()) | ||
| 202 | (cl-generic-current-method-specializers nil) | ||
| 203 | (doc-string (if (stringp (car-safe body)) (pop body))) | ||
| 204 | (mandatory t)) | ||
| 205 | (dolist (arg args) | ||
| 206 | (push (pcase arg | ||
| 207 | ((or '&optional '&rest '&key) (setq mandatory nil) arg) | ||
| 208 | ((and `(,name . ,type) (guard mandatory)) | ||
| 209 | (push (cons name (car type)) | ||
| 210 | cl-generic-current-method-specializers) | ||
| 211 | name) | ||
| 212 | (_ arg)) | ||
| 213 | plain-args)) | ||
| 214 | (setq plain-args (nreverse plain-args)) | ||
| 215 | (let ((fun `(cl-function (lambda ,plain-args | ||
| 216 | ,@(if doc-string (list doc-string)) | ||
| 217 | ,@body)))) | ||
| 218 | (if (not with-cnm) | ||
| 219 | (cons nil fun) | ||
| 220 | ;; First macroexpand away the cl-function stuff (e.g. &key and | ||
| 221 | ;; destructuring args, `declare' and whatnot). | ||
| 222 | (pcase (macroexpand fun macroexpand-all-environment) | ||
| 223 | (`#'(lambda ,args . ,body) | ||
| 224 | (require 'cl-lib) ;Needed to expand `cl-flet'. | ||
| 225 | (let* ((doc-string (and doc-string (stringp (car body)) | ||
| 226 | (pop body))) | ||
| 227 | (cnm (make-symbol "cl--cnm")) | ||
| 228 | (nbody (macroexpand-all | ||
| 229 | `(cl-flet ((cl-call-next-method ,cnm)) | ||
| 230 | ,@body) | ||
| 231 | macroexpand-all-environment)) | ||
| 232 | ;; FIXME: Rather than `grep' after the fact, the | ||
| 233 | ;; macroexpansion should directly set some flag when cnm | ||
| 234 | ;; is used. | ||
| 235 | ;; FIXME: Also, optimize the case where call-next-method is | ||
| 236 | ;; only called with explicit arguments. | ||
| 237 | (uses-cnm (cl--generic-fgrep (list cnm) nbody))) | ||
| 238 | (cons (not (not uses-cnm)) | ||
| 239 | `#'(lambda (,@(if uses-cnm (list cnm)) ,@args) | ||
| 240 | ,@(if doc-string (list doc-string)) | ||
| 241 | ,nbody)))) | ||
| 242 | (f (error "Unexpected macroexpansion result: %S" f)))))))) | ||
| 243 | |||
| 244 | |||
| 245 | ;;;###autoload | ||
| 246 | (defmacro cl-defmethod (name args &rest body) | ||
| 247 | "Define a new method for generic function NAME. | ||
| 248 | I.e. it defines the implementation of NAME to use for invocations where the | ||
| 249 | value of the dispatch argument matches the specified TYPE. | ||
| 250 | The dispatch argument has to be one of the mandatory arguments, and | ||
| 251 | all methods of NAME have to use the same argument for dispatch. | ||
| 252 | The dispatch argument and TYPE are specified in ARGS where the corresponding | ||
| 253 | formal argument appears as (VAR TYPE) rather than just VAR. | ||
| 254 | |||
| 255 | The optional second argument QUALIFIER is a specifier that | ||
| 256 | modifies how the method is combined with other methods, including: | ||
| 257 | :before - Method will be called before the primary | ||
| 258 | :after - Method will be called after the primary | ||
| 259 | :around - Method will be called around everything else | ||
| 260 | The absence of QUALIFIER means this is a \"primary\" method. | ||
| 261 | |||
| 262 | Other than a type, TYPE can also be of the form `(eql VAL)' in | ||
| 263 | which case this method will be invoked when the argument is `eql' to VAL. | ||
| 264 | |||
| 265 | \(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" | ||
| 266 | (declare (doc-string 3) (indent 2)) | ||
| 267 | (let ((qualifiers nil)) | ||
| 268 | (while (keywordp args) | ||
| 269 | (push args qualifiers) | ||
| 270 | (setq args (pop body))) | ||
| 271 | (pcase-let* ((with-cnm (not (memq (car qualifiers) '(:before :after)))) | ||
| 272 | (`(,uses-cnm . ,fun) (cl--generic-lambda args body with-cnm))) | ||
| 273 | `(progn | ||
| 274 | ,(when (eq 'setf (car-safe name)) | ||
| 275 | (pcase-let ((`(,setter . ,code) (cl--generic-setf-rewrite | ||
| 276 | (cadr name)))) | ||
| 277 | (setq name setter) | ||
| 278 | code)) | ||
| 279 | (cl-generic-define-method ',name ',qualifiers ',args | ||
| 280 | ,uses-cnm ,fun))))) | ||
| 281 | |||
| 282 | ;;;###autoload | ||
| 283 | (defun cl-generic-define-method (name qualifiers args uses-cnm function) | ||
| 284 | (when (> (length qualifiers) 1) | ||
| 285 | (error "We only support a single qualifier per method: %S" qualifiers)) | ||
| 286 | (unless (memq (car qualifiers) '(nil :primary :around :after :before)) | ||
| 287 | (error "Unsupported qualifier in: %S" qualifiers)) | ||
| 288 | (let* ((generic (cl-generic-ensure-function name)) | ||
| 289 | (mandatory (cl--generic-mandatory-args args)) | ||
| 290 | (specializers | ||
| 291 | (mapcar (lambda (arg) (if (consp arg) (cadr arg) t)) mandatory)) | ||
| 292 | (key (cons specializers (or (car qualifiers) ':primary))) | ||
| 293 | (mt (cl--generic-method-table generic)) | ||
| 294 | (me (assoc key mt)) | ||
| 295 | (dispatches (cl--generic-dispatches generic)) | ||
| 296 | (i 0)) | ||
| 297 | (dolist (specializer specializers) | ||
| 298 | (let* ((tagcode (funcall cl-generic-tagcode-function specializer 'arg)) | ||
| 299 | (x (assq i dispatches))) | ||
| 300 | (if (not x) | ||
| 301 | (setf (cl--generic-dispatches generic) | ||
| 302 | (setq dispatches (cons (list i tagcode) dispatches))) | ||
| 303 | (unless (member tagcode (cdr x)) | ||
| 304 | (setf (cdr x) | ||
| 305 | (nreverse (sort (cons tagcode (cdr x)) | ||
| 306 | #'car-less-than-car))))) | ||
| 307 | (setq i (1+ i)))) | ||
| 308 | (if me (setcdr me (cons uses-cnm function)) | ||
| 309 | (setf (cl--generic-method-table generic) | ||
| 310 | (cons `(,key ,uses-cnm . ,function) mt))) | ||
| 311 | ;; For aliases, cl--generic-name gives us the actual name. | ||
| 312 | (defalias (cl--generic-name generic) | ||
| 313 | (cl--generic-make-function generic)))) | ||
| 314 | |||
| 315 | (defmacro cl--generic-with-memoization (place &rest code) | ||
| 316 | (declare (indent 1) (debug t)) | ||
| 317 | (gv-letplace (getter setter) place | ||
| 318 | `(or ,getter | ||
| 319 | ,(macroexp-let2 nil val (macroexp-progn code) | ||
| 320 | `(progn | ||
| 321 | ,(funcall setter val) | ||
| 322 | ,val))))) | ||
| 323 | |||
| 324 | (defvar cl--generic-dispatchers (make-hash-table :test #'equal)) | ||
| 325 | |||
| 326 | (defun cl--generic-get-dispatcher (tagcodes dispatch-arg) | ||
| 327 | (cl--generic-with-memoization | ||
| 328 | (gethash (cons dispatch-arg tagcodes) cl--generic-dispatchers) | ||
| 329 | (let ((lexical-binding t) | ||
| 330 | (extraargs ())) | ||
| 331 | (dotimes (_ dispatch-arg) | ||
| 332 | (push (make-symbol "arg") extraargs)) | ||
| 333 | (byte-compile | ||
| 334 | `(lambda (generic dispatches-left) | ||
| 335 | (let ((method-cache (make-hash-table :test #'eql))) | ||
| 336 | (lambda (,@extraargs arg &rest args) | ||
| 337 | (apply (cl--generic-with-memoization | ||
| 338 | (gethash (or ,@(mapcar #'cdr tagcodes)) method-cache) | ||
| 339 | (cl--generic-cache-miss | ||
| 340 | generic ',dispatch-arg dispatches-left | ||
| 341 | (list ,@(mapcar #'cdr tagcodes)))) | ||
| 342 | ,@extraargs arg args)))))))) | ||
| 343 | |||
| 344 | (defun cl--generic-make-function (generic) | ||
| 345 | (let* ((dispatches (cl--generic-dispatches generic)) | ||
| 346 | (dispatch | ||
| 347 | (progn | ||
| 348 | (while (and dispatches | ||
| 349 | (member (cdar dispatches) | ||
| 350 | '(nil ((0 . 'cl--generic-type))))) | ||
| 351 | (setq dispatches (cdr dispatches))) | ||
| 352 | (pop dispatches)))) | ||
| 353 | (if (null dispatch) | ||
| 354 | (cl--generic-build-combined-method | ||
| 355 | (cl--generic-name generic) | ||
| 356 | (cl--generic-method-table generic)) | ||
| 357 | (let ((dispatcher (cl--generic-get-dispatcher | ||
| 358 | (cdr dispatch) (car dispatch)))) | ||
| 359 | (funcall dispatcher generic dispatches))))) | ||
| 360 | |||
| 361 | (defun cl--generic-nest (fun methods) | ||
| 362 | (pcase-dolist (`(,uses-cnm . ,method) methods) | ||
| 363 | (setq fun | ||
| 364 | (if (not uses-cnm) method | ||
| 365 | (let ((next fun)) | ||
| 366 | (lambda (&rest args) | ||
| 367 | (apply method | ||
| 368 | ;; FIXME: This sucks: passing just `next' would | ||
| 369 | ;; be a lot more efficient than the lambda+apply | ||
| 370 | ;; quasi-η, but we need this to implement the | ||
| 371 | ;; "if call-next-method is called with no | ||
| 372 | ;; arguments, then use the previous arguments". | ||
| 373 | (lambda (&rest cnm-args) | ||
| 374 | (apply next (or cnm-args args))) | ||
| 375 | args)))))) | ||
| 376 | fun) | ||
| 377 | |||
| 378 | (defvar cl--generic-combined-method-memoization | ||
| 379 | (make-hash-table :test #'equal :weakness 'value) | ||
| 380 | "Table storing previously built combined-methods. | ||
| 381 | This is particularly useful when many different tags select the same set | ||
| 382 | of methods, since this table then allows us to share a single combined-method | ||
| 383 | for all those different tags in the method-cache.") | ||
| 384 | |||
| 385 | (defun cl--generic-build-combined-method (generic-name methods) | ||
| 386 | (let ((mets-by-qual ())) | ||
| 387 | (dolist (qm methods) | ||
| 388 | (push (cdr qm) (alist-get (cdar qm) mets-by-qual))) | ||
| 389 | (cl--generic-with-memoization | ||
| 390 | (gethash (cons generic-name mets-by-qual) | ||
| 391 | cl--generic-combined-method-memoization) | ||
| 392 | (cond | ||
| 393 | ((null mets-by-qual) (lambda (&rest args) | ||
| 394 | (cl-no-applicable-method generic-name args))) | ||
| 395 | (t | ||
| 396 | (let* ((fun (lambda (&rest args) | ||
| 397 | ;; FIXME: CLOS passes as second arg the "calling method". | ||
| 398 | ;; We don't currently have "method objects" like CLOS | ||
| 399 | ;; does so we can't really do it the CLOS way. | ||
| 400 | ;; The closest would be to pass the lambda corresponding | ||
| 401 | ;; to the method, but the caller wouldn't be able to do | ||
| 402 | ;; much with it anyway. So we pass nil for now. | ||
| 403 | (apply #'cl-no-next-method generic-name nil args))) | ||
| 404 | ;; We use `cdr' to drop the `uses-cnm' annotations. | ||
| 405 | (before | ||
| 406 | (mapcar #'cdr (reverse (alist-get :before mets-by-qual)))) | ||
| 407 | (after (mapcar #'cdr (alist-get :after mets-by-qual)))) | ||
| 408 | (setq fun (cl--generic-nest fun (alist-get :primary mets-by-qual))) | ||
| 409 | (when (or after before) | ||
| 410 | (let ((next fun)) | ||
| 411 | (setq fun (lambda (&rest args) | ||
| 412 | (dolist (bf before) | ||
| 413 | (apply bf args)) | ||
| 414 | (apply next args) | ||
| 415 | (dolist (af after) | ||
| 416 | (apply af args)))))) | ||
| 417 | (cl--generic-nest fun (alist-get :around mets-by-qual)))))))) | ||
| 418 | |||
| 419 | (defun cl--generic-cache-miss (generic dispatch-arg dispatches-left tags) | ||
| 420 | (let ((types (apply #'append (mapcar cl-generic-tag-types-function tags))) | ||
| 421 | (methods '())) | ||
| 422 | (dolist (method-desc (cl--generic-method-table generic)) | ||
| 423 | (let ((m (member (nth dispatch-arg (caar method-desc)) types))) | ||
| 424 | (when m | ||
| 425 | (push (cons (length m) method-desc) methods)))) | ||
| 426 | ;; Sort the methods, most specific first. | ||
| 427 | ;; It would be tempting to sort them once and for all in the method-table | ||
| 428 | ;; rather than here, but the order might depend on the actual argument | ||
| 429 | ;; (e.g. for multiple inheritance with defclass). | ||
| 430 | (setq methods (nreverse (mapcar #'cdr (sort methods #'car-less-than-car)))) | ||
| 431 | (cl--generic-make-function (cl--generic-make (cl--generic-name generic) | ||
| 432 | dispatches-left methods)))) | ||
| 433 | |||
| 434 | ;;; Define some pre-defined generic functions, used internally. | ||
| 435 | |||
| 436 | (define-error 'cl-no-method "No method for %S") | ||
| 437 | (define-error 'cl-no-next-method "No next method for %S" 'cl-no-method) | ||
| 438 | (define-error 'cl-no-applicable-method "No applicable method for %S" | ||
| 439 | 'cl-no-method) | ||
| 440 | |||
| 441 | (cl-defgeneric cl-no-next-method (generic method &rest args) | ||
| 442 | "Function called when `cl-call-next-method' finds no next method.") | ||
| 443 | (cl-defmethod cl-no-next-method ((generic t) method &rest args) | ||
| 444 | (signal 'cl-no-next-method `(,generic ,method ,@args))) | ||
| 445 | |||
| 446 | (cl-defgeneric cl-no-applicable-method (generic &rest args) | ||
| 447 | "Function called when a method call finds no applicable method.") | ||
| 448 | (cl-defmethod cl-no-applicable-method ((generic t) &rest args) | ||
| 449 | (signal 'cl-no-applicable-method `(,generic ,@args))) | ||
| 450 | |||
| 451 | (defun cl-call-next-method (&rest _args) | ||
| 452 | "Function to call the next applicable method. | ||
| 453 | Can only be used from within the lexical body of a primary or around method." | ||
| 454 | (error "cl-call-next-method only allowed inside primary and around methods")) | ||
| 455 | |||
| 456 | ;;; Add support for describe-function | ||
| 457 | |||
| 458 | (add-hook 'help-fns-describe-function-functions 'cl--generic-describe) | ||
| 459 | (defun cl--generic-describe (function) | ||
| 460 | ;; FIXME: Fix up the main "in `<file>'" hyperlink, and add such hyperlinks | ||
| 461 | ;; for each method. | ||
| 462 | (let ((generic (if (symbolp function) (cl--generic function)))) | ||
| 463 | (when generic | ||
| 464 | (save-excursion | ||
| 465 | (insert "\n\nThis is a generic function.\n\n") | ||
| 466 | (insert (propertize "Implementations:\n\n" 'face 'bold)) | ||
| 467 | ;; Loop over fanciful generics | ||
| 468 | (pcase-dolist (`((,type . ,qualifier) . ,method) | ||
| 469 | (cl--generic-method-table generic)) | ||
| 470 | (insert "`") | ||
| 471 | (if (symbolp type) | ||
| 472 | ;; FIXME: Add support for cl-structs in help-variable. | ||
| 473 | (help-insert-xref-button (symbol-name type) | ||
| 474 | 'help-variable type) | ||
| 475 | (insert (format "%S" type))) | ||
| 476 | (insert (format "' %S %S\n" | ||
| 477 | (car qualifier) | ||
| 478 | (let ((args (help-function-arglist method))) | ||
| 479 | ;; Drop cl--generic-next arg if present. | ||
| 480 | (if (memq (car qualifier) '(:after :before)) | ||
| 481 | args (cdr args))))) | ||
| 482 | (insert (or (documentation method) "Undocumented") "\n\n")))))) | ||
| 483 | |||
| 484 | ;;; Support for (eql <val>) specializers. | ||
| 485 | |||
| 486 | (defvar cl--generic-eql-used (make-hash-table :test #'eql)) | ||
| 487 | |||
| 488 | (add-function :before-until cl-generic-tagcode-function | ||
| 489 | #'cl--generic-eql-tagcode) | ||
| 490 | (defun cl--generic-eql-tagcode (type name) | ||
| 491 | (when (eq (car-safe type) 'eql) | ||
| 492 | (puthash (cadr type) type cl--generic-eql-used) | ||
| 493 | `(100 . (gethash ,name cl--generic-eql-used)))) | ||
| 494 | |||
| 495 | (add-function :before-until cl-generic-tag-types-function | ||
| 496 | #'cl--generic-eql-tag-types) | ||
| 497 | (defun cl--generic-eql-tag-types (tag) | ||
| 498 | (if (eq (car-safe tag) 'eql) (list tag))) | ||
| 499 | |||
| 500 | ;;; Support for cl-defstructs specializers. | ||
| 501 | |||
| 502 | (add-function :before-until cl-generic-tagcode-function | ||
| 503 | #'cl--generic-struct-tagcode) | ||
| 504 | (defun cl--generic-struct-tagcode (type name) | ||
| 505 | (and (symbolp type) | ||
| 506 | (get type 'cl-struct-type) | ||
| 507 | (or (eq 'vector (car (get type 'cl-struct-type))) | ||
| 508 | (error "Can't dispatch on cl-struct %S: type is %S" | ||
| 509 | type (car (get type 'cl-struct-type)))) | ||
| 510 | (or (equal '(cl-tag-slot) (car (get type 'cl-struct-slots))) | ||
| 511 | (error "Can't dispatch on cl-struct %S: no tag in slot 0" | ||
| 512 | type)) | ||
| 513 | ;; We could/should check the vector has length >0, | ||
| 514 | ;; but really, mixing vectors and structs is a bad idea, | ||
| 515 | ;; so let's not waste time trying to handle the case | ||
| 516 | ;; of an empty vector. | ||
| 517 | ;; BEWARE: this returns a bogus tag for non-struct vectors. | ||
| 518 | `(50 . (and (vectorp ,name) (aref ,name 0))))) | ||
| 519 | |||
| 520 | (add-function :before-until cl-generic-tag-types-function | ||
| 521 | #'cl--generic-struct-tag-types) | ||
| 522 | (defun cl--generic-struct-tag-types (tag) | ||
| 523 | ;; FIXME: cl-defstruct doesn't make it easy for us. | ||
| 524 | (and (symbolp tag) | ||
| 525 | ;; A method call shouldn't itself mess with the match-data. | ||
| 526 | (string-match-p "\\`cl-struct-\\(.*\\)" (symbol-name tag)) | ||
| 527 | (let ((types (list (intern (substring (symbol-name tag) 10))))) | ||
| 528 | (while (get (car types) 'cl-struct-include) | ||
| 529 | (push (get (car types) 'cl-struct-include) types)) | ||
| 530 | (push 'cl-struct types) ;The "parent type" of all cl-structs. | ||
| 531 | (nreverse types)))) | ||
| 532 | |||
| 533 | ;;; Dispatch on "old-style types". | ||
| 534 | |||
| 535 | (defconst cl--generic-typeof-types | ||
| 536 | ;; Hand made from the source code of `type-of'. | ||
| 537 | '((integer number) (symbol) (string array) (cons list) | ||
| 538 | ;; Markers aren't `numberp', yet they are accepted wherever integers are | ||
| 539 | ;; accepted, pretty much. | ||
| 540 | (marker) (overlay) (float number) (window-configuration) | ||
| 541 | (process) (window) (subr) (compiled-function) (buffer) (char-table array) | ||
| 542 | (bool-vector array) | ||
| 543 | (frame) (hash-table) (font-spec) (font-entity) (font-object) | ||
| 544 | (vector array) | ||
| 545 | ;; Plus, hand made: | ||
| 546 | (null list symbol) | ||
| 547 | (list) | ||
| 548 | (array) | ||
| 549 | (number))) | ||
| 550 | |||
| 551 | (add-function :before-until cl-generic-tagcode-function | ||
| 552 | #'cl--generic-typeof-tagcode) | ||
| 553 | (defun cl--generic-typeof-tagcode (type name) | ||
| 554 | ;; FIXME: Add support for other types accepted by `cl-typep' such | ||
| 555 | ;; as `character', `atom', `face', `function', ... | ||
| 556 | (and (assq type cl--generic-typeof-types) | ||
| 557 | (progn | ||
| 558 | (if (memq type '(vector array)) | ||
| 559 | (message "`%S' also matches CL structs and EIEIO classes" type)) | ||
| 560 | ;; FIXME: We could also change `type-of' to return `null' for nil. | ||
| 561 | `(10 . (if ,name (type-of ,name) 'null))))) | ||
| 562 | |||
| 563 | (add-function :before-until cl-generic-tag-types-function | ||
| 564 | #'cl--generic-typeof-types) | ||
| 565 | (defun cl--generic-typeof-types (tag) | ||
| 566 | (and (symbolp tag) | ||
| 567 | (assq tag cl--generic-typeof-types))) | ||
| 568 | |||
| 569 | ;;; Just for kicks: dispatch on major-mode | ||
| 570 | ;; | ||
| 571 | ;; Here's how you'd use it: | ||
| 572 | ;; (cl-defmethod foo ((x (major-mode text-mode)) y z) ...) | ||
| 573 | ;; And then | ||
| 574 | ;; (foo 'major-mode toto titi) | ||
| 575 | ;; | ||
| 576 | ;; FIXME: Better would be to do that via dispatch on an "implicit argument". | ||
| 577 | |||
| 578 | ;; (defvar cl--generic-major-modes (make-hash-table :test #'eq)) | ||
| 579 | ;; | ||
| 580 | ;; (add-function :before-until cl-generic-tagcode-function | ||
| 581 | ;; #'cl--generic-major-mode-tagcode) | ||
| 582 | ;; (defun cl--generic-major-mode-tagcode (type name) | ||
| 583 | ;; (if (eq 'major-mode (car-safe type)) | ||
| 584 | ;; `(50 . (if (eq ,name 'major-mode) | ||
| 585 | ;; (cl--generic-with-memoization | ||
| 586 | ;; (gethash major-mode cl--generic-major-modes) | ||
| 587 | ;; `(cl--generic-major-mode . ,major-mode)))))) | ||
| 588 | ;; | ||
| 589 | ;; (add-function :before-until cl-generic-tag-types-function | ||
| 590 | ;; #'cl--generic-major-mode-types) | ||
| 591 | ;; (defun cl--generic-major-mode-types (tag) | ||
| 592 | ;; (when (eq (car-safe tag) 'cl--generic-major-mode) | ||
| 593 | ;; (if (eq tag 'fundamental-mode) '(fundamental-mode t) | ||
| 594 | ;; (let ((types `((major-mode ,(cdr tag))))) | ||
| 595 | ;; (while (get (car types) 'derived-mode-parent) | ||
| 596 | ;; (push (list 'major-mode (get (car types) 'derived-mode-parent)) | ||
| 597 | ;; types)) | ||
| 598 | ;; (unless (eq 'fundamental-mode (car types)) | ||
| 599 | ;; (push '(major-mode fundamental-mode) types)) | ||
| 600 | ;; (nreverse types))))) | ||
| 601 | |||
| 602 | ;; Local variables: | ||
| 603 | ;; generated-autoload-file: "cl-loaddefs.el" | ||
| 604 | ;; End: | ||
| 605 | |||
| 606 | (provide 'cl-generic) | ||
| 607 | ;;; cl-generic.el ends here | ||
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index fff5b27315c..0070599af6f 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -625,14 +625,20 @@ The result of the body appears to the compiler as a quoted constant." | |||
| 625 | (set `(setq ,temp ,form))) | 625 | (set `(setq ,temp ,form))) |
| 626 | (if (and (fboundp 'byte-compile-file-form-defmumble) | 626 | (if (and (fboundp 'byte-compile-file-form-defmumble) |
| 627 | (boundp 'this-kind) (boundp 'that-one)) | 627 | (boundp 'this-kind) (boundp 'that-one)) |
| 628 | (fset 'byte-compile-file-form | 628 | ;; Else, we can't output right away, so we have to delay it to the |
| 629 | `(lambda (form) | 629 | ;; next time we're at the top-level. |
| 630 | (fset 'byte-compile-file-form | 630 | ;; FIXME: Use advice-add/remove. |
| 631 | ',(symbol-function 'byte-compile-file-form)) | 631 | (fset 'byte-compile-file-form |
| 632 | (byte-compile-file-form ',set) | 632 | (let ((old (symbol-function 'byte-compile-file-form))) |
| 633 | (byte-compile-file-form form))) | 633 | (lambda (form) |
| 634 | (print set (symbol-value 'byte-compile--outbuffer))) | 634 | (fset 'byte-compile-file-form old) |
| 635 | `(symbol-value ',temp)) | 635 | (byte-compile-file-form set) |
| 636 | (byte-compile-file-form form)))) | ||
| 637 | ;; If we're not in the middle of compiling something, we can | ||
| 638 | ;; output directly to byte-compile-outbuffer, to make sure | ||
| 639 | ;; temp is set before we use it. | ||
| 640 | (print set byte-compile--outbuffer)) | ||
| 641 | temp) | ||
| 636 | `',(eval form))) | 642 | `',(eval form))) |
| 637 | 643 | ||
| 638 | 644 | ||
| @@ -1824,18 +1830,30 @@ a `let' form, except that the list of symbols can be computed at run-time." | |||
| 1824 | (defmacro cl-flet (bindings &rest body) | 1830 | (defmacro cl-flet (bindings &rest body) |
| 1825 | "Make local function definitions. | 1831 | "Make local function definitions. |
| 1826 | Like `cl-labels' but the definitions are not recursive. | 1832 | Like `cl-labels' but the definitions are not recursive. |
| 1833 | Each binding can take the form (FUNC EXP) where | ||
| 1834 | FUNC is the function name, and EXP is an expression that returns the | ||
| 1835 | function value to which it should be bound, or it can take the more common | ||
| 1836 | form \(FUNC ARGLIST BODY...) which is a shorthand | ||
| 1837 | for (FUNC (lambda ARGLIST BODY)). | ||
| 1827 | 1838 | ||
| 1828 | \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" | 1839 | \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" |
| 1829 | (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body))) | 1840 | (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body))) |
| 1830 | (let ((binds ()) (newenv macroexpand-all-environment)) | 1841 | (let ((binds ()) (newenv macroexpand-all-environment)) |
| 1831 | (dolist (binding bindings) | 1842 | (dolist (binding bindings) |
| 1832 | (let ((var (make-symbol (format "--cl-%s--" (car binding))))) | 1843 | (let ((var (make-symbol (format "--cl-%s--" (car binding)))) |
| 1833 | (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) | 1844 | (args-and-body (cdr binding))) |
| 1845 | (if (and (= (length args-and-body) 1) (symbolp (car args-and-body))) | ||
| 1846 | ;; Optimize (cl-flet ((fun var)) body). | ||
| 1847 | (setq var (car args-and-body)) | ||
| 1848 | (push (list var (if (= (length args-and-body) 1) | ||
| 1849 | (car args-and-body) | ||
| 1850 | `(cl-function (lambda . ,args-and-body)))) | ||
| 1851 | binds)) | ||
| 1834 | (push (cons (car binding) | 1852 | (push (cons (car binding) |
| 1835 | `(lambda (&rest cl-labels-args) | 1853 | (lambda (&rest cl-labels-args) |
| 1836 | (cl-list* 'funcall ',var | 1854 | (cl-list* 'funcall var cl-labels-args))) |
| 1837 | cl-labels-args))) | ||
| 1838 | newenv))) | 1855 | newenv))) |
| 1856 | ;; FIXME: Eliminate those functions which aren't referenced. | ||
| 1839 | `(let ,(nreverse binds) | 1857 | `(let ,(nreverse binds) |
| 1840 | ,@(macroexp-unprogn | 1858 | ,@(macroexp-unprogn |
| 1841 | (macroexpand-all | 1859 | (macroexpand-all |
| @@ -1869,9 +1887,8 @@ in closures will only work if `lexical-binding' is in use. | |||
| 1869 | (let ((var (make-symbol (format "--cl-%s--" (car binding))))) | 1887 | (let ((var (make-symbol (format "--cl-%s--" (car binding))))) |
| 1870 | (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) | 1888 | (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) |
| 1871 | (push (cons (car binding) | 1889 | (push (cons (car binding) |
| 1872 | `(lambda (&rest cl-labels-args) | 1890 | (lambda (&rest cl-labels-args) |
| 1873 | (cl-list* 'funcall ',var | 1891 | (cl-list* 'funcall var cl-labels-args))) |
| 1874 | cl-labels-args))) | ||
| 1875 | newenv))) | 1892 | newenv))) |
| 1876 | (macroexpand-all `(letrec ,(nreverse binds) ,@body) | 1893 | (macroexpand-all `(letrec ,(nreverse binds) ,@body) |
| 1877 | ;; Don't override lexical-let's macro-expander. | 1894 | ;; Don't override lexical-let's macro-expander. |
| @@ -1898,7 +1915,8 @@ This is like `cl-flet', but for macros instead of functions. | |||
| 1898 | (res (cl--transform-lambda (cdar bindings) name))) | 1915 | (res (cl--transform-lambda (cdar bindings) name))) |
| 1899 | (eval (car res)) | 1916 | (eval (car res)) |
| 1900 | (macroexpand-all (macroexp-progn body) | 1917 | (macroexpand-all (macroexp-progn body) |
| 1901 | (cons (cons name `(lambda ,@(cdr res))) | 1918 | (cons (cons name |
| 1919 | (eval `(cl-function (lambda ,@(cdr res))) t)) | ||
| 1902 | macroexpand-all-environment)))))) | 1920 | macroexpand-all-environment)))))) |
| 1903 | 1921 | ||
| 1904 | (defconst cl--old-macroexpand | 1922 | (defconst cl--old-macroexpand |
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index dc2c873eb42..bfa922bade6 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el | |||
| @@ -264,7 +264,7 @@ Return nil if that option doesn't exist." | |||
| 264 | 264 | ||
| 265 | (defsubst eieio-object-p (obj) | 265 | (defsubst eieio-object-p (obj) |
| 266 | "Return non-nil if OBJ is an EIEIO object." | 266 | "Return non-nil if OBJ is an EIEIO object." |
| 267 | (and (arrayp obj) | 267 | (and (vectorp obj) |
| 268 | (condition-case nil | 268 | (condition-case nil |
| 269 | (eq (aref (eieio--object-class-object obj) 0) 'defclass) | 269 | (eq (aref (eieio--object-class-object obj) 0) 'defclass) |
| 270 | (error nil)))) | 270 | (error nil)))) |
| @@ -1303,11 +1303,35 @@ method invocation orders of the involved classes." | |||
| 1303 | (define-error 'unbound-slot "Unbound slot") | 1303 | (define-error 'unbound-slot "Unbound slot") |
| 1304 | (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") | 1304 | (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") |
| 1305 | 1305 | ||
| 1306 | ;;; Hooking into cl-generic. | ||
| 1307 | |||
| 1308 | (require 'cl-generic) | ||
| 1309 | |||
| 1310 | (add-function :before-until cl-generic-tagcode-function | ||
| 1311 | #'eieio--generic-tagcode) | ||
| 1312 | (defun eieio--generic-tagcode (type name) | ||
| 1313 | ;; CLHS says: | ||
| 1314 | ;; A class must be defined before it can be used as a parameter | ||
| 1315 | ;; specializer in a defmethod form. | ||
| 1316 | ;; So we can ignore types that are not known to denote classes. | ||
| 1317 | (and (class-p type) | ||
| 1318 | ;; Prefer (aref ,name 0) over (eieio--class-tag ,name) so that | ||
| 1319 | ;; the tagcode is identical to the tagcode used for cl-struct. | ||
| 1320 | `(50 . (and (vectorp ,name) (aref ,name 0))))) | ||
| 1321 | |||
| 1322 | (add-function :before-until cl-generic-tag-types-function | ||
| 1323 | #'eieio--generic-tag-types) | ||
| 1324 | (defun eieio--generic-tag-types (tag) | ||
| 1325 | (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag)) | ||
| 1326 | (mapcar #'eieio--class-symbol | ||
| 1327 | (eieio--class-precedence-list (symbol-value tag))))) | ||
| 1328 | |||
| 1306 | ;;; Backward compatibility functions | 1329 | ;;; Backward compatibility functions |
| 1307 | ;; To support .elc files compiled for older versions of EIEIO. | 1330 | ;; To support .elc files compiled for older versions of EIEIO. |
| 1308 | 1331 | ||
| 1309 | (defun eieio-defclass (cname superclasses slots options) | 1332 | (defun eieio-defclass (cname superclasses slots options) |
| 1310 | (eval `(defclass ,cname ,superclasses ,slots ,options))) | 1333 | (declare (obsolete eieio-defclass-internal "25.1")) |
| 1334 | (eval `(defclass ,cname ,superclasses ,slots ,@options))) | ||
| 1311 | 1335 | ||
| 1312 | 1336 | ||
| 1313 | (provide 'eieio-core) | 1337 | (provide 'eieio-core) |
diff --git a/lisp/files.el b/lisp/files.el index 1533c35e6ca..175f85b29d0 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -740,7 +740,10 @@ This function works recursively. Files are returned in \"depth first\" | |||
| 740 | and alphabetical order. | 740 | and alphabetical order. |
| 741 | If INCLUDE-DIRECTORIES, also include directories that have matching names." | 741 | If INCLUDE-DIRECTORIES, also include directories that have matching names." |
| 742 | (let ((result nil) | 742 | (let ((result nil) |
| 743 | (files nil)) | 743 | (files nil) |
| 744 | ;; When DIR is "/", remote file names like "/method:" could | ||
| 745 | ;; also be offered. We shall suppress them. | ||
| 746 | (tramp-mode (and tramp-mode (file-remote-p dir)))) | ||
| 744 | (dolist (file (sort (file-name-all-completions "" dir) | 747 | (dolist (file (sort (file-name-all-completions "" dir) |
| 745 | 'string<)) | 748 | 'string<)) |
| 746 | (unless (member file '("./" "../")) | 749 | (unless (member file '("./" "../")) |
diff --git a/lisp/frame.el b/lisp/frame.el index 8b927309f0a..1d5bbf2317e 100644 --- a/lisp/frame.el +++ b/lisp/frame.el | |||
| @@ -275,23 +275,22 @@ there (in decreasing order of priority)." | |||
| 275 | ;; by the lines added in x-create-frame for the tool-bar and | 275 | ;; by the lines added in x-create-frame for the tool-bar and |
| 276 | ;; switch `tool-bar-mode' off. | 276 | ;; switch `tool-bar-mode' off. |
| 277 | (when (display-graphic-p) | 277 | (when (display-graphic-p) |
| 278 | (let ((tool-bar-lines | 278 | (let* ((init-lines |
| 279 | (or (assq 'tool-bar-lines initial-frame-alist) | 279 | (assq 'tool-bar-lines initial-frame-alist)) |
| 280 | (assq 'tool-bar-lines window-system-frame-alist) | 280 | (other-lines |
| 281 | (assq 'tool-bar-lines default-frame-alist)))) | 281 | (or (assq 'tool-bar-lines window-system-frame-alist) |
| 282 | ;; Shrink frame by its initial tool bar height iff either zero | 282 | (assq 'tool-bar-lines default-frame-alist))) |
| 283 | ;; tool bar lines have been requested in one of the frame's | 283 | (lines (or init-lines other-lines)) |
| 284 | ;; alists or tool bar mode has been turned off explicitly in | 284 | (height (tool-bar-height frame-initial-frame t))) |
| 285 | ;; the user's init file. | 285 | ;; Adjust frame top if either zero (nil) tool bar lines have |
| 286 | (when (and tool-bar-lines | 286 | ;; been requested in the most relevant of the frame's alists |
| 287 | (> frame-initial-frame-tool-bar-height 0) | 287 | ;; or tool bar mode has been explicitly turned off in the |
| 288 | (or (not tool-bar-mode) | 288 | ;; user's init file. |
| 289 | (null (cdr tool-bar-lines)) | 289 | (when (and (> height 0) |
| 290 | (eq 0 (cdr tool-bar-lines)))) | 290 | (or (and lines |
| 291 | (set-frame-height | 291 | (or (null (cdr lines)) |
| 292 | frame-initial-frame (- (frame-text-height frame-initial-frame) | 292 | (eq 0 (cdr lines)))) |
| 293 | frame-initial-frame-tool-bar-height) | 293 | (not tool-bar-mode))) |
| 294 | nil t) | ||
| 295 | (let* ((initial-top | 294 | (let* ((initial-top |
| 296 | (cdr (assq 'top frame-initial-geometry-arguments))) | 295 | (cdr (assq 'top frame-initial-geometry-arguments))) |
| 297 | (top (frame-parameter frame-initial-frame 'top))) | 296 | (top (frame-parameter frame-initial-frame 'top))) |
| @@ -299,15 +298,19 @@ there (in decreasing order of priority)." | |||
| 299 | (let ((adjusted-top | 298 | (let ((adjusted-top |
| 300 | (cond | 299 | (cond |
| 301 | ((and (consp top) (eq '+ (car top))) | 300 | ((and (consp top) (eq '+ (car top))) |
| 302 | (list '+ (+ (cadr top) | 301 | (list '+ (+ (cadr top) height))) |
| 303 | frame-initial-frame-tool-bar-height))) | ||
| 304 | ((and (consp top) (eq '- (car top))) | 302 | ((and (consp top) (eq '- (car top))) |
| 305 | (list '- (- (cadr top) | 303 | (list '- (- (cadr top) height))) |
| 306 | frame-initial-frame-tool-bar-height))) | 304 | (t (+ top height))))) |
| 307 | (t (+ top frame-initial-frame-tool-bar-height))))) | ||
| 308 | (modify-frame-parameters | 305 | (modify-frame-parameters |
| 309 | frame-initial-frame `((top . ,adjusted-top)))))) | 306 | frame-initial-frame `((top . ,adjusted-top)))))) |
| 310 | (tool-bar-mode -1)))) | 307 | ;; Reset `tool-bar-mode' when zero tool bar lines have been |
| 308 | ;; requested for the window-system or default frame alists. | ||
| 309 | (when (and tool-bar-mode | ||
| 310 | (and other-lines | ||
| 311 | (or (null (cdr other-lines)) | ||
| 312 | (eq 0 (cdr other-lines))))) | ||
| 313 | (tool-bar-mode -1))))) | ||
| 311 | 314 | ||
| 312 | ;; The initial frame we create above always has a minibuffer. | 315 | ;; The initial frame we create above always has a minibuffer. |
| 313 | ;; If the user wants to remove it, or make it a minibuffer-only | 316 | ;; If the user wants to remove it, or make it a minibuffer-only |
| @@ -682,6 +685,9 @@ the new frame according to its own rules." | |||
| 682 | (push p params))) | 685 | (push p params))) |
| 683 | ;; Now make the frame. | 686 | ;; Now make the frame. |
| 684 | (run-hooks 'before-make-frame-hook) | 687 | (run-hooks 'before-make-frame-hook) |
| 688 | |||
| 689 | ;; (setq frame-adjust-size-history '(t)) | ||
| 690 | |||
| 685 | (setq frame | 691 | (setq frame |
| 686 | (funcall (gui-method frame-creation-function w) params)) | 692 | (funcall (gui-method frame-creation-function w) params)) |
| 687 | (normal-erase-is-backspace-setup-frame frame) | 693 | (normal-erase-is-backspace-setup-frame frame) |
| @@ -690,6 +696,12 @@ the new frame according to its own rules." | |||
| 690 | (unless (assq param parameters) ;Overridden by explicit parameters. | 696 | (unless (assq param parameters) ;Overridden by explicit parameters. |
| 691 | (let ((val (frame-parameter oldframe param))) | 697 | (let ((val (frame-parameter oldframe param))) |
| 692 | (when val (set-frame-parameter frame param val))))) | 698 | (when val (set-frame-parameter frame param val))))) |
| 699 | |||
| 700 | (when (eq (car frame-adjust-size-history) t) | ||
| 701 | (setq frame-adjust-size-history | ||
| 702 | (cons t (cons (list "Frame made") | ||
| 703 | (cdr frame-adjust-size-history))))) | ||
| 704 | |||
| 693 | (run-hook-with-args 'after-make-frame-functions frame) | 705 | (run-hook-with-args 'after-make-frame-functions frame) |
| 694 | frame)) | 706 | frame)) |
| 695 | 707 | ||
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 67cb3273d23..cd1a4d05b55 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el | |||
| @@ -381,7 +381,8 @@ | |||
| 381 | 381 | ||
| 382 | (bindings--define-key menu [xref-pop] | 382 | (bindings--define-key menu [xref-pop] |
| 383 | '(menu-item "Back" xref-pop-marker-stack | 383 | '(menu-item "Back" xref-pop-marker-stack |
| 384 | :visible (not (xref-marker-stack-empty-p)) | 384 | :visible (and (featurep 'xref) |
| 385 | (not (xref-marker-stack-empty-p))) | ||
| 385 | :help "Back to the position of the last search")) | 386 | :help "Back to the position of the last search")) |
| 386 | 387 | ||
| 387 | (bindings--define-key menu [xref-apropos] | 388 | (bindings--define-key menu [xref-apropos] |
diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 6a6da17d1ce..879eb53115e 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; eww.el --- Emacs Web Wowser | 1 | ;;; eww.el --- Emacs Web Wowser -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -255,7 +255,9 @@ word(s) will be searched for via `eww-search-prefix'." | |||
| 255 | ((string-match-p "\\`ftp://" url) | 255 | ((string-match-p "\\`ftp://" url) |
| 256 | (user-error "FTP is not supported.")) | 256 | (user-error "FTP is not supported.")) |
| 257 | (t | 257 | (t |
| 258 | (if (or (string-match "\\`https?:" url) | 258 | ;; Anything that starts with something that vaguely looks |
| 259 | ;; like a protocol designator is interpreted as a full URL. | ||
| 260 | (if (or (string-match "\\`[A-Za-z]+:" url) | ||
| 259 | ;; Also try to match "naked" URLs like | 261 | ;; Also try to match "naked" URLs like |
| 260 | ;; en.wikipedia.org/wiki/Free software | 262 | ;; en.wikipedia.org/wiki/Free software |
| 261 | (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url) | 263 | (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url) |
| @@ -550,7 +552,7 @@ See the `eww-search-prefix' variable for the search engine used." | |||
| 550 | "Return URI of the Web page the current EWW buffer is visiting." | 552 | "Return URI of the Web page the current EWW buffer is visiting." |
| 551 | (plist-get eww-data :url)) | 553 | (plist-get eww-data :url)) |
| 552 | 554 | ||
| 553 | (defun eww-links-at-point (&optional pt) | 555 | (defun eww-links-at-point () |
| 554 | "Return list of URIs, if any, linked at point." | 556 | "Return list of URIs, if any, linked at point." |
| 555 | (remq nil | 557 | (remq nil |
| 556 | (list (get-text-property (point) 'shr-url) | 558 | (list (get-text-property (point) 'shr-url) |
| @@ -629,17 +631,13 @@ the like." | |||
| 629 | 631 | ||
| 630 | (defvar eww-mode-map | 632 | (defvar eww-mode-map |
| 631 | (let ((map (make-sparse-keymap))) | 633 | (let ((map (make-sparse-keymap))) |
| 632 | (suppress-keymap map) | 634 | (set-keymap-parent map special-mode-map) |
| 633 | (define-key map "q" 'quit-window) | 635 | (define-key map "g" 'eww-reload) ;FIXME: revert-buffer-function instead! |
| 634 | (define-key map "g" 'eww-reload) | ||
| 635 | (define-key map "G" 'eww) | 636 | (define-key map "G" 'eww) |
| 636 | (define-key map [?\t] 'shr-next-link) | 637 | (define-key map [?\t] 'shr-next-link) |
| 637 | (define-key map [?\M-\t] 'shr-previous-link) | 638 | (define-key map [?\M-\t] 'shr-previous-link) |
| 638 | (define-key map [backtab] 'shr-previous-link) | 639 | (define-key map [backtab] 'shr-previous-link) |
| 639 | (define-key map [delete] 'scroll-down-command) | 640 | (define-key map [delete] 'scroll-down-command) |
| 640 | (define-key map [?\S-\ ] 'scroll-down-command) | ||
| 641 | (define-key map "\177" 'scroll-down-command) | ||
| 642 | (define-key map " " 'scroll-up-command) | ||
| 643 | (define-key map "l" 'eww-back-url) | 641 | (define-key map "l" 'eww-back-url) |
| 644 | (define-key map "r" 'eww-forward-url) | 642 | (define-key map "r" 'eww-forward-url) |
| 645 | (define-key map "n" 'eww-next-url) | 643 | (define-key map "n" 'eww-next-url) |
| @@ -697,21 +695,19 @@ the like." | |||
| 697 | map) | 695 | map) |
| 698 | "Tool bar for `eww-mode'.") | 696 | "Tool bar for `eww-mode'.") |
| 699 | 697 | ||
| 700 | (define-derived-mode eww-mode nil "eww" | 698 | (define-derived-mode eww-mode special-mode "eww" |
| 701 | "Mode for browsing the web. | 699 | "Mode for browsing the web." |
| 702 | |||
| 703 | \\{eww-mode-map}" | ||
| 704 | (setq-local eww-data (list :title "")) | 700 | (setq-local eww-data (list :title "")) |
| 705 | (setq-local browse-url-browser-function 'eww-browse-url) | 701 | (setq-local browse-url-browser-function #'eww-browse-url) |
| 706 | (setq-local after-change-functions 'eww-process-text-input) | 702 | (add-hook 'after-change-functions #'eww-process-text-input nil t) |
| 707 | (setq-local eww-history nil) | 703 | (setq-local eww-history nil) |
| 708 | (setq-local eww-history-position 0) | 704 | (setq-local eww-history-position 0) |
| 709 | (when (boundp 'tool-bar-map) | 705 | (when (boundp 'tool-bar-map) |
| 710 | (setq-local tool-bar-map eww-tool-bar-map)) | 706 | (setq-local tool-bar-map eww-tool-bar-map)) |
| 711 | ;; desktop support | 707 | ;; desktop support |
| 712 | (setq-local desktop-save-buffer 'eww-desktop-misc-data) | 708 | (setq-local desktop-save-buffer #'eww-desktop-misc-data) |
| 713 | ;; multi-page isearch support | 709 | ;; multi-page isearch support |
| 714 | (setq-local multi-isearch-next-buffer-function 'eww-isearch-next-buffer) | 710 | (setq-local multi-isearch-next-buffer-function #'eww-isearch-next-buffer) |
| 715 | (setq truncate-lines t) | 711 | (setq truncate-lines t) |
| 716 | (buffer-disable-undo) | 712 | (buffer-disable-undo) |
| 717 | (setq buffer-read-only t)) | 713 | (setq buffer-read-only t)) |
| @@ -1054,7 +1050,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") | |||
| 1054 | (insert value) | 1050 | (insert value) |
| 1055 | (shr-ensure-newline) | 1051 | (shr-ensure-newline) |
| 1056 | (when (< (count-lines start (point)) lines) | 1052 | (when (< (count-lines start (point)) lines) |
| 1057 | (dotimes (i (- lines (count-lines start (point)))) | 1053 | (dotimes (_ (- lines (count-lines start (point)))) |
| 1058 | (insert "\n"))) | 1054 | (insert "\n"))) |
| 1059 | (setq end (point-marker)) | 1055 | (setq end (point-marker)) |
| 1060 | (goto-char start) | 1056 | (goto-char start) |
| @@ -1846,7 +1842,7 @@ Also used when saving `eww-history'.") | |||
| 1846 | ;; . | 1842 | ;; . |
| 1847 | r)) | 1843 | r)) |
| 1848 | 1844 | ||
| 1849 | (defun eww-desktop-misc-data (directory) | 1845 | (defun eww-desktop-misc-data (_directory) |
| 1850 | "Return a property list with data used to restore eww buffers. | 1846 | "Return a property list with data used to restore eww buffers. |
| 1851 | This list will contain, as :history, the list, whose first element is | 1847 | This list will contain, as :history, the list, whose first element is |
| 1852 | the value of `eww-data', and the tail is `eww-history'. | 1848 | the value of `eww-data', and the tail is `eww-history'. |
| @@ -1894,7 +1890,7 @@ Otherwise, the restored buffer will contain a prompt to do so by using | |||
| 1894 | 1890 | ||
| 1895 | ;;; Isearch support | 1891 | ;;; Isearch support |
| 1896 | 1892 | ||
| 1897 | (defun eww-isearch-next-buffer (&optional buffer wrap) | 1893 | (defun eww-isearch-next-buffer (&optional _buffer wrap) |
| 1898 | "Go to the next page to search using `rel' attribute for navigation." | 1894 | "Go to the next page to search using `rel' attribute for navigation." |
| 1899 | (if wrap | 1895 | (if wrap |
| 1900 | (condition-case nil | 1896 | (condition-case nil |
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index bf7803c85ca..b63eeb4c7a6 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el | |||
| @@ -89,13 +89,60 @@ | |||
| 89 | ;;`(message ,@args) | 89 | ;;`(message ,@args) |
| 90 | ) | 90 | ) |
| 91 | 91 | ||
| 92 | (defun cc-bytecomp-compiling-or-loading () | ||
| 93 | ;; Determine whether byte-compilation or loading is currently active, | ||
| 94 | ;; returning 'compiling, 'loading or nil. | ||
| 95 | ;; If both are active, the "innermost" activity counts. Note that | ||
| 96 | ;; compilation can trigger loading (various `require' type forms) | ||
| 97 | ;; and loading can trigger compilation (the package manager does | ||
| 98 | ;; this). We walk the lisp stack if necessary. | ||
| 99 | (cond | ||
| 100 | ((and load-in-progress | ||
| 101 | (boundp 'byte-compile-dest-file) | ||
| 102 | (stringp byte-compile-dest-file)) | ||
| 103 | (let ((n 0) elt) | ||
| 104 | (while (and | ||
| 105 | (setq elt (backtrace-frame n)) | ||
| 106 | (not (and (car elt) | ||
| 107 | (memq (cadr elt) | ||
| 108 | '(load require | ||
| 109 | byte-compile-file byte-recompile-directory | ||
| 110 | batch-byte-compile))))) | ||
| 111 | (setq n (1+ n))) | ||
| 112 | (cond | ||
| 113 | ((memq (cadr elt) '(load require)) | ||
| 114 | 'loading) | ||
| 115 | ((memq (cadr elt) '(byte-compile-file | ||
| 116 | byte-recompile-directory | ||
| 117 | batch-byte-compile)) | ||
| 118 | 'compiling) | ||
| 119 | (t ; Can't happen. | ||
| 120 | (message "cc-bytecomp-compiling-or-loading: System flags spuriously set") | ||
| 121 | nil)))) | ||
| 122 | (load-in-progress | ||
| 123 | ;; Being loaded. | ||
| 124 | 'loading) | ||
| 125 | ((and (boundp 'byte-compile-dest-file) | ||
| 126 | (stringp byte-compile-dest-file)) | ||
| 127 | ;; Being compiled. | ||
| 128 | 'compiling) | ||
| 129 | (t | ||
| 130 | ;; Being evaluated interactively. | ||
| 131 | nil))) | ||
| 132 | |||
| 133 | (defsubst cc-bytecomp-is-compiling () | ||
| 134 | "Return non-nil if eval'ed during compilation." | ||
| 135 | (eq (cc-bytecomp-compiling-or-loading) 'compiling)) | ||
| 136 | |||
| 137 | (defsubst cc-bytecomp-is-loading () | ||
| 138 | "Return non-nil if eval'ed during loading. | ||
| 139 | Nil will be returned if we're in a compilation triggered by the loading." | ||
| 140 | (eq (cc-bytecomp-compiling-or-loading) 'loading)) | ||
| 141 | |||
| 92 | (defun cc-bytecomp-setup-environment () | 142 | (defun cc-bytecomp-setup-environment () |
| 93 | ;; Eval'ed during compilation to setup variables, functions etc | 143 | ;; Eval'ed during compilation to setup variables, functions etc |
| 94 | ;; declared with `cc-bytecomp-defvar' et al. | 144 | ;; declared with `cc-bytecomp-defvar' et al. |
| 95 | (if (not load-in-progress) | 145 | (if (not (cc-bytecomp-is-loading)) |
| 96 | ;; Look at `load-in-progress' to tell whether we're called | ||
| 97 | ;; directly in the file being compiled or just from some file | ||
| 98 | ;; being loaded during compilation. | ||
| 99 | (let (p) | 146 | (let (p) |
| 100 | (if cc-bytecomp-environment-set | 147 | (if cc-bytecomp-environment-set |
| 101 | (error "Byte compilation environment already set - \ | 148 | (error "Byte compilation environment already set - \ |
| @@ -143,7 +190,7 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere")) | |||
| 143 | (defun cc-bytecomp-restore-environment () | 190 | (defun cc-bytecomp-restore-environment () |
| 144 | ;; Eval'ed during compilation to restore variables, functions etc | 191 | ;; Eval'ed during compilation to restore variables, functions etc |
| 145 | ;; declared with `cc-bytecomp-defvar' et al. | 192 | ;; declared with `cc-bytecomp-defvar' et al. |
| 146 | (if (not load-in-progress) | 193 | (if (not (cc-bytecomp-is-loading)) |
| 147 | (let (p) | 194 | (let (p) |
| 148 | (setq p cc-bytecomp-unbound-variables) | 195 | (setq p cc-bytecomp-unbound-variables) |
| 149 | (while p | 196 | (while p |
| @@ -287,8 +334,7 @@ use within `eval-when-compile'." | |||
| 287 | `(eval-when-compile | 334 | `(eval-when-compile |
| 288 | (if (and (fboundp 'cc-bytecomp-is-compiling) | 335 | (if (and (fboundp 'cc-bytecomp-is-compiling) |
| 289 | (cc-bytecomp-is-compiling)) | 336 | (cc-bytecomp-is-compiling)) |
| 290 | (if (or (not load-in-progress) | 337 | (if (not (featurep ,cc-part)) |
| 291 | (not (featurep ,cc-part))) | ||
| 292 | (cc-bytecomp-load (symbol-name ,cc-part))) | 338 | (cc-bytecomp-load (symbol-name ,cc-part))) |
| 293 | (require ,cc-part)))) | 339 | (require ,cc-part)))) |
| 294 | 340 | ||
| @@ -301,12 +347,6 @@ afterwards. Don't use within `eval-when-compile'." | |||
| 301 | (require ,feature) | 347 | (require ,feature) |
| 302 | (eval-when-compile (cc-bytecomp-setup-environment)))) | 348 | (eval-when-compile (cc-bytecomp-setup-environment)))) |
| 303 | 349 | ||
| 304 | (defun cc-bytecomp-is-compiling () | ||
| 305 | "Return non-nil if eval'ed during compilation. Don't use outside | ||
| 306 | `eval-when-compile'." | ||
| 307 | (and (boundp 'byte-compile-dest-file) | ||
| 308 | (stringp byte-compile-dest-file))) | ||
| 309 | |||
| 310 | (defmacro cc-bytecomp-defvar (var) | 350 | (defmacro cc-bytecomp-defvar (var) |
| 311 | "Binds the symbol as a variable during compilation of the file, | 351 | "Binds the symbol as a variable during compilation of the file, |
| 312 | to silence the byte compiler. Don't use within `eval-when-compile'." | 352 | to silence the byte compiler. Don't use within `eval-when-compile'." |
| @@ -320,8 +360,7 @@ to silence the byte compiler. Don't use within `eval-when-compile'." | |||
| 320 | "cc-bytecomp-defvar: Saving %s (as unbound)" ',var) | 360 | "cc-bytecomp-defvar: Saving %s (as unbound)" ',var) |
| 321 | (setq cc-bytecomp-unbound-variables | 361 | (setq cc-bytecomp-unbound-variables |
| 322 | (cons ',var cc-bytecomp-unbound-variables)))) | 362 | (cons ',var cc-bytecomp-unbound-variables)))) |
| 323 | (if (and (cc-bytecomp-is-compiling) | 363 | (if (cc-bytecomp-is-compiling) |
| 324 | (not load-in-progress)) | ||
| 325 | (progn | 364 | (progn |
| 326 | (defvar ,var) | 365 | (defvar ,var) |
| 327 | (set ',var (intern (concat "cc-bytecomp-ignore-var:" | 366 | (set ',var (intern (concat "cc-bytecomp-ignore-var:" |
| @@ -349,8 +388,7 @@ at compile time, e.g. for macros and inline functions." | |||
| 349 | (setq cc-bytecomp-original-functions | 388 | (setq cc-bytecomp-original-functions |
| 350 | (cons (list ',fun nil 'unbound) | 389 | (cons (list ',fun nil 'unbound) |
| 351 | cc-bytecomp-original-functions)))) | 390 | cc-bytecomp-original-functions)))) |
| 352 | (if (and (cc-bytecomp-is-compiling) | 391 | (if (cc-bytecomp-is-compiling) |
| 353 | (not load-in-progress)) | ||
| 354 | (progn | 392 | (progn |
| 355 | (fset ',fun (intern (concat "cc-bytecomp-ignore-fun:" | 393 | (fset ',fun (intern (concat "cc-bytecomp-ignore-fun:" |
| 356 | (symbol-name ',fun)))) | 394 | (symbol-name ',fun)))) |
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 2ea566a7a25..d0beab1d485 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el | |||
| @@ -1983,19 +1983,22 @@ system." | |||
| 1983 | 1983 | ||
| 1984 | (defvar c-lang-const-expansion nil) | 1984 | (defvar c-lang-const-expansion nil) |
| 1985 | 1985 | ||
| 1986 | ;; Ugly hack to pull in the definition of `cc-bytecomp-compiling-or-loading` | ||
| 1987 | ;; from cc-bytecomp to make it available at loadtime. This is the same | ||
| 1988 | ;; mechanism used in cc-mode.el for `c-populate-syntax-table'. | ||
| 1989 | (defalias 'cc-bytecomp-compiling-or-loading | ||
| 1990 | (cc-eval-when-compile | ||
| 1991 | (let ((f (symbol-function 'cc-bytecomp-compiling-or-loading))) | ||
| 1992 | (if (byte-code-function-p f) f (byte-compile f))))) | ||
| 1993 | |||
| 1986 | (defsubst c-get-current-file () | 1994 | (defsubst c-get-current-file () |
| 1987 | ;; Return the base name of the current file. | 1995 | ;; Return the base name of the current file. |
| 1988 | (let ((file (cond | 1996 | (let* ((c-or-l (cc-bytecomp-compiling-or-loading)) |
| 1989 | (load-in-progress | 1997 | (file |
| 1990 | ;; Being loaded. | 1998 | (cond |
| 1991 | load-file-name) | 1999 | ((eq c-or-l 'loading) load-file-name) |
| 1992 | ((and (boundp 'byte-compile-dest-file) | 2000 | ((eq c-or-l 'compiling) byte-compile-dest-file) |
| 1993 | (stringp byte-compile-dest-file)) | 2001 | ((null c-or-l) (buffer-file-name))))) |
| 1994 | ;; Being compiled. | ||
| 1995 | byte-compile-dest-file) | ||
| 1996 | (t | ||
| 1997 | ;; Being evaluated interactively. | ||
| 1998 | (buffer-file-name))))) | ||
| 1999 | (and file | 2002 | (and file |
| 2000 | (file-name-sans-extension | 2003 | (file-name-sans-extension |
| 2001 | (file-name-nondirectory file))))) | 2004 | (file-name-nondirectory file))))) |
| @@ -2062,6 +2065,9 @@ constant. A file is identified by its base name." | |||
| 2062 | ;; language constant source definitions.) | 2065 | ;; language constant source definitions.) |
| 2063 | (c-lang-const-expansion 'call) | 2066 | (c-lang-const-expansion 'call) |
| 2064 | (c-langs-are-parametric t) | 2067 | (c-langs-are-parametric t) |
| 2068 | (file (intern | ||
| 2069 | (or (c-get-current-file) | ||
| 2070 | (error "`c-lang-defconst' can only be used in a file")))) | ||
| 2065 | bindings | 2071 | bindings |
| 2066 | pre-files) | 2072 | pre-files) |
| 2067 | 2073 | ||
| @@ -2121,9 +2127,14 @@ constant. A file is identified by its base name." | |||
| 2121 | ;; definitions for this symbol, to make sure the order in the | 2127 | ;; definitions for this symbol, to make sure the order in the |
| 2122 | ;; `source' property is correct even when files are loaded out of | 2128 | ;; `source' property is correct even when files are loaded out of |
| 2123 | ;; order. | 2129 | ;; order. |
| 2124 | (setq pre-files (nreverse | 2130 | (setq pre-files (mapcar 'car (get sym 'source))) |
| 2125 | ;; Reverse to get the right load order. | 2131 | (if (memq file pre-files) |
| 2126 | (mapcar 'car (get sym 'source)))) | 2132 | ;; This can happen when the source file (e.g. cc-langs.el) is first |
| 2133 | ;; loaded as source, setting a 'source property entry, and then itself | ||
| 2134 | ;; being compiled. | ||
| 2135 | (setq pre-files (cdr (memq file pre-files)))) | ||
| 2136 | ;; Reverse to get the right load order. | ||
| 2137 | (setq pre-files (nreverse pre-files)) | ||
| 2127 | 2138 | ||
| 2128 | `(eval-and-compile | 2139 | `(eval-and-compile |
| 2129 | (c-define-lang-constant ',name ,bindings | 2140 | (c-define-lang-constant ',name ,bindings |
| @@ -2233,9 +2244,7 @@ quoted." | |||
| 2233 | (if (or (eq c-lang-const-expansion 'call) | 2244 | (if (or (eq c-lang-const-expansion 'call) |
| 2234 | (and (not c-lang-const-expansion) | 2245 | (and (not c-lang-const-expansion) |
| 2235 | (not mode)) | 2246 | (not mode)) |
| 2236 | load-in-progress | 2247 | (not (cc-bytecomp-is-compiling))) |
| 2237 | (not (boundp 'byte-compile-dest-file)) | ||
| 2238 | (not (stringp byte-compile-dest-file))) | ||
| 2239 | ;; Either a straight call is requested in the context, or | 2248 | ;; Either a straight call is requested in the context, or |
| 2240 | ;; we're in an "uncontrolled" context and got no language, | 2249 | ;; we're in an "uncontrolled" context and got no language, |
| 2241 | ;; or we're not being byte compiled so the compile time | 2250 | ;; or we're not being byte compiled so the compile time |
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 17d717e740f..4d16a9b9d33 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el | |||
| @@ -3260,10 +3260,7 @@ function it returns is byte compiled with all the evaluated results | |||
| 3260 | from the language constants. Use the `c-init-language-vars' macro to | 3260 | from the language constants. Use the `c-init-language-vars' macro to |
| 3261 | accomplish that conveniently." | 3261 | accomplish that conveniently." |
| 3262 | 3262 | ||
| 3263 | (if (and (not load-in-progress) | 3263 | (if (cc-bytecomp-is-compiling) |
| 3264 | (boundp 'byte-compile-dest-file) | ||
| 3265 | (stringp byte-compile-dest-file)) | ||
| 3266 | |||
| 3267 | ;; No need to byte compile this lambda since the byte compiler is | 3264 | ;; No need to byte compile this lambda since the byte compiler is |
| 3268 | ;; smart enough to detect the `funcall' construct in the | 3265 | ;; smart enough to detect the `funcall' construct in the |
| 3269 | ;; `c-init-language-vars' macro below and compile it all straight | 3266 | ;; `c-init-language-vars' macro below and compile it all straight |
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index b822619f783..7f77d218a48 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el | |||
| @@ -301,6 +301,7 @@ backward." | |||
| 301 | (let ((marker (ring-remove ring))) | 301 | (let ((marker (ring-remove ring))) |
| 302 | (set-marker marker nil nil))))) | 302 | (set-marker marker nil nil))))) |
| 303 | 303 | ||
| 304 | ;;;###autoload | ||
| 304 | (defun xref-marker-stack-empty-p () | 305 | (defun xref-marker-stack-empty-p () |
| 305 | "Return t if the marker stack is empty; nil otherwise." | 306 | "Return t if the marker stack is empty; nil otherwise." |
| 306 | (ring-empty-p xref--marker-ring)) | 307 | (ring-empty-p xref--marker-ring)) |
diff --git a/src/.gdbinit b/src/.gdbinit index 1a2a973e694..91beaef8d73 100644 --- a/src/.gdbinit +++ b/src/.gdbinit | |||
| @@ -70,14 +70,18 @@ define xgettype | |||
| 70 | set $type = (enum Lisp_Type) (USE_LSB_TAG ? $bugfix & (1 << GCTYPEBITS) - 1 : (EMACS_UINT) $bugfix >> VALBITS) | 70 | set $type = (enum Lisp_Type) (USE_LSB_TAG ? $bugfix & (1 << GCTYPEBITS) - 1 : (EMACS_UINT) $bugfix >> VALBITS) |
| 71 | end | 71 | end |
| 72 | 72 | ||
| 73 | define xgetsym | ||
| 74 | xgetptr $arg0 | ||
| 75 | if (!USE_LSB_TAG) | ||
| 76 | set $ptr = ($ptr << GCTYPEBITS) | ||
| 77 | end | ||
| 78 | set $ptr = ((struct Lisp_Symbol *) ((char *)lispsym + $ptr)) | ||
| 79 | end | ||
| 80 | |||
| 73 | # Access the name of a symbol | 81 | # Access the name of a symbol |
| 74 | define xsymname | 82 | define xsymname |
| 75 | if (CHECK_LISP_OBJECT_TYPE) | 83 | xgetsym $arg0 |
| 76 | set $bugfix = $arg0.i | 84 | set $symname = $ptr->name |
| 77 | else | ||
| 78 | set $bugfix = $arg0 | ||
| 79 | end | ||
| 80 | set $symname = ((struct Lisp_Symbol *) ((char *)lispsym + $bugfix))->name | ||
| 81 | end | 85 | end |
| 82 | 86 | ||
| 83 | # Set up something to print out s-expressions. | 87 | # Set up something to print out s-expressions. |
| @@ -760,7 +764,7 @@ end | |||
| 760 | 764 | ||
| 761 | define xsymbol | 765 | define xsymbol |
| 762 | set $sym = $ | 766 | set $sym = $ |
| 763 | xgetptr $sym | 767 | xgetsym $sym |
| 764 | print (struct Lisp_Symbol *) $ptr | 768 | print (struct Lisp_Symbol *) $ptr |
| 765 | xprintsym $sym | 769 | xprintsym $sym |
| 766 | echo \n | 770 | echo \n |
| @@ -1082,8 +1086,7 @@ define xprintstr | |||
| 1082 | end | 1086 | end |
| 1083 | 1087 | ||
| 1084 | define xprintsym | 1088 | define xprintsym |
| 1085 | xgetptr $arg0 | 1089 | xsymname $arg0 |
| 1086 | xsymname $ptr | ||
| 1087 | xgetptr $symname | 1090 | xgetptr $symname |
| 1088 | set $sym_name = (struct Lisp_String *) $ptr | 1091 | set $sym_name = (struct Lisp_String *) $ptr |
| 1089 | xprintstr $sym_name | 1092 | xprintstr $sym_name |
diff --git a/src/ChangeLog b/src/ChangeLog index 8f441be3307..b2588f1451f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,236 @@ | |||
| 1 | 2015-01-14 Eli Zaretskii <eliz@gnu.org> | ||
| 2 | |||
| 3 | * w32fns.c (w32_wnd_proc): Ignore MENUITEMINFO's dwItemData data | ||
| 4 | when FLAGS indicate the item is not highlighted. (Bug#19596) | ||
| 5 | |||
| 6 | 2015-01-14 Martin Rudalics <rudalics@gmx.at> | ||
| 7 | |||
| 8 | * xmenu.c (update_frame_menubar): Remove garbaged code. | ||
| 9 | |||
| 10 | 2015-01-14 Paul Eggert <eggert@cs.ucla.edu> | ||
| 11 | |||
| 12 | remove_slash_colon need not be inline | ||
| 13 | * process.c, process.h (remove_slash_colon): No longer inline. | ||
| 14 | This saves text bytes without hurting runtime performance. | ||
| 15 | |||
| 16 | 2015-01-14 Dmitry Antipov <dmantipov@yandex.ru> | ||
| 17 | |||
| 18 | Avoid extra multibyteness check in ENCODE_FILE users. | ||
| 19 | * callproc.c (encode_current_directory, Fcall_process, call_process): | ||
| 20 | * dired.c (directory_files_internal, file_name_completion): | ||
| 21 | Do not check for STRING_MULTIBYTE because encode_file_name | ||
| 22 | is a no-op for unibyte strings. | ||
| 23 | |||
| 24 | * process.h (remove_slash_colon): New function. | ||
| 25 | * callproc.c (encode_current_directory, call_process): | ||
| 26 | * process.c (Fstart_process): Use it. | ||
| 27 | |||
| 28 | Consistently handle time zone specification. | ||
| 29 | * editfns.c (decode_time_zone): New function, refactored out from ... | ||
| 30 | (Fencode_time): ... adjusted user. | ||
| 31 | (Fset_time_zone_rule): Use decode_time_zone. | ||
| 32 | |||
| 33 | * editfns.c (make_buffer_string_both): If requested range intersects | ||
| 34 | the gap, don't move the latter but copy in two regions, thus avoiding | ||
| 35 | unnecessary relocation of buffer data. | ||
| 36 | |||
| 37 | 2015-01-14 Paul Eggert <eggert@cs.ucla.edu> | ||
| 38 | |||
| 39 | Use bool for boolean in xmenu.c, xml.c | ||
| 40 | * xmenu.c (x_menu_set_in_use, popup_get_selection) | ||
| 41 | (Fx_menu_bar_open_internal, popup_widget_loop) | ||
| 42 | (x_activate_menubar, xg_crazy_callback_abort) | ||
| 43 | (update_frame_menubar, set_frame_menubar) | ||
| 44 | (initialize_frame_menubar, free_frame_menubar) | ||
| 45 | (create_and_show_popup_menu, x_menu_show) | ||
| 46 | (create_and_show_dialog, x_dialog_show): | ||
| 47 | * xml.c (libxml2_loaded_p, init_libxml2_functions, parse_region) | ||
| 48 | (Flibxml_parse_html_region, Flibxml_parse_xml_region): | ||
| 49 | * xrdb.c (main) [TESTRM]: | ||
| 50 | * xsettings.c (init_gsettings): | ||
| 51 | * xterm.c (XFillRectangle, xg_scroll_callback) | ||
| 52 | (xg_end_scroll_callback): | ||
| 53 | * xterm.h (x_menu_set_in_use) [USE_GTK || USE_MOTIF]: | ||
| 54 | Use bool for boolean. | ||
| 55 | * xmenu.c (TRUE): Remove; no longer used. | ||
| 56 | (show_help_event): Remove long-unused code. | ||
| 57 | (set_frame_menubar): Remove "#if 1" and corresponding "#endif" lines. | ||
| 58 | |||
| 59 | 2015-01-13 Paul Eggert <eggert@cs.ucla.edu> | ||
| 60 | |||
| 61 | Don't say Fnext_read_file_uses_dialog_p is const | ||
| 62 | It's const only if a windowing system is not used; don't say it's | ||
| 63 | const otherwise. See: | ||
| 64 | http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00310.html | ||
| 65 | * fileio.c (next_read_file_uses_dialog_p): Remove. | ||
| 66 | Move guts back to ... | ||
| 67 | (Fnext_read_file_uses_dialog_p): ... here. | ||
| 68 | Don't declare as const, as make-docfile.c now has a special case | ||
| 69 | for this function. This is an ugly hack, but it's better than | ||
| 70 | lying to the compiler. | ||
| 71 | |||
| 72 | Remove now-unnecessary forward XTYPE decl | ||
| 73 | * lisp.h (XTYPE): Remove forward declaration. The recent merge | ||
| 74 | from emacs-24 fixed the problem in a better way, by moving XPNTR's | ||
| 75 | definition to after XTYPE's. | ||
| 76 | |||
| 77 | 2015-01-13 Eli Zaretskii <eliz@gnu.org> | ||
| 78 | |||
| 79 | Fix problems with 32-bit wide-int build exposed by MinGW. | ||
| 80 | * lisp.h (XPNTR): Move definition to after XTYPE, to avoid | ||
| 81 | compilation error in an unoptimized build when !USE_LSB_TAG. | ||
| 82 | |||
| 83 | * w32heap.c (DUMPED_HEAP_SIZE): For 32-bit wide-int build, use the | ||
| 84 | same larger value as for the 64-bit build. | ||
| 85 | |||
| 86 | * w32term.h (SCROLL_BAR_PACK): Cast the result to UINT_PTR to | ||
| 87 | avoid compiler warnings. | ||
| 88 | |||
| 89 | * w32proc.c (Fw32_get_codepage_charset, Fw32_set_keyboard_layout): | ||
| 90 | Avoid compiler warnings about cast from integer to pointer of | ||
| 91 | different size. | ||
| 92 | |||
| 93 | * w32menu.c (menubar_selection_callback, w32_menu_show): Cast to | ||
| 94 | UINT_PTR instead of EMACS_INT, to avoid compiler warnings about | ||
| 95 | casting from integer to pointer of different size. | ||
| 96 | (add_menu_item): Pass the help-echo string as a pointer to | ||
| 97 | Lisp_String, not as a Lisp_Object. | ||
| 98 | (w32_menu_display_help): Use make_lisp_ptr to reconstruct a Lisp | ||
| 99 | string object from its C pointer. | ||
| 100 | |||
| 101 | * w32fns.c (w32_msg_pump) <WM_EMACS_UNREGISTER_HOT_KEY>: Use | ||
| 102 | make_lisp_ptr instead of XIL, to reconstruct a Lisp_Cons from its | ||
| 103 | C pointer. | ||
| 104 | <WM_EMACS_TOGGLE_LOCK_KEY>: msg.lparam is now a C integer. | ||
| 105 | (Fx_create_frame): Type-cast the result of XFASTINT to avoild | ||
| 106 | compiler warnings about size differences. | ||
| 107 | (Fw32_unregister_hot_key): Pass the tail of w32_grabbed_keys as a | ||
| 108 | pointer to a Lisp_Cons struct, not as a disguised EMACS_INT. | ||
| 109 | (Fw32_toggle_lock_key): Pass the new state of the key as a C | ||
| 110 | integer; use -1 for nil. Doc fix. | ||
| 111 | |||
| 112 | * .gdbinit (xgetsym): New subroutine. | ||
| 113 | (xsymname, xsymbol): Use it. | ||
| 114 | (xprintsym): No need to call xgetptr. | ||
| 115 | |||
| 116 | 2015-01-13 Martin Rudalics <rudalics@gmx.at> | ||
| 117 | |||
| 118 | * frame.c (adjust_frame_size): Make sure new numbers of | ||
| 119 | lines/columns get installed after font size change (Bug#19575). | ||
| 120 | |||
| 121 | 2015-01-13 Dmitry Antipov <dmantipov@yandex.ru> | ||
| 122 | |||
| 123 | Add DEFUN attributes. | ||
| 124 | * callint.c (Finteractive): | ||
| 125 | * character.c (Fcharacterp, Fmax_char): | ||
| 126 | * data.c (Feq, Fnull, Fconsp, Fatom, Flistp, Fnlistp, Fsymbolp) | ||
| 127 | (Fstringp, Fchar_or_string_p, Fintegerp, Fnatnump, Fnumberp) | ||
| 128 | (Ffloatp, Fbyteorder): | ||
| 129 | * decompress.c (Fzlib_available_p): | ||
| 130 | * fns.c (Fidentity): | ||
| 131 | * frame.c (Fframe_windows_min_size): | ||
| 132 | * gnutls.c (Fgnutls_error_p, Fgnutls_available_p): | ||
| 133 | * window.c (Fwindow__sanitize_window_sizes): | ||
| 134 | * xdisp.c (Ftool_bar_height): | ||
| 135 | * xfaces.c (Fface_attribute_relative_p): Add const attribute. | ||
| 136 | * emacs.c (Fkill_emacs): | ||
| 137 | * eval.c (Fthrow): | ||
| 138 | * keyboard.c (Ftop_level, Fexit_recursive_edit) | ||
| 139 | (Fabor_recursive_edit): Add noreturn attribute. | ||
| 140 | |||
| 141 | * search.c (fast_string_match_internal): New function, | ||
| 142 | consolidated from... | ||
| 143 | (fast_string_match, fast_string_match_ignore_case): ...functions | ||
| 144 | which are... | ||
| 145 | * lisp.h (fast_string_match, fast_string_match_ignore_case): | ||
| 146 | inlined from here now. | ||
| 147 | (fast_string_match_internal): Add prototype. | ||
| 148 | * dired.c (file_name_completion): Use fast_string_match_internal. | ||
| 149 | |||
| 150 | * fileio.c (next_read_file_uses_dialog_p): New workaround ... | ||
| 151 | (Fnext_read_file_uses_dialog_p): ... called from here to avoid | ||
| 152 | ATTRIBUTE_CONST dependency from #ifdefs. For details, see | ||
| 153 | http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00289.html. | ||
| 154 | |||
| 155 | 2015-01-12 Paul Eggert <eggert@cs.ucla.edu> | ||
| 156 | |||
| 157 | Port to 32-bit MingGW --with-wide-int | ||
| 158 | Problem reported by Eli Zaretskii in: | ||
| 159 | http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00265.html | ||
| 160 | * lisp.h (struct Lisp_Sub_Char_Table): Check that offset matches | ||
| 161 | what we think it is, rather than checking only its alignment (and | ||
| 162 | doing so incorrectly on MinGW). | ||
| 163 | |||
| 164 | 2015-01-12 Dmitry Antipov <dmantipov@yandex.ru> | ||
| 165 | |||
| 166 | * fileio.c (Ffile_name_as_directory, Fdirectory_file_name): | ||
| 167 | Remove dead NILP check. | ||
| 168 | * image.c (Flookup_image): Use regular format for docstring. | ||
| 169 | * keyboard.c (apply_modifiers_uncached): Use stpcpy. | ||
| 170 | |||
| 171 | 2015-01-12 Martin Rudalics <rudalics@gmx.at> | ||
| 172 | |||
| 173 | * dispnew.c (change_frame_size_1): Pass Qchange_frame_size to | ||
| 174 | adjust_frame_size. | ||
| 175 | * frame.c (frame_default_tool_bar_height): New variable. | ||
| 176 | (adjust_frame_size): Possibly add requested adjustment to | ||
| 177 | Vframe_adjust_size_history. | ||
| 178 | (make_frame): Initialize tool_bar_redisplayed_once slot. | ||
| 179 | (Fset_frame_height, Fset_frame_width, Fset_frame_size): Clarify | ||
| 180 | doc-string. Call adjust_frame_size unconditionally (the frame's | ||
| 181 | text size may remain unaltered but the pixel size may change). | ||
| 182 | (x_figure_window_size): If frame_default_tool_bar_height was | ||
| 183 | set, use it instead of calculating the tool bar height from | ||
| 184 | DEFAULT_TOOL_BAR_IMAGE_HEIGHT. Don't set | ||
| 185 | Vframe_initial_frame_tool_bar_height. | ||
| 186 | (Qchange_frame_size, Qxg_frame_set_char_size) | ||
| 187 | (Qset_window_configuration, Qx_create_frame_1) | ||
| 188 | (Qx_create_frame_2): New symbols. | ||
| 189 | (Vframe_initial_frame_tool_bar_height): Remove. | ||
| 190 | (Vframe_adjust_size_history): New history variable for debugging | ||
| 191 | frame size adjustments. | ||
| 192 | * frame.h (struct frame): New boolean slot | ||
| 193 | tool_bar_redisplayed_once. | ||
| 194 | (frame_default_tool_bar_height): Extern. | ||
| 195 | * gtkutil.c (xg_frame_set_char_size): Pass Qxg_frame_set_char_size | ||
| 196 | to adjust_frame_size. | ||
| 197 | * nsfns.m (Fx_create_frame): Pass Pass Qx_create_frame_1 and | ||
| 198 | Qx_create_frame_2 to adjust_frame_size. | ||
| 199 | * w32fns.c (x_change_tool_bar_height): Call adjust_frame_size with | ||
| 200 | inhibit 1 when we have not redisplayed the tool bar yet. | ||
| 201 | (Fx_create_frame): Pass Pass Qx_create_frame_1 and | ||
| 202 | Qx_create_frame_2 to adjust_frame_size. | ||
| 203 | * w32menu.c (set_frame_menubar): Simplify adjust_frame_size | ||
| 204 | call. | ||
| 205 | * window.c (Fset_window_configuration): Pass | ||
| 206 | Qset_window_configuration to adjust_frame_size. | ||
| 207 | * xdisp.c (redisplay_tool_bar): Assign new height to | ||
| 208 | frame_default_tool_bar_height. | ||
| 209 | (redisplay_internal): If we haven't redisplayed this frame's | ||
| 210 | tool bar, call redisplay_tool_bar early so we can adjust the | ||
| 211 | frame size accordingly. | ||
| 212 | * xfns.c (x_change_tool_bar_height): Call adjust_frame_size with | ||
| 213 | inhibit 1 when we have not redisplayed the tool bar yet. | ||
| 214 | (Fx_create_frame): Pass Pass Qx_create_frame_1 and | ||
| 215 | Qx_create_frame_2 to adjust_frame_size. | ||
| 216 | |||
| 217 | 2015-01-12 Paul Eggert <eggert@cs.ucla.edu> | ||
| 218 | |||
| 219 | Have 'make' output better GEN names | ||
| 220 | * Makefile.in (gl-stamp, globals.h): Simplify by putting the new | ||
| 221 | contents of globals.h into gl-stamp. This lets us use AM_V_GEN | ||
| 222 | more naturally so that 'make' can output more-accurate names. | ||
| 223 | |||
| 224 | 2015-01-11 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 225 | |||
| 226 | * buffer.c (init_buffer_once): Initialize buffer_local_flags before | ||
| 227 | calling reset_buffer_local_variables, and make sure we initialize | ||
| 228 | it completely. | ||
| 229 | |||
| 230 | 2015-01-11 Dmitry Antipov <dmantipov@yandex.ru> | ||
| 231 | |||
| 232 | * coding.c (Fcoding_system_plist): Use common style for docstring. | ||
| 233 | |||
| 1 | 2015-01-11 Paul Eggert <eggert@cs.ucla.edu> | 234 | 2015-01-11 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 235 | ||
| 3 | Port to MSB hosts without optimization | 236 | Port to MSB hosts without optimization |
diff --git a/src/Makefile.in b/src/Makefile.in index 9bd86d54793..079e0e41c9f 100644 --- a/src/Makefile.in +++ b/src/Makefile.in | |||
| @@ -502,14 +502,13 @@ buildobj.h: Makefile | |||
| 502 | done >$@.tmp | 502 | done >$@.tmp |
| 503 | $(AM_V_at)mv $@.tmp $@ | 503 | $(AM_V_at)mv $@.tmp $@ |
| 504 | 504 | ||
| 505 | globals.h: gl-stamp; @true | ||
| 506 | |||
| 507 | GLOBAL_SOURCES = $(base_obj:.o=.c) $(NS_OBJC_OBJ:.o=.m) | 505 | GLOBAL_SOURCES = $(base_obj:.o=.c) $(NS_OBJC_OBJ:.o=.m) |
| 508 | 506 | ||
| 509 | gl-stamp: $(libsrc)/make-docfile$(EXEEXT) $(GLOBAL_SOURCES) | 507 | gl-stamp: $(libsrc)/make-docfile$(EXEEXT) $(GLOBAL_SOURCES) |
| 510 | $(AM_V_GEN)$(libsrc)/make-docfile -d $(srcdir) -g $(obj) > gl.tmp | 508 | $(AM_V_GEN)$(libsrc)/make-docfile -d $(srcdir) -g $(obj) >$@ |
| 511 | $(AM_V_at)$(top_srcdir)/build-aux/move-if-change gl.tmp globals.h | 509 | |
| 512 | $(AM_V_at)echo timestamp > $@ | 510 | globals.h: gl-stamp |
| 511 | $(AM_V_GEN)cmp $< $@ >/dev/null || cp $< $@ | ||
| 513 | 512 | ||
| 514 | $(ALLOBJS): globals.h | 513 | $(ALLOBJS): globals.h |
| 515 | 514 | ||
diff --git a/src/buffer.c b/src/buffer.c index 2ea69f38f91..6bff57fe12e 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -5035,6 +5035,93 @@ init_buffer_once (void) | |||
| 5035 | 5035 | ||
| 5036 | memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags); | 5036 | memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags); |
| 5037 | 5037 | ||
| 5038 | /* 0 means not a lisp var, -1 means always local, else mask. */ | ||
| 5039 | memset (&buffer_local_flags, 0, sizeof buffer_local_flags); | ||
| 5040 | bset_filename (&buffer_local_flags, make_number (-1)); | ||
| 5041 | bset_directory (&buffer_local_flags, make_number (-1)); | ||
| 5042 | bset_backed_up (&buffer_local_flags, make_number (-1)); | ||
| 5043 | bset_save_length (&buffer_local_flags, make_number (-1)); | ||
| 5044 | bset_auto_save_file_name (&buffer_local_flags, make_number (-1)); | ||
| 5045 | bset_read_only (&buffer_local_flags, make_number (-1)); | ||
| 5046 | bset_major_mode (&buffer_local_flags, make_number (-1)); | ||
| 5047 | bset_mode_name (&buffer_local_flags, make_number (-1)); | ||
| 5048 | bset_undo_list (&buffer_local_flags, make_number (-1)); | ||
| 5049 | bset_mark_active (&buffer_local_flags, make_number (-1)); | ||
| 5050 | bset_point_before_scroll (&buffer_local_flags, make_number (-1)); | ||
| 5051 | bset_file_truename (&buffer_local_flags, make_number (-1)); | ||
| 5052 | bset_invisibility_spec (&buffer_local_flags, make_number (-1)); | ||
| 5053 | bset_file_format (&buffer_local_flags, make_number (-1)); | ||
| 5054 | bset_auto_save_file_format (&buffer_local_flags, make_number (-1)); | ||
| 5055 | bset_display_count (&buffer_local_flags, make_number (-1)); | ||
| 5056 | bset_display_time (&buffer_local_flags, make_number (-1)); | ||
| 5057 | bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1)); | ||
| 5058 | |||
| 5059 | /* These used to be stuck at 0 by default, but now that the all-zero value | ||
| 5060 | means Qnil, we have to initialize them explicitly. */ | ||
| 5061 | bset_name (&buffer_local_flags, make_number (0)); | ||
| 5062 | bset_mark (&buffer_local_flags, make_number (0)); | ||
| 5063 | bset_local_var_alist (&buffer_local_flags, make_number (0)); | ||
| 5064 | bset_keymap (&buffer_local_flags, make_number (0)); | ||
| 5065 | bset_downcase_table (&buffer_local_flags, make_number (0)); | ||
| 5066 | bset_upcase_table (&buffer_local_flags, make_number (0)); | ||
| 5067 | bset_case_canon_table (&buffer_local_flags, make_number (0)); | ||
| 5068 | bset_case_eqv_table (&buffer_local_flags, make_number (0)); | ||
| 5069 | bset_minor_modes (&buffer_local_flags, make_number (0)); | ||
| 5070 | bset_width_table (&buffer_local_flags, make_number (0)); | ||
| 5071 | bset_pt_marker (&buffer_local_flags, make_number (0)); | ||
| 5072 | bset_begv_marker (&buffer_local_flags, make_number (0)); | ||
| 5073 | bset_zv_marker (&buffer_local_flags, make_number (0)); | ||
| 5074 | bset_last_selected_window (&buffer_local_flags, make_number (0)); | ||
| 5075 | |||
| 5076 | idx = 1; | ||
| 5077 | XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx; | ||
| 5078 | XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx; | ||
| 5079 | XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx; | ||
| 5080 | XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx; | ||
| 5081 | XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx; | ||
| 5082 | XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx; | ||
| 5083 | XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx; | ||
| 5084 | XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx; | ||
| 5085 | XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx; | ||
| 5086 | XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx; | ||
| 5087 | XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx; | ||
| 5088 | XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx; | ||
| 5089 | XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx; | ||
| 5090 | XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx; | ||
| 5091 | XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx; | ||
| 5092 | XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx; | ||
| 5093 | XSETFASTINT (BVAR (&buffer_local_flags, cache_long_scans), idx); ++idx; | ||
| 5094 | XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx; | ||
| 5095 | XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx; | ||
| 5096 | XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; | ||
| 5097 | XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx); | ||
| 5098 | /* Make this one a permanent local. */ | ||
| 5099 | buffer_permanent_local_flags[idx++] = 1; | ||
| 5100 | XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx; | ||
| 5101 | XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx; | ||
| 5102 | XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx; | ||
| 5103 | XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx; | ||
| 5104 | XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx; | ||
| 5105 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx; | ||
| 5106 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_height), idx); ++idx; | ||
| 5107 | XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx; | ||
| 5108 | XSETFASTINT (BVAR (&buffer_local_flags, horizontal_scroll_bar_type), idx); ++idx; | ||
| 5109 | XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx; | ||
| 5110 | XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx; | ||
| 5111 | XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx; | ||
| 5112 | XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx; | ||
| 5113 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx; | ||
| 5114 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx; | ||
| 5115 | XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx; | ||
| 5116 | XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx; | ||
| 5117 | XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx; | ||
| 5118 | XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx; | ||
| 5119 | |||
| 5120 | /* Need more room? */ | ||
| 5121 | if (idx >= MAX_PER_BUFFER_VARS) | ||
| 5122 | emacs_abort (); | ||
| 5123 | last_per_buffer_idx = idx; | ||
| 5124 | |||
| 5038 | /* Make sure all markable slots in buffer_defaults | 5125 | /* Make sure all markable slots in buffer_defaults |
| 5039 | are initialized reasonably, so mark_buffer won't choke. */ | 5126 | are initialized reasonably, so mark_buffer won't choke. */ |
| 5040 | reset_buffer (&buffer_defaults); | 5127 | reset_buffer (&buffer_defaults); |
| @@ -5121,79 +5208,9 @@ init_buffer_once (void) | |||
| 5121 | to say that it has its own local value for the slot. | 5208 | to say that it has its own local value for the slot. |
| 5122 | The local flag bits are in the local_var_flags slot of the buffer. */ | 5209 | The local flag bits are in the local_var_flags slot of the buffer. */ |
| 5123 | 5210 | ||
| 5124 | /* Nothing can work if this isn't true */ | 5211 | /* Nothing can work if this isn't true. */ |
| 5125 | { verify (sizeof (EMACS_INT) == word_size); } | 5212 | { verify (sizeof (EMACS_INT) == word_size); } |
| 5126 | 5213 | ||
| 5127 | /* 0 means not a lisp var, -1 means always local, else mask */ | ||
| 5128 | memset (&buffer_local_flags, 0, sizeof buffer_local_flags); | ||
| 5129 | bset_filename (&buffer_local_flags, make_number (-1)); | ||
| 5130 | bset_directory (&buffer_local_flags, make_number (-1)); | ||
| 5131 | bset_backed_up (&buffer_local_flags, make_number (-1)); | ||
| 5132 | bset_save_length (&buffer_local_flags, make_number (-1)); | ||
| 5133 | bset_auto_save_file_name (&buffer_local_flags, make_number (-1)); | ||
| 5134 | bset_read_only (&buffer_local_flags, make_number (-1)); | ||
| 5135 | bset_major_mode (&buffer_local_flags, make_number (-1)); | ||
| 5136 | bset_mode_name (&buffer_local_flags, make_number (-1)); | ||
| 5137 | bset_undo_list (&buffer_local_flags, make_number (-1)); | ||
| 5138 | bset_mark_active (&buffer_local_flags, make_number (-1)); | ||
| 5139 | bset_point_before_scroll (&buffer_local_flags, make_number (-1)); | ||
| 5140 | bset_file_truename (&buffer_local_flags, make_number (-1)); | ||
| 5141 | bset_invisibility_spec (&buffer_local_flags, make_number (-1)); | ||
| 5142 | bset_file_format (&buffer_local_flags, make_number (-1)); | ||
| 5143 | bset_auto_save_file_format (&buffer_local_flags, make_number (-1)); | ||
| 5144 | bset_display_count (&buffer_local_flags, make_number (-1)); | ||
| 5145 | bset_display_time (&buffer_local_flags, make_number (-1)); | ||
| 5146 | bset_enable_multibyte_characters (&buffer_local_flags, make_number (-1)); | ||
| 5147 | |||
| 5148 | idx = 1; | ||
| 5149 | XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx; | ||
| 5150 | XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx; | ||
| 5151 | XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx; | ||
| 5152 | XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx; | ||
| 5153 | XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx; | ||
| 5154 | XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx; | ||
| 5155 | XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx; | ||
| 5156 | XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx; | ||
| 5157 | XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx; | ||
| 5158 | XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx; | ||
| 5159 | XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx; | ||
| 5160 | XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx; | ||
| 5161 | XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx; | ||
| 5162 | XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx; | ||
| 5163 | XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx; | ||
| 5164 | XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx; | ||
| 5165 | XSETFASTINT (BVAR (&buffer_local_flags, cache_long_scans), idx); ++idx; | ||
| 5166 | XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx; | ||
| 5167 | XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx; | ||
| 5168 | XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; | ||
| 5169 | XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx); | ||
| 5170 | /* Make this one a permanent local. */ | ||
| 5171 | buffer_permanent_local_flags[idx++] = 1; | ||
| 5172 | XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx; | ||
| 5173 | XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx; | ||
| 5174 | XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx; | ||
| 5175 | XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx; | ||
| 5176 | XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx; | ||
| 5177 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx; | ||
| 5178 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_height), idx); ++idx; | ||
| 5179 | XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx; | ||
| 5180 | XSETFASTINT (BVAR (&buffer_local_flags, horizontal_scroll_bar_type), idx); ++idx; | ||
| 5181 | XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx; | ||
| 5182 | XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx; | ||
| 5183 | XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx; | ||
| 5184 | XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx; | ||
| 5185 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx; | ||
| 5186 | XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx; | ||
| 5187 | XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx; | ||
| 5188 | XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx; | ||
| 5189 | XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx; | ||
| 5190 | XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx; | ||
| 5191 | |||
| 5192 | /* Need more room? */ | ||
| 5193 | if (idx >= MAX_PER_BUFFER_VARS) | ||
| 5194 | emacs_abort (); | ||
| 5195 | last_per_buffer_idx = idx; | ||
| 5196 | |||
| 5197 | Vbuffer_alist = Qnil; | 5214 | Vbuffer_alist = Qnil; |
| 5198 | current_buffer = 0; | 5215 | current_buffer = 0; |
| 5199 | all_buffers = 0; | 5216 | all_buffers = 0; |
| @@ -5210,7 +5227,7 @@ init_buffer_once (void) | |||
| 5210 | DEFSYM (Qkill_buffer_hook, "kill-buffer-hook"); | 5227 | DEFSYM (Qkill_buffer_hook, "kill-buffer-hook"); |
| 5211 | Fput (Qkill_buffer_hook, Qpermanent_local, Qt); | 5228 | Fput (Qkill_buffer_hook, Qpermanent_local, Qt); |
| 5212 | 5229 | ||
| 5213 | /* super-magic invisible buffer */ | 5230 | /* Super-magic invisible buffer. */ |
| 5214 | Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1")); | 5231 | Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1")); |
| 5215 | Vbuffer_alist = Qnil; | 5232 | Vbuffer_alist = Qnil; |
| 5216 | 5233 | ||
diff --git a/src/callint.c b/src/callint.c index 25955039ac7..dd238b976aa 100644 --- a/src/callint.c +++ b/src/callint.c | |||
| @@ -101,7 +101,8 @@ If the string begins with `^' and `shift-select-mode' is non-nil, | |||
| 101 | Emacs first calls the function `handle-shift-selection'. | 101 | Emacs first calls the function `handle-shift-selection'. |
| 102 | You may use `@', `*', and `^' together. They are processed in the | 102 | You may use `@', `*', and `^' together. They are processed in the |
| 103 | order that they appear, before reading any arguments. | 103 | order that they appear, before reading any arguments. |
| 104 | usage: (interactive &optional ARGS) */) | 104 | usage: (interactive &optional ARGS) */ |
| 105 | attributes: const) | ||
| 105 | (Lisp_Object args) | 106 | (Lisp_Object args) |
| 106 | { | 107 | { |
| 107 | return Qnil; | 108 | return Qnil; |
diff --git a/src/callproc.c b/src/callproc.c index 0fdf278073d..63ab9bf70db 100644 --- a/src/callproc.c +++ b/src/callproc.c | |||
| @@ -131,12 +131,9 @@ encode_current_directory (void) | |||
| 131 | report_file_error ("Setting current directory", | 131 | report_file_error ("Setting current directory", |
| 132 | BVAR (current_buffer, directory)); | 132 | BVAR (current_buffer, directory)); |
| 133 | 133 | ||
| 134 | /* Remove "/:" from dir. */ | 134 | /* Remove "/:" from DIR and encode it. */ |
| 135 | if (! NILP (Fstring_match (build_string ("^/:"), dir, Qnil))) | 135 | dir = ENCODE_FILE (remove_slash_colon (dir)); |
| 136 | dir = Fsubstring (dir, make_number (2), Qnil); | ||
| 137 | 136 | ||
| 138 | if (STRING_MULTIBYTE (dir)) | ||
| 139 | dir = ENCODE_FILE (dir); | ||
| 140 | if (! file_accessible_directory_p (dir)) | 137 | if (! file_accessible_directory_p (dir)) |
| 141 | report_file_error ("Setting current directory", | 138 | report_file_error ("Setting current directory", |
| 142 | BVAR (current_buffer, directory)); | 139 | BVAR (current_buffer, directory)); |
| @@ -267,7 +264,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * | |||
| 267 | infile = build_string (NULL_DEVICE); | 264 | infile = build_string (NULL_DEVICE); |
| 268 | 265 | ||
| 269 | GCPRO1 (infile); | 266 | GCPRO1 (infile); |
| 270 | encoded_infile = STRING_MULTIBYTE (infile) ? ENCODE_FILE (infile) : infile; | 267 | encoded_infile = ENCODE_FILE (infile); |
| 271 | 268 | ||
| 272 | filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0); | 269 | filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0); |
| 273 | if (filefd < 0) | 270 | if (filefd < 0) |
| @@ -439,9 +436,9 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 439 | 436 | ||
| 440 | GCPRO4 (buffer, current_dir, error_file, output_file); | 437 | GCPRO4 (buffer, current_dir, error_file, output_file); |
| 441 | 438 | ||
| 442 | if (STRINGP (error_file) && STRING_MULTIBYTE (error_file)) | 439 | if (STRINGP (error_file)) |
| 443 | error_file = ENCODE_FILE (error_file); | 440 | error_file = ENCODE_FILE (error_file); |
| 444 | if (STRINGP (output_file) && STRING_MULTIBYTE (output_file)) | 441 | if (STRINGP (output_file)) |
| 445 | output_file = ENCODE_FILE (output_file); | 442 | output_file = ENCODE_FILE (output_file); |
| 446 | UNGCPRO; | 443 | UNGCPRO; |
| 447 | } | 444 | } |
| @@ -468,11 +465,8 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 468 | report_file_error ("Searching for program", args[0]); | 465 | report_file_error ("Searching for program", args[0]); |
| 469 | } | 466 | } |
| 470 | 467 | ||
| 471 | /* If program file name starts with /: for quoting a magic name, | 468 | /* Remove "/:" from PATH. */ |
| 472 | discard that. */ | 469 | path = remove_slash_colon (path); |
| 473 | if (SBYTES (path) > 2 && SREF (path, 0) == '/' | ||
| 474 | && SREF (path, 1) == ':') | ||
| 475 | path = Fsubstring (path, make_number (2), Qnil); | ||
| 476 | 470 | ||
| 477 | SAFE_NALLOCA (new_argv, 1, nargs < 4 ? 2 : nargs - 2); | 471 | SAFE_NALLOCA (new_argv, 1, nargs < 4 ? 2 : nargs - 2); |
| 478 | 472 | ||
| @@ -498,8 +492,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, | |||
| 498 | } | 492 | } |
| 499 | else | 493 | else |
| 500 | new_argv[1] = 0; | 494 | new_argv[1] = 0; |
| 501 | if (STRING_MULTIBYTE (path)) | 495 | path = ENCODE_FILE (path); |
| 502 | path = ENCODE_FILE (path); | ||
| 503 | new_argv[0] = SSDATA (path); | 496 | new_argv[0] = SSDATA (path); |
| 504 | UNGCPRO; | 497 | UNGCPRO; |
| 505 | } | 498 | } |
diff --git a/src/character.c b/src/character.c index 4a5c7ec3156..39d32c9d41a 100644 --- a/src/character.c +++ b/src/character.c | |||
| @@ -232,14 +232,16 @@ DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 2, 0, | |||
| 232 | In Emacs Lisp, characters are represented by character codes, which | 232 | In Emacs Lisp, characters are represented by character codes, which |
| 233 | are non-negative integers. The function `max-char' returns the | 233 | are non-negative integers. The function `max-char' returns the |
| 234 | maximum character code. | 234 | maximum character code. |
| 235 | usage: (characterp OBJECT) */) | 235 | usage: (characterp OBJECT) */ |
| 236 | attributes: const) | ||
| 236 | (Lisp_Object object, Lisp_Object ignore) | 237 | (Lisp_Object object, Lisp_Object ignore) |
| 237 | { | 238 | { |
| 238 | return (CHARACTERP (object) ? Qt : Qnil); | 239 | return (CHARACTERP (object) ? Qt : Qnil); |
| 239 | } | 240 | } |
| 240 | 241 | ||
| 241 | DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0, | 242 | DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0, |
| 242 | doc: /* Return the character of the maximum code. */) | 243 | doc: /* Return the character of the maximum code. */ |
| 244 | attributes: const) | ||
| 243 | (void) | 245 | (void) |
| 244 | { | 246 | { |
| 245 | return make_number (MAX_CHAR); | 247 | return make_number (MAX_CHAR); |
diff --git a/src/coding.c b/src/coding.c index 20c64762160..b11143a32fb 100644 --- a/src/coding.c +++ b/src/coding.c | |||
| @@ -10671,7 +10671,7 @@ Any alias or subsidiary coding system is not a base coding system. */) | |||
| 10671 | 10671 | ||
| 10672 | DEFUN ("coding-system-plist", Fcoding_system_plist, Scoding_system_plist, | 10672 | DEFUN ("coding-system-plist", Fcoding_system_plist, Scoding_system_plist, |
| 10673 | 1, 1, 0, | 10673 | 1, 1, 0, |
| 10674 | doc: "Return the property list of CODING-SYSTEM.") | 10674 | doc: /* Return the property list of CODING-SYSTEM. */) |
| 10675 | (Lisp_Object coding_system) | 10675 | (Lisp_Object coding_system) |
| 10676 | { | 10676 | { |
| 10677 | Lisp_Object spec, attrs; | 10677 | Lisp_Object spec, attrs; |
diff --git a/src/data.c b/src/data.c index 820c3ce8407..0389eb49b06 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -176,7 +176,8 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) | |||
| 176 | /* Data type predicates. */ | 176 | /* Data type predicates. */ |
| 177 | 177 | ||
| 178 | DEFUN ("eq", Feq, Seq, 2, 2, 0, | 178 | DEFUN ("eq", Feq, Seq, 2, 2, 0, |
| 179 | doc: /* Return t if the two args are the same Lisp object. */) | 179 | doc: /* Return t if the two args are the same Lisp object. */ |
| 180 | attributes: const) | ||
| 180 | (Lisp_Object obj1, Lisp_Object obj2) | 181 | (Lisp_Object obj1, Lisp_Object obj2) |
| 181 | { | 182 | { |
| 182 | if (EQ (obj1, obj2)) | 183 | if (EQ (obj1, obj2)) |
| @@ -185,7 +186,8 @@ DEFUN ("eq", Feq, Seq, 2, 2, 0, | |||
| 185 | } | 186 | } |
| 186 | 187 | ||
| 187 | DEFUN ("null", Fnull, Snull, 1, 1, 0, | 188 | DEFUN ("null", Fnull, Snull, 1, 1, 0, |
| 188 | doc: /* Return t if OBJECT is nil. */) | 189 | doc: /* Return t if OBJECT is nil. */ |
| 190 | attributes: const) | ||
| 189 | (Lisp_Object object) | 191 | (Lisp_Object object) |
| 190 | { | 192 | { |
| 191 | if (NILP (object)) | 193 | if (NILP (object)) |
| @@ -263,7 +265,8 @@ for example, (type-of 1) returns `integer'. */) | |||
| 263 | } | 265 | } |
| 264 | 266 | ||
| 265 | DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, | 267 | DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, |
| 266 | doc: /* Return t if OBJECT is a cons cell. */) | 268 | doc: /* Return t if OBJECT is a cons cell. */ |
| 269 | attributes: const) | ||
| 267 | (Lisp_Object object) | 270 | (Lisp_Object object) |
| 268 | { | 271 | { |
| 269 | if (CONSP (object)) | 272 | if (CONSP (object)) |
| @@ -272,7 +275,8 @@ DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, | |||
| 272 | } | 275 | } |
| 273 | 276 | ||
| 274 | DEFUN ("atom", Fatom, Satom, 1, 1, 0, | 277 | DEFUN ("atom", Fatom, Satom, 1, 1, 0, |
| 275 | doc: /* Return t if OBJECT is not a cons cell. This includes nil. */) | 278 | doc: /* Return t if OBJECT is not a cons cell. This includes nil. */ |
| 279 | attributes: const) | ||
| 276 | (Lisp_Object object) | 280 | (Lisp_Object object) |
| 277 | { | 281 | { |
| 278 | if (CONSP (object)) | 282 | if (CONSP (object)) |
| @@ -282,7 +286,8 @@ DEFUN ("atom", Fatom, Satom, 1, 1, 0, | |||
| 282 | 286 | ||
| 283 | DEFUN ("listp", Flistp, Slistp, 1, 1, 0, | 287 | DEFUN ("listp", Flistp, Slistp, 1, 1, 0, |
| 284 | doc: /* Return t if OBJECT is a list, that is, a cons cell or nil. | 288 | doc: /* Return t if OBJECT is a list, that is, a cons cell or nil. |
| 285 | Otherwise, return nil. */) | 289 | Otherwise, return nil. */ |
| 290 | attributes: const) | ||
| 286 | (Lisp_Object object) | 291 | (Lisp_Object object) |
| 287 | { | 292 | { |
| 288 | if (CONSP (object) || NILP (object)) | 293 | if (CONSP (object) || NILP (object)) |
| @@ -291,7 +296,8 @@ Otherwise, return nil. */) | |||
| 291 | } | 296 | } |
| 292 | 297 | ||
| 293 | DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, | 298 | DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, |
| 294 | doc: /* Return t if OBJECT is not a list. Lists include nil. */) | 299 | doc: /* Return t if OBJECT is not a list. Lists include nil. */ |
| 300 | attributes: const) | ||
| 295 | (Lisp_Object object) | 301 | (Lisp_Object object) |
| 296 | { | 302 | { |
| 297 | if (CONSP (object) || NILP (object)) | 303 | if (CONSP (object) || NILP (object)) |
| @@ -300,7 +306,8 @@ DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, | |||
| 300 | } | 306 | } |
| 301 | 307 | ||
| 302 | DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, | 308 | DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, |
| 303 | doc: /* Return t if OBJECT is a symbol. */) | 309 | doc: /* Return t if OBJECT is a symbol. */ |
| 310 | attributes: const) | ||
| 304 | (Lisp_Object object) | 311 | (Lisp_Object object) |
| 305 | { | 312 | { |
| 306 | if (SYMBOLP (object)) | 313 | if (SYMBOLP (object)) |
| @@ -333,7 +340,8 @@ DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, | |||
| 333 | } | 340 | } |
| 334 | 341 | ||
| 335 | DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, | 342 | DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, |
| 336 | doc: /* Return t if OBJECT is a string. */) | 343 | doc: /* Return t if OBJECT is a string. */ |
| 344 | attributes: const) | ||
| 337 | (Lisp_Object object) | 345 | (Lisp_Object object) |
| 338 | { | 346 | { |
| 339 | if (STRINGP (object)) | 347 | if (STRINGP (object)) |
| @@ -436,7 +444,8 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, | |||
| 436 | } | 444 | } |
| 437 | 445 | ||
| 438 | DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, | 446 | DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, |
| 439 | doc: /* Return t if OBJECT is a character or a string. */) | 447 | doc: /* Return t if OBJECT is a character or a string. */ |
| 448 | attributes: const) | ||
| 440 | (register Lisp_Object object) | 449 | (register Lisp_Object object) |
| 441 | { | 450 | { |
| 442 | if (CHARACTERP (object) || STRINGP (object)) | 451 | if (CHARACTERP (object) || STRINGP (object)) |
| @@ -445,7 +454,8 @@ DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, | |||
| 445 | } | 454 | } |
| 446 | 455 | ||
| 447 | DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, | 456 | DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, |
| 448 | doc: /* Return t if OBJECT is an integer. */) | 457 | doc: /* Return t if OBJECT is an integer. */ |
| 458 | attributes: const) | ||
| 449 | (Lisp_Object object) | 459 | (Lisp_Object object) |
| 450 | { | 460 | { |
| 451 | if (INTEGERP (object)) | 461 | if (INTEGERP (object)) |
| @@ -463,7 +473,8 @@ DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, | |||
| 463 | } | 473 | } |
| 464 | 474 | ||
| 465 | DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, | 475 | DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, |
| 466 | doc: /* Return t if OBJECT is a nonnegative integer. */) | 476 | doc: /* Return t if OBJECT is a nonnegative integer. */ |
| 477 | attributes: const) | ||
| 467 | (Lisp_Object object) | 478 | (Lisp_Object object) |
| 468 | { | 479 | { |
| 469 | if (NATNUMP (object)) | 480 | if (NATNUMP (object)) |
| @@ -472,7 +483,8 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, | |||
| 472 | } | 483 | } |
| 473 | 484 | ||
| 474 | DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, | 485 | DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0, |
| 475 | doc: /* Return t if OBJECT is a number (floating point or integer). */) | 486 | doc: /* Return t if OBJECT is a number (floating point or integer). */ |
| 487 | attributes: const) | ||
| 476 | (Lisp_Object object) | 488 | (Lisp_Object object) |
| 477 | { | 489 | { |
| 478 | if (NUMBERP (object)) | 490 | if (NUMBERP (object)) |
| @@ -492,7 +504,8 @@ DEFUN ("number-or-marker-p", Fnumber_or_marker_p, | |||
| 492 | } | 504 | } |
| 493 | 505 | ||
| 494 | DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, | 506 | DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, |
| 495 | doc: /* Return t if OBJECT is a floating point number. */) | 507 | doc: /* Return t if OBJECT is a floating point number. */ |
| 508 | attributes: const) | ||
| 496 | (Lisp_Object object) | 509 | (Lisp_Object object) |
| 497 | { | 510 | { |
| 498 | if (FLOATP (object)) | 511 | if (FLOATP (object)) |
| @@ -2954,7 +2967,8 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0, | |||
| 2954 | DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0, | 2967 | DEFUN ("byteorder", Fbyteorder, Sbyteorder, 0, 0, 0, |
| 2955 | doc: /* Return the byteorder for the machine. | 2968 | doc: /* Return the byteorder for the machine. |
| 2956 | Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII | 2969 | Returns 66 (ASCII uppercase B) for big endian machines or 108 (ASCII |
| 2957 | lowercase l) for small endian machines. */) | 2970 | lowercase l) for small endian machines. */ |
| 2971 | attributes: const) | ||
| 2958 | (void) | 2972 | (void) |
| 2959 | { | 2973 | { |
| 2960 | unsigned i = 0x04030201; | 2974 | unsigned i = 0x04030201; |
diff --git a/src/decompress.c b/src/decompress.c index b14f0a2cd79..b78dacee207 100644 --- a/src/decompress.c +++ b/src/decompress.c | |||
| @@ -88,7 +88,8 @@ unwind_decompress (void *ddata) | |||
| 88 | } | 88 | } |
| 89 | 89 | ||
| 90 | DEFUN ("zlib-available-p", Fzlib_available_p, Szlib_available_p, 0, 0, 0, | 90 | DEFUN ("zlib-available-p", Fzlib_available_p, Szlib_available_p, 0, 0, 0, |
| 91 | doc: /* Return t if zlib decompression is available in this instance of Emacs. */) | 91 | doc: /* Return t if zlib decompression is available in this instance of Emacs. */ |
| 92 | attributes: const) | ||
| 92 | (void) | 93 | (void) |
| 93 | { | 94 | { |
| 94 | #ifdef WINDOWSNT | 95 | #ifdef WINDOWSNT |
diff --git a/src/dired.c b/src/dired.c index 00f9a5b0765..ca43cd90219 100644 --- a/src/dired.c +++ b/src/dired.c | |||
| @@ -176,10 +176,8 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, | |||
| 176 | /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run | 176 | /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run |
| 177 | run_pre_post_conversion_on_str which calls Lisp directly and | 177 | run_pre_post_conversion_on_str which calls Lisp directly and |
| 178 | indirectly. */ | 178 | indirectly. */ |
| 179 | if (STRING_MULTIBYTE (dirfilename)) | 179 | dirfilename = ENCODE_FILE (dirfilename); |
| 180 | dirfilename = ENCODE_FILE (dirfilename); | 180 | encoded_directory = ENCODE_FILE (directory); |
| 181 | encoded_directory = (STRING_MULTIBYTE (directory) | ||
| 182 | ? ENCODE_FILE (directory) : directory); | ||
| 183 | 181 | ||
| 184 | /* Now *bufp is the compiled form of MATCH; don't call anything | 182 | /* Now *bufp is the compiled form of MATCH; don't call anything |
| 185 | which might compile a new regexp until we're done with the loop! */ | 183 | which might compile a new regexp until we're done with the loop! */ |
| @@ -482,7 +480,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, | |||
| 482 | /* Actually, this is not quite true any more: we do most of the completion | 480 | /* Actually, this is not quite true any more: we do most of the completion |
| 483 | work with decoded file names, but we still do some filtering based | 481 | work with decoded file names, but we still do some filtering based |
| 484 | on the encoded file name. */ | 482 | on the encoded file name. */ |
| 485 | encoded_file = STRING_MULTIBYTE (file) ? ENCODE_FILE (file) : file; | 483 | encoded_file = ENCODE_FILE (file); |
| 486 | 484 | ||
| 487 | encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname)); | 485 | encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname)); |
| 488 | 486 | ||
| @@ -634,23 +632,14 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, | |||
| 634 | name = DECODE_FILE (name); | 632 | name = DECODE_FILE (name); |
| 635 | 633 | ||
| 636 | { | 634 | { |
| 637 | Lisp_Object regexps; | 635 | Lisp_Object regexps, table = (completion_ignore_case |
| 636 | ? Vascii_canon_table : Qnil); | ||
| 638 | 637 | ||
| 639 | /* Ignore this element if it fails to match all the regexps. */ | 638 | /* Ignore this element if it fails to match all the regexps. */ |
| 640 | if (completion_ignore_case) | 639 | for (regexps = Vcompletion_regexp_list; CONSP (regexps); |
| 641 | { | 640 | regexps = XCDR (regexps)) |
| 642 | for (regexps = Vcompletion_regexp_list; CONSP (regexps); | 641 | if (fast_string_match_internal (XCAR (regexps), name, table) < 0) |
| 643 | regexps = XCDR (regexps)) | 642 | break; |
| 644 | if (fast_string_match_ignore_case (XCAR (regexps), name) < 0) | ||
| 645 | break; | ||
| 646 | } | ||
| 647 | else | ||
| 648 | { | ||
| 649 | for (regexps = Vcompletion_regexp_list; CONSP (regexps); | ||
| 650 | regexps = XCDR (regexps)) | ||
| 651 | if (fast_string_match (XCAR (regexps), name) < 0) | ||
| 652 | break; | ||
| 653 | } | ||
| 654 | 643 | ||
| 655 | if (CONSP (regexps)) | 644 | if (CONSP (regexps)) |
| 656 | continue; | 645 | continue; |
diff --git a/src/dispnew.c b/src/dispnew.c index bb75973edb8..bfa06bd2878 100644 --- a/src/dispnew.c +++ b/src/dispnew.c | |||
| @@ -5536,7 +5536,8 @@ change_frame_size_1 (struct frame *f, int new_width, int new_height, | |||
| 5536 | 5536 | ||
| 5537 | /* Adjust frame size but make sure x_set_window_size does not | 5537 | /* Adjust frame size but make sure x_set_window_size does not |
| 5538 | get called. */ | 5538 | get called. */ |
| 5539 | adjust_frame_size (f, new_width, new_height, 5, pretend, Qnil); | 5539 | adjust_frame_size (f, new_width, new_height, 5, pretend, |
| 5540 | Qchange_frame_size); | ||
| 5540 | } | 5541 | } |
| 5541 | } | 5542 | } |
| 5542 | 5543 | ||
diff --git a/src/editfns.c b/src/editfns.c index cd15f6569aa..621e841c3f5 100644 --- a/src/editfns.c +++ b/src/editfns.c | |||
| @@ -2063,6 +2063,29 @@ check_tm_member (Lisp_Object obj, int offset) | |||
| 2063 | return n - offset; | 2063 | return n - offset; |
| 2064 | } | 2064 | } |
| 2065 | 2065 | ||
| 2066 | /* Decode ZONE as a time zone specification. */ | ||
| 2067 | |||
| 2068 | static Lisp_Object | ||
| 2069 | decode_time_zone (Lisp_Object zone) | ||
| 2070 | { | ||
| 2071 | if (EQ (zone, Qt)) | ||
| 2072 | return build_string ("UTC0"); | ||
| 2073 | else if (STRINGP (zone)) | ||
| 2074 | return zone; | ||
| 2075 | else if (INTEGERP (zone)) | ||
| 2076 | { | ||
| 2077 | static char const tzbuf_format[] = "XXX%s%"pI"d:%02d:%02d"; | ||
| 2078 | char tzbuf[sizeof tzbuf_format + INT_STRLEN_BOUND (EMACS_INT)]; | ||
| 2079 | EMACS_INT abszone = eabs (XINT (zone)), zone_hr = abszone / (60 * 60); | ||
| 2080 | int zone_min = (abszone / 60) % 60, zone_sec = abszone % 60; | ||
| 2081 | |||
| 2082 | return make_formatted_string (tzbuf, tzbuf_format, &"-"[XINT (zone) < 0], | ||
| 2083 | zone_hr, zone_min, zone_sec); | ||
| 2084 | } | ||
| 2085 | else | ||
| 2086 | xsignal2 (Qerror, build_string ("Invalid time zone specification"), zone); | ||
| 2087 | } | ||
| 2088 | |||
| 2066 | DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, | 2089 | DEFUN ("encode-time", Fencode_time, Sencode_time, 6, MANY, 0, |
| 2067 | doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. | 2090 | doc: /* Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. |
| 2068 | This is the reverse operation of `decode-time', which see. | 2091 | This is the reverse operation of `decode-time', which see. |
| @@ -2105,30 +2128,7 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) | |||
| 2105 | value = mktime (&tm); | 2128 | value = mktime (&tm); |
| 2106 | else | 2129 | else |
| 2107 | { | 2130 | { |
| 2108 | static char const tzbuf_format[] = "XXX%s%"pI"d:%02d:%02d"; | 2131 | timezone_t tz = tzalloc (SSDATA (decode_time_zone (zone))); |
| 2109 | char tzbuf[sizeof tzbuf_format + INT_STRLEN_BOUND (EMACS_INT)]; | ||
| 2110 | const char *tzstring; | ||
| 2111 | |||
| 2112 | if (EQ (zone, Qt)) | ||
| 2113 | tzstring = "UTC0"; | ||
| 2114 | else if (STRINGP (zone)) | ||
| 2115 | tzstring = SSDATA (zone); | ||
| 2116 | else if (INTEGERP (zone)) | ||
| 2117 | { | ||
| 2118 | EMACS_INT abszone = eabs (XINT (zone)); | ||
| 2119 | EMACS_INT zone_hr = abszone / (60*60); | ||
| 2120 | int zone_min = (abszone/60) % 60; | ||
| 2121 | int zone_sec = abszone % 60; | ||
| 2122 | sprintf (tzbuf, tzbuf_format, &"-"[XINT (zone) < 0], | ||
| 2123 | zone_hr, zone_min, zone_sec); | ||
| 2124 | tzstring = tzbuf; | ||
| 2125 | } | ||
| 2126 | else | ||
| 2127 | tzstring = 0; | ||
| 2128 | |||
| 2129 | timezone_t tz = tzstring ? tzalloc (tzstring) : 0; | ||
| 2130 | if (! tz) | ||
| 2131 | error ("Invalid time zone specification"); | ||
| 2132 | value = mktime_z (tz, &tm); | 2132 | value = mktime_z (tz, &tm); |
| 2133 | tzfree (tz); | 2133 | tzfree (tz); |
| 2134 | } | 2134 | } |
| @@ -2265,7 +2265,8 @@ the data it can't find. */) | |||
| 2265 | DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, | 2265 | DEFUN ("set-time-zone-rule", Fset_time_zone_rule, Sset_time_zone_rule, 1, 1, 0, |
| 2266 | doc: /* Set the local time zone using TZ, a string specifying a time zone rule. | 2266 | doc: /* Set the local time zone using TZ, a string specifying a time zone rule. |
| 2267 | If TZ is nil, use implementation-defined default time zone information. | 2267 | If TZ is nil, use implementation-defined default time zone information. |
| 2268 | If TZ is t, use Universal Time. | 2268 | If TZ is t, use Universal Time. If TZ is an integer, it is treated as in |
| 2269 | `encode-time'. | ||
| 2269 | 2270 | ||
| 2270 | Instead of calling this function, you typically want (setenv "TZ" TZ). | 2271 | Instead of calling this function, you typically want (setenv "TZ" TZ). |
| 2271 | That changes both the environment of the Emacs process and the | 2272 | That changes both the environment of the Emacs process and the |
| @@ -2273,17 +2274,7 @@ variable `process-environment', whereas `set-time-zone-rule' affects | |||
| 2273 | only the former. */) | 2274 | only the former. */) |
| 2274 | (Lisp_Object tz) | 2275 | (Lisp_Object tz) |
| 2275 | { | 2276 | { |
| 2276 | const char *tzstring; | 2277 | const char *tzstring = NILP (tz) ? initial_tz : SSDATA (decode_time_zone (tz)); |
| 2277 | |||
| 2278 | if (! (NILP (tz) || EQ (tz, Qt))) | ||
| 2279 | CHECK_STRING (tz); | ||
| 2280 | |||
| 2281 | if (NILP (tz)) | ||
| 2282 | tzstring = initial_tz; | ||
| 2283 | else if (EQ (tz, Qt)) | ||
| 2284 | tzstring = "UTC0"; | ||
| 2285 | else | ||
| 2286 | tzstring = SSDATA (tz); | ||
| 2287 | 2278 | ||
| 2288 | block_input (); | 2279 | block_input (); |
| 2289 | set_time_zone_rule (tzstring); | 2280 | set_time_zone_rule (tzstring); |
| @@ -2633,15 +2624,34 @@ make_buffer_string_both (ptrdiff_t start, ptrdiff_t start_byte, | |||
| 2633 | ptrdiff_t end, ptrdiff_t end_byte, bool props) | 2624 | ptrdiff_t end, ptrdiff_t end_byte, bool props) |
| 2634 | { | 2625 | { |
| 2635 | Lisp_Object result, tem, tem1; | 2626 | Lisp_Object result, tem, tem1; |
| 2627 | ptrdiff_t beg0, end0, beg1, end1, size; | ||
| 2636 | 2628 | ||
| 2637 | if (start < GPT && GPT < end) | 2629 | if (start_byte < GPT_BYTE && GPT_BYTE < end_byte) |
| 2638 | move_gap_both (start, start_byte); | 2630 | { |
| 2631 | /* Two regions, before and after the gap. */ | ||
| 2632 | beg0 = start_byte; | ||
| 2633 | end0 = GPT_BYTE; | ||
| 2634 | beg1 = GPT_BYTE + GAP_SIZE - BEG_BYTE; | ||
| 2635 | end1 = end_byte + GAP_SIZE - BEG_BYTE; | ||
| 2636 | } | ||
| 2637 | else | ||
| 2638 | { | ||
| 2639 | /* The only region. */ | ||
| 2640 | beg0 = start_byte; | ||
| 2641 | end0 = end_byte; | ||
| 2642 | beg1 = -1; | ||
| 2643 | end1 = -1; | ||
| 2644 | } | ||
| 2639 | 2645 | ||
| 2640 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) | 2646 | if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) |
| 2641 | result = make_uninit_multibyte_string (end - start, end_byte - start_byte); | 2647 | result = make_uninit_multibyte_string (end - start, end_byte - start_byte); |
| 2642 | else | 2648 | else |
| 2643 | result = make_uninit_string (end - start); | 2649 | result = make_uninit_string (end - start); |
| 2644 | memcpy (SDATA (result), BYTE_POS_ADDR (start_byte), end_byte - start_byte); | 2650 | |
| 2651 | size = end0 - beg0; | ||
| 2652 | memcpy (SDATA (result), BYTE_POS_ADDR (beg0), size); | ||
| 2653 | if (beg1 != -1) | ||
| 2654 | memcpy (SDATA (result) + size, BEG_ADDR + beg1, end1 - beg1); | ||
| 2645 | 2655 | ||
| 2646 | /* If desired, update and copy the text properties. */ | 2656 | /* If desired, update and copy the text properties. */ |
| 2647 | if (props) | 2657 | if (props) |
diff --git a/src/emacs.c b/src/emacs.c index e7094b11580..d83311ac5b6 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -1898,7 +1898,8 @@ or SIGHUP, and upon SIGINT in batch mode. | |||
| 1898 | 1898 | ||
| 1899 | The value of `kill-emacs-hook', if not void, | 1899 | The value of `kill-emacs-hook', if not void, |
| 1900 | is a list of functions (of no args), | 1900 | is a list of functions (of no args), |
| 1901 | all of which are called before Emacs is actually killed. */) | 1901 | all of which are called before Emacs is actually killed. */ |
| 1902 | attributes: noreturn) | ||
| 1902 | (Lisp_Object arg) | 1903 | (Lisp_Object arg) |
| 1903 | { | 1904 | { |
| 1904 | struct gcpro gcpro1; | 1905 | struct gcpro gcpro1; |
diff --git a/src/eval.c b/src/eval.c index 7e4b016b236..5cadb1bc2de 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -1162,7 +1162,8 @@ unwind_to_catch (struct handler *catch, Lisp_Object value) | |||
| 1162 | 1162 | ||
| 1163 | DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0, | 1163 | DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0, |
| 1164 | doc: /* Throw to the catch for TAG and return VALUE from it. | 1164 | doc: /* Throw to the catch for TAG and return VALUE from it. |
| 1165 | Both TAG and VALUE are evalled. */) | 1165 | Both TAG and VALUE are evalled. */ |
| 1166 | attributes: noreturn) | ||
| 1166 | (register Lisp_Object tag, Lisp_Object value) | 1167 | (register Lisp_Object tag, Lisp_Object value) |
| 1167 | { | 1168 | { |
| 1168 | struct handler *c; | 1169 | struct handler *c; |
diff --git a/src/fileio.c b/src/fileio.c index 15c6f9123a2..6c443c91db7 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -522,8 +522,6 @@ For a Unix-syntax file name, just appends a slash. */) | |||
| 522 | USE_SAFE_ALLOCA; | 522 | USE_SAFE_ALLOCA; |
| 523 | 523 | ||
| 524 | CHECK_STRING (file); | 524 | CHECK_STRING (file); |
| 525 | if (NILP (file)) | ||
| 526 | return Qnil; | ||
| 527 | 525 | ||
| 528 | /* If the file name has special constructs in it, | 526 | /* If the file name has special constructs in it, |
| 529 | call the corresponding file handler. */ | 527 | call the corresponding file handler. */ |
| @@ -591,9 +589,6 @@ In Unix-syntax, this function just removes the final slash. */) | |||
| 591 | 589 | ||
| 592 | CHECK_STRING (directory); | 590 | CHECK_STRING (directory); |
| 593 | 591 | ||
| 594 | if (NILP (directory)) | ||
| 595 | return Qnil; | ||
| 596 | |||
| 597 | /* If the file name has special constructs in it, | 592 | /* If the file name has special constructs in it, |
| 598 | call the corresponding file handler. */ | 593 | call the corresponding file handler. */ |
| 599 | handler = Ffind_file_name_handler (directory, Qdirectory_file_name); | 594 | handler = Ffind_file_name_handler (directory, Qdirectory_file_name); |
| @@ -5738,8 +5733,8 @@ then any auto-save counts as "recent". */) | |||
| 5738 | they're never autosaved. */ | 5733 | they're never autosaved. */ |
| 5739 | return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil); | 5734 | return (SAVE_MODIFF < BUF_AUTOSAVE_MODIFF (current_buffer) ? Qt : Qnil); |
| 5740 | } | 5735 | } |
| 5741 | 5736 | ||
| 5742 | /* Reading and completing file names */ | 5737 | /* Reading and completing file names. */ |
| 5743 | 5738 | ||
| 5744 | DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p, | 5739 | DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p, |
| 5745 | Snext_read_file_uses_dialog_p, 0, 0, 0, | 5740 | Snext_read_file_uses_dialog_p, 0, 0, 0, |
| @@ -5748,8 +5743,8 @@ The return value is only relevant for a call to `read-file-name' that happens | |||
| 5748 | before any other event (mouse or keypress) is handled. */) | 5743 | before any other event (mouse or keypress) is handled. */) |
| 5749 | (void) | 5744 | (void) |
| 5750 | { | 5745 | { |
| 5751 | #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) \ | 5746 | #if (defined USE_GTK || defined USE_MOTIF \ |
| 5752 | || defined (HAVE_NS) | 5747 | || defined HAVE_NS || defined HAVE_NTGUI) |
| 5753 | if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) | 5748 | if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) |
| 5754 | && use_dialog_box | 5749 | && use_dialog_box |
| 5755 | && use_file_dialog | 5750 | && use_file_dialog |
| @@ -46,7 +46,8 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t, | |||
| 46 | static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object); | 46 | static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object); |
| 47 | 47 | ||
| 48 | DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, | 48 | DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, |
| 49 | doc: /* Return the argument unchanged. */) | 49 | doc: /* Return the argument unchanged. */ |
| 50 | attributes: const) | ||
| 50 | (Lisp_Object arg) | 51 | (Lisp_Object arg) |
| 51 | { | 52 | { |
| 52 | return arg; | 53 | return arg; |
diff --git a/src/frame.c b/src/frame.c index 3d2ffbf624f..ec580f37c5b 100644 --- a/src/frame.c +++ b/src/frame.c | |||
| @@ -67,6 +67,9 @@ static struct frame *last_nonminibuf_frame; | |||
| 67 | /* False means there are no visible garbaged frames. */ | 67 | /* False means there are no visible garbaged frames. */ |
| 68 | bool frame_garbaged; | 68 | bool frame_garbaged; |
| 69 | 69 | ||
| 70 | /* The default tool bar height for future frames. */ | ||
| 71 | int frame_default_tool_bar_height; | ||
| 72 | |||
| 70 | #ifdef HAVE_WINDOW_SYSTEM | 73 | #ifdef HAVE_WINDOW_SYSTEM |
| 71 | static void x_report_frame_params (struct frame *, Lisp_Object *); | 74 | static void x_report_frame_params (struct frame *, Lisp_Object *); |
| 72 | #endif | 75 | #endif |
| @@ -267,7 +270,8 @@ predicates which report frame's specific UI-related capabilities. */) | |||
| 267 | /* Placeholder used by temacs -nw before window.el is loaded. */ | 270 | /* Placeholder used by temacs -nw before window.el is loaded. */ |
| 268 | DEFUN ("frame-windows-min-size", Fframe_windows_min_size, | 271 | DEFUN ("frame-windows-min-size", Fframe_windows_min_size, |
| 269 | Sframe_windows_min_size, 4, 4, 0, | 272 | Sframe_windows_min_size, 4, 4, 0, |
| 270 | doc: /* */) | 273 | doc: /* */ |
| 274 | attributes: const) | ||
| 271 | (Lisp_Object frame, Lisp_Object horizontal, | 275 | (Lisp_Object frame, Lisp_Object horizontal, |
| 272 | Lisp_Object ignore, Lisp_Object pixelwise) | 276 | Lisp_Object ignore, Lisp_Object pixelwise) |
| 273 | { | 277 | { |
| @@ -331,6 +335,8 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, | |||
| 331 | int unit_height = FRAME_LINE_HEIGHT (f); | 335 | int unit_height = FRAME_LINE_HEIGHT (f); |
| 332 | int old_pixel_width = FRAME_PIXEL_WIDTH (f); | 336 | int old_pixel_width = FRAME_PIXEL_WIDTH (f); |
| 333 | int old_pixel_height = FRAME_PIXEL_HEIGHT (f); | 337 | int old_pixel_height = FRAME_PIXEL_HEIGHT (f); |
| 338 | int old_cols = FRAME_COLS (f); | ||
| 339 | int old_lines = FRAME_LINES (f); | ||
| 334 | int new_pixel_width, new_pixel_height; | 340 | int new_pixel_width, new_pixel_height; |
| 335 | /* The following two values are calculated from the old frame pixel | 341 | /* The following two values are calculated from the old frame pixel |
| 336 | sizes and any "new" settings for tool bar, menu bar and internal | 342 | sizes and any "new" settings for tool bar, menu bar and internal |
| @@ -358,6 +364,20 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, | |||
| 358 | Lisp_Object frame; | 364 | Lisp_Object frame; |
| 359 | 365 | ||
| 360 | XSETFRAME (frame, f); | 366 | XSETFRAME (frame, f); |
| 367 | |||
| 368 | /* `make-frame' initializes Vframe_adjust_size_history to (Qt) and | ||
| 369 | strips its car when exiting. Just in case make sure its size never | ||
| 370 | exceeds 100. */ | ||
| 371 | if (!NILP (Fconsp (Vframe_adjust_size_history)) | ||
| 372 | && EQ (Fcar (Vframe_adjust_size_history), Qt) | ||
| 373 | && XFASTINT (Fsafe_length (Vframe_adjust_size_history)) <= 100) | ||
| 374 | Vframe_adjust_size_history = | ||
| 375 | Fcons (Qt, Fcons (list5 (make_number (0), | ||
| 376 | make_number (new_text_width), | ||
| 377 | make_number (new_text_height), | ||
| 378 | make_number (inhibit), parameter), | ||
| 379 | Fcdr (Vframe_adjust_size_history))); | ||
| 380 | |||
| 361 | /* The following two values are calculated from the old window body | 381 | /* The following two values are calculated from the old window body |
| 362 | sizes and any "new" settings for scroll bars, dividers, fringes and | 382 | sizes and any "new" settings for scroll bars, dividers, fringes and |
| 363 | margins (though the latter should have been processed already). */ | 383 | margins (though the latter should have been processed already). */ |
| @@ -425,6 +445,17 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, | |||
| 425 | else if (inhibit_vertical) | 445 | else if (inhibit_vertical) |
| 426 | new_text_height = old_text_height; | 446 | new_text_height = old_text_height; |
| 427 | 447 | ||
| 448 | if (!NILP (Fconsp (Vframe_adjust_size_history)) | ||
| 449 | && EQ (Fcar (Vframe_adjust_size_history), Qt) | ||
| 450 | && XFASTINT (Fsafe_length (Vframe_adjust_size_history)) <= 100) | ||
| 451 | Vframe_adjust_size_history = | ||
| 452 | Fcons (Qt, Fcons (list5 (make_number (1), | ||
| 453 | make_number (new_text_width), | ||
| 454 | make_number (new_text_height), | ||
| 455 | make_number (new_cols), | ||
| 456 | make_number (new_lines)), | ||
| 457 | Fcdr (Vframe_adjust_size_history))); | ||
| 458 | |||
| 428 | x_set_window_size (f, 0, new_text_width, new_text_height, 1); | 459 | x_set_window_size (f, 0, new_text_width, new_text_height, 1); |
| 429 | f->resized_p = true; | 460 | f->resized_p = true; |
| 430 | 461 | ||
| @@ -437,7 +468,9 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, | |||
| 437 | && new_windows_width == old_windows_width | 468 | && new_windows_width == old_windows_width |
| 438 | && new_windows_height == old_windows_height | 469 | && new_windows_height == old_windows_height |
| 439 | && new_pixel_width == old_pixel_width | 470 | && new_pixel_width == old_pixel_width |
| 440 | && new_pixel_height == old_pixel_height) | 471 | && new_pixel_height == old_pixel_height |
| 472 | && new_cols == old_cols | ||
| 473 | && new_lines == old_lines) | ||
| 441 | /* No change. Sanitize window sizes and return. */ | 474 | /* No change. Sanitize window sizes and return. */ |
| 442 | { | 475 | { |
| 443 | sanitize_window_sizes (frame, Qt); | 476 | sanitize_window_sizes (frame, Qt); |
| @@ -496,6 +529,17 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, | |||
| 496 | SET_FRAME_COLS (f, new_cols); | 529 | SET_FRAME_COLS (f, new_cols); |
| 497 | SET_FRAME_LINES (f, new_lines); | 530 | SET_FRAME_LINES (f, new_lines); |
| 498 | 531 | ||
| 532 | if (!NILP (Fconsp (Vframe_adjust_size_history)) | ||
| 533 | && EQ (Fcar (Vframe_adjust_size_history), Qt) | ||
| 534 | && XFASTINT (Fsafe_length (Vframe_adjust_size_history)) <= 100) | ||
| 535 | Vframe_adjust_size_history = | ||
| 536 | Fcons (Qt, Fcons (list5 (make_number (2), | ||
| 537 | make_number (new_text_width), | ||
| 538 | make_number (new_text_height), | ||
| 539 | make_number (new_cols), | ||
| 540 | make_number (new_lines)), | ||
| 541 | Fcdr (Vframe_adjust_size_history))); | ||
| 542 | |||
| 499 | { | 543 | { |
| 500 | struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f)); | 544 | struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f)); |
| 501 | int text_area_x, text_area_y, text_area_width, text_area_height; | 545 | int text_area_x, text_area_y, text_area_width, text_area_height; |
| @@ -554,6 +598,7 @@ make_frame (bool mini_p) | |||
| 554 | f->garbaged = true; | 598 | f->garbaged = true; |
| 555 | f->can_x_set_window_size = false; | 599 | f->can_x_set_window_size = false; |
| 556 | f->can_run_window_configuration_change_hook = false; | 600 | f->can_run_window_configuration_change_hook = false; |
| 601 | f->tool_bar_redisplayed_once = false; | ||
| 557 | f->column_width = 1; /* !FRAME_WINDOW_P value. */ | 602 | f->column_width = 1; /* !FRAME_WINDOW_P value. */ |
| 558 | f->line_height = 1; /* !FRAME_WINDOW_P value. */ | 603 | f->line_height = 1; /* !FRAME_WINDOW_P value. */ |
| 559 | #ifdef HAVE_WINDOW_SYSTEM | 604 | #ifdef HAVE_WINDOW_SYSTEM |
| @@ -2808,7 +2853,7 @@ DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_widt | |||
| 2808 | } | 2853 | } |
| 2809 | 2854 | ||
| 2810 | DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, 0, | 2855 | DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, 0, |
| 2811 | doc: /* Set height of frame FRAME to HEIGHT lines. | 2856 | doc: /* Set text height of frame FRAME to HEIGHT lines. |
| 2812 | Optional third arg PRETEND non-nil means that redisplay should use | 2857 | Optional third arg PRETEND non-nil means that redisplay should use |
| 2813 | HEIGHT lines but that the idea of the actual height of the frame should | 2858 | HEIGHT lines but that the idea of the actual height of the frame should |
| 2814 | not be changed. | 2859 | not be changed. |
| @@ -2827,14 +2872,13 @@ multiple of the default frame font height. */) | |||
| 2827 | pixel_height = (!NILP (pixelwise) | 2872 | pixel_height = (!NILP (pixelwise) |
| 2828 | ? XINT (height) | 2873 | ? XINT (height) |
| 2829 | : XINT (height) * FRAME_LINE_HEIGHT (f)); | 2874 | : XINT (height) * FRAME_LINE_HEIGHT (f)); |
| 2830 | if (pixel_height != FRAME_TEXT_HEIGHT (f)) | 2875 | adjust_frame_size (f, -1, pixel_height, 1, !NILP (pretend), Qheight); |
| 2831 | adjust_frame_size (f, -1, pixel_height, 1, !NILP (pretend), Qheight); | ||
| 2832 | 2876 | ||
| 2833 | return Qnil; | 2877 | return Qnil; |
| 2834 | } | 2878 | } |
| 2835 | 2879 | ||
| 2836 | DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4, 0, | 2880 | DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4, 0, |
| 2837 | doc: /* Set width of frame FRAME to WIDTH columns. | 2881 | doc: /* Set text width of frame FRAME to WIDTH columns. |
| 2838 | Optional third arg PRETEND non-nil means that redisplay should use WIDTH | 2882 | Optional third arg PRETEND non-nil means that redisplay should use WIDTH |
| 2839 | columns but that the idea of the actual width of the frame should not | 2883 | columns but that the idea of the actual width of the frame should not |
| 2840 | be changed. | 2884 | be changed. |
| @@ -2853,14 +2897,13 @@ multiple of the default frame font width. */) | |||
| 2853 | pixel_width = (!NILP (pixelwise) | 2897 | pixel_width = (!NILP (pixelwise) |
| 2854 | ? XINT (width) | 2898 | ? XINT (width) |
| 2855 | : XINT (width) * FRAME_COLUMN_WIDTH (f)); | 2899 | : XINT (width) * FRAME_COLUMN_WIDTH (f)); |
| 2856 | if (pixel_width != FRAME_TEXT_WIDTH (f)) | 2900 | adjust_frame_size (f, pixel_width, -1, 1, !NILP (pretend), Qwidth); |
| 2857 | adjust_frame_size (f, pixel_width, -1, 1, !NILP (pretend), Qwidth); | ||
| 2858 | 2901 | ||
| 2859 | return Qnil; | 2902 | return Qnil; |
| 2860 | } | 2903 | } |
| 2861 | 2904 | ||
| 2862 | DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 4, 0, | 2905 | DEFUN ("set-frame-size", Fset_frame_size, Sset_frame_size, 3, 4, 0, |
| 2863 | doc: /* Set size of FRAME to WIDTH by HEIGHT, measured in characters. | 2906 | doc: /* Set text size of FRAME to WIDTH by HEIGHT, measured in characters. |
| 2864 | Optional argument PIXELWISE non-nil means to measure in pixels. Note: | 2907 | Optional argument PIXELWISE non-nil means to measure in pixels. Note: |
| 2865 | When `frame-resize-pixelwise' is nil, some window managers may refuse to | 2908 | When `frame-resize-pixelwise' is nil, some window managers may refuse to |
| 2866 | honor a WIDTH that is not an integer multiple of the default frame font | 2909 | honor a WIDTH that is not an integer multiple of the default frame font |
| @@ -2880,10 +2923,7 @@ font height. */) | |||
| 2880 | pixel_height = (!NILP (pixelwise) | 2923 | pixel_height = (!NILP (pixelwise) |
| 2881 | ? XINT (height) | 2924 | ? XINT (height) |
| 2882 | : XINT (height) * FRAME_LINE_HEIGHT (f)); | 2925 | : XINT (height) * FRAME_LINE_HEIGHT (f)); |
| 2883 | 2926 | adjust_frame_size (f, pixel_width, pixel_height, 1, 0, Qsize); | |
| 2884 | if (pixel_width != FRAME_TEXT_WIDTH (f) | ||
| 2885 | || pixel_height != FRAME_TEXT_HEIGHT (f)) | ||
| 2886 | adjust_frame_size (f, pixel_width, pixel_height, 1, 0, Qsize); | ||
| 2887 | 2927 | ||
| 2888 | return Qnil; | 2928 | return Qnil; |
| 2889 | } | 2929 | } |
| @@ -4492,23 +4532,27 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p) | |||
| 4492 | frames without having to guess how tall the tool bar will get. */ | 4532 | frames without having to guess how tall the tool bar will get. */ |
| 4493 | if (toolbar_p && FRAME_TOOL_BAR_LINES (f)) | 4533 | if (toolbar_p && FRAME_TOOL_BAR_LINES (f)) |
| 4494 | { | 4534 | { |
| 4495 | int margin, relief; | 4535 | if (frame_default_tool_bar_height) |
| 4536 | FRAME_TOOL_BAR_HEIGHT (f) = frame_default_tool_bar_height; | ||
| 4537 | else | ||
| 4538 | { | ||
| 4539 | int margin, relief; | ||
| 4496 | 4540 | ||
| 4497 | relief = (tool_bar_button_relief >= 0 | 4541 | relief = (tool_bar_button_relief >= 0 |
| 4498 | ? tool_bar_button_relief | 4542 | ? tool_bar_button_relief |
| 4499 | : DEFAULT_TOOL_BAR_BUTTON_RELIEF); | 4543 | : DEFAULT_TOOL_BAR_BUTTON_RELIEF); |
| 4500 | 4544 | ||
| 4501 | if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX)) | 4545 | if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX)) |
| 4502 | margin = XFASTINT (Vtool_bar_button_margin); | 4546 | margin = XFASTINT (Vtool_bar_button_margin); |
| 4503 | else if (CONSP (Vtool_bar_button_margin) | 4547 | else if (CONSP (Vtool_bar_button_margin) |
| 4504 | && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX)) | 4548 | && RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX)) |
| 4505 | margin = XFASTINT (XCDR (Vtool_bar_button_margin)); | 4549 | margin = XFASTINT (XCDR (Vtool_bar_button_margin)); |
| 4506 | else | 4550 | else |
| 4507 | margin = 0; | 4551 | margin = 0; |
| 4508 | 4552 | ||
| 4509 | FRAME_TOOL_BAR_HEIGHT (f) | 4553 | FRAME_TOOL_BAR_HEIGHT (f) |
| 4510 | = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief; | 4554 | = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief; |
| 4511 | Vframe_initial_frame_tool_bar_height = make_number (FRAME_TOOL_BAR_HEIGHT (f)); | 4555 | } |
| 4512 | } | 4556 | } |
| 4513 | 4557 | ||
| 4514 | top = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER); | 4558 | top = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER); |
| @@ -4779,6 +4823,11 @@ syms_of_frame (void) | |||
| 4779 | DEFSYM (Qtool_bar_external, "tool-bar-external"); | 4823 | DEFSYM (Qtool_bar_external, "tool-bar-external"); |
| 4780 | DEFSYM (Qtool_bar_size, "tool-bar-size"); | 4824 | DEFSYM (Qtool_bar_size, "tool-bar-size"); |
| 4781 | DEFSYM (Qframe_inner_size, "frame-inner-size"); | 4825 | DEFSYM (Qframe_inner_size, "frame-inner-size"); |
| 4826 | DEFSYM (Qchange_frame_size, "change-frame-size"); | ||
| 4827 | DEFSYM (Qxg_frame_set_char_size, "xg-frame-set-char-size"); | ||
| 4828 | DEFSYM (Qset_window_configuration, "set-window-configuration"); | ||
| 4829 | DEFSYM (Qx_create_frame_1, "x-create-frame-1"); | ||
| 4830 | DEFSYM (Qx_create_frame_2, "x-create-frame-2"); | ||
| 4782 | 4831 | ||
| 4783 | #ifdef HAVE_NS | 4832 | #ifdef HAVE_NS |
| 4784 | DEFSYM (Qns_parse_geometry, "ns-parse-geometry"); | 4833 | DEFSYM (Qns_parse_geometry, "ns-parse-geometry"); |
| @@ -4968,10 +5017,6 @@ or call the function `tool-bar-mode'. */); | |||
| 4968 | Vtool_bar_mode = Qnil; | 5017 | Vtool_bar_mode = Qnil; |
| 4969 | #endif | 5018 | #endif |
| 4970 | 5019 | ||
| 4971 | DEFVAR_LISP ("frame-initial-frame-tool-bar-height", Vframe_initial_frame_tool_bar_height, | ||
| 4972 | doc: /* Height of tool bar of initial frame. */); | ||
| 4973 | Vframe_initial_frame_tool_bar_height = make_number (0); | ||
| 4974 | |||
| 4975 | DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame, | 5020 | DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame, |
| 4976 | doc: /* Minibufferless frames use this frame's minibuffer. | 5021 | doc: /* Minibufferless frames use this frame's minibuffer. |
| 4977 | Emacs cannot create minibufferless frames unless this is set to an | 5022 | Emacs cannot create minibufferless frames unless this is set to an |
| @@ -5050,6 +5095,10 @@ even if this option is non-nil. */); | |||
| 5050 | frame_inhibit_implied_resize = Qt; | 5095 | frame_inhibit_implied_resize = Qt; |
| 5051 | #endif | 5096 | #endif |
| 5052 | 5097 | ||
| 5098 | DEFVAR_LISP ("frame-adjust-size-history", Vframe_adjust_size_history, | ||
| 5099 | doc: /* History of frame size adjustments. */); | ||
| 5100 | Vframe_adjust_size_history = Qnil; | ||
| 5101 | |||
| 5053 | staticpro (&Vframe_list); | 5102 | staticpro (&Vframe_list); |
| 5054 | 5103 | ||
| 5055 | defsubr (&Sframep); | 5104 | defsubr (&Sframep); |
diff --git a/src/frame.h b/src/frame.h index d1ed4d4a67e..cb0044cfe23 100644 --- a/src/frame.h +++ b/src/frame.h | |||
| @@ -336,6 +336,10 @@ struct frame | |||
| 336 | for this frame. */ | 336 | for this frame. */ |
| 337 | bool_bf can_run_window_configuration_change_hook : 1; | 337 | bool_bf can_run_window_configuration_change_hook : 1; |
| 338 | 338 | ||
| 339 | /* True means tool bar has been redisplayed at least once in current | ||
| 340 | session. */ | ||
| 341 | bool_bf tool_bar_redisplayed_once : 1; | ||
| 342 | |||
| 339 | /* Bitfield area ends here. */ | 343 | /* Bitfield area ends here. */ |
| 340 | 344 | ||
| 341 | /* Number of lines (rounded up) of tool bar. REMOVE THIS */ | 345 | /* Number of lines (rounded up) of tool bar. REMOVE THIS */ |
| @@ -1096,6 +1100,8 @@ SET_FRAME_VISIBLE (struct frame *f, int v) | |||
| 1096 | 1100 | ||
| 1097 | extern Lisp_Object selected_frame; | 1101 | extern Lisp_Object selected_frame; |
| 1098 | 1102 | ||
| 1103 | extern int frame_default_tool_bar_height; | ||
| 1104 | |||
| 1099 | extern struct frame *decode_window_system_frame (Lisp_Object); | 1105 | extern struct frame *decode_window_system_frame (Lisp_Object); |
| 1100 | extern struct frame *decode_live_frame (Lisp_Object); | 1106 | extern struct frame *decode_live_frame (Lisp_Object); |
| 1101 | extern struct frame *decode_any_frame (Lisp_Object); | 1107 | extern struct frame *decode_any_frame (Lisp_Object); |
diff --git a/src/gnutls.c b/src/gnutls.c index 75fe6149a55..5e6c6353b45 100644 --- a/src/gnutls.c +++ b/src/gnutls.c | |||
| @@ -695,7 +695,8 @@ See also `gnutls-boot'. */) | |||
| 695 | DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0, | 695 | DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0, |
| 696 | doc: /* Return t if ERROR indicates a GnuTLS problem. | 696 | doc: /* Return t if ERROR indicates a GnuTLS problem. |
| 697 | ERROR is an integer or a symbol with an integer `gnutls-code' property. | 697 | ERROR is an integer or a symbol with an integer `gnutls-code' property. |
| 698 | usage: (gnutls-errorp ERROR) */) | 698 | usage: (gnutls-errorp ERROR) */ |
| 699 | attributes: const) | ||
| 699 | (Lisp_Object err) | 700 | (Lisp_Object err) |
| 700 | { | 701 | { |
| 701 | if (EQ (err, Qt)) return Qnil; | 702 | if (EQ (err, Qt)) return Qnil; |
| @@ -1603,7 +1604,8 @@ This function may also return `gnutls-e-again', or | |||
| 1603 | #endif /* HAVE_GNUTLS */ | 1604 | #endif /* HAVE_GNUTLS */ |
| 1604 | 1605 | ||
| 1605 | DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, | 1606 | DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, |
| 1606 | doc: /* Return t if GnuTLS is available in this instance of Emacs. */) | 1607 | doc: /* Return t if GnuTLS is available in this instance of Emacs. */ |
| 1608 | attributes: const) | ||
| 1607 | (void) | 1609 | (void) |
| 1608 | { | 1610 | { |
| 1609 | #ifdef HAVE_GNUTLS | 1611 | #ifdef HAVE_GNUTLS |
diff --git a/src/gtkutil.c b/src/gtkutil.c index bedac8451e2..694278a2b4c 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c | |||
| @@ -954,7 +954,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) | |||
| 954 | x_wait_for_event (f, ConfigureNotify); | 954 | x_wait_for_event (f, ConfigureNotify); |
| 955 | } | 955 | } |
| 956 | else | 956 | else |
| 957 | adjust_frame_size (f, -1, -1, 5, 0, Qnil); | 957 | adjust_frame_size (f, -1, -1, 5, 0, Qxg_frame_set_char_size); |
| 958 | } | 958 | } |
| 959 | 959 | ||
| 960 | /* Handle height/width changes (i.e. add/remove/move menu/toolbar). | 960 | /* Handle height/width changes (i.e. add/remove/move menu/toolbar). |
diff --git a/src/image.c b/src/image.c index 5d08a890234..9c09c5596b9 100644 --- a/src/image.c +++ b/src/image.c | |||
| @@ -9288,7 +9288,8 @@ DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0, | |||
| 9288 | } | 9288 | } |
| 9289 | 9289 | ||
| 9290 | 9290 | ||
| 9291 | DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "") | 9291 | DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, |
| 9292 | doc: /* */) | ||
| 9292 | (Lisp_Object spec) | 9293 | (Lisp_Object spec) |
| 9293 | { | 9294 | { |
| 9294 | ptrdiff_t id = -1; | 9295 | ptrdiff_t id = -1; |
diff --git a/src/keyboard.c b/src/keyboard.c index 6afbd5d5fb8..dbae12b79f1 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -1163,7 +1163,8 @@ top_level_1 (Lisp_Object ignore) | |||
| 1163 | 1163 | ||
| 1164 | DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "", | 1164 | DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "", |
| 1165 | doc: /* Exit all recursive editing levels. | 1165 | doc: /* Exit all recursive editing levels. |
| 1166 | This also exits all active minibuffers. */) | 1166 | This also exits all active minibuffers. */ |
| 1167 | attributes: noreturn) | ||
| 1167 | (void) | 1168 | (void) |
| 1168 | { | 1169 | { |
| 1169 | #ifdef HAVE_WINDOW_SYSTEM | 1170 | #ifdef HAVE_WINDOW_SYSTEM |
| @@ -1186,7 +1187,8 @@ user_error (const char *msg) | |||
| 1186 | 1187 | ||
| 1187 | /* _Noreturn will be added to prototype by make-docfile. */ | 1188 | /* _Noreturn will be added to prototype by make-docfile. */ |
| 1188 | DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "", | 1189 | DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "", |
| 1189 | doc: /* Exit from the innermost recursive edit or minibuffer. */) | 1190 | doc: /* Exit from the innermost recursive edit or minibuffer. */ |
| 1191 | attributes: noreturn) | ||
| 1190 | (void) | 1192 | (void) |
| 1191 | { | 1193 | { |
| 1192 | if (command_loop_level > 0 || minibuf_level > 0) | 1194 | if (command_loop_level > 0 || minibuf_level > 0) |
| @@ -1197,7 +1199,8 @@ DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, | |||
| 1197 | 1199 | ||
| 1198 | /* _Noreturn will be added to prototype by make-docfile. */ | 1200 | /* _Noreturn will be added to prototype by make-docfile. */ |
| 1199 | DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "", | 1201 | DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "", |
| 1200 | doc: /* Abort the command that requested this recursive edit or minibuffer input. */) | 1202 | doc: /* Abort the command that requested this recursive edit or minibuffer input. */ |
| 1203 | attributes: noreturn) | ||
| 1201 | (void) | 1204 | (void) |
| 1202 | { | 1205 | { |
| 1203 | if (command_loop_level > 0 || minibuf_level > 0) | 1206 | if (command_loop_level > 0 || minibuf_level > 0) |
| @@ -6293,10 +6296,10 @@ apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_ | |||
| 6293 | if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; } | 6296 | if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; } |
| 6294 | if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; } | 6297 | if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; } |
| 6295 | if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; } | 6298 | if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; } |
| 6296 | if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; } | 6299 | if (modifiers & double_modifier) p = stpcpy (p, "double-"); |
| 6297 | if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; } | 6300 | if (modifiers & triple_modifier) p = stpcpy (p, "triple-"); |
| 6298 | if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; } | 6301 | if (modifiers & down_modifier) p = stpcpy (p, "down-"); |
| 6299 | if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; } | 6302 | if (modifiers & drag_modifier) p = stpcpy (p, "drag-"); |
| 6300 | /* The click modifier is denoted by the absence of other modifiers. */ | 6303 | /* The click modifier is denoted by the absence of other modifiers. */ |
| 6301 | 6304 | ||
| 6302 | *p = '\0'; | 6305 | *p = '\0'; |
diff --git a/src/lisp.h b/src/lisp.h index 9e1f1501464..b6608daa20e 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -610,7 +610,6 @@ INLINE bool (VECTORLIKEP) (Lisp_Object); | |||
| 610 | INLINE bool WINDOWP (Lisp_Object); | 610 | INLINE bool WINDOWP (Lisp_Object); |
| 611 | INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); | 611 | INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); |
| 612 | INLINE struct Lisp_Symbol *(XSYMBOL) (Lisp_Object); | 612 | INLINE struct Lisp_Symbol *(XSYMBOL) (Lisp_Object); |
| 613 | INLINE enum Lisp_Type (XTYPE) (Lisp_Object); | ||
| 614 | INLINE void *(XUNTAG) (Lisp_Object, int); | 613 | INLINE void *(XUNTAG) (Lisp_Object, int); |
| 615 | 614 | ||
| 616 | /* Defined in chartab.c. */ | 615 | /* Defined in chartab.c. */ |
| @@ -825,9 +824,6 @@ DEFINE_GDB_SYMBOL_END (VALMASK) | |||
| 825 | #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) | 824 | #define MOST_POSITIVE_FIXNUM (EMACS_INT_MAX >> INTTYPEBITS) |
| 826 | #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) | 825 | #define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM) |
| 827 | 826 | ||
| 828 | /* Extract the pointer hidden within A. */ | ||
| 829 | LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a)) | ||
| 830 | |||
| 831 | #if USE_LSB_TAG | 827 | #if USE_LSB_TAG |
| 832 | 828 | ||
| 833 | LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n)) | 829 | LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n)) |
| @@ -917,6 +913,9 @@ XUNTAG (Lisp_Object a, int type) | |||
| 917 | 913 | ||
| 918 | #endif /* ! USE_LSB_TAG */ | 914 | #endif /* ! USE_LSB_TAG */ |
| 919 | 915 | ||
| 916 | /* Extract the pointer hidden within A. */ | ||
| 917 | LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a)) | ||
| 918 | |||
| 920 | /* Extract A's value as an unsigned integer. */ | 919 | /* Extract A's value as an unsigned integer. */ |
| 921 | INLINE EMACS_UINT | 920 | INLINE EMACS_UINT |
| 922 | XUINT (Lisp_Object a) | 921 | XUINT (Lisp_Object a) |
| @@ -1694,10 +1693,9 @@ CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct) | |||
| 1694 | - CHAR_TABLE_STANDARD_SLOTS); | 1693 | - CHAR_TABLE_STANDARD_SLOTS); |
| 1695 | } | 1694 | } |
| 1696 | 1695 | ||
| 1697 | /* Make sure that sub char-table contents slot | 1696 | /* Make sure that sub char-table contents slot is where we think it is. */ |
| 1698 | is aligned on a multiple of Lisp_Objects. */ | 1697 | verify (offsetof (struct Lisp_Sub_Char_Table, contents) |
| 1699 | verify ((offsetof (struct Lisp_Sub_Char_Table, contents) | 1698 | == offsetof (struct Lisp_Vector, contents[SUB_CHAR_TABLE_OFFSET])); |
| 1700 | - offsetof (struct Lisp_Sub_Char_Table, depth)) % word_size == 0); | ||
| 1701 | 1699 | ||
| 1702 | /*********************************************************************** | 1700 | /*********************************************************************** |
| 1703 | Symbols | 1701 | Symbols |
| @@ -4060,10 +4058,23 @@ struct re_registers; | |||
| 4060 | extern struct re_pattern_buffer *compile_pattern (Lisp_Object, | 4058 | extern struct re_pattern_buffer *compile_pattern (Lisp_Object, |
| 4061 | struct re_registers *, | 4059 | struct re_registers *, |
| 4062 | Lisp_Object, bool, bool); | 4060 | Lisp_Object, bool, bool); |
| 4063 | extern ptrdiff_t fast_string_match (Lisp_Object, Lisp_Object); | 4061 | extern ptrdiff_t fast_string_match_internal (Lisp_Object, Lisp_Object, |
| 4062 | Lisp_Object); | ||
| 4063 | |||
| 4064 | INLINE ptrdiff_t | ||
| 4065 | fast_string_match (Lisp_Object regexp, Lisp_Object string) | ||
| 4066 | { | ||
| 4067 | return fast_string_match_internal (regexp, string, Qnil); | ||
| 4068 | } | ||
| 4069 | |||
| 4070 | INLINE ptrdiff_t | ||
| 4071 | fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string) | ||
| 4072 | { | ||
| 4073 | return fast_string_match_internal (regexp, string, Vascii_canon_table); | ||
| 4074 | } | ||
| 4075 | |||
| 4064 | extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *, | 4076 | extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *, |
| 4065 | ptrdiff_t); | 4077 | ptrdiff_t); |
| 4066 | extern ptrdiff_t fast_string_match_ignore_case (Lisp_Object, Lisp_Object); | ||
| 4067 | extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t, | 4078 | extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t, |
| 4068 | ptrdiff_t, ptrdiff_t, Lisp_Object); | 4079 | ptrdiff_t, ptrdiff_t, Lisp_Object); |
| 4069 | extern ptrdiff_t find_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, | 4080 | extern ptrdiff_t find_newline (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, |
diff --git a/src/nsfns.m b/src/nsfns.m index 828ee88e635..cc2e49641e8 100644 --- a/src/nsfns.m +++ b/src/nsfns.m | |||
| @@ -1251,7 +1251,8 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 1251 | 1251 | ||
| 1252 | /* Read comment about this code in corresponding place in xfns.c. */ | 1252 | /* Read comment about this code in corresponding place in xfns.c. */ |
| 1253 | adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), | 1253 | adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), |
| 1254 | FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, Qnil); | 1254 | FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, |
| 1255 | Qx_create_frame_1); | ||
| 1255 | 1256 | ||
| 1256 | /* The resources controlling the menu-bar and tool-bar are | 1257 | /* The resources controlling the menu-bar and tool-bar are |
| 1257 | processed specially at startup, and reflected in the mode | 1258 | processed specially at startup, and reflected in the mode |
| @@ -1325,7 +1326,8 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 1325 | /* Allow x_set_window_size, now. */ | 1326 | /* Allow x_set_window_size, now. */ |
| 1326 | f->can_x_set_window_size = true; | 1327 | f->can_x_set_window_size = true; |
| 1327 | 1328 | ||
| 1328 | adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1, Qnil); | 1329 | adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1, |
| 1330 | Qx_create_frame_2); | ||
| 1329 | 1331 | ||
| 1330 | if (! f->output_data.ns->explicit_parent) | 1332 | if (! f->output_data.ns->explicit_parent) |
| 1331 | { | 1333 | { |
diff --git a/src/process.c b/src/process.c index 9015383b8b5..77c94f29211 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -1517,11 +1517,8 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) | |||
| 1517 | tem = program; | 1517 | tem = program; |
| 1518 | } | 1518 | } |
| 1519 | 1519 | ||
| 1520 | /* If program file name starts with /: for quoting a magic name, | 1520 | /* Remove "/:" from TEM. */ |
| 1521 | discard that. */ | 1521 | tem = remove_slash_colon (tem); |
| 1522 | if (SBYTES (tem) > 2 && SREF (tem, 0) == '/' | ||
| 1523 | && SREF (tem, 1) == ':') | ||
| 1524 | tem = Fsubstring (tem, make_number (2), Qnil); | ||
| 1525 | 1522 | ||
| 1526 | { | 1523 | { |
| 1527 | Lisp_Object arg_encoding = Qnil; | 1524 | Lisp_Object arg_encoding = Qnil; |
| @@ -3830,6 +3827,18 @@ Data that is unavailable is returned as nil. */) | |||
| 3830 | #endif | 3827 | #endif |
| 3831 | } | 3828 | } |
| 3832 | 3829 | ||
| 3830 | /* If program file NAME starts with /: for quoting a magic | ||
| 3831 | name, remove that, preserving the multibyteness of NAME. */ | ||
| 3832 | |||
| 3833 | Lisp_Object | ||
| 3834 | remove_slash_colon (Lisp_Object name) | ||
| 3835 | { | ||
| 3836 | return | ||
| 3837 | ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':') | ||
| 3838 | ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2, | ||
| 3839 | SBYTES (name) - 2, STRING_MULTIBYTE (name)) | ||
| 3840 | : name); | ||
| 3841 | } | ||
| 3833 | 3842 | ||
| 3834 | /* Turn off input and output for process PROC. */ | 3843 | /* Turn off input and output for process PROC. */ |
| 3835 | 3844 | ||
diff --git a/src/process.h b/src/process.h index 7803672d61a..36979dcac9e 100644 --- a/src/process.h +++ b/src/process.h | |||
| @@ -237,4 +237,6 @@ extern Lisp_Object network_interface_list (void); | |||
| 237 | extern Lisp_Object network_interface_info (Lisp_Object); | 237 | extern Lisp_Object network_interface_info (Lisp_Object); |
| 238 | #endif | 238 | #endif |
| 239 | 239 | ||
| 240 | extern Lisp_Object remove_slash_colon (Lisp_Object); | ||
| 241 | |||
| 240 | INLINE_HEADER_END | 242 | INLINE_HEADER_END |
diff --git a/src/search.c b/src/search.c index 0252542a361..e9617985c18 100644 --- a/src/search.c +++ b/src/search.c | |||
| @@ -459,17 +459,18 @@ matched by parenthesis constructs in the pattern. */) | |||
| 459 | return string_match_1 (regexp, string, start, 1); | 459 | return string_match_1 (regexp, string, start, 1); |
| 460 | } | 460 | } |
| 461 | 461 | ||
| 462 | /* Match REGEXP against STRING, searching all of STRING, | 462 | /* Match REGEXP against STRING using translation table TABLE, |
| 463 | and return the index of the match, or negative on failure. | 463 | searching all of STRING, and return the index of the match, |
| 464 | This does not clobber the match data. */ | 464 | or negative on failure. This does not clobber the match data. */ |
| 465 | 465 | ||
| 466 | ptrdiff_t | 466 | ptrdiff_t |
| 467 | fast_string_match (Lisp_Object regexp, Lisp_Object string) | 467 | fast_string_match_internal (Lisp_Object regexp, Lisp_Object string, |
| 468 | Lisp_Object table) | ||
| 468 | { | 469 | { |
| 469 | ptrdiff_t val; | 470 | ptrdiff_t val; |
| 470 | struct re_pattern_buffer *bufp; | 471 | struct re_pattern_buffer *bufp; |
| 471 | 472 | ||
| 472 | bufp = compile_pattern (regexp, 0, Qnil, | 473 | bufp = compile_pattern (regexp, 0, table, |
| 473 | 0, STRING_MULTIBYTE (string)); | 474 | 0, STRING_MULTIBYTE (string)); |
| 474 | immediate_quit = 1; | 475 | immediate_quit = 1; |
| 475 | re_match_object = string; | 476 | re_match_object = string; |
| @@ -504,26 +505,6 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, | |||
| 504 | return val; | 505 | return val; |
| 505 | } | 506 | } |
| 506 | 507 | ||
| 507 | /* Like fast_string_match but ignore case. */ | ||
| 508 | |||
| 509 | ptrdiff_t | ||
| 510 | fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string) | ||
| 511 | { | ||
| 512 | ptrdiff_t val; | ||
| 513 | struct re_pattern_buffer *bufp; | ||
| 514 | |||
| 515 | bufp = compile_pattern (regexp, 0, Vascii_canon_table, | ||
| 516 | 0, STRING_MULTIBYTE (string)); | ||
| 517 | immediate_quit = 1; | ||
| 518 | re_match_object = string; | ||
| 519 | |||
| 520 | val = re_search (bufp, SSDATA (string), | ||
| 521 | SBYTES (string), 0, | ||
| 522 | SBYTES (string), 0); | ||
| 523 | immediate_quit = 0; | ||
| 524 | return val; | ||
| 525 | } | ||
| 526 | |||
| 527 | /* Match REGEXP against the characters after POS to LIMIT, and return | 508 | /* Match REGEXP against the characters after POS to LIMIT, and return |
| 528 | the number of matched characters. If STRING is non-nil, match | 509 | the number of matched characters. If STRING is non-nil, match |
| 529 | against the characters in it. In that case, POS and LIMIT are | 510 | against the characters in it. In that case, POS and LIMIT are |
diff --git a/src/w32fns.c b/src/w32fns.c index 789a91a3c96..2dd92ff8a3a 100644 --- a/src/w32fns.c +++ b/src/w32fns.c | |||
| @@ -1744,8 +1744,11 @@ x_change_tool_bar_height (struct frame *f, int height) | |||
| 1744 | /* Recalculate toolbar height. */ | 1744 | /* Recalculate toolbar height. */ |
| 1745 | f->n_tool_bar_rows = 0; | 1745 | f->n_tool_bar_rows = 0; |
| 1746 | 1746 | ||
| 1747 | adjust_frame_size (f, -1, -1, (old_height == 0 || height == 0) ? 2 : 4, 0, | 1747 | adjust_frame_size (f, -1, -1, |
| 1748 | Qtool_bar_lines); | 1748 | (!f->tool_bar_redisplayed_once ? 1 |
| 1749 | : (old_height == 0 || height == 0) ? 2 | ||
| 1750 | : 4), | ||
| 1751 | 0, Qtool_bar_lines); | ||
| 1749 | 1752 | ||
| 1750 | /* adjust_frame_size might not have done anything, garbage frame | 1753 | /* adjust_frame_size might not have done anything, garbage frame |
| 1751 | here. */ | 1754 | here. */ |
| @@ -2540,7 +2543,7 @@ w32_msg_pump (deferred_msg * msg_buf) | |||
| 2540 | thread-safe. The next line is okay because the cons | 2543 | thread-safe. The next line is okay because the cons |
| 2541 | cell is never made into garbage and is not relocated by | 2544 | cell is never made into garbage and is not relocated by |
| 2542 | GC. */ | 2545 | GC. */ |
| 2543 | XSETCAR (XIL ((EMACS_INT) msg.lParam), Qnil); | 2546 | XSETCAR (make_lisp_ptr ((void *)msg.lParam, Lisp_Cons), Qnil); |
| 2544 | if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0)) | 2547 | if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0)) |
| 2545 | emacs_abort (); | 2548 | emacs_abort (); |
| 2546 | break; | 2549 | break; |
| @@ -2548,16 +2551,10 @@ w32_msg_pump (deferred_msg * msg_buf) | |||
| 2548 | { | 2551 | { |
| 2549 | int vk_code = (int) msg.wParam; | 2552 | int vk_code = (int) msg.wParam; |
| 2550 | int cur_state = (GetKeyState (vk_code) & 1); | 2553 | int cur_state = (GetKeyState (vk_code) & 1); |
| 2551 | Lisp_Object new_state = XIL ((EMACS_INT) msg.lParam); | 2554 | int new_state = msg.lParam; |
| 2552 | 2555 | ||
| 2553 | /* NB: This code must be thread-safe. It is safe to | 2556 | if (new_state == -1 |
| 2554 | call NILP because symbols are not relocated by GC, | 2557 | || ((new_state & 1) != cur_state)) |
| 2555 | and pointer here is not touched by GC (so the markbit | ||
| 2556 | can't be set). Numbers are safe because they are | ||
| 2557 | immediate values. */ | ||
| 2558 | if (NILP (new_state) | ||
| 2559 | || (NUMBERP (new_state) | ||
| 2560 | && ((XUINT (new_state)) & 1) != cur_state)) | ||
| 2561 | { | 2558 | { |
| 2562 | one_w32_display_info.faked_key = vk_code; | 2559 | one_w32_display_info.faked_key = vk_code; |
| 2563 | 2560 | ||
| @@ -4520,7 +4517,9 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 4520 | /* Specify the parent under which to make this window. */ | 4517 | /* Specify the parent under which to make this window. */ |
| 4521 | if (!NILP (parent)) | 4518 | if (!NILP (parent)) |
| 4522 | { | 4519 | { |
| 4523 | f->output_data.w32->parent_desc = (Window) XFASTINT (parent); | 4520 | /* Cast to UINT_PTR shuts up compiler warnings about cast to |
| 4521 | pointer from integer of different size. */ | ||
| 4522 | f->output_data.w32->parent_desc = (Window) (UINT_PTR) XFASTINT (parent); | ||
| 4524 | f->output_data.w32->explicit_parent = 1; | 4523 | f->output_data.w32->explicit_parent = 1; |
| 4525 | } | 4524 | } |
| 4526 | else | 4525 | else |
| @@ -4617,7 +4616,8 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 4617 | had one frame line vs one toolbar line which left us with a zero | 4616 | had one frame line vs one toolbar line which left us with a zero |
| 4618 | root window height which was obviously wrong as well ... */ | 4617 | root window height which was obviously wrong as well ... */ |
| 4619 | adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), | 4618 | adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), |
| 4620 | FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, Qnil); | 4619 | FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, |
| 4620 | Qx_create_frame_1); | ||
| 4621 | 4621 | ||
| 4622 | /* The X resources controlling the menu-bar and tool-bar are | 4622 | /* The X resources controlling the menu-bar and tool-bar are |
| 4623 | processed specially at startup, and reflected in the mode | 4623 | processed specially at startup, and reflected in the mode |
| @@ -4685,7 +4685,8 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 4685 | /* Allow x_set_window_size, now. */ | 4685 | /* Allow x_set_window_size, now. */ |
| 4686 | f->can_x_set_window_size = true; | 4686 | f->can_x_set_window_size = true; |
| 4687 | 4687 | ||
| 4688 | adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1, Qnil); | 4688 | adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1, |
| 4689 | Qx_create_frame_2); | ||
| 4689 | 4690 | ||
| 4690 | /* Tell the server what size and position, etc, we want, and how | 4691 | /* Tell the server what size and position, etc, we want, and how |
| 4691 | badly we want them. This should be done after we have the menu | 4692 | badly we want them. This should be done after we have the menu |
| @@ -7255,10 +7256,17 @@ DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, | |||
| 7255 | 7256 | ||
| 7256 | if (!NILP (item)) | 7257 | if (!NILP (item)) |
| 7257 | { | 7258 | { |
| 7259 | LPARAM lparam; | ||
| 7260 | |||
| 7261 | eassert (CONSP (item)); | ||
| 7262 | /* Pass the tail of the list as a pointer to a Lisp_Cons cell, | ||
| 7263 | so that it works in a --with-wide-int build as well. */ | ||
| 7264 | lparam = (LPARAM) XUNTAG (item, Lisp_Cons); | ||
| 7265 | |||
| 7258 | /* Notify input thread about hot-key definition being removed, so | 7266 | /* Notify input thread about hot-key definition being removed, so |
| 7259 | that it takes effect without needing focus switch. */ | 7267 | that it takes effect without needing focus switch. */ |
| 7260 | if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY, | 7268 | if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY, |
| 7261 | (WPARAM) XINT (XCAR (item)), (LPARAM) XLI (item))) | 7269 | (WPARAM) XINT (XCAR (item)), lparam)) |
| 7262 | { | 7270 | { |
| 7263 | MSG msg; | 7271 | MSG msg; |
| 7264 | GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); | 7272 | GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); |
| @@ -7313,10 +7321,15 @@ DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key, | |||
| 7313 | doc: /* Toggle the state of the lock key KEY. | 7321 | doc: /* Toggle the state of the lock key KEY. |
| 7314 | KEY can be `capslock', `kp-numlock', or `scroll'. | 7322 | KEY can be `capslock', `kp-numlock', or `scroll'. |
| 7315 | If the optional parameter NEW-STATE is a number, then the state of KEY | 7323 | If the optional parameter NEW-STATE is a number, then the state of KEY |
| 7316 | is set to off if the low bit of NEW-STATE is zero, otherwise on. */) | 7324 | is set to off if the low bit of NEW-STATE is zero, otherwise on. |
| 7325 | If NEW-STATE is omitted or nil, the function toggles the state, | ||
| 7326 | |||
| 7327 | Value is the new state of the key, or nil if the function failed | ||
| 7328 | to change the state. */) | ||
| 7317 | (Lisp_Object key, Lisp_Object new_state) | 7329 | (Lisp_Object key, Lisp_Object new_state) |
| 7318 | { | 7330 | { |
| 7319 | int vk_code; | 7331 | int vk_code; |
| 7332 | LPARAM lparam; | ||
| 7320 | 7333 | ||
| 7321 | if (EQ (key, intern ("capslock"))) | 7334 | if (EQ (key, intern ("capslock"))) |
| 7322 | vk_code = VK_CAPITAL; | 7335 | vk_code = VK_CAPITAL; |
| @@ -7330,8 +7343,12 @@ is set to off if the low bit of NEW-STATE is zero, otherwise on. */) | |||
| 7330 | if (!dwWindowsThreadId) | 7343 | if (!dwWindowsThreadId) |
| 7331 | return make_number (w32_console_toggle_lock_key (vk_code, new_state)); | 7344 | return make_number (w32_console_toggle_lock_key (vk_code, new_state)); |
| 7332 | 7345 | ||
| 7346 | if (NILP (new_state)) | ||
| 7347 | lparam = -1; | ||
| 7348 | else | ||
| 7349 | lparam = (XUINT (new_state)) & 1; | ||
| 7333 | if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY, | 7350 | if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY, |
| 7334 | (WPARAM) vk_code, (LPARAM) XLI (new_state))) | 7351 | (WPARAM) vk_code, lparam)) |
| 7335 | { | 7352 | { |
| 7336 | MSG msg; | 7353 | MSG msg; |
| 7337 | GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); | 7354 | GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); |
diff --git a/src/w32heap.c b/src/w32heap.c index f68332319c1..d5a9dae0aa4 100644 --- a/src/w32heap.c +++ b/src/w32heap.c | |||
| @@ -114,7 +114,7 @@ typedef struct _RTL_HEAP_PARAMETERS { | |||
| 114 | than half of the size stated below. It would be nice to find a way | 114 | than half of the size stated below. It would be nice to find a way |
| 115 | to build only the first bootstrap-emacs.exe with the large size, | 115 | to build only the first bootstrap-emacs.exe with the large size, |
| 116 | and reset that to a lower value afterwards. */ | 116 | and reset that to a lower value afterwards. */ |
| 117 | #ifdef _WIN64 | 117 | #if defined _WIN64 || defined WIDE_EMACS_INT |
| 118 | # define DUMPED_HEAP_SIZE (18*1024*1024) | 118 | # define DUMPED_HEAP_SIZE (18*1024*1024) |
| 119 | #else | 119 | #else |
| 120 | # define DUMPED_HEAP_SIZE (11*1024*1024) | 120 | # define DUMPED_HEAP_SIZE (11*1024*1024) |
diff --git a/src/w32menu.c b/src/w32menu.c index 7a946d2dc75..2a1dafbd6d7 100644 --- a/src/w32menu.c +++ b/src/w32menu.c | |||
| @@ -217,9 +217,9 @@ menubar_selection_callback (struct frame *f, void * client_data) | |||
| 217 | else | 217 | else |
| 218 | { | 218 | { |
| 219 | entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE); | 219 | entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE); |
| 220 | /* The EMACS_INT cast avoids a warning. There's no problem | 220 | /* The UINT_PTR cast avoids a warning. There's no problem |
| 221 | as long as pointers have enough bits to hold small integers. */ | 221 | as long as pointers have enough bits to hold small integers. */ |
| 222 | if ((int) (EMACS_INT) client_data == i) | 222 | if ((int) (UINT_PTR) client_data == i) |
| 223 | { | 223 | { |
| 224 | int j; | 224 | int j; |
| 225 | struct input_event buf; | 225 | struct input_event buf; |
| @@ -501,8 +501,7 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) | |||
| 501 | /* Force the window size to be recomputed so that the frame's text | 501 | /* Force the window size to be recomputed so that the frame's text |
| 502 | area remains the same, if menubar has just been created. */ | 502 | area remains the same, if menubar has just been created. */ |
| 503 | if (old_widget == NULL) | 503 | if (old_widget == NULL) |
| 504 | adjust_frame_size (f, FRAME_TEXT_WIDTH (f), | 504 | adjust_frame_size (f, -1, -1, 2, 0, Qmenu_bar_lines); |
| 505 | FRAME_TEXT_HEIGHT (f), 2, 0, Qmenu_bar_lines); | ||
| 506 | } | 505 | } |
| 507 | 506 | ||
| 508 | unblock_input (); | 507 | unblock_input (); |
| @@ -707,7 +706,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, | |||
| 707 | wv->key = SSDATA (descrip); | 706 | wv->key = SSDATA (descrip); |
| 708 | /* Use the contents index as call_data, since we are | 707 | /* Use the contents index as call_data, since we are |
| 709 | restricted to 16-bits. */ | 708 | restricted to 16-bits. */ |
| 710 | wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0; | 709 | wv->call_data = !NILP (def) ? (void *) (UINT_PTR) i : 0; |
| 711 | 710 | ||
| 712 | if (NILP (type)) | 711 | if (NILP (type)) |
| 713 | wv->button_type = BUTTON_TYPE_NONE; | 712 | wv->button_type = BUTTON_TYPE_NONE; |
| @@ -1402,17 +1401,21 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) | |||
| 1402 | info.cbSize = sizeof (info); | 1401 | info.cbSize = sizeof (info); |
| 1403 | info.fMask = MIIM_DATA; | 1402 | info.fMask = MIIM_DATA; |
| 1404 | 1403 | ||
| 1405 | /* Set help string for menu item. Leave it as a Lisp_Object | 1404 | /* Set help string for menu item. Leave it as a pointer to |
| 1406 | until it is ready to be displayed, since GC can happen while | 1405 | a Lisp_String until it is ready to be displayed, since GC |
| 1407 | menus are active. */ | 1406 | can happen while menus are active. */ |
| 1408 | if (!NILP (wv->help)) | 1407 | if (!NILP (wv->help)) |
| 1409 | { | 1408 | { |
| 1409 | /* We use XUNTAG below because in a 32-bit build | ||
| 1410 | --with-wide-int we cannot pass a Lisp_Object | ||
| 1411 | via a DWORD member of MENUITEMINFO. */ | ||
| 1410 | /* As of Jul-2012, w32api headers say that dwItemData | 1412 | /* As of Jul-2012, w32api headers say that dwItemData |
| 1411 | has DWORD type, but that's a bug: it should actually | 1413 | has DWORD type, but that's a bug: it should actually |
| 1412 | be ULONG_PTR, which is correct for 32-bit and 64-bit | 1414 | be ULONG_PTR, which is correct for 32-bit and 64-bit |
| 1413 | Windows alike. MSVC headers get it right; hopefully, | 1415 | Windows alike. MSVC headers get it right; hopefully, |
| 1414 | MinGW headers will, too. */ | 1416 | MinGW headers will, too. */ |
| 1415 | info.dwItemData = (ULONG_PTR) XLI (wv->help); | 1417 | eassert (STRINGP (wv->help)); |
| 1418 | info.dwItemData = (ULONG_PTR) XUNTAG (wv->help, Lisp_String); | ||
| 1416 | } | 1419 | } |
| 1417 | if (wv->button_type == BUTTON_TYPE_RADIO) | 1420 | if (wv->button_type == BUTTON_TYPE_RADIO) |
| 1418 | { | 1421 | { |
| @@ -1473,11 +1476,24 @@ w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags) | |||
| 1473 | struct frame *f = x_window_to_frame (&one_w32_display_info, owner); | 1476 | struct frame *f = x_window_to_frame (&one_w32_display_info, owner); |
| 1474 | Lisp_Object frame, help; | 1477 | Lisp_Object frame, help; |
| 1475 | 1478 | ||
| 1476 | /* No help echo on owner-draw menu items, or when the keyboard is used | 1479 | /* No help echo on owner-draw menu items, or when the keyboard |
| 1477 | to navigate the menus, since tooltips are distracting if they pop | 1480 | is used to navigate the menus, since tooltips are distracting |
| 1478 | up elsewhere. */ | 1481 | if they pop up elsewhere. */ |
| 1479 | if (flags & MF_OWNERDRAW || flags & MF_POPUP | 1482 | if ((flags & MF_OWNERDRAW) || (flags & MF_POPUP) |
| 1480 | || !(flags & MF_MOUSESELECT)) | 1483 | || !(flags & MF_MOUSESELECT) |
| 1484 | /* Ignore any dwItemData for menu items whose flags don't | ||
| 1485 | have the MF_HILITE bit set. These are dwItemData that | ||
| 1486 | Windows sends our way, but they aren't pointers to our | ||
| 1487 | Lisp_String objects, so trying to create Lisp_Strings out | ||
| 1488 | of them below and pass that to the keyboard queue will | ||
| 1489 | crash Emacs when we try to display those "strings". It | ||
| 1490 | is unclear why we get these dwItemData, or what they are: | ||
| 1491 | sometimes they point to a wchar_t string that is the menu | ||
| 1492 | title, sometimes to someting that doesn't look like text | ||
| 1493 | at all. (The problematic data also comes with the 0x0800 | ||
| 1494 | bit set, but this bit is not documented, so we don't want | ||
| 1495 | to depend on it.) */ | ||
| 1496 | || !(flags & MF_HILITE)) | ||
| 1481 | help = Qnil; | 1497 | help = Qnil; |
| 1482 | else | 1498 | else |
| 1483 | { | 1499 | { |
| @@ -1488,7 +1504,10 @@ w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags) | |||
| 1488 | info.fMask = MIIM_DATA; | 1504 | info.fMask = MIIM_DATA; |
| 1489 | get_menu_item_info (menu, item, FALSE, &info); | 1505 | get_menu_item_info (menu, item, FALSE, &info); |
| 1490 | 1506 | ||
| 1491 | help = info.dwItemData ? XIL (info.dwItemData) : Qnil; | 1507 | help = |
| 1508 | info.dwItemData | ||
| 1509 | ? make_lisp_ptr ((void *) info.dwItemData, Lisp_String) | ||
| 1510 | : Qnil; | ||
| 1492 | } | 1511 | } |
| 1493 | 1512 | ||
| 1494 | /* Store the help echo in the keyboard buffer as the X toolkit | 1513 | /* Store the help echo in the keyboard buffer as the X toolkit |
diff --git a/src/w32proc.c b/src/w32proc.c index 26cfa2996d0..74731db2426 100644 --- a/src/w32proc.c +++ b/src/w32proc.c | |||
| @@ -3077,13 +3077,18 @@ yield nil. */) | |||
| 3077 | (Lisp_Object cp) | 3077 | (Lisp_Object cp) |
| 3078 | { | 3078 | { |
| 3079 | CHARSETINFO info; | 3079 | CHARSETINFO info; |
| 3080 | DWORD dwcp; | ||
| 3080 | 3081 | ||
| 3081 | CHECK_NUMBER (cp); | 3082 | CHECK_NUMBER (cp); |
| 3082 | 3083 | ||
| 3083 | if (!IsValidCodePage (XINT (cp))) | 3084 | if (!IsValidCodePage (XINT (cp))) |
| 3084 | return Qnil; | 3085 | return Qnil; |
| 3085 | 3086 | ||
| 3086 | if (TranslateCharsetInfo ((DWORD *) XINT (cp), &info, TCI_SRCCODEPAGE)) | 3087 | /* Going through a temporary DWORD variable avoids compiler warning |
| 3088 | about cast to pointer from integer of different size, when | ||
| 3089 | building --with-wide-int. */ | ||
| 3090 | dwcp = XINT (cp); | ||
| 3091 | if (TranslateCharsetInfo ((DWORD *) dwcp, &info, TCI_SRCCODEPAGE)) | ||
| 3087 | return make_number (info.ciCharset); | 3092 | return make_number (info.ciCharset); |
| 3088 | 3093 | ||
| 3089 | return Qnil; | 3094 | return Qnil; |
| @@ -3142,8 +3147,8 @@ If successful, the new layout id is returned, otherwise nil. */) | |||
| 3142 | CHECK_NUMBER_CAR (layout); | 3147 | CHECK_NUMBER_CAR (layout); |
| 3143 | CHECK_NUMBER_CDR (layout); | 3148 | CHECK_NUMBER_CDR (layout); |
| 3144 | 3149 | ||
| 3145 | kl = (HKL) ((XINT (XCAR (layout)) & 0xffff) | 3150 | kl = (HKL) (UINT_PTR) ((XINT (XCAR (layout)) & 0xffff) |
| 3146 | | (XINT (XCDR (layout)) << 16)); | 3151 | | (XINT (XCDR (layout)) << 16)); |
| 3147 | 3152 | ||
| 3148 | /* Synchronize layout with input thread. */ | 3153 | /* Synchronize layout with input thread. */ |
| 3149 | if (dwWindowsThreadId) | 3154 | if (dwWindowsThreadId) |
diff --git a/src/w32term.h b/src/w32term.h index 042d7abd945..c905ef15737 100644 --- a/src/w32term.h +++ b/src/w32term.h | |||
| @@ -493,8 +493,8 @@ struct scroll_bar { | |||
| 493 | (XSETINT ((low), ((DWORDLONG)(int64)) & 0xffffffff), \ | 493 | (XSETINT ((low), ((DWORDLONG)(int64)) & 0xffffffff), \ |
| 494 | XSETINT ((high), ((DWORDLONG)(int64) >> 32) & 0xffffffff)) | 494 | XSETINT ((high), ((DWORDLONG)(int64) >> 32) & 0xffffffff)) |
| 495 | #else /* not _WIN64 */ | 495 | #else /* not _WIN64 */ |
| 496 | /* Building a 32-bit C integer from two 16-bit lisp integers. */ | 496 | /* Building a 32-bit C unsigned integer from two 16-bit lisp integers. */ |
| 497 | #define SCROLL_BAR_PACK(low, high) (XINT (high) << 16 | XINT (low)) | 497 | #define SCROLL_BAR_PACK(low, high) ((UINT_PTR)(XINT (high) << 16 | XINT (low))) |
| 498 | 498 | ||
| 499 | /* Setting two lisp integers to the low and high words of a 32-bit C int. */ | 499 | /* Setting two lisp integers to the low and high words of a 32-bit C int. */ |
| 500 | #define SCROLL_BAR_UNPACK(low, high, int32) \ | 500 | #define SCROLL_BAR_UNPACK(low, high, int32) \ |
diff --git a/src/window.c b/src/window.c index 4dec9768e2c..60ba3750f5b 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -3003,7 +3003,8 @@ resize_root_window (Lisp_Object window, Lisp_Object delta, Lisp_Object horizonta | |||
| 3003 | /* Placeholder used by temacs -nw before window.el is loaded. */ | 3003 | /* Placeholder used by temacs -nw before window.el is loaded. */ |
| 3004 | DEFUN ("window--sanitize-window-sizes", Fwindow__sanitize_window_sizes, | 3004 | DEFUN ("window--sanitize-window-sizes", Fwindow__sanitize_window_sizes, |
| 3005 | Swindow__sanitize_window_sizes, 2, 2, 0, | 3005 | Swindow__sanitize_window_sizes, 2, 2, 0, |
| 3006 | doc: /* */) | 3006 | doc: /* */ |
| 3007 | attributes: const) | ||
| 3007 | (Lisp_Object frame, Lisp_Object horizontal) | 3008 | (Lisp_Object frame, Lisp_Object horizontal) |
| 3008 | { | 3009 | { |
| 3009 | return Qnil; | 3010 | return Qnil; |
| @@ -6427,7 +6428,7 @@ the return value is nil. Otherwise the value is t. */) | |||
| 6427 | /* Allow x_set_window_size again and apply frame size changes if | 6428 | /* Allow x_set_window_size again and apply frame size changes if |
| 6428 | needed. */ | 6429 | needed. */ |
| 6429 | f->can_x_set_window_size = true; | 6430 | f->can_x_set_window_size = true; |
| 6430 | adjust_frame_size (f, -1, -1, 1, 0, Qnil); | 6431 | adjust_frame_size (f, -1, -1, 1, 0, Qset_window_configuration); |
| 6431 | 6432 | ||
| 6432 | adjust_frame_glyphs (f); | 6433 | adjust_frame_glyphs (f); |
| 6433 | unblock_input (); | 6434 | unblock_input (); |
diff --git a/src/xdisp.c b/src/xdisp.c index 8b68ab7ddf7..120e810f445 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -12332,7 +12332,8 @@ DEFUN ("tool-bar-height", Ftool_bar_height, Stool_bar_height, | |||
| 12332 | 0, 2, 0, | 12332 | 0, 2, 0, |
| 12333 | doc: /* Return the number of lines occupied by the tool bar of FRAME. | 12333 | doc: /* Return the number of lines occupied by the tool bar of FRAME. |
| 12334 | If FRAME is nil or omitted, use the selected frame. Optional argument | 12334 | If FRAME is nil or omitted, use the selected frame. Optional argument |
| 12335 | PIXELWISE non-nil means return the height of the tool bar in pixels. */) | 12335 | PIXELWISE non-nil means return the height of the tool bar in pixels. */ |
| 12336 | attributes: const) | ||
| 12336 | (Lisp_Object frame, Lisp_Object pixelwise) | 12337 | (Lisp_Object frame, Lisp_Object pixelwise) |
| 12337 | { | 12338 | { |
| 12338 | int height = 0; | 12339 | int height = 0; |
| @@ -12408,6 +12409,7 @@ redisplay_tool_bar (struct frame *f) | |||
| 12408 | if (new_height != WINDOW_PIXEL_HEIGHT (w)) | 12409 | if (new_height != WINDOW_PIXEL_HEIGHT (w)) |
| 12409 | { | 12410 | { |
| 12410 | x_change_tool_bar_height (f, new_height); | 12411 | x_change_tool_bar_height (f, new_height); |
| 12412 | frame_default_tool_bar_height = new_height; | ||
| 12411 | /* Always do that now. */ | 12413 | /* Always do that now. */ |
| 12412 | clear_glyph_matrix (w->desired_matrix); | 12414 | clear_glyph_matrix (w->desired_matrix); |
| 12413 | f->fonts_changed = 1; | 12415 | f->fonts_changed = 1; |
| @@ -12502,6 +12504,7 @@ redisplay_tool_bar (struct frame *f) | |||
| 12502 | if (change_height_p) | 12504 | if (change_height_p) |
| 12503 | { | 12505 | { |
| 12504 | x_change_tool_bar_height (f, new_height); | 12506 | x_change_tool_bar_height (f, new_height); |
| 12507 | frame_default_tool_bar_height = new_height; | ||
| 12505 | clear_glyph_matrix (w->desired_matrix); | 12508 | clear_glyph_matrix (w->desired_matrix); |
| 12506 | f->n_tool_bar_rows = nrows; | 12509 | f->n_tool_bar_rows = nrows; |
| 12507 | f->fonts_changed = 1; | 12510 | f->fonts_changed = 1; |
| @@ -13831,6 +13834,17 @@ redisplay_internal (void) | |||
| 13831 | 13834 | ||
| 13832 | retry_frame: | 13835 | retry_frame: |
| 13833 | 13836 | ||
| 13837 | #if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_GTK) && !defined (HAVE_NS) | ||
| 13838 | /* Redisplay internal tool bar if this is the first time so we | ||
| 13839 | can adjust the frame height right now, if necessary. */ | ||
| 13840 | if (!f->tool_bar_redisplayed_once) | ||
| 13841 | { | ||
| 13842 | if (redisplay_tool_bar (f)) | ||
| 13843 | adjust_frame_glyphs (f); | ||
| 13844 | f->tool_bar_redisplayed_once = true; | ||
| 13845 | } | ||
| 13846 | #endif | ||
| 13847 | |||
| 13834 | if (FRAME_WINDOW_P (f) || FRAME_TERMCAP_P (f) || f == sf) | 13848 | if (FRAME_WINDOW_P (f) || FRAME_TERMCAP_P (f) || f == sf) |
| 13835 | { | 13849 | { |
| 13836 | bool gcscrollbars | 13850 | bool gcscrollbars |
diff --git a/src/xfaces.c b/src/xfaces.c index 6ecd857d685..85af770c6a2 100644 --- a/src/xfaces.c +++ b/src/xfaces.c | |||
| @@ -3546,7 +3546,8 @@ with the value VALUE is relative. | |||
| 3546 | A relative value is one that doesn't entirely override whatever is | 3546 | A relative value is one that doesn't entirely override whatever is |
| 3547 | inherited from another face. For most possible attributes, | 3547 | inherited from another face. For most possible attributes, |
| 3548 | the only relative value that users see is `unspecified'. | 3548 | the only relative value that users see is `unspecified'. |
| 3549 | However, for :height, floating point values are also relative. */) | 3549 | However, for :height, floating point values are also relative. */ |
| 3550 | attributes: const) | ||
| 3550 | (Lisp_Object attribute, Lisp_Object value) | 3551 | (Lisp_Object attribute, Lisp_Object value) |
| 3551 | { | 3552 | { |
| 3552 | if (EQ (value, Qunspecified) || (EQ (value, QCignore_defface))) | 3553 | if (EQ (value, Qunspecified) || (EQ (value, QCignore_defface))) |
diff --git a/src/xfns.c b/src/xfns.c index 4a417526dcd..936c769a2de 100644 --- a/src/xfns.c +++ b/src/xfns.c | |||
| @@ -1130,8 +1130,11 @@ x_change_tool_bar_height (struct frame *f, int height) | |||
| 1130 | /* Recalculate toolbar height. */ | 1130 | /* Recalculate toolbar height. */ |
| 1131 | f->n_tool_bar_rows = 0; | 1131 | f->n_tool_bar_rows = 0; |
| 1132 | 1132 | ||
| 1133 | adjust_frame_size (f, -1, -1, (old_height == 0 || height == 0) ? 2 : 4, 0, | 1133 | adjust_frame_size (f, -1, -1, |
| 1134 | Qtool_bar_lines); | 1134 | (!f->tool_bar_redisplayed_once ? 1 |
| 1135 | : (old_height == 0 || height == 0) ? 2 | ||
| 1136 | : 4), | ||
| 1137 | 0, Qtool_bar_lines); | ||
| 1135 | 1138 | ||
| 1136 | /* adjust_frame_size might not have done anything, garbage frame | 1139 | /* adjust_frame_size might not have done anything, garbage frame |
| 1137 | here. */ | 1140 | here. */ |
| @@ -3160,7 +3163,8 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 3160 | had one frame line vs one toolbar line which left us with a zero | 3163 | had one frame line vs one toolbar line which left us with a zero |
| 3161 | root window height which was obviously wrong as well ... */ | 3164 | root window height which was obviously wrong as well ... */ |
| 3162 | adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), | 3165 | adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), |
| 3163 | FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, Qnil); | 3166 | FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, |
| 3167 | Qx_create_frame_1); | ||
| 3164 | 3168 | ||
| 3165 | /* Set the menu-bar-lines and tool-bar-lines parameters. We don't | 3169 | /* Set the menu-bar-lines and tool-bar-lines parameters. We don't |
| 3166 | look up the X resources controlling the menu-bar and tool-bar | 3170 | look up the X resources controlling the menu-bar and tool-bar |
| @@ -3234,7 +3238,8 @@ This function is an internal primitive--use `make-frame' instead. */) | |||
| 3234 | /* Consider frame official, now. */ | 3238 | /* Consider frame official, now. */ |
| 3235 | f->can_x_set_window_size = true; | 3239 | f->can_x_set_window_size = true; |
| 3236 | 3240 | ||
| 3237 | adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1, Qnil); | 3241 | adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1, |
| 3242 | Qx_create_frame_2); | ||
| 3238 | 3243 | ||
| 3239 | #if defined (USE_X_TOOLKIT) || defined (USE_GTK) | 3244 | #if defined (USE_X_TOOLKIT) || defined (USE_GTK) |
| 3240 | /* Create the menu bar. */ | 3245 | /* Create the menu bar. */ |
diff --git a/src/xmenu.c b/src/xmenu.c index fd667a84343..9063a8a2a52 100644 --- a/src/xmenu.c +++ b/src/xmenu.c | |||
| @@ -104,10 +104,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 104 | 104 | ||
| 105 | #include "menu.h" | 105 | #include "menu.h" |
| 106 | 106 | ||
| 107 | #ifndef TRUE | ||
| 108 | #define TRUE 1 | ||
| 109 | #endif /* no TRUE */ | ||
| 110 | |||
| 111 | 107 | ||
| 112 | /* Flag which when set indicates a dialog or menu has been posted by | 108 | /* Flag which when set indicates a dialog or menu has been posted by |
| 113 | Xt on behalf of one of the widget sets. */ | 109 | Xt on behalf of one of the widget sets. */ |
| @@ -146,7 +142,7 @@ menubar_id_to_frame (LWLIB_ID id) | |||
| 146 | /* Set menu_items_inuse so no other popup menu or dialog is created. */ | 142 | /* Set menu_items_inuse so no other popup menu or dialog is created. */ |
| 147 | 143 | ||
| 148 | void | 144 | void |
| 149 | x_menu_set_in_use (int in_use) | 145 | x_menu_set_in_use (bool in_use) |
| 150 | { | 146 | { |
| 151 | menu_items_inuse = in_use ? Qt : Qnil; | 147 | menu_items_inuse = in_use ? Qt : Qnil; |
| 152 | popup_activated_flag = in_use; | 148 | popup_activated_flag = in_use; |
| @@ -222,7 +218,8 @@ x_menu_wait_for_event (void *data) | |||
| 222 | with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */ | 218 | with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */ |
| 223 | 219 | ||
| 224 | static void | 220 | static void |
| 225 | popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, LWLIB_ID id, int do_timers) | 221 | popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, |
| 222 | LWLIB_ID id, bool do_timers) | ||
| 226 | { | 223 | { |
| 227 | XEvent event; | 224 | XEvent event; |
| 228 | 225 | ||
| @@ -287,13 +284,13 @@ If FRAME is nil or not given, use the selected frame. */) | |||
| 287 | block_input (); | 284 | block_input (); |
| 288 | 285 | ||
| 289 | if (FRAME_EXTERNAL_MENU_BAR (f)) | 286 | if (FRAME_EXTERNAL_MENU_BAR (f)) |
| 290 | set_frame_menubar (f, 0, 1); | 287 | set_frame_menubar (f, false, true); |
| 291 | 288 | ||
| 292 | menubar = FRAME_X_OUTPUT (f)->menubar_widget; | 289 | menubar = FRAME_X_OUTPUT (f)->menubar_widget; |
| 293 | if (menubar) | 290 | if (menubar) |
| 294 | { | 291 | { |
| 295 | Window child; | 292 | Window child; |
| 296 | bool error_p = 0; | 293 | bool error_p = false; |
| 297 | 294 | ||
| 298 | x_catch_errors (FRAME_X_DISPLAY (f)); | 295 | x_catch_errors (FRAME_X_DISPLAY (f)); |
| 299 | memset (&ev, 0, sizeof ev); | 296 | memset (&ev, 0, sizeof ev); |
| @@ -366,7 +363,7 @@ If FRAME is nil or not given, use the selected frame. */) | |||
| 366 | f = decode_window_system_frame (frame); | 363 | f = decode_window_system_frame (frame); |
| 367 | 364 | ||
| 368 | if (FRAME_EXTERNAL_MENU_BAR (f)) | 365 | if (FRAME_EXTERNAL_MENU_BAR (f)) |
| 369 | set_frame_menubar (f, 0, 1); | 366 | set_frame_menubar (f, false, true); |
| 370 | 367 | ||
| 371 | menubar = FRAME_X_OUTPUT (f)->menubar_widget; | 368 | menubar = FRAME_X_OUTPUT (f)->menubar_widget; |
| 372 | if (menubar) | 369 | if (menubar) |
| @@ -390,7 +387,7 @@ If FRAME is nil or not given, use the selected frame. */) | |||
| 390 | Used for popup menus and dialogs. */ | 387 | Used for popup menus and dialogs. */ |
| 391 | 388 | ||
| 392 | static void | 389 | static void |
| 393 | popup_widget_loop (int do_timers, GtkWidget *widget) | 390 | popup_widget_loop (bool do_timers, GtkWidget *widget) |
| 394 | { | 391 | { |
| 395 | ++popup_activated_flag; | 392 | ++popup_activated_flag; |
| 396 | 393 | ||
| @@ -431,7 +428,7 @@ x_activate_menubar (struct frame *f) | |||
| 431 | return; | 428 | return; |
| 432 | #endif | 429 | #endif |
| 433 | 430 | ||
| 434 | set_frame_menubar (f, 0, 1); | 431 | set_frame_menubar (f, false, true); |
| 435 | block_input (); | 432 | block_input (); |
| 436 | popup_activated_flag = 1; | 433 | popup_activated_flag = 1; |
| 437 | #ifdef USE_GTK | 434 | #ifdef USE_GTK |
| @@ -488,24 +485,7 @@ show_help_event (struct frame *f, xt_or_gtk_widget widget, Lisp_Object help) | |||
| 488 | kbd_buffer_store_help_event (frame, help); | 485 | kbd_buffer_store_help_event (frame, help); |
| 489 | } | 486 | } |
| 490 | else | 487 | else |
| 491 | { | 488 | show_help_echo (help, Qnil, Qnil, Qnil); |
| 492 | #if 0 /* This code doesn't do anything useful. ++kfs */ | ||
| 493 | /* WIDGET is the popup menu. It's parent is the frame's | ||
| 494 | widget. See which frame that is. */ | ||
| 495 | xt_or_gtk_widget frame_widget = XtParent (widget); | ||
| 496 | Lisp_Object tail; | ||
| 497 | |||
| 498 | for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) | ||
| 499 | { | ||
| 500 | frame = XCAR (tail); | ||
| 501 | if (FRAMEP (frame) | ||
| 502 | && (f = XFRAME (frame), | ||
| 503 | FRAME_X_P (f) && f->output_data.x->widget == frame_widget)) | ||
| 504 | break; | ||
| 505 | } | ||
| 506 | #endif | ||
| 507 | show_help_echo (help, Qnil, Qnil, Qnil); | ||
| 508 | } | ||
| 509 | } | 489 | } |
| 510 | 490 | ||
| 511 | /* Callback called when menu items are highlighted/unhighlighted | 491 | /* Callback called when menu items are highlighted/unhighlighted |
| @@ -554,7 +534,7 @@ menu_highlight_callback (Widget widget, LWLIB_ID id, void *call_data) | |||
| 554 | selected in a radio group. If this variable is set to a non-zero | 534 | selected in a radio group. If this variable is set to a non-zero |
| 555 | value, we are creating menus and don't want callbacks right now. | 535 | value, we are creating menus and don't want callbacks right now. |
| 556 | */ | 536 | */ |
| 557 | static int xg_crazy_callback_abort; | 537 | static bool xg_crazy_callback_abort; |
| 558 | 538 | ||
| 559 | /* This callback is called from the menu bar pulldown menu | 539 | /* This callback is called from the menu bar pulldown menu |
| 560 | when the user makes a selection. | 540 | when the user makes a selection. |
| @@ -656,13 +636,13 @@ update_frame_menubar (struct frame *f) | |||
| 656 | lw_refigure_widget (x->column_widget, True); | 636 | lw_refigure_widget (x->column_widget, True); |
| 657 | 637 | ||
| 658 | /* Force the pane widget to resize itself. */ | 638 | /* Force the pane widget to resize itself. */ |
| 639 | int new_height = -1; | ||
| 659 | #ifdef USE_LUCID | 640 | #ifdef USE_LUCID |
| 660 | /* For reasons I don't know Lucid wants to add one pixel to the frame | 641 | /* For reasons I don't know Lucid wants to add one pixel to the frame |
| 661 | height when adding the menu bar. Compensate that here. */ | 642 | height when adding the menu bar. Compensate that here. */ |
| 662 | adjust_frame_size (f, -1, FRAME_TEXT_HEIGHT (f) - 1, 2, 0, Qmenu_bar_lines); | 643 | new_height = FRAME_TEXT_HEIGHT (f) - 1; |
| 663 | #else | ||
| 664 | adjust_frame_size (f, -1, -1, 2, 0, Qmenu_bar_lines); | ||
| 665 | #endif /* USE_LUCID */ | 644 | #endif /* USE_LUCID */ |
| 645 | adjust_frame_size (f, -1, new_height, 2, false, Qmenu_bar_lines); | ||
| 666 | unblock_input (); | 646 | unblock_input (); |
| 667 | #endif /* USE_GTK */ | 647 | #endif /* USE_GTK */ |
| 668 | } | 648 | } |
| @@ -729,11 +709,11 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) | |||
| 729 | #endif | 709 | #endif |
| 730 | 710 | ||
| 731 | if (! menubar_widget) | 711 | if (! menubar_widget) |
| 732 | deep_p = 1; | 712 | deep_p = true; |
| 733 | /* Make the first call for any given frame always go deep. */ | 713 | /* Make the first call for any given frame always go deep. */ |
| 734 | else if (!f->output_data.x->saved_menu_event && !deep_p) | 714 | else if (!f->output_data.x->saved_menu_event && !deep_p) |
| 735 | { | 715 | { |
| 736 | deep_p = 1; | 716 | deep_p = true; |
| 737 | f->output_data.x->saved_menu_event = xmalloc (sizeof (XEvent)); | 717 | f->output_data.x->saved_menu_event = xmalloc (sizeof (XEvent)); |
| 738 | f->output_data.x->saved_menu_event->type = 0; | 718 | f->output_data.x->saved_menu_event->type = 0; |
| 739 | } | 719 | } |
| @@ -840,7 +820,7 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) | |||
| 840 | else | 820 | else |
| 841 | first_wv->contents = wv; | 821 | first_wv->contents = wv; |
| 842 | /* Don't set wv->name here; GC during the loop might relocate it. */ | 822 | /* Don't set wv->name here; GC during the loop might relocate it. */ |
| 843 | wv->enabled = 1; | 823 | wv->enabled = true; |
| 844 | wv->button_type = BUTTON_TYPE_NONE; | 824 | wv->button_type = BUTTON_TYPE_NONE; |
| 845 | prev_wv = wv; | 825 | prev_wv = wv; |
| 846 | } | 826 | } |
| @@ -931,7 +911,7 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) | |||
| 931 | block_input (); | 911 | block_input (); |
| 932 | 912 | ||
| 933 | #ifdef USE_GTK | 913 | #ifdef USE_GTK |
| 934 | xg_crazy_callback_abort = 1; | 914 | xg_crazy_callback_abort = true; |
| 935 | if (menubar_widget) | 915 | if (menubar_widget) |
| 936 | { | 916 | { |
| 937 | /* The fourth arg is DEEP_P, which says to consider the entire | 917 | /* The fourth arg is DEEP_P, which says to consider the entire |
| @@ -980,7 +960,7 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) | |||
| 980 | menubar_widget = lw_create_widget ("menubar", "menubar", id, | 960 | menubar_widget = lw_create_widget ("menubar", "menubar", id, |
| 981 | first_wv, | 961 | first_wv, |
| 982 | f->output_data.x->column_widget, | 962 | f->output_data.x->column_widget, |
| 983 | 0, | 963 | false, |
| 984 | popup_activate_callback, | 964 | popup_activate_callback, |
| 985 | menubar_selection_callback, | 965 | menubar_selection_callback, |
| 986 | popup_deactivate_callback, | 966 | popup_deactivate_callback, |
| @@ -1002,11 +982,11 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) | |||
| 1002 | + f->output_data.x->menubar_widget->core.border_width) | 982 | + f->output_data.x->menubar_widget->core.border_width) |
| 1003 | : 0); | 983 | : 0); |
| 1004 | 984 | ||
| 1005 | #if 1 /* Experimentally, we now get the right results | 985 | #ifdef USE_LUCID |
| 986 | /* Experimentally, we now get the right results | ||
| 1006 | for -geometry -0-0 without this. 24 Aug 96, rms. | 987 | for -geometry -0-0 without this. 24 Aug 96, rms. |
| 1007 | Maybe so, but the menu bar size is missing the pixels so the | 988 | Maybe so, but the menu bar size is missing the pixels so the |
| 1008 | WM size hints are off by these pixels. Jan D, oct 2009. */ | 989 | WM size hints are off by these pixels. Jan D, oct 2009. */ |
| 1009 | #ifdef USE_LUCID | ||
| 1010 | if (FRAME_EXTERNAL_MENU_BAR (f)) | 990 | if (FRAME_EXTERNAL_MENU_BAR (f)) |
| 1011 | { | 991 | { |
| 1012 | Dimension ibw = 0; | 992 | Dimension ibw = 0; |
| @@ -1015,7 +995,6 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) | |||
| 1015 | menubar_size += ibw; | 995 | menubar_size += ibw; |
| 1016 | } | 996 | } |
| 1017 | #endif /* USE_LUCID */ | 997 | #endif /* USE_LUCID */ |
| 1018 | #endif /* 1 */ | ||
| 1019 | 998 | ||
| 1020 | FRAME_MENUBAR_HEIGHT (f) = menubar_size; | 999 | FRAME_MENUBAR_HEIGHT (f) = menubar_size; |
| 1021 | } | 1000 | } |
| @@ -1025,7 +1004,7 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) | |||
| 1025 | update_frame_menubar (f); | 1004 | update_frame_menubar (f); |
| 1026 | 1005 | ||
| 1027 | #ifdef USE_GTK | 1006 | #ifdef USE_GTK |
| 1028 | xg_crazy_callback_abort = 0; | 1007 | xg_crazy_callback_abort = false; |
| 1029 | #endif | 1008 | #endif |
| 1030 | 1009 | ||
| 1031 | unblock_input (); | 1010 | unblock_input (); |
| @@ -1042,7 +1021,7 @@ initialize_frame_menubar (struct frame *f) | |||
| 1042 | /* This function is called before the first chance to redisplay | 1021 | /* This function is called before the first chance to redisplay |
| 1043 | the frame. It has to be, so the frame will have the right size. */ | 1022 | the frame. It has to be, so the frame will have the right size. */ |
| 1044 | fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); | 1023 | fset_menu_bar_items (f, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); |
| 1045 | set_frame_menubar (f, 1, 1); | 1024 | set_frame_menubar (f, true, true); |
| 1046 | } | 1025 | } |
| 1047 | 1026 | ||
| 1048 | 1027 | ||
| @@ -1094,21 +1073,21 @@ free_frame_menubar (struct frame *f) | |||
| 1094 | 1073 | ||
| 1095 | if (f->output_data.x->widget) | 1074 | if (f->output_data.x->widget) |
| 1096 | { | 1075 | { |
| 1076 | int new_height = -1; | ||
| 1097 | #ifdef USE_MOTIF | 1077 | #ifdef USE_MOTIF |
| 1098 | XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL); | 1078 | XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL); |
| 1099 | if (x1 == 0 && y1 == 0) | 1079 | if (x1 == 0 && y1 == 0) |
| 1100 | XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL); | 1080 | XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL); |
| 1101 | if (frame_inhibit_resize (f, 0, Qmenu_bar_lines)) | 1081 | if (frame_inhibit_resize (f, false, Qmenu_bar_lines)) |
| 1102 | adjust_frame_size (f, -1, old_height, 1, 0, Qmenu_bar_lines); | 1082 | new_height = old_height; |
| 1103 | else | ||
| 1104 | #endif /* USE_MOTIF */ | 1083 | #endif /* USE_MOTIF */ |
| 1105 | adjust_frame_size (f, -1, -1, 2, 0, Qmenu_bar_lines); | 1084 | adjust_frame_size (f, -1, new_height, 2, false, Qmenu_bar_lines); |
| 1106 | } | 1085 | } |
| 1107 | else | 1086 | else |
| 1108 | { | 1087 | { |
| 1109 | #ifdef USE_MOTIF | 1088 | #ifdef USE_MOTIF |
| 1110 | if (frame_inhibit_resize (f, 0, Qmenu_bar_lines)) | 1089 | if (frame_inhibit_resize (f, false, Qmenu_bar_lines)) |
| 1111 | adjust_frame_size (f, -1, old_height, 1, 0, Qmenu_bar_lines); | 1090 | adjust_frame_size (f, -1, old_height, 1, false, Qmenu_bar_lines); |
| 1112 | #endif | 1091 | #endif |
| 1113 | } | 1092 | } |
| 1114 | 1093 | ||
| @@ -1218,17 +1197,17 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, | |||
| 1218 | #ifdef HAVE_GTK3 | 1197 | #ifdef HAVE_GTK3 |
| 1219 | /* Always use position function for Gtk3. Otherwise menus may become | 1198 | /* Always use position function for Gtk3. Otherwise menus may become |
| 1220 | too small to show anything. */ | 1199 | too small to show anything. */ |
| 1221 | use_pos_func = 1; | 1200 | use_pos_func = true; |
| 1222 | #endif | 1201 | #endif |
| 1223 | 1202 | ||
| 1224 | eassert (FRAME_X_P (f)); | 1203 | eassert (FRAME_X_P (f)); |
| 1225 | 1204 | ||
| 1226 | xg_crazy_callback_abort = 1; | 1205 | xg_crazy_callback_abort = true; |
| 1227 | menu = xg_create_widget ("popup", first_wv->name, f, first_wv, | 1206 | menu = xg_create_widget ("popup", first_wv->name, f, first_wv, |
| 1228 | G_CALLBACK (popup_selection_callback), | 1207 | G_CALLBACK (popup_selection_callback), |
| 1229 | G_CALLBACK (popup_deactivate_callback), | 1208 | G_CALLBACK (popup_deactivate_callback), |
| 1230 | G_CALLBACK (menu_highlight_callback)); | 1209 | G_CALLBACK (menu_highlight_callback)); |
| 1231 | xg_crazy_callback_abort = 0; | 1210 | xg_crazy_callback_abort = false; |
| 1232 | 1211 | ||
| 1233 | if (use_pos_func) | 1212 | if (use_pos_func) |
| 1234 | { | 1213 | { |
| @@ -1269,7 +1248,7 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, | |||
| 1269 | two. show_help_echo uses this to detect popup menus. */ | 1248 | two. show_help_echo uses this to detect popup menus. */ |
| 1270 | popup_activated_flag = 1; | 1249 | popup_activated_flag = 1; |
| 1271 | /* Process events that apply to the menu. */ | 1250 | /* Process events that apply to the menu. */ |
| 1272 | popup_widget_loop (1, menu); | 1251 | popup_widget_loop (true, menu); |
| 1273 | } | 1252 | } |
| 1274 | 1253 | ||
| 1275 | unbind_to (specpdl_count, Qnil); | 1254 | unbind_to (specpdl_count, Qnil); |
| @@ -1331,14 +1310,14 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, | |||
| 1331 | 1310 | ||
| 1332 | menu_id = widget_id_tick++; | 1311 | menu_id = widget_id_tick++; |
| 1333 | menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv, | 1312 | menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv, |
| 1334 | f->output_data.x->widget, 1, 0, | 1313 | f->output_data.x->widget, true, 0, |
| 1335 | popup_selection_callback, | 1314 | popup_selection_callback, |
| 1336 | popup_deactivate_callback, | 1315 | popup_deactivate_callback, |
| 1337 | menu_highlight_callback); | 1316 | menu_highlight_callback); |
| 1338 | 1317 | ||
| 1339 | event->type = ButtonPress; | 1318 | event->type = ButtonPress; |
| 1340 | event->serial = 0; | 1319 | event->serial = 0; |
| 1341 | event->send_event = 0; | 1320 | event->send_event = false; |
| 1342 | event->display = FRAME_X_DISPLAY (f); | 1321 | event->display = FRAME_X_DISPLAY (f); |
| 1343 | event->time = CurrentTime; | 1322 | event->time = CurrentTime; |
| 1344 | event->root = FRAME_DISPLAY_INFO (f)->root_window; | 1323 | event->root = FRAME_DISPLAY_INFO (f)->root_window; |
| @@ -1374,7 +1353,7 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, | |||
| 1374 | record_unwind_protect_int (pop_down_menu, (int) menu_id); | 1353 | record_unwind_protect_int (pop_down_menu, (int) menu_id); |
| 1375 | 1354 | ||
| 1376 | /* Process events that apply to the menu. */ | 1355 | /* Process events that apply to the menu. */ |
| 1377 | popup_get_selection (0, FRAME_DISPLAY_INFO (f), menu_id, 1); | 1356 | popup_get_selection (0, FRAME_DISPLAY_INFO (f), menu_id, true); |
| 1378 | 1357 | ||
| 1379 | unbind_to (specpdl_count, Qnil); | 1358 | unbind_to (specpdl_count, Qnil); |
| 1380 | } | 1359 | } |
| @@ -1400,8 +1379,6 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, | |||
| 1400 | = alloca (menu_items_used * sizeof *subprefix_stack); | 1379 | = alloca (menu_items_used * sizeof *subprefix_stack); |
| 1401 | int submenu_depth = 0; | 1380 | int submenu_depth = 0; |
| 1402 | 1381 | ||
| 1403 | int first_pane; | ||
| 1404 | |||
| 1405 | ptrdiff_t specpdl_count = SPECPDL_INDEX (); | 1382 | ptrdiff_t specpdl_count = SPECPDL_INDEX (); |
| 1406 | 1383 | ||
| 1407 | eassert (FRAME_X_P (f)); | 1384 | eassert (FRAME_X_P (f)); |
| @@ -1421,7 +1398,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, | |||
| 1421 | wv = make_widget_value ("menu", NULL, true, Qnil); | 1398 | wv = make_widget_value ("menu", NULL, true, Qnil); |
| 1422 | wv->button_type = BUTTON_TYPE_NONE; | 1399 | wv->button_type = BUTTON_TYPE_NONE; |
| 1423 | first_wv = wv; | 1400 | first_wv = wv; |
| 1424 | first_pane = 1; | 1401 | bool first_pane = true; |
| 1425 | 1402 | ||
| 1426 | /* Loop over all panes and items, filling in the tree. */ | 1403 | /* Loop over all panes and items, filling in the tree. */ |
| 1427 | i = 0; | 1404 | i = 0; |
| @@ -1432,14 +1409,14 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, | |||
| 1432 | submenu_stack[submenu_depth++] = save_wv; | 1409 | submenu_stack[submenu_depth++] = save_wv; |
| 1433 | save_wv = prev_wv; | 1410 | save_wv = prev_wv; |
| 1434 | prev_wv = 0; | 1411 | prev_wv = 0; |
| 1435 | first_pane = 1; | 1412 | first_pane = true; |
| 1436 | i++; | 1413 | i++; |
| 1437 | } | 1414 | } |
| 1438 | else if (EQ (AREF (menu_items, i), Qlambda)) | 1415 | else if (EQ (AREF (menu_items, i), Qlambda)) |
| 1439 | { | 1416 | { |
| 1440 | prev_wv = save_wv; | 1417 | prev_wv = save_wv; |
| 1441 | save_wv = submenu_stack[--submenu_depth]; | 1418 | save_wv = submenu_stack[--submenu_depth]; |
| 1442 | first_pane = 0; | 1419 | first_pane = false; |
| 1443 | i++; | 1420 | i++; |
| 1444 | } | 1421 | } |
| 1445 | else if (EQ (AREF (menu_items, i), Qt) | 1422 | else if (EQ (AREF (menu_items, i), Qt) |
| @@ -1493,7 +1470,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, | |||
| 1493 | save_wv = wv; | 1470 | save_wv = wv; |
| 1494 | prev_wv = 0; | 1471 | prev_wv = 0; |
| 1495 | } | 1472 | } |
| 1496 | first_pane = 0; | 1473 | first_pane = false; |
| 1497 | i += MENU_ITEMS_PANE_LENGTH; | 1474 | i += MENU_ITEMS_PANE_LENGTH; |
| 1498 | } | 1475 | } |
| 1499 | else | 1476 | else |
| @@ -1688,7 +1665,7 @@ create_and_show_dialog (struct frame *f, widget_value *first_wv) | |||
| 1688 | gtk_widget_show_all (menu); | 1665 | gtk_widget_show_all (menu); |
| 1689 | 1666 | ||
| 1690 | /* Process events that apply to the menu. */ | 1667 | /* Process events that apply to the menu. */ |
| 1691 | popup_widget_loop (1, menu); | 1668 | popup_widget_loop (true, menu); |
| 1692 | 1669 | ||
| 1693 | unbind_to (specpdl_count, Qnil); | 1670 | unbind_to (specpdl_count, Qnil); |
| 1694 | } | 1671 | } |
| @@ -1725,7 +1702,7 @@ create_and_show_dialog (struct frame *f, widget_value *first_wv) | |||
| 1725 | apply_systemfont_to_dialog (f->output_data.x->widget); | 1702 | apply_systemfont_to_dialog (f->output_data.x->widget); |
| 1726 | #endif | 1703 | #endif |
| 1727 | lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, | 1704 | lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, |
| 1728 | f->output_data.x->widget, 1, 0, | 1705 | f->output_data.x->widget, true, 0, |
| 1729 | dialog_selection_callback, 0, 0); | 1706 | dialog_selection_callback, 0, 0); |
| 1730 | lw_modify_all_widgets (dialog_id, first_wv->contents, True); | 1707 | lw_modify_all_widgets (dialog_id, first_wv->contents, True); |
| 1731 | /* Display the dialog box. */ | 1708 | /* Display the dialog box. */ |
| @@ -1742,7 +1719,7 @@ create_and_show_dialog (struct frame *f, widget_value *first_wv) | |||
| 1742 | 1719 | ||
| 1743 | record_unwind_protect_int (pop_down_menu, (int) dialog_id); | 1720 | record_unwind_protect_int (pop_down_menu, (int) dialog_id); |
| 1744 | 1721 | ||
| 1745 | popup_get_selection (0, FRAME_DISPLAY_INFO (f), dialog_id, 1); | 1722 | popup_get_selection (0, FRAME_DISPLAY_INFO (f), dialog_id, true); |
| 1746 | 1723 | ||
| 1747 | unbind_to (count, Qnil); | 1724 | unbind_to (count, Qnil); |
| 1748 | } | 1725 | } |
| @@ -1765,8 +1742,8 @@ x_dialog_show (struct frame *f, Lisp_Object title, | |||
| 1765 | 1742 | ||
| 1766 | /* Number of elements seen so far, before boundary. */ | 1743 | /* Number of elements seen so far, before boundary. */ |
| 1767 | int left_count = 0; | 1744 | int left_count = 0; |
| 1768 | /* 1 means we've seen the boundary between left-hand elts and right-hand. */ | 1745 | /* Whether we've seen the boundary between left-hand elts and right-hand. */ |
| 1769 | int boundary_seen = 0; | 1746 | bool boundary_seen = false; |
| 1770 | 1747 | ||
| 1771 | ptrdiff_t specpdl_count = SPECPDL_INDEX (); | 1748 | ptrdiff_t specpdl_count = SPECPDL_INDEX (); |
| 1772 | 1749 | ||
| @@ -1813,7 +1790,7 @@ x_dialog_show (struct frame *f, Lisp_Object title, | |||
| 1813 | { | 1790 | { |
| 1814 | /* This is the boundary between left-side elts | 1791 | /* This is the boundary between left-side elts |
| 1815 | and right-side elts. Stop incrementing right_count. */ | 1792 | and right-side elts. Stop incrementing right_count. */ |
| 1816 | boundary_seen = 1; | 1793 | boundary_seen = true; |
| 1817 | i++; | 1794 | i++; |
| 1818 | continue; | 1795 | continue; |
| 1819 | } | 1796 | } |
| @@ -2099,7 +2076,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, | |||
| 2099 | if ((menuflags & MENU_KEYMAPS) && !NILP (prefix)) | 2076 | if ((menuflags & MENU_KEYMAPS) && !NILP (prefix)) |
| 2100 | pane_string++; | 2077 | pane_string++; |
| 2101 | 2078 | ||
| 2102 | lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, TRUE); | 2079 | lpane = XMenuAddPane (FRAME_X_DISPLAY (f), menu, pane_string, true); |
| 2103 | if (lpane == XM_FAILURE) | 2080 | if (lpane == XM_FAILURE) |
| 2104 | { | 2081 | { |
| 2105 | XMenuDestroy (FRAME_X_DISPLAY (f), menu); | 2082 | XMenuDestroy (FRAME_X_DISPLAY (f), menu); |
| @@ -2224,8 +2201,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, | |||
| 2224 | y += 1.5*height/(maxlines+2); | 2201 | y += 1.5*height/(maxlines+2); |
| 2225 | } | 2202 | } |
| 2226 | 2203 | ||
| 2227 | XMenuSetAEQ (menu, TRUE); | 2204 | XMenuSetAEQ (menu, true); |
| 2228 | XMenuSetFreeze (menu, TRUE); | 2205 | XMenuSetFreeze (menu, true); |
| 2229 | pane = selidx = 0; | 2206 | pane = selidx = 0; |
| 2230 | 2207 | ||
| 2231 | #ifndef MSDOS | 2208 | #ifndef MSDOS |
| @@ -43,14 +43,12 @@ DEF_DLL_FN (void, xmlFreeDoc, (xmlDocPtr)); | |||
| 43 | DEF_DLL_FN (void, xmlCleanupParser, (void)); | 43 | DEF_DLL_FN (void, xmlCleanupParser, (void)); |
| 44 | DEF_DLL_FN (void, xmlCheckVersion, (int)); | 44 | DEF_DLL_FN (void, xmlCheckVersion, (int)); |
| 45 | 45 | ||
| 46 | static int | 46 | static bool |
| 47 | libxml2_loaded_p (void) | 47 | libxml2_loaded_p (void) |
| 48 | { | 48 | { |
| 49 | Lisp_Object found = Fassq (Qlibxml2_dll, Vlibrary_cache); | 49 | Lisp_Object found = Fassq (Qlibxml2_dll, Vlibrary_cache); |
| 50 | 50 | ||
| 51 | if (CONSP (found)) | 51 | return CONSP (found) && EQ (XCDR (found), Qt); |
| 52 | return EQ (XCDR (found), Qt) ? 1 : 0; | ||
| 53 | return 0; | ||
| 54 | } | 52 | } |
| 55 | 53 | ||
| 56 | # undef htmlReadMemory | 54 | # undef htmlReadMemory |
| @@ -81,20 +79,20 @@ load_dll_functions (HMODULE library) | |||
| 81 | 79 | ||
| 82 | #else /* !WINDOWSNT */ | 80 | #else /* !WINDOWSNT */ |
| 83 | 81 | ||
| 84 | static int | 82 | static bool |
| 85 | libxml2_loaded_p (void) | 83 | libxml2_loaded_p (void) |
| 86 | { | 84 | { |
| 87 | return 1; | 85 | return true; |
| 88 | } | 86 | } |
| 89 | 87 | ||
| 90 | #endif /* !WINDOWSNT */ | 88 | #endif /* !WINDOWSNT */ |
| 91 | 89 | ||
| 92 | static int | 90 | static bool |
| 93 | init_libxml2_functions (void) | 91 | init_libxml2_functions (void) |
| 94 | { | 92 | { |
| 95 | #ifdef WINDOWSNT | 93 | #ifdef WINDOWSNT |
| 96 | if (libxml2_loaded_p ()) | 94 | if (libxml2_loaded_p ()) |
| 97 | return 1; | 95 | return true; |
| 98 | else | 96 | else |
| 99 | { | 97 | { |
| 100 | HMODULE library; | 98 | HMODULE library; |
| @@ -102,22 +100,22 @@ init_libxml2_functions (void) | |||
| 102 | if (!(library = w32_delayed_load (Qlibxml2_dll))) | 100 | if (!(library = w32_delayed_load (Qlibxml2_dll))) |
| 103 | { | 101 | { |
| 104 | message1 ("libxml2 library not found"); | 102 | message1 ("libxml2 library not found"); |
| 105 | return 0; | 103 | return false; |
| 106 | } | 104 | } |
| 107 | 105 | ||
| 108 | if (! load_dll_functions (library)) | 106 | if (! load_dll_functions (library)) |
| 109 | goto bad_library; | 107 | goto bad_library; |
| 110 | 108 | ||
| 111 | Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qt), Vlibrary_cache); | 109 | Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qt), Vlibrary_cache); |
| 112 | return 1; | 110 | return true; |
| 113 | } | 111 | } |
| 114 | 112 | ||
| 115 | bad_library: | 113 | bad_library: |
| 116 | Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qnil), Vlibrary_cache); | 114 | Vlibrary_cache = Fcons (Fcons (Qlibxml2_dll, Qnil), Vlibrary_cache); |
| 117 | 115 | ||
| 118 | return 0; | 116 | return false; |
| 119 | #else /* !WINDOWSNT */ | 117 | #else /* !WINDOWSNT */ |
| 120 | return 1; | 118 | return true; |
| 121 | #endif /* !WINDOWSNT */ | 119 | #endif /* !WINDOWSNT */ |
| 122 | } | 120 | } |
| 123 | 121 | ||
| @@ -177,7 +175,8 @@ make_dom (xmlNode *node) | |||
| 177 | } | 175 | } |
| 178 | 176 | ||
| 179 | static Lisp_Object | 177 | static Lisp_Object |
| 180 | parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments, int htmlp) | 178 | parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, |
| 179 | Lisp_Object discard_comments, bool htmlp) | ||
| 181 | { | 180 | { |
| 182 | xmlDoc *doc; | 181 | xmlDoc *doc; |
| 183 | Lisp_Object result = Qnil; | 182 | Lisp_Object result = Qnil; |
| @@ -263,7 +262,7 @@ If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */) | |||
| 263 | (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments) | 262 | (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments) |
| 264 | { | 263 | { |
| 265 | if (init_libxml2_functions ()) | 264 | if (init_libxml2_functions ()) |
| 266 | return parse_region (start, end, base_url, discard_comments, 1); | 265 | return parse_region (start, end, base_url, discard_comments, true); |
| 267 | return Qnil; | 266 | return Qnil; |
| 268 | } | 267 | } |
| 269 | 268 | ||
| @@ -276,7 +275,7 @@ If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */) | |||
| 276 | (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments) | 275 | (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, Lisp_Object discard_comments) |
| 277 | { | 276 | { |
| 278 | if (init_libxml2_functions ()) | 277 | if (init_libxml2_functions ()) |
| 279 | return parse_region (start, end, base_url, discard_comments, 0); | 278 | return parse_region (start, end, base_url, discard_comments, false); |
| 280 | return Qnil; | 279 | return Qnil; |
| 281 | } | 280 | } |
| 282 | 281 | ||
diff --git a/src/xrdb.c b/src/xrdb.c index f1176daa5ee..9e85e5a6277 100644 --- a/src/xrdb.c +++ b/src/xrdb.c | |||
| @@ -667,7 +667,7 @@ main (int argc, char **argv) | |||
| 667 | /* In a real program, you'd want to also do this: */ | 667 | /* In a real program, you'd want to also do this: */ |
| 668 | display->db = xdb; | 668 | display->db = xdb; |
| 669 | 669 | ||
| 670 | while (1) | 670 | while (true) |
| 671 | { | 671 | { |
| 672 | char query_name[90]; | 672 | char query_name[90]; |
| 673 | char query_class[90]; | 673 | char query_class[90]; |
diff --git a/src/xsettings.c b/src/xsettings.c index 8dbc7d990fe..028487b91ee 100644 --- a/src/xsettings.c +++ b/src/xsettings.c | |||
| @@ -804,7 +804,7 @@ init_gsettings (void) | |||
| 804 | GSettingsSchema *sc = g_settings_schema_source_lookup | 804 | GSettingsSchema *sc = g_settings_schema_source_lookup |
| 805 | (g_settings_schema_source_get_default (), | 805 | (g_settings_schema_source_get_default (), |
| 806 | GSETTINGS_SCHEMA, | 806 | GSETTINGS_SCHEMA, |
| 807 | TRUE); | 807 | true); |
| 808 | schema_found = sc != NULL; | 808 | schema_found = sc != NULL; |
| 809 | if (sc) g_settings_schema_unref (sc); | 809 | if (sc) g_settings_schema_unref (sc); |
| 810 | } | 810 | } |
diff --git a/src/xterm.c b/src/xterm.c index 9a87a1ee49c..40043dc9430 100644 --- a/src/xterm.c +++ b/src/xterm.c | |||
| @@ -3051,7 +3051,7 @@ XTflash (struct frame *f) | |||
| 3051 | gc = gdk_gc_new_with_values (window, | 3051 | gc = gdk_gc_new_with_values (window, |
| 3052 | &vals, GDK_GC_FUNCTION | GDK_GC_FOREGROUND); | 3052 | &vals, GDK_GC_FUNCTION | GDK_GC_FOREGROUND); |
| 3053 | #define XFillRectangle(d, win, gc, x, y, w, h) \ | 3053 | #define XFillRectangle(d, win, gc, x, y, w, h) \ |
| 3054 | gdk_draw_rectangle (window, gc, TRUE, x, y, w, h) | 3054 | gdk_draw_rectangle (window, gc, true, x, y, w, h) |
| 3055 | #endif /* ! HAVE_GTK3 */ | 3055 | #endif /* ! HAVE_GTK3 */ |
| 3056 | #else /* ! USE_GTK */ | 3056 | #else /* ! USE_GTK */ |
| 3057 | GC gc; | 3057 | GC gc; |
| @@ -4604,7 +4604,7 @@ xg_scroll_callback (GtkRange *range, | |||
| 4604 | GtkAdjustment *adj = GTK_ADJUSTMENT (gtk_range_get_adjustment (range)); | 4604 | GtkAdjustment *adj = GTK_ADJUSTMENT (gtk_range_get_adjustment (range)); |
| 4605 | struct frame *f = g_object_get_data (G_OBJECT (range), XG_FRAME_DATA); | 4605 | struct frame *f = g_object_get_data (G_OBJECT (range), XG_FRAME_DATA); |
| 4606 | 4606 | ||
| 4607 | if (xg_ignore_gtk_scrollbar) return FALSE; | 4607 | if (xg_ignore_gtk_scrollbar) return false; |
| 4608 | 4608 | ||
| 4609 | switch (scroll) | 4609 | switch (scroll) |
| 4610 | { | 4610 | { |
| @@ -4660,7 +4660,7 @@ xg_scroll_callback (GtkRange *range, | |||
| 4660 | bar->horizontal); | 4660 | bar->horizontal); |
| 4661 | } | 4661 | } |
| 4662 | 4662 | ||
| 4663 | return FALSE; | 4663 | return false; |
| 4664 | } | 4664 | } |
| 4665 | 4665 | ||
| 4666 | /* Callback for button release. Sets dragging to -1 when dragging is done. */ | 4666 | /* Callback for button release. Sets dragging to -1 when dragging is done. */ |
| @@ -4679,7 +4679,7 @@ xg_end_scroll_callback (GtkWidget *widget, | |||
| 4679 | window_being_scrolled = Qnil; | 4679 | window_being_scrolled = Qnil; |
| 4680 | } | 4680 | } |
| 4681 | 4681 | ||
| 4682 | return FALSE; | 4682 | return false; |
| 4683 | } | 4683 | } |
| 4684 | 4684 | ||
| 4685 | 4685 | ||
diff --git a/src/xterm.h b/src/xterm.h index f2aff72e3ac..123f31cda7b 100644 --- a/src/xterm.h +++ b/src/xterm.h | |||
| @@ -1099,7 +1099,7 @@ extern Lisp_Object xw_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); | |||
| 1099 | #endif | 1099 | #endif |
| 1100 | 1100 | ||
| 1101 | #if defined USE_GTK || defined USE_MOTIF | 1101 | #if defined USE_GTK || defined USE_MOTIF |
| 1102 | extern void x_menu_set_in_use (int); | 1102 | extern void x_menu_set_in_use (bool); |
| 1103 | #endif | 1103 | #endif |
| 1104 | extern void x_menu_wait_for_event (void *data); | 1104 | extern void x_menu_wait_for_event (void *data); |
| 1105 | extern void initialize_frame_menubar (struct frame *); | 1105 | extern void initialize_frame_menubar (struct frame *); |
diff --git a/test/ChangeLog b/test/ChangeLog index 83bb8bf00c7..a33ec8793f4 100644 --- a/test/ChangeLog +++ b/test/ChangeLog | |||
| @@ -1,3 +1,14 @@ | |||
| 1 | 2015-01-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * automated/eieio-test-methodinvoke.el (eieio-test-method-store): Add | ||
| 4 | keysym arg instead of relying on internal var eieio--generic-call-key. | ||
| 5 | Update all callers. | ||
| 6 | (eieio-test-cl-generic-1): New tests. | ||
| 7 | |||
| 8 | 2015-01-14 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 9 | |||
| 10 | * automated/cl-generic-tests.el: New file. | ||
| 11 | |||
| 1 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | 12 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 13 | ||
| 3 | * automated/eieio-tests.el (eieio-test-23-inheritance-check): Don't use | 14 | * automated/eieio-tests.el (eieio-test-23-inheritance-check): Don't use |
diff --git a/test/automated/cl-generic-tests.el b/test/automated/cl-generic-tests.el new file mode 100644 index 00000000000..17bce6a3157 --- /dev/null +++ b/test/automated/cl-generic-tests.el | |||
| @@ -0,0 +1,133 @@ | |||
| 1 | ;;; cl-generic-tests.el --- Tests for cl-generic.el functionality -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2015 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 12 | ;; (at your option) any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 21 | |||
| 22 | ;;; Commentary: | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | |||
| 26 | (require 'ert) | ||
| 27 | (require 'cl-lib) | ||
| 28 | |||
| 29 | (cl-defgeneric cl--generic-1 (x y)) | ||
| 30 | (cl-defgeneric (setf cl--generic-1) (v y z) "My generic doc.") | ||
| 31 | |||
| 32 | (ert-deftest cl-generic-test-0 () | ||
| 33 | (cl-defgeneric cl--generic-1 (x y)) | ||
| 34 | (cl-defmethod cl--generic-1 ((x t) y) (cons x y)) | ||
| 35 | (should (equal (cl--generic-1 'a 'b) '(a . b)))) | ||
| 36 | |||
| 37 | (ert-deftest cl-generic-test-1-eql () | ||
| 38 | (cl-defgeneric cl--generic-1 (x y)) | ||
| 39 | (cl-defmethod cl--generic-1 ((x t) y) (cons x y)) | ||
| 40 | (cl-defmethod cl--generic-1 ((_x (eql 4)) _y) | ||
| 41 | (cons "quatre" (cl-call-next-method))) | ||
| 42 | (cl-defmethod cl--generic-1 ((_x (eql 5)) _y) | ||
| 43 | (cons "cinq" (cl-call-next-method))) | ||
| 44 | (cl-defmethod cl--generic-1 ((_x (eql 6)) y) | ||
| 45 | (cons "six" (cl-call-next-method 'a y))) | ||
| 46 | (should (equal (cl--generic-1 'a nil) '(a))) | ||
| 47 | (should (equal (cl--generic-1 4 nil) '("quatre" 4))) | ||
| 48 | (should (equal (cl--generic-1 5 nil) '("cinq" 5))) | ||
| 49 | (should (equal (cl--generic-1 6 nil) '("six" a)))) | ||
| 50 | |||
| 51 | (cl-defstruct cl-generic-struct-parent a b) | ||
| 52 | (cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c) | ||
| 53 | (cl-defstruct (cl-generic-struct-child11 (:include cl-generic-struct-child1)) d) | ||
| 54 | (cl-defstruct (cl-generic-struct-child2 (:include cl-generic-struct-parent)) e) | ||
| 55 | |||
| 56 | (ert-deftest cl-generic-test-2-struct () | ||
| 57 | (cl-defgeneric cl--generic-1 (x y) "My doc.") | ||
| 58 | (cl-defmethod cl--generic-1 ((x t) y) "Doc 1." (cons x y)) | ||
| 59 | (cl-defmethod cl--generic-1 ((_x cl-generic-struct-parent) y) | ||
| 60 | "Doc 2." (cons "parent" (cl-call-next-method 'a y))) | ||
| 61 | (cl-defmethod cl--generic-1 ((_x cl-generic-struct-child1) _y) | ||
| 62 | (cons "child1" (cl-call-next-method))) | ||
| 63 | (cl-defmethod cl--generic-1 :around ((_x t) _y) | ||
| 64 | (cons "around" (cl-call-next-method))) | ||
| 65 | (cl-defmethod cl--generic-1 :around ((_x cl-generic-struct-child11) _y) | ||
| 66 | (cons "child11" (cl-call-next-method))) | ||
| 67 | (cl-defmethod cl--generic-1 ((_x cl-generic-struct-child2) _y) | ||
| 68 | (cons "child2" (cl-call-next-method))) | ||
| 69 | (should (equal (cl--generic-1 (make-cl-generic-struct-child1) nil) | ||
| 70 | '("around" "child1" "parent" a))) | ||
| 71 | (should (equal (cl--generic-1 (make-cl-generic-struct-child2) nil) | ||
| 72 | '("around""child2" "parent" a))) | ||
| 73 | (should (equal (cl--generic-1 (make-cl-generic-struct-child11) nil) | ||
| 74 | '("child11" "around""child1" "parent" a)))) | ||
| 75 | |||
| 76 | (ert-deftest cl-generic-test-3-setf () | ||
| 77 | (cl-defmethod (setf cl--generic-1) (v (y t) z) (list v y z)) | ||
| 78 | (cl-defmethod (setf cl--generic-1) (v (_y (eql 4)) z) (list v "four" z)) | ||
| 79 | (should (equal (setf (cl--generic-1 'a 'b) 'v) '(v a b))) | ||
| 80 | (should (equal (setf (cl--generic-1 4 'b) 'v) '(v "four" b))) | ||
| 81 | (let ((x ())) | ||
| 82 | (should (equal (setf (cl--generic-1 (progn (push 1 x) 'a) | ||
| 83 | (progn (push 2 x) 'b)) | ||
| 84 | (progn (push 3 x) 'v)) | ||
| 85 | '(v a b))) | ||
| 86 | (should (equal x '(3 2 1))))) | ||
| 87 | |||
| 88 | (ert-deftest cl-generic-test-4-overlapping-tagcodes () | ||
| 89 | (cl-defgeneric cl--generic-1 (x y) "My doc.") | ||
| 90 | (cl-defmethod cl--generic-1 ((y t) z) (list y z)) | ||
| 91 | (cl-defmethod cl--generic-1 ((_y (eql 4)) _z) | ||
| 92 | (cons "four" (cl-call-next-method))) | ||
| 93 | (cl-defmethod cl--generic-1 ((_y integer) _z) | ||
| 94 | (cons "integer" (cl-call-next-method))) | ||
| 95 | (cl-defmethod cl--generic-1 ((_y number) _z) | ||
| 96 | (cons "number" (cl-call-next-method))) | ||
| 97 | (should (equal (cl--generic-1 'a 'b) '(a b))) | ||
| 98 | (should (equal (cl--generic-1 1 'b) '("integer" "number" 1 b))) | ||
| 99 | (should (equal (cl--generic-1 4 'b) '("four" "integer" "number" 4 b)))) | ||
| 100 | |||
| 101 | (ert-deftest cl-generic-test-5-alias () | ||
| 102 | (cl-defgeneric cl--generic-1 (x y) "My doc.") | ||
| 103 | (defalias 'cl--generic-2 #'cl--generic-1) | ||
| 104 | (cl-defmethod cl--generic-1 ((y t) z) (list y z)) | ||
| 105 | (cl-defmethod cl--generic-2 ((_y (eql 4)) _z) | ||
| 106 | (cons "four" (cl-call-next-method))) | ||
| 107 | (should (equal (cl--generic-1 4 'b) '("four" 4 b)))) | ||
| 108 | |||
| 109 | (ert-deftest cl-generic-test-6-multiple-dispatch () | ||
| 110 | (cl-defgeneric cl--generic-1 (x y) "My doc.") | ||
| 111 | (cl-defmethod cl--generic-1 (x y) (list x y)) | ||
| 112 | (cl-defmethod cl--generic-1 (_x (_y integer)) | ||
| 113 | (cons "y-int" (cl-call-next-method))) | ||
| 114 | (cl-defmethod cl--generic-1 ((_x integer) _y) | ||
| 115 | (cons "x-int" (cl-call-next-method))) | ||
| 116 | (cl-defmethod cl--generic-1 ((_x integer) (_y integer)) | ||
| 117 | (cons "x&y-int" (cl-call-next-method))) | ||
| 118 | (should (equal (cl--generic-1 1 2) '("x&y-int" "x-int" "y-int" 1 2)))) | ||
| 119 | |||
| 120 | (ert-deftest cl-generic-test-7-apo () | ||
| 121 | (cl-defgeneric cl--generic-1 (x y) | ||
| 122 | (:documentation "My doc.") (:argument-precedence-order y x)) | ||
| 123 | (cl-defmethod cl--generic-1 (x y) (list x y)) | ||
| 124 | (cl-defmethod cl--generic-1 (_x (_y integer)) | ||
| 125 | (cons "y-int" (cl-call-next-method))) | ||
| 126 | (cl-defmethod cl--generic-1 ((_x integer) _y) | ||
| 127 | (cons "x-int" (cl-call-next-method))) | ||
| 128 | (cl-defmethod cl--generic-1 ((_x integer) (_y integer)) | ||
| 129 | (cons "x&y-int" (cl-call-next-method))) | ||
| 130 | (should (equal (cl--generic-1 1 2) '("x&y-int" "y-int" "x-int" 1 2)))) | ||
| 131 | |||
| 132 | (provide 'cl-generic-tests) | ||
| 133 | ;;; cl-generic-tests.el ends here | ||
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el index 2de836ceda5..6362fc5a8d9 100644 --- a/test/automated/eieio-test-methodinvoke.el +++ b/test/automated/eieio-test-methodinvoke.el | |||
| @@ -58,12 +58,10 @@ | |||
| 58 | (defvar eieio-test-method-order-list nil | 58 | (defvar eieio-test-method-order-list nil |
| 59 | "List of symbols stored during method invocation.") | 59 | "List of symbols stored during method invocation.") |
| 60 | 60 | ||
| 61 | (defun eieio-test-method-store () | 61 | (defun eieio-test-method-store (keysym) |
| 62 | "Store current invocation class symbol in the invocation order list." | 62 | "Store current invocation class symbol in the invocation order list." |
| 63 | (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ] | 63 | ;; FIXME: Don't depend on `eieio--scoped-class'! |
| 64 | (or eieio--generic-call-key 0))) | 64 | (let* ((c (list keysym (eieio--class-symbol (eieio--scoped-class))))) |
| 65 | ;; FIXME: Don't depend on `eieio--scoped-class'! | ||
| 66 | (c (list keysym (eieio--class-symbol (eieio--scoped-class))))) | ||
| 67 | (push c eieio-test-method-order-list))) | 65 | (push c eieio-test-method-order-list))) |
| 68 | 66 | ||
| 69 | (defun eieio-test-match (rightanswer) | 67 | (defun eieio-test-match (rightanswer) |
| @@ -88,36 +86,36 @@ | |||
| 88 | (defclass eitest-B (eitest-B-base1 eitest-B-base2) ()) | 86 | (defclass eitest-B (eitest-B-base1 eitest-B-base2) ()) |
| 89 | 87 | ||
| 90 | (defmethod eitest-F :BEFORE ((p eitest-B-base1)) | 88 | (defmethod eitest-F :BEFORE ((p eitest-B-base1)) |
| 91 | (eieio-test-method-store)) | 89 | (eieio-test-method-store :BEFORE)) |
| 92 | 90 | ||
| 93 | (defmethod eitest-F :BEFORE ((p eitest-B-base2)) | 91 | (defmethod eitest-F :BEFORE ((p eitest-B-base2)) |
| 94 | (eieio-test-method-store)) | 92 | (eieio-test-method-store :BEFORE)) |
| 95 | 93 | ||
| 96 | (defmethod eitest-F :BEFORE ((p eitest-B)) | 94 | (defmethod eitest-F :BEFORE ((p eitest-B)) |
| 97 | (eieio-test-method-store)) | 95 | (eieio-test-method-store :BEFORE)) |
| 98 | 96 | ||
| 99 | (defmethod eitest-F ((p eitest-B)) | 97 | (defmethod eitest-F ((p eitest-B)) |
| 100 | (eieio-test-method-store) | 98 | (eieio-test-method-store :PRIMARY) |
| 101 | (call-next-method)) | 99 | (call-next-method)) |
| 102 | 100 | ||
| 103 | (defmethod eitest-F ((p eitest-B-base1)) | 101 | (defmethod eitest-F ((p eitest-B-base1)) |
| 104 | (eieio-test-method-store) | 102 | (eieio-test-method-store :PRIMARY) |
| 105 | (call-next-method)) | 103 | (call-next-method)) |
| 106 | 104 | ||
| 107 | (defmethod eitest-F ((p eitest-B-base2)) | 105 | (defmethod eitest-F ((p eitest-B-base2)) |
| 108 | (eieio-test-method-store) | 106 | (eieio-test-method-store :PRIMARY) |
| 109 | (when (next-method-p) | 107 | (when (next-method-p) |
| 110 | (call-next-method)) | 108 | (call-next-method)) |
| 111 | ) | 109 | ) |
| 112 | 110 | ||
| 113 | (defmethod eitest-F :AFTER ((p eitest-B-base1)) | 111 | (defmethod eitest-F :AFTER ((p eitest-B-base1)) |
| 114 | (eieio-test-method-store)) | 112 | (eieio-test-method-store :AFTER)) |
| 115 | 113 | ||
| 116 | (defmethod eitest-F :AFTER ((p eitest-B-base2)) | 114 | (defmethod eitest-F :AFTER ((p eitest-B-base2)) |
| 117 | (eieio-test-method-store)) | 115 | (eieio-test-method-store :AFTER)) |
| 118 | 116 | ||
| 119 | (defmethod eitest-F :AFTER ((p eitest-B)) | 117 | (defmethod eitest-F :AFTER ((p eitest-B)) |
| 120 | (eieio-test-method-store)) | 118 | (eieio-test-method-store :AFTER)) |
| 121 | 119 | ||
| 122 | (ert-deftest eieio-test-method-order-list-3 () | 120 | (ert-deftest eieio-test-method-order-list-3 () |
| 123 | (let ((eieio-test-method-order-list nil) | 121 | (let ((eieio-test-method-order-list nil) |
| @@ -152,15 +150,15 @@ | |||
| 152 | ;;; Return value from :PRIMARY | 150 | ;;; Return value from :PRIMARY |
| 153 | ;; | 151 | ;; |
| 154 | (defmethod eitest-I :BEFORE ((a eitest-A)) | 152 | (defmethod eitest-I :BEFORE ((a eitest-A)) |
| 155 | (eieio-test-method-store) | 153 | (eieio-test-method-store :BEFORE) |
| 156 | ":before") | 154 | ":before") |
| 157 | 155 | ||
| 158 | (defmethod eitest-I :PRIMARY ((a eitest-A)) | 156 | (defmethod eitest-I :PRIMARY ((a eitest-A)) |
| 159 | (eieio-test-method-store) | 157 | (eieio-test-method-store :PRIMARY) |
| 160 | ":primary") | 158 | ":primary") |
| 161 | 159 | ||
| 162 | (defmethod eitest-I :AFTER ((a eitest-A)) | 160 | (defmethod eitest-I :AFTER ((a eitest-A)) |
| 163 | (eieio-test-method-store) | 161 | (eieio-test-method-store :AFTER) |
| 164 | ":after") | 162 | ":after") |
| 165 | 163 | ||
| 166 | (ert-deftest eieio-test-method-order-list-5 () | 164 | (ert-deftest eieio-test-method-order-list-5 () |
| @@ -179,17 +177,17 @@ | |||
| 179 | 177 | ||
| 180 | ;; Just use the obsolete name once, to make sure it also works. | 178 | ;; Just use the obsolete name once, to make sure it also works. |
| 181 | (defmethod constructor :STATIC ((p C-base1) &rest args) | 179 | (defmethod constructor :STATIC ((p C-base1) &rest args) |
| 182 | (eieio-test-method-store) | 180 | (eieio-test-method-store :STATIC) |
| 183 | (if (next-method-p) (call-next-method)) | 181 | (if (next-method-p) (call-next-method)) |
| 184 | ) | 182 | ) |
| 185 | 183 | ||
| 186 | (defmethod eieio-constructor :STATIC ((p C-base2) &rest args) | 184 | (defmethod eieio-constructor :STATIC ((p C-base2) &rest args) |
| 187 | (eieio-test-method-store) | 185 | (eieio-test-method-store :STATIC) |
| 188 | (if (next-method-p) (call-next-method)) | 186 | (if (next-method-p) (call-next-method)) |
| 189 | ) | 187 | ) |
| 190 | 188 | ||
| 191 | (defmethod eieio-constructor :STATIC ((p C) &rest args) | 189 | (defmethod eieio-constructor :STATIC ((p C) &rest args) |
| 192 | (eieio-test-method-store) | 190 | (eieio-test-method-store :STATIC) |
| 193 | (call-next-method) | 191 | (call-next-method) |
| 194 | ) | 192 | ) |
| 195 | 193 | ||
| @@ -216,24 +214,24 @@ | |||
| 216 | 214 | ||
| 217 | (defmethod eitest-F ((p D)) | 215 | (defmethod eitest-F ((p D)) |
| 218 | "D" | 216 | "D" |
| 219 | (eieio-test-method-store) | 217 | (eieio-test-method-store :PRIMARY) |
| 220 | (call-next-method)) | 218 | (call-next-method)) |
| 221 | 219 | ||
| 222 | (defmethod eitest-F ((p D-base0)) | 220 | (defmethod eitest-F ((p D-base0)) |
| 223 | "D-base0" | 221 | "D-base0" |
| 224 | (eieio-test-method-store) | 222 | (eieio-test-method-store :PRIMARY) |
| 225 | ;; This should have no next | 223 | ;; This should have no next |
| 226 | ;; (when (next-method-p) (call-next-method)) | 224 | ;; (when (next-method-p) (call-next-method)) |
| 227 | ) | 225 | ) |
| 228 | 226 | ||
| 229 | (defmethod eitest-F ((p D-base1)) | 227 | (defmethod eitest-F ((p D-base1)) |
| 230 | "D-base1" | 228 | "D-base1" |
| 231 | (eieio-test-method-store) | 229 | (eieio-test-method-store :PRIMARY) |
| 232 | (call-next-method)) | 230 | (call-next-method)) |
| 233 | 231 | ||
| 234 | (defmethod eitest-F ((p D-base2)) | 232 | (defmethod eitest-F ((p D-base2)) |
| 235 | "D-base2" | 233 | "D-base2" |
| 236 | (eieio-test-method-store) | 234 | (eieio-test-method-store :PRIMARY) |
| 237 | (when (next-method-p) | 235 | (when (next-method-p) |
| 238 | (call-next-method)) | 236 | (call-next-method)) |
| 239 | ) | 237 | ) |
| @@ -258,21 +256,21 @@ | |||
| 258 | (defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first) | 256 | (defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first) |
| 259 | 257 | ||
| 260 | (defmethod eitest-F ((p E)) | 258 | (defmethod eitest-F ((p E)) |
| 261 | (eieio-test-method-store) | 259 | (eieio-test-method-store :PRIMARY) |
| 262 | (call-next-method)) | 260 | (call-next-method)) |
| 263 | 261 | ||
| 264 | (defmethod eitest-F ((p E-base0)) | 262 | (defmethod eitest-F ((p E-base0)) |
| 265 | (eieio-test-method-store) | 263 | (eieio-test-method-store :PRIMARY) |
| 266 | ;; This should have no next | 264 | ;; This should have no next |
| 267 | ;; (when (next-method-p) (call-next-method)) | 265 | ;; (when (next-method-p) (call-next-method)) |
| 268 | ) | 266 | ) |
| 269 | 267 | ||
| 270 | (defmethod eitest-F ((p E-base1)) | 268 | (defmethod eitest-F ((p E-base1)) |
| 271 | (eieio-test-method-store) | 269 | (eieio-test-method-store :PRIMARY) |
| 272 | (call-next-method)) | 270 | (call-next-method)) |
| 273 | 271 | ||
| 274 | (defmethod eitest-F ((p E-base2)) | 272 | (defmethod eitest-F ((p E-base2)) |
| 275 | (eieio-test-method-store) | 273 | (eieio-test-method-store :PRIMARY) |
| 276 | (when (next-method-p) | 274 | (when (next-method-p) |
| 277 | (call-next-method)) | 275 | (call-next-method)) |
| 278 | ) | 276 | ) |
| @@ -380,3 +378,21 @@ | |||
| 380 | '(CNM-1-1 CNM-2 INIT))) | 378 | '(CNM-1-1 CNM-2 INIT))) |
| 381 | (should (equal (eieio-test-arguments-for 'CNM-2) | 379 | (should (equal (eieio-test-arguments-for 'CNM-2) |
| 382 | '(INIT))))) | 380 | '(INIT))))) |
| 381 | |||
| 382 | ;;; Check cl-generic integration. | ||
| 383 | |||
| 384 | (cl-defgeneric eieio-test--1 (x y)) | ||
| 385 | |||
| 386 | (ert-deftest eieio-test-cl-generic-1 () | ||
| 387 | (cl-defmethod eieio-test--1 (x y) (list x y)) | ||
| 388 | (cl-defmethod eieio-test--1 ((_x CNM-0) y) | ||
| 389 | (cons "CNM-0" (cl-call-next-method 7 y))) | ||
| 390 | (cl-defmethod eieio-test--1 ((_x CNM-1-1) _y) | ||
| 391 | (cons "CNM-1-1" (cl-call-next-method))) | ||
| 392 | (cl-defmethod eieio-test--1 ((_x CNM-1-2) y) | ||
| 393 | (cons "CNM-1-2" (cl-call-next-method))) | ||
| 394 | (should (equal (eieio-test--1 4 5) '(4 5))) | ||
| 395 | (should (equal (eieio-test--1 (make-instance 'CNM-0) 5) | ||
| 396 | '("CNM-0" 7 5))) | ||
| 397 | (should (equal (eieio-test--1 (make-instance 'CNM-2) 5) | ||
| 398 | '("CNM-1-1" "CNM-1-2" "CNM-0" 7 5)))) | ||