diff options
| author | Joakim Verona | 2015-01-11 18:40:21 +0100 |
|---|---|---|
| committer | Joakim Verona | 2015-01-11 18:40:21 +0100 |
| commit | cc7cb20d6abc0f862e5513b24831bba0eaecaa5f (patch) | |
| tree | afc2fc05401504aa0c28699dc3bc155c5b0d7f58 | |
| parent | d972b504f30ff4300ba368940751e8736dddf0b4 (diff) | |
| parent | 9a57bda31569294ecaf8138a06e5edda9c0d87e3 (diff) | |
| download | emacs-cc7cb20d6abc0f862e5513b24831bba0eaecaa5f.tar.gz emacs-cc7cb20d6abc0f862e5513b24831bba0eaecaa5f.zip | |
merge master, fix conflicts
169 files changed, 4079 insertions, 4360 deletions
| @@ -1,3 +1,22 @@ | |||
| 1 | 2015-01-11 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Default to 'configure --enable-silent-rules' | ||
| 4 | This greatly shortens the 'make' output, making it more readable | ||
| 5 | and useful. For example, on my platform it shortens a | ||
| 6 | 4125-character line "gcc -std=gnu99 -c -Demacs -I. -I. -I../lib | ||
| 7 | ... emacs.c" -- a line so long that it's hard to see what's going | ||
| 8 | on or where the diagnostics are -- to just "CC emacs.o". | ||
| 9 | * INSTALL: Document this. | ||
| 10 | * configure.ac: Add AM_SILENT_RULES([yes]). | ||
| 11 | (AM_DEFAULT_VERBOSITY): Remove now-unnecessary initialization. | ||
| 12 | Fixes: bug#19501 | ||
| 13 | |||
| 14 | 2015-01-06 Paul Eggert <eggert@cs.ucla.edu> | ||
| 15 | |||
| 16 | Merge from gnulib | ||
| 17 | * lib/stdio.in.h, m4/stdio_h.m4: Update from gnulib, incorporating: | ||
| 18 | 2015-01-05 stdio: fix use of PRIdMAX on modern mingw | ||
| 19 | |||
| 1 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> | 20 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 21 | ||
| 3 | * INSTALL: Mention 'make WERROR_CFLAGS='. | 22 | * INSTALL: Mention 'make WERROR_CFLAGS='. |
| @@ -316,10 +316,9 @@ generated warnings may still be useful, though you may prefer building | |||
| 316 | with 'make WERROR_CFLAGS=' so that the warnings are not treated as | 316 | with 'make WERROR_CFLAGS=' so that the warnings are not treated as |
| 317 | errors. | 317 | errors. |
| 318 | 318 | ||
| 319 | Use --enable-silent-rules to cause 'make' to chatter less. This is | 319 | Use --disable-silent-rules to cause 'make' to give more details about |
| 320 | helpful when combined with options like --enable-gcc-warnings that | 320 | the commands it executes. This can be helpful when debugging a build |
| 321 | generate long shell-command lines. 'make V=0' also suppresses the | 321 | that goes awry. 'make V=1' also enables the extra chatter. |
| 322 | chatter. | ||
| 323 | 322 | ||
| 324 | Use --enable-link-time-optimization to enable link-time optimizer. If | 323 | Use --enable-link-time-optimization to enable link-time optimizer. If |
| 325 | you're using GNU compiler, this feature is supported since version 4.5.0. | 324 | you're using GNU compiler, this feature is supported since version 4.5.0. |
diff --git a/admin/ChangeLog b/admin/ChangeLog index 8c0c9759e87..dc029a0be0c 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2015-01-08 Glenn Morris <rgm@gnu.org> | ||
| 2 | |||
| 3 | * authors.el (authors-aliases): Add an entry to ignore. | ||
| 4 | |||
| 1 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> | 5 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 6 | ||
| 3 | Less 'make' chatter for admin/grammars | 7 | Less 'make' chatter for admin/grammars |
diff --git a/admin/authors.el b/admin/authors.el index 1249806686a..afab6f0e1e8 100644 --- a/admin/authors.el +++ b/admin/authors.el | |||
| @@ -40,6 +40,7 @@ files.") | |||
| 40 | 40 | ||
| 41 | (defconst authors-aliases | 41 | (defconst authors-aliases |
| 42 | '( | 42 | '( |
| 43 | (nil "A\\. N\\. Other") ; unknown author 2014-12-03, later removed | ||
| 43 | ("Aaron S. Hawley" "Aaron Hawley") | 44 | ("Aaron S. Hawley" "Aaron Hawley") |
| 44 | ("Alexandru Harsanyi" "Alex Harsanyi") | 45 | ("Alexandru Harsanyi" "Alex Harsanyi") |
| 45 | ("Andrew Csillag" "Drew Csillag") | 46 | ("Andrew Csillag" "Drew Csillag") |
diff --git a/configure.ac b/configure.ac index 3e2a6006a27..1b2dd3dbd31 100644 --- a/configure.ac +++ b/configure.ac | |||
| @@ -1013,9 +1013,11 @@ if test "${enableval}" != "no"; then | |||
| 1013 | fi | 1013 | fi |
| 1014 | fi) | 1014 | fi) |
| 1015 | 1015 | ||
| 1016 | dnl Prefer silent make output. For verbose output, use | ||
| 1017 | dnl 'configure --disable-silent-rules' or 'make V=1' . | ||
| 1018 | AM_SILENT_RULES([yes]) | ||
| 1016 | dnl Port to Automake 1.11. | 1019 | dnl Port to Automake 1.11. |
| 1017 | dnl This section can be removed once we assume Automake 1.14 or later. | 1020 | dnl This section can be removed once we assume Automake 1.14 or later. |
| 1018 | : ${AM_DEFAULT_VERBOSITY=1} | ||
| 1019 | : ${AM_V=$AM_DEFAULT_VERBOSITY} | 1021 | : ${AM_V=$AM_DEFAULT_VERBOSITY} |
| 1020 | : ${AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY} | 1022 | : ${AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY} |
| 1021 | AC_SUBST([AM_V]) | 1023 | AC_SUBST([AM_V]) |
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index ffe6d7da6d4..1b7f21da282 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi | |||
| @@ -87,10 +87,7 @@ waiting for input. | |||
| 87 | @defun redisplay &optional force | 87 | @defun redisplay &optional force |
| 88 | This function tries immediately to redisplay. The optional argument | 88 | This function tries immediately to redisplay. The optional argument |
| 89 | @var{force}, if non-@code{nil}, forces the redisplay to be performed, | 89 | @var{force}, if non-@code{nil}, forces the redisplay to be performed, |
| 90 | instead of being preempted, even if input is pending and the variable | 90 | instead of being preempted if input is pending. |
| 91 | @code{redisplay-dont-pause} is @code{nil} (see below). If | ||
| 92 | @code{redisplay-dont-pause} is non-@code{nil} (the default), this | ||
| 93 | function redisplays in any case, i.e., @var{force} does nothing. | ||
| 94 | 91 | ||
| 95 | The function returns @code{t} if it actually tried to redisplay, and | 92 | The function returns @code{t} if it actually tried to redisplay, and |
| 96 | @code{nil} otherwise. A value of @code{t} does not mean that | 93 | @code{nil} otherwise. A value of @code{t} does not mean that |
| @@ -98,28 +95,6 @@ redisplay proceeded to completion; it could have been preempted by | |||
| 98 | newly arriving input. | 95 | newly arriving input. |
| 99 | @end defun | 96 | @end defun |
| 100 | 97 | ||
| 101 | @defvar redisplay-dont-pause | ||
| 102 | If this variable is @code{nil}, arriving input events preempt | ||
| 103 | redisplay; Emacs avoids starting a redisplay, and stops any redisplay | ||
| 104 | that is in progress, until the input has been processed. In | ||
| 105 | particular, @code{(redisplay)} returns @code{nil} without actually | ||
| 106 | redisplaying, if there is pending input. | ||
| 107 | |||
| 108 | The default value is @code{t}, which means that pending input does not | ||
| 109 | preempt redisplay. | ||
| 110 | @end defvar | ||
| 111 | |||
| 112 | @defvar redisplay-preemption-period | ||
| 113 | If @code{redisplay-dont-pause} is @code{nil}, this variable specifies | ||
| 114 | how many seconds Emacs waits between checks for new input during | ||
| 115 | redisplay; if input arrives during this interval, redisplay stops and | ||
| 116 | the input is processed. The default value is 0.1; if the value is | ||
| 117 | @code{nil}, Emacs does not check for input during redisplay. | ||
| 118 | |||
| 119 | This variable has no effect when @code{redisplay-dont-pause} is | ||
| 120 | non-@code{nil} (the default). | ||
| 121 | @end defvar | ||
| 122 | |||
| 123 | @defvar pre-redisplay-function | 98 | @defvar pre-redisplay-function |
| 124 | A function run just before redisplay. It is called with one argument, | 99 | A function run just before redisplay. It is called with one argument, |
| 125 | the set of windows to redisplay. | 100 | the set of windows to redisplay. |
diff --git a/etc/ChangeLog b/etc/ChangeLog index c72c560ec9c..20f88bdecc3 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog | |||
| @@ -1,3 +1,12 @@ | |||
| 1 | 2015-01-11 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Default to 'configure --enable-silent-rules' | ||
| 4 | * NEWS: Document this. | ||
| 5 | |||
| 6 | 2015-01-10 Daniel Colascione <dancol@dancol.org> | ||
| 7 | |||
| 8 | * NEWS: Fix typo | ||
| 9 | |||
| 1 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> | 10 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 11 | ||
| 3 | batch write-region no longer says "Wrote FOO" | 12 | batch write-region no longer says "Wrote FOO" |
| @@ -40,8 +40,10 @@ or by sticking with Emacs 24.4. | |||
| 40 | ** The configure option `--with-pkg-config-prog' has been removed. | 40 | ** The configure option `--with-pkg-config-prog' has been removed. |
| 41 | Use './configure PKG_CONFIG=/full/name/of/pkg-config' if you need to. | 41 | Use './configure PKG_CONFIG=/full/name/of/pkg-config' if you need to. |
| 42 | 42 | ||
| 43 | ** The configure option '--enable-silent-rules' and the command | 43 | ** The configure option '--enable-silent-rules' is now the default, |
| 44 | 'make V=0' now do a better job of suppressing chatter. | 44 | and silent rules are now quieter. To get the old behavior where |
| 45 | 'make' chatters a lot, configure with '--disable-silent-rules' or | ||
| 46 | build with 'make V=1'. | ||
| 45 | 47 | ||
| 46 | --- | 48 | --- |
| 47 | ** The `grep-changelog' script (and its manual page) are no longer included. | 49 | ** The `grep-changelog' script (and its manual page) are no longer included. |
| @@ -141,10 +143,6 @@ this has no effect. | |||
| 141 | ** A new text property `inhibit-read-only' can be used in read-only | 143 | ** A new text property `inhibit-read-only' can be used in read-only |
| 142 | buffers to allow certain parts of the text to be writable. | 144 | buffers to allow certain parts of the text to be writable. |
| 143 | 145 | ||
| 144 | ** A new function `file-tree-walk' allows to apply a certain action | ||
| 145 | to all the files and subdirectories of a directory, similarly to the C | ||
| 146 | library function `ftw'. | ||
| 147 | |||
| 148 | ** A new function `directory-files-recursively' returns all matching | 146 | ** A new function `directory-files-recursively' returns all matching |
| 149 | files (recursively) under a directory. | 147 | files (recursively) under a directory. |
| 150 | 148 | ||
| @@ -166,6 +164,8 @@ characters, which can be used for geometry-related calculations. | |||
| 166 | 164 | ||
| 167 | * Editing Changes in Emacs 25.1 | 165 | * Editing Changes in Emacs 25.1 |
| 168 | 166 | ||
| 167 | ** Unicode names entered via C-x 8 RET now use substring completion by default. | ||
| 168 | |||
| 169 | ** New minor mode global-eldoc-mode is enabled by default. | 169 | ** New minor mode global-eldoc-mode is enabled by default. |
| 170 | 170 | ||
| 171 | ** Emacs now supports "bracketed paste mode" when running on a terminal | 171 | ** Emacs now supports "bracketed paste mode" when running on a terminal |
| @@ -191,10 +191,16 @@ Unicode standards. | |||
| 191 | 191 | ||
| 192 | When you invoke `shell' interactively, the *shell* buffer will now | 192 | When you invoke `shell' interactively, the *shell* buffer will now |
| 193 | display in a new window. However, you can customize this behavior via | 193 | display in a new window. However, you can customize this behavior via |
| 194 | the new `shell-display-buffer-actions' variable. For example, to get | 194 | the `display-buffer-alist' variable. For example, to get |
| 195 | the old behavior -- *shell* buffer displays in current window -- use | 195 | the old behavior -- *shell* buffer displays in current window -- use |
| 196 | (setq shell-display-buffer-actions '(display-buffer-same-window)). | 196 | (add-to-list 'display-buffer-alist |
| 197 | '("^\\*shell\\*$" . (display-buffer-same-window))). | ||
| 198 | |||
| 197 | 199 | ||
| 200 | ** EIEIO | ||
| 201 | *** The <class>-list-p and <class>-child-p functions are declared obsolete. | ||
| 202 | *** The <class> variables are declared obsolete. | ||
| 203 | *** The <initarg> variables are declared obsolete. | ||
| 198 | ** ido | 204 | ** ido |
| 199 | *** New command `ido-bury-buffer-at-head' bound to C-S-b | 205 | *** New command `ido-bury-buffer-at-head' bound to C-S-b |
| 200 | Bury the buffer at the head of `ido-matches', analogous to how C-k | 206 | Bury the buffer at the head of `ido-matches', analogous to how C-k |
| @@ -607,7 +613,7 @@ Horizontal scroll bars are turned off by default. | |||
| 607 | `scroll-bar-height'. | 613 | `scroll-bar-height'. |
| 608 | 614 | ||
| 609 | +++ | 615 | +++ |
| 610 | ** The height of a frame's menu and tool bar are no more counted in the | 616 | ** The height of a frame's menu and tool bar are no longer counted in the |
| 611 | frame's text height. This means that the text height stands only for | 617 | frame's text height. This means that the text height stands only for |
| 612 | the height of the frame's root window plus that of the echo area (if | 618 | the height of the frame's root window plus that of the echo area (if |
| 613 | present). This was already the behavior for frames with external tool | 619 | present). This was already the behavior for frames with external tool |
diff --git a/etc/NEWS.24 b/etc/NEWS.24 index c33b337a1e1..ae0d402a3d5 100644 --- a/etc/NEWS.24 +++ b/etc/NEWS.24 | |||
| @@ -27,6 +27,9 @@ otherwise leave it unmarked. | |||
| 27 | --- | 27 | --- |
| 28 | ** The default value of `history-length' has increased to 100. | 28 | ** The default value of `history-length' has increased to 100. |
| 29 | 29 | ||
| 30 | +++ | ||
| 31 | ** `redisplay-dont-pause' is declared as obsolete. | ||
| 32 | |||
| 30 | 33 | ||
| 31 | * Changes in Specialized Modes and Packages in Emacs 24.5 | 34 | * Changes in Specialized Modes and Packages in Emacs 24.5 |
| 32 | 35 | ||
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index acbbd3a02df..740359605fd 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog | |||
| @@ -1,3 +1,41 @@ | |||
| 1 | 2015-01-10 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Port to 32-bit --with-wide-int | ||
| 4 | * make-docfile.c (write_globals): Define and use symbols like | ||
| 5 | iQnil (a small integer, like 0) rather than aQnil (an address | ||
| 6 | constant). | ||
| 7 | |||
| 8 | Port to 32-bit Sun C 5.12 sparc | ||
| 9 | * make-docfile.c (close_emacs_globals): Align lispsym to GCALIGNMENT. | ||
| 10 | The alignment is required on all platforms; it just happens to have | ||
| 11 | been properly aligned on the previous platforms we tested. | ||
| 12 | |||
| 13 | 2015-01-05 Paul Eggert <eggert@cs.ucla.edu> | ||
| 14 | |||
| 15 | Use 0 for Qnil | ||
| 16 | * make-docfile.c (compare_globals): Consider 'nil' to be the least. | ||
| 17 | |||
| 18 | Compute C decls for DEFSYMs automatically | ||
| 19 | Fixes Bug#15880. | ||
| 20 | * make-docfile.c: Revamp to generate table of symbols, too. | ||
| 21 | Include <stdbool.h>. | ||
| 22 | (xstrdup): New function. | ||
| 23 | (main): Don't process the same file twice. | ||
| 24 | (SYMBOL): New constant in enum global_type. | ||
| 25 | (struct symbol): Turn 'value' member into a union, either v.value | ||
| 26 | for int or v.svalue for string. All uses changed. | ||
| 27 | (add_global): New arg svalue, which overrides value, so that globals | ||
| 28 | can have a string value. | ||
| 29 | (close_emacs_global): New arg num_symbols; all uses changed. | ||
| 30 | Output lispsym decl. | ||
| 31 | (write_globals): Output symbol globals too. Output more | ||
| 32 | ATTRIBUTE_CONST, now that Qnil etc. are C constants. | ||
| 33 | Output defsym_name table. | ||
| 34 | (scan_c_file): Move most of guts into ... | ||
| 35 | (scan_c_stream): ... new function. Scan for DEFSYMs and | ||
| 36 | record symbols found. Don't read past EOF if file doesn't | ||
| 37 | end in newline. | ||
| 38 | |||
| 1 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> | 39 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 40 | ||
| 3 | 'temacs -nw' should not call missing functions | 41 | 'temacs -nw' should not call missing functions |
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index f74b3d516d1..bc5420ea939 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c | |||
| @@ -36,6 +36,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 36 | 36 | ||
| 37 | #include <config.h> | 37 | #include <config.h> |
| 38 | 38 | ||
| 39 | #include <stdbool.h> | ||
| 39 | #include <stdio.h> | 40 | #include <stdio.h> |
| 40 | #include <stdlib.h> /* config.h unconditionally includes this anyway */ | 41 | #include <stdlib.h> /* config.h unconditionally includes this anyway */ |
| 41 | 42 | ||
| @@ -63,6 +64,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 63 | static int scan_file (char *filename); | 64 | static int scan_file (char *filename); |
| 64 | static int scan_lisp_file (const char *filename, const char *mode); | 65 | static int scan_lisp_file (const char *filename, const char *mode); |
| 65 | static int scan_c_file (char *filename, const char *mode); | 66 | static int scan_c_file (char *filename, const char *mode); |
| 67 | static int scan_c_stream (FILE *infile); | ||
| 66 | static void start_globals (void); | 68 | static void start_globals (void); |
| 67 | static void write_globals (void); | 69 | static void write_globals (void); |
| 68 | 70 | ||
| @@ -106,6 +108,17 @@ xmalloc (unsigned int size) | |||
| 106 | return result; | 108 | return result; |
| 107 | } | 109 | } |
| 108 | 110 | ||
| 111 | /* Like strdup, but get fatal error if memory is exhausted. */ | ||
| 112 | |||
| 113 | static char * | ||
| 114 | xstrdup (char *s) | ||
| 115 | { | ||
| 116 | char *result = strdup (s); | ||
| 117 | if (! result) | ||
| 118 | fatal ("virtual memory exhausted", 0); | ||
| 119 | return result; | ||
| 120 | } | ||
| 121 | |||
| 109 | /* Like realloc but get fatal error if memory is exhausted. */ | 122 | /* Like realloc but get fatal error if memory is exhausted. */ |
| 110 | 123 | ||
| 111 | static void * | 124 | static void * |
| @@ -123,7 +136,6 @@ main (int argc, char **argv) | |||
| 123 | { | 136 | { |
| 124 | int i; | 137 | int i; |
| 125 | int err_count = 0; | 138 | int err_count = 0; |
| 126 | int first_infile; | ||
| 127 | 139 | ||
| 128 | progname = argv[0]; | 140 | progname = argv[0]; |
| 129 | 141 | ||
| @@ -167,16 +179,21 @@ main (int argc, char **argv) | |||
| 167 | if (generate_globals) | 179 | if (generate_globals) |
| 168 | start_globals (); | 180 | start_globals (); |
| 169 | 181 | ||
| 170 | first_infile = i; | 182 | if (argc <= i) |
| 171 | for (; i < argc; i++) | 183 | scan_c_stream (stdin); |
| 184 | else | ||
| 172 | { | 185 | { |
| 173 | int j; | 186 | int first_infile = i; |
| 174 | /* Don't process one file twice. */ | 187 | for (; i < argc; i++) |
| 175 | for (j = first_infile; j < i; j++) | 188 | { |
| 176 | if (! strcmp (argv[i], argv[j])) | 189 | int j; |
| 177 | break; | 190 | /* Don't process one file twice. */ |
| 178 | if (j == i) | 191 | for (j = first_infile; j < i; j++) |
| 179 | err_count += scan_file (argv[i]); | 192 | if (strcmp (argv[i], argv[j]) == 0) |
| 193 | break; | ||
| 194 | if (j == i) | ||
| 195 | err_count += scan_file (argv[i]); | ||
| 196 | } | ||
| 180 | } | 197 | } |
| 181 | 198 | ||
| 182 | if (err_count == 0 && generate_globals) | 199 | if (err_count == 0 && generate_globals) |
| @@ -528,13 +545,15 @@ write_c_args (char *func, char *buf, int minargs, int maxargs) | |||
| 528 | } | 545 | } |
| 529 | 546 | ||
| 530 | /* The types of globals. These are sorted roughly in decreasing alignment | 547 | /* The types of globals. These are sorted roughly in decreasing alignment |
| 531 | order to avoid allocation gaps, except that functions are last. */ | 548 | order to avoid allocation gaps, except that symbols and functions |
| 549 | are last. */ | ||
| 532 | enum global_type | 550 | enum global_type |
| 533 | { | 551 | { |
| 534 | INVALID, | 552 | INVALID, |
| 535 | LISP_OBJECT, | 553 | LISP_OBJECT, |
| 536 | EMACS_INTEGER, | 554 | EMACS_INTEGER, |
| 537 | BOOLEAN, | 555 | BOOLEAN, |
| 556 | SYMBOL, | ||
| 538 | FUNCTION | 557 | FUNCTION |
| 539 | }; | 558 | }; |
| 540 | 559 | ||
| @@ -543,7 +562,11 @@ struct global | |||
| 543 | { | 562 | { |
| 544 | enum global_type type; | 563 | enum global_type type; |
| 545 | char *name; | 564 | char *name; |
| 546 | int value; | 565 | union |
| 566 | { | ||
| 567 | int value; | ||
| 568 | char const *svalue; | ||
| 569 | } v; | ||
| 547 | }; | 570 | }; |
| 548 | 571 | ||
| 549 | /* All the variable names we saw while scanning C sources in `-g' | 572 | /* All the variable names we saw while scanning C sources in `-g' |
| @@ -553,7 +576,7 @@ int num_globals_allocated; | |||
| 553 | struct global *globals; | 576 | struct global *globals; |
| 554 | 577 | ||
| 555 | static void | 578 | static void |
| 556 | add_global (enum global_type type, char *name, int value) | 579 | add_global (enum global_type type, char *name, int value, char const *svalue) |
| 557 | { | 580 | { |
| 558 | /* Ignore the one non-symbol that can occur. */ | 581 | /* Ignore the one non-symbol that can occur. */ |
| 559 | if (strcmp (name, "...")) | 582 | if (strcmp (name, "...")) |
| @@ -574,7 +597,10 @@ add_global (enum global_type type, char *name, int value) | |||
| 574 | 597 | ||
| 575 | globals[num_globals - 1].type = type; | 598 | globals[num_globals - 1].type = type; |
| 576 | globals[num_globals - 1].name = name; | 599 | globals[num_globals - 1].name = name; |
| 577 | globals[num_globals - 1].value = value; | 600 | if (svalue) |
| 601 | globals[num_globals - 1].v.svalue = svalue; | ||
| 602 | else | ||
| 603 | globals[num_globals - 1].v.value = value; | ||
| 578 | } | 604 | } |
| 579 | } | 605 | } |
| 580 | 606 | ||
| @@ -587,21 +613,58 @@ compare_globals (const void *a, const void *b) | |||
| 587 | if (ga->type != gb->type) | 613 | if (ga->type != gb->type) |
| 588 | return ga->type - gb->type; | 614 | return ga->type - gb->type; |
| 589 | 615 | ||
| 616 | /* Consider "nil" to be the least, so that iQnil is zero. That | ||
| 617 | way, Qnil's internal representation is zero, which is a bit faster. */ | ||
| 618 | if (ga->type == SYMBOL) | ||
| 619 | { | ||
| 620 | bool a_nil = strcmp (ga->name, "Qnil") == 0; | ||
| 621 | bool b_nil = strcmp (gb->name, "Qnil") == 0; | ||
| 622 | if (a_nil | b_nil) | ||
| 623 | return b_nil - a_nil; | ||
| 624 | } | ||
| 625 | |||
| 590 | return strcmp (ga->name, gb->name); | 626 | return strcmp (ga->name, gb->name); |
| 591 | } | 627 | } |
| 592 | 628 | ||
| 593 | static void | 629 | static void |
| 594 | close_emacs_globals (void) | 630 | close_emacs_globals (int num_symbols) |
| 595 | { | 631 | { |
| 596 | puts ("};"); | 632 | printf (("};\n" |
| 597 | puts ("extern struct emacs_globals globals;"); | 633 | "extern struct emacs_globals globals;\n" |
| 634 | "\n" | ||
| 635 | "#ifndef DEFINE_SYMBOLS\n" | ||
| 636 | "extern\n" | ||
| 637 | "#endif\n" | ||
| 638 | "struct Lisp_Symbol alignas (GCALIGNMENT) lispsym[%d];\n"), | ||
| 639 | num_symbols); | ||
| 598 | } | 640 | } |
| 599 | 641 | ||
| 600 | static void | 642 | static void |
| 601 | write_globals (void) | 643 | write_globals (void) |
| 602 | { | 644 | { |
| 603 | int i, seen_defun = 0; | 645 | int i, j; |
| 646 | bool seen_defun = false; | ||
| 647 | int symnum = 0; | ||
| 648 | int num_symbols = 0; | ||
| 604 | qsort (globals, num_globals, sizeof (struct global), compare_globals); | 649 | qsort (globals, num_globals, sizeof (struct global), compare_globals); |
| 650 | |||
| 651 | j = 0; | ||
| 652 | for (i = 0; i < num_globals; i++) | ||
| 653 | { | ||
| 654 | while (i + 1 < num_globals | ||
| 655 | && strcmp (globals[i].name, globals[i + 1].name) == 0) | ||
| 656 | { | ||
| 657 | if (globals[i].type == FUNCTION | ||
| 658 | && globals[i].v.value != globals[i + 1].v.value) | ||
| 659 | error ("function '%s' defined twice with differing signatures", | ||
| 660 | globals[i].name); | ||
| 661 | i++; | ||
| 662 | } | ||
| 663 | num_symbols += globals[i].type == SYMBOL; | ||
| 664 | globals[j++] = globals[i]; | ||
| 665 | } | ||
| 666 | num_globals = j; | ||
| 667 | |||
| 605 | for (i = 0; i < num_globals; ++i) | 668 | for (i = 0; i < num_globals; ++i) |
| 606 | { | 669 | { |
| 607 | char const *type = 0; | 670 | char const *type = 0; |
| @@ -617,12 +680,13 @@ write_globals (void) | |||
| 617 | case LISP_OBJECT: | 680 | case LISP_OBJECT: |
| 618 | type = "Lisp_Object"; | 681 | type = "Lisp_Object"; |
| 619 | break; | 682 | break; |
| 683 | case SYMBOL: | ||
| 620 | case FUNCTION: | 684 | case FUNCTION: |
| 621 | if (!seen_defun) | 685 | if (!seen_defun) |
| 622 | { | 686 | { |
| 623 | close_emacs_globals (); | 687 | close_emacs_globals (num_symbols); |
| 624 | putchar ('\n'); | 688 | putchar ('\n'); |
| 625 | seen_defun = 1; | 689 | seen_defun = true; |
| 626 | } | 690 | } |
| 627 | break; | 691 | break; |
| 628 | default: | 692 | default: |
| @@ -635,6 +699,13 @@ write_globals (void) | |||
| 635 | printf ("#define %s globals.f_%s\n", | 699 | printf ("#define %s globals.f_%s\n", |
| 636 | globals[i].name, globals[i].name); | 700 | globals[i].name, globals[i].name); |
| 637 | } | 701 | } |
| 702 | else if (globals[i].type == SYMBOL) | ||
| 703 | printf (("DEFINE_LISP_SYMBOL_BEGIN (%s)\n" | ||
| 704 | "#define i%s %d\n" | ||
| 705 | "#define %s builtin_lisp_symbol (i%s)\n" | ||
| 706 | "DEFINE_LISP_SYMBOL_END (%s)\n\n"), | ||
| 707 | globals[i].name, globals[i].name, symnum++, | ||
| 708 | globals[i].name, globals[i].name, globals[i].name); | ||
| 638 | else | 709 | else |
| 639 | { | 710 | { |
| 640 | /* It would be nice to have a cleaner way to deal with these | 711 | /* It would be nice to have a cleaner way to deal with these |
| @@ -647,39 +718,65 @@ write_globals (void) | |||
| 647 | fputs ("_Noreturn ", stdout); | 718 | fputs ("_Noreturn ", stdout); |
| 648 | 719 | ||
| 649 | printf ("EXFUN (%s, ", globals[i].name); | 720 | printf ("EXFUN (%s, ", globals[i].name); |
| 650 | if (globals[i].value == -1) | 721 | if (globals[i].v.value == -1) |
| 651 | fputs ("MANY", stdout); | 722 | fputs ("MANY", stdout); |
| 652 | else if (globals[i].value == -2) | 723 | else if (globals[i].v.value == -2) |
| 653 | fputs ("UNEVALLED", stdout); | 724 | fputs ("UNEVALLED", stdout); |
| 654 | else | 725 | else |
| 655 | printf ("%d", globals[i].value); | 726 | printf ("%d", globals[i].v.value); |
| 656 | putchar (')'); | 727 | putchar (')'); |
| 657 | 728 | ||
| 658 | /* It would be nice to have a cleaner way to deal with these | 729 | /* It would be nice to have a cleaner way to deal with these |
| 659 | special hacks, too. */ | 730 | special hacks, too. */ |
| 660 | if (strcmp (globals[i].name, "Fbyteorder") == 0 | 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 | ||
| 661 | || strcmp (globals[i].name, "Fframe_windows_min_size") == 0 | 738 | || strcmp (globals[i].name, "Fframe_windows_min_size") == 0 |
| 739 | || strcmp (globals[i].name, "Fgnutls_errorp") == 0 | ||
| 662 | || strcmp (globals[i].name, "Fidentity") == 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 | ||
| 663 | || strcmp (globals[i].name, "Fmax_char") == 0 | 745 | || strcmp (globals[i].name, "Fmax_char") == 0 |
| 664 | || strcmp (globals[i].name, "Ftool_bar_height") == 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) | ||
| 665 | fputs (" ATTRIBUTE_CONST", stdout); | 759 | fputs (" ATTRIBUTE_CONST", stdout); |
| 666 | 760 | ||
| 667 | puts (";"); | 761 | puts (";"); |
| 668 | } | 762 | } |
| 669 | |||
| 670 | while (i + 1 < num_globals | ||
| 671 | && !strcmp (globals[i].name, globals[i + 1].name)) | ||
| 672 | { | ||
| 673 | if (globals[i].type == FUNCTION | ||
| 674 | && globals[i].value != globals[i + 1].value) | ||
| 675 | error ("function '%s' defined twice with differing signatures", | ||
| 676 | globals[i].name); | ||
| 677 | ++i; | ||
| 678 | } | ||
| 679 | } | 763 | } |
| 680 | 764 | ||
| 681 | if (!seen_defun) | 765 | if (!seen_defun) |
| 682 | close_emacs_globals (); | 766 | close_emacs_globals (num_symbols); |
| 767 | |||
| 768 | puts ("#ifdef DEFINE_SYMBOLS"); | ||
| 769 | puts ("static char const *const defsym_name[] = {"); | ||
| 770 | for (int i = 0; i < num_globals; i++) | ||
| 771 | { | ||
| 772 | if (globals[i].type == SYMBOL) | ||
| 773 | printf ("\t\"%s\",\n", globals[i].v.svalue); | ||
| 774 | while (i + 1 < num_globals | ||
| 775 | && strcmp (globals[i].name, globals[i + 1].name) == 0) | ||
| 776 | i++; | ||
| 777 | } | ||
| 778 | puts ("};"); | ||
| 779 | puts ("#endif"); | ||
| 683 | } | 780 | } |
| 684 | 781 | ||
| 685 | 782 | ||
| @@ -692,9 +789,6 @@ static int | |||
| 692 | scan_c_file (char *filename, const char *mode) | 789 | scan_c_file (char *filename, const char *mode) |
| 693 | { | 790 | { |
| 694 | FILE *infile; | 791 | FILE *infile; |
| 695 | register int c; | ||
| 696 | register int commas; | ||
| 697 | int minargs, maxargs; | ||
| 698 | int extension = filename[strlen (filename) - 1]; | 792 | int extension = filename[strlen (filename) - 1]; |
| 699 | 793 | ||
| 700 | if (extension == 'o') | 794 | if (extension == 'o') |
| @@ -720,8 +814,15 @@ scan_c_file (char *filename, const char *mode) | |||
| 720 | 814 | ||
| 721 | /* Reset extension to be able to detect duplicate files. */ | 815 | /* Reset extension to be able to detect duplicate files. */ |
| 722 | filename[strlen (filename) - 1] = extension; | 816 | filename[strlen (filename) - 1] = extension; |
| 817 | return scan_c_stream (infile); | ||
| 818 | } | ||
| 819 | |||
| 820 | static int | ||
| 821 | scan_c_stream (FILE *infile) | ||
| 822 | { | ||
| 823 | int commas, minargs, maxargs; | ||
| 824 | int c = '\n'; | ||
| 723 | 825 | ||
| 724 | c = '\n'; | ||
| 725 | while (!feof (infile)) | 826 | while (!feof (infile)) |
| 726 | { | 827 | { |
| 727 | int doc_keyword = 0; | 828 | int doc_keyword = 0; |
| @@ -750,37 +851,53 @@ scan_c_file (char *filename, const char *mode) | |||
| 750 | if (c != 'F') | 851 | if (c != 'F') |
| 751 | continue; | 852 | continue; |
| 752 | c = getc (infile); | 853 | c = getc (infile); |
| 753 | if (c != 'V') | 854 | if (c == 'S') |
| 754 | continue; | ||
| 755 | c = getc (infile); | ||
| 756 | if (c != 'A') | ||
| 757 | continue; | ||
| 758 | c = getc (infile); | ||
| 759 | if (c != 'R') | ||
| 760 | continue; | ||
| 761 | c = getc (infile); | ||
| 762 | if (c != '_') | ||
| 763 | continue; | ||
| 764 | |||
| 765 | defvarflag = 1; | ||
| 766 | |||
| 767 | c = getc (infile); | ||
| 768 | defvarperbufferflag = (c == 'P'); | ||
| 769 | if (generate_globals) | ||
| 770 | { | 855 | { |
| 771 | if (c == 'I') | 856 | c = getc (infile); |
| 772 | type = EMACS_INTEGER; | 857 | if (c != 'Y') |
| 773 | else if (c == 'L') | 858 | continue; |
| 774 | type = LISP_OBJECT; | 859 | c = getc (infile); |
| 775 | else if (c == 'B') | 860 | if (c != 'M') |
| 776 | type = BOOLEAN; | 861 | continue; |
| 862 | c = getc (infile); | ||
| 863 | if (c != ' ' && c != '\t' && c != '(') | ||
| 864 | continue; | ||
| 865 | type = SYMBOL; | ||
| 777 | } | 866 | } |
| 867 | else if (c == 'V') | ||
| 868 | { | ||
| 869 | c = getc (infile); | ||
| 870 | if (c != 'A') | ||
| 871 | continue; | ||
| 872 | c = getc (infile); | ||
| 873 | if (c != 'R') | ||
| 874 | continue; | ||
| 875 | c = getc (infile); | ||
| 876 | if (c != '_') | ||
| 877 | continue; | ||
| 778 | 878 | ||
| 779 | c = getc (infile); | 879 | defvarflag = 1; |
| 780 | /* We need to distinguish between DEFVAR_BOOL and | 880 | |
| 781 | DEFVAR_BUFFER_DEFAULTS. */ | 881 | c = getc (infile); |
| 782 | if (generate_globals && type == BOOLEAN && c != 'O') | 882 | defvarperbufferflag = (c == 'P'); |
| 783 | type = INVALID; | 883 | if (generate_globals) |
| 884 | { | ||
| 885 | if (c == 'I') | ||
| 886 | type = EMACS_INTEGER; | ||
| 887 | else if (c == 'L') | ||
| 888 | type = LISP_OBJECT; | ||
| 889 | else if (c == 'B') | ||
| 890 | type = BOOLEAN; | ||
| 891 | } | ||
| 892 | |||
| 893 | c = getc (infile); | ||
| 894 | /* We need to distinguish between DEFVAR_BOOL and | ||
| 895 | DEFVAR_BUFFER_DEFAULTS. */ | ||
| 896 | if (generate_globals && type == BOOLEAN && c != 'O') | ||
| 897 | type = INVALID; | ||
| 898 | } | ||
| 899 | else | ||
| 900 | continue; | ||
| 784 | } | 901 | } |
| 785 | else if (c == 'D') | 902 | else if (c == 'D') |
| 786 | { | 903 | { |
| @@ -797,7 +914,7 @@ scan_c_file (char *filename, const char *mode) | |||
| 797 | 914 | ||
| 798 | if (generate_globals | 915 | if (generate_globals |
| 799 | && (!defvarflag || defvarperbufferflag || type == INVALID) | 916 | && (!defvarflag || defvarperbufferflag || type == INVALID) |
| 800 | && !defunflag) | 917 | && !defunflag && type != SYMBOL) |
| 801 | continue; | 918 | continue; |
| 802 | 919 | ||
| 803 | while (c != '(') | 920 | while (c != '(') |
| @@ -807,15 +924,19 @@ scan_c_file (char *filename, const char *mode) | |||
| 807 | c = getc (infile); | 924 | c = getc (infile); |
| 808 | } | 925 | } |
| 809 | 926 | ||
| 810 | /* Lisp variable or function name. */ | 927 | if (type != SYMBOL) |
| 811 | c = getc (infile); | 928 | { |
| 812 | if (c != '"') | 929 | /* Lisp variable or function name. */ |
| 813 | continue; | 930 | c = getc (infile); |
| 814 | c = read_c_string_or_comment (infile, -1, 0, 0); | 931 | if (c != '"') |
| 932 | continue; | ||
| 933 | c = read_c_string_or_comment (infile, -1, 0, 0); | ||
| 934 | } | ||
| 815 | 935 | ||
| 816 | if (generate_globals) | 936 | if (generate_globals) |
| 817 | { | 937 | { |
| 818 | int i = 0; | 938 | int i = 0; |
| 939 | char const *svalue = 0; | ||
| 819 | 940 | ||
| 820 | /* Skip "," and whitespace. */ | 941 | /* Skip "," and whitespace. */ |
| 821 | do | 942 | do |
| @@ -827,6 +948,8 @@ scan_c_file (char *filename, const char *mode) | |||
| 827 | /* Read in the identifier. */ | 948 | /* Read in the identifier. */ |
| 828 | do | 949 | do |
| 829 | { | 950 | { |
| 951 | if (c < 0) | ||
| 952 | goto eof; | ||
| 830 | input_buffer[i++] = c; | 953 | input_buffer[i++] = c; |
| 831 | c = getc (infile); | 954 | c = getc (infile); |
| 832 | } | 955 | } |
| @@ -837,13 +960,27 @@ scan_c_file (char *filename, const char *mode) | |||
| 837 | name = xmalloc (i + 1); | 960 | name = xmalloc (i + 1); |
| 838 | memcpy (name, input_buffer, i + 1); | 961 | memcpy (name, input_buffer, i + 1); |
| 839 | 962 | ||
| 963 | if (type == SYMBOL) | ||
| 964 | { | ||
| 965 | do | ||
| 966 | c = getc (infile); | ||
| 967 | while (c == ' ' || c == '\t' || c == '\n' || c == '\r'); | ||
| 968 | if (c != '"') | ||
| 969 | continue; | ||
| 970 | c = read_c_string_or_comment (infile, -1, 0, 0); | ||
| 971 | svalue = xstrdup (input_buffer); | ||
| 972 | } | ||
| 973 | |||
| 840 | if (!defunflag) | 974 | if (!defunflag) |
| 841 | { | 975 | { |
| 842 | add_global (type, name, 0); | 976 | add_global (type, name, 0, svalue); |
| 843 | continue; | 977 | continue; |
| 844 | } | 978 | } |
| 845 | } | 979 | } |
| 846 | 980 | ||
| 981 | if (type == SYMBOL) | ||
| 982 | continue; | ||
| 983 | |||
| 847 | /* DEFVAR_LISP ("name", addr, "doc") | 984 | /* DEFVAR_LISP ("name", addr, "doc") |
| 848 | DEFVAR_LISP ("name", addr /\* doc *\/) | 985 | DEFVAR_LISP ("name", addr /\* doc *\/) |
| 849 | DEFVAR_LISP ("name", addr, doc: /\* doc *\/) */ | 986 | DEFVAR_LISP ("name", addr, doc: /\* doc *\/) */ |
| @@ -896,7 +1033,7 @@ scan_c_file (char *filename, const char *mode) | |||
| 896 | 1033 | ||
| 897 | if (generate_globals) | 1034 | if (generate_globals) |
| 898 | { | 1035 | { |
| 899 | add_global (FUNCTION, name, maxargs); | 1036 | add_global (FUNCTION, name, maxargs, 0); |
| 900 | continue; | 1037 | continue; |
| 901 | } | 1038 | } |
| 902 | 1039 | ||
diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 2a639c4478e..759c94d7abf 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h | |||
| @@ -84,8 +84,13 @@ | |||
| 84 | except that it indicates to GCC that the supported format string directives | 84 | except that it indicates to GCC that the supported format string directives |
| 85 | are the ones of the system printf(), rather than the ones standardized by | 85 | are the ones of the system printf(), rather than the ones standardized by |
| 86 | ISO C99 and POSIX. */ | 86 | ISO C99 and POSIX. */ |
| 87 | #define _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM(formatstring_parameter, first_argument) \ | 87 | #if GNULIB_PRINTF_ATTRIBUTE_FLAVOR_GNU |
| 88 | # define _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM(formatstring_parameter, first_argument) \ | ||
| 89 | _GL_ATTRIBUTE_FORMAT_PRINTF (formatstring_parameter, first_argument) | ||
| 90 | #else | ||
| 91 | # define _GL_ATTRIBUTE_FORMAT_PRINTF_SYSTEM(formatstring_parameter, first_argument) \ | ||
| 88 | _GL_ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument)) | 92 | _GL_ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument)) |
| 93 | #endif | ||
| 89 | 94 | ||
| 90 | /* _GL_ATTRIBUTE_FORMAT_SCANF | 95 | /* _GL_ATTRIBUTE_FORMAT_SCANF |
| 91 | indicates to GCC that the function takes a format string and arguments, | 96 | indicates to GCC that the function takes a format string and arguments, |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f413526c0b2..674b26716a4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,7 +1,319 @@ | |||
| 1 | 2015-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * net/shr.el (shr-urlify): Don't bother the user about | ||
| 4 | invalidly-encoded display strings. | ||
| 5 | |||
| 6 | 2015-01-10 Ivan Shmakov <ivan@siamics.net> | ||
| 7 | |||
| 8 | * net/shr.el (shr-urlify): Decode URLs before using them as titles | ||
| 9 | (bug#19555). | ||
| 10 | |||
| 11 | 2015-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 12 | |||
| 13 | * net/eww.el (eww): Always interpret URLs that start with https?: | ||
| 14 | as plain URLs, even if they have spaces in them (bug#19556). | ||
| 15 | (eww): Also interpret things like "en.wikipedia.org/wiki/Free | ||
| 16 | software" as an URL. | ||
| 17 | (eww): Don't interpret "org/foo" as an URL. | ||
| 18 | (eww): Clear the title when loading so that we don't display | ||
| 19 | misleading information. | ||
| 20 | |||
| 21 | 2015-01-10 Daniel Colascione <dancol@dancol.org> | ||
| 22 | |||
| 23 | * vc/vc-hooks.el (vc-prefix-map): Bind vc-delete-file to C-x v x, | ||
| 24 | by analogy with dired. | ||
| 25 | |||
| 26 | 2015-01-09 Daniel Colascione <dancol@dancol.org> | ||
| 27 | |||
| 28 | * progmodes/js.el (js--function-heading-1-re) | ||
| 29 | (js--function-prologue-beginning): Parse ES6 generator function | ||
| 30 | declarations. (That is, "function* name()"). | ||
| 31 | |||
| 32 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 33 | |||
| 34 | * emacs-lisp/eieio.el (defclass): Move from eieio-defclass all the code | ||
| 35 | that creates functions, and most of the sanity checks. | ||
| 36 | Mark as obsolete the <class>-child-p function. | ||
| 37 | * emacs-lisp/eieio-core.el (eieio--define-field-accessors): Remove. | ||
| 38 | (eieio--class, eieio--object): Use cl-defstruct. | ||
| 39 | (eieio--object-num-slots): Define manually. | ||
| 40 | (eieio-defclass-autoload): Use eieio--class-make. | ||
| 41 | (eieio-defclass-internal): Rename from eieio-defclass. Move all the | ||
| 42 | `(lambda...) definitions and most of the sanity checks to `defclass'. | ||
| 43 | Mark as obsolete the <class>-list-p function, the <class> variable and | ||
| 44 | the <initarg> variables. Use pcase-dolist. | ||
| 45 | (eieio-defclass): New compatibility function. | ||
| 46 | * emacs-lisp/eieio-opt.el (eieio-build-class-alist) | ||
| 47 | (eieio-class-speedbar): Don't use eieio-default-superclass var. | ||
| 48 | |||
| 49 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 50 | |||
| 51 | * emacs-lisp/eieio-generic.el: New file. | ||
| 52 | * emacs-lisp/eieio-core.el: Move all generic function code to | ||
| 53 | eieio-generic.el. | ||
| 54 | (eieio--defmethod): Declare. | ||
| 55 | |||
| 56 | * emacs-lisp/eieio.el: Require eieio-generic. Move all generic | ||
| 57 | function code to eieio-generic.el. | ||
| 58 | * emacs-lisp/eieio-opt.el (eieio-help-generic): Move to | ||
| 59 | eieio-generic.el. | ||
| 60 | * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): Update call | ||
| 61 | to eieio--generic-call. | ||
| 62 | * emacs-lisp/eieio-base.el (eieio-instance-inheritor): Don't use | ||
| 63 | <class>-child type. | ||
| 64 | |||
| 65 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 66 | |||
| 67 | * emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie): | ||
| 68 | Don't use <class> as a variable. | ||
| 69 | |||
| 70 | * emacs-lisp/eieio.el (same-class-p): Accept class object as well. | ||
| 71 | (call-next-method): Simplify. | ||
| 72 | (clone): Obey eieio-backward-compatibility. | ||
| 73 | |||
| 74 | * emacs-lisp/eieio-opt.el (eieio-read-generic-p): Remove. | ||
| 75 | (eieio-read-generic): Use `generic-p' instead. | ||
| 76 | |||
| 77 | * emacs-lisp/eieio-core.el (eieio-backward-compatibility): New var. | ||
| 78 | (eieio-defclass-autoload): Obey it. | ||
| 79 | (eieio--class-object): Improve error behavior. | ||
| 80 | (eieio-class-children-fast, same-class-fast-p): Remove. Inline at | ||
| 81 | every use site. | ||
| 82 | (eieio--defgeneric-form-primary-only): Rename from | ||
| 83 | eieio-defgeneric-form-primary-only; update all callers. | ||
| 84 | (eieio--defgeneric-form-primary-only-one): Rename from | ||
| 85 | eieio-defgeneric-form-primary-only-one; update all callers. | ||
| 86 | (eieio-defgeneric-reset-generic-form) | ||
| 87 | (eieio-defgeneric-reset-generic-form-primary-only) | ||
| 88 | (eieio-defgeneric-reset-generic-form-primary-only-one): Remove. | ||
| 89 | (eieio--method-optimize-primary): New function to replace them. | ||
| 90 | (eieio--defmethod, eieio-defmethod): Use it. | ||
| 91 | (eieio--perform-slot-validation): Rename from | ||
| 92 | eieio-perform-slot-validation; update all callers. | ||
| 93 | (eieio--validate-slot-value): Rename from eieio-validate-slot-value. | ||
| 94 | Change `class' to be a class object. Update all callers. | ||
| 95 | (eieio--validate-class-slot-value): Rename from | ||
| 96 | eieio-validate-class-slot-value. Change `class' to be a class object. | ||
| 97 | Update all callers. | ||
| 98 | (eieio-oset-default): Accept class object as well. | ||
| 99 | (eieio--generic-call-primary-only): Rename from | ||
| 100 | eieio-generic-call-primary-only. Update all callers. | ||
| 101 | |||
| 102 | * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): | ||
| 103 | Improve error messages. | ||
| 104 | (eieio-persistent-slot-type-is-class-p): Handle `list-of' types, as | ||
| 105 | well as user-defined types. Emit errors for legacy types like | ||
| 106 | <class>-child and <class>-list, if not eieio-backward-compatibility. | ||
| 107 | |||
| 108 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 109 | |||
| 110 | * emacs-lisp/eieio.el (eieio-class-parents): Accept class objects. | ||
| 111 | (eieio--class-slot-initarg): Rename from class-slot-initarg. | ||
| 112 | Change `class' arg to be a class object. Update all callers. | ||
| 113 | (call-next-method): Adjust to new return value of `eieio-generic-form'. | ||
| 114 | (eieio-default-superclass): Set var to the class object. | ||
| 115 | (eieio-edebug-prin1-to-string): Fix recursive call for lists. | ||
| 116 | Change print behavior to affect class objects rather than | ||
| 117 | class symbols. | ||
| 118 | |||
| 119 | * emacs-lisp/eieio-core.el (eieio-class-object): New function. | ||
| 120 | (eieio-class-parents-fast): Remove macro. | ||
| 121 | (eieio--class-option-assoc): Rename from class-option-assoc. | ||
| 122 | Update all callers. | ||
| 123 | (eieio--class-option): Rename from class-option. Change `class' arg to | ||
| 124 | be a class object. Update all callers. | ||
| 125 | (eieio--class-method-invocation-order): Rename from | ||
| 126 | class-method-invocation-order. Change `class' arg to be a class | ||
| 127 | object. Update all callers. | ||
| 128 | (eieio-defclass-autoload, eieio-defclass): Set the `parent' field to | ||
| 129 | a list of class objects rather than names. | ||
| 130 | (eieio-defclass): Remove redundant quotes. Use `eieio-oref-default' | ||
| 131 | for accessors to class allocated slots. | ||
| 132 | (eieio--perform-slot-validation-for-default): Rename from | ||
| 133 | eieio-perform-slot-validation-for-default. Update all callers. | ||
| 134 | (eieio--add-new-slot): Rename from eieio-add-new-slot. | ||
| 135 | Update all callers. Use push. | ||
| 136 | (eieio-copy-parents-into-subclass): Adjust to new content of | ||
| 137 | `parent' field. Use dolist. | ||
| 138 | (eieio-oref): Remove support for providing a class rather than | ||
| 139 | an object. | ||
| 140 | (eieio-oref-default): Prefer class objects over class names. | ||
| 141 | (eieio--slot-originating-class-p): Rename from | ||
| 142 | eieio-slot-originating-class-p. Update all callers. Use `or'. | ||
| 143 | (eieio--slot-name-index): Turn check into assertion. | ||
| 144 | (eieio--class-slot-name-index): Rename from | ||
| 145 | eieio-class-slot-name-index. Change `class' arg to be a class object. | ||
| 146 | Update all callers. | ||
| 147 | (eieio-attribute-to-initarg): Move to eieio-test-persist.el. | ||
| 148 | (eieio--c3-candidate): Rename from eieio-c3-candidate. | ||
| 149 | Update all callers. | ||
| 150 | (eieio--c3-merge-lists): Rename from eieio-c3-merge-lists. | ||
| 151 | Update all callers. | ||
| 152 | (eieio--class-precedence-c3): Rename from eieio-class-precedence-c3. | ||
| 153 | Update all callers. | ||
| 154 | (eieio--class-precedence-dfs): Rename from eieio-class-precedence-dfs. | ||
| 155 | Update all callers. | ||
| 156 | (eieio--class-precedence-bfs): Rename from eieio-class-precedence-bfs. | ||
| 157 | Update all callers. Adjust to new `parent' content. | ||
| 158 | (eieio--class-precedence-list): Rename from -class-precedence-list. | ||
| 159 | Update all callers. | ||
| 160 | (eieio-generic-call): Use autoloadp and autoload-do-load. | ||
| 161 | Slight simplification. | ||
| 162 | (eieio-generic-call, eieio-generic-call-primary-only): Adjust to new | ||
| 163 | return value of `eieio-generic-form'. | ||
| 164 | (eieiomt-add): Index the hashtable with class objects rather than | ||
| 165 | class names. | ||
| 166 | (eieio-generic-form): Accept class objects as well. | ||
| 167 | |||
| 168 | * emacs-lisp/eieio-base.el (eieio-persistent-convert-list-to-object): | ||
| 169 | Adjust to new convention for eieio-persistent-validate/fix-slot-value. | ||
| 170 | (eieio-persistent-validate/fix-slot-value): | ||
| 171 | Change `class' arg to be a class object. Update all callers. | ||
| 172 | |||
| 173 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 174 | |||
| 175 | * emacs-lisp/eieio.el (child-of-class-p): Make it accept class objects | ||
| 176 | additionally to class names. | ||
| 177 | |||
| 178 | * emacs-lisp/eieio-core.el (eieio--with-scoped-class): Use let-binding. | ||
| 179 | (object): Remove first (constant) slot; rename second to `class-tag'. | ||
| 180 | (eieio--object-class-object, eieio--object-class-name): New funs | ||
| 181 | to replace eieio--object-class. | ||
| 182 | (eieio--class-object, eieio--class-p): New functions. | ||
| 183 | (same-class-fast-p): Make it a defsubst, change its implementation | ||
| 184 | to check the class objects rather than their names. | ||
| 185 | (eieio-object-p): Rewrite. | ||
| 186 | (eieio-defclass): Adjust the object initialization according to the new | ||
| 187 | object layout. | ||
| 188 | (eieio--scoped-class): Declare it returns a class object (not a class | ||
| 189 | name any more). Adjust calls accordingly (along with calls to | ||
| 190 | eieio--with-scoped-class). | ||
| 191 | (eieio--slot-name-index): Rename from eieio-slot-name-index and change | ||
| 192 | its class arg to be a class object. Adjust callers accordingly. | ||
| 193 | (eieio-slot-originating-class-p): Make its start-class arg a class | ||
| 194 | object. Adjust all callers. | ||
| 195 | (eieio--initarg-to-attribute): Rename from eieio-initarg-to-attribute. | ||
| 196 | Make its `class' arg a class object. Adjust all callers. | ||
| 197 | |||
| 198 | * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): | ||
| 199 | Use eieio--slot-name-index rather than eieio-slot-name-index. | ||
| 200 | |||
| 201 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 202 | |||
| 203 | * emacs-lisp/eieio.el (make-instance): Simplify by not adding an object | ||
| 204 | name argument. | ||
| 205 | (eieio-object-name): Use eieio-object-name-string. | ||
| 206 | (eieio--object-names): New const. | ||
| 207 | (eieio-object-name-string, eieio-object-set-name-string): Re-implement | ||
| 208 | using a hashtable rather than a built-in slot. | ||
| 209 | (eieio-constructor): Rename from `constructor'. Remove `newname' arg. | ||
| 210 | (clone): Don't mess with the object's "name". | ||
| 211 | |||
| 212 | * emacs-lisp/eieio-custom.el (eieio-widget-test): Remove dummy arg. | ||
| 213 | (eieio-object-value-get): Use eieio-object-set-name-string. | ||
| 214 | |||
| 215 | * emacs-lisp/eieio-core.el (eieio--defalias): Follow aliases. | ||
| 216 | (eieio--object): Remove `name' field. | ||
| 217 | (eieio-defclass): Adjust to new convention where constructors don't | ||
| 218 | take an "object name" any more. | ||
| 219 | (eieio--defgeneric-init-form, eieio--defmethod): Follow aliases. | ||
| 220 | (eieio-validate-slot-value, eieio-oset-default) | ||
| 221 | (eieio-slot-name-index): Don't hardcode eieio--object-num-slots. | ||
| 222 | (eieio-generic-call-primary-only): Simplify. | ||
| 223 | |||
| 224 | * emacs-lisp/eieio-base.el (clone) <eieio-instance-inheritor>: | ||
| 225 | Use call-next-method. | ||
| 226 | (eieio-constructor): Rename from `constructor'. | ||
| 227 | (eieio-persistent-convert-list-to-object): Drop objname. | ||
| 228 | (eieio-persistent-validate/fix-slot-value): Don't hardcode | ||
| 229 | eieio--object-num-slots. | ||
| 230 | (eieio-named): Use a normal slot. | ||
| 231 | (slot-missing) <eieio-named>: Remove. | ||
| 232 | (eieio-object-name-string, eieio-object-set-name-string, clone) | ||
| 233 | <eieio-named>: New methods. | ||
| 234 | |||
| 235 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 236 | |||
| 237 | * emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v. | ||
| 238 | (method-*): Add a "eieio--" prefix to those constants. | ||
| 239 | |||
| 240 | * emacs-lisp/eieio.el: Move edebug specs to the corresponding macro. | ||
| 241 | |||
| 242 | * emacs-lisp/eieio-speedbar.el: Use lexical-binding. | ||
| 243 | |||
| 244 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 245 | |||
| 246 | * emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is | ||
| 247 | `eieio-default-superclass'. | ||
| 248 | |||
| 249 | * emacs-lisp/eieio-datadebug.el: Use lexical-binding. | ||
| 250 | |||
| 251 | * emacs-lisp/eieio-custom.el: Use lexical-binding. | ||
| 252 | (eieio-object-value-to-abstract): Simplify. | ||
| 253 | |||
| 254 | * emacs-lisp/eieio-opt.el (eieio-build-class-list): Use cl-mapcan. | ||
| 255 | (eieio-build-class-alist): Use dolist. | ||
| 256 | (eieio-all-generic-functions): Adjust to use of hashtables. | ||
| 257 | |||
| 258 | * emacs-lisp/eieio-core.el (class): Rename field symbol-obarray to | ||
| 259 | symbol-hashtable. It contains a hashtable instead of an obarray. | ||
| 260 | (generic-p): Use symbol property `eieio-method-hashtable' instead of | ||
| 261 | `eieio-method-obarray'. | ||
| 262 | (generic-primary-only-p, generic-primary-only-one-p): | ||
| 263 | Slight optimization. | ||
| 264 | (eieio-defclass-autoload-map): Use a hashtable instead of an obarray. | ||
| 265 | (eieio-defclass-autoload, eieio-defclass): Adjust/simplify accordingly. | ||
| 266 | (eieio-class-un-autoload): Use autoload-do-load. | ||
| 267 | (eieio-defclass): Use dolist, cl-pushnew, cl-callf. | ||
| 268 | Use new cl-deftype-satisfies. Adjust to use of hashtables. | ||
| 269 | Don't hardcode the value of eieio--object-num-slots. | ||
| 270 | (eieio-defgeneric-form-primary-only-one): Remove `doc-string' arg. | ||
| 271 | Use a closure rather than a backquoted lambda. | ||
| 272 | (eieio--defmethod): Adjust call accordingly. Set doc-string via the | ||
| 273 | function-documentation property. | ||
| 274 | (eieio-slot-originating-class-p, eieio-slot-name-index) | ||
| 275 | (eieiomt--optimizing-hashtable, eieiomt-install, eieiomt-add) | ||
| 276 | (eieio-generic-form): Adjust to use of hashtables. | ||
| 277 | (eieiomt--sym-optimize): Rename from eieiomt-sym-optimize; take | ||
| 278 | additional class argument. | ||
| 279 | (eieio-generic-call-methodname): Remove, unused. | ||
| 280 | |||
| 281 | * emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p): | ||
| 282 | Prefer \' to $. | ||
| 283 | |||
| 284 | 2015-01-08 Eli Zaretskii <eliz@gnu.org> | ||
| 285 | |||
| 286 | * simple.el (line-move-visual): When converting X pixel coordinate | ||
| 287 | to temporary-goal-column, adjust the value for right-to-left | ||
| 288 | screen lines. This fixes vertical-motion, next/prev-line, etc. | ||
| 289 | |||
| 290 | 2015-01-08 Glenn Morris <rgm@gnu.org> | ||
| 291 | |||
| 292 | * files.el (file-tree-walk): Remove; of unknown authorship. (Bug#19325) | ||
| 293 | |||
| 294 | 2015-01-07 K. Handa <handa@gnu.org> | ||
| 295 | |||
| 296 | * international/ccl.el (define-ccl-program): Improve the docstring. | ||
| 297 | |||
| 298 | 2015-01-06 Sam Steingold <sds@gnu.org> | ||
| 299 | |||
| 300 | * shell.el (shell-display-buffer-actions): Remove, | ||
| 301 | use `display-buffer-alist' instead. | ||
| 302 | |||
| 303 | 2015-01-05 Dmitry Gutov <dgutov@yandex.ru> | ||
| 304 | |||
| 305 | * progmodes/xref.el (xref--insert-xrefs): Add `help-echo' property | ||
| 306 | to the references. | ||
| 307 | |||
| 308 | 2015-01-05 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 309 | |||
| 310 | * minibuffer.el (completion-category-defaults): New var. | ||
| 311 | Set unicode-name to use substring completion. | ||
| 312 | (completion-category-defaults): Set it to nil. | ||
| 313 | |||
| 1 | 2015-01-04 Dmitry Gutov <dgutov@yandex.ru> | 314 | 2015-01-04 Dmitry Gutov <dgutov@yandex.ru> |
| 2 | 315 | ||
| 3 | Add mouse interaction to xref. | 316 | Add mouse interaction to xref. |
| 4 | |||
| 5 | * progmodes/xref.el (xref--button-map): New variable. | 317 | * progmodes/xref.el (xref--button-map): New variable. |
| 6 | (xref--mouse-2): New command. | 318 | (xref--mouse-2): New command. |
| 7 | (xref--insert-xrefs): Add `mouse-face' and `keymap' properties to | 319 | (xref--insert-xrefs): Add `mouse-face' and `keymap' properties to |
| @@ -30,7 +342,6 @@ | |||
| 30 | 2015-01-04 Dmitry Gutov <dgutov@yandex.ru> | 342 | 2015-01-04 Dmitry Gutov <dgutov@yandex.ru> |
| 31 | 343 | ||
| 32 | Unbreak `mouse-action' property in text buttons. | 344 | Unbreak `mouse-action' property in text buttons. |
| 33 | |||
| 34 | * button.el (push-button): Fix regression from 2012-12-06. | 345 | * button.el (push-button): Fix regression from 2012-12-06. |
| 35 | 346 | ||
| 36 | 2015-01-03 Dmitry Gutov <dgutov@yandex.ru> | 347 | 2015-01-03 Dmitry Gutov <dgutov@yandex.ru> |
| @@ -144,11 +455,9 @@ | |||
| 144 | 2014-12-29 Dmitry Gutov <dgutov@yandex.ru> | 455 | 2014-12-29 Dmitry Gutov <dgutov@yandex.ru> |
| 145 | 456 | ||
| 146 | Unbreak jumping to an alias's definition. | 457 | Unbreak jumping to an alias's definition. |
| 147 | |||
| 148 | * emacs-lisp/find-func.el (find-function-library): Return a pair | 458 | * emacs-lisp/find-func.el (find-function-library): Return a pair |
| 149 | (ORIG-FUNCTION . LIBRARY) instead of just its second element. | 459 | (ORIG-FUNCTION . LIBRARY) instead of just its second element. |
| 150 | (find-function-noselect): Use it. | 460 | (find-function-noselect): Use it. |
| 151 | |||
| 152 | * progmodes/elisp-mode.el (elisp--xref-identifier-file): Rename to | 461 | * progmodes/elisp-mode.el (elisp--xref-identifier-file): Rename to |
| 153 | `elisp--xref-identifier-location', incorporate logic from | 462 | `elisp--xref-identifier-location', incorporate logic from |
| 154 | `elisp--xref-find-definitions', use the changed | 463 | `elisp--xref-find-definitions', use the changed |
| @@ -217,7 +526,6 @@ | |||
| 217 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> | 526 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> |
| 218 | 527 | ||
| 219 | python.el: Native readline completion. | 528 | python.el: Native readline completion. |
| 220 | |||
| 221 | * progmodes/python.el (python-shell-completion-native-disabled-interpreters) | 529 | * progmodes/python.el (python-shell-completion-native-disabled-interpreters) |
| 222 | (python-shell-completion-native-enable) | 530 | (python-shell-completion-native-enable) |
| 223 | (python-shell-completion-native-output-timeout): New defcustoms. | 531 | (python-shell-completion-native-output-timeout): New defcustoms. |
| @@ -236,9 +544,8 @@ | |||
| 236 | 544 | ||
| 237 | python.el: Enhance shell user interaction and deprecate | 545 | python.el: Enhance shell user interaction and deprecate |
| 238 | python-shell-get-or-create-process. | 546 | python-shell-get-or-create-process. |
| 239 | 547 | * progmodes/python.el (python-shell-get-process-or-error): | |
| 240 | * progmodes/python.el | 548 | New function. |
| 241 | (python-shell-get-process-or-error): New function. | ||
| 242 | (python-shell-with-shell-buffer): Use it. | 549 | (python-shell-with-shell-buffer): Use it. |
| 243 | (python-shell-send-string, python-shell-send-region) | 550 | (python-shell-send-string, python-shell-send-region) |
| 244 | (python-shell-send-buffer, python-shell-send-defun) | 551 | (python-shell-send-buffer, python-shell-send-defun) |
| @@ -266,22 +573,15 @@ | |||
| 266 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> | 573 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> |
| 267 | 574 | ||
| 268 | python.el: Fix message when sending region. | 575 | python.el: Fix message when sending region. |
| 269 | |||
| 270 | * progmodes/python.el (python-shell-send-region): Rename argument | 576 | * progmodes/python.el (python-shell-send-region): Rename argument |
| 271 | send-main from nomain. Fix message. | 577 | send-main from nomain. Fix message. |
| 272 | (python-shell-send-buffer): Rename argument send-main from arg. | 578 | (python-shell-send-buffer): Rename argument send-main from arg. |
| 273 | 579 | ||
| 274 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> | ||
| 275 | |||
| 276 | python.el: Cleanup temp files even with eval errors. | 580 | python.el: Cleanup temp files even with eval errors. |
| 277 | |||
| 278 | * progmodes/python.el (python-shell-send-file): Make file-name | 581 | * progmodes/python.el (python-shell-send-file): Make file-name |
| 279 | mandatory. Fix temp file removal in the majority of cases. | 582 | mandatory. Fix temp file removal in the majority of cases. |
| 280 | 583 | ||
| 281 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> | ||
| 282 | |||
| 283 | python.el: Handle file encoding for shell. | 584 | python.el: Handle file encoding for shell. |
| 284 | |||
| 285 | * progmodes/python.el (python-rx-constituents): Add coding-cookie. | 585 | * progmodes/python.el (python-rx-constituents): Add coding-cookie. |
| 286 | (python-shell--save-temp-file): Write file with proper encoding. | 586 | (python-shell--save-temp-file): Write file with proper encoding. |
| 287 | (python-shell-buffer-substring): Add coding cookie for detected | 587 | (python-shell-buffer-substring): Add coding cookie for detected |
| @@ -343,7 +643,7 @@ | |||
| 343 | 643 | ||
| 344 | 2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> | 644 | 2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> |
| 345 | 645 | ||
| 346 | * lisp/subr.el (redisplay-dont-pause): Mark as obsolete. | 646 | * subr.el (redisplay-dont-pause): Mark as obsolete. |
| 347 | 647 | ||
| 348 | 2014-12-27 Michael Albinus <michael.albinus@gmx.de> | 648 | 2014-12-27 Michael Albinus <michael.albinus@gmx.de> |
| 349 | 649 | ||
| @@ -416,7 +716,6 @@ | |||
| 416 | 2014-12-26 Fabián Ezequiel Gallina <fgallina@gnu.org> | 716 | 2014-12-26 Fabián Ezequiel Gallina <fgallina@gnu.org> |
| 417 | 717 | ||
| 418 | python.el: Generate clearer shell buffer names. | 718 | python.el: Generate clearer shell buffer names. |
| 419 | |||
| 420 | * progmodes/python.el (python-shell-get-process-name) | 719 | * progmodes/python.el (python-shell-get-process-name) |
| 421 | (python-shell-internal-get-process-name): Use `buffer-name`. | 720 | (python-shell-internal-get-process-name): Use `buffer-name`. |
| 422 | (python-shell-internal-get-or-create-process): Simplify. | 721 | (python-shell-internal-get-or-create-process): Simplify. |
| @@ -539,7 +838,7 @@ | |||
| 539 | 2014-12-19 Alan Mackenzie <acm@muc.de> | 838 | 2014-12-19 Alan Mackenzie <acm@muc.de> |
| 540 | 839 | ||
| 541 | Make C++11 uniform init syntax work. | 840 | Make C++11 uniform init syntax work. |
| 542 | New keywords "final" and "override" | 841 | New keywords "final" and "override". |
| 543 | * progmodes/cc-engine.el (c-back-over-member-initializer-braces): | 842 | * progmodes/cc-engine.el (c-back-over-member-initializer-braces): |
| 544 | New function. | 843 | New function. |
| 545 | (c-guess-basic-syntax): Set `containing-sex' and `lim' using the | 844 | (c-guess-basic-syntax): Set `containing-sex' and `lim' using the |
| @@ -575,8 +874,7 @@ | |||
| 575 | 874 | ||
| 576 | 2014-12-18 Artur Malabarba <bruce.connor.am@gmail.com> | 875 | 2014-12-18 Artur Malabarba <bruce.connor.am@gmail.com> |
| 577 | 876 | ||
| 578 | * let-alist.el (let-alist): Evaluate the `alist' argument only | 877 | * let-alist.el (let-alist): Evaluate the `alist' argument only once. |
| 579 | once. | ||
| 580 | 878 | ||
| 581 | 2014-12-18 Sam Steingold <sds@gnu.org> | 879 | 2014-12-18 Sam Steingold <sds@gnu.org> |
| 582 | 880 | ||
| @@ -590,13 +888,12 @@ | |||
| 590 | Add code for "preserving" window sizes. | 888 | Add code for "preserving" window sizes. |
| 591 | * dired.el (dired-pop-to-buffer): Call fit-window-to-buffer with | 889 | * dired.el (dired-pop-to-buffer): Call fit-window-to-buffer with |
| 592 | `preserve-size' t. | 890 | `preserve-size' t. |
| 593 | (dired-mark-pop-up): Preserve size of window showing marked | 891 | (dired-mark-pop-up): Preserve size of window showing marked files. |
| 594 | files. | ||
| 595 | * electric.el (Electric-pop-up-window): | 892 | * electric.el (Electric-pop-up-window): |
| 596 | * help.el (resize-temp-buffer-window): Call fit-window-to-buffer | 893 | * help.el (resize-temp-buffer-window): Call fit-window-to-buffer |
| 597 | with `preserve-size' t. | 894 | with `preserve-size' t. |
| 598 | * minibuffer.el (minibuffer-completion-help): Use | 895 | * minibuffer.el (minibuffer-completion-help): |
| 599 | `resize-temp-buffer-window' instead of `fit-window-to-buffer' | 896 | Use `resize-temp-buffer-window' instead of `fit-window-to-buffer' |
| 600 | (Bug#19355). Preserve size of completions window. | 897 | (Bug#19355). Preserve size of completions window. |
| 601 | * register.el (register-preview): Preserve size of register | 898 | * register.el (register-preview): Preserve size of register |
| 602 | preview window. | 899 | preview window. |
| @@ -606,8 +903,7 @@ | |||
| 606 | `window-preserve-size'. | 903 | `window-preserve-size'. |
| 607 | (window-min-pixel-size, window--preservable-size) | 904 | (window-min-pixel-size, window--preservable-size) |
| 608 | (window-preserve-size, window-preserved-size) | 905 | (window-preserve-size, window-preserved-size) |
| 609 | (window--preserve-size, window--min-size-ignore-p): New | 906 | (window--preserve-size, window--min-size-ignore-p): New functions. |
| 610 | functions. | ||
| 611 | (window-min-size, window-min-delta, window--resizable) | 907 | (window-min-size, window-min-delta, window--resizable) |
| 612 | (window--resize-this-window, split-window-below) | 908 | (window--resize-this-window, split-window-below) |
| 613 | (split-window-right): Amend doc-string. | 909 | (split-window-right): Amend doc-string. |
| @@ -622,8 +918,7 @@ | |||
| 622 | window above or below. | 918 | window above or below. |
| 623 | (window--state-put-2): Handle horizontal scroll bars. | 919 | (window--state-put-2): Handle horizontal scroll bars. |
| 624 | (window--display-buffer): Call `preserve-size' if asked for. | 920 | (window--display-buffer): Call `preserve-size' if asked for. |
| 625 | (display-buffer): Mention `preserve-size' alist member in | 921 | (display-buffer): Mention `preserve-size' alist member in doc-string. |
| 626 | doc-string. | ||
| 627 | (fit-window-to-buffer): New argument PRESERVE-SIZE. | 922 | (fit-window-to-buffer): New argument PRESERVE-SIZE. |
| 628 | * textmodes/ispell.el (ispell-command-loop): Suppress horizontal | 923 | * textmodes/ispell.el (ispell-command-loop): Suppress horizontal |
| 629 | scroll bar on ispell's windows. Don't count window lines and | 924 | scroll bar on ispell's windows. Don't count window lines and |
| @@ -711,7 +1006,7 @@ | |||
| 711 | 1006 | ||
| 712 | 2014-12-14 Alan Mackenzie <acm@muc.de> | 1007 | 2014-12-14 Alan Mackenzie <acm@muc.de> |
| 713 | 1008 | ||
| 714 | * lisp/cus-start.el (all): Add fast-but-imprecise-scrolling. | 1009 | * cus-start.el (all): Add fast-but-imprecise-scrolling. |
| 715 | 1010 | ||
| 716 | 2014-12-14 Artur Malabarba <bruce.connor.am@gmail.com> | 1011 | 2014-12-14 Artur Malabarba <bruce.connor.am@gmail.com> |
| 717 | 1012 | ||
| @@ -1857,7 +2152,7 @@ | |||
| 1857 | 2152 | ||
| 1858 | 2014-11-19 Artur Malabarba <bruce.connor.am@gmail.com> | 2153 | 2014-11-19 Artur Malabarba <bruce.connor.am@gmail.com> |
| 1859 | 2154 | ||
| 1860 | * lisp/ido.el (ido-bury-buffer-at-head): New command. | 2155 | * ido.el (ido-bury-buffer-at-head): New command. |
| 1861 | (ido-buffer-completion-map): Bind it to C-S-b. | 2156 | (ido-buffer-completion-map): Bind it to C-S-b. |
| 1862 | 2157 | ||
| 1863 | 2014-11-18 Juri Linkov <juri@linkov.net> | 2158 | 2014-11-18 Juri Linkov <juri@linkov.net> |
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 367ed9f41c8..5c958350ff0 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog | |||
| @@ -1,3 +1,52 @@ | |||
| 1 | 2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | Don't use <class> as a variable and don't assume that <class>-list-p is | ||
| 4 | automatically defined. | ||
| 5 | |||
| 6 | * ede/speedbar.el (ede-speedbar-compile-line) | ||
| 7 | (ede-speedbar-get-top-project-for-line): | ||
| 8 | * ede.el (ede-buffer-belongs-to-target-p) | ||
| 9 | (ede-buffer-belongs-to-project-p, ede-build-forms-menu) | ||
| 10 | (ede-add-project-to-global-list): | ||
| 11 | * semantic/db-typecache.el (semanticdb-get-typecache): | ||
| 12 | * semantic/db-file.el (semanticdb-load-database): | ||
| 13 | * semantic/db-el.el (semanticdb-elisp-sym->tag): | ||
| 14 | * semantic/db-ebrowse.el (semanticdb-ebrowse-load-helper): | ||
| 15 | * ede/project-am.el (project-am-preferred-target-type): | ||
| 16 | * ede/proj.el (ede-proj-load): | ||
| 17 | * ede/custom.el (ede-customize-current-target, ede-customize-target): | ||
| 18 | * semantic/ede-grammar.el ("semantic grammar"): | ||
| 19 | * semantic/scope.el (semantic-scope-reset-cache) | ||
| 20 | (semantic-calculate-scope): | ||
| 21 | * srecode/map.el (srecode-map-update-map): | ||
| 22 | * srecode/insert.el (srecode-insert-show-error-report) | ||
| 23 | (srecode-insert-method, srecode-insert-include-lookup) | ||
| 24 | (srecode-insert-method): | ||
| 25 | * srecode/fields.el (srecode-active-template-region): | ||
| 26 | * srecode/compile.el (srecode-flush-active-templates) | ||
| 27 | (srecode-compile-inserter): Don't use <class> as a variable. | ||
| 28 | Use `oref-default' for class slots. | ||
| 29 | |||
| 30 | * semantic/grammar.el (semantic-grammar-eldoc-last-data): New var. | ||
| 31 | (semantic-grammar-eldoc-get-macro-docstring): Use it instead of | ||
| 32 | eldoc-last-data. | ||
| 33 | * semantic/fw.el (semantic-exit-on-input): Use `declare'. | ||
| 34 | (semantic-throw-on-input): Use `with-current-buffer'. | ||
| 35 | * semantic/db.el (semanticdb-abstract-table-list): Define if not | ||
| 36 | pre-defined. | ||
| 37 | * semantic/db-find.el (semanticdb-find-tags-collector): | ||
| 38 | Use save-current-buffer. | ||
| 39 | (semanticdb-find-tags-collector): Don't use <class> as a variable. | ||
| 40 | * semantic/complete.el (semantic-complete-active-default) | ||
| 41 | (semantic-complete-current-matched-tag): Declare. | ||
| 42 | (semantic-complete-inline-custom-type): Don't use <class> as a variable. | ||
| 43 | * semantic/bovine/make.el (semantic-analyze-possible-completions): | ||
| 44 | Use with-current-buffer. | ||
| 45 | * semantic.el (semantic-parser-warnings): Declare. | ||
| 46 | * ede/base.el (ede-target-list): Define if not pre-defined. | ||
| 47 | (ede-with-projectfile): Prefer find-file-noselect over | ||
| 48 | save-window-excursion. | ||
| 49 | |||
| 1 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> | 50 | 2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 51 | ||
| 3 | * srecode/srt-mode.el (srecode-macro-help): Use eieio-class-children. | 52 | * srecode/srt-mode.el (srecode-macro-help): Use eieio-class-children. |
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index edf87f640cf..87cfb85b2c2 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el | |||
| @@ -248,12 +248,12 @@ Argument LIST-O-O is the list of objects to choose from." | |||
| 248 | (let ((obj ede-object)) | 248 | (let ((obj ede-object)) |
| 249 | (if (consp obj) | 249 | (if (consp obj) |
| 250 | (setq obj (car obj))) | 250 | (setq obj (car obj))) |
| 251 | (and obj (obj-of-class-p obj ede-target)))) | 251 | (and obj (obj-of-class-p obj 'ede-target)))) |
| 252 | 252 | ||
| 253 | (defun ede-buffer-belongs-to-project-p () | 253 | (defun ede-buffer-belongs-to-project-p () |
| 254 | "Return non-nil if this buffer belongs to at least one project." | 254 | "Return non-nil if this buffer belongs to at least one project." |
| 255 | (if (or (null ede-object) (consp ede-object)) nil | 255 | (if (or (null ede-object) (consp ede-object)) nil |
| 256 | (obj-of-class-p ede-object-project ede-project))) | 256 | (obj-of-class-p ede-object-project 'ede-project))) |
| 257 | 257 | ||
| 258 | (defun ede-menu-obj-of-class-p (class) | 258 | (defun ede-menu-obj-of-class-p (class) |
| 259 | "Return non-nil if some member of `ede-object' is a child of CLASS." | 259 | "Return non-nil if some member of `ede-object' is a child of CLASS." |
| @@ -281,7 +281,7 @@ Argument MENU-DEF is the menu definition to use." | |||
| 281 | ;; First, collect the build items from the project | 281 | ;; First, collect the build items from the project |
| 282 | (setq newmenu (append newmenu (ede-menu-items-build obj t))) | 282 | (setq newmenu (append newmenu (ede-menu-items-build obj t))) |
| 283 | ;; Second, declare the current target menu items | 283 | ;; Second, declare the current target menu items |
| 284 | (if (and ede-obj (ede-menu-obj-of-class-p ede-target)) | 284 | (if (and ede-obj (ede-menu-obj-of-class-p 'ede-target)) |
| 285 | (while ede-obj | 285 | (while ede-obj |
| 286 | (setq newmenu (append newmenu | 286 | (setq newmenu (append newmenu |
| 287 | (ede-menu-items-build (car ede-obj) t)) | 287 | (ede-menu-items-build (car ede-obj) t)) |
| @@ -1078,7 +1078,7 @@ On success, return the added project." | |||
| 1078 | (error "No project created to add to master list")) | 1078 | (error "No project created to add to master list")) |
| 1079 | (when (not (eieio-object-p proj)) | 1079 | (when (not (eieio-object-p proj)) |
| 1080 | (error "Attempt to add non-object to master project list")) | 1080 | (error "Attempt to add non-object to master project list")) |
| 1081 | (when (not (obj-of-class-p proj ede-project-placeholder)) | 1081 | (when (not (obj-of-class-p proj 'ede-project-placeholder)) |
| 1082 | (error "Attempt to add a non-project to the ede projects list")) | 1082 | (error "Attempt to add a non-project to the ede projects list")) |
| 1083 | (add-to-list 'ede-projects proj) | 1083 | (add-to-list 'ede-projects proj) |
| 1084 | proj) | 1084 | proj) |
| @@ -1099,6 +1099,8 @@ Flush the dead projects from the project cache." | |||
| 1099 | (ede-delete-project-from-global-list D)) | 1099 | (ede-delete-project-from-global-list D)) |
| 1100 | )) | 1100 | )) |
| 1101 | 1101 | ||
| 1102 | (defvar ede--disable-inode) ;Defined in ede/files.el. | ||
| 1103 | |||
| 1102 | (defun ede-global-list-sanity-check () | 1104 | (defun ede-global-list-sanity-check () |
| 1103 | "Perform a sanity check to make sure there are no duplicate projects." | 1105 | "Perform a sanity check to make sure there are no duplicate projects." |
| 1104 | (interactive) | 1106 | (interactive) |
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 9f4fa45ff3a..ce7857b53a3 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el | |||
| @@ -159,6 +159,9 @@ and querying them will cause the actual project to get loaded.") | |||
| 159 | ;; Projects can also affect how EDE works, by changing what appears in | 159 | ;; Projects can also affect how EDE works, by changing what appears in |
| 160 | ;; the EDE menu, or how some keys are bound. | 160 | ;; the EDE menu, or how some keys are bound. |
| 161 | ;; | 161 | ;; |
| 162 | (unless (fboundp 'ede-target-list-p) | ||
| 163 | (cl-deftype ede-target-list () '(list-of ede-target))) | ||
| 164 | |||
| 162 | (defclass ede-project (ede-project-placeholder) | 165 | (defclass ede-project (ede-project-placeholder) |
| 163 | ((subproj :initform nil | 166 | ((subproj :initform nil |
| 164 | :type list | 167 | :type list |
| @@ -287,16 +290,18 @@ All specific project types must derive from this project." | |||
| 287 | ;; | 290 | ;; |
| 288 | (defmacro ede-with-projectfile (obj &rest forms) | 291 | (defmacro ede-with-projectfile (obj &rest forms) |
| 289 | "For the project in which OBJ resides, execute FORMS." | 292 | "For the project in which OBJ resides, execute FORMS." |
| 290 | `(save-window-excursion | 293 | (declare (indent 1)) |
| 291 | (let* ((pf (if (obj-of-class-p ,obj ede-target) | 294 | (unless (symbolp obj) |
| 292 | (ede-target-parent ,obj) | 295 | (message "Beware! ede-with-projectfile's first arg is copied: %S" obj)) |
| 293 | ,obj)) | 296 | `(let* ((pf (if (obj-of-class-p ,obj 'ede-target) |
| 294 | (dbka (get-file-buffer (oref pf file)))) | 297 | (ede-target-parent ,obj) |
| 295 | (if (not dbka) (find-file (oref pf file)) | 298 | ,obj)) |
| 296 | (switch-to-buffer dbka)) | 299 | (dbka (get-file-buffer (oref pf file)))) |
| 300 | (with-current-buffer | ||
| 301 | (if (not dbka) (find-file-noselect (oref pf file)) | ||
| 302 | dbka) | ||
| 297 | ,@forms | 303 | ,@forms |
| 298 | (if (not dbka) (kill-buffer (current-buffer)))))) | 304 | (if (not dbka) (kill-buffer (current-buffer)))))) |
| 299 | (put 'ede-with-projectfile 'lisp-indent-function 1) | ||
| 300 | 305 | ||
| 301 | ;;; The EDE persistent cache. | 306 | ;;; The EDE persistent cache. |
| 302 | ;; | 307 | ;; |
diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el index 3cc3a48c27a..a39b4880283 100644 --- a/lisp/cedet/ede/custom.el +++ b/lisp/cedet/ede/custom.el | |||
| @@ -61,7 +61,7 @@ | |||
| 61 | "Edit fields of the current target through EIEIO & Custom." | 61 | "Edit fields of the current target through EIEIO & Custom." |
| 62 | (interactive) | 62 | (interactive) |
| 63 | (require 'eieio-custom) | 63 | (require 'eieio-custom) |
| 64 | (if (not (obj-of-class-p ede-object ede-target)) | 64 | (if (not (obj-of-class-p ede-object 'ede-target)) |
| 65 | (error "Current file is not part of a target")) | 65 | (error "Current file is not part of a target")) |
| 66 | (ede-customize-target ede-object)) | 66 | (ede-customize-target ede-object)) |
| 67 | 67 | ||
| @@ -72,7 +72,7 @@ | |||
| 72 | "Edit fields of the current target through EIEIO & Custom. | 72 | "Edit fields of the current target through EIEIO & Custom. |
| 73 | OBJ is the target object to customize." | 73 | OBJ is the target object to customize." |
| 74 | (require 'eieio-custom) | 74 | (require 'eieio-custom) |
| 75 | (if (and obj (not (obj-of-class-p obj ede-target))) | 75 | (if (and obj (not (obj-of-class-p obj 'ede-target))) |
| 76 | (error "No logical target to customize")) | 76 | (error "No logical target to customize")) |
| 77 | (ede-customize obj)) | 77 | (ede-customize obj)) |
| 78 | 78 | ||
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index 1ea16570467..fd789b3857d 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el | |||
| @@ -297,7 +297,7 @@ for the tree being read in. If ROOTPROJ is nil, then assume that | |||
| 297 | the PROJECT being read in is the root project." | 297 | the PROJECT being read in is the root project." |
| 298 | (save-excursion | 298 | (save-excursion |
| 299 | (let ((ret (eieio-persistent-read (concat project "Project.ede") | 299 | (let ((ret (eieio-persistent-read (concat project "Project.ede") |
| 300 | ede-proj-project)) | 300 | 'ede-proj-project)) |
| 301 | (subdirs (directory-files project nil "[^.].*" nil))) | 301 | (subdirs (directory-files project nil "[^.].*" nil))) |
| 302 | (if (not (object-of-class-p ret 'ede-proj-project)) | 302 | (if (not (object-of-class-p ret 'ede-proj-project)) |
| 303 | (error "Corrupt project file")) | 303 | (error "Corrupt project file")) |
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index 75fd195105f..d0ca8091c90 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el | |||
| @@ -853,13 +853,13 @@ Argument FILE is the file to extract the end directory name from." | |||
| 853 | (defun project-am-preferred-target-type (file) | 853 | (defun project-am-preferred-target-type (file) |
| 854 | "For FILE, return the preferred type for that file." | 854 | "For FILE, return the preferred type for that file." |
| 855 | (cond ((string-match "\\.texi?\\(nfo\\)$" file) | 855 | (cond ((string-match "\\.texi?\\(nfo\\)$" file) |
| 856 | project-am-texinfo) | 856 | 'project-am-texinfo) |
| 857 | ((string-match "\\.[0-9]$" file) | 857 | ((string-match "\\.[0-9]$" file) |
| 858 | project-am-man) | 858 | 'project-am-man) |
| 859 | ((string-match "\\.el$" file) | 859 | ((string-match "\\.el$" file) |
| 860 | project-am-lisp) | 860 | 'project-am-lisp) |
| 861 | (t | 861 | (t |
| 862 | project-am-program))) | 862 | 'project-am-program))) |
| 863 | 863 | ||
| 864 | (defmethod ede-buffer-header-file((this project-am-objectcode) buffer) | 864 | (defmethod ede-buffer-header-file((this project-am-objectcode) buffer) |
| 865 | "There are no default header files." | 865 | "There are no default header files." |
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el index fc26ec948a2..e08562a3738 100644 --- a/lisp/cedet/ede/speedbar.el +++ b/lisp/cedet/ede/speedbar.el | |||
| @@ -121,9 +121,9 @@ Argument DIR is the directory from which to derive the list of objects." | |||
| 121 | (let ((obj (eieio-speedbar-find-nearest-object))) | 121 | (let ((obj (eieio-speedbar-find-nearest-object))) |
| 122 | (if (not (eieio-object-p obj)) | 122 | (if (not (eieio-object-p obj)) |
| 123 | nil | 123 | nil |
| 124 | (cond ((obj-of-class-p obj ede-project) | 124 | (cond ((obj-of-class-p obj 'ede-project) |
| 125 | (project-compile-project obj)) | 125 | (project-compile-project obj)) |
| 126 | ((obj-of-class-p obj ede-target) | 126 | ((obj-of-class-p obj 'ede-target) |
| 127 | (project-compile-target obj)) | 127 | (project-compile-target obj)) |
| 128 | (t (error "Error in speedbar structure")))))) | 128 | (t (error "Error in speedbar structure")))))) |
| 129 | 129 | ||
| @@ -133,9 +133,9 @@ Argument DIR is the directory from which to derive the list of objects." | |||
| 133 | (let ((obj (eieio-speedbar-find-nearest-object))) | 133 | (let ((obj (eieio-speedbar-find-nearest-object))) |
| 134 | (if (not (eieio-object-p obj)) | 134 | (if (not (eieio-object-p obj)) |
| 135 | (error "Error in speedbar or ede structure") | 135 | (error "Error in speedbar or ede structure") |
| 136 | (if (obj-of-class-p obj ede-target) | 136 | (if (obj-of-class-p obj 'ede-target) |
| 137 | (setq obj (ede-target-parent obj))) | 137 | (setq obj (ede-target-parent obj))) |
| 138 | (if (obj-of-class-p obj ede-project) | 138 | (if (obj-of-class-p obj 'ede-project) |
| 139 | obj | 139 | obj |
| 140 | (error "Error in speedbar or ede structure"))))) | 140 | (error "Error in speedbar or ede structure"))))) |
| 141 | 141 | ||
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 7afe67b3207..81a97884554 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el | |||
| @@ -573,6 +573,7 @@ string." | |||
| 573 | ;; The best way to call the parser from programs is via | 573 | ;; The best way to call the parser from programs is via |
| 574 | ;; `semantic-fetch-tags'. This, in turn, uses other internal | 574 | ;; `semantic-fetch-tags'. This, in turn, uses other internal |
| 575 | ;; API functions which plug-in parsers can take advantage of. | 575 | ;; API functions which plug-in parsers can take advantage of. |
| 576 | (defvar semantic-parser-warnings) | ||
| 576 | 577 | ||
| 577 | (defun semantic-fetch-tags () | 578 | (defun semantic-fetch-tags () |
| 578 | "Fetch semantic tags from the current buffer. | 579 | "Fetch semantic tags from the current buffer. |
| @@ -602,49 +603,49 @@ was marked unparseable, then do nothing, and return the cache." | |||
| 602 | (garbage-collect) | 603 | (garbage-collect) |
| 603 | (cond | 604 | (cond |
| 604 | 605 | ||
| 605 | ;;;; Try the incremental parser to do a fast update. | 606 | ;; Try the incremental parser to do a fast update. |
| 606 | ((semantic-parse-tree-needs-update-p) | 607 | ((semantic-parse-tree-needs-update-p) |
| 607 | (setq res (semantic-parse-changes)) | 608 | (setq res (semantic-parse-changes)) |
| 608 | (if (semantic-parse-tree-needs-rebuild-p) | 609 | (if (semantic-parse-tree-needs-rebuild-p) |
| 609 | ;; If the partial reparse fails, jump to a full reparse. | 610 | ;; If the partial reparse fails, jump to a full reparse. |
| 610 | (semantic-fetch-tags) | 611 | (semantic-fetch-tags) |
| 611 | ;; Clear the cache of unmatched syntax tokens | 612 | ;; Clear the cache of unmatched syntax tokens |
| 612 | ;; | 613 | ;; |
| 613 | ;; NOTE TO SELF: | 614 | ;; NOTE TO SELF: |
| 614 | ;; | 615 | ;; |
| 615 | ;; Move this into the incremental parser. This is a bug. | 616 | ;; Move this into the incremental parser. This is a bug. |
| 616 | ;; | 617 | ;; |
| 617 | (semantic-clear-unmatched-syntax-cache) | 618 | (semantic-clear-unmatched-syntax-cache) |
| 618 | (run-hook-with-args ;; Let hooks know the updated tags | 619 | (run-hook-with-args ;; Let hooks know the updated tags |
| 619 | 'semantic-after-partial-cache-change-hook res)) | 620 | 'semantic-after-partial-cache-change-hook res)) |
| 620 | (setq semantic--completion-cache nil)) | 621 | (setq semantic--completion-cache nil)) |
| 621 | 622 | ||
| 622 | ;;;; Parse the whole system. | 623 | ;; Parse the whole system. |
| 623 | ((semantic-parse-tree-needs-rebuild-p) | 624 | ((semantic-parse-tree-needs-rebuild-p) |
| 624 | ;; Use Emacs's built-in progress-reporter (only interactive). | 625 | ;; Use Emacs's built-in progress-reporter (only interactive). |
| 625 | (if noninteractive | 626 | (if noninteractive |
| 626 | (setq res (semantic-parse-region (point-min) (point-max))) | 627 | (setq res (semantic-parse-region (point-min) (point-max))) |
| 627 | (let ((semantic--progress-reporter | 628 | (let ((semantic--progress-reporter |
| 628 | (and (>= (point-max) semantic-minimum-working-buffer-size) | 629 | (and (>= (point-max) semantic-minimum-working-buffer-size) |
| 629 | (eq semantic-working-type 'percent) | 630 | (eq semantic-working-type 'percent) |
| 630 | (make-progress-reporter | 631 | (make-progress-reporter |
| 631 | (semantic-parser-working-message (buffer-name)) | 632 | (semantic-parser-working-message (buffer-name)) |
| 632 | 0 100)))) | 633 | 0 100)))) |
| 633 | (setq res (semantic-parse-region (point-min) (point-max))) | 634 | (setq res (semantic-parse-region (point-min) (point-max))) |
| 634 | (if semantic--progress-reporter | 635 | (if semantic--progress-reporter |
| 635 | (progress-reporter-done semantic--progress-reporter)))) | 636 | (progress-reporter-done semantic--progress-reporter)))) |
| 636 | 637 | ||
| 637 | ;; Clear the caches when we see there were no errors. | 638 | ;; Clear the caches when we see there were no errors. |
| 638 | ;; But preserve the unmatched syntax cache and warnings! | 639 | ;; But preserve the unmatched syntax cache and warnings! |
| 639 | (let (semantic-unmatched-syntax-cache | 640 | (let (semantic-unmatched-syntax-cache |
| 640 | semantic-unmatched-syntax-cache-check | 641 | semantic-unmatched-syntax-cache-check |
| 641 | semantic-parser-warnings) | 642 | semantic-parser-warnings) |
| 642 | (semantic-clear-toplevel-cache)) | 643 | (semantic-clear-toplevel-cache)) |
| 643 | ;; Set up the new overlays | 644 | ;; Set up the new overlays |
| 644 | (semantic--tag-link-list-to-buffer res) | 645 | (semantic--tag-link-list-to-buffer res) |
| 645 | ;; Set up the cache with the new results | 646 | ;; Set up the cache with the new results |
| 646 | (semantic--set-buffer-cache res) | 647 | (semantic--set-buffer-cache res) |
| 647 | )))) | 648 | )))) |
| 648 | 649 | ||
| 649 | ;; Always return the current parse tree. | 650 | ;; Always return the current parse tree. |
| 650 | semantic--buffer-cache) | 651 | semantic--buffer-cache) |
diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el index 6ba02ee2006..c001a4dab5f 100644 --- a/lisp/cedet/semantic/bovine/make.el +++ b/lisp/cedet/semantic/bovine/make.el | |||
| @@ -178,9 +178,8 @@ This is the same as a regular prototype." | |||
| 178 | makefile-mode (context) | 178 | makefile-mode (context) |
| 179 | "Return a list of possible completions in a Makefile. | 179 | "Return a list of possible completions in a Makefile. |
| 180 | Uses default implementation, and also gets a list of filenames." | 180 | Uses default implementation, and also gets a list of filenames." |
| 181 | (save-excursion | 181 | (require 'semantic/analyze/complete) |
| 182 | (require 'semantic/analyze/complete) | 182 | (with-current-buffer (oref context buffer) |
| 183 | (set-buffer (oref context buffer)) | ||
| 184 | (let* ((normal (semantic-analyze-possible-completions-default context)) | 183 | (let* ((normal (semantic-analyze-possible-completions-default context)) |
| 185 | (classes (oref context :prefixclass)) | 184 | (classes (oref context :prefixclass)) |
| 186 | (filetags nil)) | 185 | (filetags nil)) |
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index f1fbc7538c2..3f726ee56fd 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el | |||
| @@ -188,6 +188,8 @@ Value should be a ... what?") | |||
| 188 | "Default history variable for any unhistoried prompt. | 188 | "Default history variable for any unhistoried prompt. |
| 189 | Keeps STRINGS only in the history.") | 189 | Keeps STRINGS only in the history.") |
| 190 | 190 | ||
| 191 | (defvar semantic-complete-active-default) | ||
| 192 | (defvar semantic-complete-current-matched-tag) | ||
| 191 | 193 | ||
| 192 | (defun semantic-complete-read-tag-engine (collector displayor prompt | 194 | (defun semantic-complete-read-tag-engine (collector displayor prompt |
| 193 | default-tag initial-input | 195 | default-tag initial-input |
| @@ -1871,7 +1873,7 @@ completion text in ghost text." | |||
| 1871 | (list 'const | 1873 | (list 'const |
| 1872 | :tag doc1 | 1874 | :tag doc1 |
| 1873 | C))) | 1875 | C))) |
| 1874 | (eieio-build-class-alist semantic-displayor-abstract t)) | 1876 | (eieio-build-class-alist 'semantic-displayor-abstract t)) |
| 1875 | ) | 1877 | ) |
| 1876 | "Possible options for inline completion displayors. | 1878 | "Possible options for inline completion displayors. |
| 1877 | Use this to enable custom editing.") | 1879 | Use this to enable custom editing.") |
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index 6ed3cdb7eb5..2590dd1208d 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el | |||
| @@ -192,7 +192,7 @@ is specified by `semanticdb-default-save-directory'." | |||
| 192 | If DIRECTORY is found to be defunct, it won't load the DB, and will | 192 | If DIRECTORY is found to be defunct, it won't load the DB, and will |
| 193 | warn instead." | 193 | warn instead." |
| 194 | (if (file-directory-p directory) | 194 | (if (file-directory-p directory) |
| 195 | (semanticdb-create-database semanticdb-project-database-ebrowse | 195 | (semanticdb-create-database 'semanticdb-project-database-ebrowse |
| 196 | directory) | 196 | directory) |
| 197 | (let* ((BF (semanticdb-ebrowse-file-for-directory directory)) | 197 | (let* ((BF (semanticdb-ebrowse-file-for-directory directory)) |
| 198 | (BFL (concat BF "-load.el")) | 198 | (BFL (concat BF "-load.el")) |
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 8b988be77bb..be9ffe31b87 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el | |||
| @@ -225,7 +225,7 @@ TOKTYPE is a hint to the type of tag desired." | |||
| 225 | (semantic-elisp-desymbolify | 225 | (semantic-elisp-desymbolify |
| 226 | ;; FIXME: This only gives the instance slots and ignores the | 226 | ;; FIXME: This only gives the instance slots and ignores the |
| 227 | ;; class-allocated slots. | 227 | ;; class-allocated slots. |
| 228 | (eieio--class-public-a (find-class semanticdb-project-database))) ;; slots ;FIXME: eieio-- | 228 | (eieio--class-public-a (find-class 'semanticdb-project-database))) ;; slots ;FIXME: eieio-- |
| 229 | (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents | 229 | (semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents |
| 230 | )) | 230 | )) |
| 231 | ((not toktype) | 231 | ((not toktype) |
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index 5b76d851b1d..0360e0680e7 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el | |||
| @@ -158,7 +158,8 @@ If DIRECTORY doesn't exist, create a new one." | |||
| 158 | (defun semanticdb-load-database (filename) | 158 | (defun semanticdb-load-database (filename) |
| 159 | "Load the database FILENAME." | 159 | "Load the database FILENAME." |
| 160 | (condition-case foo | 160 | (condition-case foo |
| 161 | (let* ((r (eieio-persistent-read filename semanticdb-project-database-file)) | 161 | (let* ((r (eieio-persistent-read filename |
| 162 | 'semanticdb-project-database-file)) | ||
| 162 | (c (semanticdb-get-database-tables r)) | 163 | (c (semanticdb-get-database-tables r)) |
| 163 | (tv (oref r semantic-tag-version)) | 164 | (tv (oref r semantic-tag-version)) |
| 164 | (fv (oref r semanticdb-version)) | 165 | (fv (oref r semanticdb-version)) |
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 08a22fb3b85..dd36cc1a01e 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el | |||
| @@ -1114,7 +1114,7 @@ for backward compatibility. | |||
| 1114 | If optional argument BRUTISH is non-nil, then ignore include statements, | 1114 | If optional argument BRUTISH is non-nil, then ignore include statements, |
| 1115 | and search all tables in this project tree." | 1115 | and search all tables in this project tree." |
| 1116 | (let (found match) | 1116 | (let (found match) |
| 1117 | (save-excursion | 1117 | (save-current-buffer |
| 1118 | ;; If path is a buffer, set ourselves up in that buffer | 1118 | ;; If path is a buffer, set ourselves up in that buffer |
| 1119 | ;; so that the override methods work correctly. | 1119 | ;; so that the override methods work correctly. |
| 1120 | (when (bufferp path) (set-buffer path)) | 1120 | (when (bufferp path) (set-buffer path)) |
| @@ -1127,7 +1127,7 @@ and search all tables in this project tree." | |||
| 1127 | ;; databases and not associated with a file. | 1127 | ;; databases and not associated with a file. |
| 1128 | (unless (and find-file-match | 1128 | (unless (and find-file-match |
| 1129 | (obj-of-class-p | 1129 | (obj-of-class-p |
| 1130 | (car tableandtags) semanticdb-search-results-table)) | 1130 | (car tableandtags) 'semanticdb-search-results-table)) |
| 1131 | (when (setq match (funcall function | 1131 | (when (setq match (funcall function |
| 1132 | (car tableandtags) (cdr tableandtags))) | 1132 | (car tableandtags) (cdr tableandtags))) |
| 1133 | (when find-file-match | 1133 | (when find-file-match |
| @@ -1144,7 +1144,7 @@ and search all tables in this project tree." | |||
| 1144 | ;; `semanticdb-search-results-table', since those are system | 1144 | ;; `semanticdb-search-results-table', since those are system |
| 1145 | ;; databases and not associated with a file. | 1145 | ;; databases and not associated with a file. |
| 1146 | (unless (and find-file-match | 1146 | (unless (and find-file-match |
| 1147 | (obj-of-class-p table semanticdb-search-results-table)) | 1147 | (obj-of-class-p table 'semanticdb-search-results-table)) |
| 1148 | (when (and table (setq match (funcall function table nil))) | 1148 | (when (and table (setq match (funcall function table nil))) |
| 1149 | (semanticdb-find-log-activity table match) | 1149 | (semanticdb-find-log-activity table match) |
| 1150 | (when find-file-match | 1150 | (when find-file-match |
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el index eb00a57cddd..723b7bd28bc 100644 --- a/lisp/cedet/semantic/db-typecache.el +++ b/lisp/cedet/semantic/db-typecache.el | |||
| @@ -180,7 +180,7 @@ If there is no table, create one, and fill it in." | |||
| 180 | (defmethod semanticdb-get-typecache ((db semanticdb-project-database)) | 180 | (defmethod semanticdb-get-typecache ((db semanticdb-project-database)) |
| 181 | "Retrieve the typecache from the semantic database DB. | 181 | "Retrieve the typecache from the semantic database DB. |
| 182 | If there is no table, create one, and fill it in." | 182 | If there is no table, create one, and fill it in." |
| 183 | (semanticdb-cache-get db semanticdb-database-typecache) | 183 | (semanticdb-cache-get db 'semanticdb-database-typecache) |
| 184 | ) | 184 | ) |
| 185 | 185 | ||
| 186 | 186 | ||
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 43e5e5b435b..b2c1252c502 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el | |||
| @@ -330,6 +330,10 @@ Adds the number of tags in this file to the object print name." | |||
| 330 | 330 | ||
| 331 | ;;; DATABASE BASE CLASS | 331 | ;;; DATABASE BASE CLASS |
| 332 | ;; | 332 | ;; |
| 333 | (unless (fboundp 'semanticdb-abstract-table-list-p) | ||
| 334 | (cl-deftype semanticdb-abstract-table-list () | ||
| 335 | '(list-of semanticdb-abstract-table))) | ||
| 336 | |||
| 333 | (defclass semanticdb-project-database (eieio-instance-tracker) | 337 | (defclass semanticdb-project-database (eieio-instance-tracker) |
| 334 | ((tracking-symbol :initform semanticdb-database-list) | 338 | ((tracking-symbol :initform semanticdb-database-list) |
| 335 | (reference-directory :type string | 339 | (reference-directory :type string |
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index dc3dfa7f55a..67f0cfeea6d 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el | |||
| @@ -213,7 +213,7 @@ Argument THIS is the target that should insert stuff." | |||
| 213 | ;; "Target class for Emacs/Semantic grammar files." nil nil) | 213 | ;; "Target class for Emacs/Semantic grammar files." nil nil) |
| 214 | 214 | ||
| 215 | (ede-proj-register-target "semantic grammar" | 215 | (ede-proj-register-target "semantic grammar" |
| 216 | semantic-ede-proj-target-grammar) | 216 | 'semantic-ede-proj-target-grammar) |
| 217 | 217 | ||
| 218 | (provide 'semantic/ede-grammar) | 218 | (provide 'semantic/ede-grammar) |
| 219 | 219 | ||
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 56adf3a6e81..a0c36944d48 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el | |||
| @@ -378,11 +378,11 @@ If FORMS includes a call to `semantic-throw-on-input', then | |||
| 378 | if a user presses any key during execution, this form macro | 378 | if a user presses any key during execution, this form macro |
| 379 | will exit with the value passed to `semantic-throw-on-input'. | 379 | will exit with the value passed to `semantic-throw-on-input'. |
| 380 | If FORMS completes, then the return value is the same as `progn'." | 380 | If FORMS completes, then the return value is the same as `progn'." |
| 381 | (declare (indent 1)) | ||
| 381 | `(let ((semantic-current-input-throw-symbol ,symbol) | 382 | `(let ((semantic-current-input-throw-symbol ,symbol) |
| 382 | (semantic--on-input-start-marker (point-marker))) | 383 | (semantic--on-input-start-marker (point-marker))) |
| 383 | (catch ,symbol | 384 | (catch ,symbol |
| 384 | ,@forms))) | 385 | ,@forms))) |
| 385 | (put 'semantic-exit-on-input 'lisp-indent-function 1) | ||
| 386 | 386 | ||
| 387 | (defmacro semantic-throw-on-input (from) | 387 | (defmacro semantic-throw-on-input (from) |
| 388 | "Exit with `throw' when in `semantic-exit-on-input' on user input. | 388 | "Exit with `throw' when in `semantic-exit-on-input' on user input. |
| @@ -391,15 +391,14 @@ to pass to `throw'. It is recommended to use the name of the function | |||
| 391 | calling this one." | 391 | calling this one." |
| 392 | `(when (and semantic-current-input-throw-symbol | 392 | `(when (and semantic-current-input-throw-symbol |
| 393 | (or (input-pending-p) | 393 | (or (input-pending-p) |
| 394 | (save-excursion | 394 | (with-current-buffer |
| 395 | ;; Timers might run during accept-process-output. | 395 | ;; Timers might run during accept-process-output. |
| 396 | ;; If they redisplay, point must be where the user | 396 | ;; If they redisplay, point must be where the user |
| 397 | ;; expects. (Bug#15045) | 397 | ;; expects. (Bug#15045) |
| 398 | (set-buffer (marker-buffer | 398 | (marker-buffer semantic--on-input-start-marker) |
| 399 | semantic--on-input-start-marker)) | 399 | (save-excursion |
| 400 | (goto-char (marker-position | 400 | (goto-char semantic--on-input-start-marker) |
| 401 | semantic--on-input-start-marker)) | 401 | (accept-process-output))))) |
| 402 | (accept-process-output)))) | ||
| 403 | (throw semantic-current-input-throw-symbol ,from))) | 402 | (throw semantic-current-input-throw-symbol ,from))) |
| 404 | 403 | ||
| 405 | 404 | ||
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index fc62b221665..7a92a12ed53 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el | |||
| @@ -1665,13 +1665,14 @@ Select the buffer containing the tag's definition, and move point there." | |||
| 1665 | (declare-function eldoc-get-fnsym-args-string "eldoc") | 1665 | (declare-function eldoc-get-fnsym-args-string "eldoc") |
| 1666 | (declare-function eldoc-get-var-docstring "eldoc") | 1666 | (declare-function eldoc-get-var-docstring "eldoc") |
| 1667 | 1667 | ||
| 1668 | (defvar semantic-grammar-eldoc-last-data (cons nil nil)) | ||
| 1669 | |||
| 1668 | (defun semantic-grammar-eldoc-get-macro-docstring (macro expander) | 1670 | (defun semantic-grammar-eldoc-get-macro-docstring (macro expander) |
| 1669 | "Return a one-line docstring for the given grammar MACRO. | 1671 | "Return a one-line docstring for the given grammar MACRO. |
| 1670 | EXPANDER is the name of the function that expands MACRO." | 1672 | EXPANDER is the name of the function that expands MACRO." |
| 1671 | (require 'eldoc) | 1673 | (require 'eldoc) |
| 1672 | (if (and (eq expander (aref eldoc-last-data 0)) | 1674 | (if (eq expander (car semantic-grammar-eldoc-last-data)) |
| 1673 | (eq 'function (aref eldoc-last-data 2))) | 1675 | (cdr semantic-grammar-eldoc-last-data) |
| 1674 | (aref eldoc-last-data 1) | ||
| 1675 | (let ((doc (help-split-fundoc (documentation expander t) expander))) | 1676 | (let ((doc (help-split-fundoc (documentation expander t) expander))) |
| 1676 | (cond | 1677 | (cond |
| 1677 | (doc | 1678 | (doc |
| @@ -1684,7 +1685,7 @@ EXPANDER is the name of the function that expands MACRO." | |||
| 1684 | (setq doc | 1685 | (setq doc |
| 1685 | (eldoc-docstring-format-sym-doc | 1686 | (eldoc-docstring-format-sym-doc |
| 1686 | macro (format "==> %s %s" expander doc) 'default)) | 1687 | macro (format "==> %s %s" expander doc) 'default)) |
| 1687 | (eldoc-last-data-store expander doc 'function)) | 1688 | (setq semantic-grammar-eldoc-last-data (cons expander doc))) |
| 1688 | doc))) | 1689 | doc))) |
| 1689 | 1690 | ||
| 1690 | (define-mode-local-override semantic-idle-summary-current-symbol-info | 1691 | (define-mode-local-override semantic-idle-summary-current-symbol-info |
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index 2c0dea20107..c56cbc3c126 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el | |||
| @@ -134,7 +134,7 @@ Saves scoping information between runs of the analyzer.") | |||
| 134 | "Get the current cached scope, and reset it." | 134 | "Get the current cached scope, and reset it." |
| 135 | (when semanticdb-current-table | 135 | (when semanticdb-current-table |
| 136 | (let ((co (semanticdb-cache-get semanticdb-current-table | 136 | (let ((co (semanticdb-cache-get semanticdb-current-table |
| 137 | semantic-scope-cache))) | 137 | 'semantic-scope-cache))) |
| 138 | (semantic-reset co)))) | 138 | (semantic-reset co)))) |
| 139 | 139 | ||
| 140 | (defmethod semantic-scope-set-typecache ((cache semantic-scope-cache) | 140 | (defmethod semantic-scope-set-typecache ((cache semantic-scope-cache) |
| @@ -706,7 +706,7 @@ The class returned from the scope calculation is variable | |||
| 706 | (let* ((TAG (semantic-current-tag)) | 706 | (let* ((TAG (semantic-current-tag)) |
| 707 | (scopecache | 707 | (scopecache |
| 708 | (semanticdb-cache-get semanticdb-current-table | 708 | (semanticdb-cache-get semanticdb-current-table |
| 709 | semantic-scope-cache)) | 709 | 'semantic-scope-cache)) |
| 710 | ) | 710 | ) |
| 711 | (when (not (semantic-equivalent-tag-p TAG (oref scopecache tag))) | 711 | (when (not (semantic-equivalent-tag-p TAG (oref scopecache tag))) |
| 712 | (semantic-reset scopecache)) | 712 | (semantic-reset scopecache)) |
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index d899b42b1e1..782121ef5b5 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el | |||
| @@ -87,10 +87,10 @@ for push, pop, and peek for the active template.") | |||
| 87 | Useful if something goes wrong in SRecode, and the active template | 87 | Useful if something goes wrong in SRecode, and the active template |
| 88 | stack is broken." | 88 | stack is broken." |
| 89 | (interactive) | 89 | (interactive) |
| 90 | (if (oref srecode-template active) | 90 | (if (oref-default 'srecode-template active) |
| 91 | (when (y-or-n-p (format "%d active templates. Flush? " | 91 | (when (y-or-n-p (format "%d active templates. Flush? " |
| 92 | (length (oref srecode-template active)))) | 92 | (length (oref-default 'srecode-template active)))) |
| 93 | (oset-default srecode-template active nil)) | 93 | (oset-default 'srecode-template active nil)) |
| 94 | (message "No active templates to flush.")) | 94 | (message "No active templates to flush.")) |
| 95 | ) | 95 | ) |
| 96 | 96 | ||
| @@ -514,7 +514,7 @@ to the inserter constructor." | |||
| 514 | ;;(message "Compile: %s %S" name props) | 514 | ;;(message "Compile: %s %S" name props) |
| 515 | (if (not key) | 515 | (if (not key) |
| 516 | (apply 'srecode-template-inserter-variable name props) | 516 | (apply 'srecode-template-inserter-variable name props) |
| 517 | (let ((classes (eieio-class-children srecode-template-inserter)) | 517 | (let ((classes (eieio-class-children 'srecode-template-inserter)) |
| 518 | (new nil)) | 518 | (new nil)) |
| 519 | ;; Loop over the various subclasses and | 519 | ;; Loop over the various subclasses and |
| 520 | ;; create the correct inserter. | 520 | ;; create the correct inserter. |
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el index 20852f78b41..f473a0d8261 100644 --- a/lisp/cedet/srecode/fields.el +++ b/lisp/cedet/srecode/fields.el | |||
| @@ -237,7 +237,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO." | |||
| 237 | 237 | ||
| 238 | (defsubst srecode-active-template-region () | 238 | (defsubst srecode-active-template-region () |
| 239 | "Return the active region for template fields." | 239 | "Return the active region for template fields." |
| 240 | (oref srecode-template-inserted-region active-region)) | 240 | (oref-default 'srecode-template-inserted-region active-region)) |
| 241 | 241 | ||
| 242 | (defun srecode-field-post-command () | 242 | (defun srecode-field-post-command () |
| 243 | "Srecode field handler in the post command hook." | 243 | "Srecode field handler in the post command hook." |
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index f1f23bc6f1d..78ec1658859 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el | |||
| @@ -211,7 +211,7 @@ insertions." | |||
| 211 | (propertize " (most recent at bottom)" 'face '(:slant italic)) | 211 | (propertize " (most recent at bottom)" 'face '(:slant italic)) |
| 212 | ":\n") | 212 | ":\n") |
| 213 | (data-debug-insert-stuff-list | 213 | (data-debug-insert-stuff-list |
| 214 | (reverse (oref srecode-template active)) "> ") | 214 | (reverse (oref-default 'srecode-template active)) "> ") |
| 215 | ;; Show the current dictionary. | 215 | ;; Show the current dictionary. |
| 216 | (insert (propertize "Dictionary" 'face '(:weight bold)) "\n") | 216 | (insert (propertize "Dictionary" 'face '(:weight bold)) "\n") |
| 217 | (data-debug-insert-thing dictionary "" "> ") | 217 | (data-debug-insert-thing dictionary "" "> ") |
| @@ -396,7 +396,7 @@ Specify the :blank argument to enable this inserter.") | |||
| 396 | (pm (point-marker))) | 396 | (pm (point-marker))) |
| 397 | (when (and inbuff | 397 | (when (and inbuff |
| 398 | ;; Don't do this if we are not the active template. | 398 | ;; Don't do this if we are not the active template. |
| 399 | (= (length (oref srecode-template active)) 1)) | 399 | (= (length (oref-default 'srecode-template active)) 1)) |
| 400 | 400 | ||
| 401 | (when (and (eq i t) inbuff (not (eq (oref sti where) 'begin))) | 401 | (when (and (eq i t) inbuff (not (eq (oref sti where) 'begin))) |
| 402 | (indent-according-to-mode) | 402 | (indent-according-to-mode) |
| @@ -773,7 +773,7 @@ generalized marker will do something else. See | |||
| 773 | ;; valid. Compare this to the actual template nesting depth and | 773 | ;; valid. Compare this to the actual template nesting depth and |
| 774 | ;; maybe use the override function which is stored in the cdr. | 774 | ;; maybe use the override function which is stored in the cdr. |
| 775 | (if (and srecode-template-inserter-point-override | 775 | (if (and srecode-template-inserter-point-override |
| 776 | (<= (length (oref srecode-template active)) | 776 | (<= (length (oref-default 'srecode-template active)) |
| 777 | (car srecode-template-inserter-point-override))) | 777 | (car srecode-template-inserter-point-override))) |
| 778 | ;; Disable the old override while we do this. | 778 | ;; Disable the old override while we do this. |
| 779 | (let ((over (cdr srecode-template-inserter-point-override)) | 779 | (let ((over (cdr srecode-template-inserter-point-override)) |
| @@ -943,7 +943,7 @@ this template instance." | |||
| 943 | ;; Calculate and store the discovered template | 943 | ;; Calculate and store the discovered template |
| 944 | (let ((tmpl (srecode-template-get-table (srecode-table) | 944 | (let ((tmpl (srecode-template-get-table (srecode-table) |
| 945 | templatenamepart)) | 945 | templatenamepart)) |
| 946 | (active (oref srecode-template active)) | 946 | (active (oref-default 'srecode-template active)) |
| 947 | ctxt) | 947 | ctxt) |
| 948 | (when (not tmpl) | 948 | (when (not tmpl) |
| 949 | ;; If it isn't just available, scan back through | 949 | ;; If it isn't just available, scan back through |
| @@ -1053,7 +1053,7 @@ template where a ^ inserter occurs." | |||
| 1053 | (lexical-let ((inserter1 sti)) | 1053 | (lexical-let ((inserter1 sti)) |
| 1054 | (cons | 1054 | (cons |
| 1055 | ;; DEPTH | 1055 | ;; DEPTH |
| 1056 | (+ (length (oref srecode-template active)) 1) | 1056 | (+ (length (oref-default 'srecode-template active)) 1) |
| 1057 | ;; FUNCTION | 1057 | ;; FUNCTION |
| 1058 | (lambda (dict) | 1058 | (lambda (dict) |
| 1059 | (let ((srecode-template-inserter-point-override nil)) | 1059 | (let ((srecode-template-inserter-point-override nil)) |
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index 7224d5942f6..cc0c4ae4427 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el | |||
| @@ -298,7 +298,7 @@ if that file is NEW, otherwise assume the mode has not changed." | |||
| 298 | (when (not srecode-current-map) | 298 | (when (not srecode-current-map) |
| 299 | (condition-case nil | 299 | (condition-case nil |
| 300 | (setq srecode-current-map | 300 | (setq srecode-current-map |
| 301 | (eieio-persistent-read srecode-map-save-file srecode-map)) | 301 | (eieio-persistent-read srecode-map-save-file 'srecode-map)) |
| 302 | (error | 302 | (error |
| 303 | ;; There was an error loading the old map. Create a new one. | 303 | ;; There was an error loading the old map. Create a new one. |
| 304 | (setq srecode-current-map | 304 | (setq srecode-current-map |
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 62b2b5cc6da..851b3bfc6fd 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el | |||
| @@ -422,7 +422,7 @@ or is created with the bounds of SEQ." | |||
| 422 | (if (stringp (car (oref seq data))) | 422 | (if (stringp (car (oref seq data))) |
| 423 | (let ((labels (oref seq data))) | 423 | (let ((labels (oref seq data))) |
| 424 | (if (not axis) | 424 | (if (not axis) |
| 425 | (setq axis (make-instance chart-axis-names | 425 | (setq axis (make-instance 'chart-axis-names |
| 426 | :name (oref seq name) | 426 | :name (oref seq name) |
| 427 | :items labels | 427 | :items labels |
| 428 | :chart c)) | 428 | :chart c)) |
| @@ -430,7 +430,7 @@ or is created with the bounds of SEQ." | |||
| 430 | (let ((range (cons 0 1)) | 430 | (let ((range (cons 0 1)) |
| 431 | (l (oref seq data))) | 431 | (l (oref seq data))) |
| 432 | (if (not axis) | 432 | (if (not axis) |
| 433 | (setq axis (make-instance chart-axis-range | 433 | (setq axis (make-instance 'chart-axis-range |
| 434 | :name (oref seq name) | 434 | :name (oref seq name) |
| 435 | :chart c))) | 435 | :chart c))) |
| 436 | (while l | 436 | (while l |
| @@ -577,19 +577,19 @@ labeled NUMTITLE. | |||
| 577 | Optional arguments: | 577 | Optional arguments: |
| 578 | Set the chart's max element display to MAX, and sort lists with | 578 | Set the chart's max element display to MAX, and sort lists with |
| 579 | SORT-PRED if desired." | 579 | SORT-PRED if desired." |
| 580 | (let ((nc (make-instance chart-bar | 580 | (let ((nc (make-instance 'chart-bar |
| 581 | :title title | 581 | :title title |
| 582 | :key-label "8-m" ; This is a text key pic | 582 | :key-label "8-m" ; This is a text key pic |
| 583 | :direction dir | 583 | :direction dir |
| 584 | )) | 584 | )) |
| 585 | (iv (eq dir 'vertical))) | 585 | (iv (eq dir 'vertical))) |
| 586 | (chart-add-sequence nc | 586 | (chart-add-sequence nc |
| 587 | (make-instance chart-sequece | 587 | (make-instance 'chart-sequece |
| 588 | :data namelst | 588 | :data namelst |
| 589 | :name nametitle) | 589 | :name nametitle) |
| 590 | (if iv 'x-axis 'y-axis)) | 590 | (if iv 'x-axis 'y-axis)) |
| 591 | (chart-add-sequence nc | 591 | (chart-add-sequence nc |
| 592 | (make-instance chart-sequece | 592 | (make-instance 'chart-sequece |
| 593 | :data numlst | 593 | :data numlst |
| 594 | :name numtitle) | 594 | :name numtitle) |
| 595 | (if iv 'y-axis 'x-axis)) | 595 | (if iv 'y-axis 'x-axis)) |
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 7478908051c..9931fbd114e 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el | |||
| @@ -40,7 +40,7 @@ | |||
| 40 | ;; error if a slot is unbound. | 40 | ;; error if a slot is unbound. |
| 41 | (defclass eieio-instance-inheritor () | 41 | (defclass eieio-instance-inheritor () |
| 42 | ((parent-instance :initarg :parent-instance | 42 | ((parent-instance :initarg :parent-instance |
| 43 | :type eieio-instance-inheritor-child | 43 | :type eieio-instance-inheritor |
| 44 | :documentation | 44 | :documentation |
| 45 | "The parent of this instance. | 45 | "The parent of this instance. |
| 46 | If a slot of this class is referenced, and is unbound, then the parent | 46 | If a slot of this class is referenced, and is unbound, then the parent |
| @@ -63,25 +63,10 @@ SLOT-NAME is the offending slot. FN is the function signaling the error." | |||
| 63 | ;; Throw the regular signal. | 63 | ;; Throw the regular signal. |
| 64 | (call-next-method))) | 64 | (call-next-method))) |
| 65 | 65 | ||
| 66 | (defmethod clone ((obj eieio-instance-inheritor) &rest params) | 66 | (defmethod clone ((obj eieio-instance-inheritor) &rest _params) |
| 67 | "Clone OBJ, initializing `:parent' to OBJ. | 67 | "Clone OBJ, initializing `:parent' to OBJ. |
| 68 | All slots are unbound, except those initialized with PARAMS." | 68 | All slots are unbound, except those initialized with PARAMS." |
| 69 | (let ((nobj (make-vector (length obj) eieio-unbound)) | 69 | (let ((nobj (call-next-method))) |
| 70 | (nm (eieio--object-name obj)) | ||
| 71 | (passname (and params (stringp (car params)))) | ||
| 72 | (num 1)) | ||
| 73 | (aset nobj 0 'object) | ||
| 74 | (setf (eieio--object-class nobj) (eieio--object-class obj)) | ||
| 75 | ;; The following was copied from the default clone. | ||
| 76 | (if (not passname) | ||
| 77 | (save-match-data | ||
| 78 | (if (string-match "-\\([0-9]+\\)" nm) | ||
| 79 | (setq num (1+ (string-to-number (match-string 1 nm))) | ||
| 80 | nm (substring nm 0 (match-beginning 0)))) | ||
| 81 | (setf (eieio--object-name nobj) (concat nm "-" (int-to-string num)))) | ||
| 82 | (setf (eieio--object-name nobj) (car params))) | ||
| 83 | ;; Now initialize from params. | ||
| 84 | (if params (shared-initialize nobj (if passname (cdr params) params))) | ||
| 85 | (oset nobj parent-instance obj) | 70 | (oset nobj parent-instance obj) |
| 86 | nobj)) | 71 | nobj)) |
| 87 | 72 | ||
| @@ -155,7 +140,7 @@ Multiple calls to `make-instance' will return this object.")) | |||
| 155 | A singleton is a class which will only ever have one instance." | 140 | A singleton is a class which will only ever have one instance." |
| 156 | :abstract t) | 141 | :abstract t) |
| 157 | 142 | ||
| 158 | (defmethod constructor :STATIC ((class eieio-singleton) _name &rest _slots) | 143 | (defmethod eieio-constructor :STATIC ((class eieio-singleton) &rest _slots) |
| 159 | "Constructor for singleton CLASS. | 144 | "Constructor for singleton CLASS. |
| 160 | NAME and SLOTS initialize the new object. | 145 | NAME and SLOTS initialize the new object. |
| 161 | This constructor guarantees that no matter how many you request, | 146 | This constructor guarantees that no matter how many you request, |
| @@ -270,7 +255,7 @@ malicious code. | |||
| 270 | Note: This function recurses when a slot of :type of some object is | 255 | Note: This function recurses when a slot of :type of some object is |
| 271 | identified, and needing more object creation." | 256 | identified, and needing more object creation." |
| 272 | (let ((objclass (nth 0 inputlist)) | 257 | (let ((objclass (nth 0 inputlist)) |
| 273 | (objname (nth 1 inputlist)) | 258 | ;; (objname (nth 1 inputlist)) |
| 274 | (slots (nthcdr 2 inputlist)) | 259 | (slots (nthcdr 2 inputlist)) |
| 275 | (createslots nil)) | 260 | (createslots nil)) |
| 276 | 261 | ||
| @@ -285,7 +270,7 @@ identified, and needing more object creation." | |||
| 285 | ;; In addition, strip out quotes, list functions, and update | 270 | ;; In addition, strip out quotes, list functions, and update |
| 286 | ;; object constructors as needed. | 271 | ;; object constructors as needed. |
| 287 | (setq value (eieio-persistent-validate/fix-slot-value | 272 | (setq value (eieio-persistent-validate/fix-slot-value |
| 288 | objclass name value)) | 273 | (eieio--class-v objclass) name value)) |
| 289 | 274 | ||
| 290 | (push name createslots) | 275 | (push name createslots) |
| 291 | (push value createslots) | 276 | (push value createslots) |
| @@ -293,7 +278,7 @@ identified, and needing more object creation." | |||
| 293 | 278 | ||
| 294 | (setq slots (cdr (cdr slots)))) | 279 | (setq slots (cdr (cdr slots)))) |
| 295 | 280 | ||
| 296 | (apply 'make-instance objclass objname (nreverse createslots)) | 281 | (apply #'make-instance objclass (nreverse createslots)) |
| 297 | 282 | ||
| 298 | ;;(eval inputlist) | 283 | ;;(eval inputlist) |
| 299 | )) | 284 | )) |
| @@ -305,11 +290,13 @@ constructor functions are considered valid. | |||
| 305 | Second, any text properties will be stripped from strings." | 290 | Second, any text properties will be stripped from strings." |
| 306 | (cond ((consp proposed-value) | 291 | (cond ((consp proposed-value) |
| 307 | ;; Lists with something in them need special treatment. | 292 | ;; Lists with something in them need special treatment. |
| 308 | (let ((slot-idx (eieio-slot-name-index class nil slot)) | 293 | (let ((slot-idx (eieio--slot-name-index class |
| 294 | nil slot)) | ||
| 309 | (type nil) | 295 | (type nil) |
| 310 | (classtype nil)) | 296 | (classtype nil)) |
| 311 | (setq slot-idx (- slot-idx 3)) | 297 | (setq slot-idx (- slot-idx |
| 312 | (setq type (aref (eieio--class-public-type (class-v class)) | 298 | (eval-when-compile eieio--object-num-slots))) |
| 299 | (setq type (aref (eieio--class-public-type class) | ||
| 313 | slot-idx)) | 300 | slot-idx)) |
| 314 | 301 | ||
| 315 | (setq classtype (eieio-persistent-slot-type-is-class-p | 302 | (setq classtype (eieio-persistent-slot-type-is-class-p |
| @@ -346,8 +333,8 @@ Second, any text properties will be stripped from strings." | |||
| 346 | (unless (and | 333 | (unless (and |
| 347 | ;; Do we have a type? | 334 | ;; Do we have a type? |
| 348 | (consp classtype) (class-p (car classtype))) | 335 | (consp classtype) (class-p (car classtype))) |
| 349 | (error "In save file, list of object constructors found, but no :type specified for slot %S" | 336 | (error "In save file, list of object constructors found, but no :type specified for slot %S of type %S" |
| 350 | slot)) | 337 | slot classtype)) |
| 351 | 338 | ||
| 352 | ;; We have a predicate, but it doesn't satisfy the predicate? | 339 | ;; We have a predicate, but it doesn't satisfy the predicate? |
| 353 | (dolist (PV (cdr proposed-value)) | 340 | (dolist (PV (cdr proposed-value)) |
| @@ -375,31 +362,49 @@ Second, any text properties will be stripped from strings." | |||
| 375 | ) | 362 | ) |
| 376 | 363 | ||
| 377 | (defun eieio-persistent-slot-type-is-class-p (type) | 364 | (defun eieio-persistent-slot-type-is-class-p (type) |
| 378 | "Return the class refered to in TYPE. | 365 | "Return the class referred to in TYPE. |
| 379 | If no class is referenced there, then return nil." | 366 | If no class is referenced there, then return nil." |
| 380 | (cond ((class-p type) | 367 | (cond ((class-p type) |
| 381 | ;; If the type is a class, then return it. | 368 | ;; If the type is a class, then return it. |
| 382 | type) | 369 | type) |
| 383 | 370 | ((and (eq 'list-of (car-safe type)) (class-p (cadr type))) | |
| 384 | ((and (symbolp type) (string-match "-child$" (symbol-name type)) | 371 | ;; If it is the type of a list of a class, then return that class and |
| 372 | ;; the type. | ||
| 373 | (cons (cadr type) type)) | ||
| 374 | |||
| 375 | ((and (symbolp type) (get type 'cl-deftype-handler)) | ||
| 376 | ;; Macro-expand the type according to cl-deftype definitions. | ||
| 377 | (eieio-persistent-slot-type-is-class-p | ||
| 378 | (funcall (get type 'cl-deftype-handler)))) | ||
| 379 | |||
| 380 | ;; FIXME: foo-child should not be a valid type! | ||
| 381 | ((and (symbolp type) (string-match "-child\\'" (symbol-name type)) | ||
| 385 | (class-p (intern-soft (substring (symbol-name type) 0 | 382 | (class-p (intern-soft (substring (symbol-name type) 0 |
| 386 | (match-beginning 0))))) | 383 | (match-beginning 0))))) |
| 384 | (unless eieio-backward-compatibility | ||
| 385 | (error "Use of bogus %S type instead of %S" | ||
| 386 | type (intern-soft (substring (symbol-name type) 0 | ||
| 387 | (match-beginning 0))))) | ||
| 387 | ;; If it is the predicate ending with -child, then return | 388 | ;; If it is the predicate ending with -child, then return |
| 388 | ;; that class. Unfortunately, in EIEIO, typep of just the | 389 | ;; that class. Unfortunately, in EIEIO, typep of just the |
| 389 | ;; class is the same as if we used -child, so no further work needed. | 390 | ;; class is the same as if we used -child, so no further work needed. |
| 390 | (intern-soft (substring (symbol-name type) 0 | 391 | (intern-soft (substring (symbol-name type) 0 |
| 391 | (match-beginning 0)))) | 392 | (match-beginning 0)))) |
| 392 | 393 | ;; FIXME: foo-list should not be a valid type! | |
| 393 | ((and (symbolp type) (string-match "-list$" (symbol-name type)) | 394 | ((and (symbolp type) (string-match "-list\\'" (symbol-name type)) |
| 394 | (class-p (intern-soft (substring (symbol-name type) 0 | 395 | (class-p (intern-soft (substring (symbol-name type) 0 |
| 395 | (match-beginning 0))))) | 396 | (match-beginning 0))))) |
| 397 | (unless eieio-backward-compatibility | ||
| 398 | (error "Use of bogus %S type instead of (list-of %S)" | ||
| 399 | type (intern-soft (substring (symbol-name type) 0 | ||
| 400 | (match-beginning 0))))) | ||
| 396 | ;; If it is the predicate ending with -list, then return | 401 | ;; If it is the predicate ending with -list, then return |
| 397 | ;; that class and the predicate to use. | 402 | ;; that class and the predicate to use. |
| 398 | (cons (intern-soft (substring (symbol-name type) 0 | 403 | (cons (intern-soft (substring (symbol-name type) 0 |
| 399 | (match-beginning 0))) | 404 | (match-beginning 0))) |
| 400 | type)) | 405 | type)) |
| 401 | 406 | ||
| 402 | ((and (consp type) (eq (car type) 'or)) | 407 | ((eq (car-safe type) 'or) |
| 403 | ;; If type is a list, and is an or, it is possibly something | 408 | ;; If type is a list, and is an or, it is possibly something |
| 404 | ;; like (or null myclass), so check for that. | 409 | ;; like (or null myclass), so check for that. |
| 405 | (let ((ans nil)) | 410 | (let ((ans nil)) |
| @@ -463,34 +468,38 @@ instance." | |||
| 463 | 468 | ||
| 464 | 469 | ||
| 465 | ;;; Named object | 470 | ;;; Named object |
| 466 | ;; | ||
| 467 | ;; Named objects use the objects `name' as a slot, and that slot | ||
| 468 | ;; is accessed with the `object-name' symbol. | ||
| 469 | 471 | ||
| 470 | (defclass eieio-named () | 472 | (defclass eieio-named () |
| 471 | () | 473 | ((object-name :initarg :object-name :initform nil)) |
| 472 | "Object with a name. | 474 | "Object with a name." |
| 473 | Name storage already occurs in an object. This object provides get/set | ||
| 474 | access to it." | ||
| 475 | :abstract t) | 475 | :abstract t) |
| 476 | 476 | ||
| 477 | (defmethod slot-missing ((obj eieio-named) | 477 | (defmethod eieio-object-name-string ((obj eieio-named)) |
| 478 | slot-name operation &optional new-value) | 478 | "Return a string which is OBJ's name." |
| 479 | "Called when a non-existent slot is accessed. | 479 | (or (slot-value obj 'object-name) |
| 480 | For variable `eieio-named', provide an imaginary `object-name' slot. | 480 | (symbol-name (eieio-object-class obj)))) |
| 481 | Argument OBJ is the named object. | 481 | |
| 482 | Argument SLOT-NAME is the slot that was attempted to be accessed. | 482 | (defmethod eieio-object-set-name-string ((obj eieio-named) name) |
| 483 | OPERATION is the type of access, such as `oref' or `oset'. | 483 | "Set the string which is OBJ's NAME." |
| 484 | NEW-VALUE is the value that was being set into SLOT if OPERATION were | 484 | (eieio--check-type stringp name) |
| 485 | a set type." | 485 | (eieio-oset obj 'object-name name)) |
| 486 | (if (memq slot-name '(object-name :object-name)) | 486 | |
| 487 | (cond ((eq operation 'oset) | 487 | (defmethod clone ((obj eieio-named) &rest params) |
| 488 | (if (not (stringp new-value)) | 488 | "Clone OBJ, initializing `:parent' to OBJ. |
| 489 | (signal 'invalid-slot-type | 489 | All slots are unbound, except those initialized with PARAMS." |
| 490 | (list obj slot-name 'string new-value))) | 490 | (let* ((newname (and (stringp (car params)) (pop params))) |
| 491 | (eieio-object-set-name-string obj new-value)) | 491 | (nobj (apply #'call-next-method obj params)) |
| 492 | (t (eieio-object-name-string obj))) | 492 | (nm (slot-value obj 'object-name))) |
| 493 | (call-next-method))) | 493 | (eieio-oset obj 'object-name |
| 494 | (or newname | ||
| 495 | (save-match-data | ||
| 496 | (if (and nm (string-match "-\\([0-9]+\\)" nm)) | ||
| 497 | (let ((num (1+ (string-to-number | ||
| 498 | (match-string 1 nm))))) | ||
| 499 | (concat (substring nm 0 (match-beginning 0)) | ||
| 500 | "-" (int-to-string num))) | ||
| 501 | (concat nm "-1"))))) | ||
| 502 | nobj)) | ||
| 494 | 503 | ||
| 495 | (provide 'eieio-base) | 504 | (provide 'eieio-base) |
| 496 | 505 | ||
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 68b376592f5..dc2c873eb42 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el | |||
| @@ -32,6 +32,7 @@ | |||
| 32 | ;;; Code: | 32 | ;;; Code: |
| 33 | 33 | ||
| 34 | (require 'cl-lib) | 34 | (require 'cl-lib) |
| 35 | (require 'pcase) | ||
| 35 | 36 | ||
| 36 | (put 'eieio--defalias 'byte-hunk-handler | 37 | (put 'eieio--defalias 'byte-hunk-handler |
| 37 | #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler) | 38 | #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler) |
| @@ -39,6 +40,9 @@ | |||
| 39 | "Like `defalias', but with less side-effects. | 40 | "Like `defalias', but with less side-effects. |
| 40 | More specifically, it has no side-effects at all when the new function | 41 | More specifically, it has no side-effects at all when the new function |
| 41 | definition is the same (`eq') as the old one." | 42 | definition is the same (`eq') as the old one." |
| 43 | (while (and (fboundp name) (symbolp (symbol-function name))) | ||
| 44 | ;; Follow aliases, so methods applied to obsolete aliases still work. | ||
| 45 | (setq name (symbol-function name))) | ||
| 42 | (unless (and (fboundp name) | 46 | (unless (and (fboundp name) |
| 43 | (eq (symbol-function name) body)) | 47 | (eq (symbol-function name) body)) |
| 44 | (defalias name body))) | 48 | (defalias name body))) |
| @@ -74,6 +78,13 @@ default setting for optimization purposes.") | |||
| 74 | (defvar eieio-initializing-object nil | 78 | (defvar eieio-initializing-object nil |
| 75 | "Set to non-nil while initializing an object.") | 79 | "Set to non-nil while initializing an object.") |
| 76 | 80 | ||
| 81 | (defvar eieio-backward-compatibility t | ||
| 82 | "If nil, drop support for some behaviors of older versions of EIEIO. | ||
| 83 | Currently under control of this var: | ||
| 84 | - Define every class as a var whose value is the class symbol. | ||
| 85 | - Define <class>-child-p and <class>-list-p predicates. | ||
| 86 | - Allow object names in constructors.") | ||
| 87 | |||
| 77 | (defconst eieio-unbound | 88 | (defconst eieio-unbound |
| 78 | (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound)) | 89 | (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound)) |
| 79 | eieio-unbound | 90 | eieio-unbound |
| @@ -98,96 +109,87 @@ default setting for optimization purposes.") | |||
| 98 | "A stack of the classes currently in scope during method invocation.") | 109 | "A stack of the classes currently in scope during method invocation.") |
| 99 | 110 | ||
| 100 | (defun eieio--scoped-class () | 111 | (defun eieio--scoped-class () |
| 101 | "Return the class currently in scope, or nil." | 112 | "Return the class object currently in scope, or nil." |
| 102 | (car-safe eieio--scoped-class-stack)) | 113 | (car-safe eieio--scoped-class-stack)) |
| 103 | 114 | ||
| 104 | (defmacro eieio--with-scoped-class (class &rest forms) | 115 | (defmacro eieio--with-scoped-class (class &rest forms) |
| 105 | "Set CLASS as the currently scoped class while executing FORMS." | 116 | "Set CLASS as the currently scoped class while executing FORMS." |
| 106 | (declare (indent 1)) | 117 | (declare (indent 1)) |
| 107 | `(unwind-protect | 118 | `(let ((eieio--scoped-class-stack (cons ,class eieio--scoped-class-stack))) |
| 108 | (progn | 119 | ,@forms)) |
| 109 | (push ,class eieio--scoped-class-stack) | 120 | |
| 110 | ,@forms) | 121 | (progn |
| 111 | (pop eieio--scoped-class-stack))) | 122 | ;; Arrange for field access not to bother checking if the access is indeed |
| 123 | ;; made to an eieio--class object. | ||
| 124 | (cl-declaim (optimize (safety 0))) | ||
| 125 | (cl-defstruct (eieio--class | ||
| 126 | (:constructor nil) | ||
| 127 | (:constructor eieio--class-make (symbol &aux (tag 'defclass))) | ||
| 128 | (:type vector) | ||
| 129 | (:copier nil)) | ||
| 130 | ;; We use an untagged cl-struct, with our own hand-made tag as first field | ||
| 131 | ;; (containing the symbol `defclass'). It would be better to use a normal | ||
| 132 | ;; cl-struct with its normal tag (e.g. so that cl-defstruct can define the | ||
| 133 | ;; predicate for us), but that breaks compatibility with .elc files compiled | ||
| 134 | ;; against older versions of EIEIO. | ||
| 135 | tag | ||
| 136 | symbol ;; symbol (self-referencing) | ||
| 137 | parent children | ||
| 138 | symbol-hashtable ;; hashtable permitting fast access to variable position indexes | ||
| 139 | ;; @todo | ||
| 140 | ;; the word "public" here is leftovers from the very first version. | ||
| 141 | ;; Get rid of it! | ||
| 142 | public-a ;; class attribute index | ||
| 143 | public-d ;; class attribute defaults index | ||
| 144 | public-doc ;; class documentation strings for attributes | ||
| 145 | public-type ;; class type for a slot | ||
| 146 | public-custom ;; class custom type for a slot | ||
| 147 | public-custom-label ;; class custom group for a slot | ||
| 148 | public-custom-group ;; class custom group for a slot | ||
| 149 | public-printer ;; printer for a slot | ||
| 150 | protection ;; protection for a slot | ||
| 151 | initarg-tuples ;; initarg tuples list | ||
| 152 | class-allocation-a ;; class allocated attributes | ||
| 153 | class-allocation-doc ;; class allocated documentation | ||
| 154 | class-allocation-type ;; class allocated value type | ||
| 155 | class-allocation-custom ;; class allocated custom descriptor | ||
| 156 | class-allocation-custom-label ;; class allocated custom descriptor | ||
| 157 | class-allocation-custom-group ;; class allocated custom group | ||
| 158 | class-allocation-printer ;; class allocated printer for a slot | ||
| 159 | class-allocation-protection ;; class allocated protection list | ||
| 160 | class-allocation-values ;; class allocated value vector | ||
| 161 | default-object-cache ;; what a newly created object would look like. | ||
| 162 | ; This will speed up instantiation time as | ||
| 163 | ; only a `copy-sequence' will be needed, instead of | ||
| 164 | ; looping over all the values and setting them from | ||
| 165 | ; the default. | ||
| 166 | options ;; storage location of tagged class option | ||
| 167 | ; Stored outright without modifications or stripping | ||
| 168 | ) | ||
| 169 | ;; Set it back to the default value. | ||
| 170 | (cl-declaim (optimize (safety 1)))) | ||
| 112 | 171 | ||
| 113 | ;;; | 172 | |
| 114 | ;; Field Accessors | 173 | (cl-defstruct (eieio--object |
| 115 | ;; | 174 | (:type vector) ;We manage our own tagging system. |
| 116 | (defmacro eieio--define-field-accessors (prefix fields) | 175 | (:constructor nil) |
| 117 | (declare (indent 1)) | 176 | (:copier nil)) |
| 118 | (let ((index 0) | 177 | ;; `class-tag' holds a symbol, which is not the class name, but is instead |
| 119 | (defs '())) | 178 | ;; properly prefixed as an internal EIEIO thingy and which holds the class |
| 120 | (dolist (field fields) | 179 | ;; object/struct in its `symbol-value' slot. |
| 121 | (let ((doc (if (listp field) | 180 | class-tag) |
| 122 | (prog1 (cadr field) (setq field (car field)))))) | 181 | |
| 123 | (push `(defmacro ,(intern (format "eieio--%s-%s" prefix field)) (x) | 182 | (eval-and-compile |
| 124 | ,@(if doc (list (format (if (string-match "\n" doc) | 183 | (defconst eieio--object-num-slots |
| 125 | "Return %s" "Return %s of a %s.") | 184 | (length (get 'eieio--object 'cl-struct-slots)))) |
| 126 | doc prefix))) | 185 | |
| 127 | (list 'aref x ,index)) | 186 | (defsubst eieio--object-class-object (obj) |
| 128 | defs) | 187 | (symbol-value (eieio--object-class-tag obj))) |
| 129 | (setq index (1+ index)))) | 188 | |
| 130 | `(eval-and-compile | 189 | (defsubst eieio--object-class-name (obj) |
| 131 | ,@(nreverse defs) | 190 | ;; FIXME: Most uses of this function should be changed to use |
| 132 | (defconst ,(intern (format "eieio--%s-num-slots" prefix)) ,index)))) | 191 | ;; eieio--object-class-object instead! |
| 133 | 192 | (eieio--class-symbol (eieio--object-class-object obj))) | |
| 134 | (eieio--define-field-accessors class | ||
| 135 | (-unused-0 ;;FIXME: not sure, but at least there was no accessor! | ||
| 136 | (symbol "symbol (self-referencing)") | ||
| 137 | parent children | ||
| 138 | (symbol-obarray "obarray permitting fast access to variable position indexes") | ||
| 139 | ;; @todo | ||
| 140 | ;; the word "public" here is leftovers from the very first version. | ||
| 141 | ;; Get rid of it! | ||
| 142 | (public-a "class attribute index") | ||
| 143 | (public-d "class attribute defaults index") | ||
| 144 | (public-doc "class documentation strings for attributes") | ||
| 145 | (public-type "class type for a slot") | ||
| 146 | (public-custom "class custom type for a slot") | ||
| 147 | (public-custom-label "class custom group for a slot") | ||
| 148 | (public-custom-group "class custom group for a slot") | ||
| 149 | (public-printer "printer for a slot") | ||
| 150 | (protection "protection for a slot") | ||
| 151 | (initarg-tuples "initarg tuples list") | ||
| 152 | (class-allocation-a "class allocated attributes") | ||
| 153 | (class-allocation-doc "class allocated documentation") | ||
| 154 | (class-allocation-type "class allocated value type") | ||
| 155 | (class-allocation-custom "class allocated custom descriptor") | ||
| 156 | (class-allocation-custom-label "class allocated custom descriptor") | ||
| 157 | (class-allocation-custom-group "class allocated custom group") | ||
| 158 | (class-allocation-printer "class allocated printer for a slot") | ||
| 159 | (class-allocation-protection "class allocated protection list") | ||
| 160 | (class-allocation-values "class allocated value vector") | ||
| 161 | (default-object-cache "what a newly created object would look like. | ||
| 162 | This will speed up instantiation time as only a `copy-sequence' will | ||
| 163 | be needed, instead of looping over all the values and setting them | ||
| 164 | from the default.") | ||
| 165 | (options "storage location of tagged class options. | ||
| 166 | Stored outright without modifications or stripping."))) | ||
| 167 | |||
| 168 | (eieio--define-field-accessors object | ||
| 169 | (-unused-0 ;;FIXME: not sure, but at least there was no accessor! | ||
| 170 | (class "class struct defining OBJ") | ||
| 171 | name)) | ||
| 172 | |||
| 173 | ;; FIXME: The constants below should have an `eieio-' prefix added!! | ||
| 174 | |||
| 175 | (defconst method-static 0 "Index into :static tag on a method.") | ||
| 176 | (defconst method-before 1 "Index into :before tag on a method.") | ||
| 177 | (defconst method-primary 2 "Index into :primary tag on a method.") | ||
| 178 | (defconst method-after 3 "Index into :after tag on a method.") | ||
| 179 | (defconst method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") | ||
| 180 | (defconst method-generic-before 4 "Index into generic :before tag on a method.") | ||
| 181 | (defconst method-generic-primary 5 "Index into generic :primary tag on a method.") | ||
| 182 | (defconst method-generic-after 6 "Index into generic :after tag on a method.") | ||
| 183 | (defconst method-num-slots 7 "Number of indexes into a method's vector.") | ||
| 184 | |||
| 185 | (defsubst eieio-specialized-key-to-generic-key (key) | ||
| 186 | "Convert a specialized KEY into a generic method key." | ||
| 187 | (cond ((eq key method-static) 0) ;; don't convert | ||
| 188 | ((< key method-num-lists) (+ key 3)) ;; The conversion | ||
| 189 | (t key) ;; already generic.. maybe. | ||
| 190 | )) | ||
| 191 | 193 | ||
| 192 | 194 | ||
| 193 | ;;; Important macros used internally in eieio. | 195 | ;;; Important macros used internally in eieio. |
| @@ -201,114 +203,91 @@ Stored outright without modifications or stripping."))) | |||
| 201 | (t `(,type ,obj)))) | 203 | (t `(,type ,obj)))) |
| 202 | (signal 'wrong-type-argument (list ',type ,obj)))) | 204 | (signal 'wrong-type-argument (list ',type ,obj)))) |
| 203 | 205 | ||
| 204 | (defmacro class-v (class) | 206 | (defmacro eieio--class-v (class) ;Use a macro, so it acts as a GV place. |
| 205 | "Internal: Return the class vector from the CLASS symbol." | 207 | "Internal: Return the class vector from the CLASS symbol." |
| 208 | (declare (debug t)) | ||
| 206 | ;; No check: If eieio gets this far, it has probably been checked already. | 209 | ;; No check: If eieio gets this far, it has probably been checked already. |
| 207 | `(get ,class 'eieio-class-definition)) | 210 | `(get ,class 'eieio-class-definition)) |
| 208 | 211 | ||
| 212 | (defsubst eieio--class-object (class) | ||
| 213 | "Return the class object." | ||
| 214 | (if (symbolp class) | ||
| 215 | ;; Keep the symbol if class-v is nil, for better error messages. | ||
| 216 | (or (eieio--class-v class) class) | ||
| 217 | class)) | ||
| 218 | |||
| 219 | (defsubst eieio--class-p (class) | ||
| 220 | "Return non-nil if CLASS is a valid class object." | ||
| 221 | (condition-case nil | ||
| 222 | (eq (aref class 0) 'defclass) | ||
| 223 | (error nil))) | ||
| 224 | |||
| 225 | (defsubst eieio-class-object (class) | ||
| 226 | "Check that CLASS is a class and return the corresponding object." | ||
| 227 | (let ((c (eieio--class-object class))) | ||
| 228 | (eieio--check-type eieio--class-p c) | ||
| 229 | c)) | ||
| 230 | |||
| 209 | (defsubst class-p (class) | 231 | (defsubst class-p (class) |
| 210 | "Return non-nil if CLASS is a valid class vector. | 232 | "Return non-nil if CLASS is a valid class vector. |
| 211 | CLASS is a symbol." | 233 | CLASS is a symbol." ;FIXME: Is it a vector or a symbol? |
| 212 | ;; this new method is faster since it doesn't waste time checking lots of | 234 | ;; this new method is faster since it doesn't waste time checking lots of |
| 213 | ;; things. | 235 | ;; things. |
| 214 | (condition-case nil | 236 | (condition-case nil |
| 215 | (eq (aref (class-v class) 0) 'defclass) | 237 | (eq (aref (eieio--class-v class) 0) 'defclass) |
| 216 | (error nil))) | 238 | (error nil))) |
| 217 | 239 | ||
| 218 | (defun eieio-class-name (class) "Return a Lisp like symbol name for CLASS." | 240 | (defun eieio-class-name (class) |
| 241 | "Return a Lisp like symbol name for CLASS." | ||
| 242 | ;; FIXME: What's a "Lisp like symbol name"? | ||
| 243 | ;; FIXME: CLOS returns a symbol, but the code returns a string. | ||
| 244 | (if (eieio--class-p class) (setq class (eieio--class-symbol class))) | ||
| 219 | (eieio--check-type class-p class) | 245 | (eieio--check-type class-p class) |
| 220 | ;; I think this is supposed to return a symbol, but to me CLASS is a symbol, | 246 | ;; I think this is supposed to return a symbol, but to me CLASS is a symbol, |
| 221 | ;; and I wanted a string. Arg! | 247 | ;; and I wanted a string. Arg! |
| 222 | (format "#<class %s>" (symbol-name class))) | 248 | (format "#<class %s>" (symbol-name class))) |
| 223 | (define-obsolete-function-alias 'class-name #'eieio-class-name "24.4") | 249 | (define-obsolete-function-alias 'class-name #'eieio-class-name "24.4") |
| 224 | 250 | ||
| 225 | (defmacro eieio-class-parents-fast (class) | ||
| 226 | "Return parent classes to CLASS with no check." | ||
| 227 | `(eieio--class-parent (class-v ,class))) | ||
| 228 | |||
| 229 | (defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check." | ||
| 230 | `(eieio--class-children (class-v ,class))) | ||
| 231 | |||
| 232 | (defmacro same-class-fast-p (obj class) | ||
| 233 | "Return t if OBJ is of class-type CLASS with no error checking." | ||
| 234 | `(eq (eieio--object-class ,obj) ,class)) | ||
| 235 | |||
| 236 | (defmacro class-constructor (class) | 251 | (defmacro class-constructor (class) |
| 237 | "Return the symbol representing the constructor of CLASS." | 252 | "Return the symbol representing the constructor of CLASS." |
| 238 | `(eieio--class-symbol (class-v ,class))) | 253 | (declare (debug t)) |
| 239 | 254 | `(eieio--class-symbol (eieio--class-v ,class))) | |
| 240 | (defsubst generic-p (method) | 255 | |
| 241 | "Return non-nil if symbol METHOD is a generic function. | 256 | (defmacro eieio--class-option-assoc (list option) |
| 242 | Only methods have the symbol `eieio-method-obarray' as a property | ||
| 243 | \(which contains a list of all bindings to that method type.)" | ||
| 244 | (and (fboundp method) (get method 'eieio-method-obarray))) | ||
| 245 | |||
| 246 | (defun generic-primary-only-p (method) | ||
| 247 | "Return t if symbol METHOD is a generic function with only primary methods. | ||
| 248 | Only methods have the symbol `eieio-method-obarray' as a property (which | ||
| 249 | contains a list of all bindings to that method type.) | ||
| 250 | Methods with only primary implementations are executed in an optimized way." | ||
| 251 | (and (generic-p method) | ||
| 252 | (let ((M (get method 'eieio-method-tree))) | ||
| 253 | (and (< 0 (length (aref M method-primary))) | ||
| 254 | (not (aref M method-static)) | ||
| 255 | (not (aref M method-before)) | ||
| 256 | (not (aref M method-after)) | ||
| 257 | (not (aref M method-generic-before)) | ||
| 258 | (not (aref M method-generic-primary)) | ||
| 259 | (not (aref M method-generic-after)))) | ||
| 260 | )) | ||
| 261 | |||
| 262 | (defun generic-primary-only-one-p (method) | ||
| 263 | "Return t if symbol METHOD is a generic function with only primary methods. | ||
| 264 | Only methods have the symbol `eieio-method-obarray' as a property (which | ||
| 265 | contains a list of all bindings to that method type.) | ||
| 266 | Methods with only primary implementations are executed in an optimized way." | ||
| 267 | (and (generic-p method) | ||
| 268 | (let ((M (get method 'eieio-method-tree))) | ||
| 269 | (and (= 1 (length (aref M method-primary))) | ||
| 270 | (not (aref M method-static)) | ||
| 271 | (not (aref M method-before)) | ||
| 272 | (not (aref M method-after)) | ||
| 273 | (not (aref M method-generic-before)) | ||
| 274 | (not (aref M method-generic-primary)) | ||
| 275 | (not (aref M method-generic-after)))) | ||
| 276 | )) | ||
| 277 | |||
| 278 | (defmacro class-option-assoc (list option) | ||
| 279 | "Return from LIST the found OPTION, or nil if it doesn't exist." | 257 | "Return from LIST the found OPTION, or nil if it doesn't exist." |
| 280 | `(car-safe (cdr (memq ,option ,list)))) | 258 | `(car-safe (cdr (memq ,option ,list)))) |
| 281 | 259 | ||
| 282 | (defmacro class-option (class option) | 260 | (defsubst eieio--class-option (class option) |
| 283 | "Return the value stored for CLASS' OPTION. | 261 | "Return the value stored for CLASS' OPTION. |
| 284 | Return nil if that option doesn't exist." | 262 | Return nil if that option doesn't exist." |
| 285 | `(class-option-assoc (eieio--class-options (class-v ,class)) ',option)) | 263 | (eieio--class-option-assoc (eieio--class-options class) option)) |
| 286 | 264 | ||
| 287 | (defsubst eieio-object-p (obj) | 265 | (defsubst eieio-object-p (obj) |
| 288 | "Return non-nil if OBJ is an EIEIO object." | 266 | "Return non-nil if OBJ is an EIEIO object." |
| 289 | (condition-case nil | 267 | (and (arrayp obj) |
| 290 | (and (eq (aref obj 0) 'object) | 268 | (condition-case nil |
| 291 | (class-p (eieio--object-class obj))) | 269 | (eq (aref (eieio--object-class-object obj) 0) 'defclass) |
| 292 | (error nil))) | 270 | (error nil)))) |
| 271 | |||
| 293 | (defalias 'object-p 'eieio-object-p) | 272 | (defalias 'object-p 'eieio-object-p) |
| 294 | 273 | ||
| 295 | (defsubst class-abstract-p (class) | 274 | (defsubst class-abstract-p (class) |
| 296 | "Return non-nil if CLASS is abstract. | 275 | "Return non-nil if CLASS is abstract. |
| 297 | Abstract classes cannot be instantiated." | 276 | Abstract classes cannot be instantiated." |
| 298 | (class-option class :abstract)) | 277 | (eieio--class-option (eieio--class-v class) :abstract)) |
| 299 | 278 | ||
| 300 | (defmacro class-method-invocation-order (class) | 279 | (defsubst eieio--class-method-invocation-order (class) |
| 301 | "Return the invocation order of CLASS. | 280 | "Return the invocation order of CLASS. |
| 302 | Abstract classes cannot be instantiated." | 281 | Abstract classes cannot be instantiated." |
| 303 | `(or (class-option ,class :method-invocation-order) | 282 | (or (eieio--class-option class :method-invocation-order) |
| 304 | :breadth-first)) | 283 | :breadth-first)) |
| 305 | 284 | ||
| 306 | 285 | ||
| 307 | 286 | ||
| 308 | ;;; | 287 | ;;; |
| 309 | ;; Class Creation | 288 | ;; Class Creation |
| 310 | 289 | ||
| 311 | (defvar eieio-defclass-autoload-map (make-vector 7 nil) | 290 | (defvar eieio-defclass-autoload-map (make-hash-table) |
| 312 | "Symbol map of superclasses we find in autoloads.") | 291 | "Symbol map of superclasses we find in autoloads.") |
| 313 | 292 | ||
| 314 | ;; We autoload this because it's used in `make-autoload'. | 293 | ;; We autoload this because it's used in `make-autoload'. |
| @@ -322,16 +301,12 @@ SUPERCLASSES as children. | |||
| 322 | It creates an autoload function for CNAME's constructor." | 301 | It creates an autoload function for CNAME's constructor." |
| 323 | ;; Assume we've already debugged inputs. | 302 | ;; Assume we've already debugged inputs. |
| 324 | 303 | ||
| 325 | (let* ((oldc (when (class-p cname) (class-v cname))) | 304 | (let* ((oldc (when (class-p cname) (eieio--class-v cname))) |
| 326 | (newc (make-vector eieio--class-num-slots nil)) | 305 | (newc (eieio--class-make cname)) |
| 327 | ) | 306 | ) |
| 328 | (if oldc | 307 | (if oldc |
| 329 | nil ;; Do nothing if we already have this class. | 308 | nil ;; Do nothing if we already have this class. |
| 330 | 309 | ||
| 331 | ;; Create the class in NEWC, but don't fill anything else in. | ||
| 332 | (aset newc 0 'defclass) | ||
| 333 | (setf (eieio--class-symbol newc) cname) | ||
| 334 | |||
| 335 | (let ((clear-parent nil)) | 310 | (let ((clear-parent nil)) |
| 336 | ;; No parents? | 311 | ;; No parents? |
| 337 | (when (not superclasses) | 312 | (when (not superclasses) |
| @@ -348,34 +323,25 @@ It creates an autoload function for CNAME's constructor." | |||
| 348 | ;; map needs to be cleared! | 323 | ;; map needs to be cleared! |
| 349 | 324 | ||
| 350 | 325 | ||
| 351 | ;; Does our parent exist? | 326 | ;; Save the child in the parent. |
| 352 | (if (not (class-p SC)) | 327 | (cl-pushnew cname (if (class-p SC) |
| 353 | 328 | (eieio--class-children (eieio--class-v SC)) | |
| 354 | ;; Create a symbol for this parent, and then store this | 329 | ;; Parent doesn't exist yet. |
| 355 | ;; parent on that symbol. | 330 | (gethash SC eieio-defclass-autoload-map))) |
| 356 | (let ((sym (intern (symbol-name SC) eieio-defclass-autoload-map))) | ||
| 357 | (if (not (boundp sym)) | ||
| 358 | (set sym (list cname)) | ||
| 359 | (add-to-list sym cname)) | ||
| 360 | ) | ||
| 361 | 331 | ||
| 362 | ;; We have a parent, save the child in there. | 332 | ;; Save parent in child. |
| 363 | (when (not (member cname (eieio--class-children (class-v SC)))) | 333 | (push (eieio--class-v SC) (eieio--class-parent newc))) |
| 364 | (setf (eieio--class-children (class-v SC)) | ||
| 365 | (cons cname (eieio--class-children (class-v SC)))))) | ||
| 366 | |||
| 367 | ;; save parent in child | ||
| 368 | (setf (eieio--class-parent newc) (cons SC (eieio--class-parent newc))) | ||
| 369 | ) | ||
| 370 | 334 | ||
| 371 | ;; turn this into a usable self-pointing symbol | 335 | ;; turn this into a usable self-pointing symbol |
| 372 | (set cname cname) | 336 | (when eieio-backward-compatibility |
| 337 | (set cname cname) | ||
| 338 | (make-obsolete-variable cname (format "use '%s instead" cname) "25.1")) | ||
| 373 | 339 | ||
| 374 | ;; Store the new class vector definition into the symbol. We need to | 340 | ;; Store the new class vector definition into the symbol. We need to |
| 375 | ;; do this first so that we can call defmethod for the accessor. | 341 | ;; do this first so that we can call defmethod for the accessor. |
| 376 | ;; The vector will be updated by the following while loop and will not | 342 | ;; The vector will be updated by the following while loop and will not |
| 377 | ;; need to be stored a second time. | 343 | ;; need to be stored a second time. |
| 378 | (put cname 'eieio-class-definition newc) | 344 | (setf (eieio--class-v cname) newc) |
| 379 | 345 | ||
| 380 | ;; Clear the parent | 346 | ;; Clear the parent |
| 381 | (if clear-parent (setf (eieio--class-parent newc) nil)) | 347 | (if clear-parent (setf (eieio--class-parent newc) nil)) |
| @@ -390,8 +356,7 @@ It creates an autoload function for CNAME's constructor." | |||
| 390 | 356 | ||
| 391 | (defsubst eieio-class-un-autoload (cname) | 357 | (defsubst eieio-class-un-autoload (cname) |
| 392 | "If class CNAME is in an autoload state, load its file." | 358 | "If class CNAME is in an autoload state, load its file." |
| 393 | (when (eq (car-safe (symbol-function cname)) 'autoload) | 359 | (autoload-do-load (symbol-function cname))) ; cname |
| 394 | (load-library (car (cdr (symbol-function cname)))))) | ||
| 395 | 360 | ||
| 396 | (cl-deftype list-of (elem-type) | 361 | (cl-deftype list-of (elem-type) |
| 397 | `(and list | 362 | `(and list |
| @@ -399,11 +364,12 @@ It creates an autoload function for CNAME's constructor." | |||
| 399 | (cl-every (lambda (elem) (cl-typep elem ',elem-type)) | 364 | (cl-every (lambda (elem) (cl-typep elem ',elem-type)) |
| 400 | list))))) | 365 | list))))) |
| 401 | 366 | ||
| 402 | (defun eieio-defclass (cname superclasses slots options-and-doc) | 367 | (declare-function eieio--defmethod "eieio-generic" (method kind argclass code)) |
| 403 | ;; FIXME: Most of this should be moved to the `defclass' macro. | 368 | |
| 369 | (defun eieio-defclass-internal (cname superclasses slots options) | ||
| 404 | "Define CNAME as a new subclass of SUPERCLASSES. | 370 | "Define CNAME as a new subclass of SUPERCLASSES. |
| 405 | SLOTS are the slots residing in that class definition, and options or | 371 | SLOTS are the slots residing in that class definition, and OPTIONS |
| 406 | documentation OPTIONS-AND-DOC is the toplevel documentation for this class. | 372 | holds the class options. |
| 407 | See `defclass' for more information." | 373 | See `defclass' for more information." |
| 408 | ;; Run our eieio-hook each time, and clear it when we are done. | 374 | ;; Run our eieio-hook each time, and clear it when we are done. |
| 409 | ;; This way people can add hooks safely if they want to modify eieio | 375 | ;; This way people can add hooks safely if they want to modify eieio |
| @@ -411,18 +377,12 @@ See `defclass' for more information." | |||
| 411 | (run-hooks 'eieio-hook) | 377 | (run-hooks 'eieio-hook) |
| 412 | (setq eieio-hook nil) | 378 | (setq eieio-hook nil) |
| 413 | 379 | ||
| 414 | (eieio--check-type listp superclasses) | ||
| 415 | |||
| 416 | (let* ((pname superclasses) | 380 | (let* ((pname superclasses) |
| 417 | (newc (make-vector eieio--class-num-slots nil)) | 381 | (newc (eieio--class-make cname)) |
| 418 | (oldc (when (class-p cname) (class-v cname))) | 382 | (oldc (when (class-p cname) (eieio--class-v cname))) |
| 419 | (groups nil) ;; list of groups id'd from slots | 383 | (groups nil) ;; list of groups id'd from slots |
| 420 | (options nil) | ||
| 421 | (clearparent nil)) | 384 | (clearparent nil)) |
| 422 | 385 | ||
| 423 | (aset newc 0 'defclass) | ||
| 424 | (setf (eieio--class-symbol newc) cname) | ||
| 425 | |||
| 426 | ;; If this class already existed, and we are updating its structure, | 386 | ;; If this class already existed, and we are updating its structure, |
| 427 | ;; make sure we keep the old child list. This can cause bugs, but | 387 | ;; make sure we keep the old child list. This can cause bugs, but |
| 428 | ;; if no new slots are created, it also saves time, and prevents | 388 | ;; if no new slots are created, it also saves time, and prevents |
| @@ -430,123 +390,68 @@ See `defclass' for more information." | |||
| 430 | ;; byte compiling an EIEIO file. | 390 | ;; byte compiling an EIEIO file. |
| 431 | (if oldc | 391 | (if oldc |
| 432 | (setf (eieio--class-children newc) (eieio--class-children oldc)) | 392 | (setf (eieio--class-children newc) (eieio--class-children oldc)) |
| 433 | ;; If the old class did not exist, but did exist in the autoload map, then adopt those children. | 393 | ;; If the old class did not exist, but did exist in the autoload map, |
| 434 | ;; This is like the above, but deals with autoloads nicely. | 394 | ;; then adopt those children. This is like the above, but deals with |
| 435 | (let ((sym (intern-soft (symbol-name cname) eieio-defclass-autoload-map))) | 395 | ;; autoloads nicely. |
| 436 | (when sym | 396 | (let ((children (gethash cname eieio-defclass-autoload-map))) |
| 437 | (condition-case nil | 397 | (when children |
| 438 | (setf (eieio--class-children newc) (symbol-value sym)) | 398 | (setf (eieio--class-children newc) children) |
| 439 | (error nil)) | 399 | (remhash cname eieio-defclass-autoload-map)))) |
| 440 | (unintern (symbol-name cname) eieio-defclass-autoload-map) | ||
| 441 | )) | ||
| 442 | ) | ||
| 443 | |||
| 444 | (cond ((and (stringp (car options-and-doc)) | ||
| 445 | (/= 1 (% (length options-and-doc) 2))) | ||
| 446 | (error "Too many arguments to `defclass'")) | ||
| 447 | ((and (symbolp (car options-and-doc)) | ||
| 448 | (/= 0 (% (length options-and-doc) 2))) | ||
| 449 | (error "Too many arguments to `defclass'")) | ||
| 450 | ) | ||
| 451 | |||
| 452 | (setq options | ||
| 453 | (if (stringp (car options-and-doc)) | ||
| 454 | (cons :documentation options-and-doc) | ||
| 455 | options-and-doc)) | ||
| 456 | 400 | ||
| 457 | (if pname | 401 | (if pname |
| 458 | (progn | 402 | (progn |
| 459 | (while pname | 403 | (dolist (p pname) |
| 460 | (if (and (car pname) (symbolp (car pname))) | 404 | (if (and p (symbolp p)) |
| 461 | (if (not (class-p (car pname))) | 405 | (if (not (class-p p)) |
| 462 | ;; bad class | 406 | ;; bad class |
| 463 | (error "Given parent class %s is not a class" (car pname)) | 407 | (error "Given parent class %S is not a class" p) |
| 464 | ;; good parent class... | 408 | ;; good parent class... |
| 465 | ;; save new child in parent | 409 | ;; save new child in parent |
| 466 | (when (not (member cname (eieio--class-children (class-v (car pname))))) | 410 | (cl-pushnew cname (eieio--class-children (eieio--class-v p))) |
| 467 | (setf (eieio--class-children (class-v (car pname))) | ||
| 468 | (cons cname (eieio--class-children (class-v (car pname)))))) | ||
| 469 | ;; Get custom groups, and store them into our local copy. | 411 | ;; Get custom groups, and store them into our local copy. |
| 470 | (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) | 412 | (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) |
| 471 | (class-option (car pname) :custom-groups)) | 413 | (eieio--class-option (eieio--class-v p) :custom-groups)) |
| 472 | ;; save parent in child | 414 | ;; save parent in child |
| 473 | (setf (eieio--class-parent newc) (cons (car pname) (eieio--class-parent newc)))) | 415 | (push (eieio--class-v p) (eieio--class-parent newc))) |
| 474 | (error "Invalid parent class %s" pname)) | 416 | (error "Invalid parent class %S" p))) |
| 475 | (setq pname (cdr pname))) | ||
| 476 | ;; Reverse the list of our parents so that they are prioritized in | 417 | ;; Reverse the list of our parents so that they are prioritized in |
| 477 | ;; the same order as specified in the code. | 418 | ;; the same order as specified in the code. |
| 478 | (setf (eieio--class-parent newc) (nreverse (eieio--class-parent newc))) ) | 419 | (cl-callf nreverse (eieio--class-parent newc))) |
| 479 | ;; If there is nothing to loop over, then inherit from the | 420 | ;; If there is nothing to loop over, then inherit from the |
| 480 | ;; default superclass. | 421 | ;; default superclass. |
| 481 | (unless (eq cname 'eieio-default-superclass) | 422 | (unless (eq cname 'eieio-default-superclass) |
| 482 | ;; adopt the default parent here, but clear it later... | 423 | ;; adopt the default parent here, but clear it later... |
| 483 | (setq clearparent t) | 424 | (setq clearparent t) |
| 484 | ;; save new child in parent | 425 | ;; save new child in parent |
| 485 | (if (not (member cname (eieio--class-children (class-v 'eieio-default-superclass)))) | 426 | (cl-pushnew cname (eieio--class-children eieio-default-superclass)) |
| 486 | (setf (eieio--class-children (class-v 'eieio-default-superclass)) | 427 | ;; save parent in child |
| 487 | (cons cname (eieio--class-children (class-v 'eieio-default-superclass))))) | 428 | (setf (eieio--class-parent newc) (list eieio-default-superclass)))) |
| 488 | ;; save parent in child | ||
| 489 | (setf (eieio--class-parent newc) (list eieio-default-superclass)))) | ||
| 490 | |||
| 491 | ;; turn this into a usable self-pointing symbol | ||
| 492 | (set cname cname) | ||
| 493 | |||
| 494 | ;; These two tests must be created right away so we can have self- | ||
| 495 | ;; referencing classes. ei, a class whose slot can contain only | ||
| 496 | ;; pointers to itself. | ||
| 497 | |||
| 498 | ;; Create the test function | ||
| 499 | (let ((csym (intern (concat (symbol-name cname) "-p")))) | ||
| 500 | (fset csym | ||
| 501 | (list 'lambda (list 'obj) | ||
| 502 | (format "Test OBJ to see if it an object of type %s" cname) | ||
| 503 | (list 'and '(eieio-object-p obj) | ||
| 504 | (list 'same-class-p 'obj cname))))) | ||
| 505 | |||
| 506 | ;; Make sure the method invocation order is a valid value. | ||
| 507 | (let ((io (class-option-assoc options :method-invocation-order))) | ||
| 508 | (when (and io (not (member io '(:depth-first :breadth-first :c3)))) | ||
| 509 | (error "Method invocation order %s is not allowed" io) | ||
| 510 | )) | ||
| 511 | 429 | ||
| 512 | ;; Create a handy child test too | 430 | ;; turn this into a usable self-pointing symbol; FIXME: Why? |
| 513 | (let ((csym (intern (concat (symbol-name cname) "-child-p")))) | 431 | (when eieio-backward-compatibility |
| 514 | (fset csym | 432 | (set cname cname) |
| 515 | `(lambda (obj) | 433 | (make-obsolete-variable cname (format "use '%s instead" cname) "25.1")) |
| 516 | ,(format | ||
| 517 | "Test OBJ to see if it an object is a child of type %s" | ||
| 518 | cname) | ||
| 519 | (and (eieio-object-p obj) | ||
| 520 | (object-of-class-p obj ,cname)))) | ||
| 521 | 434 | ||
| 522 | ;; Create a handy list of the class test too | 435 | ;; Create a handy list of the class test too |
| 523 | (let ((csym (intern (concat (symbol-name cname) "-list-p")))) | 436 | (when eieio-backward-compatibility |
| 524 | (fset csym | 437 | (let ((csym (intern (concat (symbol-name cname) "-list-p")))) |
| 525 | `(lambda (obj) | 438 | (defalias csym |
| 526 | ,(format | 439 | `(lambda (obj) |
| 527 | "Test OBJ to see if it a list of objects which are a child of type %s" | 440 | ,(format |
| 528 | cname) | 441 | "Test OBJ to see if it a list of objects which are a child of type %s" |
| 529 | (when (listp obj) | 442 | cname) |
| 530 | (let ((ans t)) ;; nil is valid | 443 | (when (listp obj) |
| 531 | ;; Loop over all the elements of the input list, test | 444 | (let ((ans t)) ;; nil is valid |
| 532 | ;; each to make sure it is a child of the desired object class. | 445 | ;; Loop over all the elements of the input list, test |
| 533 | (while (and obj ans) | 446 | ;; each to make sure it is a child of the desired object class. |
| 534 | (setq ans (and (eieio-object-p (car obj)) | 447 | (while (and obj ans) |
| 535 | (object-of-class-p (car obj) ,cname))) | 448 | (setq ans (and (eieio-object-p (car obj)) |
| 536 | (setq obj (cdr obj))) | 449 | (object-of-class-p (car obj) ,cname))) |
| 537 | ans))))) | 450 | (setq obj (cdr obj))) |
| 538 | 451 | ans)))) | |
| 539 | ;; When using typep, (typep OBJ 'myclass) returns t for objects which | 452 | (make-obsolete csym (format "use (cl-typep ... '(list-of %s)) instead" |
| 540 | ;; are subclasses of myclass. For our predicates, however, it is | 453 | cname) |
| 541 | ;; important for EIEIO to be backwards compatible, where | 454 | "25.1"))) |
| 542 | ;; myobject-p, and myobject-child-p are different. | ||
| 543 | ;; "cl" uses this technique to specify symbols with specific typep | ||
| 544 | ;; test, so we can let typep have the CLOS documented behavior | ||
| 545 | ;; while keeping our above predicate clean. | ||
| 546 | |||
| 547 | ;; FIXME: It would be cleaner to use `cl-deftype' here. | ||
| 548 | (put cname 'cl-deftype-handler | ||
| 549 | (list 'lambda () `(list 'satisfies (quote ,csym))))) | ||
| 550 | 455 | ||
| 551 | ;; Before adding new slots, let's add all the methods and classes | 456 | ;; Before adding new slots, let's add all the methods and classes |
| 552 | ;; in from the parent class. | 457 | ;; in from the parent class. |
| @@ -556,78 +461,45 @@ See `defclass' for more information." | |||
| 556 | ;; do this first so that we can call defmethod for the accessor. | 461 | ;; do this first so that we can call defmethod for the accessor. |
| 557 | ;; The vector will be updated by the following while loop and will not | 462 | ;; The vector will be updated by the following while loop and will not |
| 558 | ;; need to be stored a second time. | 463 | ;; need to be stored a second time. |
| 559 | (put cname 'eieio-class-definition newc) | 464 | (setf (eieio--class-v cname) newc) |
| 560 | 465 | ||
| 561 | ;; Query each slot in the declaration list and mangle into the | 466 | ;; Query each slot in the declaration list and mangle into the |
| 562 | ;; class structure I have defined. | 467 | ;; class structure I have defined. |
| 563 | (while slots | 468 | (pcase-dolist (`(,name . ,slot) slots) |
| 564 | (let* ((slot1 (car slots)) | 469 | (let* ((init (or (plist-get slot :initform) |
| 565 | (name (car slot1)) | 470 | (if (member :initform slot) nil |
| 566 | (slot (cdr slot1)) | ||
| 567 | (acces (plist-get slot ':accessor)) | ||
| 568 | (init (or (plist-get slot ':initform) | ||
| 569 | (if (member ':initform slot) nil | ||
| 570 | eieio-unbound))) | 471 | eieio-unbound))) |
| 571 | (initarg (plist-get slot ':initarg)) | 472 | (initarg (plist-get slot :initarg)) |
| 572 | (docstr (plist-get slot ':documentation)) | 473 | (docstr (plist-get slot :documentation)) |
| 573 | (prot (plist-get slot ':protection)) | 474 | (prot (plist-get slot :protection)) |
| 574 | (reader (plist-get slot ':reader)) | 475 | (alloc (plist-get slot :allocation)) |
| 575 | (writer (plist-get slot ':writer)) | 476 | (type (plist-get slot :type)) |
| 576 | (alloc (plist-get slot ':allocation)) | 477 | (custom (plist-get slot :custom)) |
| 577 | (type (plist-get slot ':type)) | 478 | (label (plist-get slot :label)) |
| 578 | (custom (plist-get slot ':custom)) | 479 | (customg (plist-get slot :group)) |
| 579 | (label (plist-get slot ':label)) | 480 | (printer (plist-get slot :printer)) |
| 580 | (customg (plist-get slot ':group)) | 481 | |
| 581 | (printer (plist-get slot ':printer)) | 482 | (skip-nil (eieio--class-option-assoc options :allow-nil-initform)) |
| 582 | |||
| 583 | (skip-nil (class-option-assoc options :allow-nil-initform)) | ||
| 584 | ) | 483 | ) |
| 585 | 484 | ||
| 586 | (if eieio-error-unsupported-class-tags | ||
| 587 | (let ((tmp slot)) | ||
| 588 | (while tmp | ||
| 589 | (if (not (member (car tmp) '(:accessor | ||
| 590 | :initform | ||
| 591 | :initarg | ||
| 592 | :documentation | ||
| 593 | :protection | ||
| 594 | :reader | ||
| 595 | :writer | ||
| 596 | :allocation | ||
| 597 | :type | ||
| 598 | :custom | ||
| 599 | :label | ||
| 600 | :group | ||
| 601 | :printer | ||
| 602 | :allow-nil-initform | ||
| 603 | :custom-groups))) | ||
| 604 | (signal 'invalid-slot-type (list (car tmp)))) | ||
| 605 | (setq tmp (cdr (cdr tmp)))))) | ||
| 606 | |||
| 607 | ;; Clean up the meaning of protection. | 485 | ;; Clean up the meaning of protection. |
| 608 | (cond ((or (eq prot 'public) (eq prot :public)) (setq prot nil)) | 486 | (setq prot |
| 609 | ((or (eq prot 'protected) (eq prot :protected)) (setq prot 'protected)) | 487 | (pcase prot |
| 610 | ((or (eq prot 'private) (eq prot :private)) (setq prot 'private)) | 488 | ((or 'nil 'public ':public) nil) |
| 611 | ((eq prot nil) nil) | 489 | ((or 'protected ':protected) 'protected) |
| 612 | (t (signal 'invalid-slot-type (list ':protection prot)))) | 490 | ((or 'private ':private) 'private) |
| 613 | 491 | (_ (signal 'invalid-slot-type (list :protection prot))))) | |
| 614 | ;; Make sure the :allocation parameter has a valid value. | ||
| 615 | (if (not (or (not alloc) (eq alloc :class) (eq alloc :instance))) | ||
| 616 | (signal 'invalid-slot-type (list ':allocation alloc))) | ||
| 617 | 492 | ||
| 618 | ;; The default type specifier is supposed to be t, meaning anything. | 493 | ;; The default type specifier is supposed to be t, meaning anything. |
| 619 | (if (not type) (setq type t)) | 494 | (if (not type) (setq type t)) |
| 620 | 495 | ||
| 621 | ;; Label is nil, or a string | ||
| 622 | (if (not (or (null label) (stringp label))) | ||
| 623 | (signal 'invalid-slot-type (list ':label label))) | ||
| 624 | |||
| 625 | ;; Is there an initarg, but allocation of class? | ||
| 626 | (if (and initarg (eq alloc :class)) | ||
| 627 | (message "Class allocated slots do not need :initarg")) | ||
| 628 | |||
| 629 | ;; intern the symbol so we can use it blankly | 496 | ;; intern the symbol so we can use it blankly |
| 630 | (if initarg (set initarg initarg)) | 497 | (if eieio-backward-compatibility |
| 498 | (and initarg (not (keywordp initarg)) | ||
| 499 | (progn | ||
| 500 | (set initarg initarg) | ||
| 501 | (make-obsolete-variable | ||
| 502 | initarg (format "use '%s instead" initarg) "25.1")))) | ||
| 631 | 503 | ||
| 632 | ;; The customgroup should be a list of symbols | 504 | ;; The customgroup should be a list of symbols |
| 633 | (cond ((null customg) | 505 | (cond ((null customg) |
| @@ -637,131 +509,60 @@ See `defclass' for more information." | |||
| 637 | ;; The customgroup better be a symbol, or list of symbols. | 509 | ;; The customgroup better be a symbol, or list of symbols. |
| 638 | (mapc (lambda (cg) | 510 | (mapc (lambda (cg) |
| 639 | (if (not (symbolp cg)) | 511 | (if (not (symbolp cg)) |
| 640 | (signal 'invalid-slot-type (list ':group cg)))) | 512 | (signal 'invalid-slot-type (list :group cg)))) |
| 641 | customg) | 513 | customg) |
| 642 | 514 | ||
| 643 | ;; First up, add this slot into our new class. | 515 | ;; First up, add this slot into our new class. |
| 644 | (eieio-add-new-slot newc name init docstr type custom label customg printer | 516 | (eieio--add-new-slot newc name init docstr type custom label customg printer |
| 645 | prot initarg alloc 'defaultoverride skip-nil) | 517 | prot initarg alloc 'defaultoverride skip-nil) |
| 646 | 518 | ||
| 647 | ;; We need to id the group, and store them in a group list attribute. | 519 | ;; We need to id the group, and store them in a group list attribute. |
| 648 | (mapc (lambda (cg) (cl-pushnew cg groups :test 'equal)) customg) | 520 | (dolist (cg customg) |
| 649 | 521 | (cl-pushnew cg groups :test 'equal)) | |
| 650 | ;; Anyone can have an accessor function. This creates a function | 522 | )) |
| 651 | ;; of the specified name, and also performs a `defsetf' if applicable | ||
| 652 | ;; so that users can `setf' the space returned by this function. | ||
| 653 | (if acces | ||
| 654 | (progn | ||
| 655 | (eieio--defmethod | ||
| 656 | acces (if (eq alloc :class) :static :primary) cname | ||
| 657 | `(lambda (this) | ||
| 658 | ,(format | ||
| 659 | "Retrieves the slot `%s' from an object of class `%s'" | ||
| 660 | name cname) | ||
| 661 | (if (slot-boundp this ',name) | ||
| 662 | (eieio-oref this ',name) | ||
| 663 | ;; Else - Some error? nil? | ||
| 664 | nil))) | ||
| 665 | |||
| 666 | ;; FIXME: We should move more of eieio-defclass into the | ||
| 667 | ;; defclass macro so we don't have to use `eval' and require | ||
| 668 | ;; `gv' at run-time. | ||
| 669 | (eval `(gv-define-setter ,acces (eieio--store eieio--object) | ||
| 670 | (list 'eieio-oset eieio--object '',name | ||
| 671 | eieio--store))))) | ||
| 672 | |||
| 673 | ;; If a writer is defined, then create a generic method of that | ||
| 674 | ;; name whose purpose is to set the value of the slot. | ||
| 675 | (if writer | ||
| 676 | (eieio--defmethod | ||
| 677 | writer nil cname | ||
| 678 | `(lambda (this value) | ||
| 679 | ,(format "Set the slot `%s' of an object of class `%s'" | ||
| 680 | name cname) | ||
| 681 | (setf (slot-value this ',name) value)))) | ||
| 682 | ;; If a reader is defined, then create a generic method | ||
| 683 | ;; of that name whose purpose is to access this slot value. | ||
| 684 | (if reader | ||
| 685 | (eieio--defmethod | ||
| 686 | reader nil cname | ||
| 687 | `(lambda (this) | ||
| 688 | ,(format "Access the slot `%s' from object of class `%s'" | ||
| 689 | name cname) | ||
| 690 | (slot-value this ',name)))) | ||
| 691 | ) | ||
| 692 | (setq slots (cdr slots))) | ||
| 693 | 523 | ||
| 694 | ;; Now that everything has been loaded up, all our lists are backwards! | 524 | ;; Now that everything has been loaded up, all our lists are backwards! |
| 695 | ;; Fix that up now. | 525 | ;; Fix that up now. |
| 696 | (setf (eieio--class-public-a newc) (nreverse (eieio--class-public-a newc))) | 526 | (cl-callf nreverse (eieio--class-public-a newc)) |
| 697 | (setf (eieio--class-public-d newc) (nreverse (eieio--class-public-d newc))) | 527 | (cl-callf nreverse (eieio--class-public-d newc)) |
| 698 | (setf (eieio--class-public-doc newc) (nreverse (eieio--class-public-doc newc))) | 528 | (cl-callf nreverse (eieio--class-public-doc newc)) |
| 699 | (setf (eieio--class-public-type newc) | 529 | (cl-callf (lambda (types) (apply #'vector (nreverse types))) |
| 700 | (apply #'vector (nreverse (eieio--class-public-type newc)))) | 530 | (eieio--class-public-type newc)) |
| 701 | (setf (eieio--class-public-custom newc) (nreverse (eieio--class-public-custom newc))) | 531 | (cl-callf nreverse (eieio--class-public-custom newc)) |
| 702 | (setf (eieio--class-public-custom-label newc) (nreverse (eieio--class-public-custom-label newc))) | 532 | (cl-callf nreverse (eieio--class-public-custom-label newc)) |
| 703 | (setf (eieio--class-public-custom-group newc) (nreverse (eieio--class-public-custom-group newc))) | 533 | (cl-callf nreverse (eieio--class-public-custom-group newc)) |
| 704 | (setf (eieio--class-public-printer newc) (nreverse (eieio--class-public-printer newc))) | 534 | (cl-callf nreverse (eieio--class-public-printer newc)) |
| 705 | (setf (eieio--class-protection newc) (nreverse (eieio--class-protection newc))) | 535 | (cl-callf nreverse (eieio--class-protection newc)) |
| 706 | (setf (eieio--class-initarg-tuples newc) (nreverse (eieio--class-initarg-tuples newc))) | 536 | (cl-callf nreverse (eieio--class-initarg-tuples newc)) |
| 707 | 537 | ||
| 708 | ;; The storage for class-class-allocation-type needs to be turned into | 538 | ;; The storage for class-class-allocation-type needs to be turned into |
| 709 | ;; a vector now. | 539 | ;; a vector now. |
| 710 | (setf (eieio--class-class-allocation-type newc) | 540 | (cl-callf (lambda (cat) (apply #'vector cat)) |
| 711 | (apply #'vector (eieio--class-class-allocation-type newc))) | 541 | (eieio--class-class-allocation-type newc)) |
| 712 | 542 | ||
| 713 | ;; Also, take class allocated values, and vectorize them for speed. | 543 | ;; Also, take class allocated values, and vectorize them for speed. |
| 714 | (setf (eieio--class-class-allocation-values newc) | 544 | (cl-callf (lambda (cavs) (apply #'vector cavs)) |
| 715 | (apply #'vector (eieio--class-class-allocation-values newc))) | 545 | (eieio--class-class-allocation-values newc)) |
| 716 | 546 | ||
| 717 | ;; Attach slot symbols into an obarray, and store the index of | 547 | ;; Attach slot symbols into a hashtable, and store the index of |
| 718 | ;; this slot as the variable slot in this new symbol. We need to | 548 | ;; this slot as the value this table. |
| 719 | ;; know about primes, because obarrays are best set in vectors of | ||
| 720 | ;; prime number length, and we also need to make our vector small | ||
| 721 | ;; to save space, and also optimal for the number of items we have. | ||
| 722 | (let* ((cnt 0) | 549 | (let* ((cnt 0) |
| 723 | (pubsyms (eieio--class-public-a newc)) | 550 | (pubsyms (eieio--class-public-a newc)) |
| 724 | (prots (eieio--class-protection newc)) | 551 | (prots (eieio--class-protection newc)) |
| 725 | (l (length pubsyms)) | 552 | (oa (make-hash-table :test #'eq))) |
| 726 | (vl (let ((primes '( 3 5 7 11 13 17 19 23 29 31 37 41 43 47 | ||
| 727 | 53 59 61 67 71 73 79 83 89 97 101 ))) | ||
| 728 | (while (and primes (< (car primes) l)) | ||
| 729 | (setq primes (cdr primes))) | ||
| 730 | (car primes))) | ||
| 731 | (oa (make-vector vl 0)) | ||
| 732 | (newsym)) | ||
| 733 | (while pubsyms | 553 | (while pubsyms |
| 734 | (setq newsym (intern (symbol-name (car pubsyms)) oa)) | 554 | (let ((newsym (list cnt))) |
| 735 | (set newsym cnt) | 555 | (setf (gethash (car pubsyms) oa) newsym) |
| 736 | (setq cnt (1+ cnt)) | 556 | (setq cnt (1+ cnt)) |
| 737 | (if (car prots) (put newsym 'protection (car prots))) | 557 | (if (car prots) (setcdr newsym (car prots)))) |
| 738 | (setq pubsyms (cdr pubsyms) | 558 | (setq pubsyms (cdr pubsyms) |
| 739 | prots (cdr prots))) | 559 | prots (cdr prots))) |
| 740 | (setf (eieio--class-symbol-obarray newc) oa) | 560 | (setf (eieio--class-symbol-hashtable newc) oa)) |
| 741 | ) | ||
| 742 | |||
| 743 | ;; Create the constructor function | ||
| 744 | (if (class-option-assoc options :abstract) | ||
| 745 | ;; Abstract classes cannot be instantiated. Say so. | ||
| 746 | (let ((abs (class-option-assoc options :abstract))) | ||
| 747 | (if (not (stringp abs)) | ||
| 748 | (setq abs (format "Class %s is abstract" cname))) | ||
| 749 | (fset cname | ||
| 750 | `(lambda (&rest stuff) | ||
| 751 | ,(format "You cannot create a new object of type %s" cname) | ||
| 752 | (error ,abs)))) | ||
| 753 | |||
| 754 | ;; Non-abstract classes need a constructor. | ||
| 755 | (fset cname | ||
| 756 | `(lambda (newname &rest slots) | ||
| 757 | ,(format "Create a new object with name NAME of class type %s" cname) | ||
| 758 | (apply #'constructor ,cname newname slots))) | ||
| 759 | ) | ||
| 760 | 561 | ||
| 761 | ;; Set up a specialized doc string. | 562 | ;; Set up a specialized doc string. |
| 762 | ;; Use stored value since it is calculated in a non-trivial way | 563 | ;; Use stored value since it is calculated in a non-trivial way |
| 763 | (put cname 'variable-documentation | 564 | (put cname 'variable-documentation |
| 764 | (class-option-assoc options :documentation)) | 565 | (eieio--class-option-assoc options :documentation)) |
| 765 | 566 | ||
| 766 | ;; Save the file location where this class is defined. | 567 | ;; Save the file location where this class is defined. |
| 767 | (let ((fname (if load-in-progress | 568 | (let ((fname (if load-in-progress |
| @@ -773,7 +574,7 @@ See `defclass' for more information." | |||
| 773 | (put cname 'class-location fname))) | 574 | (put cname 'class-location fname))) |
| 774 | 575 | ||
| 775 | ;; We have a list of custom groups. Store them into the options. | 576 | ;; We have a list of custom groups. Store them into the options. |
| 776 | (let ((g (class-option-assoc options :custom-groups))) | 577 | (let ((g (eieio--class-option-assoc options :custom-groups))) |
| 777 | (mapc (lambda (cg) (cl-pushnew cg g :test 'equal)) groups) | 578 | (mapc (lambda (cg) (cl-pushnew cg g :test 'equal)) groups) |
| 778 | (if (memq :custom-groups options) | 579 | (if (memq :custom-groups options) |
| 779 | (setcar (cdr (memq :custom-groups options)) g) | 580 | (setcar (cdr (memq :custom-groups options)) g) |
| @@ -787,11 +588,17 @@ See `defclass' for more information." | |||
| 787 | (if clearparent (setf (eieio--class-parent newc) nil)) | 588 | (if clearparent (setf (eieio--class-parent newc) nil)) |
| 788 | 589 | ||
| 789 | ;; Create the cached default object. | 590 | ;; Create the cached default object. |
| 790 | (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) 3) | 591 | (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) |
| 791 | nil))) | 592 | (eval-when-compile eieio--object-num-slots)) |
| 792 | (aset cache 0 'object) | 593 | nil)) |
| 793 | (setf (eieio--object-class cache) cname) | 594 | ;; We don't strictly speaking need to use a symbol, but the old |
| 794 | (setf (eieio--object-name cache) 'default-cache-object) | 595 | ;; code used the class's name rather than the class's object, so |
| 596 | ;; we follow this preference for using a symbol, which is probably | ||
| 597 | ;; convenient to keep the printed representation of such Elisp | ||
| 598 | ;; objects readable. | ||
| 599 | (tag (intern (format "eieio-class-tag--%s" cname)))) | ||
| 600 | (set tag newc) | ||
| 601 | (setf (eieio--object-class-tag cache) tag) | ||
| 795 | (let ((eieio-skip-typecheck t)) | 602 | (let ((eieio-skip-typecheck t)) |
| 796 | ;; All type-checking has been done to our satisfaction | 603 | ;; All type-checking has been done to our satisfaction |
| 797 | ;; before this call. Don't waste our time in this call.. | 604 | ;; before this call. Don't waste our time in this call.. |
| @@ -807,16 +614,16 @@ See `defclass' for more information." | |||
| 807 | "Whether the default value VAL should be evaluated for use." | 614 | "Whether the default value VAL should be evaluated for use." |
| 808 | (and (consp val) (symbolp (car val)) (fboundp (car val)))) | 615 | (and (consp val) (symbolp (car val)) (fboundp (car val)))) |
| 809 | 616 | ||
| 810 | (defun eieio-perform-slot-validation-for-default (slot spec value skipnil) | 617 | (defun eieio--perform-slot-validation-for-default (slot spec value skipnil) |
| 811 | "For SLOT, signal if SPEC does not match VALUE. | 618 | "For SLOT, signal if SPEC does not match VALUE. |
| 812 | If SKIPNIL is non-nil, then if VALUE is nil return t instead." | 619 | If SKIPNIL is non-nil, then if VALUE is nil return t instead." |
| 813 | (if (and (not (eieio-eval-default-p value)) | 620 | (if (not (or (eieio-eval-default-p value) ;FIXME: Why? |
| 814 | (not eieio-skip-typecheck) | 621 | eieio-skip-typecheck |
| 815 | (not (and skipnil (null value))) | 622 | (and skipnil (null value)) |
| 816 | (not (eieio-perform-slot-validation spec value))) | 623 | (eieio--perform-slot-validation spec value))) |
| 817 | (signal 'invalid-slot-type (list slot spec value)))) | 624 | (signal 'invalid-slot-type (list slot spec value)))) |
| 818 | 625 | ||
| 819 | (defun eieio-add-new-slot (newc a d doc type cust label custg print prot init alloc | 626 | (defun eieio--add-new-slot (newc a d doc type cust label custg print prot init alloc |
| 820 | &optional defaultoverride skipnil) | 627 | &optional defaultoverride skipnil) |
| 821 | "Add into NEWC attribute A. | 628 | "Add into NEWC attribute A. |
| 822 | If A already exists in NEWC, then do nothing. If it doesn't exist, | 629 | If A already exists in NEWC, then do nothing. If it doesn't exist, |
| @@ -837,9 +644,9 @@ if default value is nil." | |||
| 837 | 644 | ||
| 838 | ;; To prevent override information w/out specification of storage, | 645 | ;; To prevent override information w/out specification of storage, |
| 839 | ;; we need to do this little hack. | 646 | ;; we need to do this little hack. |
| 840 | (if (member a (eieio--class-class-allocation-a newc)) (setq alloc ':class)) | 647 | (if (member a (eieio--class-class-allocation-a newc)) (setq alloc :class)) |
| 841 | 648 | ||
| 842 | (if (or (not alloc) (and (symbolp alloc) (eq alloc ':instance))) | 649 | (if (or (not alloc) (and (symbolp alloc) (eq alloc :instance))) |
| 843 | ;; In this case, we modify the INSTANCE version of a given slot. | 650 | ;; In this case, we modify the INSTANCE version of a given slot. |
| 844 | 651 | ||
| 845 | (progn | 652 | (progn |
| @@ -847,16 +654,16 @@ if default value is nil." | |||
| 847 | ;; Only add this element if it is so-far unique | 654 | ;; Only add this element if it is so-far unique |
| 848 | (if (not (member a (eieio--class-public-a newc))) | 655 | (if (not (member a (eieio--class-public-a newc))) |
| 849 | (progn | 656 | (progn |
| 850 | (eieio-perform-slot-validation-for-default a type d skipnil) | 657 | (eieio--perform-slot-validation-for-default a type d skipnil) |
| 851 | (setf (eieio--class-public-a newc) (cons a (eieio--class-public-a newc))) | 658 | (push a (eieio--class-public-a newc)) |
| 852 | (setf (eieio--class-public-d newc) (cons d (eieio--class-public-d newc))) | 659 | (push d (eieio--class-public-d newc)) |
| 853 | (setf (eieio--class-public-doc newc) (cons doc (eieio--class-public-doc newc))) | 660 | (push doc (eieio--class-public-doc newc)) |
| 854 | (setf (eieio--class-public-type newc) (cons type (eieio--class-public-type newc))) | 661 | (push type (eieio--class-public-type newc)) |
| 855 | (setf (eieio--class-public-custom newc) (cons cust (eieio--class-public-custom newc))) | 662 | (push cust (eieio--class-public-custom newc)) |
| 856 | (setf (eieio--class-public-custom-label newc) (cons label (eieio--class-public-custom-label newc))) | 663 | (push label (eieio--class-public-custom-label newc)) |
| 857 | (setf (eieio--class-public-custom-group newc) (cons custg (eieio--class-public-custom-group newc))) | 664 | (push custg (eieio--class-public-custom-group newc)) |
| 858 | (setf (eieio--class-public-printer newc) (cons print (eieio--class-public-printer newc))) | 665 | (push print (eieio--class-public-printer newc)) |
| 859 | (setf (eieio--class-protection newc) (cons prot (eieio--class-protection newc))) | 666 | (push prot (eieio--class-protection newc)) |
| 860 | (setf (eieio--class-initarg-tuples newc) (cons (cons init a) (eieio--class-initarg-tuples newc))) | 667 | (setf (eieio--class-initarg-tuples newc) (cons (cons init a) (eieio--class-initarg-tuples newc))) |
| 861 | ) | 668 | ) |
| 862 | ;; When defaultoverride is true, we are usually adding new local | 669 | ;; When defaultoverride is true, we are usually adding new local |
| @@ -882,7 +689,7 @@ if default value is nil." | |||
| 882 | type tp a))) | 689 | type tp a))) |
| 883 | ;; If we have a repeat, only update the initarg... | 690 | ;; If we have a repeat, only update the initarg... |
| 884 | (unless (eq d eieio-unbound) | 691 | (unless (eq d eieio-unbound) |
| 885 | (eieio-perform-slot-validation-for-default a tp d skipnil) | 692 | (eieio--perform-slot-validation-for-default a tp d skipnil) |
| 886 | (setcar dp d)) | 693 | (setcar dp d)) |
| 887 | ;; If we have a new initarg, check for it. | 694 | ;; If we have a new initarg, check for it. |
| 888 | (when init | 695 | (when init |
| @@ -959,19 +766,19 @@ if default value is nil." | |||
| 959 | (let ((value (eieio-default-eval-maybe d))) | 766 | (let ((value (eieio-default-eval-maybe d))) |
| 960 | (if (not (member a (eieio--class-class-allocation-a newc))) | 767 | (if (not (member a (eieio--class-class-allocation-a newc))) |
| 961 | (progn | 768 | (progn |
| 962 | (eieio-perform-slot-validation-for-default a type value skipnil) | 769 | (eieio--perform-slot-validation-for-default a type value skipnil) |
| 963 | ;; Here we have found a :class version of a slot. This | 770 | ;; Here we have found a :class version of a slot. This |
| 964 | ;; requires a very different approach. | 771 | ;; requires a very different approach. |
| 965 | (setf (eieio--class-class-allocation-a newc) (cons a (eieio--class-class-allocation-a newc))) | 772 | (push a (eieio--class-class-allocation-a newc)) |
| 966 | (setf (eieio--class-class-allocation-doc newc) (cons doc (eieio--class-class-allocation-doc newc))) | 773 | (push doc (eieio--class-class-allocation-doc newc)) |
| 967 | (setf (eieio--class-class-allocation-type newc) (cons type (eieio--class-class-allocation-type newc))) | 774 | (push type (eieio--class-class-allocation-type newc)) |
| 968 | (setf (eieio--class-class-allocation-custom newc) (cons cust (eieio--class-class-allocation-custom newc))) | 775 | (push cust (eieio--class-class-allocation-custom newc)) |
| 969 | (setf (eieio--class-class-allocation-custom-label newc) (cons label (eieio--class-class-allocation-custom-label newc))) | 776 | (push label (eieio--class-class-allocation-custom-label newc)) |
| 970 | (setf (eieio--class-class-allocation-custom-group newc) (cons custg (eieio--class-class-allocation-custom-group newc))) | 777 | (push custg (eieio--class-class-allocation-custom-group newc)) |
| 971 | (setf (eieio--class-class-allocation-protection newc) (cons prot (eieio--class-class-allocation-protection newc))) | 778 | (push prot (eieio--class-class-allocation-protection newc)) |
| 972 | ;; Default value is stored in the 'values section, since new objects | 779 | ;; Default value is stored in the 'values section, since new objects |
| 973 | ;; can't initialize from this element. | 780 | ;; can't initialize from this element. |
| 974 | (setf (eieio--class-class-allocation-values newc) (cons value (eieio--class-class-allocation-values newc)))) | 781 | (push value (eieio--class-class-allocation-values newc))) |
| 975 | (when defaultoverride | 782 | (when defaultoverride |
| 976 | ;; There is a match, and we must override the old value. | 783 | ;; There is a match, and we must override the old value. |
| 977 | (let* ((ca (eieio--class-class-allocation-a newc)) | 784 | (let* ((ca (eieio--class-class-allocation-a newc)) |
| @@ -996,7 +803,7 @@ if default value is nil." | |||
| 996 | ;; is to change the default, so allow unbound in. | 803 | ;; is to change the default, so allow unbound in. |
| 997 | 804 | ||
| 998 | ;; If we have a repeat, only update the value... | 805 | ;; If we have a repeat, only update the value... |
| 999 | (eieio-perform-slot-validation-for-default a tp value skipnil) | 806 | (eieio--perform-slot-validation-for-default a tp value skipnil) |
| 1000 | (setcar dp value)) | 807 | (setcar dp value)) |
| 1001 | 808 | ||
| 1002 | ;; PLN Tue Jun 26 11:57:06 2007 : The protection is | 809 | ;; PLN Tue Jun 26 11:57:06 2007 : The protection is |
| @@ -1045,246 +852,81 @@ if default value is nil." | |||
| 1045 | "Copy into NEWC the slots of PARENTS. | 852 | "Copy into NEWC the slots of PARENTS. |
| 1046 | Follow the rules of not overwriting early parents when applying to | 853 | Follow the rules of not overwriting early parents when applying to |
| 1047 | the new child class." | 854 | the new child class." |
| 1048 | (let ((ps (eieio--class-parent newc)) | 855 | (let ((sn (eieio--class-option-assoc (eieio--class-options newc) |
| 1049 | (sn (class-option-assoc (eieio--class-options newc) | 856 | :allow-nil-initform))) |
| 1050 | ':allow-nil-initform))) | 857 | (dolist (pcv (eieio--class-parent newc)) |
| 1051 | (while ps | ||
| 1052 | ;; First, duplicate all the slots of the parent. | 858 | ;; First, duplicate all the slots of the parent. |
| 1053 | (let ((pcv (class-v (car ps)))) | 859 | (let ((pa (eieio--class-public-a pcv)) |
| 1054 | (let ((pa (eieio--class-public-a pcv)) | 860 | (pd (eieio--class-public-d pcv)) |
| 1055 | (pd (eieio--class-public-d pcv)) | 861 | (pdoc (eieio--class-public-doc pcv)) |
| 1056 | (pdoc (eieio--class-public-doc pcv)) | 862 | (ptype (eieio--class-public-type pcv)) |
| 1057 | (ptype (eieio--class-public-type pcv)) | 863 | (pcust (eieio--class-public-custom pcv)) |
| 1058 | (pcust (eieio--class-public-custom pcv)) | 864 | (plabel (eieio--class-public-custom-label pcv)) |
| 1059 | (plabel (eieio--class-public-custom-label pcv)) | 865 | (pcustg (eieio--class-public-custom-group pcv)) |
| 1060 | (pcustg (eieio--class-public-custom-group pcv)) | 866 | (printer (eieio--class-public-printer pcv)) |
| 1061 | (printer (eieio--class-public-printer pcv)) | 867 | (pprot (eieio--class-protection pcv)) |
| 1062 | (pprot (eieio--class-protection pcv)) | 868 | (pinit (eieio--class-initarg-tuples pcv)) |
| 1063 | (pinit (eieio--class-initarg-tuples pcv)) | 869 | (i 0)) |
| 1064 | (i 0)) | 870 | (while pa |
| 1065 | (while pa | 871 | (eieio--add-new-slot newc |
| 1066 | (eieio-add-new-slot newc | 872 | (car pa) (car pd) (car pdoc) (aref ptype i) |
| 1067 | (car pa) (car pd) (car pdoc) (aref ptype i) | 873 | (car pcust) (car plabel) (car pcustg) |
| 1068 | (car pcust) (car plabel) (car pcustg) | 874 | (car printer) |
| 1069 | (car printer) | 875 | (car pprot) (car-safe (car pinit)) nil nil sn) |
| 1070 | (car pprot) (car-safe (car pinit)) nil nil sn) | 876 | ;; Increment each value. |
| 1071 | ;; Increment each value. | 877 | (setq pa (cdr pa) |
| 1072 | (setq pa (cdr pa) | 878 | pd (cdr pd) |
| 1073 | pd (cdr pd) | 879 | pdoc (cdr pdoc) |
| 1074 | pdoc (cdr pdoc) | 880 | i (1+ i) |
| 1075 | i (1+ i) | 881 | pcust (cdr pcust) |
| 1076 | pcust (cdr pcust) | 882 | plabel (cdr plabel) |
| 1077 | plabel (cdr plabel) | 883 | pcustg (cdr pcustg) |
| 1078 | pcustg (cdr pcustg) | 884 | printer (cdr printer) |
| 1079 | printer (cdr printer) | 885 | pprot (cdr pprot) |
| 1080 | pprot (cdr pprot) | 886 | pinit (cdr pinit)) |
| 1081 | pinit (cdr pinit)) | 887 | )) ;; while/let |
| 1082 | )) ;; while/let | 888 | ;; Now duplicate all the class alloc slots. |
| 1083 | ;; Now duplicate all the class alloc slots. | 889 | (let ((pa (eieio--class-class-allocation-a pcv)) |
| 1084 | (let ((pa (eieio--class-class-allocation-a pcv)) | 890 | (pdoc (eieio--class-class-allocation-doc pcv)) |
| 1085 | (pdoc (eieio--class-class-allocation-doc pcv)) | 891 | (ptype (eieio--class-class-allocation-type pcv)) |
| 1086 | (ptype (eieio--class-class-allocation-type pcv)) | 892 | (pcust (eieio--class-class-allocation-custom pcv)) |
| 1087 | (pcust (eieio--class-class-allocation-custom pcv)) | 893 | (plabel (eieio--class-class-allocation-custom-label pcv)) |
| 1088 | (plabel (eieio--class-class-allocation-custom-label pcv)) | 894 | (pcustg (eieio--class-class-allocation-custom-group pcv)) |
| 1089 | (pcustg (eieio--class-class-allocation-custom-group pcv)) | 895 | (printer (eieio--class-class-allocation-printer pcv)) |
| 1090 | (printer (eieio--class-class-allocation-printer pcv)) | 896 | (pprot (eieio--class-class-allocation-protection pcv)) |
| 1091 | (pprot (eieio--class-class-allocation-protection pcv)) | 897 | (pval (eieio--class-class-allocation-values pcv)) |
| 1092 | (pval (eieio--class-class-allocation-values pcv)) | 898 | (i 0)) |
| 1093 | (i 0)) | 899 | (while pa |
| 1094 | (while pa | 900 | (eieio--add-new-slot newc |
| 1095 | (eieio-add-new-slot newc | 901 | (car pa) (aref pval i) (car pdoc) (aref ptype i) |
| 1096 | (car pa) (aref pval i) (car pdoc) (aref ptype i) | 902 | (car pcust) (car plabel) (car pcustg) |
| 1097 | (car pcust) (car plabel) (car pcustg) | 903 | (car printer) |
| 1098 | (car printer) | 904 | (car pprot) nil :class sn) |
| 1099 | (car pprot) nil ':class sn) | 905 | ;; Increment each value. |
| 1100 | ;; Increment each value. | 906 | (setq pa (cdr pa) |
| 1101 | (setq pa (cdr pa) | 907 | pdoc (cdr pdoc) |
| 1102 | pdoc (cdr pdoc) | 908 | pcust (cdr pcust) |
| 1103 | pcust (cdr pcust) | 909 | plabel (cdr plabel) |
| 1104 | plabel (cdr plabel) | 910 | pcustg (cdr pcustg) |
| 1105 | pcustg (cdr pcustg) | 911 | printer (cdr printer) |
| 1106 | printer (cdr printer) | 912 | pprot (cdr pprot) |
| 1107 | pprot (cdr pprot) | 913 | i (1+ i)) |
| 1108 | i (1+ i)) | 914 | ))))) |
| 1109 | ))) ;; while/let | ||
| 1110 | ;; Loop over each parent class | ||
| 1111 | (setq ps (cdr ps))) | ||
| 1112 | )) | ||
| 1113 | 915 | ||
| 1114 | 916 | ||
| 1115 | ;;; CLOS methods and generics | ||
| 1116 | ;; | ||
| 1117 | |||
| 1118 | (defun eieio--defgeneric-init-form (method doc-string) | ||
| 1119 | "Form to use for the initial definition of a generic." | ||
| 1120 | (cond | ||
| 1121 | ((or (not (fboundp method)) | ||
| 1122 | (eq 'autoload (car-safe (symbol-function method)))) | ||
| 1123 | ;; Make sure the method tables are installed. | ||
| 1124 | (eieiomt-install method) | ||
| 1125 | ;; Construct the actual body of this function. | ||
| 1126 | (eieio-defgeneric-form method doc-string)) | ||
| 1127 | ((generic-p method) (symbol-function method)) ;Leave it as-is. | ||
| 1128 | (t (error "You cannot create a generic/method over an existing symbol: %s" | ||
| 1129 | method)))) | ||
| 1130 | |||
| 1131 | (defun eieio-defgeneric-form (method doc-string) | ||
| 1132 | "The lambda form that would be used as the function defined on METHOD. | ||
| 1133 | All methods should call the same EIEIO function for dispatch. | ||
| 1134 | DOC-STRING is the documentation attached to METHOD." | ||
| 1135 | `(lambda (&rest local-args) | ||
| 1136 | ,doc-string | ||
| 1137 | (eieio-generic-call (quote ,method) local-args))) | ||
| 1138 | |||
| 1139 | (defsubst eieio-defgeneric-reset-generic-form (method) | ||
| 1140 | "Setup METHOD to call the generic form." | ||
| 1141 | (let ((doc-string (documentation method))) | ||
| 1142 | (fset method (eieio-defgeneric-form method doc-string)))) | ||
| 1143 | |||
| 1144 | (defun eieio-defgeneric-form-primary-only (method doc-string) | ||
| 1145 | "The lambda form that would be used as the function defined on METHOD. | ||
| 1146 | All methods should call the same EIEIO function for dispatch. | ||
| 1147 | DOC-STRING is the documentation attached to METHOD." | ||
| 1148 | `(lambda (&rest local-args) | ||
| 1149 | ,doc-string | ||
| 1150 | (eieio-generic-call-primary-only (quote ,method) local-args))) | ||
| 1151 | |||
| 1152 | (defsubst eieio-defgeneric-reset-generic-form-primary-only (method) | ||
| 1153 | "Setup METHOD to call the generic form." | ||
| 1154 | (let ((doc-string (documentation method))) | ||
| 1155 | (fset method (eieio-defgeneric-form-primary-only method doc-string)))) | ||
| 1156 | |||
| 1157 | (declare-function no-applicable-method "eieio" (object method &rest args)) | ||
| 1158 | |||
| 1159 | (defun eieio-defgeneric-form-primary-only-one (method doc-string | ||
| 1160 | class | ||
| 1161 | impl | ||
| 1162 | ) | ||
| 1163 | "The lambda form that would be used as the function defined on METHOD. | ||
| 1164 | All methods should call the same EIEIO function for dispatch. | ||
| 1165 | DOC-STRING is the documentation attached to METHOD. | ||
| 1166 | CLASS is the class symbol needed for private method access. | ||
| 1167 | IMPL is the symbol holding the method implementation." | ||
| 1168 | ;; NOTE: I tried out byte compiling this little fcn. Turns out it | ||
| 1169 | ;; is faster to execute this for not byte-compiled. ie, install this, | ||
| 1170 | ;; then measure calls going through here. I wonder why. | ||
| 1171 | (require 'bytecomp) | ||
| 1172 | (let ((byte-compile-warnings nil)) | ||
| 1173 | (byte-compile | ||
| 1174 | `(lambda (&rest local-args) | ||
| 1175 | ,doc-string | ||
| 1176 | ;; This is a cool cheat. Usually we need to look up in the | ||
| 1177 | ;; method table to find out if there is a method or not. We can | ||
| 1178 | ;; instead make that determination at load time when there is | ||
| 1179 | ;; only one method. If the first arg is not a child of the class | ||
| 1180 | ;; of that one implementation, then clearly, there is no method def. | ||
| 1181 | (if (not (eieio-object-p (car local-args))) | ||
| 1182 | ;; Not an object. Just signal. | ||
| 1183 | (signal 'no-method-definition | ||
| 1184 | (list ',method local-args)) | ||
| 1185 | |||
| 1186 | ;; We do have an object. Make sure it is the right type. | ||
| 1187 | (if ,(if (eq class eieio-default-superclass) | ||
| 1188 | nil ; default superclass means just an obj. Already asked. | ||
| 1189 | `(not (child-of-class-p (eieio--object-class (car local-args)) | ||
| 1190 | ',class))) | ||
| 1191 | |||
| 1192 | ;; If not the right kind of object, call no applicable | ||
| 1193 | (apply #'no-applicable-method (car local-args) | ||
| 1194 | ',method local-args) | ||
| 1195 | |||
| 1196 | ;; It is ok, do the call. | ||
| 1197 | ;; Fill in inter-call variables then evaluate the method. | ||
| 1198 | (let ((eieio-generic-call-next-method-list nil) | ||
| 1199 | (eieio-generic-call-key method-primary) | ||
| 1200 | (eieio-generic-call-methodname ',method) | ||
| 1201 | (eieio-generic-call-arglst local-args) | ||
| 1202 | ) | ||
| 1203 | (eieio--with-scoped-class ',class | ||
| 1204 | ,(if (< emacs-major-version 24) | ||
| 1205 | `(apply ,(list 'quote impl) local-args) | ||
| 1206 | `(apply #',impl local-args))) | ||
| 1207 | ;(,impl local-args) | ||
| 1208 | ))))))) | ||
| 1209 | |||
| 1210 | (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) | ||
| 1211 | "Setup METHOD to call the generic form." | ||
| 1212 | (let* ((doc-string (documentation method)) | ||
| 1213 | (M (get method 'eieio-method-tree)) | ||
| 1214 | (entry (car (aref M method-primary))) | ||
| 1215 | ) | ||
| 1216 | (fset method (eieio-defgeneric-form-primary-only-one | ||
| 1217 | method doc-string | ||
| 1218 | (car entry) | ||
| 1219 | (cdr entry) | ||
| 1220 | )))) | ||
| 1221 | |||
| 1222 | (defun eieio-unbind-method-implementations (method) | ||
| 1223 | "Make the generic method METHOD have no implementations. | ||
| 1224 | It will leave the original generic function in place, | ||
| 1225 | but remove reference to all implementations of METHOD." | ||
| 1226 | (put method 'eieio-method-tree nil) | ||
| 1227 | (put method 'eieio-method-obarray nil)) | ||
| 1228 | |||
| 1229 | (defun eieio--defmethod (method kind argclass code) | ||
| 1230 | "Work part of the `defmethod' macro defining METHOD with ARGS." | ||
| 1231 | (let ((key | ||
| 1232 | ;; Find optional keys. | ||
| 1233 | (cond ((memq kind '(:BEFORE :before)) method-before) | ||
| 1234 | ((memq kind '(:AFTER :after)) method-after) | ||
| 1235 | ((memq kind '(:STATIC :static)) method-static) | ||
| 1236 | ((memq kind '(:PRIMARY :primary nil)) method-primary) | ||
| 1237 | ;; Primary key. | ||
| 1238 | ;; (t method-primary) | ||
| 1239 | (t (error "Unknown method kind %S" kind))))) | ||
| 1240 | ;; Make sure there is a generic (when called from defclass). | ||
| 1241 | (eieio--defalias | ||
| 1242 | method (eieio--defgeneric-init-form | ||
| 1243 | method (or (documentation code) | ||
| 1244 | (format "Generically created method `%s'." method)))) | ||
| 1245 | ;; Create symbol for property to bind to. If the first arg is of | ||
| 1246 | ;; the form (varname vartype) and `vartype' is a class, then | ||
| 1247 | ;; that class will be the type symbol. If not, then it will fall | ||
| 1248 | ;; under the type `primary' which is a non-specific calling of the | ||
| 1249 | ;; function. | ||
| 1250 | (if argclass | ||
| 1251 | (if (not (class-p argclass)) | ||
| 1252 | (error "Unknown class type %s in method parameters" | ||
| 1253 | argclass)) | ||
| 1254 | ;; Generics are higher. | ||
| 1255 | (setq key (eieio-specialized-key-to-generic-key key))) | ||
| 1256 | ;; Put this lambda into the symbol so we can find it. | ||
| 1257 | (eieiomt-add method code key argclass) | ||
| 1258 | ) | ||
| 1259 | |||
| 1260 | (when eieio-optimize-primary-methods-flag | ||
| 1261 | ;; Optimizing step: | ||
| 1262 | ;; | ||
| 1263 | ;; If this method, after this setup, only has primary methods, then | ||
| 1264 | ;; we can setup the generic that way. | ||
| 1265 | (if (generic-primary-only-p method) | ||
| 1266 | ;; If there is only one primary method, then we can go one more | ||
| 1267 | ;; optimization step. | ||
| 1268 | (if (generic-primary-only-one-p method) | ||
| 1269 | (eieio-defgeneric-reset-generic-form-primary-only-one method) | ||
| 1270 | (eieio-defgeneric-reset-generic-form-primary-only method)) | ||
| 1271 | (eieio-defgeneric-reset-generic-form method))) | ||
| 1272 | |||
| 1273 | method) | ||
| 1274 | |||
| 1275 | ;;; Slot type validation | 917 | ;;; Slot type validation |
| 1276 | 918 | ||
| 1277 | ;; This is a hideous hack for replacing `typep' from cl-macs, to avoid | 919 | ;; This is a hideous hack for replacing `typep' from cl-macs, to avoid |
| 1278 | ;; requiring the CL library at run-time. It can be eliminated if/when | 920 | ;; requiring the CL library at run-time. It can be eliminated if/when |
| 1279 | ;; `typep' is merged into Emacs core. | 921 | ;; `typep' is merged into Emacs core. |
| 1280 | 922 | ||
| 1281 | (defun eieio-perform-slot-validation (spec value) | 923 | (defun eieio--perform-slot-validation (spec value) |
| 1282 | "Return non-nil if SPEC does not match VALUE." | 924 | "Return non-nil if SPEC does not match VALUE." |
| 1283 | (or (eq spec t) ; t always passes | 925 | (or (eq spec t) ; t always passes |
| 1284 | (eq value eieio-unbound) ; unbound always passes | 926 | (eq value eieio-unbound) ; unbound always passes |
| 1285 | (cl-typep value spec))) | 927 | (cl-typep value spec))) |
| 1286 | 928 | ||
| 1287 | (defun eieio-validate-slot-value (class slot-idx value slot) | 929 | (defun eieio--validate-slot-value (class slot-idx value slot) |
| 1288 | "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. | 930 | "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. |
| 1289 | Checks the :type specifier. | 931 | Checks the :type specifier. |
| 1290 | SLOT is the slot that is being checked, and is only used when throwing | 932 | SLOT is the slot that is being checked, and is only used when throwing |
| @@ -1292,22 +934,24 @@ an error." | |||
| 1292 | (if eieio-skip-typecheck | 934 | (if eieio-skip-typecheck |
| 1293 | nil | 935 | nil |
| 1294 | ;; Trim off object IDX junk added in for the object index. | 936 | ;; Trim off object IDX junk added in for the object index. |
| 1295 | (setq slot-idx (- slot-idx 3)) | 937 | (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots))) |
| 1296 | (let ((st (aref (eieio--class-public-type (class-v class)) slot-idx))) | 938 | (let ((st (aref (eieio--class-public-type class) slot-idx))) |
| 1297 | (if (not (eieio-perform-slot-validation st value)) | 939 | (if (not (eieio--perform-slot-validation st value)) |
| 1298 | (signal 'invalid-slot-type (list class slot st value)))))) | 940 | (signal 'invalid-slot-type |
| 941 | (list (eieio--class-symbol class) slot st value)))))) | ||
| 1299 | 942 | ||
| 1300 | (defun eieio-validate-class-slot-value (class slot-idx value slot) | 943 | (defun eieio--validate-class-slot-value (class slot-idx value slot) |
| 1301 | "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. | 944 | "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. |
| 1302 | Checks the :type specifier. | 945 | Checks the :type specifier. |
| 1303 | SLOT is the slot that is being checked, and is only used when throwing | 946 | SLOT is the slot that is being checked, and is only used when throwing |
| 1304 | an error." | 947 | an error." |
| 1305 | (if eieio-skip-typecheck | 948 | (if eieio-skip-typecheck |
| 1306 | nil | 949 | nil |
| 1307 | (let ((st (aref (eieio--class-class-allocation-type (class-v class)) | 950 | (let ((st (aref (eieio--class-class-allocation-type class) |
| 1308 | slot-idx))) | 951 | slot-idx))) |
| 1309 | (if (not (eieio-perform-slot-validation st value)) | 952 | (if (not (eieio--perform-slot-validation st value)) |
| 1310 | (signal 'invalid-slot-type (list class slot st value)))))) | 953 | (signal 'invalid-slot-type |
| 954 | (list (eieio--class-symbol class) slot st value)))))) | ||
| 1311 | 955 | ||
| 1312 | (defun eieio-barf-if-slot-unbound (value instance slotname fn) | 956 | (defun eieio-barf-if-slot-unbound (value instance slotname fn) |
| 1313 | "Throw a signal if VALUE is a representation of an UNBOUND slot. | 957 | "Throw a signal if VALUE is a representation of an UNBOUND slot. |
| @@ -1315,7 +959,7 @@ INSTANCE is the object being referenced. SLOTNAME is the offending | |||
| 1315 | slot. If the slot is ok, return VALUE. | 959 | slot. If the slot is ok, return VALUE. |
| 1316 | Argument FN is the function calling this verifier." | 960 | Argument FN is the function calling this verifier." |
| 1317 | (if (and (eq value eieio-unbound) (not eieio-skip-typecheck)) | 961 | (if (and (eq value eieio-unbound) (not eieio-skip-typecheck)) |
| 1318 | (slot-unbound instance (eieio--object-class instance) slotname fn) | 962 | (slot-unbound instance (eieio--object-class-name instance) slotname fn) |
| 1319 | value)) | 963 | value)) |
| 1320 | 964 | ||
| 1321 | 965 | ||
| @@ -1326,14 +970,17 @@ Argument FN is the function calling this verifier." | |||
| 1326 | (eieio--check-type (or eieio-object-p class-p) obj) | 970 | (eieio--check-type (or eieio-object-p class-p) obj) |
| 1327 | (eieio--check-type symbolp slot) | 971 | (eieio--check-type symbolp slot) |
| 1328 | (if (class-p obj) (eieio-class-un-autoload obj)) | 972 | (if (class-p obj) (eieio-class-un-autoload obj)) |
| 1329 | (let* ((class (if (class-p obj) obj (eieio--object-class obj))) | 973 | (let* ((class (cond ((symbolp obj) |
| 1330 | (c (eieio-slot-name-index class obj slot))) | 974 | (error "eieio-oref called on a class!") |
| 975 | (eieio--class-v obj)) | ||
| 976 | (t (eieio--object-class-object obj)))) | ||
| 977 | (c (eieio--slot-name-index class obj slot))) | ||
| 1331 | (if (not c) | 978 | (if (not c) |
| 1332 | ;; It might be missing because it is a :class allocated slot. | 979 | ;; It might be missing because it is a :class allocated slot. |
| 1333 | ;; Let's check that info out. | 980 | ;; Let's check that info out. |
| 1334 | (if (setq c (eieio-class-slot-name-index class slot)) | 981 | (if (setq c (eieio--class-slot-name-index class slot)) |
| 1335 | ;; Oref that slot. | 982 | ;; Oref that slot. |
| 1336 | (aref (eieio--class-class-allocation-values (class-v class)) c) | 983 | (aref (eieio--class-class-allocation-values class) c) |
| 1337 | ;; The slot-missing method is a cool way of allowing an object author | 984 | ;; The slot-missing method is a cool way of allowing an object author |
| 1338 | ;; to intercept missing slot definitions. Since it is also the LAST | 985 | ;; to intercept missing slot definitions. Since it is also the LAST |
| 1339 | ;; thing called in this fn, its return value would be retrieved. | 986 | ;; thing called in this fn, its return value would be retrieved. |
| @@ -1349,26 +996,30 @@ Argument FN is the function calling this verifier." | |||
| 1349 | Fills in OBJ's SLOT with its default value." | 996 | Fills in OBJ's SLOT with its default value." |
| 1350 | (eieio--check-type (or eieio-object-p class-p) obj) | 997 | (eieio--check-type (or eieio-object-p class-p) obj) |
| 1351 | (eieio--check-type symbolp slot) | 998 | (eieio--check-type symbolp slot) |
| 1352 | (let* ((cl (if (eieio-object-p obj) (eieio--object-class obj) obj)) | 999 | (let* ((cl (cond ((symbolp obj) (eieio--class-v obj)) |
| 1353 | (c (eieio-slot-name-index cl obj slot))) | 1000 | (t (eieio--object-class-object obj)))) |
| 1001 | (c (eieio--slot-name-index cl obj slot))) | ||
| 1354 | (if (not c) | 1002 | (if (not c) |
| 1355 | ;; It might be missing because it is a :class allocated slot. | 1003 | ;; It might be missing because it is a :class allocated slot. |
| 1356 | ;; Let's check that info out. | 1004 | ;; Let's check that info out. |
| 1357 | (if (setq c | 1005 | (if (setq c |
| 1358 | (eieio-class-slot-name-index cl slot)) | 1006 | (eieio--class-slot-name-index cl slot)) |
| 1359 | ;; Oref that slot. | 1007 | ;; Oref that slot. |
| 1360 | (aref (eieio--class-class-allocation-values (class-v cl)) | 1008 | (aref (eieio--class-class-allocation-values cl) |
| 1361 | c) | 1009 | c) |
| 1362 | (slot-missing obj slot 'oref-default) | 1010 | (slot-missing obj slot 'oref-default) |
| 1363 | ;;(signal 'invalid-slot-name (list (class-name cl) slot)) | 1011 | ;;(signal 'invalid-slot-name (list (class-name cl) slot)) |
| 1364 | ) | 1012 | ) |
| 1365 | (eieio-barf-if-slot-unbound | 1013 | (eieio-barf-if-slot-unbound |
| 1366 | (let ((val (nth (- c 3) (eieio--class-public-d (class-v cl))))) | 1014 | (let ((val (nth (- c (eval-when-compile eieio--object-num-slots)) |
| 1015 | (eieio--class-public-d cl)))) | ||
| 1367 | (eieio-default-eval-maybe val)) | 1016 | (eieio-default-eval-maybe val)) |
| 1368 | obj cl 'oref-default)))) | 1017 | obj (eieio--class-symbol cl) 'oref-default)))) |
| 1369 | 1018 | ||
| 1370 | (defun eieio-default-eval-maybe (val) | 1019 | (defun eieio-default-eval-maybe (val) |
| 1371 | "Check VAL, and return what `oref-default' would provide." | 1020 | "Check VAL, and return what `oref-default' would provide." |
| 1021 | ;; FIXME: What the hell is this supposed to do? Shouldn't it evaluate | ||
| 1022 | ;; variables as well? Why not just always call `eval'? | ||
| 1372 | (cond | 1023 | (cond |
| 1373 | ;; Is it a function call? If so, evaluate it. | 1024 | ;; Is it a function call? If so, evaluate it. |
| 1374 | ((eieio-eval-default-p val) | 1025 | ((eieio-eval-default-p val) |
| @@ -1384,69 +1035,71 @@ Fills in OBJ's SLOT with its default value." | |||
| 1384 | Fills in OBJ's SLOT with VALUE." | 1035 | Fills in OBJ's SLOT with VALUE." |
| 1385 | (eieio--check-type eieio-object-p obj) | 1036 | (eieio--check-type eieio-object-p obj) |
| 1386 | (eieio--check-type symbolp slot) | 1037 | (eieio--check-type symbolp slot) |
| 1387 | (let ((c (eieio-slot-name-index (eieio--object-class obj) obj slot))) | 1038 | (let* ((class (eieio--object-class-object obj)) |
| 1039 | (c (eieio--slot-name-index class obj slot))) | ||
| 1388 | (if (not c) | 1040 | (if (not c) |
| 1389 | ;; It might be missing because it is a :class allocated slot. | 1041 | ;; It might be missing because it is a :class allocated slot. |
| 1390 | ;; Let's check that info out. | 1042 | ;; Let's check that info out. |
| 1391 | (if (setq c | 1043 | (if (setq c |
| 1392 | (eieio-class-slot-name-index (eieio--object-class obj) slot)) | 1044 | (eieio--class-slot-name-index class slot)) |
| 1393 | ;; Oset that slot. | 1045 | ;; Oset that slot. |
| 1394 | (progn | 1046 | (progn |
| 1395 | (eieio-validate-class-slot-value (eieio--object-class obj) c value slot) | 1047 | (eieio--validate-class-slot-value class c value slot) |
| 1396 | (aset (eieio--class-class-allocation-values (class-v (eieio--object-class obj))) | 1048 | (aset (eieio--class-class-allocation-values class) |
| 1397 | c value)) | 1049 | c value)) |
| 1398 | ;; See oref for comment on `slot-missing' | 1050 | ;; See oref for comment on `slot-missing' |
| 1399 | (slot-missing obj slot 'oset value) | 1051 | (slot-missing obj slot 'oset value) |
| 1400 | ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) | 1052 | ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) |
| 1401 | ) | 1053 | ) |
| 1402 | (eieio-validate-slot-value (eieio--object-class obj) c value slot) | 1054 | (eieio--validate-slot-value class c value slot) |
| 1403 | (aset obj c value)))) | 1055 | (aset obj c value)))) |
| 1404 | 1056 | ||
| 1405 | (defun eieio-oset-default (class slot value) | 1057 | (defun eieio-oset-default (class slot value) |
| 1406 | "Do the work for the macro `oset-default'. | 1058 | "Do the work for the macro `oset-default'. |
| 1407 | Fills in the default value in CLASS' in SLOT with VALUE." | 1059 | Fills in the default value in CLASS' in SLOT with VALUE." |
| 1408 | (eieio--check-type class-p class) | 1060 | (setq class (eieio--class-object class)) |
| 1061 | (eieio--check-type eieio--class-p class) | ||
| 1409 | (eieio--check-type symbolp slot) | 1062 | (eieio--check-type symbolp slot) |
| 1410 | (eieio--with-scoped-class class | 1063 | (eieio--with-scoped-class class |
| 1411 | (let* ((c (eieio-slot-name-index class nil slot))) | 1064 | (let* ((c (eieio--slot-name-index class nil slot))) |
| 1412 | (if (not c) | 1065 | (if (not c) |
| 1413 | ;; It might be missing because it is a :class allocated slot. | 1066 | ;; It might be missing because it is a :class allocated slot. |
| 1414 | ;; Let's check that info out. | 1067 | ;; Let's check that info out. |
| 1415 | (if (setq c (eieio-class-slot-name-index class slot)) | 1068 | (if (setq c (eieio--class-slot-name-index class slot)) |
| 1416 | (progn | 1069 | (progn |
| 1417 | ;; Oref that slot. | 1070 | ;; Oref that slot. |
| 1418 | (eieio-validate-class-slot-value class c value slot) | 1071 | (eieio--validate-class-slot-value class c value slot) |
| 1419 | (aset (eieio--class-class-allocation-values (class-v class)) c | 1072 | (aset (eieio--class-class-allocation-values class) c |
| 1420 | value)) | 1073 | value)) |
| 1421 | (signal 'invalid-slot-name (list (eieio-class-name class) slot))) | 1074 | (signal 'invalid-slot-name (list (eieio--class-symbol class) slot))) |
| 1422 | (eieio-validate-slot-value class c value slot) | 1075 | (eieio--validate-slot-value class c value slot) |
| 1423 | ;; Set this into the storage for defaults. | 1076 | ;; Set this into the storage for defaults. |
| 1424 | (setcar (nthcdr (- c 3) (eieio--class-public-d (class-v class))) | 1077 | (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots)) |
| 1078 | (eieio--class-public-d class)) | ||
| 1425 | value) | 1079 | value) |
| 1426 | ;; Take the value, and put it into our cache object. | 1080 | ;; Take the value, and put it into our cache object. |
| 1427 | (eieio-oset (eieio--class-default-object-cache (class-v class)) | 1081 | (eieio-oset (eieio--class-default-object-cache class) |
| 1428 | slot value) | 1082 | slot value) |
| 1429 | )))) | 1083 | )))) |
| 1430 | 1084 | ||
| 1431 | 1085 | ||
| 1432 | ;;; EIEIO internal search functions | 1086 | ;;; EIEIO internal search functions |
| 1433 | ;; | 1087 | ;; |
| 1434 | (defun eieio-slot-originating-class-p (start-class slot) | 1088 | (defun eieio--slot-originating-class-p (start-class slot) |
| 1435 | "Return non-nil if START-CLASS is the first class to define SLOT. | 1089 | "Return non-nil if START-CLASS is the first class to define SLOT. |
| 1436 | This is for testing if the class currently in scope is the class that defines SLOT | 1090 | This is for testing if the class currently in scope is the class that defines SLOT |
| 1437 | so that we can protect private slots." | 1091 | so that we can protect private slots." |
| 1438 | (let ((par (eieio-class-parents-fast start-class)) | 1092 | (let ((par (eieio--class-parent start-class)) |
| 1439 | (ret t)) | 1093 | (ret t)) |
| 1440 | (if (not par) | 1094 | (or (not par) |
| 1441 | t | 1095 | (progn |
| 1442 | (while (and par ret) | 1096 | (while (and par ret) |
| 1443 | (if (intern-soft (symbol-name slot) | 1097 | (if (gethash slot (eieio--class-symbol-hashtable (car par))) |
| 1444 | (eieio--class-symbol-obarray (class-v (car par)))) | 1098 | (setq ret nil)) |
| 1445 | (setq ret nil)) | 1099 | (setq par (cdr par))) |
| 1446 | (setq par (cdr par))) | 1100 | ret)))) |
| 1447 | ret))) | 1101 | |
| 1448 | 1102 | (defun eieio--slot-name-index (class obj slot) | |
| 1449 | (defun eieio-slot-name-index (class obj slot) | ||
| 1450 | "In CLASS for OBJ find the index of the named SLOT. | 1103 | "In CLASS for OBJ find the index of the named SLOT. |
| 1451 | The slot is a symbol which is installed in CLASS by the `defclass' | 1104 | The slot is a symbol which is installed in CLASS by the `defclass' |
| 1452 | call. OBJ can be nil, but if it is an object, and the slot in question | 1105 | call. OBJ can be nil, but if it is an object, and the slot in question |
| @@ -1455,36 +1108,41 @@ scoped class. | |||
| 1455 | If SLOT is the value created with :initarg instead, | 1108 | If SLOT is the value created with :initarg instead, |
| 1456 | reverse-lookup that name, and recurse with the associated slot value." | 1109 | reverse-lookup that name, and recurse with the associated slot value." |
| 1457 | ;; Removed checks to outside this call | 1110 | ;; Removed checks to outside this call |
| 1458 | (let* ((fsym (intern-soft (symbol-name slot) | 1111 | (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class))) |
| 1459 | (eieio--class-symbol-obarray (class-v class)))) | 1112 | (fsi (car fsym))) |
| 1460 | (fsi (if (symbolp fsym) (symbol-value fsym) nil))) | ||
| 1461 | (if (integerp fsi) | 1113 | (if (integerp fsi) |
| 1462 | (cond | 1114 | (cond |
| 1463 | ((not (get fsym 'protection)) | 1115 | ((not (cdr fsym)) |
| 1464 | (+ 3 fsi)) | 1116 | (+ (eval-when-compile eieio--object-num-slots) fsi)) |
| 1465 | ((and (eq (get fsym 'protection) 'protected) | 1117 | ((and (eq (cdr fsym) 'protected) |
| 1466 | (eieio--scoped-class) | 1118 | (eieio--scoped-class) |
| 1467 | (or (child-of-class-p class (eieio--scoped-class)) | 1119 | (or (child-of-class-p class (eieio--scoped-class)) |
| 1468 | (and (eieio-object-p obj) | 1120 | (and (eieio-object-p obj) |
| 1469 | (child-of-class-p class (eieio--object-class obj))))) | 1121 | ;; AFAICT, for all callers, if `obj' is not a class, |
| 1470 | (+ 3 fsi)) | 1122 | ;; then its class is `class'. |
| 1471 | ((and (eq (get fsym 'protection) 'private) | 1123 | ;;(child-of-class-p class (eieio--object-class-object obj)) |
| 1124 | (progn | ||
| 1125 | (cl-assert (eq class (eieio--object-class-object obj))) | ||
| 1126 | t)))) | ||
| 1127 | (+ (eval-when-compile eieio--object-num-slots) fsi)) | ||
| 1128 | ((and (eq (cdr fsym) 'private) | ||
| 1472 | (or (and (eieio--scoped-class) | 1129 | (or (and (eieio--scoped-class) |
| 1473 | (eieio-slot-originating-class-p (eieio--scoped-class) slot)) | 1130 | (eieio--slot-originating-class-p |
| 1131 | (eieio--scoped-class) slot)) | ||
| 1474 | eieio-initializing-object)) | 1132 | eieio-initializing-object)) |
| 1475 | (+ 3 fsi)) | 1133 | (+ (eval-when-compile eieio--object-num-slots) fsi)) |
| 1476 | (t nil)) | 1134 | (t nil)) |
| 1477 | (let ((fn (eieio-initarg-to-attribute class slot))) | 1135 | (let ((fn (eieio--initarg-to-attribute class slot))) |
| 1478 | (if fn (eieio-slot-name-index class obj fn) nil))))) | 1136 | (if fn (eieio--slot-name-index class obj fn) nil))))) |
| 1479 | 1137 | ||
| 1480 | (defun eieio-class-slot-name-index (class slot) | 1138 | (defun eieio--class-slot-name-index (class slot) |
| 1481 | "In CLASS find the index of the named SLOT. | 1139 | "In CLASS find the index of the named SLOT. |
| 1482 | The slot is a symbol which is installed in CLASS by the `defclass' | 1140 | The slot is a symbol which is installed in CLASS by the `defclass' |
| 1483 | call. If SLOT is the value created with :initarg instead, | 1141 | call. If SLOT is the value created with :initarg instead, |
| 1484 | reverse-lookup that name, and recurse with the associated slot value." | 1142 | reverse-lookup that name, and recurse with the associated slot value." |
| 1485 | ;; This will happen less often, and with fewer slots. Do this the | 1143 | ;; This will happen less often, and with fewer slots. Do this the |
| 1486 | ;; storage cheap way. | 1144 | ;; storage cheap way. |
| 1487 | (let* ((a (eieio--class-class-allocation-a (class-v class))) | 1145 | (let* ((a (eieio--class-class-allocation-a class)) |
| 1488 | (l1 (length a)) | 1146 | (l1 (length a)) |
| 1489 | (af (memq slot a)) | 1147 | (af (memq slot a)) |
| 1490 | (l2 (length af))) | 1148 | (l2 (length af))) |
| @@ -1501,36 +1159,28 @@ reverse-lookup that name, and recurse with the associated slot value." | |||
| 1501 | If SET-ALL is non-nil, then when a default is nil, that value is | 1159 | If SET-ALL is non-nil, then when a default is nil, that value is |
| 1502 | reset. If SET-ALL is nil, the slots are only reset if the default is | 1160 | reset. If SET-ALL is nil, the slots are only reset if the default is |
| 1503 | not nil." | 1161 | not nil." |
| 1504 | (eieio--with-scoped-class (eieio--object-class obj) | 1162 | (eieio--with-scoped-class (eieio--object-class-object obj) |
| 1505 | (let ((eieio-initializing-object t) | 1163 | (let ((eieio-initializing-object t) |
| 1506 | (pub (eieio--class-public-a (class-v (eieio--object-class obj))))) | 1164 | (pub (eieio--class-public-a (eieio--object-class-object obj)))) |
| 1507 | (while pub | 1165 | (while pub |
| 1508 | (let ((df (eieio-oref-default obj (car pub)))) | 1166 | (let ((df (eieio-oref-default obj (car pub)))) |
| 1509 | (if (or df set-all) | 1167 | (if (or df set-all) |
| 1510 | (eieio-oset obj (car pub) df))) | 1168 | (eieio-oset obj (car pub) df))) |
| 1511 | (setq pub (cdr pub)))))) | 1169 | (setq pub (cdr pub)))))) |
| 1512 | 1170 | ||
| 1513 | (defun eieio-initarg-to-attribute (class initarg) | 1171 | (defun eieio--initarg-to-attribute (class initarg) |
| 1514 | "For CLASS, convert INITARG to the actual attribute name. | 1172 | "For CLASS, convert INITARG to the actual attribute name. |
| 1515 | If there is no translation, pass it in directly (so we can cheat if | 1173 | If there is no translation, pass it in directly (so we can cheat if |
| 1516 | need be... May remove that later...)" | 1174 | need be... May remove that later...)" |
| 1517 | (let ((tuple (assoc initarg (eieio--class-initarg-tuples (class-v class))))) | 1175 | (let ((tuple (assoc initarg (eieio--class-initarg-tuples class)))) |
| 1518 | (if tuple | 1176 | (if tuple |
| 1519 | (cdr tuple) | 1177 | (cdr tuple) |
| 1520 | nil))) | 1178 | nil))) |
| 1521 | 1179 | ||
| 1522 | (defun eieio-attribute-to-initarg (class attribute) | ||
| 1523 | "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag. | ||
| 1524 | This is usually a symbol that starts with `:'." | ||
| 1525 | (let ((tuple (rassoc attribute (eieio--class-initarg-tuples (class-v class))))) | ||
| 1526 | (if tuple | ||
| 1527 | (car tuple) | ||
| 1528 | nil))) | ||
| 1529 | |||
| 1530 | ;;; | 1180 | ;;; |
| 1531 | ;; Method Invocation order: C3 | 1181 | ;; Method Invocation order: C3 |
| 1532 | (defun eieio-c3-candidate (class remaining-inputs) | 1182 | (defun eieio--c3-candidate (class remaining-inputs) |
| 1533 | "Return CLASS if it can go in the result now, otherwise nil" | 1183 | "Return CLASS if it can go in the result now, otherwise nil." |
| 1534 | ;; Ensure CLASS is not in any position but the first in any of the | 1184 | ;; Ensure CLASS is not in any position but the first in any of the |
| 1535 | ;; element lists of REMAINING-INPUTS. | 1185 | ;; element lists of REMAINING-INPUTS. |
| 1536 | (and (not (let ((found nil)) | 1186 | (and (not (let ((found nil)) |
| @@ -1540,7 +1190,7 @@ This is usually a symbol that starts with `:'." | |||
| 1540 | found)) | 1190 | found)) |
| 1541 | class)) | 1191 | class)) |
| 1542 | 1192 | ||
| 1543 | (defun eieio-c3-merge-lists (reversed-partial-result remaining-inputs) | 1193 | (defun eieio--c3-merge-lists (reversed-partial-result remaining-inputs) |
| 1544 | "Merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order, if possible. | 1194 | "Merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order, if possible. |
| 1545 | If a consistent order does not exist, signal an error." | 1195 | If a consistent order does not exist, signal an error." |
| 1546 | (if (let ((tail remaining-inputs) | 1196 | (if (let ((tail remaining-inputs) |
| @@ -1559,41 +1209,38 @@ If a consistent order does not exist, signal an error." | |||
| 1559 | (next (progn | 1209 | (next (progn |
| 1560 | (while (and tail (not found)) | 1210 | (while (and tail (not found)) |
| 1561 | (setq found (and (car tail) | 1211 | (setq found (and (car tail) |
| 1562 | (eieio-c3-candidate (caar tail) | 1212 | (eieio--c3-candidate (caar tail) |
| 1563 | remaining-inputs)) | 1213 | remaining-inputs)) |
| 1564 | tail (cdr tail))) | 1214 | tail (cdr tail))) |
| 1565 | found))) | 1215 | found))) |
| 1566 | (if next | 1216 | (if next |
| 1567 | ;; The graph is consistent so far, add NEXT to result and | 1217 | ;; The graph is consistent so far, add NEXT to result and |
| 1568 | ;; merge input lists, dropping NEXT from their heads where | 1218 | ;; merge input lists, dropping NEXT from their heads where |
| 1569 | ;; applicable. | 1219 | ;; applicable. |
| 1570 | (eieio-c3-merge-lists | 1220 | (eieio--c3-merge-lists |
| 1571 | (cons next reversed-partial-result) | 1221 | (cons next reversed-partial-result) |
| 1572 | (mapcar (lambda (l) (if (eq (cl-first l) next) (cl-rest l) l)) | 1222 | (mapcar (lambda (l) (if (eq (cl-first l) next) (cl-rest l) l)) |
| 1573 | remaining-inputs)) | 1223 | remaining-inputs)) |
| 1574 | ;; The graph is inconsistent, give up | 1224 | ;; The graph is inconsistent, give up |
| 1575 | (signal 'inconsistent-class-hierarchy (list remaining-inputs)))))) | 1225 | (signal 'inconsistent-class-hierarchy (list remaining-inputs)))))) |
| 1576 | 1226 | ||
| 1577 | (defun eieio-class-precedence-c3 (class) | 1227 | (defun eieio--class-precedence-c3 (class) |
| 1578 | "Return all parents of CLASS in c3 order." | 1228 | "Return all parents of CLASS in c3 order." |
| 1579 | (let ((parents (eieio-class-parents-fast class))) | 1229 | (let ((parents (eieio--class-parent (eieio--class-v class)))) |
| 1580 | (eieio-c3-merge-lists | 1230 | (eieio--c3-merge-lists |
| 1581 | (list class) | 1231 | (list class) |
| 1582 | (append | 1232 | (append |
| 1583 | (or | 1233 | (or |
| 1584 | (mapcar | 1234 | (mapcar #'eieio--class-precedence-c3 parents) |
| 1585 | (lambda (x) | 1235 | `((,eieio-default-superclass))) |
| 1586 | (eieio-class-precedence-c3 x)) | ||
| 1587 | parents) | ||
| 1588 | '((eieio-default-superclass))) | ||
| 1589 | (list parents)))) | 1236 | (list parents)))) |
| 1590 | ) | 1237 | ) |
| 1591 | ;;; | 1238 | ;;; |
| 1592 | ;; Method Invocation Order: Depth First | 1239 | ;; Method Invocation Order: Depth First |
| 1593 | 1240 | ||
| 1594 | (defun eieio-class-precedence-dfs (class) | 1241 | (defun eieio--class-precedence-dfs (class) |
| 1595 | "Return all parents of CLASS in depth-first order." | 1242 | "Return all parents of CLASS in depth-first order." |
| 1596 | (let* ((parents (eieio-class-parents-fast class)) | 1243 | (let* ((parents (eieio--class-parent class)) |
| 1597 | (classes (copy-sequence | 1244 | (classes (copy-sequence |
| 1598 | (apply #'append | 1245 | (apply #'append |
| 1599 | (list class) | 1246 | (list class) |
| @@ -1601,9 +1248,9 @@ If a consistent order does not exist, signal an error." | |||
| 1601 | (mapcar | 1248 | (mapcar |
| 1602 | (lambda (parent) | 1249 | (lambda (parent) |
| 1603 | (cons parent | 1250 | (cons parent |
| 1604 | (eieio-class-precedence-dfs parent))) | 1251 | (eieio--class-precedence-dfs parent))) |
| 1605 | parents) | 1252 | parents) |
| 1606 | '((eieio-default-superclass)))))) | 1253 | `((,eieio-default-superclass)))))) |
| 1607 | (tail classes)) | 1254 | (tail classes)) |
| 1608 | ;; Remove duplicates. | 1255 | ;; Remove duplicates. |
| 1609 | (while tail | 1256 | (while tail |
| @@ -1613,563 +1260,55 @@ If a consistent order does not exist, signal an error." | |||
| 1613 | 1260 | ||
| 1614 | ;;; | 1261 | ;;; |
| 1615 | ;; Method Invocation Order: Breadth First | 1262 | ;; Method Invocation Order: Breadth First |
| 1616 | (defun eieio-class-precedence-bfs (class) | 1263 | (defun eieio--class-precedence-bfs (class) |
| 1617 | "Return all parents of CLASS in breadth-first order." | 1264 | "Return all parents of CLASS in breadth-first order." |
| 1618 | (let ((result) | 1265 | (let* ((result) |
| 1619 | (queue (or (eieio-class-parents-fast class) | 1266 | (queue (or (eieio--class-parent class) |
| 1620 | '(eieio-default-superclass)))) | 1267 | `(,eieio-default-superclass)))) |
| 1621 | (while queue | 1268 | (while queue |
| 1622 | (let ((head (pop queue))) | 1269 | (let ((head (pop queue))) |
| 1623 | (unless (member head result) | 1270 | (unless (member head result) |
| 1624 | (push head result) | 1271 | (push head result) |
| 1625 | (unless (eq head 'eieio-default-superclass) | 1272 | (unless (eq head eieio-default-superclass) |
| 1626 | (setq queue (append queue (or (eieio-class-parents-fast head) | 1273 | (setq queue (append queue (or (eieio--class-parent head) |
| 1627 | '(eieio-default-superclass)))))))) | 1274 | `(,eieio-default-superclass)))))))) |
| 1628 | (cons class (nreverse result))) | 1275 | (cons class (nreverse result))) |
| 1629 | ) | 1276 | ) |
| 1630 | 1277 | ||
| 1631 | ;;; | 1278 | ;;; |
| 1632 | ;; Method Invocation Order | 1279 | ;; Method Invocation Order |
| 1633 | 1280 | ||
| 1634 | (defun eieio-class-precedence-list (class) | 1281 | (defun eieio--class-precedence-list (class) |
| 1635 | "Return (transitively closed) list of parents of CLASS. | 1282 | "Return (transitively closed) list of parents of CLASS. |
| 1636 | The order, in which the parents are returned depends on the | 1283 | The order, in which the parents are returned depends on the |
| 1637 | method invocation orders of the involved classes." | 1284 | method invocation orders of the involved classes." |
| 1638 | (if (or (null class) (eq class 'eieio-default-superclass)) | 1285 | (if (or (null class) (eq class eieio-default-superclass)) |
| 1639 | nil | 1286 | nil |
| 1640 | (cl-case (class-method-invocation-order class) | 1287 | (cl-case (eieio--class-method-invocation-order class) |
| 1641 | (:depth-first | 1288 | (:depth-first |
| 1642 | (eieio-class-precedence-dfs class)) | 1289 | (eieio--class-precedence-dfs class)) |
| 1643 | (:breadth-first | 1290 | (:breadth-first |
| 1644 | (eieio-class-precedence-bfs class)) | 1291 | (eieio--class-precedence-bfs class)) |
| 1645 | (:c3 | 1292 | (:c3 |
| 1646 | (eieio-class-precedence-c3 class)))) | 1293 | (eieio--class-precedence-c3 class)))) |
| 1647 | ) | 1294 | ) |
| 1648 | (define-obsolete-function-alias | 1295 | (define-obsolete-function-alias |
| 1649 | 'class-precedence-list 'eieio-class-precedence-list "24.4") | 1296 | 'class-precedence-list 'eieio--class-precedence-list "24.4") |
| 1650 | |||
| 1651 | |||
| 1652 | ;;; CLOS generics internal function handling | ||
| 1653 | ;; | ||
| 1654 | (defvar eieio-generic-call-methodname nil | ||
| 1655 | "When using `call-next-method', provides a context on how to do it.") | ||
| 1656 | (defvar eieio-generic-call-arglst nil | ||
| 1657 | "When using `call-next-method', provides a context for parameters.") | ||
| 1658 | (defvar eieio-generic-call-key nil | ||
| 1659 | "When using `call-next-method', provides a context for the current key. | ||
| 1660 | Keys are a number representing :before, :primary, and :after methods.") | ||
| 1661 | (defvar eieio-generic-call-next-method-list nil | ||
| 1662 | "When executing a PRIMARY or STATIC method, track the 'next-method'. | ||
| 1663 | During executions, the list is first generated, then as each next method | ||
| 1664 | is called, the next method is popped off the stack.") | ||
| 1665 | |||
| 1666 | (define-obsolete-variable-alias 'eieio-pre-method-execution-hooks | ||
| 1667 | 'eieio-pre-method-execution-functions "24.3") | ||
| 1668 | (defvar eieio-pre-method-execution-functions nil | ||
| 1669 | "Abnormal hook run just before an EIEIO method is executed. | ||
| 1670 | The hook function must accept one argument, the list of forms | ||
| 1671 | about to be executed.") | ||
| 1672 | |||
| 1673 | (defun eieio-generic-call (method args) | ||
| 1674 | "Call METHOD with ARGS. | ||
| 1675 | ARGS provides the context on which implementation to use. | ||
| 1676 | This should only be called from a generic function." | ||
| 1677 | ;; We must expand our arguments first as they are always | ||
| 1678 | ;; passed in as quoted symbols | ||
| 1679 | (let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil) | ||
| 1680 | (eieio-generic-call-methodname method) | ||
| 1681 | (eieio-generic-call-arglst args) | ||
| 1682 | (firstarg nil) | ||
| 1683 | (primarymethodlist nil)) | ||
| 1684 | ;; get a copy | ||
| 1685 | (setq newargs args | ||
| 1686 | firstarg (car newargs)) | ||
| 1687 | ;; Is the class passed in autoloaded? | ||
| 1688 | ;; Since class names are also constructors, they can be autoloaded | ||
| 1689 | ;; via the autoload command. Check for this, and load them in. | ||
| 1690 | ;; It is ok if it doesn't turn out to be a class. Probably want that | ||
| 1691 | ;; function loaded anyway. | ||
| 1692 | (if (and (symbolp firstarg) | ||
| 1693 | (fboundp firstarg) | ||
| 1694 | (listp (symbol-function firstarg)) | ||
| 1695 | (eq 'autoload (car (symbol-function firstarg)))) | ||
| 1696 | (load (nth 1 (symbol-function firstarg)))) | ||
| 1697 | ;; Determine the class to use. | ||
| 1698 | (cond ((eieio-object-p firstarg) | ||
| 1699 | (setq mclass (eieio--object-class firstarg))) | ||
| 1700 | ((class-p firstarg) | ||
| 1701 | (setq mclass firstarg)) | ||
| 1702 | ) | ||
| 1703 | ;; Make sure the class is a valid class | ||
| 1704 | ;; mclass can be nil (meaning a generic for should be used. | ||
| 1705 | ;; mclass cannot have a value that is not a class, however. | ||
| 1706 | (when (and (not (null mclass)) (not (class-p mclass))) | ||
| 1707 | (error "Cannot dispatch method %S on class %S" | ||
| 1708 | method mclass) | ||
| 1709 | ) | ||
| 1710 | ;; Now create a list in reverse order of all the calls we have | ||
| 1711 | ;; make in order to successfully do this right. Rules: | ||
| 1712 | ;; 1) Only call generics if scoped-class is not defined | ||
| 1713 | ;; This prevents multiple calls in the case of recursion | ||
| 1714 | ;; 2) Only call static if this is a static method. | ||
| 1715 | ;; 3) Only call specifics if the definition allows for them. | ||
| 1716 | ;; 4) Call in order based on :before, :primary, and :after | ||
| 1717 | (when (eieio-object-p firstarg) | ||
| 1718 | ;; Non-static calls do all this stuff. | ||
| 1719 | |||
| 1720 | ;; :after methods | ||
| 1721 | (setq tlambdas | ||
| 1722 | (if mclass | ||
| 1723 | (eieiomt-method-list method method-after mclass) | ||
| 1724 | (list (eieio-generic-form method method-after nil))) | ||
| 1725 | ;;(or (and mclass (eieio-generic-form method method-after mclass)) | ||
| 1726 | ;; (eieio-generic-form method method-after nil)) | ||
| 1727 | ) | ||
| 1728 | (setq lambdas (append tlambdas lambdas) | ||
| 1729 | keys (append (make-list (length tlambdas) method-after) keys)) | ||
| 1730 | |||
| 1731 | ;; :primary methods | ||
| 1732 | (setq tlambdas | ||
| 1733 | (or (and mclass (eieio-generic-form method method-primary mclass)) | ||
| 1734 | (eieio-generic-form method method-primary nil))) | ||
| 1735 | (when tlambdas | ||
| 1736 | (setq lambdas (cons tlambdas lambdas) | ||
| 1737 | keys (cons method-primary keys) | ||
| 1738 | primarymethodlist | ||
| 1739 | (eieiomt-method-list method method-primary mclass))) | ||
| 1740 | |||
| 1741 | ;; :before methods | ||
| 1742 | (setq tlambdas | ||
| 1743 | (if mclass | ||
| 1744 | (eieiomt-method-list method method-before mclass) | ||
| 1745 | (list (eieio-generic-form method method-before nil))) | ||
| 1746 | ;;(or (and mclass (eieio-generic-form method method-before mclass)) | ||
| 1747 | ;; (eieio-generic-form method method-before nil)) | ||
| 1748 | ) | ||
| 1749 | (setq lambdas (append tlambdas lambdas) | ||
| 1750 | keys (append (make-list (length tlambdas) method-before) keys)) | ||
| 1751 | ) | ||
| 1752 | |||
| 1753 | (if mclass | ||
| 1754 | ;; For the case of a class, | ||
| 1755 | ;; if there were no methods found, then there could be :static methods. | ||
| 1756 | (when (not lambdas) | ||
| 1757 | (setq tlambdas | ||
| 1758 | (eieio-generic-form method method-static mclass)) | ||
| 1759 | (setq lambdas (cons tlambdas lambdas) | ||
| 1760 | keys (cons method-static keys) | ||
| 1761 | primarymethodlist ;; Re-use even with bad name here | ||
| 1762 | (eieiomt-method-list method method-static mclass))) | ||
| 1763 | ;; For the case of no class (ie - mclass == nil) then there may | ||
| 1764 | ;; be a primary method. | ||
| 1765 | (setq tlambdas | ||
| 1766 | (eieio-generic-form method method-primary nil)) | ||
| 1767 | (when tlambdas | ||
| 1768 | (setq lambdas (cons tlambdas lambdas) | ||
| 1769 | keys (cons method-primary keys) | ||
| 1770 | primarymethodlist | ||
| 1771 | (eieiomt-method-list method method-primary nil))) | ||
| 1772 | ) | ||
| 1773 | |||
| 1774 | (run-hook-with-args 'eieio-pre-method-execution-functions | ||
| 1775 | primarymethodlist) | ||
| 1776 | |||
| 1777 | ;; Now loop through all occurrences forms which we must execute | ||
| 1778 | ;; (which are happily sorted now) and execute them all! | ||
| 1779 | (let ((rval nil) (lastval nil) (found nil)) | ||
| 1780 | (while lambdas | ||
| 1781 | (if (car lambdas) | ||
| 1782 | (eieio--with-scoped-class (cdr (car lambdas)) | ||
| 1783 | (let* ((eieio-generic-call-key (car keys)) | ||
| 1784 | (has-return-val | ||
| 1785 | (or (= eieio-generic-call-key method-primary) | ||
| 1786 | (= eieio-generic-call-key method-static))) | ||
| 1787 | (eieio-generic-call-next-method-list | ||
| 1788 | ;; Use the cdr, as the first element is the fcn | ||
| 1789 | ;; we are calling right now. | ||
| 1790 | (when has-return-val (cdr primarymethodlist))) | ||
| 1791 | ) | ||
| 1792 | (setq found t) | ||
| 1793 | ;;(setq rval (apply (car (car lambdas)) newargs)) | ||
| 1794 | (setq lastval (apply (car (car lambdas)) newargs)) | ||
| 1795 | (when has-return-val | ||
| 1796 | (setq rval lastval)) | ||
| 1797 | ))) | ||
| 1798 | (setq lambdas (cdr lambdas) | ||
| 1799 | keys (cdr keys))) | ||
| 1800 | (if (not found) | ||
| 1801 | (if (eieio-object-p (car args)) | ||
| 1802 | (setq rval (apply #'no-applicable-method (car args) method args)) | ||
| 1803 | (signal | ||
| 1804 | 'no-method-definition | ||
| 1805 | (list method args)))) | ||
| 1806 | rval))) | ||
| 1807 | |||
| 1808 | (defun eieio-generic-call-primary-only (method args) | ||
| 1809 | "Call METHOD with ARGS for methods with only :PRIMARY implementations. | ||
| 1810 | ARGS provides the context on which implementation to use. | ||
| 1811 | This should only be called from a generic function. | ||
| 1812 | |||
| 1813 | This method is like `eieio-generic-call', but only | ||
| 1814 | implementations in the :PRIMARY slot are queried. After many | ||
| 1815 | years of use, it appears that over 90% of methods in use | ||
| 1816 | have :PRIMARY implementations only. We can therefore optimize | ||
| 1817 | for this common case to improve performance." | ||
| 1818 | ;; We must expand our arguments first as they are always | ||
| 1819 | ;; passed in as quoted symbols | ||
| 1820 | (let ((newargs nil) (mclass nil) (lambdas nil) | ||
| 1821 | (eieio-generic-call-methodname method) | ||
| 1822 | (eieio-generic-call-arglst args) | ||
| 1823 | (firstarg nil) | ||
| 1824 | (primarymethodlist nil) | ||
| 1825 | ) | ||
| 1826 | ;; get a copy | ||
| 1827 | (setq newargs args | ||
| 1828 | firstarg (car newargs)) | ||
| 1829 | |||
| 1830 | ;; Determine the class to use. | ||
| 1831 | (cond ((eieio-object-p firstarg) | ||
| 1832 | (setq mclass (eieio--object-class firstarg))) | ||
| 1833 | ((not firstarg) | ||
| 1834 | (error "Method %s called on nil" method)) | ||
| 1835 | ((not (eieio-object-p firstarg)) | ||
| 1836 | (error "Primary-only method %s called on something not an object" method)) | ||
| 1837 | (t | ||
| 1838 | (error "EIEIO Error: Improperly classified method %s as primary only" | ||
| 1839 | method) | ||
| 1840 | )) | ||
| 1841 | ;; Make sure the class is a valid class | ||
| 1842 | ;; mclass can be nil (meaning a generic for should be used. | ||
| 1843 | ;; mclass cannot have a value that is not a class, however. | ||
| 1844 | (when (null mclass) | ||
| 1845 | (error "Cannot dispatch method %S on class %S" method mclass) | ||
| 1846 | ) | ||
| 1847 | |||
| 1848 | ;; :primary methods | ||
| 1849 | (setq lambdas (eieio-generic-form method method-primary mclass)) | ||
| 1850 | (setq primarymethodlist ;; Re-use even with bad name here | ||
| 1851 | (eieiomt-method-list method method-primary mclass)) | ||
| 1852 | |||
| 1853 | ;; Now loop through all occurrences forms which we must execute | ||
| 1854 | ;; (which are happily sorted now) and execute them all! | ||
| 1855 | (eieio--with-scoped-class (cdr lambdas) | ||
| 1856 | (let* ((rval nil) (lastval nil) | ||
| 1857 | (eieio-generic-call-key method-primary) | ||
| 1858 | ;; Use the cdr, as the first element is the fcn | ||
| 1859 | ;; we are calling right now. | ||
| 1860 | (eieio-generic-call-next-method-list (cdr primarymethodlist)) | ||
| 1861 | ) | ||
| 1862 | |||
| 1863 | (if (or (not lambdas) (not (car lambdas))) | ||
| 1864 | |||
| 1865 | ;; No methods found for this impl... | ||
| 1866 | (if (eieio-object-p (car args)) | ||
| 1867 | (setq rval (apply #'no-applicable-method | ||
| 1868 | (car args) method args)) | ||
| 1869 | (signal | ||
| 1870 | 'no-method-definition | ||
| 1871 | (list method args))) | ||
| 1872 | |||
| 1873 | ;; Do the regular implementation here. | ||
| 1874 | |||
| 1875 | (run-hook-with-args 'eieio-pre-method-execution-functions | ||
| 1876 | lambdas) | ||
| 1877 | |||
| 1878 | (setq lastval (apply (car lambdas) newargs)) | ||
| 1879 | (setq rval lastval)) | ||
| 1880 | |||
| 1881 | rval)))) | ||
| 1882 | |||
| 1883 | (defun eieiomt-method-list (method key class) | ||
| 1884 | "Return an alist list of methods lambdas. | ||
| 1885 | METHOD is the method name. | ||
| 1886 | KEY represents either :before, or :after methods. | ||
| 1887 | CLASS is the starting class to search from in the method tree. | ||
| 1888 | If CLASS is nil, then an empty list of methods should be returned." | ||
| 1889 | ;; Note: eieiomt - the MT means MethodTree. See more comments below | ||
| 1890 | ;; for the rest of the eieiomt methods. | ||
| 1891 | |||
| 1892 | ;; Collect lambda expressions stored for the class and its parent | ||
| 1893 | ;; classes. | ||
| 1894 | (let (lambdas) | ||
| 1895 | (dolist (ancestor (eieio-class-precedence-list class)) | ||
| 1896 | ;; Lookup the form to use for the PRIMARY object for the next level | ||
| 1897 | (let ((tmpl (eieio-generic-form method key ancestor))) | ||
| 1898 | (when (and tmpl | ||
| 1899 | (or (not lambdas) | ||
| 1900 | ;; This prevents duplicates coming out of the | ||
| 1901 | ;; class method optimizer. Perhaps we should | ||
| 1902 | ;; just not optimize before/afters? | ||
| 1903 | (not (member tmpl lambdas)))) | ||
| 1904 | (push tmpl lambdas)))) | ||
| 1905 | |||
| 1906 | ;; Return collected lambda. For :after methods, return in current | ||
| 1907 | ;; order (most general class last); Otherwise, reverse order. | ||
| 1908 | (if (eq key method-after) | ||
| 1909 | lambdas | ||
| 1910 | (nreverse lambdas)))) | ||
| 1911 | |||
| 1912 | |||
| 1913 | ;;; | ||
| 1914 | ;; eieio-method-tree : eieiomt- | ||
| 1915 | ;; | ||
| 1916 | ;; Stored as eieio-method-tree in property list of a generic method | ||
| 1917 | ;; | ||
| 1918 | ;; (eieio-method-tree . [BEFORE PRIMARY AFTER | ||
| 1919 | ;; genericBEFORE genericPRIMARY genericAFTER]) | ||
| 1920 | ;; and | ||
| 1921 | ;; (eieio-method-obarray . [BEFORE PRIMARY AFTER | ||
| 1922 | ;; genericBEFORE genericPRIMARY genericAFTER]) | ||
| 1923 | ;; where the association is a vector. | ||
| 1924 | ;; (aref 0 -- all static methods. | ||
| 1925 | ;; (aref 1 -- all methods classified as :before | ||
| 1926 | ;; (aref 2 -- all methods classified as :primary | ||
| 1927 | ;; (aref 3 -- all methods classified as :after | ||
| 1928 | ;; (aref 4 -- a generic classified as :before | ||
| 1929 | ;; (aref 5 -- a generic classified as :primary | ||
| 1930 | ;; (aref 6 -- a generic classified as :after | ||
| 1931 | ;; | ||
| 1932 | (defvar eieiomt-optimizing-obarray nil | ||
| 1933 | "While mapping atoms, this contain the obarray being optimized.") | ||
| 1934 | |||
| 1935 | (defun eieiomt-install (method-name) | ||
| 1936 | "Install the method tree, and obarray onto METHOD-NAME. | ||
| 1937 | Do not do the work if they already exist." | ||
| 1938 | (let ((emtv (get method-name 'eieio-method-tree)) | ||
| 1939 | (emto (get method-name 'eieio-method-obarray))) | ||
| 1940 | (if (or (not emtv) (not emto)) | ||
| 1941 | (progn | ||
| 1942 | (setq emtv (put method-name 'eieio-method-tree | ||
| 1943 | (make-vector method-num-slots nil)) | ||
| 1944 | emto (put method-name 'eieio-method-obarray | ||
| 1945 | (make-vector method-num-slots nil))) | ||
| 1946 | (aset emto 0 (make-vector 11 0)) | ||
| 1947 | (aset emto 1 (make-vector 11 0)) | ||
| 1948 | (aset emto 2 (make-vector 41 0)) | ||
| 1949 | (aset emto 3 (make-vector 11 0)) | ||
| 1950 | )))) | ||
| 1951 | |||
| 1952 | (defun eieiomt-add (method-name method key class) | ||
| 1953 | "Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS. | ||
| 1954 | METHOD-NAME is the name created by a call to `defgeneric'. | ||
| 1955 | METHOD are the forms for a given implementation. | ||
| 1956 | KEY is an integer (see comment in eieio.el near this function) which | ||
| 1957 | is associated with the :static :before :primary and :after tags. | ||
| 1958 | It also indicates if CLASS is defined or not. | ||
| 1959 | CLASS is the class this method is associated with." | ||
| 1960 | (if (or (> key method-num-slots) (< key 0)) | ||
| 1961 | (error "eieiomt-add: method key error!")) | ||
| 1962 | (let ((emtv (get method-name 'eieio-method-tree)) | ||
| 1963 | (emto (get method-name 'eieio-method-obarray))) | ||
| 1964 | ;; Make sure the method tables are available. | ||
| 1965 | (if (or (not emtv) (not emto)) | ||
| 1966 | (error "Programmer error: eieiomt-add")) | ||
| 1967 | ;; only add new cells on if it doesn't already exist! | ||
| 1968 | (if (assq class (aref emtv key)) | ||
| 1969 | (setcdr (assq class (aref emtv key)) method) | ||
| 1970 | (aset emtv key (cons (cons class method) (aref emtv key)))) | ||
| 1971 | ;; Add function definition into newly created symbol, and store | ||
| 1972 | ;; said symbol in the correct obarray, otherwise use the | ||
| 1973 | ;; other array to keep this stuff | ||
| 1974 | (if (< key method-num-lists) | ||
| 1975 | (let ((nsym (intern (symbol-name class) (aref emto key)))) | ||
| 1976 | (fset nsym method))) | ||
| 1977 | ;; Save the defmethod file location in a symbol property. | ||
| 1978 | (let ((fname (if load-in-progress | ||
| 1979 | load-file-name | ||
| 1980 | buffer-file-name)) | ||
| 1981 | loc) | ||
| 1982 | (when fname | ||
| 1983 | (when (string-match "\\.elc$" fname) | ||
| 1984 | (setq fname (substring fname 0 (1- (length fname))))) | ||
| 1985 | (setq loc (get method-name 'method-locations)) | ||
| 1986 | (cl-pushnew (list class fname) loc :test 'equal) | ||
| 1987 | (put method-name 'method-locations loc))) | ||
| 1988 | ;; Now optimize the entire obarray | ||
| 1989 | (if (< key method-num-lists) | ||
| 1990 | (let ((eieiomt-optimizing-obarray (aref emto key))) | ||
| 1991 | ;; @todo - Is this overkill? Should we just clear the symbol? | ||
| 1992 | (mapatoms 'eieiomt-sym-optimize eieiomt-optimizing-obarray))) | ||
| 1993 | )) | ||
| 1994 | |||
| 1995 | (defun eieiomt-next (class) | ||
| 1996 | "Return the next parent class for CLASS. | ||
| 1997 | If CLASS is a superclass, return variable `eieio-default-superclass'. | ||
| 1998 | If CLASS is variable `eieio-default-superclass' then return nil. | ||
| 1999 | This is different from function `class-parent' as class parent returns | ||
| 2000 | nil for superclasses. This function performs no type checking!" | ||
| 2001 | ;; No type-checking because all calls are made from functions which | ||
| 2002 | ;; are safe and do checking for us. | ||
| 2003 | (or (eieio-class-parents-fast class) | ||
| 2004 | (if (eq class 'eieio-default-superclass) | ||
| 2005 | nil | ||
| 2006 | '(eieio-default-superclass)))) | ||
| 2007 | |||
| 2008 | (defun eieiomt-sym-optimize (s) | ||
| 2009 | "Find the next class above S which has a function body for the optimizer." | ||
| 2010 | ;; Set the value to nil in case there is no nearest cell. | ||
| 2011 | (set s nil) | ||
| 2012 | ;; Find the nearest cell that has a function body. If we find one, | ||
| 2013 | ;; we replace the nil from above. | ||
| 2014 | (let ((external-symbol (intern-soft (symbol-name s)))) | ||
| 2015 | (catch 'done | ||
| 2016 | (dolist (ancestor | ||
| 2017 | (cl-rest (eieio-class-precedence-list external-symbol))) | ||
| 2018 | (let ((ov (intern-soft (symbol-name ancestor) | ||
| 2019 | eieiomt-optimizing-obarray))) | ||
| 2020 | (when (fboundp ov) | ||
| 2021 | (set s ov) ;; store ov as our next symbol | ||
| 2022 | (throw 'done ancestor))))))) | ||
| 2023 | |||
| 2024 | (defun eieio-generic-form (method key class) | ||
| 2025 | "Return the lambda form belonging to METHOD using KEY based upon CLASS. | ||
| 2026 | If CLASS is not a class then use `generic' instead. If class has | ||
| 2027 | no form, but has a parent class, then trace to that parent class. | ||
| 2028 | The first time a form is requested from a symbol, an optimized path | ||
| 2029 | is memorized for faster future use." | ||
| 2030 | (let ((emto (aref (get method 'eieio-method-obarray) | ||
| 2031 | (if class key (eieio-specialized-key-to-generic-key key))))) | ||
| 2032 | (if (class-p class) | ||
| 2033 | ;; 1) find our symbol | ||
| 2034 | (let ((cs (intern-soft (symbol-name class) emto))) | ||
| 2035 | (if (not cs) | ||
| 2036 | ;; 2) If there isn't one, then make one. | ||
| 2037 | ;; This can be slow since it only occurs once | ||
| 2038 | (progn | ||
| 2039 | (setq cs (intern (symbol-name class) emto)) | ||
| 2040 | ;; 2.1) Cache its nearest neighbor with a quick optimize | ||
| 2041 | ;; which should only occur once for this call ever | ||
| 2042 | (let ((eieiomt-optimizing-obarray emto)) | ||
| 2043 | (eieiomt-sym-optimize cs)))) | ||
| 2044 | ;; 3) If it's bound return this one. | ||
| 2045 | (if (fboundp cs) | ||
| 2046 | (cons cs (eieio--class-symbol (class-v class))) | ||
| 2047 | ;; 4) If it's not bound then this variable knows something | ||
| 2048 | (if (symbol-value cs) | ||
| 2049 | (progn | ||
| 2050 | ;; 4.1) This symbol holds the next class in its value | ||
| 2051 | (setq class (symbol-value cs) | ||
| 2052 | cs (intern-soft (symbol-name class) emto)) | ||
| 2053 | ;; 4.2) The optimizer should always have chosen a | ||
| 2054 | ;; function-symbol | ||
| 2055 | ;;(if (fboundp cs) | ||
| 2056 | (cons cs (eieio--class-symbol (class-v (intern (symbol-name class))))) | ||
| 2057 | ;;(error "EIEIO optimizer: erratic data loss!")) | ||
| 2058 | ) | ||
| 2059 | ;; There never will be a funcall... | ||
| 2060 | nil))) | ||
| 2061 | ;; for a generic call, what is a list, is the function body we want. | ||
| 2062 | (let ((emtl (aref (get method 'eieio-method-tree) | ||
| 2063 | (if class key (eieio-specialized-key-to-generic-key key))))) | ||
| 2064 | (if emtl | ||
| 2065 | ;; The car of EMTL is supposed to be a class, which in this | ||
| 2066 | ;; case is nil, so skip it. | ||
| 2067 | (cons (cdr (car emtl)) nil) | ||
| 2068 | nil))))) | ||
| 2069 | 1297 | ||
| 2070 | 1298 | ||
| 2071 | ;;; Here are some special types of errors | 1299 | ;;; Here are some special types of errors |
| 2072 | ;; | 1300 | ;; |
| 2073 | (define-error 'no-method-definition "No method definition") | ||
| 2074 | (define-error 'no-next-method "No next method") | ||
| 2075 | (define-error 'invalid-slot-name "Invalid slot name") | 1301 | (define-error 'invalid-slot-name "Invalid slot name") |
| 2076 | (define-error 'invalid-slot-type "Invalid slot type") | 1302 | (define-error 'invalid-slot-type "Invalid slot type") |
| 2077 | (define-error 'unbound-slot "Unbound slot") | 1303 | (define-error 'unbound-slot "Unbound slot") |
| 2078 | (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") | 1304 | (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") |
| 2079 | 1305 | ||
| 2080 | ;;; Obsolete backward compatibility functions. | 1306 | ;;; Backward compatibility functions |
| 2081 | ;; Needed to run byte-code compiled with the EIEIO of Emacs-23. | 1307 | ;; To support .elc files compiled for older versions of EIEIO. |
| 2082 | 1308 | ||
| 2083 | (defun eieio-defmethod (method args) | 1309 | (defun eieio-defclass (cname superclasses slots options) |
| 2084 | "Obsolete work part of an old version of the `defmethod' macro." | 1310 | (eval `(defclass ,cname ,superclasses ,slots ,options))) |
| 2085 | (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) | 1311 | |
| 2086 | ;; find optional keys | ||
| 2087 | (setq key | ||
| 2088 | (cond ((memq (car args) '(:BEFORE :before)) | ||
| 2089 | (setq args (cdr args)) | ||
| 2090 | method-before) | ||
| 2091 | ((memq (car args) '(:AFTER :after)) | ||
| 2092 | (setq args (cdr args)) | ||
| 2093 | method-after) | ||
| 2094 | ((memq (car args) '(:STATIC :static)) | ||
| 2095 | (setq args (cdr args)) | ||
| 2096 | method-static) | ||
| 2097 | ((memq (car args) '(:PRIMARY :primary)) | ||
| 2098 | (setq args (cdr args)) | ||
| 2099 | method-primary) | ||
| 2100 | ;; Primary key. | ||
| 2101 | (t method-primary))) | ||
| 2102 | ;; Get body, and fix contents of args to be the arguments of the fn. | ||
| 2103 | (setq body (cdr args) | ||
| 2104 | args (car args)) | ||
| 2105 | (setq loopa args) | ||
| 2106 | ;; Create a fixed version of the arguments. | ||
| 2107 | (while loopa | ||
| 2108 | (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa)) | ||
| 2109 | argfix)) | ||
| 2110 | (setq loopa (cdr loopa))) | ||
| 2111 | ;; Make sure there is a generic. | ||
| 2112 | (eieio-defgeneric | ||
| 2113 | method | ||
| 2114 | (if (stringp (car body)) | ||
| 2115 | (car body) (format "Generically created method `%s'." method))) | ||
| 2116 | ;; create symbol for property to bind to. If the first arg is of | ||
| 2117 | ;; the form (varname vartype) and `vartype' is a class, then | ||
| 2118 | ;; that class will be the type symbol. If not, then it will fall | ||
| 2119 | ;; under the type `primary' which is a non-specific calling of the | ||
| 2120 | ;; function. | ||
| 2121 | (setq firstarg (car args)) | ||
| 2122 | (if (listp firstarg) | ||
| 2123 | (progn | ||
| 2124 | (setq argclass (nth 1 firstarg)) | ||
| 2125 | (if (not (class-p argclass)) | ||
| 2126 | (error "Unknown class type %s in method parameters" | ||
| 2127 | (nth 1 firstarg)))) | ||
| 2128 | ;; Generics are higher. | ||
| 2129 | (setq key (eieio-specialized-key-to-generic-key key))) | ||
| 2130 | ;; Put this lambda into the symbol so we can find it. | ||
| 2131 | (if (byte-code-function-p (car-safe body)) | ||
| 2132 | (eieiomt-add method (car-safe body) key argclass) | ||
| 2133 | (eieiomt-add method (append (list 'lambda (reverse argfix)) body) | ||
| 2134 | key argclass)) | ||
| 2135 | ) | ||
| 2136 | |||
| 2137 | (when eieio-optimize-primary-methods-flag | ||
| 2138 | ;; Optimizing step: | ||
| 2139 | ;; | ||
| 2140 | ;; If this method, after this setup, only has primary methods, then | ||
| 2141 | ;; we can setup the generic that way. | ||
| 2142 | (if (generic-primary-only-p method) | ||
| 2143 | ;; If there is only one primary method, then we can go one more | ||
| 2144 | ;; optimization step. | ||
| 2145 | (if (generic-primary-only-one-p method) | ||
| 2146 | (eieio-defgeneric-reset-generic-form-primary-only-one method) | ||
| 2147 | (eieio-defgeneric-reset-generic-form-primary-only method)) | ||
| 2148 | (eieio-defgeneric-reset-generic-form method))) | ||
| 2149 | |||
| 2150 | method) | ||
| 2151 | (make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1") | ||
| 2152 | |||
| 2153 | (defun eieio-defgeneric (method doc-string) | ||
| 2154 | "Obsolete work part of an old version of the `defgeneric' macro." | ||
| 2155 | (if (and (fboundp method) (not (generic-p method)) | ||
| 2156 | (or (byte-code-function-p (symbol-function method)) | ||
| 2157 | (not (eq 'autoload (car (symbol-function method))))) | ||
| 2158 | ) | ||
| 2159 | (error "You cannot create a generic/method over an existing symbol: %s" | ||
| 2160 | method)) | ||
| 2161 | ;; Don't do this over and over. | ||
| 2162 | (unless (fboundp 'method) | ||
| 2163 | ;; This defun tells emacs where the first definition of this | ||
| 2164 | ;; method is defined. | ||
| 2165 | `(defun ,method nil) | ||
| 2166 | ;; Make sure the method tables are installed. | ||
| 2167 | (eieiomt-install method) | ||
| 2168 | ;; Apply the actual body of this function. | ||
| 2169 | (fset method (eieio-defgeneric-form method doc-string)) | ||
| 2170 | ;; Return the method | ||
| 2171 | 'method)) | ||
| 2172 | (make-obsolete 'eieio-defgeneric nil "24.1") | ||
| 2173 | 1312 | ||
| 2174 | (provide 'eieio-core) | 1313 | (provide 'eieio-core) |
| 2175 | 1314 | ||
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index dc85b4cc892..d0eaaf24d2b 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; eieio-custom.el -- eieio object customization | 1 | ;;; eieio-custom.el -- eieio object customization -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999-2001, 2005, 2007-2015 Free Software Foundation, | 3 | ;; Copyright (C) 1999-2001, 2005, 2007-2015 Free Software Foundation, |
| 4 | ;; Inc. | 4 | ;; Inc. |
| @@ -70,7 +70,7 @@ of these.") | |||
| 70 | :documentation "A number of thingies.")) | 70 | :documentation "A number of thingies.")) |
| 71 | "A class for testing the widget on.") | 71 | "A class for testing the widget on.") |
| 72 | 72 | ||
| 73 | (defcustom eieio-widget-test (eieio-widget-test-class "Foo") | 73 | (defcustom eieio-widget-test (eieio-widget-test-class) |
| 74 | "Test variable for editing an object." | 74 | "Test variable for editing an object." |
| 75 | :type 'object | 75 | :type 'object |
| 76 | :group 'eieio) | 76 | :group 'eieio) |
| @@ -136,7 +136,7 @@ Updates occur regardless of the current customization group.") | |||
| 136 | )) | 136 | )) |
| 137 | (widget-value-set vc (widget-value vc)))) | 137 | (widget-value-set vc (widget-value vc)))) |
| 138 | 138 | ||
| 139 | (defun eieio-custom-toggle-parent (widget &rest ignore) | 139 | (defun eieio-custom-toggle-parent (widget &rest _) |
| 140 | "Toggle visibility of parent of WIDGET. | 140 | "Toggle visibility of parent of WIDGET. |
| 141 | Optional argument IGNORE is an extraneous parameter." | 141 | Optional argument IGNORE is an extraneous parameter." |
| 142 | (eieio-custom-toggle-hide (widget-get widget :parent))) | 142 | (eieio-custom-toggle-hide (widget-get widget :parent))) |
| @@ -154,7 +154,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 154 | :clone-object-children nil | 154 | :clone-object-children nil |
| 155 | ) | 155 | ) |
| 156 | 156 | ||
| 157 | (defun eieio-object-match (widget value) | 157 | (defun eieio-object-match (_widget _value) |
| 158 | "Match info for WIDGET against VALUE." | 158 | "Match info for WIDGET against VALUE." |
| 159 | ;; Write me | 159 | ;; Write me |
| 160 | t) | 160 | t) |
| @@ -193,7 +193,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 193 | (let* ((chil nil) | 193 | (let* ((chil nil) |
| 194 | (obj (widget-get widget :value)) | 194 | (obj (widget-get widget :value)) |
| 195 | (master-group (widget-get widget :eieio-group)) | 195 | (master-group (widget-get widget :eieio-group)) |
| 196 | (cv (class-v (eieio--object-class obj))) | 196 | (cv (eieio--object-class-object obj)) |
| 197 | (slots (eieio--class-public-a cv)) | 197 | (slots (eieio--class-public-a cv)) |
| 198 | (flabel (eieio--class-public-custom-label cv)) | 198 | (flabel (eieio--class-public-custom-label cv)) |
| 199 | (fgroup (eieio--class-public-custom-group cv)) | 199 | (fgroup (eieio--class-public-custom-group cv)) |
| @@ -208,7 +208,8 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 208 | chil))) | 208 | chil))) |
| 209 | ;; Display information about the group being shown | 209 | ;; Display information about the group being shown |
| 210 | (when master-group | 210 | (when master-group |
| 211 | (let ((groups (class-option (eieio--object-class obj) :custom-groups))) | 211 | (let ((groups (eieio--class-option (eieio--object-class-object obj) |
| 212 | :custom-groups))) | ||
| 212 | (widget-insert "Groups:") | 213 | (widget-insert "Groups:") |
| 213 | (while groups | 214 | (while groups |
| 214 | (widget-insert " ") | 215 | (widget-insert " ") |
| @@ -216,7 +217,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 216 | (widget-insert "*" (capitalize (symbol-name master-group)) "*") | 217 | (widget-insert "*" (capitalize (symbol-name master-group)) "*") |
| 217 | (widget-create 'push-button | 218 | (widget-create 'push-button |
| 218 | :thing (cons obj (car groups)) | 219 | :thing (cons obj (car groups)) |
| 219 | :notify (lambda (widget &rest stuff) | 220 | :notify (lambda (widget &rest _) |
| 220 | (eieio-customize-object | 221 | (eieio-customize-object |
| 221 | (car (widget-get widget :thing)) | 222 | (car (widget-get widget :thing)) |
| 222 | (cdr (widget-get widget :thing)))) | 223 | (cdr (widget-get widget :thing)))) |
| @@ -260,8 +261,8 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 260 | (car flabel) | 261 | (car flabel) |
| 261 | (let ((s (symbol-name | 262 | (let ((s (symbol-name |
| 262 | (or | 263 | (or |
| 263 | (class-slot-initarg | 264 | (eieio--class-slot-initarg |
| 264 | (eieio--object-class obj) | 265 | (eieio--object-class-object obj) |
| 265 | (car slots)) | 266 | (car slots)) |
| 266 | (car slots))))) | 267 | (car slots))))) |
| 267 | (capitalize | 268 | (capitalize |
| @@ -288,7 +289,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 288 | "Get the value of WIDGET." | 289 | "Get the value of WIDGET." |
| 289 | (let* ((obj (widget-get widget :value)) | 290 | (let* ((obj (widget-get widget :value)) |
| 290 | (master-group eieio-cog) | 291 | (master-group eieio-cog) |
| 291 | (cv (class-v (eieio--object-class obj))) | 292 | (cv (eieio--object-class-object obj)) |
| 292 | (fgroup (eieio--class-public-custom-group cv)) | 293 | (fgroup (eieio--class-public-custom-group cv)) |
| 293 | (wids (widget-get widget :children)) | 294 | (wids (widget-get widget :children)) |
| 294 | (name (if (widget-get widget :eieio-show-name) | 295 | (name (if (widget-get widget :eieio-show-name) |
| @@ -296,7 +297,7 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 296 | nil)) | 297 | nil)) |
| 297 | (chil (if (widget-get widget :eieio-show-name) | 298 | (chil (if (widget-get widget :eieio-show-name) |
| 298 | (nthcdr 1 wids) wids)) | 299 | (nthcdr 1 wids) wids)) |
| 299 | (cv (class-v (eieio--object-class obj))) | 300 | (cv (eieio--object-class-object obj)) |
| 300 | (slots (eieio--class-public-a cv)) | 301 | (slots (eieio--class-public-a cv)) |
| 301 | (fcust (eieio--class-public-custom cv))) | 302 | (fcust (eieio--class-public-custom cv))) |
| 302 | ;; If there are any prefix widgets, clear them. | 303 | ;; If there are any prefix widgets, clear them. |
| @@ -317,11 +318,11 @@ Optional argument IGNORE is an extraneous parameter." | |||
| 317 | fgroup (cdr fgroup) | 318 | fgroup (cdr fgroup) |
| 318 | fcust (cdr fcust))) | 319 | fcust (cdr fcust))) |
| 319 | ;; Set any name updates on it. | 320 | ;; Set any name updates on it. |
| 320 | (if name (setf (eieio--object-name obj) name)) | 321 | (if name (eieio-object-set-name-string obj name)) |
| 321 | ;; This is the same object we had before. | 322 | ;; This is the same object we had before. |
| 322 | obj)) | 323 | obj)) |
| 323 | 324 | ||
| 324 | (defmethod eieio-done-customizing ((obj eieio-default-superclass)) | 325 | (defmethod eieio-done-customizing ((_obj eieio-default-superclass)) |
| 325 | "When applying change to a widget, call this method. | 326 | "When applying change to a widget, call this method. |
| 326 | This method is called by the default widget-edit commands. | 327 | This method is called by the default widget-edit commands. |
| 327 | User made commands should also call this method when applying changes. | 328 | User made commands should also call this method when applying changes. |
| @@ -385,18 +386,18 @@ These groups are specified with the `:group' slot flag." | |||
| 385 | (make-local-variable 'eieio-cog) | 386 | (make-local-variable 'eieio-cog) |
| 386 | (setq eieio-cog g))) | 387 | (setq eieio-cog g))) |
| 387 | 388 | ||
| 388 | (defmethod eieio-custom-object-apply-reset ((obj eieio-default-superclass)) | 389 | (defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass)) |
| 389 | "Insert an Apply and Reset button into the object editor. | 390 | "Insert an Apply and Reset button into the object editor. |
| 390 | Argument OBJ is the object being customized." | 391 | Argument OBJ is the object being customized." |
| 391 | (widget-create 'push-button | 392 | (widget-create 'push-button |
| 392 | :notify (lambda (&rest ignore) | 393 | :notify (lambda (&rest _) |
| 393 | (widget-apply eieio-wo :value-get) | 394 | (widget-apply eieio-wo :value-get) |
| 394 | (eieio-done-customizing eieio-co) | 395 | (eieio-done-customizing eieio-co) |
| 395 | (bury-buffer)) | 396 | (bury-buffer)) |
| 396 | "Accept") | 397 | "Accept") |
| 397 | (widget-insert " ") | 398 | (widget-insert " ") |
| 398 | (widget-create 'push-button | 399 | (widget-create 'push-button |
| 399 | :notify (lambda (&rest ignore) | 400 | :notify (lambda (&rest _) |
| 400 | ;; I think the act of getting it sets | 401 | ;; I think the act of getting it sets |
| 401 | ;; its value through the get function. | 402 | ;; its value through the get function. |
| 402 | (message "Applying Changes...") | 403 | (message "Applying Changes...") |
| @@ -406,13 +407,13 @@ Argument OBJ is the object being customized." | |||
| 406 | "Apply") | 407 | "Apply") |
| 407 | (widget-insert " ") | 408 | (widget-insert " ") |
| 408 | (widget-create 'push-button | 409 | (widget-create 'push-button |
| 409 | :notify (lambda (&rest ignore) | 410 | :notify (lambda (&rest _) |
| 410 | (message "Resetting") | 411 | (message "Resetting") |
| 411 | (eieio-customize-object eieio-co eieio-cog)) | 412 | (eieio-customize-object eieio-co eieio-cog)) |
| 412 | "Reset") | 413 | "Reset") |
| 413 | (widget-insert " ") | 414 | (widget-insert " ") |
| 414 | (widget-create 'push-button | 415 | (widget-create 'push-button |
| 415 | :notify (lambda (&rest ignore) | 416 | :notify (lambda (&rest _) |
| 416 | (bury-buffer)) | 417 | (bury-buffer)) |
| 417 | "Cancel")) | 418 | "Cancel")) |
| 418 | 419 | ||
| @@ -431,13 +432,11 @@ Must return the created widget." | |||
| 431 | :clone-object-children t | 432 | :clone-object-children t |
| 432 | ) | 433 | ) |
| 433 | 434 | ||
| 434 | (defun eieio-object-value-to-abstract (widget value) | 435 | (defun eieio-object-value-to-abstract (_widget value) |
| 435 | "For WIDGET, convert VALUE to an abstract /safe/ representation." | 436 | "For WIDGET, convert VALUE to an abstract /safe/ representation." |
| 436 | (if (eieio-object-p value) value | 437 | (if (eieio-object-p value) value)) |
| 437 | (if (null value) value | ||
| 438 | nil))) | ||
| 439 | 438 | ||
| 440 | (defun eieio-object-abstract-to-value (widget value) | 439 | (defun eieio-object-abstract-to-value (_widget value) |
| 441 | "For WIDGET, convert VALUE from an abstract /safe/ representation." | 440 | "For WIDGET, convert VALUE from an abstract /safe/ representation." |
| 442 | value) | 441 | value) |
| 443 | 442 | ||
| @@ -453,7 +452,7 @@ Must return the created widget." | |||
| 453 | (vector (concat "Group " (symbol-name group)) | 452 | (vector (concat "Group " (symbol-name group)) |
| 454 | (list 'customize-object obj (list 'quote group)) | 453 | (list 'customize-object obj (list 'quote group)) |
| 455 | t)) | 454 | t)) |
| 456 | (class-option (eieio--object-class obj) :custom-groups))) | 455 | (eieio--class-option (eieio--object-class-object obj) :custom-groups))) |
| 457 | 456 | ||
| 458 | (defvar eieio-read-custom-group-history nil | 457 | (defvar eieio-read-custom-group-history nil |
| 459 | "History for the custom group reader.") | 458 | "History for the custom group reader.") |
| @@ -461,7 +460,8 @@ Must return the created widget." | |||
| 461 | (defmethod eieio-read-customization-group ((obj eieio-default-superclass)) | 460 | (defmethod eieio-read-customization-group ((obj eieio-default-superclass)) |
| 462 | "Do a completing read on the name of a customization group in OBJ. | 461 | "Do a completing read on the name of a customization group in OBJ. |
| 463 | Return the symbol for the group, or nil" | 462 | Return the symbol for the group, or nil" |
| 464 | (let ((g (class-option (eieio--object-class obj) :custom-groups))) | 463 | (let ((g (eieio--class-option (eieio--object-class-object obj) |
| 464 | :custom-groups))) | ||
| 465 | (if (= (length g) 1) | 465 | (if (= (length g) 1) |
| 466 | (car g) | 466 | (car g) |
| 467 | ;; Make the association list | 467 | ;; Make the association list |
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 0a51ecfa203..43d9a03932a 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. | 1 | ;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007-2015 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007-2015 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -87,7 +87,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." | |||
| 87 | prefix | 87 | prefix |
| 88 | "Name: ") | 88 | "Name: ") |
| 89 | (let* ((cl (eieio-object-class obj)) | 89 | (let* ((cl (eieio-object-class obj)) |
| 90 | (cv (class-v cl))) | 90 | (cv (eieio--class-v cl))) |
| 91 | (data-debug-insert-thing (class-constructor cl) | 91 | (data-debug-insert-thing (class-constructor cl) |
| 92 | prefix | 92 | prefix |
| 93 | "Class: ") | 93 | "Class: ") |
| @@ -96,7 +96,8 @@ PREBUTTONTEXT is some text between PREFIX and the object button." | |||
| 96 | ) | 96 | ) |
| 97 | (while publa | 97 | (while publa |
| 98 | (if (slot-boundp obj (car publa)) | 98 | (if (slot-boundp obj (car publa)) |
| 99 | (let* ((i (class-slot-initarg cl (car publa))) | 99 | (let* ((i (eieio--class-slot-initarg (eieio--class-v cl) |
| 100 | (car publa))) | ||
| 100 | (v (eieio-oref obj (car publa)))) | 101 | (v (eieio-oref obj (car publa)))) |
| 101 | (data-debug-insert-thing | 102 | (data-debug-insert-thing |
| 102 | v prefix (concat | 103 | v prefix (concat |
| @@ -104,7 +105,8 @@ PREBUTTONTEXT is some text between PREFIX and the object button." | |||
| 104 | (symbol-name (car publa))) | 105 | (symbol-name (car publa))) |
| 105 | " "))) | 106 | " "))) |
| 106 | ;; Unbound case | 107 | ;; Unbound case |
| 107 | (let ((i (class-slot-initarg cl (car publa)))) | 108 | (let ((i (eieio--class-slot-initarg (eieio--class-v cl) |
| 109 | (car publa)))) | ||
| 108 | (data-debug-insert-custom | 110 | (data-debug-insert-custom |
| 109 | "#unbound" prefix | 111 | "#unbound" prefix |
| 110 | (concat (if i (symbol-name i) | 112 | (concat (if i (symbol-name i) |
| @@ -135,9 +137,9 @@ PREBUTTONTEXT is some text between PREFIX and the object button." | |||
| 135 | (let* ((eieio-pre-method-execution-functions | 137 | (let* ((eieio-pre-method-execution-functions |
| 136 | (lambda (l) (throw 'moose l) )) | 138 | (lambda (l) (throw 'moose l) )) |
| 137 | (data | 139 | (data |
| 138 | (catch 'moose (eieio-generic-call | 140 | (catch 'moose (eieio--generic-call |
| 139 | method (list class)))) | 141 | method (list class)))) |
| 140 | (buf (data-debug-new-buffer "*Method Invocation*")) | 142 | (_buf (data-debug-new-buffer "*Method Invocation*")) |
| 141 | (data2 (mapcar (lambda (sym) | 143 | (data2 (mapcar (lambda (sym) |
| 142 | (symbol-function (car sym))) | 144 | (symbol-function (car sym))) |
| 143 | data))) | 145 | data))) |
diff --git a/lisp/emacs-lisp/eieio-generic.el b/lisp/emacs-lisp/eieio-generic.el new file mode 100644 index 00000000000..0e90074660e --- /dev/null +++ b/lisp/emacs-lisp/eieio-generic.el | |||
| @@ -0,0 +1,904 @@ | |||
| 1 | ;;; eieio-generic.el --- CLOS-style generics for EIEIO -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | ||
| 6 | ;; Keywords: OO, lisp | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | ;; | ||
| 25 | ;; The "core" part of EIEIO is the implementation for the object | ||
| 26 | ;; system (such as eieio-defclass, or eieio-defmethod) but not the | ||
| 27 | ;; base classes for the object system, which are defined in EIEIO. | ||
| 28 | ;; | ||
| 29 | ;; See the commentary for eieio.el for more about EIEIO itself. | ||
| 30 | |||
| 31 | ;;; Code: | ||
| 32 | |||
| 33 | (require 'eieio-core) | ||
| 34 | (declare-function child-of-class-p "eieio") | ||
| 35 | |||
| 36 | (defconst eieio--method-static 0 "Index into :static tag on a method.") | ||
| 37 | (defconst eieio--method-before 1 "Index into :before tag on a method.") | ||
| 38 | (defconst eieio--method-primary 2 "Index into :primary tag on a method.") | ||
| 39 | (defconst eieio--method-after 3 "Index into :after tag on a method.") | ||
| 40 | (defconst eieio--method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.") | ||
| 41 | (defconst eieio--method-generic-before 4 "Index into generic :before tag on a method.") | ||
| 42 | (defconst eieio--method-generic-primary 5 "Index into generic :primary tag on a method.") | ||
| 43 | (defconst eieio--method-generic-after 6 "Index into generic :after tag on a method.") | ||
| 44 | (defconst eieio--method-num-slots 7 "Number of indexes into a method's vector.") | ||
| 45 | |||
| 46 | (defsubst eieio--specialized-key-to-generic-key (key) | ||
| 47 | "Convert a specialized KEY into a generic method key." | ||
| 48 | (cond ((eq key eieio--method-static) 0) ;; don't convert | ||
| 49 | ((< key eieio--method-num-lists) (+ key 3)) ;; The conversion | ||
| 50 | (t key) ;; already generic.. maybe. | ||
| 51 | )) | ||
| 52 | |||
| 53 | |||
| 54 | (defsubst generic-p (method) | ||
| 55 | "Return non-nil if symbol METHOD is a generic function. | ||
| 56 | Only methods have the symbol `eieio-method-hashtable' as a property | ||
| 57 | \(which contains a list of all bindings to that method type.)" | ||
| 58 | (and (fboundp method) (get method 'eieio-method-hashtable))) | ||
| 59 | |||
| 60 | (defun eieio--generic-primary-only-p (method) | ||
| 61 | "Return t if symbol METHOD is a generic function with only primary methods. | ||
| 62 | Only methods have the symbol `eieio-method-hashtable' as a property (which | ||
| 63 | contains a list of all bindings to that method type.) | ||
| 64 | Methods with only primary implementations are executed in an optimized way." | ||
| 65 | (and (generic-p method) | ||
| 66 | (let ((M (get method 'eieio-method-tree))) | ||
| 67 | (not (or (>= 0 (length (aref M eieio--method-primary))) | ||
| 68 | (aref M eieio--method-static) | ||
| 69 | (aref M eieio--method-before) | ||
| 70 | (aref M eieio--method-after) | ||
| 71 | (aref M eieio--method-generic-before) | ||
| 72 | (aref M eieio--method-generic-primary) | ||
| 73 | (aref M eieio--method-generic-after))) | ||
| 74 | ))) | ||
| 75 | |||
| 76 | (defun eieio--generic-primary-only-one-p (method) | ||
| 77 | "Return t if symbol METHOD is a generic function with only primary methods. | ||
| 78 | Only methods have the symbol `eieio-method-hashtable' as a property (which | ||
| 79 | contains a list of all bindings to that method type.) | ||
| 80 | Methods with only primary implementations are executed in an optimized way." | ||
| 81 | (and (generic-p method) | ||
| 82 | (let ((M (get method 'eieio-method-tree))) | ||
| 83 | (not (or (/= 1 (length (aref M eieio--method-primary))) | ||
| 84 | (aref M eieio--method-static) | ||
| 85 | (aref M eieio--method-before) | ||
| 86 | (aref M eieio--method-after) | ||
| 87 | (aref M eieio--method-generic-before) | ||
| 88 | (aref M eieio--method-generic-primary) | ||
| 89 | (aref M eieio--method-generic-after))) | ||
| 90 | ))) | ||
| 91 | |||
| 92 | (defun eieio--defgeneric-init-form (method doc-string) | ||
| 93 | "Form to use for the initial definition of a generic." | ||
| 94 | (while (and (fboundp method) (symbolp (symbol-function method))) | ||
| 95 | ;; Follow aliases, so methods applied to obsolete aliases still work. | ||
| 96 | (setq method (symbol-function method))) | ||
| 97 | |||
| 98 | (cond | ||
| 99 | ((or (not (fboundp method)) | ||
| 100 | (eq 'autoload (car-safe (symbol-function method)))) | ||
| 101 | ;; Make sure the method tables are installed. | ||
| 102 | (eieio--mt-install method) | ||
| 103 | ;; Construct the actual body of this function. | ||
| 104 | (put method 'function-documentation doc-string) | ||
| 105 | (eieio--defgeneric-form method)) | ||
| 106 | ((generic-p method) (symbol-function method)) ;Leave it as-is. | ||
| 107 | (t (error "You cannot create a generic/method over an existing symbol: %s" | ||
| 108 | method)))) | ||
| 109 | |||
| 110 | (defun eieio--defgeneric-form (method) | ||
| 111 | "The lambda form that would be used as the function defined on METHOD. | ||
| 112 | All methods should call the same EIEIO function for dispatch. | ||
| 113 | DOC-STRING is the documentation attached to METHOD." | ||
| 114 | (lambda (&rest local-args) | ||
| 115 | (eieio--generic-call method local-args))) | ||
| 116 | |||
| 117 | (defun eieio--defgeneric-form-primary-only (method) | ||
| 118 | "The lambda form that would be used as the function defined on METHOD. | ||
| 119 | All methods should call the same EIEIO function for dispatch. | ||
| 120 | DOC-STRING is the documentation attached to METHOD." | ||
| 121 | (lambda (&rest local-args) | ||
| 122 | (eieio--generic-call-primary-only method local-args))) | ||
| 123 | |||
| 124 | (defvar eieio--generic-call-arglst nil | ||
| 125 | "When using `call-next-method', provides a context for parameters.") | ||
| 126 | (defvar eieio--generic-call-key nil | ||
| 127 | "When using `call-next-method', provides a context for the current key. | ||
| 128 | Keys are a number representing :before, :primary, and :after methods.") | ||
| 129 | (defvar eieio--generic-call-next-method-list nil | ||
| 130 | "When executing a PRIMARY or STATIC method, track the 'next-method'. | ||
| 131 | During executions, the list is first generated, then as each next method | ||
| 132 | is called, the next method is popped off the stack.") | ||
| 133 | |||
| 134 | (defun eieio--defgeneric-form-primary-only-one (method class impl) | ||
| 135 | "The lambda form that would be used as the function defined on METHOD. | ||
| 136 | All methods should call the same EIEIO function for dispatch. | ||
| 137 | CLASS is the class symbol needed for private method access. | ||
| 138 | IMPL is the symbol holding the method implementation." | ||
| 139 | (lambda (&rest local-args) | ||
| 140 | ;; This is a cool cheat. Usually we need to look up in the | ||
| 141 | ;; method table to find out if there is a method or not. We can | ||
| 142 | ;; instead make that determination at load time when there is | ||
| 143 | ;; only one method. If the first arg is not a child of the class | ||
| 144 | ;; of that one implementation, then clearly, there is no method def. | ||
| 145 | (if (not (eieio-object-p (car local-args))) | ||
| 146 | ;; Not an object. Just signal. | ||
| 147 | (signal 'no-method-definition | ||
| 148 | (list method local-args)) | ||
| 149 | |||
| 150 | ;; We do have an object. Make sure it is the right type. | ||
| 151 | (if (not (child-of-class-p (eieio--object-class-object (car local-args)) | ||
| 152 | class)) | ||
| 153 | |||
| 154 | ;; If not the right kind of object, call no applicable | ||
| 155 | (apply #'no-applicable-method (car local-args) | ||
| 156 | method local-args) | ||
| 157 | |||
| 158 | ;; It is ok, do the call. | ||
| 159 | ;; Fill in inter-call variables then evaluate the method. | ||
| 160 | (let ((eieio--generic-call-next-method-list nil) | ||
| 161 | (eieio--generic-call-key eieio--method-primary) | ||
| 162 | (eieio--generic-call-arglst local-args) | ||
| 163 | ) | ||
| 164 | (eieio--with-scoped-class (eieio--class-v class) | ||
| 165 | (apply impl local-args))))))) | ||
| 166 | |||
| 167 | (defun eieio-unbind-method-implementations (method) | ||
| 168 | "Make the generic method METHOD have no implementations. | ||
| 169 | It will leave the original generic function in place, | ||
| 170 | but remove reference to all implementations of METHOD." | ||
| 171 | (put method 'eieio-method-tree nil) | ||
| 172 | (put method 'eieio-method-hashtable nil)) | ||
| 173 | |||
| 174 | (defun eieio--method-optimize-primary (method) | ||
| 175 | (when eieio-optimize-primary-methods-flag | ||
| 176 | ;; Optimizing step: | ||
| 177 | ;; | ||
| 178 | ;; If this method, after this setup, only has primary methods, then | ||
| 179 | ;; we can setup the generic that way. | ||
| 180 | (let ((doc-string (documentation method 'raw))) | ||
| 181 | (put method 'function-documentation doc-string) | ||
| 182 | ;; Use `defalias' so as to interact properly with nadvice.el. | ||
| 183 | (defalias method | ||
| 184 | (if (eieio--generic-primary-only-p method) | ||
| 185 | ;; If there is only one primary method, then we can go one more | ||
| 186 | ;; optimization step. | ||
| 187 | (if (eieio--generic-primary-only-one-p method) | ||
| 188 | (let* ((M (get method 'eieio-method-tree)) | ||
| 189 | (entry (car (aref M eieio--method-primary)))) | ||
| 190 | (eieio--defgeneric-form-primary-only-one | ||
| 191 | method (car entry) (cdr entry))) | ||
| 192 | (eieio--defgeneric-form-primary-only method)) | ||
| 193 | (eieio--defgeneric-form method)))))) | ||
| 194 | |||
| 195 | (defun eieio--defmethod (method kind argclass code) | ||
| 196 | "Work part of the `defmethod' macro defining METHOD with ARGS." | ||
| 197 | (let ((key | ||
| 198 | ;; Find optional keys. | ||
| 199 | (cond ((memq kind '(:BEFORE :before)) eieio--method-before) | ||
| 200 | ((memq kind '(:AFTER :after)) eieio--method-after) | ||
| 201 | ((memq kind '(:STATIC :static)) eieio--method-static) | ||
| 202 | ((memq kind '(:PRIMARY :primary nil)) eieio--method-primary) | ||
| 203 | ;; Primary key. | ||
| 204 | ;; (t eieio--method-primary) | ||
| 205 | (t (error "Unknown method kind %S" kind))))) | ||
| 206 | |||
| 207 | (while (and (fboundp method) (symbolp (symbol-function method))) | ||
| 208 | ;; Follow aliases, so methods applied to obsolete aliases still work. | ||
| 209 | (setq method (symbol-function method))) | ||
| 210 | |||
| 211 | ;; Make sure there is a generic (when called from defclass). | ||
| 212 | (eieio--defalias | ||
| 213 | method (eieio--defgeneric-init-form | ||
| 214 | method (or (documentation code) | ||
| 215 | (format "Generically created method `%s'." method)))) | ||
| 216 | ;; Create symbol for property to bind to. If the first arg is of | ||
| 217 | ;; the form (varname vartype) and `vartype' is a class, then | ||
| 218 | ;; that class will be the type symbol. If not, then it will fall | ||
| 219 | ;; under the type `primary' which is a non-specific calling of the | ||
| 220 | ;; function. | ||
| 221 | (if argclass | ||
| 222 | (if (not (class-p argclass)) ;FIXME: Accept cl-defstructs! | ||
| 223 | (error "Unknown class type %s in method parameters" | ||
| 224 | argclass)) | ||
| 225 | ;; Generics are higher. | ||
| 226 | (setq key (eieio--specialized-key-to-generic-key key))) | ||
| 227 | ;; Put this lambda into the symbol so we can find it. | ||
| 228 | (eieio--mt-add method code key argclass) | ||
| 229 | ) | ||
| 230 | |||
| 231 | (eieio--method-optimize-primary method) | ||
| 232 | |||
| 233 | method) | ||
| 234 | |||
| 235 | (define-obsolete-variable-alias 'eieio-pre-method-execution-hooks | ||
| 236 | 'eieio-pre-method-execution-functions "24.3") | ||
| 237 | (defvar eieio-pre-method-execution-functions nil | ||
| 238 | "Abnormal hook run just before an EIEIO method is executed. | ||
| 239 | The hook function must accept one argument, the list of forms | ||
| 240 | about to be executed.") | ||
| 241 | |||
| 242 | (defun eieio--generic-call (method args) | ||
| 243 | "Call METHOD with ARGS. | ||
| 244 | ARGS provides the context on which implementation to use. | ||
| 245 | This should only be called from a generic function." | ||
| 246 | ;; We must expand our arguments first as they are always | ||
| 247 | ;; passed in as quoted symbols | ||
| 248 | (let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil) | ||
| 249 | (eieio--generic-call-arglst args) | ||
| 250 | (firstarg nil) | ||
| 251 | (primarymethodlist nil)) | ||
| 252 | ;; get a copy | ||
| 253 | (setq newargs args | ||
| 254 | firstarg (car newargs)) | ||
| 255 | ;; Is the class passed in autoloaded? | ||
| 256 | ;; Since class names are also constructors, they can be autoloaded | ||
| 257 | ;; via the autoload command. Check for this, and load them in. | ||
| 258 | ;; It is ok if it doesn't turn out to be a class. Probably want that | ||
| 259 | ;; function loaded anyway. | ||
| 260 | (if (and (symbolp firstarg) | ||
| 261 | (fboundp firstarg) | ||
| 262 | (autoloadp (symbol-function firstarg))) | ||
| 263 | (autoload-do-load (symbol-function firstarg))) | ||
| 264 | ;; Determine the class to use. | ||
| 265 | (cond ((eieio-object-p firstarg) | ||
| 266 | (setq mclass (eieio--object-class-name firstarg))) | ||
| 267 | ((class-p firstarg) | ||
| 268 | (setq mclass firstarg)) | ||
| 269 | ) | ||
| 270 | ;; Make sure the class is a valid class | ||
| 271 | ;; mclass can be nil (meaning a generic for should be used. | ||
| 272 | ;; mclass cannot have a value that is not a class, however. | ||
| 273 | (unless (or (null mclass) (class-p mclass)) | ||
| 274 | (error "Cannot dispatch method %S on class %S" | ||
| 275 | method mclass) | ||
| 276 | ) | ||
| 277 | ;; Now create a list in reverse order of all the calls we have | ||
| 278 | ;; make in order to successfully do this right. Rules: | ||
| 279 | ;; 1) Only call generics if scoped-class is not defined | ||
| 280 | ;; This prevents multiple calls in the case of recursion | ||
| 281 | ;; 2) Only call static if this is a static method. | ||
| 282 | ;; 3) Only call specifics if the definition allows for them. | ||
| 283 | ;; 4) Call in order based on :before, :primary, and :after | ||
| 284 | (when (eieio-object-p firstarg) | ||
| 285 | ;; Non-static calls do all this stuff. | ||
| 286 | |||
| 287 | ;; :after methods | ||
| 288 | (setq tlambdas | ||
| 289 | (if mclass | ||
| 290 | (eieio--mt-method-list method eieio--method-after mclass) | ||
| 291 | (list (eieio--generic-form method eieio--method-after nil))) | ||
| 292 | ;;(or (and mclass (eieio--generic-form method eieio--method-after mclass)) | ||
| 293 | ;; (eieio--generic-form method eieio--method-after nil)) | ||
| 294 | ) | ||
| 295 | (setq lambdas (append tlambdas lambdas) | ||
| 296 | keys (append (make-list (length tlambdas) eieio--method-after) keys)) | ||
| 297 | |||
| 298 | ;; :primary methods | ||
| 299 | (setq tlambdas | ||
| 300 | (or (and mclass (eieio--generic-form method eieio--method-primary mclass)) | ||
| 301 | (eieio--generic-form method eieio--method-primary nil))) | ||
| 302 | (when tlambdas | ||
| 303 | (setq lambdas (cons tlambdas lambdas) | ||
| 304 | keys (cons eieio--method-primary keys) | ||
| 305 | primarymethodlist | ||
| 306 | (eieio--mt-method-list method eieio--method-primary mclass))) | ||
| 307 | |||
| 308 | ;; :before methods | ||
| 309 | (setq tlambdas | ||
| 310 | (if mclass | ||
| 311 | (eieio--mt-method-list method eieio--method-before mclass) | ||
| 312 | (list (eieio--generic-form method eieio--method-before nil))) | ||
| 313 | ;;(or (and mclass (eieio--generic-form method eieio--method-before mclass)) | ||
| 314 | ;; (eieio--generic-form method eieio--method-before nil)) | ||
| 315 | ) | ||
| 316 | (setq lambdas (append tlambdas lambdas) | ||
| 317 | keys (append (make-list (length tlambdas) eieio--method-before) keys)) | ||
| 318 | ) | ||
| 319 | |||
| 320 | (if mclass | ||
| 321 | ;; For the case of a class, | ||
| 322 | ;; if there were no methods found, then there could be :static methods. | ||
| 323 | (when (not lambdas) | ||
| 324 | (setq tlambdas | ||
| 325 | (eieio--generic-form method eieio--method-static mclass)) | ||
| 326 | (setq lambdas (cons tlambdas lambdas) | ||
| 327 | keys (cons eieio--method-static keys) | ||
| 328 | primarymethodlist ;; Re-use even with bad name here | ||
| 329 | (eieio--mt-method-list method eieio--method-static mclass))) | ||
| 330 | ;; For the case of no class (ie - mclass == nil) then there may | ||
| 331 | ;; be a primary method. | ||
| 332 | (setq tlambdas | ||
| 333 | (eieio--generic-form method eieio--method-primary nil)) | ||
| 334 | (when tlambdas | ||
| 335 | (setq lambdas (cons tlambdas lambdas) | ||
| 336 | keys (cons eieio--method-primary keys) | ||
| 337 | primarymethodlist | ||
| 338 | (eieio--mt-method-list method eieio--method-primary nil))) | ||
| 339 | ) | ||
| 340 | |||
| 341 | (run-hook-with-args 'eieio-pre-method-execution-functions | ||
| 342 | primarymethodlist) | ||
| 343 | |||
| 344 | ;; Now loop through all occurrences forms which we must execute | ||
| 345 | ;; (which are happily sorted now) and execute them all! | ||
| 346 | (let ((rval nil) (lastval nil) (found nil)) | ||
| 347 | (while lambdas | ||
| 348 | (if (car lambdas) | ||
| 349 | (eieio--with-scoped-class (cdr (car lambdas)) | ||
| 350 | (let* ((eieio--generic-call-key (car keys)) | ||
| 351 | (has-return-val | ||
| 352 | (or (= eieio--generic-call-key eieio--method-primary) | ||
| 353 | (= eieio--generic-call-key eieio--method-static))) | ||
| 354 | (eieio--generic-call-next-method-list | ||
| 355 | ;; Use the cdr, as the first element is the fcn | ||
| 356 | ;; we are calling right now. | ||
| 357 | (when has-return-val (cdr primarymethodlist))) | ||
| 358 | ) | ||
| 359 | (setq found t) | ||
| 360 | ;;(setq rval (apply (car (car lambdas)) newargs)) | ||
| 361 | (setq lastval (apply (car (car lambdas)) newargs)) | ||
| 362 | (when has-return-val | ||
| 363 | (setq rval lastval)) | ||
| 364 | ))) | ||
| 365 | (setq lambdas (cdr lambdas) | ||
| 366 | keys (cdr keys))) | ||
| 367 | (if (not found) | ||
| 368 | (if (eieio-object-p (car args)) | ||
| 369 | (setq rval (apply #'no-applicable-method (car args) method args)) | ||
| 370 | (signal | ||
| 371 | 'no-method-definition | ||
| 372 | (list method args)))) | ||
| 373 | rval))) | ||
| 374 | |||
| 375 | (defun eieio--generic-call-primary-only (method args) | ||
| 376 | "Call METHOD with ARGS for methods with only :PRIMARY implementations. | ||
| 377 | ARGS provides the context on which implementation to use. | ||
| 378 | This should only be called from a generic function. | ||
| 379 | |||
| 380 | This method is like `eieio--generic-call', but only | ||
| 381 | implementations in the :PRIMARY slot are queried. After many | ||
| 382 | years of use, it appears that over 90% of methods in use | ||
| 383 | have :PRIMARY implementations only. We can therefore optimize | ||
| 384 | for this common case to improve performance." | ||
| 385 | ;; We must expand our arguments first as they are always | ||
| 386 | ;; passed in as quoted symbols | ||
| 387 | (let ((newargs nil) (mclass nil) (lambdas nil) | ||
| 388 | (eieio--generic-call-arglst args) | ||
| 389 | (firstarg nil) | ||
| 390 | (primarymethodlist nil) | ||
| 391 | ) | ||
| 392 | ;; get a copy | ||
| 393 | (setq newargs args | ||
| 394 | firstarg (car newargs)) | ||
| 395 | |||
| 396 | ;; Determine the class to use. | ||
| 397 | (cond ((eieio-object-p firstarg) | ||
| 398 | (setq mclass (eieio--object-class-name firstarg))) | ||
| 399 | ((not firstarg) | ||
| 400 | (error "Method %s called on nil" method)) | ||
| 401 | (t | ||
| 402 | (error "Primary-only method %s called on something not an object" method))) | ||
| 403 | ;; Make sure the class is a valid class | ||
| 404 | ;; mclass can be nil (meaning a generic for should be used. | ||
| 405 | ;; mclass cannot have a value that is not a class, however. | ||
| 406 | (when (null mclass) | ||
| 407 | (error "Cannot dispatch method %S on class %S" method mclass) | ||
| 408 | ) | ||
| 409 | |||
| 410 | ;; :primary methods | ||
| 411 | (setq lambdas (eieio--generic-form method eieio--method-primary mclass)) | ||
| 412 | (setq primarymethodlist ;; Re-use even with bad name here | ||
| 413 | (eieio--mt-method-list method eieio--method-primary mclass)) | ||
| 414 | |||
| 415 | ;; Now loop through all occurrences forms which we must execute | ||
| 416 | ;; (which are happily sorted now) and execute them all! | ||
| 417 | (eieio--with-scoped-class (cdr lambdas) | ||
| 418 | (let* ((rval nil) (lastval nil) | ||
| 419 | (eieio--generic-call-key eieio--method-primary) | ||
| 420 | ;; Use the cdr, as the first element is the fcn | ||
| 421 | ;; we are calling right now. | ||
| 422 | (eieio--generic-call-next-method-list (cdr primarymethodlist)) | ||
| 423 | ) | ||
| 424 | |||
| 425 | (if (or (not lambdas) (not (car lambdas))) | ||
| 426 | |||
| 427 | ;; No methods found for this impl... | ||
| 428 | (if (eieio-object-p (car args)) | ||
| 429 | (setq rval (apply #'no-applicable-method | ||
| 430 | (car args) method args)) | ||
| 431 | (signal | ||
| 432 | 'no-method-definition | ||
| 433 | (list method args))) | ||
| 434 | |||
| 435 | ;; Do the regular implementation here. | ||
| 436 | |||
| 437 | (run-hook-with-args 'eieio-pre-method-execution-functions | ||
| 438 | lambdas) | ||
| 439 | |||
| 440 | (setq lastval (apply (car lambdas) newargs)) | ||
| 441 | (setq rval lastval)) | ||
| 442 | |||
| 443 | rval)))) | ||
| 444 | |||
| 445 | (defun eieio--mt-method-list (method key class) | ||
| 446 | "Return an alist list of methods lambdas. | ||
| 447 | METHOD is the method name. | ||
| 448 | KEY represents either :before, or :after methods. | ||
| 449 | CLASS is the starting class to search from in the method tree. | ||
| 450 | If CLASS is nil, then an empty list of methods should be returned." | ||
| 451 | ;; Note: eieiomt - the MT means MethodTree. See more comments below | ||
| 452 | ;; for the rest of the eieiomt methods. | ||
| 453 | |||
| 454 | ;; Collect lambda expressions stored for the class and its parent | ||
| 455 | ;; classes. | ||
| 456 | (let (lambdas) | ||
| 457 | (dolist (ancestor (eieio--class-precedence-list (eieio--class-v class))) | ||
| 458 | ;; Lookup the form to use for the PRIMARY object for the next level | ||
| 459 | (let ((tmpl (eieio--generic-form method key ancestor))) | ||
| 460 | (when (and tmpl | ||
| 461 | (or (not lambdas) | ||
| 462 | ;; This prevents duplicates coming out of the | ||
| 463 | ;; class method optimizer. Perhaps we should | ||
| 464 | ;; just not optimize before/afters? | ||
| 465 | (not (member tmpl lambdas)))) | ||
| 466 | (push tmpl lambdas)))) | ||
| 467 | |||
| 468 | ;; Return collected lambda. For :after methods, return in current | ||
| 469 | ;; order (most general class last); Otherwise, reverse order. | ||
| 470 | (if (eq key eieio--method-after) | ||
| 471 | lambdas | ||
| 472 | (nreverse lambdas)))) | ||
| 473 | |||
| 474 | |||
| 475 | ;;; | ||
| 476 | ;; eieio-method-tree : eieio--mt- | ||
| 477 | ;; | ||
| 478 | ;; Stored as eieio-method-tree in property list of a generic method | ||
| 479 | ;; | ||
| 480 | ;; (eieio-method-tree . [BEFORE PRIMARY AFTER | ||
| 481 | ;; genericBEFORE genericPRIMARY genericAFTER]) | ||
| 482 | ;; and | ||
| 483 | ;; (eieio-method-hashtable . [BEFORE PRIMARY AFTER | ||
| 484 | ;; genericBEFORE genericPRIMARY genericAFTER]) | ||
| 485 | ;; where the association is a vector. | ||
| 486 | ;; (aref 0 -- all static methods. | ||
| 487 | ;; (aref 1 -- all methods classified as :before | ||
| 488 | ;; (aref 2 -- all methods classified as :primary | ||
| 489 | ;; (aref 3 -- all methods classified as :after | ||
| 490 | ;; (aref 4 -- a generic classified as :before | ||
| 491 | ;; (aref 5 -- a generic classified as :primary | ||
| 492 | ;; (aref 6 -- a generic classified as :after | ||
| 493 | ;; | ||
| 494 | (defvar eieio--mt--optimizing-hashtable nil | ||
| 495 | "While mapping atoms, this contain the hashtable being optimized.") | ||
| 496 | |||
| 497 | (defun eieio--mt-install (method-name) | ||
| 498 | "Install the method tree, and hashtable onto METHOD-NAME. | ||
| 499 | Do not do the work if they already exist." | ||
| 500 | (unless (and (get method-name 'eieio-method-tree) | ||
| 501 | (get method-name 'eieio-method-hashtable)) | ||
| 502 | (put method-name 'eieio-method-tree | ||
| 503 | (make-vector eieio--method-num-slots nil)) | ||
| 504 | (let ((emto (put method-name 'eieio-method-hashtable | ||
| 505 | (make-vector eieio--method-num-slots nil)))) | ||
| 506 | (aset emto 0 (make-hash-table :test 'eq)) | ||
| 507 | (aset emto 1 (make-hash-table :test 'eq)) | ||
| 508 | (aset emto 2 (make-hash-table :test 'eq)) | ||
| 509 | (aset emto 3 (make-hash-table :test 'eq))))) | ||
| 510 | |||
| 511 | (defun eieio--mt-add (method-name method key class) | ||
| 512 | "Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS. | ||
| 513 | METHOD-NAME is the name created by a call to `defgeneric'. | ||
| 514 | METHOD are the forms for a given implementation. | ||
| 515 | KEY is an integer (see comment in eieio.el near this function) which | ||
| 516 | is associated with the :static :before :primary and :after tags. | ||
| 517 | It also indicates if CLASS is defined or not. | ||
| 518 | CLASS is the class this method is associated with." | ||
| 519 | (if (or (> key eieio--method-num-slots) (< key 0)) | ||
| 520 | (error "eieio--mt-add: method key error!")) | ||
| 521 | (let ((emtv (get method-name 'eieio-method-tree)) | ||
| 522 | (emto (get method-name 'eieio-method-hashtable))) | ||
| 523 | ;; Make sure the method tables are available. | ||
| 524 | (unless (and emtv emto) | ||
| 525 | (error "Programmer error: eieio--mt-add")) | ||
| 526 | ;; only add new cells on if it doesn't already exist! | ||
| 527 | (if (assq class (aref emtv key)) | ||
| 528 | (setcdr (assq class (aref emtv key)) method) | ||
| 529 | (aset emtv key (cons (cons class method) (aref emtv key)))) | ||
| 530 | ;; Add function definition into newly created symbol, and store | ||
| 531 | ;; said symbol in the correct hashtable, otherwise use the | ||
| 532 | ;; other array to keep this stuff. | ||
| 533 | (if (< key eieio--method-num-lists) | ||
| 534 | (puthash (eieio--class-v class) (list method) (aref emto key))) | ||
| 535 | ;; Save the defmethod file location in a symbol property. | ||
| 536 | (let ((fname (if load-in-progress | ||
| 537 | load-file-name | ||
| 538 | buffer-file-name))) | ||
| 539 | (when fname | ||
| 540 | (when (string-match "\\.elc\\'" fname) | ||
| 541 | (setq fname (substring fname 0 (1- (length fname))))) | ||
| 542 | (cl-pushnew (list class fname) (get method-name 'method-locations) | ||
| 543 | :test 'equal))) | ||
| 544 | ;; Now optimize the entire hashtable. | ||
| 545 | (if (< key eieio--method-num-lists) | ||
| 546 | (let ((eieio--mt--optimizing-hashtable (aref emto key))) | ||
| 547 | ;; @todo - Is this overkill? Should we just clear the symbol? | ||
| 548 | (maphash #'eieio--mt--sym-optimize eieio--mt--optimizing-hashtable))) | ||
| 549 | )) | ||
| 550 | |||
| 551 | (defun eieio--mt-next (class) | ||
| 552 | "Return the next parent class for CLASS. | ||
| 553 | If CLASS is a superclass, return variable `eieio-default-superclass'. | ||
| 554 | If CLASS is variable `eieio-default-superclass' then return nil. | ||
| 555 | This is different from function `class-parent' as class parent returns | ||
| 556 | nil for superclasses. This function performs no type checking!" | ||
| 557 | ;; No type-checking because all calls are made from functions which | ||
| 558 | ;; are safe and do checking for us. | ||
| 559 | (or (eieio--class-parent (eieio--class-v class)) | ||
| 560 | (if (eq class 'eieio-default-superclass) | ||
| 561 | nil | ||
| 562 | '(eieio-default-superclass)))) | ||
| 563 | |||
| 564 | (defun eieio--mt--sym-optimize (class s) | ||
| 565 | "Find the next class above S which has a function body for the optimizer." | ||
| 566 | ;; Set the value to nil in case there is no nearest cell. | ||
| 567 | (setcdr s nil) | ||
| 568 | ;; Find the nearest cell that has a function body. If we find one, | ||
| 569 | ;; we replace the nil from above. | ||
| 570 | (catch 'done | ||
| 571 | (dolist (ancestor | ||
| 572 | (cl-rest (eieio--class-precedence-list class))) | ||
| 573 | (let ((ov (gethash ancestor eieio--mt--optimizing-hashtable))) | ||
| 574 | (when (car ov) | ||
| 575 | (setcdr s ancestor) ;; store ov as our next symbol | ||
| 576 | (throw 'done ancestor)))))) | ||
| 577 | |||
| 578 | (defun eieio--generic-form (method key class) | ||
| 579 | "Return the lambda form belonging to METHOD using KEY based upon CLASS. | ||
| 580 | If CLASS is not a class then use `generic' instead. If class has | ||
| 581 | no form, but has a parent class, then trace to that parent class. | ||
| 582 | The first time a form is requested from a symbol, an optimized path | ||
| 583 | is memorized for faster future use." | ||
| 584 | (if (symbolp class) (setq class (eieio--class-v class))) | ||
| 585 | (let ((emto (aref (get method 'eieio-method-hashtable) | ||
| 586 | (if class key (eieio--specialized-key-to-generic-key key))))) | ||
| 587 | (if (eieio--class-p class) | ||
| 588 | ;; 1) find our symbol | ||
| 589 | (let ((cs (gethash class emto))) | ||
| 590 | (unless cs | ||
| 591 | ;; 2) If there isn't one, then make one. | ||
| 592 | ;; This can be slow since it only occurs once | ||
| 593 | (puthash class (setq cs (list nil)) emto) | ||
| 594 | ;; 2.1) Cache its nearest neighbor with a quick optimize | ||
| 595 | ;; which should only occur once for this call ever | ||
| 596 | (let ((eieio--mt--optimizing-hashtable emto)) | ||
| 597 | (eieio--mt--sym-optimize class cs))) | ||
| 598 | ;; 3) If it's bound return this one. | ||
| 599 | (if (car cs) | ||
| 600 | (cons (car cs) class) | ||
| 601 | ;; 4) If it's not bound then this variable knows something | ||
| 602 | (if (cdr cs) | ||
| 603 | (progn | ||
| 604 | ;; 4.1) This symbol holds the next class in its value | ||
| 605 | (setq class (cdr cs) | ||
| 606 | cs (gethash class emto)) | ||
| 607 | ;; 4.2) The optimizer should always have chosen a | ||
| 608 | ;; function-symbol | ||
| 609 | ;;(if (car cs) | ||
| 610 | (cons (car cs) class) | ||
| 611 | ;;(error "EIEIO optimizer: erratic data loss!")) | ||
| 612 | ) | ||
| 613 | ;; There never will be a funcall... | ||
| 614 | nil))) | ||
| 615 | ;; for a generic call, what is a list, is the function body we want. | ||
| 616 | (let ((emtl (aref (get method 'eieio-method-tree) | ||
| 617 | (if class key (eieio--specialized-key-to-generic-key key))))) | ||
| 618 | (if emtl | ||
| 619 | ;; The car of EMTL is supposed to be a class, which in this | ||
| 620 | ;; case is nil, so skip it. | ||
| 621 | (cons (cdr (car emtl)) nil) | ||
| 622 | nil))))) | ||
| 623 | |||
| 624 | |||
| 625 | (define-error 'no-method-definition "No method definition") | ||
| 626 | (define-error 'no-next-method "No next method") | ||
| 627 | |||
| 628 | ;;; CLOS methods and generics | ||
| 629 | ;; | ||
| 630 | (defmacro defgeneric (method _args &optional doc-string) | ||
| 631 | "Create a generic function METHOD. | ||
| 632 | DOC-STRING is the base documentation for this class. A generic | ||
| 633 | function has no body, as its purpose is to decide which method body | ||
| 634 | is appropriate to use. Uses `defmethod' to create methods, and calls | ||
| 635 | `defgeneric' for you. With this implementation the ARGS are | ||
| 636 | currently ignored. You can use `defgeneric' to apply specialized | ||
| 637 | top level documentation to a method." | ||
| 638 | (declare (doc-string 3)) | ||
| 639 | `(eieio--defalias ',method | ||
| 640 | (eieio--defgeneric-init-form ',method ,doc-string))) | ||
| 641 | |||
| 642 | (defmacro defmethod (method &rest args) | ||
| 643 | "Create a new METHOD through `defgeneric' with ARGS. | ||
| 644 | |||
| 645 | The optional second argument KEY is a specifier that | ||
| 646 | modifies how the method is called, including: | ||
| 647 | :before - Method will be called before the :primary | ||
| 648 | :primary - The default if not specified | ||
| 649 | :after - Method will be called after the :primary | ||
| 650 | :static - First arg could be an object or class | ||
| 651 | The next argument is the ARGLIST. The ARGLIST specifies the arguments | ||
| 652 | to the method as with `defun'. The first argument can have a type | ||
| 653 | specifier, such as: | ||
| 654 | ((VARNAME CLASS) ARG2 ...) | ||
| 655 | where VARNAME is the name of the local variable for the method being | ||
| 656 | created. The CLASS is a class symbol for a class made with `defclass'. | ||
| 657 | A DOCSTRING comes after the ARGLIST, and is optional. | ||
| 658 | All the rest of the args are the BODY of the method. A method will | ||
| 659 | return the value of the last form in the BODY. | ||
| 660 | |||
| 661 | Summary: | ||
| 662 | |||
| 663 | (defmethod mymethod [:before | :primary | :after | :static] | ||
| 664 | ((typearg class-name) arg2 &optional opt &rest rest) | ||
| 665 | \"doc-string\" | ||
| 666 | body)" | ||
| 667 | (declare (doc-string 3) | ||
| 668 | (debug | ||
| 669 | (&define ; this means we are defining something | ||
| 670 | [&or name ("setf" :name setf name)] | ||
| 671 | ;; ^^ This is the methods symbol | ||
| 672 | [ &optional symbolp ] ; this is key :before etc | ||
| 673 | list ; arguments | ||
| 674 | [ &optional stringp ] ; documentation string | ||
| 675 | def-body ; part to be debugged | ||
| 676 | ))) | ||
| 677 | (let* ((key (if (keywordp (car args)) (pop args))) | ||
| 678 | (params (car args)) | ||
| 679 | (arg1 (car params)) | ||
| 680 | (fargs (if (consp arg1) | ||
| 681 | (cons (car arg1) (cdr params)) | ||
| 682 | params)) | ||
| 683 | (class (if (consp arg1) (nth 1 arg1))) | ||
| 684 | (code `(lambda ,fargs ,@(cdr args)))) | ||
| 685 | `(progn | ||
| 686 | ;; Make sure there is a generic and the byte-compiler sees it. | ||
| 687 | (defgeneric ,method ,args | ||
| 688 | ,(or (documentation code) | ||
| 689 | (format "Generically created method `%s'." method))) | ||
| 690 | (eieio--defmethod ',method ',key ',class #',code)))) | ||
| 691 | |||
| 692 | |||
| 693 | |||
| 694 | ;;; | ||
| 695 | ;; Method Calling Functions | ||
| 696 | |||
| 697 | (defun next-method-p () | ||
| 698 | "Return non-nil if there is a next method. | ||
| 699 | Returns a list of lambda expressions which is the `next-method' | ||
| 700 | order." | ||
| 701 | eieio--generic-call-next-method-list) | ||
| 702 | |||
| 703 | (defun call-next-method (&rest replacement-args) | ||
| 704 | "Call the superclass method from a subclass method. | ||
| 705 | The superclass method is specified in the current method list, | ||
| 706 | and is called the next method. | ||
| 707 | |||
| 708 | If REPLACEMENT-ARGS is non-nil, then use them instead of | ||
| 709 | `eieio--generic-call-arglst'. The generic arg list are the | ||
| 710 | arguments passed in at the top level. | ||
| 711 | |||
| 712 | Use `next-method-p' to find out if there is a next method to call." | ||
| 713 | (if (not (eieio--scoped-class)) | ||
| 714 | (error "`call-next-method' not called within a class specific method")) | ||
| 715 | (if (and (/= eieio--generic-call-key eieio--method-primary) | ||
| 716 | (/= eieio--generic-call-key eieio--method-static)) | ||
| 717 | (error "Cannot `call-next-method' except in :primary or :static methods") | ||
| 718 | ) | ||
| 719 | (let ((newargs (or replacement-args eieio--generic-call-arglst)) | ||
| 720 | (next (car eieio--generic-call-next-method-list)) | ||
| 721 | ) | ||
| 722 | (if (not (and next (car next))) | ||
| 723 | (apply #'no-next-method newargs) | ||
| 724 | (let* ((eieio--generic-call-next-method-list | ||
| 725 | (cdr eieio--generic-call-next-method-list)) | ||
| 726 | (eieio--generic-call-arglst newargs) | ||
| 727 | (fcn (car next)) | ||
| 728 | ) | ||
| 729 | (eieio--with-scoped-class (cdr next) | ||
| 730 | (apply fcn newargs)) )))) | ||
| 731 | |||
| 732 | (defgeneric no-applicable-method (object method &rest args) | ||
| 733 | "Called if there are no implementations for OBJECT in METHOD.") | ||
| 734 | |||
| 735 | (defmethod no-applicable-method (object method &rest _args) | ||
| 736 | "Called if there are no implementations for OBJECT in METHOD. | ||
| 737 | OBJECT is the object which has no method implementation. | ||
| 738 | ARGS are the arguments that were passed to METHOD. | ||
| 739 | |||
| 740 | Implement this for a class to block this signal. The return | ||
| 741 | value becomes the return value of the original method call." | ||
| 742 | (signal 'no-method-definition (list method object))) | ||
| 743 | |||
| 744 | (defgeneric no-next-method (object &rest args) | ||
| 745 | "Called from `call-next-method' when no additional methods are available.") | ||
| 746 | |||
| 747 | (defmethod no-next-method (object &rest args) | ||
| 748 | "Called from `call-next-method' when no additional methods are available. | ||
| 749 | OBJECT is othe object being called on `call-next-method'. | ||
| 750 | ARGS are the arguments it is called by. | ||
| 751 | This method signals `no-next-method' by default. Override this | ||
| 752 | method to not throw an error, and its return value becomes the | ||
| 753 | return value of `call-next-method'." | ||
| 754 | (signal 'no-next-method (list object args))) | ||
| 755 | |||
| 756 | (add-hook 'help-fns-describe-function-functions 'eieio--help-generic) | ||
| 757 | (defun eieio--help-generic (generic) | ||
| 758 | "Describe GENERIC if it is a generic function." | ||
| 759 | (when (and (symbolp generic) (generic-p generic)) | ||
| 760 | (save-excursion | ||
| 761 | (goto-char (point-min)) | ||
| 762 | (when (re-search-forward " in `.+'.$" nil t) | ||
| 763 | (replace-match "."))) | ||
| 764 | (save-excursion | ||
| 765 | (insert "\n\nThis is a generic function" | ||
| 766 | (cond | ||
| 767 | ((and (eieio--generic-primary-only-p generic) | ||
| 768 | (eieio--generic-primary-only-one-p generic)) | ||
| 769 | " with only one primary method") | ||
| 770 | ((eieio--generic-primary-only-p generic) | ||
| 771 | " with only primary methods") | ||
| 772 | (t "")) | ||
| 773 | ".\n\n") | ||
| 774 | (insert (propertize "Implementations:\n\n" 'face 'bold)) | ||
| 775 | (let ((i 4) | ||
| 776 | (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] )) | ||
| 777 | ;; Loop over fanciful generics | ||
| 778 | (while (< i 7) | ||
| 779 | (let ((gm (aref (get generic 'eieio-method-tree) i))) | ||
| 780 | (when gm | ||
| 781 | (insert "Generic " | ||
| 782 | (aref prefix (- i 3)) | ||
| 783 | "\n" | ||
| 784 | (or (nth 2 gm) "Undocumented") | ||
| 785 | "\n\n"))) | ||
| 786 | (setq i (1+ i))) | ||
| 787 | (setq i 0) | ||
| 788 | ;; Loop over defined class-specific methods | ||
| 789 | (while (< i 4) | ||
| 790 | (let* ((gm (reverse (aref (get generic 'eieio-method-tree) i))) | ||
| 791 | cname location) | ||
| 792 | (while gm | ||
| 793 | (setq cname (caar gm)) | ||
| 794 | (insert "`") | ||
| 795 | (help-insert-xref-button (symbol-name cname) | ||
| 796 | 'help-variable cname) | ||
| 797 | (insert "' " (aref prefix i) " ") | ||
| 798 | ;; argument list | ||
| 799 | (let* ((func (cdr (car gm))) | ||
| 800 | (arglst (help-function-arglist func))) | ||
| 801 | (prin1 arglst (current-buffer))) | ||
| 802 | (insert "\n" | ||
| 803 | (or (documentation (cdr (car gm))) | ||
| 804 | "Undocumented")) | ||
| 805 | ;; Print file location if available | ||
| 806 | (when (and (setq location (get generic 'method-locations)) | ||
| 807 | (setq location (assoc cname location))) | ||
| 808 | (setq location (cadr location)) | ||
| 809 | (insert "\n\nDefined in `") | ||
| 810 | (help-insert-xref-button | ||
| 811 | (file-name-nondirectory location) | ||
| 812 | 'eieio-method-def cname generic location) | ||
| 813 | (insert "'\n")) | ||
| 814 | (setq gm (cdr gm)) | ||
| 815 | (insert "\n"))) | ||
| 816 | (setq i (1+ i))))))) | ||
| 817 | |||
| 818 | ;;; Obsolete backward compatibility functions. | ||
| 819 | ;; Needed to run byte-code compiled with the EIEIO of Emacs-23. | ||
| 820 | |||
| 821 | (defun eieio-defmethod (method args) | ||
| 822 | "Obsolete work part of an old version of the `defmethod' macro." | ||
| 823 | (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) | ||
| 824 | ;; find optional keys | ||
| 825 | (setq key | ||
| 826 | (cond ((memq (car args) '(:BEFORE :before)) | ||
| 827 | (setq args (cdr args)) | ||
| 828 | eieio--method-before) | ||
| 829 | ((memq (car args) '(:AFTER :after)) | ||
| 830 | (setq args (cdr args)) | ||
| 831 | eieio--method-after) | ||
| 832 | ((memq (car args) '(:STATIC :static)) | ||
| 833 | (setq args (cdr args)) | ||
| 834 | eieio--method-static) | ||
| 835 | ((memq (car args) '(:PRIMARY :primary)) | ||
| 836 | (setq args (cdr args)) | ||
| 837 | eieio--method-primary) | ||
| 838 | ;; Primary key. | ||
| 839 | (t eieio--method-primary))) | ||
| 840 | ;; Get body, and fix contents of args to be the arguments of the fn. | ||
| 841 | (setq body (cdr args) | ||
| 842 | args (car args)) | ||
| 843 | (setq loopa args) | ||
| 844 | ;; Create a fixed version of the arguments. | ||
| 845 | (while loopa | ||
| 846 | (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa)) | ||
| 847 | argfix)) | ||
| 848 | (setq loopa (cdr loopa))) | ||
| 849 | ;; Make sure there is a generic. | ||
| 850 | (eieio-defgeneric | ||
| 851 | method | ||
| 852 | (if (stringp (car body)) | ||
| 853 | (car body) (format "Generically created method `%s'." method))) | ||
| 854 | ;; create symbol for property to bind to. If the first arg is of | ||
| 855 | ;; the form (varname vartype) and `vartype' is a class, then | ||
| 856 | ;; that class will be the type symbol. If not, then it will fall | ||
| 857 | ;; under the type `primary' which is a non-specific calling of the | ||
| 858 | ;; function. | ||
| 859 | (setq firstarg (car args)) | ||
| 860 | (if (listp firstarg) | ||
| 861 | (progn | ||
| 862 | (setq argclass (nth 1 firstarg)) | ||
| 863 | (if (not (class-p argclass)) | ||
| 864 | (error "Unknown class type %s in method parameters" | ||
| 865 | (nth 1 firstarg)))) | ||
| 866 | ;; Generics are higher. | ||
| 867 | (setq key (eieio--specialized-key-to-generic-key key))) | ||
| 868 | ;; Put this lambda into the symbol so we can find it. | ||
| 869 | (if (byte-code-function-p (car-safe body)) | ||
| 870 | (eieio--mt-add method (car-safe body) key argclass) | ||
| 871 | (eieio--mt-add method (append (list 'lambda (reverse argfix)) body) | ||
| 872 | key argclass)) | ||
| 873 | ) | ||
| 874 | |||
| 875 | (eieio--method-optimize-primary method) | ||
| 876 | |||
| 877 | method) | ||
| 878 | (make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1") | ||
| 879 | |||
| 880 | (defun eieio-defgeneric (method doc-string) | ||
| 881 | "Obsolete work part of an old version of the `defgeneric' macro." | ||
| 882 | (if (and (fboundp method) (not (generic-p method)) | ||
| 883 | (or (byte-code-function-p (symbol-function method)) | ||
| 884 | (not (eq 'autoload (car (symbol-function method))))) | ||
| 885 | ) | ||
| 886 | (error "You cannot create a generic/method over an existing symbol: %s" | ||
| 887 | method)) | ||
| 888 | ;; Don't do this over and over. | ||
| 889 | (unless (fboundp 'method) | ||
| 890 | ;; This defun tells emacs where the first definition of this | ||
| 891 | ;; method is defined. | ||
| 892 | `(defun ,method nil) | ||
| 893 | ;; Make sure the method tables are installed. | ||
| 894 | (eieio--mt-install method) | ||
| 895 | ;; Apply the actual body of this function. | ||
| 896 | (put method 'function-documentation doc-string) | ||
| 897 | (fset method (eieio--defgeneric-form method)) | ||
| 898 | ;; Return the method | ||
| 899 | 'method)) | ||
| 900 | (make-obsolete 'eieio-defgeneric nil "24.1") | ||
| 901 | |||
| 902 | (provide 'eieio-generic) | ||
| 903 | |||
| 904 | ;;; eieio-generic.el ends here | ||
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index bef7ceb259a..13ad120a9b5 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el | |||
| @@ -60,7 +60,7 @@ Argument PREFIX is the character prefix to use. | |||
| 60 | Argument CH-PREFIX is another character prefix to display." | 60 | Argument CH-PREFIX is another character prefix to display." |
| 61 | (eieio--check-type class-p this-root) | 61 | (eieio--check-type class-p this-root) |
| 62 | (let ((myname (symbol-name this-root)) | 62 | (let ((myname (symbol-name this-root)) |
| 63 | (chl (eieio--class-children (class-v this-root))) | 63 | (chl (eieio--class-children (eieio--class-v this-root))) |
| 64 | (fprefix (concat ch-prefix " +--")) | 64 | (fprefix (concat ch-prefix " +--")) |
| 65 | (mprefix (concat ch-prefix " | ")) | 65 | (mprefix (concat ch-prefix " | ")) |
| 66 | (lprefix (concat ch-prefix " "))) | 66 | (lprefix (concat ch-prefix " "))) |
| @@ -81,7 +81,7 @@ If CLASS is actually an object, then also display current values of that object. | |||
| 81 | ;; Header line | 81 | ;; Header line |
| 82 | (prin1 class) | 82 | (prin1 class) |
| 83 | (insert " is a" | 83 | (insert " is a" |
| 84 | (if (class-option class :abstract) | 84 | (if (eieio--class-option (eieio--class-v class) :abstract) |
| 85 | "n abstract" | 85 | "n abstract" |
| 86 | "") | 86 | "") |
| 87 | " class") | 87 | " class") |
| @@ -149,7 +149,7 @@ If CLASS is actually an object, then also display current values of that object. | |||
| 149 | (defun eieio-help-class-slots (class) | 149 | (defun eieio-help-class-slots (class) |
| 150 | "Print help description for the slots in CLASS. | 150 | "Print help description for the slots in CLASS. |
| 151 | Outputs to the current buffer." | 151 | Outputs to the current buffer." |
| 152 | (let* ((cv (class-v class)) | 152 | (let* ((cv (eieio--class-v class)) |
| 153 | (docs (eieio--class-public-doc cv)) | 153 | (docs (eieio--class-public-doc cv)) |
| 154 | (names (eieio--class-public-a cv)) | 154 | (names (eieio--class-public-a cv)) |
| 155 | (deflt (eieio--class-public-d cv)) | 155 | (deflt (eieio--class-public-d cv)) |
| @@ -218,11 +218,10 @@ Outputs to the current buffer." | |||
| 218 | (defun eieio-build-class-list (class) | 218 | (defun eieio-build-class-list (class) |
| 219 | "Return a list of all classes that inherit from CLASS." | 219 | "Return a list of all classes that inherit from CLASS." |
| 220 | (if (class-p class) | 220 | (if (class-p class) |
| 221 | (apply #'append | 221 | (cl-mapcan |
| 222 | (mapcar | 222 | (lambda (c) |
| 223 | (lambda (c) | 223 | (append (list c) (eieio-build-class-list c))) |
| 224 | (append (list c) (eieio-build-class-list c))) | 224 | (eieio--class-children (eieio--class-v class))) |
| 225 | (eieio-class-children-fast class))) | ||
| 226 | (list class))) | 225 | (list class))) |
| 227 | 226 | ||
| 228 | (defun eieio-build-class-alist (&optional class instantiable-only buildlist) | 227 | (defun eieio-build-class-alist (&optional class instantiable-only buildlist) |
| @@ -231,15 +230,16 @@ Optional argument CLASS is the class to start with. | |||
| 231 | If INSTANTIABLE-ONLY is non nil, only allow names of classes which | 230 | If INSTANTIABLE-ONLY is non nil, only allow names of classes which |
| 232 | are not abstract, otherwise allow all classes. | 231 | are not abstract, otherwise allow all classes. |
| 233 | Optional argument BUILDLIST is more list to attach and is used internally." | 232 | Optional argument BUILDLIST is more list to attach and is used internally." |
| 234 | (let* ((cc (or class eieio-default-superclass)) | 233 | (let* ((cc (or class 'eieio-default-superclass)) |
| 235 | (sublst (eieio--class-children (class-v cc)))) | 234 | (sublst (eieio--class-children (eieio--class-v cc)))) |
| 236 | (unless (assoc (symbol-name cc) buildlist) | 235 | (unless (assoc (symbol-name cc) buildlist) |
| 237 | (when (or (not instantiable-only) (not (class-abstract-p cc))) | 236 | (when (or (not instantiable-only) (not (class-abstract-p cc))) |
| 237 | ;; FIXME: Completion tables don't need alists, and ede/generic.el needs | ||
| 238 | ;; the symbols rather than their names. | ||
| 238 | (setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))) | 239 | (setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))) |
| 239 | (while sublst | 240 | (dolist (elem sublst) |
| 240 | (setq buildlist (eieio-build-class-alist | 241 | (setq buildlist (eieio-build-class-alist |
| 241 | (car sublst) instantiable-only buildlist)) | 242 | elem instantiable-only buildlist))) |
| 242 | (setq sublst (cdr sublst))) | ||
| 243 | buildlist)) | 243 | buildlist)) |
| 244 | 244 | ||
| 245 | (defvar eieio-read-class nil | 245 | (defvar eieio-read-class nil |
| @@ -311,132 +311,59 @@ are not abstract." | |||
| 311 | (eieio-help-class ctr)) | 311 | (eieio-help-class ctr)) |
| 312 | )))) | 312 | )))) |
| 313 | 313 | ||
| 314 | |||
| 315 | ;;;###autoload | ||
| 316 | (defun eieio-help-generic (generic) | ||
| 317 | "Describe GENERIC if it is a generic function." | ||
| 318 | (when (and (symbolp generic) (generic-p generic)) | ||
| 319 | (save-excursion | ||
| 320 | (goto-char (point-min)) | ||
| 321 | (when (re-search-forward " in `.+'.$" nil t) | ||
| 322 | (replace-match "."))) | ||
| 323 | (save-excursion | ||
| 324 | (insert "\n\nThis is a generic function" | ||
| 325 | (cond | ||
| 326 | ((and (generic-primary-only-p generic) | ||
| 327 | (generic-primary-only-one-p generic)) | ||
| 328 | " with only one primary method") | ||
| 329 | ((generic-primary-only-p generic) | ||
| 330 | " with only primary methods") | ||
| 331 | (t "")) | ||
| 332 | ".\n\n") | ||
| 333 | (insert (propertize "Implementations:\n\n" 'face 'bold)) | ||
| 334 | (let ((i 4) | ||
| 335 | (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] )) | ||
| 336 | ;; Loop over fanciful generics | ||
| 337 | (while (< i 7) | ||
| 338 | (let ((gm (aref (get generic 'eieio-method-tree) i))) | ||
| 339 | (when gm | ||
| 340 | (insert "Generic " | ||
| 341 | (aref prefix (- i 3)) | ||
| 342 | "\n" | ||
| 343 | (or (nth 2 gm) "Undocumented") | ||
| 344 | "\n\n"))) | ||
| 345 | (setq i (1+ i))) | ||
| 346 | (setq i 0) | ||
| 347 | ;; Loop over defined class-specific methods | ||
| 348 | (while (< i 4) | ||
| 349 | (let* ((gm (reverse (aref (get generic 'eieio-method-tree) i))) | ||
| 350 | cname location) | ||
| 351 | (while gm | ||
| 352 | (setq cname (caar gm)) | ||
| 353 | (insert "`") | ||
| 354 | (help-insert-xref-button (symbol-name cname) | ||
| 355 | 'help-variable cname) | ||
| 356 | (insert "' " (aref prefix i) " ") | ||
| 357 | ;; argument list | ||
| 358 | (let* ((func (cdr (car gm))) | ||
| 359 | (arglst (help-function-arglist func))) | ||
| 360 | (prin1 arglst (current-buffer))) | ||
| 361 | (insert "\n" | ||
| 362 | (or (documentation (cdr (car gm))) | ||
| 363 | "Undocumented")) | ||
| 364 | ;; Print file location if available | ||
| 365 | (when (and (setq location (get generic 'method-locations)) | ||
| 366 | (setq location (assoc cname location))) | ||
| 367 | (setq location (cadr location)) | ||
| 368 | (insert "\n\nDefined in `") | ||
| 369 | (help-insert-xref-button | ||
| 370 | (file-name-nondirectory location) | ||
| 371 | 'eieio-method-def cname generic location) | ||
| 372 | (insert "'\n")) | ||
| 373 | (setq gm (cdr gm)) | ||
| 374 | (insert "\n"))) | ||
| 375 | (setq i (1+ i))))))) | ||
| 376 | |||
| 377 | (defun eieio-all-generic-functions (&optional class) | 314 | (defun eieio-all-generic-functions (&optional class) |
| 378 | "Return a list of all generic functions. | 315 | "Return a list of all generic functions. |
| 379 | Optional CLASS argument returns only those functions that contain | 316 | Optional CLASS argument returns only those functions that contain |
| 380 | methods for CLASS." | 317 | methods for CLASS." |
| 381 | (let ((l nil) tree (cn (if class (symbol-name class) nil))) | 318 | (let ((l nil)) |
| 382 | (mapatoms | 319 | (mapatoms |
| 383 | (lambda (symbol) | 320 | (lambda (symbol) |
| 384 | (setq tree (get symbol 'eieio-method-obarray)) | 321 | (let ((tree (get symbol 'eieio-method-hashtable))) |
| 385 | (if tree | 322 | (when tree |
| 386 | (progn | 323 | ;; A symbol might be interned for that class in one of |
| 387 | ;; A symbol might be interned for that class in one of | 324 | ;; these three slots in the method-obarray. |
| 388 | ;; these three slots in the method-obarray. | 325 | (if (or (not class) |
| 389 | (if (or (not class) | 326 | (car (gethash class (aref tree 0))) |
| 390 | (fboundp (intern-soft cn (aref tree 0))) | 327 | (car (gethash class (aref tree 1))) |
| 391 | (fboundp (intern-soft cn (aref tree 1))) | 328 | (car (gethash class (aref tree 2)))) |
| 392 | (fboundp (intern-soft cn (aref tree 2)))) | 329 | (setq l (cons symbol l))))))) |
| 393 | (setq l (cons symbol l))))))) | ||
| 394 | l)) | 330 | l)) |
| 395 | 331 | ||
| 396 | (defun eieio-method-documentation (generic class) | 332 | (defun eieio-method-documentation (generic class) |
| 397 | "Return a list of the specific documentation of GENERIC for CLASS. | 333 | "Return a list of the specific documentation of GENERIC for CLASS. |
| 398 | If there is not an explicit method for CLASS in GENERIC, or if that | 334 | If there is not an explicit method for CLASS in GENERIC, or if that |
| 399 | function has no documentation, then return nil." | 335 | function has no documentation, then return nil." |
| 400 | (let ((tree (get generic 'eieio-method-obarray)) | 336 | (let ((tree (get generic 'eieio-method-hashtable))) |
| 401 | (cn (symbol-name class)) | 337 | (when tree |
| 402 | before primary after) | ||
| 403 | (if (not tree) | ||
| 404 | nil | ||
| 405 | ;; A symbol might be interned for that class in one of | 338 | ;; A symbol might be interned for that class in one of |
| 406 | ;; these three slots in the method-obarray. | 339 | ;; these three slots in the method-hashtable. |
| 407 | (setq before (intern-soft cn (aref tree 0)) | 340 | ;; FIXME: Where do these 0/1/2 come from? Isn't 0 for :static, |
| 408 | primary (intern-soft cn (aref tree 1)) | 341 | ;; 1 for before, and 2 for primary (and 3 for after)? |
| 409 | after (intern-soft cn (aref tree 2))) | 342 | (let ((before (car (gethash class (aref tree 0)))) |
| 410 | (if (not (or (fboundp before) | 343 | (primary (car (gethash class (aref tree 1)))) |
| 411 | (fboundp primary) | 344 | (after (car (gethash class (aref tree 2))))) |
| 412 | (fboundp after))) | 345 | (if (not (or before primary after)) |
| 413 | nil | 346 | nil |
| 414 | (list (if (fboundp before) | 347 | (list (if before |
| 415 | (cons (help-function-arglist before) | 348 | (cons (help-function-arglist before) |
| 416 | (documentation before)) | 349 | (documentation before)) |
| 417 | nil) | 350 | nil) |
| 418 | (if (fboundp primary) | 351 | (if primary |
| 419 | (cons (help-function-arglist primary) | 352 | (cons (help-function-arglist primary) |
| 420 | (documentation primary)) | 353 | (documentation primary)) |
| 421 | nil) | 354 | nil) |
| 422 | (if (fboundp after) | 355 | (if after |
| 423 | (cons (help-function-arglist after) | 356 | (cons (help-function-arglist after) |
| 424 | (documentation after)) | 357 | (documentation after)) |
| 425 | nil)))))) | 358 | nil))))))) |
| 426 | 359 | ||
| 427 | (defvar eieio-read-generic nil | 360 | (defvar eieio-read-generic nil |
| 428 | "History of the `eieio-read-generic' prompt.") | 361 | "History of the `eieio-read-generic' prompt.") |
| 429 | 362 | ||
| 430 | (defun eieio-read-generic-p (fn) | ||
| 431 | "Function used in function `eieio-read-generic'. | ||
| 432 | This is because `generic-p' is a macro. | ||
| 433 | Argument FN is the function to test." | ||
| 434 | (generic-p fn)) | ||
| 435 | |||
| 436 | (defun eieio-read-generic (prompt &optional historyvar) | 363 | (defun eieio-read-generic (prompt &optional historyvar) |
| 437 | "Read a generic function from the minibuffer with PROMPT. | 364 | "Read a generic function from the minibuffer with PROMPT. |
| 438 | Optional argument HISTORYVAR is the variable to use as history." | 365 | Optional argument HISTORYVAR is the variable to use as history." |
| 439 | (intern (completing-read prompt obarray 'eieio-read-generic-p | 366 | (intern (completing-read prompt obarray #'generic-p |
| 440 | t nil (or historyvar 'eieio-read-generic)))) | 367 | t nil (or historyvar 'eieio-read-generic)))) |
| 441 | 368 | ||
| 442 | ;;; METHOD STATS | 369 | ;;; METHOD STATS |
| @@ -627,21 +554,21 @@ Optional argument HISTORYVAR is the variable to use as history." | |||
| 627 | () | 554 | () |
| 628 | "Menu part in easymenu format used in speedbar while in `eieio' mode.") | 555 | "Menu part in easymenu format used in speedbar while in `eieio' mode.") |
| 629 | 556 | ||
| 630 | (defun eieio-class-speedbar (dir-or-object depth) | 557 | (defun eieio-class-speedbar (_dir-or-object _depth) |
| 631 | "Create buttons in speedbar that represents the current project. | 558 | "Create buttons in speedbar that represents the current project. |
| 632 | DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the | 559 | DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the |
| 633 | current expansion depth." | 560 | current expansion depth." |
| 634 | (when (eq (point-min) (point-max)) | 561 | (when (eq (point-min) (point-max)) |
| 635 | ;; This function is only called once, to start the whole deal. | 562 | ;; This function is only called once, to start the whole deal. |
| 636 | ;; Create and expand the default object. | 563 | ;; Create and expand the default object. |
| 637 | (eieio-class-button eieio-default-superclass 0) | 564 | (eieio-class-button 'eieio-default-superclass 0) |
| 638 | (forward-line -1) | 565 | (forward-line -1) |
| 639 | (speedbar-expand-line))) | 566 | (speedbar-expand-line))) |
| 640 | 567 | ||
| 641 | (defun eieio-class-button (class depth) | 568 | (defun eieio-class-button (class depth) |
| 642 | "Draw a speedbar button at the current point for CLASS at DEPTH." | 569 | "Draw a speedbar button at the current point for CLASS at DEPTH." |
| 643 | (eieio--check-type class-p class) | 570 | (eieio--check-type class-p class) |
| 644 | (let ((subclasses (eieio--class-children (class-v class)))) | 571 | (let ((subclasses (eieio--class-children (eieio--class-v class)))) |
| 645 | (if subclasses | 572 | (if subclasses |
| 646 | (speedbar-make-tag-line 'angle ?+ | 573 | (speedbar-make-tag-line 'angle ?+ |
| 647 | 'eieio-sb-expand | 574 | 'eieio-sb-expand |
| @@ -666,7 +593,7 @@ Argument INDENT is the depth of indentation." | |||
| 666 | (speedbar-with-writable | 593 | (speedbar-with-writable |
| 667 | (save-excursion | 594 | (save-excursion |
| 668 | (end-of-line) (forward-char 1) | 595 | (end-of-line) (forward-char 1) |
| 669 | (let ((subclasses (eieio--class-children (class-v class)))) | 596 | (let ((subclasses (eieio--class-children (eieio--class-v class)))) |
| 670 | (while subclasses | 597 | (while subclasses |
| 671 | (eieio-class-button (car subclasses) (1+ indent)) | 598 | (eieio-class-button (car subclasses) (1+ indent)) |
| 672 | (setq subclasses (cdr subclasses))))))) | 599 | (setq subclasses (cdr subclasses))))))) |
| @@ -676,7 +603,7 @@ Argument INDENT is the depth of indentation." | |||
| 676 | (t (error "Ooops... not sure what to do"))) | 603 | (t (error "Ooops... not sure what to do"))) |
| 677 | (speedbar-center-buffer-smartly)) | 604 | (speedbar-center-buffer-smartly)) |
| 678 | 605 | ||
| 679 | (defun eieio-describe-class-sb (text token indent) | 606 | (defun eieio-describe-class-sb (_text token _indent) |
| 680 | "Describe the class TEXT in TOKEN. | 607 | "Describe the class TEXT in TOKEN. |
| 681 | INDENT is the current indentation level." | 608 | INDENT is the current indentation level." |
| 682 | (dframe-with-attached-buffer | 609 | (dframe-with-attached-buffer |
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index cf676256d43..b236f0f03e1 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; eieio-speedbar.el -- Classes for managing speedbar displays. | 1 | ;;; eieio-speedbar.el -- Classes for managing speedbar displays. -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999-2002, 2005, 2007-2015 Free Software Foundation, | 3 | ;; Copyright (C) 1999-2002, 2005, 2007-2015 Free Software Foundation, |
| 4 | ;; Inc. | 4 | ;; Inc. |
| @@ -200,7 +200,7 @@ that path." | |||
| 200 | "Return a string describing OBJECT." | 200 | "Return a string describing OBJECT." |
| 201 | (eieio-object-name-string object)) | 201 | (eieio-object-name-string object)) |
| 202 | 202 | ||
| 203 | (defmethod eieio-speedbar-derive-line-path (object) | 203 | (defmethod eieio-speedbar-derive-line-path (_object) |
| 204 | "Return the path which OBJECT has something to do with." | 204 | "Return the path which OBJECT has something to do with." |
| 205 | nil) | 205 | nil) |
| 206 | 206 | ||
| @@ -321,7 +321,7 @@ Argument DEPTH is the depth at which the tag line is inserted." | |||
| 321 | (if exp | 321 | (if exp |
| 322 | (eieio-speedbar-expand object (1+ depth)))))) | 322 | (eieio-speedbar-expand object (1+ depth)))))) |
| 323 | 323 | ||
| 324 | (defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) depth) | 324 | (defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth) |
| 325 | "Base method for creating tag lines for non-object children." | 325 | "Base method for creating tag lines for non-object children." |
| 326 | (error "You must implement `eieio-speedbar-child-make-tag-lines' for %s" | 326 | (error "You must implement `eieio-speedbar-child-make-tag-lines' for %s" |
| 327 | (eieio-object-name object))) | 327 | (eieio-object-name object))) |
| @@ -340,7 +340,7 @@ OBJECT." | |||
| 340 | 340 | ||
| 341 | ;;; Speedbar specific function callbacks. | 341 | ;;; Speedbar specific function callbacks. |
| 342 | ;; | 342 | ;; |
| 343 | (defun eieio-speedbar-object-click (text token indent) | 343 | (defun eieio-speedbar-object-click (_text token _indent) |
| 344 | "Handle a user click on TEXT representing object TOKEN. | 344 | "Handle a user click on TEXT representing object TOKEN. |
| 345 | The object is at indentation level INDENT." | 345 | The object is at indentation level INDENT." |
| 346 | (eieio-speedbar-handle-click token)) | 346 | (eieio-speedbar-handle-click token)) |
| @@ -412,7 +412,7 @@ Optional DEPTH is the depth we start at." | |||
| 412 | 412 | ||
| 413 | ;;; Methods to the eieio-speedbar-* classes which need to be overridden. | 413 | ;;; Methods to the eieio-speedbar-* classes which need to be overridden. |
| 414 | ;; | 414 | ;; |
| 415 | (defmethod eieio-speedbar-object-children ((object eieio-speedbar)) | 415 | (defmethod eieio-speedbar-object-children ((_object eieio-speedbar)) |
| 416 | "Return a list of children to be displayed in speedbar. | 416 | "Return a list of children to be displayed in speedbar. |
| 417 | If the return value is a list of OBJECTs, then those objects are | 417 | If the return value is a list of OBJECTs, then those objects are |
| 418 | queried for details. If the return list is made of strings, | 418 | queried for details. If the return list is made of strings, |
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 361005414de..419a78be469 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el | |||
| @@ -53,17 +53,16 @@ | |||
| 53 | (message eieio-version)) | 53 | (message eieio-version)) |
| 54 | 54 | ||
| 55 | (require 'eieio-core) | 55 | (require 'eieio-core) |
| 56 | (require 'eieio-generic) | ||
| 56 | 57 | ||
| 57 | 58 | ||
| 58 | ;;; Defining a new class | 59 | ;;; Defining a new class |
| 59 | ;; | 60 | ;; |
| 60 | (defmacro defclass (name superclass slots &rest options-and-doc) | 61 | (defmacro defclass (name superclasses slots &rest options-and-doc) |
| 61 | "Define NAME as a new class derived from SUPERCLASS with SLOTS. | 62 | "Define NAME as a new class derived from SUPERCLASS with SLOTS. |
| 62 | OPTIONS-AND-DOC is used as the class' options and base documentation. | 63 | OPTIONS-AND-DOC is used as the class' options and base documentation. |
| 63 | SUPERCLASS is a list of superclasses to inherit from, with SLOTS | 64 | SUPERCLASSES is a list of superclasses to inherit from, with SLOTS |
| 64 | being the slots residing in that class definition. NOTE: Currently | 65 | being the slots residing in that class definition. Supported tags are: |
| 65 | only one slot may exist in SUPERCLASS as multiple inheritance is not | ||
| 66 | yet supported. Supported tags are: | ||
| 67 | 66 | ||
| 68 | :initform - Initializing form. | 67 | :initform - Initializing form. |
| 69 | :initarg - Tag used during initialization. | 68 | :initarg - Tag used during initialization. |
| @@ -114,12 +113,178 @@ Options in CLOS not supported in EIEIO: | |||
| 114 | Due to the way class options are set up, you can add any tags you wish, | 113 | Due to the way class options are set up, you can add any tags you wish, |
| 115 | and reference them using the function `class-option'." | 114 | and reference them using the function `class-option'." |
| 116 | (declare (doc-string 4)) | 115 | (declare (doc-string 4)) |
| 117 | ;; This is eval-and-compile only to silence spurious compiler warnings | 116 | (eieio--check-type listp superclasses) |
| 118 | ;; about functions and variables not known to be defined. | 117 | |
| 119 | ;; When eieio-defclass code is merged here and this becomes | 118 | (cond ((and (stringp (car options-and-doc)) |
| 120 | ;; transparent to the compiler, the eval-and-compile can be removed. | 119 | (/= 1 (% (length options-and-doc) 2))) |
| 121 | `(eval-and-compile | 120 | (error "Too many arguments to `defclass'")) |
| 122 | (eieio-defclass ',name ',superclass ',slots ',options-and-doc))) | 121 | ((and (symbolp (car options-and-doc)) |
| 122 | (/= 0 (% (length options-and-doc) 2))) | ||
| 123 | (error "Too many arguments to `defclass'"))) | ||
| 124 | |||
| 125 | (if (stringp (car options-and-doc)) | ||
| 126 | (setq options-and-doc | ||
| 127 | (cons :documentation options-and-doc))) | ||
| 128 | |||
| 129 | ;; Make sure the method invocation order is a valid value. | ||
| 130 | (let ((io (eieio--class-option-assoc options-and-doc | ||
| 131 | :method-invocation-order))) | ||
| 132 | (when (and io (not (member io '(:depth-first :breadth-first :c3)))) | ||
| 133 | (error "Method invocation order %s is not allowed" io))) | ||
| 134 | |||
| 135 | (let ((testsym1 (intern (concat (symbol-name name) "-p"))) | ||
| 136 | (testsym2 (intern (format "eieio--childp--%s" name))) | ||
| 137 | (accessors ())) | ||
| 138 | |||
| 139 | ;; Collect the accessors we need to define. | ||
| 140 | (pcase-dolist (`(,sname . ,soptions) slots) | ||
| 141 | (let* ((acces (plist-get soptions :accessor)) | ||
| 142 | (initarg (plist-get soptions :initarg)) | ||
| 143 | (reader (plist-get soptions :reader)) | ||
| 144 | (writer (plist-get soptions :writer)) | ||
| 145 | (alloc (plist-get soptions :allocation)) | ||
| 146 | (label (plist-get soptions :label))) | ||
| 147 | |||
| 148 | (if eieio-error-unsupported-class-tags | ||
| 149 | (let ((tmp soptions)) | ||
| 150 | (while tmp | ||
| 151 | (if (not (member (car tmp) '(:accessor | ||
| 152 | :initform | ||
| 153 | :initarg | ||
| 154 | :documentation | ||
| 155 | :protection | ||
| 156 | :reader | ||
| 157 | :writer | ||
| 158 | :allocation | ||
| 159 | :type | ||
| 160 | :custom | ||
| 161 | :label | ||
| 162 | :group | ||
| 163 | :printer | ||
| 164 | :allow-nil-initform | ||
| 165 | :custom-groups))) | ||
| 166 | (signal 'invalid-slot-type (list (car tmp)))) | ||
| 167 | (setq tmp (cdr (cdr tmp)))))) | ||
| 168 | |||
| 169 | ;; Make sure the :allocation parameter has a valid value. | ||
| 170 | (if (not (memq alloc '(nil :class :instance))) | ||
| 171 | (signal 'invalid-slot-type (list :allocation alloc))) | ||
| 172 | |||
| 173 | ;; Label is nil, or a string | ||
| 174 | (if (not (or (null label) (stringp label))) | ||
| 175 | (signal 'invalid-slot-type (list :label label))) | ||
| 176 | |||
| 177 | ;; Is there an initarg, but allocation of class? | ||
| 178 | (if (and initarg (eq alloc :class)) | ||
| 179 | (message "Class allocated slots do not need :initarg")) | ||
| 180 | |||
| 181 | ;; Anyone can have an accessor function. This creates a function | ||
| 182 | ;; of the specified name, and also performs a `defsetf' if applicable | ||
| 183 | ;; so that users can `setf' the space returned by this function. | ||
| 184 | (when acces | ||
| 185 | ;; FIXME: The defmethod below only defines a part of the generic | ||
| 186 | ;; function (good), but the define-setter below affects the whole | ||
| 187 | ;; generic function (bad)! | ||
| 188 | (push `(gv-define-setter ,acces (store object) | ||
| 189 | ;; Apparently, eieio-oset-default doesn't work like | ||
| 190 | ;; oref-default and only accept class arguments! | ||
| 191 | (list ',(if nil ;; (eq alloc :class) | ||
| 192 | 'eieio-oset-default | ||
| 193 | 'eieio-oset) | ||
| 194 | object '',sname store)) | ||
| 195 | accessors) | ||
| 196 | (push `(defmethod ,acces ,(if (eq alloc :class) :static :primary) | ||
| 197 | ((this ,name)) | ||
| 198 | ,(format | ||
| 199 | "Retrieve the slot `%S' from an object of class `%S'." | ||
| 200 | sname name) | ||
| 201 | (if (slot-boundp this ',sname) | ||
| 202 | ;; Use oref-default for :class allocated slots, since | ||
| 203 | ;; these also accept the use of a class argument instead | ||
| 204 | ;; of an object argument. | ||
| 205 | (,(if (eq alloc :class) 'eieio-oref-default 'eieio-oref) | ||
| 206 | this ',sname) | ||
| 207 | ;; Else - Some error? nil? | ||
| 208 | nil)) | ||
| 209 | accessors)) | ||
| 210 | |||
| 211 | ;; If a writer is defined, then create a generic method of that | ||
| 212 | ;; name whose purpose is to set the value of the slot. | ||
| 213 | (if writer | ||
| 214 | (push `(defmethod ,writer ((this ,name) value) | ||
| 215 | ,(format "Set the slot `%S' of an object of class `%S'." | ||
| 216 | sname name) | ||
| 217 | (setf (slot-value this ',sname) value)) | ||
| 218 | accessors)) | ||
| 219 | ;; If a reader is defined, then create a generic method | ||
| 220 | ;; of that name whose purpose is to access this slot value. | ||
| 221 | (if reader | ||
| 222 | (push `(defmethod ,reader ((this ,name)) | ||
| 223 | ,(format "Access the slot `%S' from object of class `%S'." | ||
| 224 | sname name) | ||
| 225 | (slot-value this ',sname)) | ||
| 226 | accessors)) | ||
| 227 | )) | ||
| 228 | |||
| 229 | `(progn | ||
| 230 | ;; This test must be created right away so we can have self- | ||
| 231 | ;; referencing classes. ei, a class whose slot can contain only | ||
| 232 | ;; pointers to itself. | ||
| 233 | |||
| 234 | ;; Create the test function. | ||
| 235 | (defun ,testsym1 (obj) | ||
| 236 | ,(format "Test OBJ to see if it an object of type %S." name) | ||
| 237 | (and (eieio-object-p obj) | ||
| 238 | (same-class-p obj ',name))) | ||
| 239 | |||
| 240 | (defun ,testsym2 (obj) | ||
| 241 | ,(format | ||
| 242 | "Test OBJ to see if it an object is a child of type %S." | ||
| 243 | name) | ||
| 244 | (and (eieio-object-p obj) | ||
| 245 | (object-of-class-p obj ',name))) | ||
| 246 | |||
| 247 | ,@(when eieio-backward-compatibility | ||
| 248 | (let ((f (intern (format "%s-child-p" name)))) | ||
| 249 | `((defalias ',f ',testsym2) | ||
| 250 | (make-obsolete | ||
| 251 | ',f ,(format "use (cl-typep ... '%s) instead" name) "25.1")))) | ||
| 252 | |||
| 253 | ;; When using typep, (typep OBJ 'myclass) returns t for objects which | ||
| 254 | ;; are subclasses of myclass. For our predicates, however, it is | ||
| 255 | ;; important for EIEIO to be backwards compatible, where | ||
| 256 | ;; myobject-p, and myobject-child-p are different. | ||
| 257 | ;; "cl" uses this technique to specify symbols with specific typep | ||
| 258 | ;; test, so we can let typep have the CLOS documented behavior | ||
| 259 | ;; while keeping our above predicate clean. | ||
| 260 | |||
| 261 | (put ',name 'cl-deftype-satisfies #',testsym2) | ||
| 262 | |||
| 263 | (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc) | ||
| 264 | |||
| 265 | ,@accessors | ||
| 266 | |||
| 267 | ;; Create the constructor function | ||
| 268 | ,(if (eieio--class-option-assoc options-and-doc :abstract) | ||
| 269 | ;; Abstract classes cannot be instantiated. Say so. | ||
| 270 | (let ((abs (eieio--class-option-assoc options-and-doc :abstract))) | ||
| 271 | (if (not (stringp abs)) | ||
| 272 | (setq abs (format "Class %s is abstract" name))) | ||
| 273 | `(defun ,name (&rest _) | ||
| 274 | ,(format "You cannot create a new object of type %S." name) | ||
| 275 | (error ,abs))) | ||
| 276 | |||
| 277 | ;; Non-abstract classes need a constructor. | ||
| 278 | `(defun ,name (&rest slots) | ||
| 279 | ,(format "Create a new object with name NAME of class type %S." | ||
| 280 | name) | ||
| 281 | (if (and slots | ||
| 282 | (let ((x (car slots))) | ||
| 283 | (or (stringp x) (null x)))) | ||
| 284 | (funcall (if eieio-backward-compatibility #'ignore #'message) | ||
| 285 | "Obsolete name %S passed to %S constructor" | ||
| 286 | (pop slots) ',name)) | ||
| 287 | (apply #'eieio-constructor ',name slots)))))) | ||
| 123 | 288 | ||
| 124 | 289 | ||
| 125 | ;;; CLOS style implementation of object creators. | 290 | ;;; CLOS style implementation of object creators. |
| @@ -144,75 +309,16 @@ In EIEIO, the class' constructor requires a name for use when printing. | |||
| 144 | `make-instance' in CLOS doesn't use names the way Emacs does, so the | 309 | `make-instance' in CLOS doesn't use names the way Emacs does, so the |
| 145 | class is used as the name slot instead when INITARGS doesn't start with | 310 | class is used as the name slot instead when INITARGS doesn't start with |
| 146 | a string." | 311 | a string." |
| 147 | (if (and (car initargs) (stringp (car initargs))) | 312 | (apply (class-constructor class) initargs)) |
| 148 | (apply (class-constructor class) initargs) | ||
| 149 | (apply (class-constructor class) | ||
| 150 | (cond ((symbolp class) (symbol-name class)) | ||
| 151 | (t (format "%S" class))) | ||
| 152 | initargs))) | ||
| 153 | 313 | ||
| 154 | 314 | ||
| 155 | ;;; CLOS methods and generics | ||
| 156 | ;; | ||
| 157 | (defmacro defgeneric (method _args &optional doc-string) | ||
| 158 | "Create a generic function METHOD. | ||
| 159 | DOC-STRING is the base documentation for this class. A generic | ||
| 160 | function has no body, as its purpose is to decide which method body | ||
| 161 | is appropriate to use. Uses `defmethod' to create methods, and calls | ||
| 162 | `defgeneric' for you. With this implementation the ARGS are | ||
| 163 | currently ignored. You can use `defgeneric' to apply specialized | ||
| 164 | top level documentation to a method." | ||
| 165 | (declare (doc-string 3)) | ||
| 166 | `(eieio--defalias ',method | ||
| 167 | (eieio--defgeneric-init-form ',method ,doc-string))) | ||
| 168 | |||
| 169 | (defmacro defmethod (method &rest args) | ||
| 170 | "Create a new METHOD through `defgeneric' with ARGS. | ||
| 171 | |||
| 172 | The optional second argument KEY is a specifier that | ||
| 173 | modifies how the method is called, including: | ||
| 174 | :before - Method will be called before the :primary | ||
| 175 | :primary - The default if not specified | ||
| 176 | :after - Method will be called after the :primary | ||
| 177 | :static - First arg could be an object or class | ||
| 178 | The next argument is the ARGLIST. The ARGLIST specifies the arguments | ||
| 179 | to the method as with `defun'. The first argument can have a type | ||
| 180 | specifier, such as: | ||
| 181 | ((VARNAME CLASS) ARG2 ...) | ||
| 182 | where VARNAME is the name of the local variable for the method being | ||
| 183 | created. The CLASS is a class symbol for a class made with `defclass'. | ||
| 184 | A DOCSTRING comes after the ARGLIST, and is optional. | ||
| 185 | All the rest of the args are the BODY of the method. A method will | ||
| 186 | return the value of the last form in the BODY. | ||
| 187 | |||
| 188 | Summary: | ||
| 189 | |||
| 190 | (defmethod mymethod [:before | :primary | :after | :static] | ||
| 191 | ((typearg class-name) arg2 &optional opt &rest rest) | ||
| 192 | \"doc-string\" | ||
| 193 | body)" | ||
| 194 | (declare (doc-string 3)) | ||
| 195 | (let* ((key (if (keywordp (car args)) (pop args))) | ||
| 196 | (params (car args)) | ||
| 197 | (arg1 (car params)) | ||
| 198 | (fargs (if (consp arg1) | ||
| 199 | (cons (car arg1) (cdr params)) | ||
| 200 | params)) | ||
| 201 | (class (if (consp arg1) (nth 1 arg1))) | ||
| 202 | (code `(lambda ,fargs ,@(cdr args)))) | ||
| 203 | `(progn | ||
| 204 | ;; Make sure there is a generic and the byte-compiler sees it. | ||
| 205 | (defgeneric ,method ,args | ||
| 206 | ,(or (documentation code) | ||
| 207 | (format "Generically created method `%s'." method))) | ||
| 208 | (eieio--defmethod ',method ',key ',class #',code)))) | ||
| 209 | |||
| 210 | ;;; Get/Set slots in an object. | 315 | ;;; Get/Set slots in an object. |
| 211 | ;; | 316 | ;; |
| 212 | (defmacro oref (obj slot) | 317 | (defmacro oref (obj slot) |
| 213 | "Retrieve the value stored in OBJ in the slot named by SLOT. | 318 | "Retrieve the value stored in OBJ in the slot named by SLOT. |
| 214 | Slot is the name of the slot when created by `defclass' or the label | 319 | Slot is the name of the slot when created by `defclass' or the label |
| 215 | created by the :initarg tag." | 320 | created by the :initarg tag." |
| 321 | (declare (debug (form symbolp))) | ||
| 216 | `(eieio-oref ,obj (quote ,slot))) | 322 | `(eieio-oref ,obj (quote ,slot))) |
| 217 | 323 | ||
| 218 | (defalias 'slot-value 'eieio-oref) | 324 | (defalias 'slot-value 'eieio-oref) |
| @@ -223,6 +329,7 @@ created by the :initarg tag." | |||
| 223 | The default value is the value installed in a class with the :initform | 329 | The default value is the value installed in a class with the :initform |
| 224 | tag. SLOT can be the slot name, or the tag specified by the :initarg | 330 | tag. SLOT can be the slot name, or the tag specified by the :initarg |
| 225 | tag in the `defclass' call." | 331 | tag in the `defclass' call." |
| 332 | (declare (debug (form symbolp))) | ||
| 226 | `(eieio-oref-default ,obj (quote ,slot))) | 333 | `(eieio-oref-default ,obj (quote ,slot))) |
| 227 | 334 | ||
| 228 | ;;; Handy CLOS macros | 335 | ;;; Handy CLOS macros |
| @@ -246,7 +353,7 @@ SPEC-LIST is of a form similar to `let'. For example: | |||
| 246 | Where each VAR is the local variable given to the associated | 353 | Where each VAR is the local variable given to the associated |
| 247 | SLOT. A slot specified without a variable name is given a | 354 | SLOT. A slot specified without a variable name is given a |
| 248 | variable name of the same name as the slot." | 355 | variable name of the same name as the slot." |
| 249 | (declare (indent 2)) | 356 | (declare (indent 2) (debug (sexp sexp def-body))) |
| 250 | (require 'cl-lib) | 357 | (require 'cl-lib) |
| 251 | ;; Transform the spec-list into a cl-symbol-macrolet spec-list. | 358 | ;; Transform the spec-list into a cl-symbol-macrolet spec-list. |
| 252 | (let ((mappings (mapcar (lambda (entry) | 359 | (let ((mappings (mapcar (lambda (entry) |
| @@ -261,33 +368,43 @@ variable name of the same name as the slot." | |||
| 261 | ;; well embedded into an object. | 368 | ;; well embedded into an object. |
| 262 | ;; | 369 | ;; |
| 263 | (define-obsolete-function-alias | 370 | (define-obsolete-function-alias |
| 264 | 'object-class-fast #'eieio--object-class "24.4") | 371 | 'object-class-fast #'eieio--object-class-name "24.4") |
| 265 | 372 | ||
| 266 | (defun eieio-object-name (obj &optional extra) | 373 | (defun eieio-object-name (obj &optional extra) |
| 267 | "Return a Lisp like symbol string for object OBJ. | 374 | "Return a Lisp like symbol string for object OBJ. |
| 268 | If EXTRA, include that in the string returned to represent the symbol." | 375 | If EXTRA, include that in the string returned to represent the symbol." |
| 269 | (eieio--check-type eieio-object-p obj) | 376 | (eieio--check-type eieio-object-p obj) |
| 270 | (format "#<%s %s%s>" (symbol-name (eieio--object-class obj)) | 377 | (format "#<%s %s%s>" (eieio--object-class-name obj) |
| 271 | (eieio--object-name obj) (or extra ""))) | 378 | (eieio-object-name-string obj) (or extra ""))) |
| 272 | (define-obsolete-function-alias 'object-name #'eieio-object-name "24.4") | 379 | (define-obsolete-function-alias 'object-name #'eieio-object-name "24.4") |
| 273 | 380 | ||
| 274 | (defun eieio-object-name-string (obj) "Return a string which is OBJ's name." | 381 | (defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key)) |
| 275 | (eieio--check-type eieio-object-p obj) | 382 | |
| 276 | (eieio--object-name obj)) | 383 | ;; In the past, every EIEIO object had a `name' field, so we had the two method |
| 384 | ;; below "for free". Since this field is very rarely used, we got rid of it | ||
| 385 | ;; and instead we keep it in a weak hash-tables, for those very rare objects | ||
| 386 | ;; that use it. | ||
| 387 | (defmethod eieio-object-name-string (obj) | ||
| 388 | "Return a string which is OBJ's name." | ||
| 389 | (declare (obsolete eieio-named "25.1")) | ||
| 390 | (or (gethash obj eieio--object-names) | ||
| 391 | (symbol-name (eieio-object-class obj)))) | ||
| 277 | (define-obsolete-function-alias | 392 | (define-obsolete-function-alias |
| 278 | 'object-name-string #'eieio-object-name-string "24.4") | 393 | 'object-name-string #'eieio-object-name-string "24.4") |
| 279 | 394 | ||
| 280 | (defun eieio-object-set-name-string (obj name) | 395 | (defmethod eieio-object-set-name-string (obj name) |
| 281 | "Set the string which is OBJ's NAME." | 396 | "Set the string which is OBJ's NAME." |
| 282 | (eieio--check-type eieio-object-p obj) | 397 | (declare (obsolete eieio-named "25.1")) |
| 283 | (eieio--check-type stringp name) | 398 | (eieio--check-type stringp name) |
| 284 | (setf (eieio--object-name obj) name)) | 399 | (setf (gethash obj eieio--object-names) name)) |
| 285 | (define-obsolete-function-alias | 400 | (define-obsolete-function-alias |
| 286 | 'object-set-name-string 'eieio-object-set-name-string "24.4") | 401 | 'object-set-name-string 'eieio-object-set-name-string "24.4") |
| 287 | 402 | ||
| 288 | (defun eieio-object-class (obj) "Return the class struct defining OBJ." | 403 | (defun eieio-object-class (obj) |
| 404 | "Return the class struct defining OBJ." | ||
| 405 | ;; FIXME: We say we return a "struct" but we return a symbol instead! | ||
| 289 | (eieio--check-type eieio-object-p obj) | 406 | (eieio--check-type eieio-object-p obj) |
| 290 | (eieio--object-class obj)) | 407 | (eieio--object-class-name obj)) |
| 291 | (define-obsolete-function-alias 'object-class #'eieio-object-class "24.4") | 408 | (define-obsolete-function-alias 'object-class #'eieio-object-class "24.4") |
| 292 | ;; CLOS name, maybe? | 409 | ;; CLOS name, maybe? |
| 293 | (define-obsolete-function-alias 'class-of #'eieio-object-class "24.4") | 410 | (define-obsolete-function-alias 'class-of #'eieio-object-class "24.4") |
| @@ -295,7 +412,7 @@ If EXTRA, include that in the string returned to represent the symbol." | |||
| 295 | (defun eieio-object-class-name (obj) | 412 | (defun eieio-object-class-name (obj) |
| 296 | "Return a Lisp like symbol name for OBJ's class." | 413 | "Return a Lisp like symbol name for OBJ's class." |
| 297 | (eieio--check-type eieio-object-p obj) | 414 | (eieio--check-type eieio-object-p obj) |
| 298 | (eieio-class-name (eieio--object-class obj))) | 415 | (eieio-class-name (eieio--object-class-name obj))) |
| 299 | (define-obsolete-function-alias | 416 | (define-obsolete-function-alias |
| 300 | 'object-class-name 'eieio-object-class-name "24.4") | 417 | 'object-class-name 'eieio-object-class-name "24.4") |
| 301 | 418 | ||
| @@ -303,15 +420,16 @@ If EXTRA, include that in the string returned to represent the symbol." | |||
| 303 | "Return parent classes to CLASS. (overload of variable). | 420 | "Return parent classes to CLASS. (overload of variable). |
| 304 | 421 | ||
| 305 | The CLOS function `class-direct-superclasses' is aliased to this function." | 422 | The CLOS function `class-direct-superclasses' is aliased to this function." |
| 306 | (eieio--check-type class-p class) | 423 | (let ((c (eieio-class-object class))) |
| 307 | (eieio-class-parents-fast class)) | 424 | (eieio--class-parent c))) |
| 425 | |||
| 308 | (define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4") | 426 | (define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4") |
| 309 | 427 | ||
| 310 | (defun eieio-class-children (class) | 428 | (defun eieio-class-children (class) |
| 311 | "Return child classes to CLASS. | 429 | "Return child classes to CLASS. |
| 312 | The CLOS function `class-direct-subclasses' is aliased to this function." | 430 | The CLOS function `class-direct-subclasses' is aliased to this function." |
| 313 | (eieio--check-type class-p class) | 431 | (eieio--check-type class-p class) |
| 314 | (eieio-class-children-fast class)) | 432 | (eieio--class-children (eieio--class-v class))) |
| 315 | (define-obsolete-function-alias | 433 | (define-obsolete-function-alias |
| 316 | 'class-children #'eieio-class-children "24.4") | 434 | 'class-children #'eieio-class-children "24.4") |
| 317 | 435 | ||
| @@ -326,38 +444,44 @@ The CLOS function `class-direct-subclasses' is aliased to this function." | |||
| 326 | `(car (eieio-class-parents ,class))) | 444 | `(car (eieio-class-parents ,class))) |
| 327 | (define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4") | 445 | (define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4") |
| 328 | 446 | ||
| 329 | (defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS." | 447 | (defun same-class-p (obj class) |
| 330 | (eieio--check-type class-p class) | 448 | "Return t if OBJ is of class-type CLASS." |
| 449 | (setq class (eieio--class-object class)) | ||
| 450 | (eieio--check-type eieio--class-p class) | ||
| 331 | (eieio--check-type eieio-object-p obj) | 451 | (eieio--check-type eieio-object-p obj) |
| 332 | (same-class-fast-p obj class)) | 452 | (eq (eieio--object-class-object obj) class)) |
| 333 | 453 | ||
| 334 | (defun object-of-class-p (obj class) | 454 | (defun object-of-class-p (obj class) |
| 335 | "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses." | 455 | "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses." |
| 336 | (eieio--check-type eieio-object-p obj) | 456 | (eieio--check-type eieio-object-p obj) |
| 337 | ;; class will be checked one layer down | 457 | ;; class will be checked one layer down |
| 338 | (child-of-class-p (eieio--object-class obj) class)) | 458 | (child-of-class-p (eieio--object-class-object obj) class)) |
| 339 | ;; Backwards compatibility | 459 | ;; Backwards compatibility |
| 340 | (defalias 'obj-of-class-p 'object-of-class-p) | 460 | (defalias 'obj-of-class-p 'object-of-class-p) |
| 341 | 461 | ||
| 342 | (defun child-of-class-p (child class) | 462 | (defun child-of-class-p (child class) |
| 343 | "Return non-nil if CHILD class is a subclass of CLASS." | 463 | "Return non-nil if CHILD class is a subclass of CLASS." |
| 344 | (eieio--check-type class-p class) | 464 | (setq child (eieio--class-object child)) |
| 345 | (eieio--check-type class-p child) | 465 | (eieio--check-type eieio--class-p child) |
| 346 | (let ((p nil)) | 466 | ;; `eieio-default-superclass' is never mentioned in eieio--class-parent, |
| 347 | (while (and child (not (eq child class))) | 467 | ;; so we have to special case it here. |
| 348 | (setq p (append p (eieio--class-parent (class-v child))) | 468 | (or (eq class 'eieio-default-superclass) |
| 349 | child (car p) | 469 | (let ((p nil)) |
| 350 | p (cdr p))) | 470 | (setq class (eieio--class-object class)) |
| 351 | (if child t))) | 471 | (eieio--check-type eieio--class-p class) |
| 472 | (while (and child (not (eq child class))) | ||
| 473 | (setq p (append p (eieio--class-parent child)) | ||
| 474 | child (pop p))) | ||
| 475 | (if child t)))) | ||
| 352 | 476 | ||
| 353 | (defun object-slots (obj) | 477 | (defun object-slots (obj) |
| 354 | "Return list of slots available in OBJ." | 478 | "Return list of slots available in OBJ." |
| 355 | (eieio--check-type eieio-object-p obj) | 479 | (eieio--check-type eieio-object-p obj) |
| 356 | (eieio--class-public-a (class-v (eieio--object-class obj)))) | 480 | (eieio--class-public-a (eieio--object-class-object obj))) |
| 357 | 481 | ||
| 358 | (defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." | 482 | (defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." |
| 359 | (eieio--check-type class-p class) | 483 | (eieio--check-type eieio--class-p class) |
| 360 | (let ((ia (eieio--class-initarg-tuples (class-v class))) | 484 | (let ((ia (eieio--class-initarg-tuples class)) |
| 361 | (f nil)) | 485 | (f nil)) |
| 362 | (while (and ia (not f)) | 486 | (while (and ia (not f)) |
| 363 | (if (eq (cdr (car ia)) slot) | 487 | (if (eq (cdr (car ia)) slot) |
| @@ -371,6 +495,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function." | |||
| 371 | "Set the value in OBJ for slot SLOT to VALUE. | 495 | "Set the value in OBJ for slot SLOT to VALUE. |
| 372 | SLOT is the slot name as specified in `defclass' or the tag created | 496 | SLOT is the slot name as specified in `defclass' or the tag created |
| 373 | with in the :initarg slot. VALUE can be any Lisp object." | 497 | with in the :initarg slot. VALUE can be any Lisp object." |
| 498 | (declare (debug (form symbolp form))) | ||
| 374 | `(eieio-oset ,obj (quote ,slot) ,value)) | 499 | `(eieio-oset ,obj (quote ,slot) ,value)) |
| 375 | 500 | ||
| 376 | (defmacro oset-default (class slot value) | 501 | (defmacro oset-default (class slot value) |
| @@ -378,6 +503,7 @@ with in the :initarg slot. VALUE can be any Lisp object." | |||
| 378 | The default value is usually set with the :initform tag during class | 503 | The default value is usually set with the :initform tag during class |
| 379 | creation. This allows users to change the default behavior of classes | 504 | creation. This allows users to change the default behavior of classes |
| 380 | after they are created." | 505 | after they are created." |
| 506 | (declare (debug (form symbolp form))) | ||
| 381 | `(eieio-oset-default ,class (quote ,slot) ,value)) | 507 | `(eieio-oset-default ,class (quote ,slot) ,value)) |
| 382 | 508 | ||
| 383 | ;;; CLOS queries into classes and slots | 509 | ;;; CLOS queries into classes and slots |
| @@ -402,11 +528,9 @@ OBJECT can be an instance or a class." | |||
| 402 | 528 | ||
| 403 | (defun slot-exists-p (object-or-class slot) | 529 | (defun slot-exists-p (object-or-class slot) |
| 404 | "Return non-nil if OBJECT-OR-CLASS has SLOT." | 530 | "Return non-nil if OBJECT-OR-CLASS has SLOT." |
| 405 | (let ((cv (class-v (cond ((eieio-object-p object-or-class) | 531 | (let ((cv (cond ((eieio-object-p object-or-class) |
| 406 | (eieio-object-class object-or-class)) | 532 | (eieio--object-class-object object-or-class)) |
| 407 | ((class-p object-or-class) | 533 | (t (eieio-class-object object-or-class))))) |
| 408 | object-or-class)) | ||
| 409 | ))) | ||
| 410 | (or (memq slot (eieio--class-public-a cv)) | 534 | (or (memq slot (eieio--class-public-a cv)) |
| 411 | (memq slot (eieio--class-class-allocation-a cv))) | 535 | (memq slot (eieio--class-class-allocation-a cv))) |
| 412 | )) | 536 | )) |
| @@ -418,7 +542,7 @@ If ERRORP is non-nil, `wrong-argument-type' is signaled." | |||
| 418 | (if (not (class-p symbol)) | 542 | (if (not (class-p symbol)) |
| 419 | (if errorp (signal 'wrong-type-argument (list 'class-p symbol)) | 543 | (if errorp (signal 'wrong-type-argument (list 'class-p symbol)) |
| 420 | nil) | 544 | nil) |
| 421 | (class-v symbol))) | 545 | (eieio--class-v symbol))) |
| 422 | 546 | ||
| 423 | ;;; Slightly more complex utility functions for objects | 547 | ;;; Slightly more complex utility functions for objects |
| 424 | ;; | 548 | ;; |
| @@ -496,44 +620,6 @@ If SLOT is unbound, do nothing." | |||
| 496 | nil | 620 | nil |
| 497 | (eieio-oset object slot (delete item (eieio-oref object slot))))) | 621 | (eieio-oset object slot (delete item (eieio-oref object slot))))) |
| 498 | 622 | ||
| 499 | ;;; | ||
| 500 | ;; Method Calling Functions | ||
| 501 | |||
| 502 | (defun next-method-p () | ||
| 503 | "Return non-nil if there is a next method. | ||
| 504 | Returns a list of lambda expressions which is the `next-method' | ||
| 505 | order." | ||
| 506 | eieio-generic-call-next-method-list) | ||
| 507 | |||
| 508 | (defun call-next-method (&rest replacement-args) | ||
| 509 | "Call the superclass method from a subclass method. | ||
| 510 | The superclass method is specified in the current method list, | ||
| 511 | and is called the next method. | ||
| 512 | |||
| 513 | If REPLACEMENT-ARGS is non-nil, then use them instead of | ||
| 514 | `eieio-generic-call-arglst'. The generic arg list are the | ||
| 515 | arguments passed in at the top level. | ||
| 516 | |||
| 517 | Use `next-method-p' to find out if there is a next method to call." | ||
| 518 | (if (not (eieio--scoped-class)) | ||
| 519 | (error "`call-next-method' not called within a class specific method")) | ||
| 520 | (if (and (/= eieio-generic-call-key method-primary) | ||
| 521 | (/= eieio-generic-call-key method-static)) | ||
| 522 | (error "Cannot `call-next-method' except in :primary or :static methods") | ||
| 523 | ) | ||
| 524 | (let ((newargs (or replacement-args eieio-generic-call-arglst)) | ||
| 525 | (next (car eieio-generic-call-next-method-list)) | ||
| 526 | ) | ||
| 527 | (if (or (not next) (not (car next))) | ||
| 528 | (apply #'no-next-method (car newargs) (cdr newargs)) | ||
| 529 | (let* ((eieio-generic-call-next-method-list | ||
| 530 | (cdr eieio-generic-call-next-method-list)) | ||
| 531 | (eieio-generic-call-arglst newargs) | ||
| 532 | (fcn (car next)) | ||
| 533 | ) | ||
| 534 | (eieio--with-scoped-class (cdr next) | ||
| 535 | (apply fcn newargs)) )))) | ||
| 536 | |||
| 537 | ;;; Here are some CLOS items that need the CL package | 623 | ;;; Here are some CLOS items that need the CL package |
| 538 | ;; | 624 | ;; |
| 539 | 625 | ||
| @@ -556,22 +642,23 @@ Its slots are automatically adopted by classes with no specified parents. | |||
| 556 | This class is not stored in the `parent' slot of a class vector." | 642 | This class is not stored in the `parent' slot of a class vector." |
| 557 | :abstract t) | 643 | :abstract t) |
| 558 | 644 | ||
| 645 | (setq eieio-default-superclass (eieio--class-v 'eieio-default-superclass)) | ||
| 646 | |||
| 559 | (defalias 'standard-class 'eieio-default-superclass) | 647 | (defalias 'standard-class 'eieio-default-superclass) |
| 560 | 648 | ||
| 561 | (defgeneric constructor (class newname &rest slots) | 649 | (defgeneric eieio-constructor (class &rest slots) |
| 562 | "Default constructor for CLASS `eieio-default-superclass'.") | 650 | "Default constructor for CLASS `eieio-default-superclass'.") |
| 563 | 651 | ||
| 564 | (defmethod constructor :static | 652 | (define-obsolete-function-alias 'constructor #'eieio-constructor "25.1") |
| 565 | ((class eieio-default-superclass) newname &rest slots) | 653 | |
| 654 | (defmethod eieio-constructor :static | ||
| 655 | ((class eieio-default-superclass) &rest slots) | ||
| 566 | "Default constructor for CLASS `eieio-default-superclass'. | 656 | "Default constructor for CLASS `eieio-default-superclass'. |
| 567 | NEWNAME is the name to be given to the constructed object. | ||
| 568 | SLOTS are the initialization slots used by `shared-initialize'. | 657 | SLOTS are the initialization slots used by `shared-initialize'. |
| 569 | This static method is called when an object is constructed. | 658 | This static method is called when an object is constructed. |
| 570 | It allocates the vector used to represent an EIEIO object, and then | 659 | It allocates the vector used to represent an EIEIO object, and then |
| 571 | calls `shared-initialize' on that object." | 660 | calls `shared-initialize' on that object." |
| 572 | (let* ((new-object (copy-sequence (eieio--class-default-object-cache (class-v class))))) | 661 | (let* ((new-object (copy-sequence (eieio--class-default-object-cache (eieio--class-v class))))) |
| 573 | ;; Update the name for the newly created object. | ||
| 574 | (setf (eieio--object-name new-object) newname) | ||
| 575 | ;; Call the initialize method on the new object with the slots | 662 | ;; Call the initialize method on the new object with the slots |
| 576 | ;; that were passed down to us. | 663 | ;; that were passed down to us. |
| 577 | (initialize-instance new-object slots) | 664 | (initialize-instance new-object slots) |
| @@ -585,10 +672,10 @@ Called from the constructor routine.") | |||
| 585 | (defmethod shared-initialize ((obj eieio-default-superclass) slots) | 672 | (defmethod shared-initialize ((obj eieio-default-superclass) slots) |
| 586 | "Set slots of OBJ with SLOTS which is a list of name/value pairs. | 673 | "Set slots of OBJ with SLOTS which is a list of name/value pairs. |
| 587 | Called from the constructor routine." | 674 | Called from the constructor routine." |
| 588 | (eieio--with-scoped-class (eieio--object-class obj) | 675 | (eieio--with-scoped-class (eieio--object-class-object obj) |
| 589 | (while slots | 676 | (while slots |
| 590 | (let ((rn (eieio-initarg-to-attribute (eieio--object-class obj) | 677 | (let ((rn (eieio--initarg-to-attribute (eieio--object-class-object obj) |
| 591 | (car slots)))) | 678 | (car slots)))) |
| 592 | (if (not rn) | 679 | (if (not rn) |
| 593 | (slot-missing obj (car slots) 'oset (car (cdr slots))) | 680 | (slot-missing obj (car slots) 'oset (car (cdr slots))) |
| 594 | (eieio-oset obj rn (car (cdr slots))))) | 681 | (eieio-oset obj rn (car (cdr slots))))) |
| @@ -609,7 +696,7 @@ not taken, then new objects of your class will not have their values | |||
| 609 | dynamically set from SLOTS." | 696 | dynamically set from SLOTS." |
| 610 | ;; First, see if any of our defaults are `lambda', and | 697 | ;; First, see if any of our defaults are `lambda', and |
| 611 | ;; re-evaluate them and apply the value to our slots. | 698 | ;; re-evaluate them and apply the value to our slots. |
| 612 | (let* ((this-class (class-v (eieio--object-class this))) | 699 | (let* ((this-class (eieio--object-class-object this)) |
| 613 | (slot (eieio--class-public-a this-class)) | 700 | (slot (eieio--class-public-a this-class)) |
| 614 | (defaults (eieio--class-public-d this-class))) | 701 | (defaults (eieio--class-public-d this-class))) |
| 615 | (while slot | 702 | (while slot |
| @@ -662,34 +749,6 @@ EIEIO can only dispatch on the first argument, so the first two are swapped." | |||
| 662 | (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object) | 749 | (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object) |
| 663 | slot-name fn))) | 750 | slot-name fn))) |
| 664 | 751 | ||
| 665 | (defgeneric no-applicable-method (object method &rest args) | ||
| 666 | "Called if there are no implementations for OBJECT in METHOD.") | ||
| 667 | |||
| 668 | (defmethod no-applicable-method ((object eieio-default-superclass) | ||
| 669 | method &rest _args) | ||
| 670 | "Called if there are no implementations for OBJECT in METHOD. | ||
| 671 | OBJECT is the object which has no method implementation. | ||
| 672 | ARGS are the arguments that were passed to METHOD. | ||
| 673 | |||
| 674 | Implement this for a class to block this signal. The return | ||
| 675 | value becomes the return value of the original method call." | ||
| 676 | (signal 'no-method-definition (list method (eieio-object-name object))) | ||
| 677 | ) | ||
| 678 | |||
| 679 | (defgeneric no-next-method (object &rest args) | ||
| 680 | "Called from `call-next-method' when no additional methods are available.") | ||
| 681 | |||
| 682 | (defmethod no-next-method ((object eieio-default-superclass) | ||
| 683 | &rest args) | ||
| 684 | "Called from `call-next-method' when no additional methods are available. | ||
| 685 | OBJECT is othe object being called on `call-next-method'. | ||
| 686 | ARGS are the arguments it is called by. | ||
| 687 | This method signals `no-next-method' by default. Override this | ||
| 688 | method to not throw an error, and its return value becomes the | ||
| 689 | return value of `call-next-method'." | ||
| 690 | (signal 'no-next-method (list (eieio-object-name object) args)) | ||
| 691 | ) | ||
| 692 | |||
| 693 | (defgeneric clone (obj &rest params) | 752 | (defgeneric clone (obj &rest params) |
| 694 | "Make a copy of OBJ, and then supply PARAMS. | 753 | "Make a copy of OBJ, and then supply PARAMS. |
| 695 | PARAMS is a parameter list of the same form used by `initialize-instance'. | 754 | PARAMS is a parameter list of the same form used by `initialize-instance'. |
| @@ -699,18 +758,11 @@ first and modify the returned object.") | |||
| 699 | 758 | ||
| 700 | (defmethod clone ((obj eieio-default-superclass) &rest params) | 759 | (defmethod clone ((obj eieio-default-superclass) &rest params) |
| 701 | "Make a copy of OBJ, and then apply PARAMS." | 760 | "Make a copy of OBJ, and then apply PARAMS." |
| 702 | (let ((nobj (copy-sequence obj)) | 761 | (let ((nobj (copy-sequence obj))) |
| 703 | (nm (eieio--object-name obj)) | 762 | (if (stringp (car params)) |
| 704 | (passname (and params (stringp (car params)))) | 763 | (funcall (if eieio-backward-compatibility #'ignore #'message) |
| 705 | (num 1)) | 764 | "Obsolete name %S passed to clone" (pop params))) |
| 706 | (if params (shared-initialize nobj (if passname (cdr params) params))) | 765 | (if params (shared-initialize nobj params)) |
| 707 | (if (not passname) | ||
| 708 | (save-match-data | ||
| 709 | (if (string-match "-\\([0-9]+\\)" nm) | ||
| 710 | (setq num (1+ (string-to-number (match-string 1 nm))) | ||
| 711 | nm (substring nm 0 (match-beginning 0)))) | ||
| 712 | (setf (eieio--object-name nobj) (concat nm "-" (int-to-string num)))) | ||
| 713 | (setf (eieio--object-name nobj) (car params))) | ||
| 714 | nobj)) | 766 | nobj)) |
| 715 | 767 | ||
| 716 | (defgeneric destructor (this &rest params) | 768 | (defgeneric destructor (this &rest params) |
| @@ -764,7 +816,7 @@ this object." | |||
| 764 | (princ comment) | 816 | (princ comment) |
| 765 | (princ "\n")) | 817 | (princ "\n")) |
| 766 | (let* ((cl (eieio-object-class this)) | 818 | (let* ((cl (eieio-object-class this)) |
| 767 | (cv (class-v cl))) | 819 | (cv (eieio--class-v cl))) |
| 768 | ;; Now output readable lisp to recreate this object | 820 | ;; Now output readable lisp to recreate this object |
| 769 | ;; It should look like this: | 821 | ;; It should look like this: |
| 770 | ;; (<constructor> <name> <slot> <slot> ... ) | 822 | ;; (<constructor> <name> <slot> <slot> ... ) |
| @@ -782,7 +834,7 @@ this object." | |||
| 782 | (eieio-print-depth (1+ eieio-print-depth))) | 834 | (eieio-print-depth (1+ eieio-print-depth))) |
| 783 | (while publa | 835 | (while publa |
| 784 | (when (slot-boundp this (car publa)) | 836 | (when (slot-boundp this (car publa)) |
| 785 | (let ((i (class-slot-initarg cl (car publa))) | 837 | (let ((i (eieio--class-slot-initarg cv (car publa))) |
| 786 | (v (eieio-oref this (car publa))) | 838 | (v (eieio-oref this (car publa))) |
| 787 | ) | 839 | ) |
| 788 | (unless (or (not i) (equal v (car publd))) | 840 | (unless (or (not i) (equal v (car publd))) |
| @@ -848,7 +900,6 @@ of `eq'." | |||
| 848 | (error "EIEIO: `change-class' is unimplemented")) | 900 | (error "EIEIO: `change-class' is unimplemented")) |
| 849 | 901 | ||
| 850 | ;; Hook ourselves into help system for describing classes and methods. | 902 | ;; Hook ourselves into help system for describing classes and methods. |
| 851 | (add-hook 'help-fns-describe-function-functions 'eieio-help-generic) | ||
| 852 | (add-hook 'help-fns-describe-function-functions 'eieio-help-constructor) | 903 | (add-hook 'help-fns-describe-function-functions 'eieio-help-constructor) |
| 853 | 904 | ||
| 854 | ;;; Interfacing with edebug | 905 | ;;; Interfacing with edebug |
| @@ -859,43 +910,23 @@ of `eq'." | |||
| 859 | Used as advice around `edebug-prin1-to-string', held in the | 910 | Used as advice around `edebug-prin1-to-string', held in the |
| 860 | variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to | 911 | variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to |
| 861 | `prin1-to-string' when appropriate." | 912 | `prin1-to-string' when appropriate." |
| 862 | (cond ((class-p object) (eieio-class-name object)) | 913 | (cond ((eieio--class-p object) (eieio-class-name object)) |
| 863 | ((eieio-object-p object) (object-print object)) | 914 | ((eieio-object-p object) (object-print object)) |
| 864 | ((and (listp object) (or (class-p (car object)) | 915 | ((and (listp object) (or (eieio--class-p (car object)) |
| 865 | (eieio-object-p (car object)))) | 916 | (eieio-object-p (car object)))) |
| 866 | (concat "(" (mapconcat #'eieio-edebug-prin1-to-string object " ") | 917 | (concat "(" (mapconcat |
| 918 | (lambda (x) (eieio-edebug-prin1-to-string print-function x)) | ||
| 919 | object " ") | ||
| 867 | ")")) | 920 | ")")) |
| 868 | (t (funcall print-function object noescape)))) | 921 | (t (funcall print-function object noescape)))) |
| 869 | 922 | ||
| 870 | (add-hook 'edebug-setup-hook | 923 | (advice-add 'edebug-prin1-to-string |
| 871 | (lambda () | 924 | :around #'eieio-edebug-prin1-to-string) |
| 872 | (def-edebug-spec defmethod | ||
| 873 | (&define ; this means we are defining something | ||
| 874 | [&or name ("setf" :name setf name)] | ||
| 875 | ;; ^^ This is the methods symbol | ||
| 876 | [ &optional symbolp ] ; this is key :before etc | ||
| 877 | list ; arguments | ||
| 878 | [ &optional stringp ] ; documentation string | ||
| 879 | def-body ; part to be debugged | ||
| 880 | )) | ||
| 881 | ;; The rest of the macros | ||
| 882 | (def-edebug-spec oref (form quote)) | ||
| 883 | (def-edebug-spec oref-default (form quote)) | ||
| 884 | (def-edebug-spec oset (form quote form)) | ||
| 885 | (def-edebug-spec oset-default (form quote form)) | ||
| 886 | (def-edebug-spec class-v form) | ||
| 887 | (def-edebug-spec class-p form) | ||
| 888 | (def-edebug-spec eieio-object-p form) | ||
| 889 | (def-edebug-spec class-constructor form) | ||
| 890 | (def-edebug-spec generic-p form) | ||
| 891 | (def-edebug-spec with-slots (list list def-body)) | ||
| 892 | (advice-add 'edebug-prin1-to-string | ||
| 893 | :around #'eieio-edebug-prin1-to-string))) | ||
| 894 | 925 | ||
| 895 | 926 | ||
| 896 | ;;; Start of automatically extracted autoloads. | 927 | ;;; Start of automatically extracted autoloads. |
| 897 | 928 | ||
| 898 | ;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "62709d76ae43f4fe70ed922391f9c64d") | 929 | ;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "9a908efef1720439feb6323c1dd01770") |
| 899 | ;;; Generated autoloads from eieio-custom.el | 930 | ;;; Generated autoloads from eieio-custom.el |
| 900 | 931 | ||
| 901 | (autoload 'customize-object "eieio-custom" "\ | 932 | (autoload 'customize-object "eieio-custom" "\ |
| @@ -906,7 +937,7 @@ Optional argument GROUP is the sub-group of slots to display. | |||
| 906 | 937 | ||
| 907 | ;;;*** | 938 | ;;;*** |
| 908 | 939 | ||
| 909 | ;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "76058d02377b677eed3d15c28fc7ab21") | 940 | ;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "e922bf7ebc7dcb272480c4ba148da1ac") |
| 910 | ;;; Generated autoloads from eieio-opt.el | 941 | ;;; Generated autoloads from eieio-opt.el |
| 911 | 942 | ||
| 912 | (autoload 'eieio-browse "eieio-opt" "\ | 943 | (autoload 'eieio-browse "eieio-opt" "\ |
| @@ -927,11 +958,6 @@ Describe CTR if it is a class constructor. | |||
| 927 | 958 | ||
| 928 | \(fn CTR)" nil nil) | 959 | \(fn CTR)" nil nil) |
| 929 | 960 | ||
| 930 | (autoload 'eieio-help-generic "eieio-opt" "\ | ||
| 931 | Describe GENERIC if it is a generic function. | ||
| 932 | |||
| 933 | \(fn GENERIC)" nil nil) | ||
| 934 | |||
| 935 | ;;;*** | 961 | ;;;*** |
| 936 | 962 | ||
| 937 | ;;; End of automatically extracted autoloads. | 963 | ;;; End of automatically extracted autoloads. |
diff --git a/lisp/files.el b/lisp/files.el index 80b538c3267..1533c35e6ca 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -729,38 +729,6 @@ The path separator is colon in GNU and GNU-like systems." | |||
| 729 | (lambda (f) (and (file-directory-p f) 'dir-ok))) | 729 | (lambda (f) (and (file-directory-p f) 'dir-ok))) |
| 730 | (error "No such directory found via CDPATH environment variable")))) | 730 | (error "No such directory found via CDPATH environment variable")))) |
| 731 | 731 | ||
| 732 | (defun file-tree-walk (dir action &rest args) | ||
| 733 | "Walk DIR executing ACTION on each file, with ARGS as additional arguments. | ||
| 734 | For each file, the function calls ACTION as follows: | ||
| 735 | |||
| 736 | \(ACTION DIRECTORY BASENAME ARGS\) | ||
| 737 | |||
| 738 | Where DIRECTORY is the leading directory of the file, | ||
| 739 | BASENAME is the basename of the file, | ||
| 740 | and ARGS are as specified in the call to this function, or nil if omitted. | ||
| 741 | |||
| 742 | The ACTION is applied to each subdirectory before descending into | ||
| 743 | it, and if nil is returned at that point, the descent will be | ||
| 744 | prevented. Directory entries are sorted with string-lessp." | ||
| 745 | (cond ((file-directory-p dir) | ||
| 746 | (setq dir (file-name-as-directory dir)) | ||
| 747 | (let ((lst (directory-files dir nil nil t)) | ||
| 748 | fullname file) | ||
| 749 | (while lst | ||
| 750 | (setq file (car lst)) | ||
| 751 | (setq lst (cdr lst)) | ||
| 752 | (cond ((member file '("." ".."))) | ||
| 753 | (t | ||
| 754 | (and (apply action dir file args) | ||
| 755 | (setq fullname (concat dir file)) | ||
| 756 | (file-directory-p fullname) | ||
| 757 | (apply 'file-tree-walk fullname action args))))))) | ||
| 758 | (t | ||
| 759 | (apply action | ||
| 760 | (file-name-directory dir) | ||
| 761 | (file-name-nondirectory dir) | ||
| 762 | args)))) | ||
| 763 | |||
| 764 | (defsubst directory-name-p (name) | 732 | (defsubst directory-name-p (name) |
| 765 | "Return non-nil if NAME ends with a slash character." | 733 | "Return non-nil if NAME ends with a slash character." |
| 766 | (and (> (length name) 0) | 734 | (and (> (length name) 0) |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 73a0de76a1f..20de9aea136 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * registry.el: Don't use <class> as a variable. | ||
| 4 | |||
| 1 | 2014-12-29 Paul Eggert <eggert@cs.ucla.edu> | 5 | 2014-12-29 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 6 | ||
| 3 | * message.el (message-make-fqdn): | 7 | * message.el (message-make-fqdn): |
| @@ -10,6 +14,12 @@ | |||
| 10 | * mm-decode.el (mm-shr): Bind `shr-width' to `fill-column' so that | 14 | * mm-decode.el (mm-shr): Bind `shr-width' to `fill-column' so that |
| 11 | lines don't get overlong when responding. | 15 | lines don't get overlong when responding. |
| 12 | 16 | ||
| 17 | 2014-12-19 Andreas Schwab <schwab@linux-m68k.org> | ||
| 18 | |||
| 19 | * gnus-group.el (gnus-read-ephemeral-bug-group): | ||
| 20 | Bind coding-system-for-read and coding-system-for-write only around | ||
| 21 | with-temp-file, and make buffer unibyte. Don't write temp file twice. | ||
| 22 | |||
| 13 | 2014-12-18 Paul Eggert <eggert@cs.ucla.edu> | 23 | 2014-12-18 Paul Eggert <eggert@cs.ucla.edu> |
| 14 | 24 | ||
| 15 | * registry.el (registry-db): Set default slot later. | 25 | * registry.el (registry-db): Set default slot later. |
| @@ -67,9 +77,9 @@ | |||
| 67 | 77 | ||
| 68 | 2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> | 78 | 2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 69 | 79 | ||
| 70 | * gnus-art.el (gnus-article-mime-handles): Refactored out into own | 80 | * gnus-art.el (gnus-article-mime-handles): Refactor out into own |
| 71 | function for reuse. | 81 | function for reuse. |
| 72 | (gnus-mime-buttonize-attachments-in-header): Adjusted. | 82 | (gnus-mime-buttonize-attachments-in-header): Adjust. |
| 73 | 83 | ||
| 74 | 2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org> | 84 | 2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 75 | 85 | ||
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 29c380f8234..f3dcc40b8c4 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el | |||
| @@ -2455,27 +2455,27 @@ the bug number, and browsing the URL must return mbox output." | |||
| 2455 | (setq ids (string-to-number ids))) | 2455 | (setq ids (string-to-number ids))) |
| 2456 | (unless (listp ids) | 2456 | (unless (listp ids) |
| 2457 | (setq ids (list ids))) | 2457 | (setq ids (list ids))) |
| 2458 | (let ((tmpfile (mm-make-temp-file "gnus-temp-group-")) | 2458 | (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) |
| 2459 | (coding-system-for-write 'binary) | 2459 | (let ((coding-system-for-write 'binary) |
| 2460 | (coding-system-for-read 'binary)) | 2460 | (coding-system-for-read 'binary)) |
| 2461 | (with-temp-file tmpfile | 2461 | (with-temp-file tmpfile |
| 2462 | (dolist (id ids) | 2462 | (mm-disable-multibyte) |
| 2463 | (url-insert-file-contents (format mbox-url id))) | 2463 | (dolist (id ids) |
| 2464 | (goto-char (point-min)) | 2464 | (url-insert-file-contents (format mbox-url id))) |
| 2465 | ;; Add the debbugs address so that we can respond to reports easily. | 2465 | (goto-char (point-min)) |
| 2466 | (while (re-search-forward "^To: " nil t) | 2466 | ;; Add the debbugs address so that we can respond to reports easily. |
| 2467 | (end-of-line) | 2467 | (while (re-search-forward "^To: " nil t) |
| 2468 | (insert (format ", %s@%s" (car ids) | 2468 | (end-of-line) |
| 2469 | (gnus-replace-in-string | 2469 | (insert (format ", %s@%s" (car ids) |
| 2470 | (gnus-replace-in-string mbox-url "^http://" "") | 2470 | (gnus-replace-in-string |
| 2471 | "/.*$" "")))) | 2471 | (gnus-replace-in-string mbox-url "^http://" "") |
| 2472 | (write-region (point-min) (point-max) tmpfile) | 2472 | "/.*$" "")))))) |
| 2473 | (gnus-group-read-ephemeral-group | 2473 | (gnus-group-read-ephemeral-group |
| 2474 | (format "nndoc+ephemeral:bug#%s" | 2474 | (format "nndoc+ephemeral:bug#%s" |
| 2475 | (mapconcat 'number-to-string ids ",")) | 2475 | (mapconcat 'number-to-string ids ",")) |
| 2476 | `(nndoc ,tmpfile | 2476 | `(nndoc ,tmpfile |
| 2477 | (nndoc-article-type mbox)) | 2477 | (nndoc-article-type mbox)) |
| 2478 | nil window-conf)) | 2478 | nil window-conf) |
| 2479 | (delete-file tmpfile))) | 2479 | (delete-file tmpfile))) |
| 2480 | 2480 | ||
| 2481 | (defun gnus-read-ephemeral-debian-bug-group (number) | 2481 | (defun gnus-read-ephemeral-debian-bug-group (number) |
diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index b3a2abfe26f..55b83a8e889 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el | |||
| @@ -124,7 +124,7 @@ | |||
| 124 | :type hash-table | 124 | :type hash-table |
| 125 | :documentation "The data hashtable."))) | 125 | :documentation "The data hashtable."))) |
| 126 | ;; Do this separately, since defclass doesn't allow expressions in :initform. | 126 | ;; Do this separately, since defclass doesn't allow expressions in :initform. |
| 127 | (oset-default registry-db max-size most-positive-fixnum) | 127 | (oset-default 'registry-db max-size most-positive-fixnum) |
| 128 | 128 | ||
| 129 | (defmethod initialize-instance :BEFORE ((this registry-db) slots) | 129 | (defmethod initialize-instance :BEFORE ((this registry-db) slots) |
| 130 | "Check whether a registry object needs to be upgraded." | 130 | "Check whether a registry object needs to be upgraded." |
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 9eb091f80c1..429c14b5e44 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el | |||
| @@ -1355,6 +1355,14 @@ IF := (if EXPRESSION CCL_BLOCK_0 CCL_BLOCK_1) | |||
| 1355 | BRANCH := (branch EXPRESSION CCL_BLOCK_0 [CCL_BLOCK_1 ...]) | 1355 | BRANCH := (branch EXPRESSION CCL_BLOCK_0 [CCL_BLOCK_1 ...]) |
| 1356 | 1356 | ||
| 1357 | ;; Execute STATEMENTs until (break) or (end) is executed. | 1357 | ;; Execute STATEMENTs until (break) or (end) is executed. |
| 1358 | |||
| 1359 | ;; Create a block of STATEMENTs for repeating. The STATEMENTs | ||
| 1360 | ;; are executed sequentially until REPEAT or BREAK is executed. | ||
| 1361 | ;; If REPEAT statement is executed, STATEMENTs are executed from the | ||
| 1362 | ;; start again. If BREAK statements is executed, the execution | ||
| 1363 | ;; exits from the block. If neither REPEAT nor BREAK is | ||
| 1364 | ;; executed, the execution exits from the block after executing the | ||
| 1365 | ;; last STATEMENT. | ||
| 1358 | LOOP := (loop STATEMENT [STATEMENT ...]) | 1366 | LOOP := (loop STATEMENT [STATEMENT ...]) |
| 1359 | 1367 | ||
| 1360 | ;; Terminate the most inner loop. | 1368 | ;; Terminate the most inner loop. |
| @@ -1501,17 +1509,42 @@ ARRAY := `[' integer ... `]' | |||
| 1501 | 1509 | ||
| 1502 | 1510 | ||
| 1503 | TRANSLATE := | 1511 | TRANSLATE := |
| 1504 | (translate-character REG(table) REG(charset) REG(codepoint)) | 1512 | ;; Decode character SRC, translate it by translate table |
| 1505 | | (translate-character SYMBOL REG(charset) REG(codepoint)) | 1513 | ;; TABLE, and encode it back to DST. TABLE is specified |
| 1506 | ;; SYMBOL must refer to a table defined by `define-translation-table'. | 1514 | ;; by its id number in REG_0, SRC is specified by its |
| 1515 | ;; charset id number and codepoint in REG_1 and REG_2 | ||
| 1516 | ;; respectively. | ||
| 1517 | ;; On encoding, the charset of highest priority is selected. | ||
| 1518 | ;; After the execution, DST is specified by its charset | ||
| 1519 | ;; id number and codepoint in REG_1 and REG_2 respectively. | ||
| 1520 | (translate-character REG_0 REG_1 REG_2) | ||
| 1521 | |||
| 1522 | ;; Same as above except for SYMBOL specifying the name of | ||
| 1523 | ;; the translate table defined by `define-translation-table'. | ||
| 1524 | | (translate-character SYMBOL REG_1 REG_2) | ||
| 1525 | |||
| 1507 | LOOKUP := | 1526 | LOOKUP := |
| 1508 | (lookup-character SYMBOL REG(charset) REG(codepoint)) | 1527 | ;; Look up character SRC in hash table TABLE. TABLE is |
| 1528 | ;; specified by its name in SYMBOL, and SRC is specified by | ||
| 1529 | ;; its charset id number and codepoint in REG_1 and REG_2 | ||
| 1530 | ;; respectively. | ||
| 1531 | ;; If its associated value is an integer, set REG_1 to that | ||
| 1532 | ;; value, and set r7 to 1. Otherwise, set r7 to 0. | ||
| 1533 | (lookup-character SYMBOL REG_1 REG_2) | ||
| 1534 | |||
| 1535 | ;; Look up integer value N in hash table TABLE. TABLE is | ||
| 1536 | ;; specified by its name in SYMBOL and N is specified in | ||
| 1537 | ;; REG. | ||
| 1538 | ;; If its associated value is a character, set REG to that | ||
| 1539 | ;; value, and set r7 to 1. Otherwise, set r7 to 0. | ||
| 1509 | | (lookup-integer SYMBOL REG(integer)) | 1540 | | (lookup-integer SYMBOL REG(integer)) |
| 1510 | ;; SYMBOL refers to a table defined by `define-translation-hash-table'. | 1541 | |
| 1511 | MAP := | 1542 | MAP := |
| 1512 | (iterate-multiple-map REG REG MAP-IDs) | 1543 | ;; The following statements are for internal use only. |
| 1513 | | (map-multiple REG REG (MAP-SET)) | 1544 | (iterate-multiple-map REG REG MAP-IDs) |
| 1514 | | (map-single REG REG MAP-ID) | 1545 | | (map-multiple REG REG (MAP-SET)) |
| 1546 | | (map-single REG REG MAP-ID) | ||
| 1547 | |||
| 1515 | MAP-IDs := MAP-ID ... | 1548 | MAP-IDs := MAP-ID ... |
| 1516 | MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET | 1549 | MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET |
| 1517 | MAP-ID := integer | 1550 | MAP-ID := integer |
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 16312444e3c..538bd974256 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -826,16 +826,27 @@ styles for specific categories, such as files, buffers, etc." | |||
| 826 | :type completion--styles-type | 826 | :type completion--styles-type |
| 827 | :version "23.1") | 827 | :version "23.1") |
| 828 | 828 | ||
| 829 | (defcustom completion-category-overrides | 829 | (defvar completion-category-defaults |
| 830 | '((buffer (styles . (basic substring)))) | 830 | '((buffer (styles . (basic substring))) |
| 831 | "List of `completion-styles' overrides for specific categories. | 831 | (unicode-name (styles . (basic substring)))) |
| 832 | "Default settings for specific completion categories. | ||
| 833 | Each entry has the shape (CATEGORY . ALIST) where ALIST is | ||
| 834 | an association list that can specify properties such as: | ||
| 835 | - `styles': the list of `completion-styles' to use for that category. | ||
| 836 | - `cycle': the `completion-cycle-threshold' to use for that category. | ||
| 837 | Categories are symbols such as `buffer' and `file', used when | ||
| 838 | completing buffer and file names, respectively.") | ||
| 839 | |||
| 840 | (defcustom completion-category-overrides nil | ||
| 841 | "List of category-specific user overrides for completion styles. | ||
| 832 | Each override has the shape (CATEGORY . ALIST) where ALIST is | 842 | Each override has the shape (CATEGORY . ALIST) where ALIST is |
| 833 | an association list that can specify properties such as: | 843 | an association list that can specify properties such as: |
| 834 | - `styles': the list of `completion-styles' to use for that category. | 844 | - `styles': the list of `completion-styles' to use for that category. |
| 835 | - `cycle': the `completion-cycle-threshold' to use for that category. | 845 | - `cycle': the `completion-cycle-threshold' to use for that category. |
| 836 | Categories are symbols such as `buffer' and `file', used when | 846 | Categories are symbols such as `buffer' and `file', used when |
| 837 | completing buffer and file names, respectively." | 847 | completing buffer and file names, respectively. |
| 838 | :version "24.1" | 848 | This overrides the defaults specified in `completion-category-defaults'." |
| 849 | :version "25.1" | ||
| 839 | :type `(alist :key-type (choice :tag "Category" | 850 | :type `(alist :key-type (choice :tag "Category" |
| 840 | (const buffer) | 851 | (const buffer) |
| 841 | (const file) | 852 | (const file) |
| @@ -851,9 +862,13 @@ completing buffer and file names, respectively." | |||
| 851 | (const :tag "Select one value from the menu." cycle) | 862 | (const :tag "Select one value from the menu." cycle) |
| 852 | ,completion--cycling-threshold-type)))) | 863 | ,completion--cycling-threshold-type)))) |
| 853 | 864 | ||
| 865 | (defun completion--category-override (category tag) | ||
| 866 | (or (assq tag (cdr (assq category completion-category-overrides))) | ||
| 867 | (assq tag (cdr (assq category completion-category-defaults))))) | ||
| 868 | |||
| 854 | (defun completion--styles (metadata) | 869 | (defun completion--styles (metadata) |
| 855 | (let* ((cat (completion-metadata-get metadata 'category)) | 870 | (let* ((cat (completion-metadata-get metadata 'category)) |
| 856 | (over (assq 'styles (cdr (assq cat completion-category-overrides))))) | 871 | (over (completion--category-override cat 'styles))) |
| 857 | (if over | 872 | (if over |
| 858 | (delete-dups (append (cdr over) (copy-sequence completion-styles))) | 873 | (delete-dups (append (cdr over) (copy-sequence completion-styles))) |
| 859 | completion-styles))) | 874 | completion-styles))) |
| @@ -967,7 +982,7 @@ completion candidates than this number." | |||
| 967 | 982 | ||
| 968 | (defun completion--cycle-threshold (metadata) | 983 | (defun completion--cycle-threshold (metadata) |
| 969 | (let* ((cat (completion-metadata-get metadata 'category)) | 984 | (let* ((cat (completion-metadata-get metadata 'category)) |
| 970 | (over (assq 'cycle (cdr (assq cat completion-category-overrides))))) | 985 | (over (completion--category-override cat 'cycle))) |
| 971 | (if over (cdr over) completion-cycle-threshold))) | 986 | (if over (cdr over) completion-cycle-threshold))) |
| 972 | 987 | ||
| 973 | (defvar-local completion-all-sorted-completions nil) | 988 | (defvar-local completion-all-sorted-completions nil) |
diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2ce95d97ff8..6a6da17d1ce 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el | |||
| @@ -255,14 +255,18 @@ 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 (and (= (length (split-string url)) 1) | 258 | (if (or (string-match "\\`https?:" url) |
| 259 | (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url)) | 259 | ;; Also try to match "naked" URLs like |
| 260 | (> (length (split-string url "[.:]")) 1)) | 260 | ;; en.wikipedia.org/wiki/Free software |
| 261 | (string-match eww-local-regex url))) | 261 | (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url) |
| 262 | (and (= (length (split-string url)) 1) | ||
| 263 | (or (and (not (string-match-p "\\`[\"\'].*[\"\']\\'" url)) | ||
| 264 | (> (length (split-string url "[.:]")) 1)) | ||
| 265 | (string-match eww-local-regex url)))) | ||
| 262 | (progn | 266 | (progn |
| 263 | (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url) | 267 | (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url) |
| 264 | (setq url (concat "http://" url))) | 268 | (setq url (concat "http://" url))) |
| 265 | ;; some site don't redirect final / | 269 | ;; Some sites do not redirect final / |
| 266 | (when (string= (url-filename (url-generic-parse-url url)) "") | 270 | (when (string= (url-filename (url-generic-parse-url url)) "") |
| 267 | (setq url (concat url "/")))) | 271 | (setq url (concat url "/")))) |
| 268 | (setq url (concat eww-search-prefix | 272 | (setq url (concat eww-search-prefix |
| @@ -273,6 +277,7 @@ word(s) will be searched for via `eww-search-prefix'." | |||
| 273 | (eww-save-history)) | 277 | (eww-save-history)) |
| 274 | (eww-setup-buffer) | 278 | (eww-setup-buffer) |
| 275 | (plist-put eww-data :url url) | 279 | (plist-put eww-data :url url) |
| 280 | (plist-put eww-data :title "") | ||
| 276 | (eww-update-header-line-format) | 281 | (eww-update-header-line-format) |
| 277 | (let ((inhibit-read-only t)) | 282 | (let ((inhibit-read-only t)) |
| 278 | (insert (format "Loading %s..." url)) | 283 | (insert (format "Loading %s..." url)) |
diff --git a/lisp/net/shr.el b/lisp/net/shr.el index ed824cf3fb2..feb934c7190 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el | |||
| @@ -894,7 +894,12 @@ START, and END. Note that START and END should be markers." | |||
| 894 | (add-text-properties | 894 | (add-text-properties |
| 895 | start (point) | 895 | start (point) |
| 896 | (list 'shr-url url | 896 | (list 'shr-url url |
| 897 | 'help-echo (if title (shr-fold-text (format "%s (%s)" url title)) url) | 897 | 'help-echo (let ((iri (or (ignore-errors |
| 898 | (decode-coding-string | ||
| 899 | (url-unhex-string url) | ||
| 900 | 'utf-8 t)) | ||
| 901 | url))) | ||
| 902 | (if title (format "%s (%s)" iri title) iri)) | ||
| 898 | 'follow-link t | 903 | 'follow-link t |
| 899 | 'mouse-face 'highlight | 904 | 'mouse-face 'highlight |
| 900 | 'keymap shr-map))) | 905 | 'keymap shr-map))) |
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index de6a33988a4..c25e52cdc6a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el | |||
| @@ -248,7 +248,7 @@ name as matched contains | |||
| 248 | 248 | ||
| 249 | (defconst js--function-heading-1-re | 249 | (defconst js--function-heading-1-re |
| 250 | (concat | 250 | (concat |
| 251 | "^\\s-*function\\s-+\\(" js--name-re "\\)") | 251 | "^\\s-*function\\(?:\\s-\\|\\*\\)+\\(" js--name-re "\\)") |
| 252 | "Regexp matching the start of a JavaScript function header. | 252 | "Regexp matching the start of a JavaScript function header. |
| 253 | Match group 1 is the name of the function.") | 253 | Match group 1 is the name of the function.") |
| 254 | 254 | ||
| @@ -796,6 +796,9 @@ determined. Otherwise, return nil." | |||
| 796 | (let ((name t)) | 796 | (let ((name t)) |
| 797 | (forward-word) | 797 | (forward-word) |
| 798 | (forward-comment most-positive-fixnum) | 798 | (forward-comment most-positive-fixnum) |
| 799 | (when (eq (char-after) ?*) | ||
| 800 | (forward-char) | ||
| 801 | (forward-comment most-positive-fixnum)) | ||
| 799 | (when (looking-at js--name-re) | 802 | (when (looking-at js--name-re) |
| 800 | (setq name (match-string-no-properties 0)) | 803 | (setq name (match-string-no-properties 0)) |
| 801 | (goto-char (match-end 0))) | 804 | (goto-char (match-end 0))) |
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 41b70c7eff2..b822619f783 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el | |||
| @@ -434,7 +434,8 @@ GROUP is a string for decoration purposes and XREF is an | |||
| 434 | (list 'xref-location location | 434 | (list 'xref-location location |
| 435 | 'face 'font-lock-keyword-face | 435 | 'face 'font-lock-keyword-face |
| 436 | 'mouse-face 'highlight | 436 | 'mouse-face 'highlight |
| 437 | 'keymap xref--button-map) | 437 | 'keymap xref--button-map |
| 438 | 'help-echo "mouse-2: display, RET or mouse-1: navigate") | ||
| 438 | description)) | 439 | description)) |
| 439 | (when (or more1 more2) | 440 | (when (or more1 more2) |
| 440 | (insert "\n"))))) | 441 | (insert "\n"))))) |
diff --git a/lisp/shell.el b/lisp/shell.el index 6e336eb1403..f71d1407a49 100644 --- a/lisp/shell.el +++ b/lisp/shell.el | |||
| @@ -309,13 +309,6 @@ for Shell mode only." | |||
| 309 | (const :tag "on" t)) | 309 | (const :tag "on" t)) |
| 310 | :group 'shell) | 310 | :group 'shell) |
| 311 | 311 | ||
| 312 | (defcustom shell-display-buffer-actions display-buffer-base-action | ||
| 313 | "The `display-buffer' actions for the `*shell*' buffer." | ||
| 314 | :type display-buffer--action-custom-type | ||
| 315 | :risky t | ||
| 316 | :version "25.1" | ||
| 317 | :group 'shell) | ||
| 318 | |||
| 319 | (defvar shell-dirstack nil | 312 | (defvar shell-dirstack nil |
| 320 | "List of directories saved by pushd in this buffer's shell. | 313 | "List of directories saved by pushd in this buffer's shell. |
| 321 | Thus, this does not include the shell's current directory.") | 314 | Thus, this does not include the shell's current directory.") |
| @@ -726,7 +719,7 @@ Otherwise, one argument `-i' is passed to the shell. | |||
| 726 | 719 | ||
| 727 | ;; The buffer's window must be correctly set when we call comint (so | 720 | ;; The buffer's window must be correctly set when we call comint (so |
| 728 | ;; that comint sets the COLUMNS env var properly). | 721 | ;; that comint sets the COLUMNS env var properly). |
| 729 | (pop-to-buffer buffer shell-display-buffer-actions) | 722 | (pop-to-buffer buffer) |
| 730 | (unless (comint-check-proc buffer) | 723 | (unless (comint-check-proc buffer) |
| 731 | (let* ((prog (or explicit-shell-file-name | 724 | (let* ((prog (or explicit-shell-file-name |
| 732 | (getenv "ESHELL") shell-file-name)) | 725 | (getenv "ESHELL") shell-file-name)) |
diff --git a/lisp/simple.el b/lisp/simple.el index e15291a345b..25293edf88f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -5604,14 +5604,22 @@ If NOERROR, don't signal an error if we can't move that many lines." | |||
| 5604 | (> (cdr temporary-goal-column) 0)) | 5604 | (> (cdr temporary-goal-column) 0)) |
| 5605 | (setq target-hscroll (cdr temporary-goal-column))) | 5605 | (setq target-hscroll (cdr temporary-goal-column))) |
| 5606 | ;; Otherwise, we should reset `temporary-goal-column'. | 5606 | ;; Otherwise, we should reset `temporary-goal-column'. |
| 5607 | (let ((posn (posn-at-point))) | 5607 | (let ((posn (posn-at-point)) |
| 5608 | x-pos) | ||
| 5608 | (cond | 5609 | (cond |
| 5609 | ;; Handle the `overflow-newline-into-fringe' case: | 5610 | ;; Handle the `overflow-newline-into-fringe' case: |
| 5610 | ((eq (nth 1 posn) 'right-fringe) | 5611 | ((eq (nth 1 posn) 'right-fringe) |
| 5611 | (setq temporary-goal-column (cons (- (window-width) 1) hscroll))) | 5612 | (setq temporary-goal-column (cons (- (window-width) 1) hscroll))) |
| 5612 | ((car (posn-x-y posn)) | 5613 | ((car (posn-x-y posn)) |
| 5614 | (setq x-pos (car (posn-x-y posn))) | ||
| 5615 | ;; In R2L lines, the X pixel coordinate is measured from the | ||
| 5616 | ;; left edge of the window, but columns are still counted | ||
| 5617 | ;; from the logical-order beginning of the line, i.e. from | ||
| 5618 | ;; the right edge in this case. We need to adjust for that. | ||
| 5619 | (if (eq (current-bidi-paragraph-direction) 'right-to-left) | ||
| 5620 | (setq x-pos (- (window-body-width nil t) 1 x-pos))) | ||
| 5613 | (setq temporary-goal-column | 5621 | (setq temporary-goal-column |
| 5614 | (cons (/ (float (car (posn-x-y posn))) | 5622 | (cons (/ (float x-pos) |
| 5615 | (frame-char-width)) | 5623 | (frame-char-width)) |
| 5616 | hscroll)))))) | 5624 | hscroll)))))) |
| 5617 | (if target-hscroll | 5625 | (if target-hscroll |
diff --git a/lisp/subr.el b/lisp/subr.el index 8237a5b8d22..05345853edc 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1312,6 +1312,7 @@ is converted into a string by expressing it in decimal." | |||
| 1312 | (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") | 1312 | (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") |
| 1313 | (make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1") | 1313 | (make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1") |
| 1314 | (make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1") | 1314 | (make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1") |
| 1315 | (make-obsolete-variable 'redisplay-dont-pause nil "24.5") | ||
| 1315 | (make-obsolete 'window-redisplay-end-trigger nil "23.1") | 1316 | (make-obsolete 'window-redisplay-end-trigger nil "23.1") |
| 1316 | (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") | 1317 | (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") |
| 1317 | 1318 | ||
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 3b1f6c7103c..7801f4f8ed9 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el | |||
| @@ -886,7 +886,7 @@ current, and kill the buffer that visits the link." | |||
| 886 | (define-key map "=" 'vc-diff) | 886 | (define-key map "=" 'vc-diff) |
| 887 | (define-key map "D" 'vc-root-diff) | 887 | (define-key map "D" 'vc-root-diff) |
| 888 | (define-key map "~" 'vc-revision-other-window) | 888 | (define-key map "~" 'vc-revision-other-window) |
| 889 | (define-key map "[delete]" 'vc-delete-file) | 889 | (define-key map "x" 'vc-delete-file) |
| 890 | map)) | 890 | map)) |
| 891 | (fset 'vc-prefix-map vc-prefix-map) | 891 | (fset 'vc-prefix-map vc-prefix-map) |
| 892 | (define-key ctl-x-map "v" 'vc-prefix-map) | 892 | (define-key ctl-x-map "v" 'vc-prefix-map) |
diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4 index 42173387aff..e0c4bde1f8e 100644 --- a/m4/stdio_h.m4 +++ b/m4/stdio_h.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # stdio_h.m4 serial 43 | 1 | # stdio_h.m4 serial 44 |
| 2 | dnl Copyright (C) 2007-2015 Free Software Foundation, Inc. | 2 | dnl Copyright (C) 2007-2015 Free Software Foundation, Inc. |
| 3 | dnl This file is free software; the Free Software Foundation | 3 | dnl This file is free software; the Free Software Foundation |
| 4 | dnl gives unlimited permission to copy and/or distribute it, | 4 | dnl gives unlimited permission to copy and/or distribute it, |
| @@ -12,6 +12,24 @@ AC_DEFUN([gl_STDIO_H], | |||
| 12 | AC_REQUIRE([gl_STDIO_H_DEFAULTS]) | 12 | AC_REQUIRE([gl_STDIO_H_DEFAULTS]) |
| 13 | gl_NEXT_HEADERS([stdio.h]) | 13 | gl_NEXT_HEADERS([stdio.h]) |
| 14 | 14 | ||
| 15 | dnl Determine whether __USE_MINGW_ANSI_STDIO makes printf and | ||
| 16 | dnl inttypes.h behave like gnu instead of system; we must give our | ||
| 17 | dnl printf wrapper the right attribute to match. | ||
| 18 | AC_CACHE_CHECK([whether inttypes macros match system or gnu printf], | ||
| 19 | [gl_cv_func_printf_attribute_flavor], | ||
| 20 | [AC_EGREP_CPP([findme .(ll|j)d. findme], | ||
| 21 | [#define __STDC_FORMAT_MACROS 1 | ||
| 22 | #include <stdio.h> | ||
| 23 | #include <inttypes.h> | ||
| 24 | findme PRIdMAX findme | ||
| 25 | ], [gl_cv_func_printf_attribute_flavor=gnu], | ||
| 26 | [gl_cv_func_printf_attribute_flavor=system])]) | ||
| 27 | if test "$gl_cv_func_printf_attribute_flavor" = gnu; then | ||
| 28 | AC_DEFINE([GNULIB_PRINTF_ATTRIBUTE_FLAVOR_GNU], [1], | ||
| 29 | [Define to 1 if printf and friends should be labeled with | ||
| 30 | attribute "__gnu_printf__" instead of "__printf__"]) | ||
| 31 | fi | ||
| 32 | |||
| 15 | dnl No need to create extra modules for these functions. Everyone who uses | 33 | dnl No need to create extra modules for these functions. Everyone who uses |
| 16 | dnl <stdio.h> likely needs them. | 34 | dnl <stdio.h> likely needs them. |
| 17 | GNULIB_FSCANF=1 | 35 | GNULIB_FSCANF=1 |
diff --git a/src/.gdbinit b/src/.gdbinit index 0f2138284a0..1a2a973e694 100644 --- a/src/.gdbinit +++ b/src/.gdbinit | |||
| @@ -70,6 +70,16 @@ 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 | # Access the name of a symbol | ||
| 74 | define xsymname | ||
| 75 | if (CHECK_LISP_OBJECT_TYPE) | ||
| 76 | set $bugfix = $arg0.i | ||
| 77 | else | ||
| 78 | set $bugfix = $arg0 | ||
| 79 | end | ||
| 80 | set $symname = ((struct Lisp_Symbol *) ((char *)lispsym + $bugfix))->name | ||
| 81 | end | ||
| 82 | |||
| 73 | # Set up something to print out s-expressions. | 83 | # Set up something to print out s-expressions. |
| 74 | # We save and restore print_output_debug_flag to prevent the w32 port | 84 | # We save and restore print_output_debug_flag to prevent the w32 port |
| 75 | # from calling OutputDebugString, which causes GDB to display each | 85 | # from calling OutputDebugString, which causes GDB to display each |
| @@ -1073,8 +1083,8 @@ end | |||
| 1073 | 1083 | ||
| 1074 | define xprintsym | 1084 | define xprintsym |
| 1075 | xgetptr $arg0 | 1085 | xgetptr $arg0 |
| 1076 | set $sym = (struct Lisp_Symbol *) $ptr | 1086 | xsymname $ptr |
| 1077 | xgetptr $sym->name | 1087 | xgetptr $symname |
| 1078 | set $sym_name = (struct Lisp_String *) $ptr | 1088 | set $sym_name = (struct Lisp_String *) $ptr |
| 1079 | xprintstr $sym_name | 1089 | xprintstr $sym_name |
| 1080 | end | 1090 | end |
| @@ -1258,8 +1268,8 @@ tbreak init_sys_modes | |||
| 1258 | commands | 1268 | commands |
| 1259 | silent | 1269 | silent |
| 1260 | xgetptr globals.f_Vinitial_window_system | 1270 | xgetptr globals.f_Vinitial_window_system |
| 1261 | set $tem = (struct Lisp_Symbol *) $ptr | 1271 | xsymname $ptr |
| 1262 | xgetptr $tem->name | 1272 | xgetptr $symname |
| 1263 | set $tem = (struct Lisp_String *) $ptr | 1273 | set $tem = (struct Lisp_String *) $ptr |
| 1264 | set $tem = (char *) $tem->data | 1274 | set $tem = (char *) $tem->data |
| 1265 | # If we are running in synchronous mode, we want a chance to look | 1275 | # If we are running in synchronous mode, we want a chance to look |
diff --git a/src/ChangeLog b/src/ChangeLog index 8cf269680de..8f441be3307 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,246 @@ | |||
| 1 | 2015-01-11 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Port to MSB hosts without optimization | ||
| 4 | E.g., when configuring --with-wide-int CFLAGS='-O0' on x86, | ||
| 5 | the inline function XTYPE needs to be declared before being used. | ||
| 6 | * lisp.h (XTYPE): New forward declaration. | ||
| 7 | |||
| 8 | 2015-01-10 Paul Eggert <eggert@cs.ucla.edu> | ||
| 9 | |||
| 10 | Port to 32-bit --with-wide-int | ||
| 11 | Prefer symbol indexes to struct Lisp_Symbol * casted and then | ||
| 12 | widened, as the latter had trouble with GCC on Fedora 21 when | ||
| 13 | configured --with-wide-int and when used in static initializers. | ||
| 14 | * alloc.c (garbage_collect_1, which_symbols): | ||
| 15 | * lread.c (init_obarray): | ||
| 16 | Prefer builtin_lisp_symbol when it can be used. | ||
| 17 | * dispextern.h (struct image_type.type): | ||
| 18 | * font.c (font_property_table.key): | ||
| 19 | * frame.c (struct frame_parm_table.sym): | ||
| 20 | * keyboard.c (scroll_bar_parts, struct event_head): | ||
| 21 | * xdisp.c (struct props.name): | ||
| 22 | Use the index of a builtin symbol rather than its address. | ||
| 23 | All uses changed. | ||
| 24 | * lisp.h (TAG_SYMPTR, XSYMBOL_INIT): Remove, replacing with ... | ||
| 25 | (TAG_SYMOFFSET, SYMBOL_INDEX): ... new macros that deal with | ||
| 26 | symbol indexes rather than pointers, and which work better on MSB | ||
| 27 | hosts because they shift right before tagging. All uses changed. | ||
| 28 | (DEFINE_LISP_SYMBOL_BEGIN, DEFINE_LISP_SYMBOL_END): | ||
| 29 | No longer noops on wide-int hosts, since they work now. | ||
| 30 | (builtin_lisp_symbol): New function. | ||
| 31 | |||
| 32 | Port to HAVE_FREETYPE && !HAVE_XFT | ||
| 33 | * dispextern.h (struct face.extra) [HAVE_FREETYPE && !HAVE_XFT]: | ||
| 34 | * font.h (syms_of_xftfont) [HAVE_FREETYPE && !HAVE_XFT]: | ||
| 35 | Declare in this case too. | ||
| 36 | |||
| 37 | 2015-01-10 Eli Zaretskii <eliz@gnu.org> | ||
| 38 | |||
| 39 | * w32fns.c (Fw32_register_hot_key): Use XINT instead of XLI. | ||
| 40 | |||
| 41 | * w32notify.c (Fw32notify_add_watch, w32_get_watch_object): Use | ||
| 42 | make_pointer_integer instead of XIL. | ||
| 43 | (Fw32notify_rm_watch): Use XINTPTR instead of XLI. | ||
| 44 | |||
| 45 | * w32inevt.c (handle_file_notifications): Use make_pointer_integer | ||
| 46 | instead of XIL. Put a list of the descriptor, action, and file | ||
| 47 | name in event->arg, instead of spreading them between event->code | ||
| 48 | and event->arg. | ||
| 49 | |||
| 50 | * w32term.c (queue_notifications): Use make_pointer_integer | ||
| 51 | instead of XIL. Put a list of the descriptor, action, and file | ||
| 52 | name in event->arg, instead of spreading them between event->code | ||
| 53 | and event->arg. | ||
| 54 | |||
| 55 | * keyboard.c (kbd_buffer_get_event) [HAVE_W32NOTIFY]: Adjust Lisp | ||
| 56 | event creation to changes in w32term.c and w32inevt.c above. | ||
| 57 | |||
| 58 | 2015-01-09 Paul Eggert <eggert@cs.ucla.edu> | ||
| 59 | |||
| 60 | Port Qnil==0 changes to 32-bit --with-wide-int | ||
| 61 | * lisp.h (lisp_h_XSYMBOL, XSYMBOL): Assume USE_LSB_TAG in the | ||
| 62 | macro-implemented version. For the non-USE_LSB_TAG case, supply | ||
| 63 | a new inline function that is the inverse of the new TAG_SYMPTR. | ||
| 64 | (lisp_h_XUNTAGBASE, XUNTAGBASE): Remove. All uses removed. | ||
| 65 | (TAG_SYMPTR) [!USE_LSB_TAG]: If the pointer subtraction yields a | ||
| 66 | negative number, don't allow sign bits to bleed into the encoded | ||
| 67 | value. Shift in zero bits instead. | ||
| 68 | |||
| 69 | Refactor pointer-to-integer conversion | ||
| 70 | * gfilenotify.c (monitor_to_lisp, lisp_to_monitor): | ||
| 71 | Rename and move to lisp.h. All uses changed. | ||
| 72 | * lisp.h (XINTPTR, make_pointer_integer): New inline functions, | ||
| 73 | which are renamed from gfilenotify.c's lisp_to_monitor and | ||
| 74 | monitor_to_lisp, and with more-generic void * signatures. | ||
| 75 | |||
| 76 | 2015-01-08 Eli Zaretskii <eliz@gnu.org> | ||
| 77 | |||
| 78 | * dispnew.c (buffer_posn_from_coords): Fix the value of the column | ||
| 79 | returned for right-to-left screen lines. (Before the change on | ||
| 80 | 2014-12-30, the incorrectly-computed X pixel coordinate concealed | ||
| 81 | this bug.) | ||
| 82 | |||
| 83 | * .gdbinit (xsymname): New subroutine. | ||
| 84 | (xprintsym, initial-tbreak): Use it to access the name of a symbol | ||
| 85 | in a way that doesn't cause GDB to barf when it tries to | ||
| 86 | dereference a NULL pointer. | ||
| 87 | |||
| 88 | * xdisp.c (next_element_from_c_string): Use Lisp integer zero as | ||
| 89 | the object. | ||
| 90 | (set_cursor_from_row, try_cursor_movement, dump_glyph) | ||
| 91 | (insert_left_trunc_glyphs, append_space_for_newline) | ||
| 92 | (extend_face_to_end_of_line, highlight_trailing_whitespace) | ||
| 93 | (find_row_edges, ROW_GLYPH_NEWLINE_P, Fmove_point_visually) | ||
| 94 | (Fbidi_resolved_levels, produce_special_glyphs) | ||
| 95 | (rows_from_pos_range, mouse_face_from_buffer_pos) | ||
| 96 | (note_mouse_highlight): Use nil as the object for glyphs inserted | ||
| 97 | by the display engine, and test with NILP instead of INTEGERP. | ||
| 98 | (Bug#19535) | ||
| 99 | |||
| 100 | * w32fns.c (Fx_show_tip): Use NILP to test for glyphs inserted by | ||
| 101 | the display engine. | ||
| 102 | |||
| 103 | * xfns.c (Fx_show_tip): Use NILP to test for glyphs inserted by | ||
| 104 | the display engine. | ||
| 105 | |||
| 106 | * dispextern.h (struct glyph, struct it): Update comments for the | ||
| 107 | OBJECT members. | ||
| 108 | |||
| 109 | 2015-01-08 Paul Eggert <eggert@cs.ucla.edu> | ||
| 110 | |||
| 111 | Port new Lisp symbol init to x86 --with-wide-int | ||
| 112 | * lisp.h (DEFINE_LISP_SYMBOL_BEGIN, DEFINE_LISP_SYMBOL_END): | ||
| 113 | Define to empty on platforms where EMACS_INT_MAX != INTPTR_MAX, as | ||
| 114 | GCC (at least) does not allow a constant initializer to widen an | ||
| 115 | address constant. | ||
| 116 | |||
| 117 | * lisp.h (TAG_SYMPTR): Don't do arithmetic on NULL. | ||
| 118 | This is a followup to the "Port Qnil==0 XUNTAG to clang" patch. | ||
| 119 | Although clang doesn't need it, some other compiler might, and | ||
| 120 | it's easy enough to be safe. | ||
| 121 | |||
| 122 | * conf_post.h (ATTRIBUTE_ALLOC_SIZE): Port to clang 3.5.0. | ||
| 123 | Apparently clang removed support for the alloc_size attribute. | ||
| 124 | |||
| 125 | Port Qnil==0 XUNTAG to clang | ||
| 126 | clang has undefined behavior if the program subtracts an integer | ||
| 127 | from (char *) 0. Problem reported by YAMAMOTO Mitsuharu in: | ||
| 128 | http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00132.html | ||
| 129 | * lisp.h (lisp_h_XUNTAG) [USE_LSB_TAG]: | ||
| 130 | (XUNTAG) [!USE_LSB_TAG]: Port to clang 3.5.0. | ||
| 131 | |||
| 132 | Port GFileMonitor * hack to Qnil==0 platforms | ||
| 133 | Reported by Glenn Morris in: http://bugs.gnu.org/15880#112 | ||
| 134 | * gfilenotify.c (monitor_to_lisp, lisp_to_monitor): New functions. | ||
| 135 | (dir_monitor_callback, Fgfile_add_watch, Fgfile_rm_watch): Use them. | ||
| 136 | |||
| 137 | 2015-01-06 Jan Djärv <jan.h.d@swipnet.se> | ||
| 138 | |||
| 139 | * nsterm.m (x_set_window_size): Call updateFrameSize to get real | ||
| 140 | size instead of using widht/height. The frame may be constrained. | ||
| 141 | |||
| 142 | 2015-01-05 Paul Eggert <eggert@cs.ucla.edu> | ||
| 143 | |||
| 144 | * lisp.h (XSYMBOL): Parenthesize id in forward decl. | ||
| 145 | Needed when neither optimizing nor inlining. | ||
| 146 | Also, sort decls alphabetically. | ||
| 147 | |||
| 148 | 2015-01-05 Eli Zaretskii <eliz@gnu.org> | ||
| 149 | |||
| 150 | * w32proc.c, w32.h, w32fns.c, w32font.c, w32menu.c, w32notify.c: | ||
| 151 | * w32proc.c, w32select.c, w32term.c, w32uniscribe.c: Remove | ||
| 152 | declarations of Q* variables that represent symbols. | ||
| 153 | |||
| 154 | 2015-01-05 Paul Eggert <eggert@cs.ucla.edu> | ||
| 155 | |||
| 156 | Use 0 for Qnil | ||
| 157 | Fixes Bug#15880. | ||
| 158 | If USE_LSB_TAG, arrange for the representation of Qnil to be zero so | ||
| 159 | that NILP (x) is equivalent to testing whether x is 0 at the | ||
| 160 | machine level. The overall effects of this and the previous patch | ||
| 161 | shrink the size of the text segment by 2.3% and speeds up | ||
| 162 | compilation of all the .elc files by about 0.5% on my platform, | ||
| 163 | which is Fedora 20 x86-64. | ||
| 164 | * lisp.h (lisp_h_XPNTR, lisp_h_XSYMBOL, lisp_h_XUNTAG) | ||
| 165 | (make_lisp_symbol) [USE_LSB_TAG]: | ||
| 166 | Symbols now tag the difference from lispsym, not the pointer. | ||
| 167 | (lisp_h_XUNTAGBASE, TAG_SYMPTR): New macros. | ||
| 168 | (Lisp_Int0, Lisp_Int1, Lisp_Symbol, Lisp_Misc, Lisp_String, Lisp_Cons): | ||
| 169 | Renumber so that Lisp_Symbol is 0, so that Qnil is zero. | ||
| 170 | (XSYMBOL): New forward decl. | ||
| 171 | (XUNTAGBASE): New function. | ||
| 172 | (XUNTAG): Use it. | ||
| 173 | |||
| 174 | Compute C decls for DEFSYMs automatically | ||
| 175 | Fixes Bug#15880. | ||
| 176 | This patch also makes Q constants (e.g., Qnil) constant addresses | ||
| 177 | from the C point of view. | ||
| 178 | * alloc.c, bidi.c, buffer.c, bytecode.c, callint.c, casefiddle.c: | ||
| 179 | * casetab.c, category.c, ccl.c, charset.c, chartab.c, cmds.c, coding.c: | ||
| 180 | * composite.c, data.c, dbusbind.c, decompress.c, dired.c, dispnew.c: | ||
| 181 | * doc.c, editfns.c, emacs.c, eval.c, fileio.c, fns.c, font.c, fontset.c: | ||
| 182 | * frame.c, fringe.c, ftfont.c, ftxfont.c, gfilenotify.c, gnutls.c: | ||
| 183 | * image.c, inotify.c, insdel.c, keyboard.c, keymap.c, lread.c: | ||
| 184 | * macfont.m, macros.c, minibuf.c, nsfns.m, nsfont.m, nsimage.m: | ||
| 185 | * nsmenu.m, nsselect.m, nsterm.m, print.c, process.c, profiler.c: | ||
| 186 | * search.c, sound.c, syntax.c, term.c, terminal.c, textprop.c, undo.c: | ||
| 187 | * window.c, xdisp.c, xfaces.c, xfns.c, xftfont.c, xmenu.c, xml.c: | ||
| 188 | * xselect.c, xsettings.c, xterm.c: | ||
| 189 | Remove Q vars that represent symbols (e.g., Qnil, Qt, Qemacs). | ||
| 190 | These names are now defined automatically by make-docfile. | ||
| 191 | * alloc.c (init_symbol): New function. | ||
| 192 | (Fmake_symbol): Use it. | ||
| 193 | (c_symbol_p): New function. | ||
| 194 | (valid_lisp_object_p, purecopy): Use it. | ||
| 195 | * alloc.c (marked_pinned_symbols): | ||
| 196 | Use make_lisp_symbol instead of make_lisp_ptr. | ||
| 197 | (garbage_collect_1): Mark lispsym symbols. | ||
| 198 | (CHECK_ALLOCATED_AND_LIVE_SYMBOL): New macro. | ||
| 199 | (mark_object): Use it. | ||
| 200 | (sweep_symbols): Sweep lispsym symbols. | ||
| 201 | (symbol_uses_obj): New function. | ||
| 202 | (which_symbols): Use it. Work for lispsym symbols, too. | ||
| 203 | (init_alloc_once): Initialize Vpurify_flag here; no need to wait, | ||
| 204 | since Qt's address is already known now. | ||
| 205 | (syms_of_alloc): Add lispsym count to symbols_consed. | ||
| 206 | * buffer.c (init_buffer_once): Compare to Qnil, not to make_number (0), | ||
| 207 | when testing whether storage is all bits zero. | ||
| 208 | * dispextern.h (struct image_type): | ||
| 209 | * font.c (font_property_table): | ||
| 210 | * frame.c (struct frame_parm_table, frame_parms): | ||
| 211 | * keyboard.c (scroll_bar_parts, struct event_head): | ||
| 212 | * xdisp.c (struct props): | ||
| 213 | Use XSYMBOL_INIT (Qfoo) and struct Lisp_Symbol * rather than &Qfoo and | ||
| 214 | Lisp_Object *, since Qfoo is no longer an object whose address can be | ||
| 215 | taken. All uses changed. | ||
| 216 | * eval.c (run_hook): New function. Most uses of Frun_hooks changed to | ||
| 217 | use it, so that they no longer need to take the address of a Lisp sym. | ||
| 218 | (syms_of_eval): Don't use DEFSYM on Vrun_hooks, as it's a variable. | ||
| 219 | * frame.c (syms_of_frame): Add defsyms for the frame_parms table. | ||
| 220 | * keyboard.c (syms_of_keyboard): Don't DEFSYM Qmenu_bar here. | ||
| 221 | DEFSYM Qdeactivate_mark before the corresponding var. | ||
| 222 | * keymap.c (syms_of_keymap): Use DEFSYM for Qmenu_bar and Qmode_line | ||
| 223 | instead of interning their symbols; this avoids duplicates. | ||
| 224 | (LISP_INITIALLY, TAG_PTR) | ||
| 225 | (DEFINE_LISP_SYMBOL_BEGIN, DEFINE_LISP_SYMBOL_END, XSYMBOL_INIT): | ||
| 226 | New macros. | ||
| 227 | (LISP_INITIALLY_ZERO): Use it. | ||
| 228 | (enum symbol_interned, enum symbol_redirect, struct Lisp_Symbol) | ||
| 229 | (EXFUN, DEFUN_ARGS_MANY, DEFUN_ARGS_UNEVALLED, DEFUN_ARGS_*): | ||
| 230 | Move decls up, to avoid forward uses. Include globals.h earlier, too. | ||
| 231 | (make_lisp_symbol): New function. | ||
| 232 | (XSETSYMBOL): Use it. | ||
| 233 | (DEFSYM): Now just a placeholder for make-docfile. | ||
| 234 | * lread.c (DEFINE_SYMBOLS): Define, for globals.h. | ||
| 235 | (intern_sym): New function, with body taken from old intern_driver. | ||
| 236 | (intern_driver): Use it. Last arg is now Lisp integer, not ptrdiff_t. | ||
| 237 | All uses changed. | ||
| 238 | (define_symbol): New function. | ||
| 239 | (init_obarray): Define the C symbols taken from lispsym. | ||
| 240 | Use plain DEFSYM for Qt and Qnil. | ||
| 241 | * syntax.c (init_syntax_once): No need to worry about | ||
| 242 | Qchar_table_extra_slots. | ||
| 243 | |||
| 1 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> | 244 | 2015-01-04 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 245 | ||
| 3 | 'temacs -nw' should not call missing functions | 246 | 'temacs -nw' should not call missing functions |
| @@ -146,6 +389,10 @@ | |||
| 146 | * xterm.c (do_ewmh_fullscreen): Don't remove maximized_horz/vert | 389 | * xterm.c (do_ewmh_fullscreen): Don't remove maximized_horz/vert |
| 147 | when going to fullscreen (Bug#0x180004f). | 390 | when going to fullscreen (Bug#0x180004f). |
| 148 | 391 | ||
| 392 | 2014-12-27 Eli Zaretskii <eliz@gnu.org> | ||
| 393 | |||
| 394 | * window.c (Fwindow_body_width): Doc fix. (Bug#19395) | ||
| 395 | |||
| 149 | 2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> | 396 | 2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> |
| 150 | 397 | ||
| 151 | * buffer.c (syms_of_buffer) <Vafter_change_functions>: fix docstring. | 398 | * buffer.c (syms_of_buffer) <Vafter_change_functions>: fix docstring. |
diff --git a/src/alloc.c b/src/alloc.c index ecea3e8ac7d..7c937332407 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -263,23 +263,6 @@ no_sanitize_memcpy (void *dest, void const *src, size_t size) | |||
| 263 | 263 | ||
| 264 | #endif /* MAX_SAVE_STACK > 0 */ | 264 | #endif /* MAX_SAVE_STACK > 0 */ |
| 265 | 265 | ||
| 266 | static Lisp_Object Qconses; | ||
| 267 | static Lisp_Object Qsymbols; | ||
| 268 | static Lisp_Object Qmiscs; | ||
| 269 | static Lisp_Object Qstrings; | ||
| 270 | static Lisp_Object Qvectors; | ||
| 271 | static Lisp_Object Qfloats; | ||
| 272 | static Lisp_Object Qintervals; | ||
| 273 | static Lisp_Object Qbuffers; | ||
| 274 | static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; | ||
| 275 | static Lisp_Object Qgc_cons_threshold; | ||
| 276 | Lisp_Object Qautomatic_gc; | ||
| 277 | Lisp_Object Qchar_table_extra_slots; | ||
| 278 | |||
| 279 | /* Hook run after GC has finished. */ | ||
| 280 | |||
| 281 | static Lisp_Object Qpost_gc_hook; | ||
| 282 | |||
| 283 | static void mark_terminals (void); | 266 | static void mark_terminals (void); |
| 284 | static void gc_sweep (void); | 267 | static void gc_sweep (void); |
| 285 | static Lisp_Object make_pure_vector (ptrdiff_t); | 268 | static Lisp_Object make_pure_vector (ptrdiff_t); |
| @@ -3410,13 +3393,29 @@ set_symbol_name (Lisp_Object sym, Lisp_Object name) | |||
| 3410 | XSYMBOL (sym)->name = name; | 3393 | XSYMBOL (sym)->name = name; |
| 3411 | } | 3394 | } |
| 3412 | 3395 | ||
| 3396 | void | ||
| 3397 | init_symbol (Lisp_Object val, Lisp_Object name) | ||
| 3398 | { | ||
| 3399 | struct Lisp_Symbol *p = XSYMBOL (val); | ||
| 3400 | set_symbol_name (val, name); | ||
| 3401 | set_symbol_plist (val, Qnil); | ||
| 3402 | p->redirect = SYMBOL_PLAINVAL; | ||
| 3403 | SET_SYMBOL_VAL (p, Qunbound); | ||
| 3404 | set_symbol_function (val, Qnil); | ||
| 3405 | set_symbol_next (val, NULL); | ||
| 3406 | p->gcmarkbit = false; | ||
| 3407 | p->interned = SYMBOL_UNINTERNED; | ||
| 3408 | p->constant = 0; | ||
| 3409 | p->declared_special = false; | ||
| 3410 | p->pinned = false; | ||
| 3411 | } | ||
| 3412 | |||
| 3413 | DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, | 3413 | DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, |
| 3414 | doc: /* Return a newly allocated uninterned symbol whose name is NAME. | 3414 | doc: /* Return a newly allocated uninterned symbol whose name is NAME. |
| 3415 | Its value is void, and its function definition and property list are nil. */) | 3415 | Its value is void, and its function definition and property list are nil. */) |
| 3416 | (Lisp_Object name) | 3416 | (Lisp_Object name) |
| 3417 | { | 3417 | { |
| 3418 | register Lisp_Object val; | 3418 | Lisp_Object val; |
| 3419 | register struct Lisp_Symbol *p; | ||
| 3420 | 3419 | ||
| 3421 | CHECK_STRING (name); | 3420 | CHECK_STRING (name); |
| 3422 | 3421 | ||
| @@ -3444,18 +3443,7 @@ Its value is void, and its function definition and property list are nil. */) | |||
| 3444 | 3443 | ||
| 3445 | MALLOC_UNBLOCK_INPUT; | 3444 | MALLOC_UNBLOCK_INPUT; |
| 3446 | 3445 | ||
| 3447 | p = XSYMBOL (val); | 3446 | init_symbol (val, name); |
| 3448 | set_symbol_name (val, name); | ||
| 3449 | set_symbol_plist (val, Qnil); | ||
| 3450 | p->redirect = SYMBOL_PLAINVAL; | ||
| 3451 | SET_SYMBOL_VAL (p, Qunbound); | ||
| 3452 | set_symbol_function (val, Qnil); | ||
| 3453 | set_symbol_next (val, NULL); | ||
| 3454 | p->gcmarkbit = false; | ||
| 3455 | p->interned = SYMBOL_UNINTERNED; | ||
| 3456 | p->constant = 0; | ||
| 3457 | p->declared_special = false; | ||
| 3458 | p->pinned = false; | ||
| 3459 | consing_since_gc += sizeof (struct Lisp_Symbol); | 3447 | consing_since_gc += sizeof (struct Lisp_Symbol); |
| 3460 | symbols_consed++; | 3448 | symbols_consed++; |
| 3461 | total_free_symbols--; | 3449 | total_free_symbols--; |
| @@ -4925,6 +4913,14 @@ mark_stack (void *end) | |||
| 4925 | 4913 | ||
| 4926 | #endif /* GC_MARK_STACK != 0 */ | 4914 | #endif /* GC_MARK_STACK != 0 */ |
| 4927 | 4915 | ||
| 4916 | static bool | ||
| 4917 | c_symbol_p (struct Lisp_Symbol *sym) | ||
| 4918 | { | ||
| 4919 | char *lispsym_ptr = (char *) lispsym; | ||
| 4920 | char *sym_ptr = (char *) sym; | ||
| 4921 | ptrdiff_t lispsym_offset = sym_ptr - lispsym_ptr; | ||
| 4922 | return 0 <= lispsym_offset && lispsym_offset < sizeof lispsym; | ||
| 4923 | } | ||
| 4928 | 4924 | ||
| 4929 | /* Determine whether it is safe to access memory at address P. */ | 4925 | /* Determine whether it is safe to access memory at address P. */ |
| 4930 | static int | 4926 | static int |
| @@ -4978,6 +4974,9 @@ valid_lisp_object_p (Lisp_Object obj) | |||
| 4978 | if (PURE_POINTER_P (p)) | 4974 | if (PURE_POINTER_P (p)) |
| 4979 | return 1; | 4975 | return 1; |
| 4980 | 4976 | ||
| 4977 | if (SYMBOLP (obj) && c_symbol_p (p)) | ||
| 4978 | return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0; | ||
| 4979 | |||
| 4981 | if (p == &buffer_defaults || p == &buffer_local_symbols) | 4980 | if (p == &buffer_defaults || p == &buffer_local_symbols) |
| 4982 | return 2; | 4981 | return 2; |
| 4983 | 4982 | ||
| @@ -5343,7 +5342,7 @@ purecopy (Lisp_Object obj) | |||
| 5343 | } | 5342 | } |
| 5344 | else if (SYMBOLP (obj)) | 5343 | else if (SYMBOLP (obj)) |
| 5345 | { | 5344 | { |
| 5346 | if (!XSYMBOL (obj)->pinned) | 5345 | if (!XSYMBOL (obj)->pinned && !c_symbol_p (XSYMBOL (obj))) |
| 5347 | { /* We can't purify them, but they appear in many pure objects. | 5346 | { /* We can't purify them, but they appear in many pure objects. |
| 5348 | Mark them as `pinned' so we know to mark them at every GC cycle. */ | 5347 | Mark them as `pinned' so we know to mark them at every GC cycle. */ |
| 5349 | XSYMBOL (obj)->pinned = true; | 5348 | XSYMBOL (obj)->pinned = true; |
| @@ -5532,7 +5531,7 @@ mark_pinned_symbols (void) | |||
| 5532 | union aligned_Lisp_Symbol *sym = sblk->symbols, *end = sym + lim; | 5531 | union aligned_Lisp_Symbol *sym = sblk->symbols, *end = sym + lim; |
| 5533 | for (; sym < end; ++sym) | 5532 | for (; sym < end; ++sym) |
| 5534 | if (sym->s.pinned) | 5533 | if (sym->s.pinned) |
| 5535 | mark_object (make_lisp_ptr (&sym->s, Lisp_Symbol)); | 5534 | mark_object (make_lisp_symbol (&sym->s)); |
| 5536 | 5535 | ||
| 5537 | lim = SYMBOL_BLOCK_SIZE; | 5536 | lim = SYMBOL_BLOCK_SIZE; |
| 5538 | } | 5537 | } |
| @@ -5566,7 +5565,7 @@ garbage_collect_1 (void *end) | |||
| 5566 | return Qnil; | 5565 | return Qnil; |
| 5567 | 5566 | ||
| 5568 | /* Record this function, so it appears on the profiler's backtraces. */ | 5567 | /* Record this function, so it appears on the profiler's backtraces. */ |
| 5569 | record_in_backtrace (Qautomatic_gc, &Qnil, 0); | 5568 | record_in_backtrace (Qautomatic_gc, 0, 0); |
| 5570 | 5569 | ||
| 5571 | check_cons_list (); | 5570 | check_cons_list (); |
| 5572 | 5571 | ||
| @@ -5630,6 +5629,9 @@ garbage_collect_1 (void *end) | |||
| 5630 | mark_buffer (&buffer_defaults); | 5629 | mark_buffer (&buffer_defaults); |
| 5631 | mark_buffer (&buffer_local_symbols); | 5630 | mark_buffer (&buffer_local_symbols); |
| 5632 | 5631 | ||
| 5632 | for (i = 0; i < ARRAYELTS (lispsym); i++) | ||
| 5633 | mark_object (builtin_lisp_symbol (i)); | ||
| 5634 | |||
| 5633 | for (i = 0; i < staticidx; i++) | 5635 | for (i = 0; i < staticidx; i++) |
| 5634 | mark_object (*staticvec[i]); | 5636 | mark_object (*staticvec[i]); |
| 5635 | 5637 | ||
| @@ -6193,17 +6195,28 @@ mark_object (Lisp_Object arg) | |||
| 6193 | emacs_abort (); \ | 6195 | emacs_abort (); \ |
| 6194 | } while (0) | 6196 | } while (0) |
| 6195 | 6197 | ||
| 6196 | /* Check both of the above conditions. */ | 6198 | /* Check both of the above conditions, for non-symbols. */ |
| 6197 | #define CHECK_ALLOCATED_AND_LIVE(LIVEP) \ | 6199 | #define CHECK_ALLOCATED_AND_LIVE(LIVEP) \ |
| 6198 | do { \ | 6200 | do { \ |
| 6199 | CHECK_ALLOCATED (); \ | 6201 | CHECK_ALLOCATED (); \ |
| 6200 | CHECK_LIVE (LIVEP); \ | 6202 | CHECK_LIVE (LIVEP); \ |
| 6201 | } while (0) \ | 6203 | } while (0) \ |
| 6202 | 6204 | ||
| 6205 | /* Check both of the above conditions, for symbols. */ | ||
| 6206 | #define CHECK_ALLOCATED_AND_LIVE_SYMBOL() \ | ||
| 6207 | do { \ | ||
| 6208 | if (!c_symbol_p (ptr)) \ | ||
| 6209 | { \ | ||
| 6210 | CHECK_ALLOCATED (); \ | ||
| 6211 | CHECK_LIVE (live_symbol_p); \ | ||
| 6212 | } \ | ||
| 6213 | } while (0) \ | ||
| 6214 | |||
| 6203 | #else /* not GC_CHECK_MARKED_OBJECTS */ | 6215 | #else /* not GC_CHECK_MARKED_OBJECTS */ |
| 6204 | 6216 | ||
| 6205 | #define CHECK_LIVE(LIVEP) ((void) 0) | 6217 | #define CHECK_LIVE(LIVEP) ((void) 0) |
| 6206 | #define CHECK_ALLOCATED_AND_LIVE(LIVEP) ((void) 0) | 6218 | #define CHECK_ALLOCATED_AND_LIVE(LIVEP) ((void) 0) |
| 6219 | #define CHECK_ALLOCATED_AND_LIVE_SYMBOL() ((void) 0) | ||
| 6207 | 6220 | ||
| 6208 | #endif /* not GC_CHECK_MARKED_OBJECTS */ | 6221 | #endif /* not GC_CHECK_MARKED_OBJECTS */ |
| 6209 | 6222 | ||
| @@ -6363,7 +6376,7 @@ mark_object (Lisp_Object arg) | |||
| 6363 | nextsym: | 6376 | nextsym: |
| 6364 | if (ptr->gcmarkbit) | 6377 | if (ptr->gcmarkbit) |
| 6365 | break; | 6378 | break; |
| 6366 | CHECK_ALLOCATED_AND_LIVE (live_symbol_p); | 6379 | CHECK_ALLOCATED_AND_LIVE_SYMBOL (); |
| 6367 | ptr->gcmarkbit = 1; | 6380 | ptr->gcmarkbit = 1; |
| 6368 | /* Attempt to catch bogus objects. */ | 6381 | /* Attempt to catch bogus objects. */ |
| 6369 | eassert (valid_lisp_object_p (ptr->function)); | 6382 | eassert (valid_lisp_object_p (ptr->function)); |
| @@ -6720,13 +6733,16 @@ NO_INLINE /* For better stack traces */ | |||
| 6720 | static void | 6733 | static void |
| 6721 | sweep_symbols (void) | 6734 | sweep_symbols (void) |
| 6722 | { | 6735 | { |
| 6723 | register struct symbol_block *sblk; | 6736 | struct symbol_block *sblk; |
| 6724 | struct symbol_block **sprev = &symbol_block; | 6737 | struct symbol_block **sprev = &symbol_block; |
| 6725 | register int lim = symbol_block_index; | 6738 | int lim = symbol_block_index; |
| 6726 | EMACS_INT num_free = 0, num_used = 0; | 6739 | EMACS_INT num_free = 0, num_used = ARRAYELTS (lispsym); |
| 6727 | 6740 | ||
| 6728 | symbol_free_list = NULL; | 6741 | symbol_free_list = NULL; |
| 6729 | 6742 | ||
| 6743 | for (int i = 0; i < ARRAYELTS (lispsym); i++) | ||
| 6744 | lispsym[i].gcmarkbit = 0; | ||
| 6745 | |||
| 6730 | for (sblk = symbol_block; sblk; sblk = *sprev) | 6746 | for (sblk = symbol_block; sblk; sblk = *sprev) |
| 6731 | { | 6747 | { |
| 6732 | int this_free = 0; | 6748 | int this_free = 0; |
| @@ -6974,6 +6990,21 @@ Frames, windows, buffers, and subprocesses count as vectors | |||
| 6974 | bounded_number (strings_consed)); | 6990 | bounded_number (strings_consed)); |
| 6975 | } | 6991 | } |
| 6976 | 6992 | ||
| 6993 | static bool | ||
| 6994 | symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj) | ||
| 6995 | { | ||
| 6996 | struct Lisp_Symbol *sym = XSYMBOL (symbol); | ||
| 6997 | Lisp_Object val = find_symbol_value (symbol); | ||
| 6998 | return (EQ (val, obj) | ||
| 6999 | || EQ (sym->function, obj) | ||
| 7000 | || (!NILP (sym->function) | ||
| 7001 | && COMPILEDP (sym->function) | ||
| 7002 | && EQ (AREF (sym->function, COMPILED_BYTECODE), obj)) | ||
| 7003 | || (!NILP (val) | ||
| 7004 | && COMPILEDP (val) | ||
| 7005 | && EQ (AREF (val, COMPILED_BYTECODE), obj))); | ||
| 7006 | } | ||
| 7007 | |||
| 6977 | /* Find at most FIND_MAX symbols which have OBJ as their value or | 7008 | /* Find at most FIND_MAX symbols which have OBJ as their value or |
| 6978 | function. This is used in gdbinit's `xwhichsymbols' command. */ | 7009 | function. This is used in gdbinit's `xwhichsymbols' command. */ |
| 6979 | 7010 | ||
| @@ -6986,6 +7017,17 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max) | |||
| 6986 | 7017 | ||
| 6987 | if (! DEADP (obj)) | 7018 | if (! DEADP (obj)) |
| 6988 | { | 7019 | { |
| 7020 | for (int i = 0; i < ARRAYELTS (lispsym); i++) | ||
| 7021 | { | ||
| 7022 | Lisp_Object sym = builtin_lisp_symbol (i); | ||
| 7023 | if (symbol_uses_obj (sym, obj)) | ||
| 7024 | { | ||
| 7025 | found = Fcons (sym, found); | ||
| 7026 | if (--find_max == 0) | ||
| 7027 | goto out; | ||
| 7028 | } | ||
| 7029 | } | ||
| 7030 | |||
| 6989 | for (sblk = symbol_block; sblk; sblk = sblk->next) | 7031 | for (sblk = symbol_block; sblk; sblk = sblk->next) |
| 6990 | { | 7032 | { |
| 6991 | union aligned_Lisp_Symbol *aligned_sym = sblk->symbols; | 7033 | union aligned_Lisp_Symbol *aligned_sym = sblk->symbols; |
| @@ -6993,25 +7035,13 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max) | |||
| 6993 | 7035 | ||
| 6994 | for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, aligned_sym++) | 7036 | for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, aligned_sym++) |
| 6995 | { | 7037 | { |
| 6996 | struct Lisp_Symbol *sym = &aligned_sym->s; | ||
| 6997 | Lisp_Object val; | ||
| 6998 | Lisp_Object tem; | ||
| 6999 | |||
| 7000 | if (sblk == symbol_block && bn >= symbol_block_index) | 7038 | if (sblk == symbol_block && bn >= symbol_block_index) |
| 7001 | break; | 7039 | break; |
| 7002 | 7040 | ||
| 7003 | XSETSYMBOL (tem, sym); | 7041 | Lisp_Object sym = make_lisp_symbol (&aligned_sym->s); |
| 7004 | val = find_symbol_value (tem); | 7042 | if (symbol_uses_obj (sym, obj)) |
| 7005 | if (EQ (val, obj) | ||
| 7006 | || EQ (sym->function, obj) | ||
| 7007 | || (!NILP (sym->function) | ||
| 7008 | && COMPILEDP (sym->function) | ||
| 7009 | && EQ (AREF (sym->function, COMPILED_BYTECODE), obj)) | ||
| 7010 | || (!NILP (val) | ||
| 7011 | && COMPILEDP (val) | ||
| 7012 | && EQ (AREF (val, COMPILED_BYTECODE), obj))) | ||
| 7013 | { | 7043 | { |
| 7014 | found = Fcons (tem, found); | 7044 | found = Fcons (sym, found); |
| 7015 | if (--find_max == 0) | 7045 | if (--find_max == 0) |
| 7016 | goto out; | 7046 | goto out; |
| 7017 | } | 7047 | } |
| @@ -7154,7 +7184,9 @@ verify_alloca (void) | |||
| 7154 | void | 7184 | void |
| 7155 | init_alloc_once (void) | 7185 | init_alloc_once (void) |
| 7156 | { | 7186 | { |
| 7157 | /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */ | 7187 | /* Even though Qt's contents are not set up, its address is known. */ |
| 7188 | Vpurify_flag = Qt; | ||
| 7189 | |||
| 7158 | purebeg = PUREBEG; | 7190 | purebeg = PUREBEG; |
| 7159 | pure_size = PURESIZE; | 7191 | pure_size = PURESIZE; |
| 7160 | 7192 | ||
| @@ -7230,6 +7262,7 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); | |||
| 7230 | 7262 | ||
| 7231 | DEFVAR_INT ("symbols-consed", symbols_consed, | 7263 | DEFVAR_INT ("symbols-consed", symbols_consed, |
| 7232 | doc: /* Number of symbols that have been consed so far. */); | 7264 | doc: /* Number of symbols that have been consed so far. */); |
| 7265 | symbols_consed += ARRAYELTS (lispsym); | ||
| 7233 | 7266 | ||
| 7234 | DEFVAR_INT ("string-chars-consed", string_chars_consed, | 7267 | DEFVAR_INT ("string-chars-consed", string_chars_consed, |
| 7235 | doc: /* Number of string characters that have been consed so far. */); | 7268 | doc: /* Number of string characters that have been consed so far. */); |
diff --git a/src/bidi.c b/src/bidi.c index ef0092f3d93..cbc1820c2a5 100644 --- a/src/bidi.c +++ b/src/bidi.c | |||
| @@ -262,7 +262,6 @@ typedef enum { | |||
| 262 | } bidi_category_t; | 262 | } bidi_category_t; |
| 263 | 263 | ||
| 264 | static Lisp_Object paragraph_start_re, paragraph_separate_re; | 264 | static Lisp_Object paragraph_start_re, paragraph_separate_re; |
| 265 | static Lisp_Object Qparagraph_start, Qparagraph_separate; | ||
| 266 | 265 | ||
| 267 | 266 | ||
| 268 | /*********************************************************************** | 267 | /*********************************************************************** |
diff --git a/src/buffer.c b/src/buffer.c index 7023a515571..2ea69f38f91 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -118,41 +118,8 @@ static void reset_buffer_local_variables (struct buffer *, bool); | |||
| 118 | due to user rplac'ing this alist or its elements. */ | 118 | due to user rplac'ing this alist or its elements. */ |
| 119 | Lisp_Object Vbuffer_alist; | 119 | Lisp_Object Vbuffer_alist; |
| 120 | 120 | ||
| 121 | static Lisp_Object Qkill_buffer_query_functions; | ||
| 122 | |||
| 123 | /* Hook run before changing a major mode. */ | ||
| 124 | static Lisp_Object Qchange_major_mode_hook; | ||
| 125 | |||
| 126 | Lisp_Object Qfirst_change_hook; | ||
| 127 | Lisp_Object Qbefore_change_functions; | ||
| 128 | Lisp_Object Qafter_change_functions; | ||
| 129 | |||
| 130 | static Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local; | ||
| 131 | static Lisp_Object Qpermanent_local_hook; | ||
| 132 | |||
| 133 | static Lisp_Object Qprotected_field; | ||
| 134 | |||
| 135 | static Lisp_Object QSFundamental; /* A string "Fundamental". */ | 121 | static Lisp_Object QSFundamental; /* A string "Fundamental". */ |
| 136 | 122 | ||
| 137 | static Lisp_Object Qkill_buffer_hook; | ||
| 138 | static Lisp_Object Qbuffer_list_update_hook; | ||
| 139 | |||
| 140 | static Lisp_Object Qget_file_buffer; | ||
| 141 | |||
| 142 | static Lisp_Object Qoverlayp; | ||
| 143 | |||
| 144 | Lisp_Object Qpriority, Qbefore_string, Qafter_string; | ||
| 145 | |||
| 146 | static Lisp_Object Qevaporate; | ||
| 147 | |||
| 148 | Lisp_Object Qmodification_hooks; | ||
| 149 | Lisp_Object Qinsert_in_front_hooks; | ||
| 150 | Lisp_Object Qinsert_behind_hooks; | ||
| 151 | |||
| 152 | Lisp_Object Qchoice, Qrange, Qleft, Qright; | ||
| 153 | Lisp_Object Qvertical_scroll_bar, Qhorizontal_scroll_bar; | ||
| 154 | static Lisp_Object Qoverwrite_mode, Qfraction; | ||
| 155 | |||
| 156 | static void alloc_buffer_text (struct buffer *, ptrdiff_t); | 123 | static void alloc_buffer_text (struct buffer *, ptrdiff_t); |
| 157 | static void free_buffer_text (struct buffer *b); | 124 | static void free_buffer_text (struct buffer *b); |
| 158 | static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *); | 125 | static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *); |
| @@ -1719,7 +1686,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) | |||
| 1719 | return unbind_to (count, Qt); | 1686 | return unbind_to (count, Qt); |
| 1720 | 1687 | ||
| 1721 | /* Then run the hooks. */ | 1688 | /* Then run the hooks. */ |
| 1722 | Frun_hooks (1, &Qkill_buffer_hook); | 1689 | run_hook (Qkill_buffer_hook); |
| 1723 | unbind_to (count, Qnil); | 1690 | unbind_to (count, Qnil); |
| 1724 | } | 1691 | } |
| 1725 | 1692 | ||
| @@ -2748,7 +2715,7 @@ The first thing this function does is run | |||
| 2748 | the normal hook `change-major-mode-hook'. */) | 2715 | the normal hook `change-major-mode-hook'. */) |
| 2749 | (void) | 2716 | (void) |
| 2750 | { | 2717 | { |
| 2751 | Frun_hooks (1, &Qchange_major_mode_hook); | 2718 | run_hook (Qchange_major_mode_hook); |
| 2752 | 2719 | ||
| 2753 | /* Make sure none of the bindings in local_var_alist | 2720 | /* Make sure none of the bindings in local_var_alist |
| 2754 | remain swapped in, in their symbols. */ | 2721 | remain swapped in, in their symbols. */ |
| @@ -5071,9 +5038,9 @@ init_buffer_once (void) | |||
| 5071 | /* Make sure all markable slots in buffer_defaults | 5038 | /* Make sure all markable slots in buffer_defaults |
| 5072 | are initialized reasonably, so mark_buffer won't choke. */ | 5039 | are initialized reasonably, so mark_buffer won't choke. */ |
| 5073 | reset_buffer (&buffer_defaults); | 5040 | reset_buffer (&buffer_defaults); |
| 5074 | eassert (EQ (BVAR (&buffer_defaults, name), make_number (0))); | 5041 | eassert (NILP (BVAR (&buffer_defaults, name))); |
| 5075 | reset_buffer_local_variables (&buffer_defaults, 1); | 5042 | reset_buffer_local_variables (&buffer_defaults, 1); |
| 5076 | eassert (EQ (BVAR (&buffer_local_symbols, name), make_number (0))); | 5043 | eassert (NILP (BVAR (&buffer_local_symbols, name))); |
| 5077 | reset_buffer (&buffer_local_symbols); | 5044 | reset_buffer (&buffer_local_symbols); |
| 5078 | reset_buffer_local_variables (&buffer_local_symbols, 1); | 5045 | reset_buffer_local_variables (&buffer_local_symbols, 1); |
| 5079 | /* Prevent GC from getting confused. */ | 5046 | /* Prevent GC from getting confused. */ |
diff --git a/src/buffer.h b/src/buffer.h index 1b2b5b6a1b1..81852cae505 100644 --- a/src/buffer.h +++ b/src/buffer.h | |||
| @@ -1141,12 +1141,6 @@ record_unwind_current_buffer (void) | |||
| 1141 | } while (false) | 1141 | } while (false) |
| 1142 | 1142 | ||
| 1143 | extern Lisp_Object Vbuffer_alist; | 1143 | extern Lisp_Object Vbuffer_alist; |
| 1144 | extern Lisp_Object Qbefore_change_functions; | ||
| 1145 | extern Lisp_Object Qafter_change_functions; | ||
| 1146 | extern Lisp_Object Qfirst_change_hook; | ||
| 1147 | extern Lisp_Object Qpriority, Qbefore_string, Qafter_string; | ||
| 1148 | extern Lisp_Object Qchoice, Qrange, Qleft, Qright; | ||
| 1149 | extern Lisp_Object Qvertical_scroll_bar, Qhorizontal_scroll_bar; | ||
| 1150 | 1144 | ||
| 1151 | /* FOR_EACH_LIVE_BUFFER (LIST_VAR, BUF_VAR) followed by a statement is | 1145 | /* FOR_EACH_LIVE_BUFFER (LIST_VAR, BUF_VAR) followed by a statement is |
| 1152 | a `for' loop which iterates over the buffers from Vbuffer_alist. */ | 1146 | a `for' loop which iterates over the buffers from Vbuffer_alist. */ |
diff --git a/src/bytecode.c b/src/bytecode.c index 1d89d02e28f..b4583676835 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -69,7 +69,6 @@ by Hallvard: | |||
| 69 | 69 | ||
| 70 | #ifdef BYTE_CODE_METER | 70 | #ifdef BYTE_CODE_METER |
| 71 | 71 | ||
| 72 | Lisp_Object Qbyte_code_meter; | ||
| 73 | #define METER_2(code1, code2) AREF (AREF (Vbyte_code_meter, code1), code2) | 72 | #define METER_2(code1, code2) AREF (AREF (Vbyte_code_meter, code1), code2) |
| 74 | #define METER_1(code) METER_2 (0, code) | 73 | #define METER_1(code) METER_2 (0, code) |
| 75 | 74 | ||
diff --git a/src/callint.c b/src/callint.c index 200c9ed9d7d..25955039ac7 100644 --- a/src/callint.c +++ b/src/callint.c | |||
| @@ -28,18 +28,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 28 | #include "window.h" | 28 | #include "window.h" |
| 29 | #include "keymap.h" | 29 | #include "keymap.h" |
| 30 | 30 | ||
| 31 | Lisp_Object Qminus, Qplus; | ||
| 32 | static Lisp_Object Qfuncall_interactively; | ||
| 33 | static Lisp_Object Qcommand_debug_status; | ||
| 34 | static Lisp_Object Qenable_recursive_minibuffers; | ||
| 35 | |||
| 36 | static Lisp_Object Qhandle_shift_selection; | ||
| 37 | static Lisp_Object Qread_number; | ||
| 38 | |||
| 39 | Lisp_Object Qmouse_leave_buffer_hook; | ||
| 40 | |||
| 41 | static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qif; | ||
| 42 | Lisp_Object Qwhen, Qprogn; | ||
| 43 | static Lisp_Object preserved_fns; | 31 | static Lisp_Object preserved_fns; |
| 44 | 32 | ||
| 45 | /* Marker used within call-interactively to refer to point. */ | 33 | /* Marker used within call-interactively to refer to point. */ |
| @@ -477,7 +465,7 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 477 | error ("Attempt to select inactive minibuffer window"); | 465 | error ("Attempt to select inactive minibuffer window"); |
| 478 | 466 | ||
| 479 | /* If the current buffer wants to clean up, let it. */ | 467 | /* If the current buffer wants to clean up, let it. */ |
| 480 | Frun_hooks (1, &Qmouse_leave_buffer_hook); | 468 | run_hook (Qmouse_leave_buffer_hook); |
| 481 | 469 | ||
| 482 | Fselect_window (w, Qnil); | 470 | Fselect_window (w, Qnil); |
| 483 | } | 471 | } |
diff --git a/src/casefiddle.c b/src/casefiddle.c index 22680032c0d..8755353240a 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c | |||
| @@ -30,8 +30,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 30 | #include "keymap.h" | 30 | #include "keymap.h" |
| 31 | 31 | ||
| 32 | enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; | 32 | enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; |
| 33 | |||
| 34 | Lisp_Object Qidentity; | ||
| 35 | 33 | ||
| 36 | static Lisp_Object | 34 | static Lisp_Object |
| 37 | casify_object (enum case_action flag, Lisp_Object obj) | 35 | casify_object (enum case_action flag, Lisp_Object obj) |
diff --git a/src/casetab.c b/src/casetab.c index 4bedc1771ce..b086abc0125 100644 --- a/src/casetab.c +++ b/src/casetab.c | |||
| @@ -24,7 +24,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 24 | #include "character.h" | 24 | #include "character.h" |
| 25 | #include "buffer.h" | 25 | #include "buffer.h" |
| 26 | 26 | ||
| 27 | static Lisp_Object Qcase_table_p, Qcase_table; | ||
| 28 | Lisp_Object Vascii_downcase_table; | 27 | Lisp_Object Vascii_downcase_table; |
| 29 | static Lisp_Object Vascii_upcase_table; | 28 | static Lisp_Object Vascii_upcase_table; |
| 30 | Lisp_Object Vascii_canon_table; | 29 | Lisp_Object Vascii_canon_table; |
diff --git a/src/category.c b/src/category.c index 09c78240a59..b20493e5949 100644 --- a/src/category.c +++ b/src/category.c | |||
| @@ -53,8 +53,6 @@ bset_category_table (struct buffer *b, Lisp_Object val) | |||
| 53 | 53 | ||
| 54 | For the moment, we are not using this feature. */ | 54 | For the moment, we are not using this feature. */ |
| 55 | static int category_table_version; | 55 | static int category_table_version; |
| 56 | |||
| 57 | static Lisp_Object Qcategory_table, Qcategoryp, Qcategorysetp, Qcategory_table_p; | ||
| 58 | 56 | ||
| 59 | /* Category set staff. */ | 57 | /* Category set staff. */ |
| 60 | 58 | ||
| @@ -34,21 +34,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 34 | #include "ccl.h" | 34 | #include "ccl.h" |
| 35 | #include "coding.h" | 35 | #include "coding.h" |
| 36 | 36 | ||
| 37 | Lisp_Object Qccl, Qcclp; | ||
| 38 | |||
| 39 | /* This symbol is a property which associates with ccl program vector. | ||
| 40 | Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */ | ||
| 41 | static Lisp_Object Qccl_program; | ||
| 42 | |||
| 43 | /* These symbols are properties which associate with code conversion | ||
| 44 | map and their ID respectively. */ | ||
| 45 | static Lisp_Object Qcode_conversion_map; | ||
| 46 | static Lisp_Object Qcode_conversion_map_id; | ||
| 47 | |||
| 48 | /* Symbols of ccl program have this property, a value of the property | ||
| 49 | is an index for Vccl_program_table. */ | ||
| 50 | static Lisp_Object Qccl_program_idx; | ||
| 51 | |||
| 52 | /* Table of registered CCL programs. Each element is a vector of | 37 | /* Table of registered CCL programs. Each element is a vector of |
| 53 | NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the | 38 | NAME, CCL_PROG, RESOLVEDP, and UPDATEDP, where NAME (symbol) is the |
| 54 | name of the program, CCL_PROG (vector) is the compiled code of the | 39 | name of the program, CCL_PROG (vector) is the compiled code of the |
| @@ -2297,8 +2282,17 @@ syms_of_ccl (void) | |||
| 2297 | 2282 | ||
| 2298 | DEFSYM (Qccl, "ccl"); | 2283 | DEFSYM (Qccl, "ccl"); |
| 2299 | DEFSYM (Qcclp, "cclp"); | 2284 | DEFSYM (Qcclp, "cclp"); |
| 2285 | |||
| 2286 | /* This symbol is a property which associates with ccl program vector. | ||
| 2287 | Ex: (get 'ccl-big5-encoder 'ccl-program) returns ccl program vector. */ | ||
| 2300 | DEFSYM (Qccl_program, "ccl-program"); | 2288 | DEFSYM (Qccl_program, "ccl-program"); |
| 2289 | |||
| 2290 | /* Symbols of ccl program have this property, a value of the property | ||
| 2291 | is an index for Vccl_program_table. */ | ||
| 2301 | DEFSYM (Qccl_program_idx, "ccl-program-idx"); | 2292 | DEFSYM (Qccl_program_idx, "ccl-program-idx"); |
| 2293 | |||
| 2294 | /* These symbols are properties which associate with code conversion | ||
| 2295 | map and their ID respectively. */ | ||
| 2302 | DEFSYM (Qcode_conversion_map, "code-conversion-map"); | 2296 | DEFSYM (Qcode_conversion_map, "code-conversion-map"); |
| 2303 | DEFSYM (Qcode_conversion_map_id, "code-conversion-map-id"); | 2297 | DEFSYM (Qcode_conversion_map_id, "code-conversion-map-id"); |
| 2304 | 2298 | ||
| @@ -81,8 +81,6 @@ extern bool setup_ccl_program (struct ccl_program *, Lisp_Object); | |||
| 81 | extern void ccl_driver (struct ccl_program *, int *, int *, int, int, | 81 | extern void ccl_driver (struct ccl_program *, int *, int *, int, int, |
| 82 | Lisp_Object); | 82 | Lisp_Object); |
| 83 | 83 | ||
| 84 | extern Lisp_Object Qccl, Qcclp; | ||
| 85 | |||
| 86 | #define CHECK_CCL_PROGRAM(x) \ | 84 | #define CHECK_CCL_PROGRAM(x) \ |
| 87 | do { \ | 85 | do { \ |
| 88 | if (NILP (Fccl_program_p (x))) \ | 86 | if (NILP (Fccl_program_p (x))) \ |
diff --git a/src/character.c b/src/character.c index ad3fe129a33..4a5c7ec3156 100644 --- a/src/character.c +++ b/src/character.c | |||
| @@ -48,16 +48,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 48 | 48 | ||
| 49 | #endif /* emacs */ | 49 | #endif /* emacs */ |
| 50 | 50 | ||
| 51 | Lisp_Object Qcharacterp; | ||
| 52 | |||
| 53 | static Lisp_Object Qauto_fill_chars; | ||
| 54 | |||
| 55 | /* Char-table of information about which character to unify to which | 51 | /* Char-table of information about which character to unify to which |
| 56 | Unicode character. Mainly used by the macro MAYBE_UNIFY_CHAR. */ | 52 | Unicode character. Mainly used by the macro MAYBE_UNIFY_CHAR. */ |
| 57 | Lisp_Object Vchar_unify_table; | 53 | Lisp_Object Vchar_unify_table; |
| 58 | 54 | ||
| 59 | static Lisp_Object Qchar_script_table; | ||
| 60 | |||
| 61 | 55 | ||
| 62 | 56 | ||
| 63 | /* If character code C has modifier masks, reflect them to the | 57 | /* If character code C has modifier masks, reflect them to the |
diff --git a/src/character.h b/src/character.h index 624f4fff3f0..5043880cb42 100644 --- a/src/character.h +++ b/src/character.h | |||
| @@ -657,7 +657,6 @@ extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int, | |||
| 657 | extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t, | 657 | extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t, |
| 658 | ptrdiff_t *, ptrdiff_t *); | 658 | ptrdiff_t *, ptrdiff_t *); |
| 659 | 659 | ||
| 660 | extern Lisp_Object Qcharacterp; | ||
| 661 | extern Lisp_Object Vchar_unify_table; | 660 | extern Lisp_Object Vchar_unify_table; |
| 662 | extern Lisp_Object string_escape_byte8 (Lisp_Object); | 661 | extern Lisp_Object string_escape_byte8 (Lisp_Object); |
| 663 | 662 | ||
diff --git a/src/charset.c b/src/charset.c index 33436d53f63..ea1480e806a 100644 --- a/src/charset.c +++ b/src/charset.c | |||
| @@ -66,16 +66,7 @@ struct charset *charset_table; | |||
| 66 | static ptrdiff_t charset_table_size; | 66 | static ptrdiff_t charset_table_size; |
| 67 | static int charset_table_used; | 67 | static int charset_table_used; |
| 68 | 68 | ||
| 69 | Lisp_Object Qcharsetp; | 69 | /* Special charsets corresponding to symbols. */ |
| 70 | |||
| 71 | /* Special charset symbols. */ | ||
| 72 | Lisp_Object Qascii; | ||
| 73 | static Lisp_Object Qeight_bit; | ||
| 74 | static Lisp_Object Qiso_8859_1; | ||
| 75 | static Lisp_Object Qunicode; | ||
| 76 | static Lisp_Object Qemacs; | ||
| 77 | |||
| 78 | /* The corresponding charsets. */ | ||
| 79 | int charset_ascii; | 70 | int charset_ascii; |
| 80 | int charset_eight_bit; | 71 | int charset_eight_bit; |
| 81 | static int charset_iso_8859_1; | 72 | static int charset_iso_8859_1; |
| @@ -88,9 +79,6 @@ int charset_jisx0208_1978; | |||
| 88 | int charset_jisx0208; | 79 | int charset_jisx0208; |
| 89 | int charset_ksc5601; | 80 | int charset_ksc5601; |
| 90 | 81 | ||
| 91 | /* Value of charset attribute `charset-iso-plane'. */ | ||
| 92 | static Lisp_Object Qgl, Qgr; | ||
| 93 | |||
| 94 | /* Charset of unibyte characters. */ | 82 | /* Charset of unibyte characters. */ |
| 95 | int charset_unibyte; | 83 | int charset_unibyte; |
| 96 | 84 | ||
| @@ -2344,12 +2332,14 @@ syms_of_charset (void) | |||
| 2344 | { | 2332 | { |
| 2345 | DEFSYM (Qcharsetp, "charsetp"); | 2333 | DEFSYM (Qcharsetp, "charsetp"); |
| 2346 | 2334 | ||
| 2335 | /* Special charset symbols. */ | ||
| 2347 | DEFSYM (Qascii, "ascii"); | 2336 | DEFSYM (Qascii, "ascii"); |
| 2348 | DEFSYM (Qunicode, "unicode"); | 2337 | DEFSYM (Qunicode, "unicode"); |
| 2349 | DEFSYM (Qemacs, "emacs"); | 2338 | DEFSYM (Qemacs, "emacs"); |
| 2350 | DEFSYM (Qeight_bit, "eight-bit"); | 2339 | DEFSYM (Qeight_bit, "eight-bit"); |
| 2351 | DEFSYM (Qiso_8859_1, "iso-8859-1"); | 2340 | DEFSYM (Qiso_8859_1, "iso-8859-1"); |
| 2352 | 2341 | ||
| 2342 | /* Value of charset attribute `charset-iso-plane'. */ | ||
| 2353 | DEFSYM (Qgl, "gl"); | 2343 | DEFSYM (Qgl, "gl"); |
| 2354 | DEFSYM (Qgr, "gr"); | 2344 | DEFSYM (Qgr, "gr"); |
| 2355 | 2345 | ||
| @@ -2362,10 +2352,6 @@ syms_of_charset (void) | |||
| 2362 | staticpro (&Vemacs_mule_charset_list); | 2352 | staticpro (&Vemacs_mule_charset_list); |
| 2363 | Vemacs_mule_charset_list = Qnil; | 2353 | Vemacs_mule_charset_list = Qnil; |
| 2364 | 2354 | ||
| 2365 | /* Don't staticpro them here. It's done in syms_of_fns. */ | ||
| 2366 | QCtest = intern_c_string (":test"); | ||
| 2367 | Qeq = intern_c_string ("eq"); | ||
| 2368 | |||
| 2369 | staticpro (&Vcharset_hash_table); | 2355 | staticpro (&Vcharset_hash_table); |
| 2370 | { | 2356 | { |
| 2371 | Lisp_Object args[2]; | 2357 | Lisp_Object args[2]; |
diff --git a/src/charset.h b/src/charset.h index f66ca0d9cb2..f6575985a47 100644 --- a/src/charset.h +++ b/src/charset.h | |||
| @@ -519,9 +519,6 @@ extern int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL]; | |||
| 519 | 519 | ||
| 520 | 520 | ||
| 521 | 521 | ||
| 522 | extern Lisp_Object Qcharsetp; | ||
| 523 | |||
| 524 | extern Lisp_Object Qascii; | ||
| 525 | extern int charset_ascii, charset_eight_bit; | 522 | extern int charset_ascii, charset_eight_bit; |
| 526 | extern int charset_unicode; | 523 | extern int charset_unicode; |
| 527 | extern int charset_jisx0201_roman; | 524 | extern int charset_jisx0201_roman; |
diff --git a/src/chartab.c b/src/chartab.c index bfbbf798f0c..013a5be575e 100644 --- a/src/chartab.c +++ b/src/chartab.c | |||
| @@ -57,9 +57,6 @@ static const int chartab_bits[4] = | |||
| 57 | /* Preamble for uniprop (Unicode character property) tables. See the | 57 | /* Preamble for uniprop (Unicode character property) tables. See the |
| 58 | comment of "Unicode character property tables". */ | 58 | comment of "Unicode character property tables". */ |
| 59 | 59 | ||
| 60 | /* Purpose of uniprop tables. */ | ||
| 61 | static Lisp_Object Qchar_code_property_table; | ||
| 62 | |||
| 63 | /* Types of decoder and encoder functions for uniprop values. */ | 60 | /* Types of decoder and encoder functions for uniprop values. */ |
| 64 | typedef Lisp_Object (*uniprop_decoder_t) (Lisp_Object, Lisp_Object); | 61 | typedef Lisp_Object (*uniprop_decoder_t) (Lisp_Object, Lisp_Object); |
| 65 | typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object); | 62 | typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object); |
| @@ -1378,6 +1375,7 @@ CHAR-TABLE must be what returned by `unicode-property-table-internal'. */) | |||
| 1378 | void | 1375 | void |
| 1379 | syms_of_chartab (void) | 1376 | syms_of_chartab (void) |
| 1380 | { | 1377 | { |
| 1378 | /* Purpose of uniprop tables. */ | ||
| 1381 | DEFSYM (Qchar_code_property_table, "char-code-property-table"); | 1379 | DEFSYM (Qchar_code_property_table, "char-code-property-table"); |
| 1382 | 1380 | ||
| 1383 | defsubr (&Smake_char_table); | 1381 | defsubr (&Smake_char_table); |
diff --git a/src/cmds.c b/src/cmds.c index 485a235b5ab..270fc39cabc 100644 --- a/src/cmds.c +++ b/src/cmds.c | |||
| @@ -31,11 +31,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 31 | #include "dispextern.h" | 31 | #include "dispextern.h" |
| 32 | #include "frame.h" | 32 | #include "frame.h" |
| 33 | 33 | ||
| 34 | static Lisp_Object Qkill_forward_chars, Qkill_backward_chars; | ||
| 35 | |||
| 36 | /* A possible value for a buffer's overwrite-mode variable. */ | ||
| 37 | static Lisp_Object Qoverwrite_mode_binary; | ||
| 38 | |||
| 39 | static int internal_self_insert (int, EMACS_INT); | 34 | static int internal_self_insert (int, EMACS_INT); |
| 40 | 35 | ||
| 41 | DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, | 36 | DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, |
| @@ -322,9 +317,6 @@ At the end, it runs `post-self-insert-hook'. */) | |||
| 322 | return 0. A value of 1 indicates this *might* not have been simple. | 317 | return 0. A value of 1 indicates this *might* not have been simple. |
| 323 | A value of 2 means this did things that call for an undo boundary. */ | 318 | A value of 2 means this did things that call for an undo boundary. */ |
| 324 | 319 | ||
| 325 | static Lisp_Object Qexpand_abbrev; | ||
| 326 | static Lisp_Object Qpost_self_insert_hook; | ||
| 327 | |||
| 328 | static int | 320 | static int |
| 329 | internal_self_insert (int c, EMACS_INT n) | 321 | internal_self_insert (int c, EMACS_INT n) |
| 330 | { | 322 | { |
| @@ -507,7 +499,7 @@ internal_self_insert (int c, EMACS_INT n) | |||
| 507 | } | 499 | } |
| 508 | 500 | ||
| 509 | /* Run hooks for electric keys. */ | 501 | /* Run hooks for electric keys. */ |
| 510 | Frun_hooks (1, &Qpost_self_insert_hook); | 502 | run_hook (Qpost_self_insert_hook); |
| 511 | 503 | ||
| 512 | return hairy; | 504 | return hairy; |
| 513 | } | 505 | } |
| @@ -519,7 +511,10 @@ syms_of_cmds (void) | |||
| 519 | { | 511 | { |
| 520 | DEFSYM (Qkill_backward_chars, "kill-backward-chars"); | 512 | DEFSYM (Qkill_backward_chars, "kill-backward-chars"); |
| 521 | DEFSYM (Qkill_forward_chars, "kill-forward-chars"); | 513 | DEFSYM (Qkill_forward_chars, "kill-forward-chars"); |
| 514 | |||
| 515 | /* A possible value for a buffer's overwrite-mode variable. */ | ||
| 522 | DEFSYM (Qoverwrite_mode_binary, "overwrite-mode-binary"); | 516 | DEFSYM (Qoverwrite_mode_binary, "overwrite-mode-binary"); |
| 517 | |||
| 523 | DEFSYM (Qexpand_abbrev, "expand-abbrev"); | 518 | DEFSYM (Qexpand_abbrev, "expand-abbrev"); |
| 524 | DEFSYM (Qpost_self_insert_hook, "post-self-insert-hook"); | 519 | DEFSYM (Qpost_self_insert_hook, "post-self-insert-hook"); |
| 525 | 520 | ||
diff --git a/src/coding.c b/src/coding.c index f3f8dc18875..20c64762160 100644 --- a/src/coding.c +++ b/src/coding.c | |||
| @@ -303,35 +303,6 @@ encode_coding_XXX (struct coding_system *coding) | |||
| 303 | 303 | ||
| 304 | Lisp_Object Vcoding_system_hash_table; | 304 | Lisp_Object Vcoding_system_hash_table; |
| 305 | 305 | ||
| 306 | static Lisp_Object Qcoding_system, Qeol_type; | ||
| 307 | static Lisp_Object Qcoding_aliases; | ||
| 308 | Lisp_Object Qunix, Qdos; | ||
| 309 | static Lisp_Object Qmac; | ||
| 310 | Lisp_Object Qbuffer_file_coding_system; | ||
| 311 | static Lisp_Object Qpost_read_conversion, Qpre_write_conversion; | ||
| 312 | static Lisp_Object Qdefault_char; | ||
| 313 | Lisp_Object Qno_conversion, Qundecided; | ||
| 314 | Lisp_Object Qcharset, Qutf_8; | ||
| 315 | static Lisp_Object Qiso_2022; | ||
| 316 | static Lisp_Object Qutf_16, Qshift_jis, Qbig5; | ||
| 317 | static Lisp_Object Qbig, Qlittle; | ||
| 318 | static Lisp_Object Qcoding_system_history; | ||
| 319 | static Lisp_Object Qvalid_codes; | ||
| 320 | static Lisp_Object QCcategory, QCmnemonic, QCdefault_char; | ||
| 321 | static Lisp_Object QCdecode_translation_table, QCencode_translation_table; | ||
| 322 | static Lisp_Object QCpost_read_conversion, QCpre_write_conversion; | ||
| 323 | static Lisp_Object QCascii_compatible_p; | ||
| 324 | |||
| 325 | Lisp_Object Qcall_process, Qcall_process_region; | ||
| 326 | Lisp_Object Qstart_process, Qopen_network_stream; | ||
| 327 | static Lisp_Object Qtarget_idx; | ||
| 328 | |||
| 329 | static Lisp_Object Qinsufficient_source, Qinvalid_source, Qinterrupted; | ||
| 330 | |||
| 331 | /* If a symbol has this property, evaluate the value to define the | ||
| 332 | symbol as a coding system. */ | ||
| 333 | static Lisp_Object Qcoding_system_define_form; | ||
| 334 | |||
| 335 | /* Format of end-of-line decided by system. This is Qunix on | 306 | /* Format of end-of-line decided by system. This is Qunix on |
| 336 | Unix and Mac, Qdos on DOS/Windows. | 307 | Unix and Mac, Qdos on DOS/Windows. |
| 337 | This has an effect only for external encoding (i.e. for output to | 308 | This has an effect only for external encoding (i.e. for output to |
| @@ -340,17 +311,6 @@ static Lisp_Object system_eol_type; | |||
| 340 | 311 | ||
| 341 | #ifdef emacs | 312 | #ifdef emacs |
| 342 | 313 | ||
| 343 | Lisp_Object Qcoding_system_p, Qcoding_system_error; | ||
| 344 | |||
| 345 | /* Coding system emacs-mule and raw-text are for converting only | ||
| 346 | end-of-line format. */ | ||
| 347 | Lisp_Object Qemacs_mule, Qraw_text; | ||
| 348 | Lisp_Object Qutf_8_emacs; | ||
| 349 | |||
| 350 | #if defined (WINDOWSNT) || defined (CYGWIN) | ||
| 351 | static Lisp_Object Qutf_16le; | ||
| 352 | #endif | ||
| 353 | |||
| 354 | /* Coding-systems are handed between Emacs Lisp programs and C internal | 314 | /* Coding-systems are handed between Emacs Lisp programs and C internal |
| 355 | routines by the following three variables. */ | 315 | routines by the following three variables. */ |
| 356 | /* Coding system to be used to encode text for terminal display when | 316 | /* Coding system to be used to encode text for terminal display when |
| @@ -359,11 +319,6 @@ struct coding_system safe_terminal_coding; | |||
| 359 | 319 | ||
| 360 | #endif /* emacs */ | 320 | #endif /* emacs */ |
| 361 | 321 | ||
| 362 | Lisp_Object Qtranslation_table; | ||
| 363 | Lisp_Object Qtranslation_table_id; | ||
| 364 | static Lisp_Object Qtranslation_table_for_decode; | ||
| 365 | static Lisp_Object Qtranslation_table_for_encode; | ||
| 366 | |||
| 367 | /* Two special coding systems. */ | 322 | /* Two special coding systems. */ |
| 368 | static Lisp_Object Vsjis_coding_system; | 323 | static Lisp_Object Vsjis_coding_system; |
| 369 | static Lisp_Object Vbig5_coding_system; | 324 | static Lisp_Object Vbig5_coding_system; |
| @@ -10903,6 +10858,7 @@ syms_of_coding (void) | |||
| 10903 | 10858 | ||
| 10904 | DEFSYM (Qcoding_system_p, "coding-system-p"); | 10859 | DEFSYM (Qcoding_system_p, "coding-system-p"); |
| 10905 | 10860 | ||
| 10861 | /* Error signaled when there's a problem with detecting a coding system. */ | ||
| 10906 | DEFSYM (Qcoding_system_error, "coding-system-error"); | 10862 | DEFSYM (Qcoding_system_error, "coding-system-error"); |
| 10907 | Fput (Qcoding_system_error, Qerror_conditions, | 10863 | Fput (Qcoding_system_error, Qerror_conditions, |
| 10908 | listn (CONSTYPE_PURE, 2, Qcoding_system_error, Qerror)); | 10864 | listn (CONSTYPE_PURE, 2, Qcoding_system_error, Qerror)); |
| @@ -10917,6 +10873,8 @@ syms_of_coding (void) | |||
| 10917 | 10873 | ||
| 10918 | DEFSYM (Qvalid_codes, "valid-codes"); | 10874 | DEFSYM (Qvalid_codes, "valid-codes"); |
| 10919 | 10875 | ||
| 10876 | /* Coding system emacs-mule and raw-text are for converting only | ||
| 10877 | end-of-line format. */ | ||
| 10920 | DEFSYM (Qemacs_mule, "emacs-mule"); | 10878 | DEFSYM (Qemacs_mule, "emacs-mule"); |
| 10921 | 10879 | ||
| 10922 | DEFSYM (QCcategory, ":category"); | 10880 | DEFSYM (QCcategory, ":category"); |
| @@ -10979,6 +10937,9 @@ syms_of_coding (void) | |||
| 10979 | DEFSYM (Qinsufficient_source, "insufficient-source"); | 10937 | DEFSYM (Qinsufficient_source, "insufficient-source"); |
| 10980 | DEFSYM (Qinvalid_source, "invalid-source"); | 10938 | DEFSYM (Qinvalid_source, "invalid-source"); |
| 10981 | DEFSYM (Qinterrupted, "interrupted"); | 10939 | DEFSYM (Qinterrupted, "interrupted"); |
| 10940 | |||
| 10941 | /* If a symbol has this property, evaluate the value to define the | ||
| 10942 | symbol as a coding system. */ | ||
| 10982 | DEFSYM (Qcoding_system_define_form, "coding-system-define-form"); | 10943 | DEFSYM (Qcoding_system_define_form, "coding-system-define-form"); |
| 10983 | 10944 | ||
| 10984 | defsubr (&Scoding_system_p); | 10945 | defsubr (&Scoding_system_p); |
diff --git a/src/coding.h b/src/coding.h index 2b56e5abd9d..d49d786e6dd 100644 --- a/src/coding.h +++ b/src/coding.h | |||
| @@ -763,23 +763,7 @@ extern Lisp_Object from_unicode_buffer (const wchar_t *wstr); | |||
| 763 | extern Lisp_Object preferred_coding_system (void); | 763 | extern Lisp_Object preferred_coding_system (void); |
| 764 | 764 | ||
| 765 | 765 | ||
| 766 | extern Lisp_Object Qutf_8, Qutf_8_emacs; | ||
| 767 | |||
| 768 | extern Lisp_Object Qcoding_category_index; | ||
| 769 | extern Lisp_Object Qcoding_system_p; | ||
| 770 | extern Lisp_Object Qraw_text, Qemacs_mule, Qno_conversion, Qundecided; | ||
| 771 | extern Lisp_Object Qbuffer_file_coding_system; | ||
| 772 | |||
| 773 | extern Lisp_Object Qunix, Qdos; | ||
| 774 | |||
| 775 | extern Lisp_Object Qtranslation_table; | ||
| 776 | extern Lisp_Object Qtranslation_table_id; | ||
| 777 | |||
| 778 | #ifdef emacs | 766 | #ifdef emacs |
| 779 | extern Lisp_Object Qfile_coding_system; | ||
| 780 | extern Lisp_Object Qcall_process, Qcall_process_region; | ||
| 781 | extern Lisp_Object Qstart_process, Qopen_network_stream; | ||
| 782 | extern Lisp_Object Qwrite_region; | ||
| 783 | 767 | ||
| 784 | extern char *emacs_strerror (int); | 768 | extern char *emacs_strerror (int); |
| 785 | 769 | ||
| @@ -789,9 +773,6 @@ extern struct coding_system safe_terminal_coding; | |||
| 789 | 773 | ||
| 790 | #endif | 774 | #endif |
| 791 | 775 | ||
| 792 | /* Error signaled when there's a problem with detecting coding system */ | ||
| 793 | extern Lisp_Object Qcoding_system_error; | ||
| 794 | |||
| 795 | extern char emacs_mule_bytes[256]; | 776 | extern char emacs_mule_bytes[256]; |
| 796 | 777 | ||
| 797 | #endif /* EMACS_CODING_H */ | 778 | #endif /* EMACS_CODING_H */ |
diff --git a/src/composite.c b/src/composite.c index 4b22499fdd9..8ac5ef712c6 100644 --- a/src/composite.c +++ b/src/composite.c | |||
| @@ -134,8 +134,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 134 | */ | 134 | */ |
| 135 | 135 | ||
| 136 | 136 | ||
| 137 | Lisp_Object Qcomposition; | ||
| 138 | |||
| 139 | /* Table of pointers to the structure `composition' indexed by | 137 | /* Table of pointers to the structure `composition' indexed by |
| 140 | COMPOSITION-ID. This structure is for storing information about | 138 | COMPOSITION-ID. This structure is for storing information about |
| 141 | each composition except for COMPONENTS-VEC. */ | 139 | each composition except for COMPONENTS-VEC. */ |
| @@ -152,8 +150,6 @@ ptrdiff_t n_compositions; | |||
| 152 | COMPOSITION-ID. */ | 150 | COMPOSITION-ID. */ |
| 153 | Lisp_Object composition_hash_table; | 151 | Lisp_Object composition_hash_table; |
| 154 | 152 | ||
| 155 | static Lisp_Object Qauto_composed; | ||
| 156 | static Lisp_Object Qauto_composition_function; | ||
| 157 | /* Maximum number of characters to look back for | 153 | /* Maximum number of characters to look back for |
| 158 | auto-compositions. */ | 154 | auto-compositions. */ |
| 159 | #define MAX_AUTO_COMPOSITION_LOOKBACK 3 | 155 | #define MAX_AUTO_COMPOSITION_LOOKBACK 3 |
diff --git a/src/composite.h b/src/composite.h index e0d4e858d48..fb9f9eb8655 100644 --- a/src/composite.h +++ b/src/composite.h | |||
| @@ -190,7 +190,6 @@ extern ptrdiff_t n_compositions; | |||
| 190 | #define CHECK_BORDER (CHECK_HEAD | CHECK_TAIL) | 190 | #define CHECK_BORDER (CHECK_HEAD | CHECK_TAIL) |
| 191 | #define CHECK_ALL (CHECK_BORDER | CHECK_INSIDE) | 191 | #define CHECK_ALL (CHECK_BORDER | CHECK_INSIDE) |
| 192 | 192 | ||
| 193 | extern Lisp_Object Qcomposition; | ||
| 194 | extern Lisp_Object composition_hash_table; | 193 | extern Lisp_Object composition_hash_table; |
| 195 | extern ptrdiff_t get_composition_id (ptrdiff_t, ptrdiff_t, ptrdiff_t, | 194 | extern ptrdiff_t get_composition_id (ptrdiff_t, ptrdiff_t, ptrdiff_t, |
| 196 | Lisp_Object, Lisp_Object); | 195 | Lisp_Object, Lisp_Object); |
diff --git a/src/conf_post.h b/src/conf_post.h index 479d0448775..1a080fad635 100644 --- a/src/conf_post.h +++ b/src/conf_post.h | |||
| @@ -245,7 +245,9 @@ extern void _DebPrint (const char *fmt, ...); | |||
| 245 | # define ATTRIBUTE_MALLOC | 245 | # define ATTRIBUTE_MALLOC |
| 246 | #endif | 246 | #endif |
| 247 | 247 | ||
| 248 | #if 4 < __GNUC__ + (3 <= __GNUC_MINOR__) | 248 | #if (__clang__ \ |
| 249 | ? __has_attribute (alloc_size) \ | ||
| 250 | : 4 < __GNUC__ + (3 <= __GNUC_MINOR__)) | ||
| 249 | # define ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args)) | 251 | # define ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args)) |
| 250 | #else | 252 | #else |
| 251 | # define ATTRIBUTE_ALLOC_SIZE(args) | 253 | # define ATTRIBUTE_ALLOC_SIZE(args) |
diff --git a/src/data.c b/src/data.c index 3992792fdd0..820c3ce8407 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -37,58 +37,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 37 | #include "font.h" | 37 | #include "font.h" |
| 38 | #include "keymap.h" | 38 | #include "keymap.h" |
| 39 | 39 | ||
| 40 | Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; | ||
| 41 | static Lisp_Object Qsubr; | ||
| 42 | Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; | ||
| 43 | Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range; | ||
| 44 | static Lisp_Object Qwrong_length_argument; | ||
| 45 | static Lisp_Object Qwrong_type_argument; | ||
| 46 | Lisp_Object Qvoid_variable, Qvoid_function; | ||
| 47 | static Lisp_Object Qcyclic_function_indirection; | ||
| 48 | static Lisp_Object Qcyclic_variable_indirection; | ||
| 49 | Lisp_Object Qcircular_list; | ||
| 50 | static Lisp_Object Qsetting_constant; | ||
| 51 | Lisp_Object Qinvalid_read_syntax; | ||
| 52 | Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; | ||
| 53 | Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive; | ||
| 54 | Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; | ||
| 55 | Lisp_Object Qtext_read_only; | ||
| 56 | |||
| 57 | Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp; | ||
| 58 | static Lisp_Object Qnatnump; | ||
| 59 | Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; | ||
| 60 | Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp; | ||
| 61 | Lisp_Object Qbool_vector_p; | ||
| 62 | Lisp_Object Qbuffer_or_string_p; | ||
| 63 | static Lisp_Object Qkeywordp, Qboundp; | ||
| 64 | Lisp_Object Qfboundp; | ||
| 65 | Lisp_Object Qchar_table_p, Qvector_or_char_table_p; | ||
| 66 | |||
| 67 | Lisp_Object Qcdr; | ||
| 68 | static Lisp_Object Qad_advice_info, Qad_activate_internal; | ||
| 69 | |||
| 70 | static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error; | ||
| 71 | Lisp_Object Qrange_error, Qoverflow_error; | ||
| 72 | |||
| 73 | Lisp_Object Qfloatp; | ||
| 74 | Lisp_Object Qnumberp, Qnumber_or_marker_p; | ||
| 75 | |||
| 76 | Lisp_Object Qinteger, Qsymbol; | ||
| 77 | static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector; | ||
| 78 | Lisp_Object Qwindow; | ||
| 79 | static Lisp_Object Qoverlay, Qwindow_configuration; | ||
| 80 | static Lisp_Object Qprocess, Qmarker; | ||
| 81 | static Lisp_Object Qcompiled_function, Qframe; | ||
| 82 | Lisp_Object Qbuffer; | ||
| 83 | static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; | ||
| 84 | static Lisp_Object Qsubrp; | ||
| 85 | static Lisp_Object Qmany, Qunevalled; | ||
| 86 | Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; | ||
| 87 | static Lisp_Object Qdefun; | ||
| 88 | |||
| 89 | Lisp_Object Qinteractive_form; | ||
| 90 | static Lisp_Object Qdefalias_fset_function; | ||
| 91 | |||
| 92 | static void swap_in_symval_forwarding (struct Lisp_Symbol *, | 40 | static void swap_in_symval_forwarding (struct Lisp_Symbol *, |
| 93 | struct Lisp_Buffer_Local_Value *); | 41 | struct Lisp_Buffer_Local_Value *); |
| 94 | 42 | ||
| @@ -3584,10 +3532,6 @@ syms_of_data (void) | |||
| 3584 | PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail), | 3532 | PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail), |
| 3585 | "Arithmetic underflow error"); | 3533 | "Arithmetic underflow error"); |
| 3586 | 3534 | ||
| 3587 | staticpro (&Qnil); | ||
| 3588 | staticpro (&Qt); | ||
| 3589 | staticpro (&Qunbound); | ||
| 3590 | |||
| 3591 | /* Types that type-of returns. */ | 3535 | /* Types that type-of returns. */ |
| 3592 | DEFSYM (Qinteger, "integer"); | 3536 | DEFSYM (Qinteger, "integer"); |
| 3593 | DEFSYM (Qsymbol, "symbol"); | 3537 | DEFSYM (Qsymbol, "symbol"); |
diff --git a/src/dbusbind.c b/src/dbusbind.c index 9de694954d4..3bdec0fa4a6 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c | |||
| @@ -41,37 +41,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 41 | #endif | 41 | #endif |
| 42 | 42 | ||
| 43 | 43 | ||
| 44 | /* Subroutines. */ | ||
| 45 | static Lisp_Object Qdbus__init_bus; | ||
| 46 | static Lisp_Object Qdbus_get_unique_name; | ||
| 47 | static Lisp_Object Qdbus_message_internal; | ||
| 48 | |||
| 49 | /* D-Bus error symbol. */ | ||
| 50 | static Lisp_Object Qdbus_error; | ||
| 51 | |||
| 52 | /* Lisp symbols of the system and session buses. */ | ||
| 53 | static Lisp_Object QCdbus_system_bus, QCdbus_session_bus; | ||
| 54 | |||
| 55 | /* Lisp symbol for method call timeout. */ | ||
| 56 | static Lisp_Object QCdbus_timeout; | ||
| 57 | |||
| 58 | /* Lisp symbols of D-Bus types. */ | ||
| 59 | static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean; | ||
| 60 | static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16; | ||
| 61 | static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32; | ||
| 62 | static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64; | ||
| 63 | static Lisp_Object QCdbus_type_double, QCdbus_type_string; | ||
| 64 | static Lisp_Object QCdbus_type_object_path, QCdbus_type_signature; | ||
| 65 | #ifdef DBUS_TYPE_UNIX_FD | ||
| 66 | static Lisp_Object QCdbus_type_unix_fd; | ||
| 67 | #endif | ||
| 68 | static Lisp_Object QCdbus_type_array, QCdbus_type_variant; | ||
| 69 | static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry; | ||
| 70 | |||
| 71 | /* Lisp symbols of objects in `dbus-registered-objects-table'. */ | ||
| 72 | static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method; | ||
| 73 | static Lisp_Object QCdbus_registered_signal; | ||
| 74 | |||
| 75 | /* Alist of D-Bus buses we are polling for messages. | 44 | /* Alist of D-Bus buses we are polling for messages. |
| 76 | The key is the symbol or string of the bus, and the value is the | 45 | The key is the symbol or string of the bus, and the value is the |
| 77 | connection address. */ | 46 | connection address. */ |
| @@ -1755,15 +1724,21 @@ syms_of_dbusbind (void) | |||
| 1755 | DEFSYM (Qdbus_message_internal, "dbus-message-internal"); | 1724 | DEFSYM (Qdbus_message_internal, "dbus-message-internal"); |
| 1756 | defsubr (&Sdbus_message_internal); | 1725 | defsubr (&Sdbus_message_internal); |
| 1757 | 1726 | ||
| 1727 | /* D-Bus error symbol. */ | ||
| 1758 | DEFSYM (Qdbus_error, "dbus-error"); | 1728 | DEFSYM (Qdbus_error, "dbus-error"); |
| 1759 | Fput (Qdbus_error, Qerror_conditions, | 1729 | Fput (Qdbus_error, Qerror_conditions, |
| 1760 | list2 (Qdbus_error, Qerror)); | 1730 | list2 (Qdbus_error, Qerror)); |
| 1761 | Fput (Qdbus_error, Qerror_message, | 1731 | Fput (Qdbus_error, Qerror_message, |
| 1762 | build_pure_c_string ("D-Bus error")); | 1732 | build_pure_c_string ("D-Bus error")); |
| 1763 | 1733 | ||
| 1734 | /* Lisp symbols of the system and session buses. */ | ||
| 1764 | DEFSYM (QCdbus_system_bus, ":system"); | 1735 | DEFSYM (QCdbus_system_bus, ":system"); |
| 1765 | DEFSYM (QCdbus_session_bus, ":session"); | 1736 | DEFSYM (QCdbus_session_bus, ":session"); |
| 1737 | |||
| 1738 | /* Lisp symbol for method call timeout. */ | ||
| 1766 | DEFSYM (QCdbus_timeout, ":timeout"); | 1739 | DEFSYM (QCdbus_timeout, ":timeout"); |
| 1740 | |||
| 1741 | /* Lisp symbols of D-Bus types. */ | ||
| 1767 | DEFSYM (QCdbus_type_byte, ":byte"); | 1742 | DEFSYM (QCdbus_type_byte, ":byte"); |
| 1768 | DEFSYM (QCdbus_type_boolean, ":boolean"); | 1743 | DEFSYM (QCdbus_type_boolean, ":boolean"); |
| 1769 | DEFSYM (QCdbus_type_int16, ":int16"); | 1744 | DEFSYM (QCdbus_type_int16, ":int16"); |
| @@ -1783,6 +1758,8 @@ syms_of_dbusbind (void) | |||
| 1783 | DEFSYM (QCdbus_type_variant, ":variant"); | 1758 | DEFSYM (QCdbus_type_variant, ":variant"); |
| 1784 | DEFSYM (QCdbus_type_struct, ":struct"); | 1759 | DEFSYM (QCdbus_type_struct, ":struct"); |
| 1785 | DEFSYM (QCdbus_type_dict_entry, ":dict-entry"); | 1760 | DEFSYM (QCdbus_type_dict_entry, ":dict-entry"); |
| 1761 | |||
| 1762 | /* Lisp symbols of objects in `dbus-registered-objects-table'. */ | ||
| 1786 | DEFSYM (QCdbus_registered_serial, ":serial"); | 1763 | DEFSYM (QCdbus_registered_serial, ":serial"); |
| 1787 | DEFSYM (QCdbus_registered_method, ":method"); | 1764 | DEFSYM (QCdbus_registered_method, ":method"); |
| 1788 | DEFSYM (QCdbus_registered_signal, ":signal"); | 1765 | DEFSYM (QCdbus_registered_signal, ":signal"); |
diff --git a/src/decompress.c b/src/decompress.c index 3c0ef10cea5..b14f0a2cd79 100644 --- a/src/decompress.c +++ b/src/decompress.c | |||
| @@ -28,8 +28,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 28 | 28 | ||
| 29 | #include <verify.h> | 29 | #include <verify.h> |
| 30 | 30 | ||
| 31 | static Lisp_Object Qzlib_dll; | ||
| 32 | |||
| 33 | #ifdef WINDOWSNT | 31 | #ifdef WINDOWSNT |
| 34 | # include <windows.h> | 32 | # include <windows.h> |
| 35 | # include "w32.h" | 33 | # include "w32.h" |
diff --git a/src/dired.c b/src/dired.c index 3ca400eafe9..00f9a5b0765 100644 --- a/src/dired.c +++ b/src/dired.c | |||
| @@ -51,13 +51,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 51 | #include "msdos.h" /* for fstatat */ | 51 | #include "msdos.h" /* for fstatat */ |
| 52 | #endif | 52 | #endif |
| 53 | 53 | ||
| 54 | static Lisp_Object Qdirectory_files; | ||
| 55 | static Lisp_Object Qdirectory_files_and_attributes; | ||
| 56 | static Lisp_Object Qfile_name_completion; | ||
| 57 | static Lisp_Object Qfile_name_all_completions; | ||
| 58 | static Lisp_Object Qfile_attributes; | ||
| 59 | static Lisp_Object Qfile_attributes_lessp; | ||
| 60 | |||
| 61 | static ptrdiff_t scmp (const char *, const char *, ptrdiff_t); | 54 | static ptrdiff_t scmp (const char *, const char *, ptrdiff_t); |
| 62 | static Lisp_Object file_attributes (int, char const *, Lisp_Object); | 55 | static Lisp_Object file_attributes (int, char const *, Lisp_Object); |
| 63 | 56 | ||
| @@ -450,7 +443,6 @@ These are all file names in directory DIRECTORY which begin with FILE. */) | |||
| 450 | } | 443 | } |
| 451 | 444 | ||
| 452 | static int file_name_completion_stat (int, struct dirent *, struct stat *); | 445 | static int file_name_completion_stat (int, struct dirent *, struct stat *); |
| 453 | static Lisp_Object Qdefault_directory; | ||
| 454 | 446 | ||
| 455 | static Lisp_Object | 447 | static Lisp_Object |
| 456 | file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, | 448 | file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, |
diff --git a/src/dispextern.h b/src/dispextern.h index 10c84da2486..bf0c2fc0a47 100644 --- a/src/dispextern.h +++ b/src/dispextern.h | |||
| @@ -393,10 +393,9 @@ struct glyph | |||
| 393 | 393 | ||
| 394 | /* Lisp object source of this glyph. Currently either a buffer or a | 394 | /* Lisp object source of this glyph. Currently either a buffer or a |
| 395 | string, if the glyph was produced from characters which came from | 395 | string, if the glyph was produced from characters which came from |
| 396 | a buffer or a string; or Lisp integer zero (a.k.a. "null object") | 396 | a buffer or a string; or nil if the glyph was inserted by |
| 397 | if the glyph was inserted by redisplay for its own purposes, such | 397 | redisplay for its own purposes, such as padding, truncation, or |
| 398 | as padding or truncation/continuation glyphs, or the | 398 | continuation glyphs, or the overlay-arrow glyphs on TTYs. */ |
| 399 | overlay-arrow glyphs on TTYs. */ | ||
| 400 | Lisp_Object object; | 399 | Lisp_Object object; |
| 401 | 400 | ||
| 402 | /* Width in pixels. */ | 401 | /* Width in pixels. */ |
| @@ -1727,8 +1726,8 @@ struct face | |||
| 1727 | attributes except the font. */ | 1726 | attributes except the font. */ |
| 1728 | struct face *ascii_face; | 1727 | struct face *ascii_face; |
| 1729 | 1728 | ||
| 1730 | #ifdef HAVE_XFT | 1729 | #if defined HAVE_XFT || defined HAVE_FREETYPE |
| 1731 | /* Extra member that a font-driver uses privately. */ | 1730 | /* Extra member that a font-driver uses privately. */ |
| 1732 | void *extra; | 1731 | void *extra; |
| 1733 | #endif | 1732 | #endif |
| 1734 | }; | 1733 | }; |
| @@ -2552,11 +2551,11 @@ struct it | |||
| 2552 | Object is normally the buffer which is being rendered, but it can | 2551 | Object is normally the buffer which is being rendered, but it can |
| 2553 | also be a Lisp string in case the current display element comes | 2552 | also be a Lisp string in case the current display element comes |
| 2554 | from an overlay string or from a display string (before- or | 2553 | from an overlay string or from a display string (before- or |
| 2555 | after-string). It may also be nil when a C string is being | 2554 | after-string). It may also be a zero-valued Lisp integer when a |
| 2556 | rendered, e.g., during mode-line or header-line update. It can | 2555 | C string is being rendered, e.g., during mode-line or header-line |
| 2557 | also be a cons cell of the form `(space ...)', when we produce a | 2556 | update. It can also be a cons cell of the form `(space ...)', |
| 2558 | stretch glyph from a `display' specification. Finally, it can be | 2557 | when we produce a stretch glyph from a `display' specification. |
| 2559 | a zero-valued Lisp integer, but only temporarily, when we are | 2558 | Finally, it can be nil, but only temporarily, when we are |
| 2560 | producing special glyphs for display purposes, like truncation | 2559 | producing special glyphs for display purposes, like truncation |
| 2561 | and continuation glyphs, or blanks that extend each line to the | 2560 | and continuation glyphs, or blanks that extend each line to the |
| 2562 | edge of the window on a TTY. | 2561 | edge of the window on a TTY. |
| @@ -2934,8 +2933,8 @@ struct redisplay_interface | |||
| 2934 | 2933 | ||
| 2935 | struct image_type | 2934 | struct image_type |
| 2936 | { | 2935 | { |
| 2937 | /* A symbol uniquely identifying the image type, .e.g `jpeg'. */ | 2936 | /* Index of a symbol uniquely identifying the image type, e.g., 'jpeg'. */ |
| 2938 | Lisp_Object *type; | 2937 | int type; |
| 2939 | 2938 | ||
| 2940 | /* Check that SPEC is a valid image specification for the given | 2939 | /* Check that SPEC is a valid image specification for the given |
| 2941 | image type. Value is true if SPEC is valid. */ | 2940 | image type. Value is true if SPEC is valid. */ |
| @@ -3249,7 +3248,6 @@ void move_it_in_display_line (struct it *it, | |||
| 3249 | enum move_operation_enum op); | 3248 | enum move_operation_enum op); |
| 3250 | bool in_display_vector_p (struct it *); | 3249 | bool in_display_vector_p (struct it *); |
| 3251 | int frame_mode_line_height (struct frame *); | 3250 | int frame_mode_line_height (struct frame *); |
| 3252 | extern Lisp_Object Qtool_bar; | ||
| 3253 | extern bool redisplaying_p; | 3251 | extern bool redisplaying_p; |
| 3254 | extern bool help_echo_showing_p; | 3252 | extern bool help_echo_showing_p; |
| 3255 | extern Lisp_Object help_echo_string, help_echo_window; | 3253 | extern Lisp_Object help_echo_string, help_echo_window; |
| @@ -3429,7 +3427,6 @@ int face_at_string_position (struct window *w, Lisp_Object string, | |||
| 3429 | int merge_faces (struct frame *, Lisp_Object, int, int); | 3427 | int merge_faces (struct frame *, Lisp_Object, int, int); |
| 3430 | int compute_char_face (struct frame *, int, Lisp_Object); | 3428 | int compute_char_face (struct frame *, int, Lisp_Object); |
| 3431 | void free_all_realized_faces (Lisp_Object); | 3429 | void free_all_realized_faces (Lisp_Object); |
| 3432 | extern Lisp_Object Qforeground_color, Qbackground_color; | ||
| 3433 | extern char unspecified_fg[], unspecified_bg[]; | 3430 | extern char unspecified_fg[], unspecified_bg[]; |
| 3434 | 3431 | ||
| 3435 | /* Defined in xfns.c. */ | 3432 | /* Defined in xfns.c. */ |
| @@ -3519,7 +3516,6 @@ void do_pending_window_change (bool); | |||
| 3519 | void change_frame_size (struct frame *, int, int, bool, bool, bool, bool); | 3516 | void change_frame_size (struct frame *, int, int, bool, bool, bool, bool); |
| 3520 | void init_display (void); | 3517 | void init_display (void); |
| 3521 | void syms_of_display (void); | 3518 | void syms_of_display (void); |
| 3522 | extern Lisp_Object Qredisplay_dont_pause; | ||
| 3523 | extern void spec_glyph_lookup_face (struct window *, GLYPH *); | 3519 | extern void spec_glyph_lookup_face (struct window *, GLYPH *); |
| 3524 | extern void fill_up_frame_row_with_spaces (struct glyph_row *, int); | 3520 | extern void fill_up_frame_row_with_spaces (struct glyph_row *, int); |
| 3525 | 3521 | ||
diff --git a/src/dispnew.c b/src/dispnew.c index 6e0fcc3f69b..bb75973edb8 100644 --- a/src/dispnew.c +++ b/src/dispnew.c | |||
| @@ -106,8 +106,6 @@ static void set_window_update_flags (struct window *w, bool on_p); | |||
| 106 | 106 | ||
| 107 | bool display_completed; | 107 | bool display_completed; |
| 108 | 108 | ||
| 109 | Lisp_Object Qdisplay_table, Qredisplay_dont_pause; | ||
| 110 | |||
| 111 | /* True means SIGWINCH happened when not safe. */ | 109 | /* True means SIGWINCH happened when not safe. */ |
| 112 | 110 | ||
| 113 | static bool delayed_size_change; | 111 | static bool delayed_size_change; |
| @@ -5177,7 +5175,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p | |||
| 5177 | 5175 | ||
| 5178 | Fset_buffer (old_current_buffer); | 5176 | Fset_buffer (old_current_buffer); |
| 5179 | 5177 | ||
| 5180 | *dx = x0 + it.first_visible_x - it.current_x; | 5178 | *dx = to_x - it.current_x; |
| 5181 | *dy = *y - it.current_y; | 5179 | *dy = *y - it.current_y; |
| 5182 | 5180 | ||
| 5183 | string = w->contents; | 5181 | string = w->contents; |
| @@ -5252,9 +5250,9 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p | |||
| 5252 | } | 5250 | } |
| 5253 | 5251 | ||
| 5254 | /* Add extra (default width) columns if clicked after EOL. */ | 5252 | /* Add extra (default width) columns if clicked after EOL. */ |
| 5255 | x1 = max (0, it.current_x + it.pixel_width - it.first_visible_x); | 5253 | x1 = max (0, it.current_x + it.pixel_width); |
| 5256 | if (x0 > x1) | 5254 | if (to_x > x1) |
| 5257 | it.hpos += (x0 - x1) / WINDOW_FRAME_COLUMN_WIDTH (w); | 5255 | it.hpos += (to_x - x1) / WINDOW_FRAME_COLUMN_WIDTH (w); |
| 5258 | 5256 | ||
| 5259 | *x = it.hpos; | 5257 | *x = it.hpos; |
| 5260 | *y = it.vpos; | 5258 | *y = it.vpos; |
| @@ -6204,7 +6202,9 @@ syms_of_display (void) | |||
| 6204 | frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda); | 6202 | frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda); |
| 6205 | staticpro (&frame_and_buffer_state); | 6203 | staticpro (&frame_and_buffer_state); |
| 6206 | 6204 | ||
| 6205 | /* This is the "purpose" slot of a display table. */ | ||
| 6207 | DEFSYM (Qdisplay_table, "display-table"); | 6206 | DEFSYM (Qdisplay_table, "display-table"); |
| 6207 | |||
| 6208 | DEFSYM (Qredisplay_dont_pause, "redisplay-dont-pause"); | 6208 | DEFSYM (Qredisplay_dont_pause, "redisplay-dont-pause"); |
| 6209 | 6209 | ||
| 6210 | DEFVAR_INT ("baud-rate", baud_rate, | 6210 | DEFVAR_INT ("baud-rate", baud_rate, |
diff --git a/src/disptab.h b/src/disptab.h index cea040fe8aa..7afc862312a 100644 --- a/src/disptab.h +++ b/src/disptab.h | |||
| @@ -48,9 +48,6 @@ extern struct Lisp_Char_Table *window_display_table (struct window *); | |||
| 48 | /* Defined in indent.c. */ | 48 | /* Defined in indent.c. */ |
| 49 | extern struct Lisp_Char_Table *buffer_display_table (void); | 49 | extern struct Lisp_Char_Table *buffer_display_table (void); |
| 50 | 50 | ||
| 51 | /* This is the `purpose' slot of a display table. */ | ||
| 52 | extern Lisp_Object Qdisplay_table; | ||
| 53 | |||
| 54 | /* Return the current length of the GLYPH table, | 51 | /* Return the current length of the GLYPH table, |
| 55 | or 0 if the table isn't currently valid. */ | 52 | or 0 if the table isn't currently valid. */ |
| 56 | #define GLYPH_TABLE_LENGTH \ | 53 | #define GLYPH_TABLE_LENGTH \ |
| @@ -35,8 +35,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 35 | #include "keyboard.h" | 35 | #include "keyboard.h" |
| 36 | #include "keymap.h" | 36 | #include "keymap.h" |
| 37 | 37 | ||
| 38 | Lisp_Object Qfunction_documentation; | ||
| 39 | |||
| 40 | /* Buffer used for reading from documentation file. */ | 38 | /* Buffer used for reading from documentation file. */ |
| 41 | static char *get_doc_string_buffer; | 39 | static char *get_doc_string_buffer; |
| 42 | static ptrdiff_t get_doc_string_buffer_size; | 40 | static ptrdiff_t get_doc_string_buffer_size; |
diff --git a/src/dosfns.c b/src/dosfns.c index 8c0fed2230f..e506e9fbe14 100644 --- a/src/dosfns.c +++ b/src/dosfns.c | |||
| @@ -409,8 +409,6 @@ msdos_stdcolor_idx (const char *name) | |||
| 409 | Lisp_Object | 409 | Lisp_Object |
| 410 | msdos_stdcolor_name (int idx) | 410 | msdos_stdcolor_name (int idx) |
| 411 | { | 411 | { |
| 412 | extern Lisp_Object Qunspecified; | ||
| 413 | |||
| 414 | if (idx == FACE_TTY_DEFAULT_FG_COLOR) | 412 | if (idx == FACE_TTY_DEFAULT_FG_COLOR) |
| 415 | return build_string (unspecified_fg); | 413 | return build_string (unspecified_fg); |
| 416 | else if (idx == FACE_TTY_DEFAULT_BG_COLOR) | 414 | else if (idx == FACE_TTY_DEFAULT_BG_COLOR) |
diff --git a/src/editfns.c b/src/editfns.c index 37f85b3ada3..cd15f6569aa 100644 --- a/src/editfns.c +++ b/src/editfns.c | |||
| @@ -76,16 +76,6 @@ static void update_buffer_properties (ptrdiff_t, ptrdiff_t); | |||
| 76 | # define HAVE_TM_GMTOFF false | 76 | # define HAVE_TM_GMTOFF false |
| 77 | #endif | 77 | #endif |
| 78 | 78 | ||
| 79 | static Lisp_Object Qbuffer_access_fontify_functions; | ||
| 80 | |||
| 81 | /* Symbol for the text property used to mark fields. */ | ||
| 82 | |||
| 83 | Lisp_Object Qfield; | ||
| 84 | |||
| 85 | /* A special value for Qfield properties. */ | ||
| 86 | |||
| 87 | static Lisp_Object Qboundary; | ||
| 88 | |||
| 89 | /* The startup value of the TZ environment variable; null if unset. */ | 79 | /* The startup value of the TZ environment variable; null if unset. */ |
| 90 | static char const *initial_tz; | 80 | static char const *initial_tz; |
| 91 | 81 | ||
| @@ -915,17 +905,11 @@ save_excursion_restore (Lisp_Object info) | |||
| 915 | if (! NILP (tem)) | 905 | if (! NILP (tem)) |
| 916 | { | 906 | { |
| 917 | if (! EQ (omark, nmark)) | 907 | if (! EQ (omark, nmark)) |
| 918 | { | 908 | run_hook (intern ("activate-mark-hook")); |
| 919 | tem = intern ("activate-mark-hook"); | ||
| 920 | Frun_hooks (1, &tem); | ||
| 921 | } | ||
| 922 | } | 909 | } |
| 923 | /* If mark has ceased to be active, run deactivate hook. */ | 910 | /* If mark has ceased to be active, run deactivate hook. */ |
| 924 | else if (! NILP (tem1)) | 911 | else if (! NILP (tem1)) |
| 925 | { | 912 | run_hook (intern ("deactivate-mark-hook")); |
| 926 | tem = intern ("deactivate-mark-hook"); | ||
| 927 | Frun_hooks (1, &tem); | ||
| 928 | } | ||
| 929 | 913 | ||
| 930 | /* If buffer was visible in a window, and a different window was | 914 | /* If buffer was visible in a window, and a different window was |
| 931 | selected, and the old selected window is still showing this | 915 | selected, and the old selected window is still showing this |
| @@ -5009,8 +4993,12 @@ functions if all the text being accessed has this property. */); | |||
| 5009 | defsubr (&Sregion_beginning); | 4993 | defsubr (&Sregion_beginning); |
| 5010 | defsubr (&Sregion_end); | 4994 | defsubr (&Sregion_end); |
| 5011 | 4995 | ||
| 4996 | /* Symbol for the text property used to mark fields. */ | ||
| 5012 | DEFSYM (Qfield, "field"); | 4997 | DEFSYM (Qfield, "field"); |
| 4998 | |||
| 4999 | /* A special value for Qfield properties. */ | ||
| 5013 | DEFSYM (Qboundary, "boundary"); | 5000 | DEFSYM (Qboundary, "boundary"); |
| 5001 | |||
| 5014 | defsubr (&Sfield_beginning); | 5002 | defsubr (&Sfield_beginning); |
| 5015 | defsubr (&Sfield_end); | 5003 | defsubr (&Sfield_end); |
| 5016 | defsubr (&Sfield_string); | 5004 | defsubr (&Sfield_string); |
diff --git a/src/emacs.c b/src/emacs.c index e7131c02f62..e7094b11580 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -151,13 +151,6 @@ static bool malloc_using_checking; | |||
| 151 | extern void malloc_enable_thread (void); | 151 | extern void malloc_enable_thread (void); |
| 152 | #endif | 152 | #endif |
| 153 | 153 | ||
| 154 | Lisp_Object Qfile_name_handler_alist; | ||
| 155 | |||
| 156 | Lisp_Object Qrisky_local_variable; | ||
| 157 | |||
| 158 | Lisp_Object Qkill_emacs; | ||
| 159 | static Lisp_Object Qkill_emacs_hook; | ||
| 160 | |||
| 161 | /* If true, Emacs should not attempt to use a window-specific code, | 154 | /* If true, Emacs should not attempt to use a window-specific code, |
| 162 | but instead should use the virtual terminal under which it was started. */ | 155 | but instead should use the virtual terminal under which it was started. */ |
| 163 | bool inhibit_window_system; | 156 | bool inhibit_window_system; |
| @@ -1919,7 +1912,7 @@ all of which are called before Emacs is actually killed. */) | |||
| 1919 | /* Fsignal calls emacs_abort () if it sees that waiting_for_input is | 1912 | /* Fsignal calls emacs_abort () if it sees that waiting_for_input is |
| 1920 | set. */ | 1913 | set. */ |
| 1921 | waiting_for_input = 0; | 1914 | waiting_for_input = 0; |
| 1922 | Frun_hooks (1, &Qkill_emacs_hook); | 1915 | run_hook (Qkill_emacs_hook); |
| 1923 | UNGCPRO; | 1916 | UNGCPRO; |
| 1924 | 1917 | ||
| 1925 | #ifdef HAVE_X_WINDOWS | 1918 | #ifdef HAVE_X_WINDOWS |
diff --git a/src/eval.c b/src/eval.c index 4748712708f..7e4b016b236 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -38,22 +38,6 @@ struct handler *handlerlist; | |||
| 38 | int gcpro_level; | 38 | int gcpro_level; |
| 39 | #endif | 39 | #endif |
| 40 | 40 | ||
| 41 | Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp; | ||
| 42 | Lisp_Object Qinhibit_quit; | ||
| 43 | Lisp_Object Qand_rest; | ||
| 44 | static Lisp_Object Qand_optional; | ||
| 45 | static Lisp_Object Qinhibit_debugger; | ||
| 46 | static Lisp_Object Qdeclare; | ||
| 47 | Lisp_Object Qinternal_interpreter_environment, Qclosure; | ||
| 48 | |||
| 49 | static Lisp_Object Qdebug; | ||
| 50 | |||
| 51 | /* This holds either the symbol `run-hooks' or nil. | ||
| 52 | It is nil at an early stage of startup, and when Emacs | ||
| 53 | is shutting down. */ | ||
| 54 | |||
| 55 | Lisp_Object Vrun_hooks; | ||
| 56 | |||
| 57 | /* Non-nil means record all fset's and provide's, to be undone | 41 | /* Non-nil means record all fset's and provide's, to be undone |
| 58 | if the file being autoloaded is not fully loaded. | 42 | if the file being autoloaded is not fully loaded. |
| 59 | They are recorded by being consed onto the front of Vautoload_queue: | 43 | They are recorded by being consed onto the front of Vautoload_queue: |
| @@ -61,6 +45,11 @@ Lisp_Object Vrun_hooks; | |||
| 61 | 45 | ||
| 62 | Lisp_Object Vautoload_queue; | 46 | Lisp_Object Vautoload_queue; |
| 63 | 47 | ||
| 48 | /* This holds either the symbol `run-hooks' or nil. | ||
| 49 | It is nil at an early stage of startup, and when Emacs | ||
| 50 | is shutting down. */ | ||
| 51 | Lisp_Object Vrun_hooks; | ||
| 52 | |||
| 64 | /* Current number of specbindings allocated in specpdl, not counting | 53 | /* Current number of specbindings allocated in specpdl, not counting |
| 65 | the dummy entry specpdl[-1]. */ | 54 | the dummy entry specpdl[-1]. */ |
| 66 | 55 | ||
| @@ -2363,14 +2352,10 @@ Instead, use `add-hook' and specify t for the LOCAL argument. | |||
| 2363 | usage: (run-hooks &rest HOOKS) */) | 2352 | usage: (run-hooks &rest HOOKS) */) |
| 2364 | (ptrdiff_t nargs, Lisp_Object *args) | 2353 | (ptrdiff_t nargs, Lisp_Object *args) |
| 2365 | { | 2354 | { |
| 2366 | Lisp_Object hook[1]; | ||
| 2367 | ptrdiff_t i; | 2355 | ptrdiff_t i; |
| 2368 | 2356 | ||
| 2369 | for (i = 0; i < nargs; i++) | 2357 | for (i = 0; i < nargs; i++) |
| 2370 | { | 2358 | run_hook (args[i]); |
| 2371 | hook[0] = args[i]; | ||
| 2372 | run_hook_with_args (1, hook, funcall_nil); | ||
| 2373 | } | ||
| 2374 | 2359 | ||
| 2375 | return Qnil; | 2360 | return Qnil; |
| 2376 | } | 2361 | } |
| @@ -2536,6 +2521,14 @@ run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, | |||
| 2536 | } | 2521 | } |
| 2537 | } | 2522 | } |
| 2538 | 2523 | ||
| 2524 | /* Run the hook HOOK, giving each function no args. */ | ||
| 2525 | |||
| 2526 | void | ||
| 2527 | run_hook (Lisp_Object hook) | ||
| 2528 | { | ||
| 2529 | Frun_hook_with_args (1, &hook); | ||
| 2530 | } | ||
| 2531 | |||
| 2539 | /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */ | 2532 | /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */ |
| 2540 | 2533 | ||
| 2541 | void | 2534 | void |
| @@ -3762,7 +3755,8 @@ alist of active lexical bindings. */); | |||
| 3762 | (Just imagine if someone makes it buffer-local). */ | 3755 | (Just imagine if someone makes it buffer-local). */ |
| 3763 | Funintern (Qinternal_interpreter_environment, Qnil); | 3756 | Funintern (Qinternal_interpreter_environment, Qnil); |
| 3764 | 3757 | ||
| 3765 | DEFSYM (Vrun_hooks, "run-hooks"); | 3758 | Vrun_hooks = intern_c_string ("run-hooks"); |
| 3759 | staticpro (&Vrun_hooks); | ||
| 3766 | 3760 | ||
| 3767 | staticpro (&Vautoload_queue); | 3761 | staticpro (&Vautoload_queue); |
| 3768 | Vautoload_queue = Qnil; | 3762 | Vautoload_queue = Qnil; |
diff --git a/src/fileio.c b/src/fileio.c index 0f0fd1a5c8d..15c6f9123a2 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -113,50 +113,10 @@ static bool auto_save_error_occurred; | |||
| 113 | static bool valid_timestamp_file_system; | 113 | static bool valid_timestamp_file_system; |
| 114 | static dev_t timestamp_file_system; | 114 | static dev_t timestamp_file_system; |
| 115 | 115 | ||
| 116 | /* The symbol bound to coding-system-for-read when | ||
| 117 | insert-file-contents is called for recovering a file. This is not | ||
| 118 | an actual coding system name, but just an indicator to tell | ||
| 119 | insert-file-contents to use `emacs-mule' with a special flag for | ||
| 120 | auto saving and recovering a file. */ | ||
| 121 | static Lisp_Object Qauto_save_coding; | ||
| 122 | |||
| 123 | /* Property name of a file name handler, | ||
| 124 | which gives a list of operations it handles.. */ | ||
| 125 | static Lisp_Object Qoperations; | ||
| 126 | |||
| 127 | /* Lisp functions for translating file formats. */ | ||
| 128 | static Lisp_Object Qformat_decode, Qformat_annotate_function; | ||
| 129 | |||
| 130 | /* Lisp function for setting buffer-file-coding-system and the | ||
| 131 | multibyteness of the current buffer after inserting a file. */ | ||
| 132 | static Lisp_Object Qafter_insert_file_set_coding; | ||
| 133 | |||
| 134 | static Lisp_Object Qwrite_region_annotate_functions; | ||
| 135 | /* Each time an annotation function changes the buffer, the new buffer | 116 | /* Each time an annotation function changes the buffer, the new buffer |
| 136 | is added here. */ | 117 | is added here. */ |
| 137 | static Lisp_Object Vwrite_region_annotation_buffers; | 118 | static Lisp_Object Vwrite_region_annotation_buffers; |
| 138 | 119 | ||
| 139 | static Lisp_Object Qdelete_by_moving_to_trash; | ||
| 140 | |||
| 141 | /* Lisp function for moving files to trash. */ | ||
| 142 | static Lisp_Object Qmove_file_to_trash; | ||
| 143 | |||
| 144 | /* Lisp function for recursively copying directories. */ | ||
| 145 | static Lisp_Object Qcopy_directory; | ||
| 146 | |||
| 147 | /* Lisp function for recursively deleting directories. */ | ||
| 148 | static Lisp_Object Qdelete_directory; | ||
| 149 | |||
| 150 | static Lisp_Object Qsubstitute_env_in_file_name; | ||
| 151 | static Lisp_Object Qget_buffer_window_list; | ||
| 152 | |||
| 153 | Lisp_Object Qfile_error, Qfile_notify_error; | ||
| 154 | static Lisp_Object Qfile_already_exists, Qfile_date_error; | ||
| 155 | static Lisp_Object Qexcl; | ||
| 156 | Lisp_Object Qfile_name_history; | ||
| 157 | |||
| 158 | static Lisp_Object Qcar_less_than_car; | ||
| 159 | |||
| 160 | static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, | 120 | static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, |
| 161 | Lisp_Object *, struct coding_system *); | 121 | Lisp_Object *, struct coding_system *); |
| 162 | static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, | 122 | static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, |
| @@ -291,43 +251,6 @@ restore_point_unwind (Lisp_Object location) | |||
| 291 | } | 251 | } |
| 292 | 252 | ||
| 293 | 253 | ||
| 294 | static Lisp_Object Qexpand_file_name; | ||
| 295 | static Lisp_Object Qsubstitute_in_file_name; | ||
| 296 | static Lisp_Object Qdirectory_file_name; | ||
| 297 | static Lisp_Object Qfile_name_directory; | ||
| 298 | static Lisp_Object Qfile_name_nondirectory; | ||
| 299 | static Lisp_Object Qunhandled_file_name_directory; | ||
| 300 | static Lisp_Object Qfile_name_as_directory; | ||
| 301 | static Lisp_Object Qcopy_file; | ||
| 302 | static Lisp_Object Qmake_directory_internal; | ||
| 303 | static Lisp_Object Qmake_directory; | ||
| 304 | static Lisp_Object Qdelete_directory_internal; | ||
| 305 | Lisp_Object Qdelete_file; | ||
| 306 | static Lisp_Object Qrename_file; | ||
| 307 | static Lisp_Object Qadd_name_to_file; | ||
| 308 | static Lisp_Object Qmake_symbolic_link; | ||
| 309 | Lisp_Object Qfile_exists_p; | ||
| 310 | static Lisp_Object Qfile_executable_p; | ||
| 311 | static Lisp_Object Qfile_readable_p; | ||
| 312 | static Lisp_Object Qfile_writable_p; | ||
| 313 | static Lisp_Object Qfile_symlink_p; | ||
| 314 | static Lisp_Object Qaccess_file; | ||
| 315 | Lisp_Object Qfile_directory_p; | ||
| 316 | static Lisp_Object Qfile_regular_p; | ||
| 317 | static Lisp_Object Qfile_accessible_directory_p; | ||
| 318 | static Lisp_Object Qfile_modes; | ||
| 319 | static Lisp_Object Qset_file_modes; | ||
| 320 | static Lisp_Object Qset_file_times; | ||
| 321 | static Lisp_Object Qfile_selinux_context; | ||
| 322 | static Lisp_Object Qset_file_selinux_context; | ||
| 323 | static Lisp_Object Qfile_acl; | ||
| 324 | static Lisp_Object Qset_file_acl; | ||
| 325 | static Lisp_Object Qfile_newer_than_file_p; | ||
| 326 | Lisp_Object Qinsert_file_contents; | ||
| 327 | Lisp_Object Qwrite_region; | ||
| 328 | static Lisp_Object Qverify_visited_file_modtime; | ||
| 329 | static Lisp_Object Qset_visited_file_modtime; | ||
| 330 | |||
| 331 | DEFUN ("find-file-name-handler", Ffind_file_name_handler, | 254 | DEFUN ("find-file-name-handler", Ffind_file_name_handler, |
| 332 | Sfind_file_name_handler, 2, 2, 0, | 255 | Sfind_file_name_handler, 2, 2, 0, |
| 333 | doc: /* Return FILENAME's handler function for OPERATION, if it has one. | 256 | doc: /* Return FILENAME's handler function for OPERATION, if it has one. |
| @@ -5866,7 +5789,10 @@ init_fileio (void) | |||
| 5866 | void | 5789 | void |
| 5867 | syms_of_fileio (void) | 5790 | syms_of_fileio (void) |
| 5868 | { | 5791 | { |
| 5792 | /* Property name of a file name handler, | ||
| 5793 | which gives a list of operations it handles. */ | ||
| 5869 | DEFSYM (Qoperations, "operations"); | 5794 | DEFSYM (Qoperations, "operations"); |
| 5795 | |||
| 5870 | DEFSYM (Qexpand_file_name, "expand-file-name"); | 5796 | DEFSYM (Qexpand_file_name, "expand-file-name"); |
| 5871 | DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name"); | 5797 | DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name"); |
| 5872 | DEFSYM (Qdirectory_file_name, "directory-file-name"); | 5798 | DEFSYM (Qdirectory_file_name, "directory-file-name"); |
| @@ -5903,6 +5829,12 @@ syms_of_fileio (void) | |||
| 5903 | DEFSYM (Qwrite_region, "write-region"); | 5829 | DEFSYM (Qwrite_region, "write-region"); |
| 5904 | DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime"); | 5830 | DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime"); |
| 5905 | DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime"); | 5831 | DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime"); |
| 5832 | |||
| 5833 | /* The symbol bound to coding-system-for-read when | ||
| 5834 | insert-file-contents is called for recovering a file. This is not | ||
| 5835 | an actual coding system name, but just an indicator to tell | ||
| 5836 | insert-file-contents to use `emacs-mule' with a special flag for | ||
| 5837 | auto saving and recovering a file. */ | ||
| 5906 | DEFSYM (Qauto_save_coding, "auto-save-coding"); | 5838 | DEFSYM (Qauto_save_coding, "auto-save-coding"); |
| 5907 | 5839 | ||
| 5908 | DEFSYM (Qfile_name_history, "file-name-history"); | 5840 | DEFSYM (Qfile_name_history, "file-name-history"); |
| @@ -5938,9 +5870,14 @@ On MS-Windows, the value of this variable is largely ignored if | |||
| 5938 | behaves as if file names were encoded in `utf-8'. */); | 5870 | behaves as if file names were encoded in `utf-8'. */); |
| 5939 | Vdefault_file_name_coding_system = Qnil; | 5871 | Vdefault_file_name_coding_system = Qnil; |
| 5940 | 5872 | ||
| 5873 | /* Lisp functions for translating file formats. */ | ||
| 5941 | DEFSYM (Qformat_decode, "format-decode"); | 5874 | DEFSYM (Qformat_decode, "format-decode"); |
| 5942 | DEFSYM (Qformat_annotate_function, "format-annotate-function"); | 5875 | DEFSYM (Qformat_annotate_function, "format-annotate-function"); |
| 5876 | |||
| 5877 | /* Lisp function for setting buffer-file-coding-system and the | ||
| 5878 | multibyteness of the current buffer after inserting a file. */ | ||
| 5943 | DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding"); | 5879 | DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding"); |
| 5880 | |||
| 5944 | DEFSYM (Qcar_less_than_car, "car-less-than-car"); | 5881 | DEFSYM (Qcar_less_than_car, "car-less-than-car"); |
| 5945 | 5882 | ||
| 5946 | Fput (Qfile_error, Qerror_conditions, | 5883 | Fput (Qfile_error, Qerror_conditions, |
| @@ -6094,11 +6031,17 @@ When non-nil, certain file deletion commands use the function | |||
| 6094 | This includes interactive calls to `delete-file' and | 6031 | This includes interactive calls to `delete-file' and |
| 6095 | `delete-directory' and the Dired deletion commands. */); | 6032 | `delete-directory' and the Dired deletion commands. */); |
| 6096 | delete_by_moving_to_trash = 0; | 6033 | delete_by_moving_to_trash = 0; |
| 6097 | Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash"); | 6034 | DEFSYM (Qdelete_by_moving_to_trash, "delete-by-moving-to-trash"); |
| 6098 | 6035 | ||
| 6036 | /* Lisp function for moving files to trash. */ | ||
| 6099 | DEFSYM (Qmove_file_to_trash, "move-file-to-trash"); | 6037 | DEFSYM (Qmove_file_to_trash, "move-file-to-trash"); |
| 6038 | |||
| 6039 | /* Lisp function for recursively copying directories. */ | ||
| 6100 | DEFSYM (Qcopy_directory, "copy-directory"); | 6040 | DEFSYM (Qcopy_directory, "copy-directory"); |
| 6041 | |||
| 6042 | /* Lisp function for recursively deleting directories. */ | ||
| 6101 | DEFSYM (Qdelete_directory, "delete-directory"); | 6043 | DEFSYM (Qdelete_directory, "delete-directory"); |
| 6044 | |||
| 6102 | DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name"); | 6045 | DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name"); |
| 6103 | DEFSYM (Qget_buffer_window_list, "get-buffer-window-list"); | 6046 | DEFSYM (Qget_buffer_window_list, "get-buffer-window-list"); |
| 6104 | 6047 | ||
| @@ -41,16 +41,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 41 | #include "xterm.h" | 41 | #include "xterm.h" |
| 42 | #endif | 42 | #endif |
| 43 | 43 | ||
| 44 | Lisp_Object Qstring_lessp; | ||
| 45 | static Lisp_Object Qstring_collate_lessp, Qstring_collate_equalp; | ||
| 46 | static Lisp_Object Qprovide, Qrequire; | ||
| 47 | static Lisp_Object Qyes_or_no_p_history; | ||
| 48 | Lisp_Object Qcursor_in_echo_area; | ||
| 49 | static Lisp_Object Qwidget_type; | ||
| 50 | static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; | ||
| 51 | |||
| 52 | static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512; | ||
| 53 | |||
| 54 | static void sort_vector_copy (Lisp_Object, ptrdiff_t, | 44 | static void sort_vector_copy (Lisp_Object, ptrdiff_t, |
| 55 | Lisp_Object [restrict], Lisp_Object [restrict]); | 45 | Lisp_Object [restrict], Lisp_Object [restrict]); |
| 56 | 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); |
| @@ -2788,8 +2778,6 @@ advisable. */) | |||
| 2788 | return ret; | 2778 | return ret; |
| 2789 | } | 2779 | } |
| 2790 | 2780 | ||
| 2791 | static Lisp_Object Qsubfeatures; | ||
| 2792 | |||
| 2793 | DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0, | 2781 | DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0, |
| 2794 | doc: /* Return t if FEATURE is present in this Emacs. | 2782 | doc: /* Return t if FEATURE is present in this Emacs. |
| 2795 | 2783 | ||
| @@ -2808,8 +2796,6 @@ SUBFEATURE can be used to check a specific subfeature of FEATURE. */) | |||
| 2808 | return (NILP (tem)) ? Qnil : Qt; | 2796 | return (NILP (tem)) ? Qnil : Qt; |
| 2809 | } | 2797 | } |
| 2810 | 2798 | ||
| 2811 | static Lisp_Object Qfuncall; | ||
| 2812 | |||
| 2813 | DEFUN ("provide", Fprovide, Sprovide, 1, 2, 0, | 2799 | DEFUN ("provide", Fprovide, Sprovide, 1, 2, 0, |
| 2814 | doc: /* Announce that FEATURE is a feature of the current Emacs. | 2800 | doc: /* Announce that FEATURE is a feature of the current Emacs. |
| 2815 | The optional argument SUBFEATURES should be a list of symbols listing | 2801 | The optional argument SUBFEATURES should be a list of symbols listing |
| @@ -3596,14 +3582,6 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length, | |||
| 3596 | 3582 | ||
| 3597 | static struct Lisp_Hash_Table *weak_hash_tables; | 3583 | static struct Lisp_Hash_Table *weak_hash_tables; |
| 3598 | 3584 | ||
| 3599 | /* Various symbols. */ | ||
| 3600 | |||
| 3601 | static Lisp_Object Qhash_table_p; | ||
| 3602 | static Lisp_Object Qkey, Qvalue, Qeql; | ||
| 3603 | Lisp_Object Qeq, Qequal; | ||
| 3604 | Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness; | ||
| 3605 | static Lisp_Object Qhash_table_test, Qkey_or_value, Qkey_and_value; | ||
| 3606 | |||
| 3607 | 3585 | ||
| 3608 | /*********************************************************************** | 3586 | /*********************************************************************** |
| 3609 | Utilities | 3587 | Utilities |
diff --git a/src/font.c b/src/font.c index dea18a1e939..a68c3c707c8 100644 --- a/src/font.c +++ b/src/font.c | |||
| @@ -41,16 +41,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 41 | #include TERM_HEADER | 41 | #include TERM_HEADER |
| 42 | #endif /* HAVE_WINDOW_SYSTEM */ | 42 | #endif /* HAVE_WINDOW_SYSTEM */ |
| 43 | 43 | ||
| 44 | Lisp_Object Qopentype; | ||
| 45 | |||
| 46 | /* Important character set strings. */ | ||
| 47 | Lisp_Object Qascii_0, Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip; | ||
| 48 | |||
| 49 | #define DEFAULT_ENCODING Qiso8859_1 | 44 | #define DEFAULT_ENCODING Qiso8859_1 |
| 50 | 45 | ||
| 51 | /* Unicode category `Cf'. */ | ||
| 52 | static Lisp_Object QCf; | ||
| 53 | |||
| 54 | /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */ | 46 | /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */ |
| 55 | static Lisp_Object font_style_table; | 47 | static Lisp_Object font_style_table; |
| 56 | 48 | ||
| @@ -110,21 +102,6 @@ static const struct table_entry width_table[] = | |||
| 110 | { 200, { "ultra-expanded", "ultraexpanded", "wide" }} | 102 | { 200, { "ultra-expanded", "ultraexpanded", "wide" }} |
| 111 | }; | 103 | }; |
| 112 | 104 | ||
| 113 | Lisp_Object QCfoundry; | ||
| 114 | static Lisp_Object QCadstyle, QCregistry; | ||
| 115 | /* Symbols representing keys of font extra info. */ | ||
| 116 | Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClang, QCscript, QCavgwidth; | ||
| 117 | Lisp_Object QCantialias, QCfont_entity; | ||
| 118 | static Lisp_Object QCfc_unknown_spec; | ||
| 119 | /* Symbols representing values of font spacing property. */ | ||
| 120 | static Lisp_Object Qc, Qm, Qd; | ||
| 121 | Lisp_Object Qp; | ||
| 122 | /* Special ADSTYLE properties to avoid fonts used for Latin | ||
| 123 | characters; used in xfont.c and ftfont.c. */ | ||
| 124 | Lisp_Object Qja, Qko; | ||
| 125 | |||
| 126 | static Lisp_Object QCuser_spec; | ||
| 127 | |||
| 128 | /* Alist of font registry symbols and the corresponding charset | 105 | /* Alist of font registry symbols and the corresponding charset |
| 129 | information. The information is retrieved from | 106 | information. The information is retrieved from |
| 130 | Vfont_encoding_alist on demand. | 107 | Vfont_encoding_alist on demand. |
| @@ -309,7 +286,7 @@ font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol) | |||
| 309 | return tem; | 286 | return tem; |
| 310 | name = make_specified_string (str, nchars, len, | 287 | name = make_specified_string (str, nchars, len, |
| 311 | len != nchars && len == nbytes); | 288 | len != nchars && len == nbytes); |
| 312 | return intern_driver (name, obarray, XINT (tem)); | 289 | return intern_driver (name, obarray, tem); |
| 313 | } | 290 | } |
| 314 | 291 | ||
| 315 | /* Return a pixel size of font-spec SPEC on frame F. */ | 292 | /* Return a pixel size of font-spec SPEC on frame F. */ |
| @@ -662,30 +639,30 @@ font_prop_validate_otf (Lisp_Object prop, Lisp_Object val) | |||
| 662 | values. */ | 639 | values. */ |
| 663 | static const struct | 640 | static const struct |
| 664 | { | 641 | { |
| 665 | /* Pointer to the key symbol. */ | 642 | /* Index of the key symbol. */ |
| 666 | Lisp_Object *key; | 643 | int key; |
| 667 | /* Function to validate PROP's value VAL, or NULL if any value is | 644 | /* Function to validate PROP's value VAL, or NULL if any value is |
| 668 | ok. The value is VAL or its regularized value if VAL is valid, | 645 | ok. The value is VAL or its regularized value if VAL is valid, |
| 669 | and Qerror if not. */ | 646 | and Qerror if not. */ |
| 670 | Lisp_Object (*validator) (Lisp_Object prop, Lisp_Object val); | 647 | Lisp_Object (*validator) (Lisp_Object prop, Lisp_Object val); |
| 671 | } font_property_table[] = | 648 | } font_property_table[] = |
| 672 | { { &QCtype, font_prop_validate_symbol }, | 649 | { { SYMBOL_INDEX (QCtype), font_prop_validate_symbol }, |
| 673 | { &QCfoundry, font_prop_validate_symbol }, | 650 | { SYMBOL_INDEX (QCfoundry), font_prop_validate_symbol }, |
| 674 | { &QCfamily, font_prop_validate_symbol }, | 651 | { SYMBOL_INDEX (QCfamily), font_prop_validate_symbol }, |
| 675 | { &QCadstyle, font_prop_validate_symbol }, | 652 | { SYMBOL_INDEX (QCadstyle), font_prop_validate_symbol }, |
| 676 | { &QCregistry, font_prop_validate_symbol }, | 653 | { SYMBOL_INDEX (QCregistry), font_prop_validate_symbol }, |
| 677 | { &QCweight, font_prop_validate_style }, | 654 | { SYMBOL_INDEX (QCweight), font_prop_validate_style }, |
| 678 | { &QCslant, font_prop_validate_style }, | 655 | { SYMBOL_INDEX (QCslant), font_prop_validate_style }, |
| 679 | { &QCwidth, font_prop_validate_style }, | 656 | { SYMBOL_INDEX (QCwidth), font_prop_validate_style }, |
| 680 | { &QCsize, font_prop_validate_non_neg }, | 657 | { SYMBOL_INDEX (QCsize), font_prop_validate_non_neg }, |
| 681 | { &QCdpi, font_prop_validate_non_neg }, | 658 | { SYMBOL_INDEX (QCdpi), font_prop_validate_non_neg }, |
| 682 | { &QCspacing, font_prop_validate_spacing }, | 659 | { SYMBOL_INDEX (QCspacing), font_prop_validate_spacing }, |
| 683 | { &QCavgwidth, font_prop_validate_non_neg }, | 660 | { SYMBOL_INDEX (QCavgwidth), font_prop_validate_non_neg }, |
| 684 | /* The order of the above entries must match with enum | 661 | /* The order of the above entries must match with enum |
| 685 | font_property_index. */ | 662 | font_property_index. */ |
| 686 | { &QClang, font_prop_validate_symbol }, | 663 | { SYMBOL_INDEX (QClang), font_prop_validate_symbol }, |
| 687 | { &QCscript, font_prop_validate_symbol }, | 664 | { SYMBOL_INDEX (QCscript), font_prop_validate_symbol }, |
| 688 | { &QCotf, font_prop_validate_otf } | 665 | { SYMBOL_INDEX (QCotf), font_prop_validate_otf } |
| 689 | }; | 666 | }; |
| 690 | 667 | ||
| 691 | /* Return an index number of font property KEY or -1 if KEY is not an | 668 | /* Return an index number of font property KEY or -1 if KEY is not an |
| @@ -697,7 +674,7 @@ get_font_prop_index (Lisp_Object key) | |||
| 697 | int i; | 674 | int i; |
| 698 | 675 | ||
| 699 | for (i = 0; i < ARRAYELTS (font_property_table); i++) | 676 | for (i = 0; i < ARRAYELTS (font_property_table); i++) |
| 700 | if (EQ (key, *font_property_table[i].key)) | 677 | if (EQ (key, builtin_lisp_symbol (font_property_table[i].key))) |
| 701 | return i; | 678 | return i; |
| 702 | return -1; | 679 | return -1; |
| 703 | } | 680 | } |
| @@ -714,7 +691,7 @@ font_prop_validate (int idx, Lisp_Object prop, Lisp_Object val) | |||
| 714 | if (NILP (val)) | 691 | if (NILP (val)) |
| 715 | return val; | 692 | return val; |
| 716 | if (NILP (prop)) | 693 | if (NILP (prop)) |
| 717 | prop = *font_property_table[idx].key; | 694 | prop = builtin_lisp_symbol (font_property_table[idx].key); |
| 718 | else | 695 | else |
| 719 | { | 696 | { |
| 720 | idx = get_font_prop_index (prop); | 697 | idx = get_font_prop_index (prop); |
| @@ -5169,19 +5146,21 @@ syms_of_font (void) | |||
| 5169 | 5146 | ||
| 5170 | DEFSYM (Qopentype, "opentype"); | 5147 | DEFSYM (Qopentype, "opentype"); |
| 5171 | 5148 | ||
| 5149 | /* Important character set symbols. */ | ||
| 5172 | DEFSYM (Qascii_0, "ascii-0"); | 5150 | DEFSYM (Qascii_0, "ascii-0"); |
| 5173 | DEFSYM (Qiso8859_1, "iso8859-1"); | 5151 | DEFSYM (Qiso8859_1, "iso8859-1"); |
| 5174 | DEFSYM (Qiso10646_1, "iso10646-1"); | 5152 | DEFSYM (Qiso10646_1, "iso10646-1"); |
| 5175 | DEFSYM (Qunicode_bmp, "unicode-bmp"); | 5153 | DEFSYM (Qunicode_bmp, "unicode-bmp"); |
| 5176 | DEFSYM (Qunicode_sip, "unicode-sip"); | 5154 | DEFSYM (Qunicode_sip, "unicode-sip"); |
| 5177 | 5155 | ||
| 5156 | /* Unicode category `Cf'. */ | ||
| 5178 | DEFSYM (QCf, "Cf"); | 5157 | DEFSYM (QCf, "Cf"); |
| 5179 | 5158 | ||
| 5159 | /* Symbols representing keys of font extra info. */ | ||
| 5180 | DEFSYM (QCotf, ":otf"); | 5160 | DEFSYM (QCotf, ":otf"); |
| 5181 | DEFSYM (QClang, ":lang"); | 5161 | DEFSYM (QClang, ":lang"); |
| 5182 | DEFSYM (QCscript, ":script"); | 5162 | DEFSYM (QCscript, ":script"); |
| 5183 | DEFSYM (QCantialias, ":antialias"); | 5163 | DEFSYM (QCantialias, ":antialias"); |
| 5184 | |||
| 5185 | DEFSYM (QCfoundry, ":foundry"); | 5164 | DEFSYM (QCfoundry, ":foundry"); |
| 5186 | DEFSYM (QCadstyle, ":adstyle"); | 5165 | DEFSYM (QCadstyle, ":adstyle"); |
| 5187 | DEFSYM (QCregistry, ":registry"); | 5166 | DEFSYM (QCregistry, ":registry"); |
| @@ -5192,11 +5171,14 @@ syms_of_font (void) | |||
| 5192 | DEFSYM (QCfont_entity, ":font-entity"); | 5171 | DEFSYM (QCfont_entity, ":font-entity"); |
| 5193 | DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec"); | 5172 | DEFSYM (QCfc_unknown_spec, ":fc-unknown-spec"); |
| 5194 | 5173 | ||
| 5174 | /* Symbols representing values of font spacing property. */ | ||
| 5195 | DEFSYM (Qc, "c"); | 5175 | DEFSYM (Qc, "c"); |
| 5196 | DEFSYM (Qm, "m"); | 5176 | DEFSYM (Qm, "m"); |
| 5197 | DEFSYM (Qp, "p"); | 5177 | DEFSYM (Qp, "p"); |
| 5198 | DEFSYM (Qd, "d"); | 5178 | DEFSYM (Qd, "d"); |
| 5199 | 5179 | ||
| 5180 | /* Special ADSTYLE properties to avoid fonts used for Latin | ||
| 5181 | characters; used in xfont.c and ftfont.c. */ | ||
| 5200 | DEFSYM (Qja, "ja"); | 5182 | DEFSYM (Qja, "ja"); |
| 5201 | DEFSYM (Qko, "ko"); | 5183 | DEFSYM (Qko, "ko"); |
| 5202 | 5184 | ||
diff --git a/src/font.h b/src/font.h index 617860c85f1..5a3e38a2a6e 100644 --- a/src/font.h +++ b/src/font.h | |||
| @@ -56,7 +56,6 @@ INLINE_HEADER_BEGIN | |||
| 56 | Note: Only the method `open' of a font-driver can create this | 56 | Note: Only the method `open' of a font-driver can create this |
| 57 | object, and it should never be modified by Lisp. */ | 57 | object, and it should never be modified by Lisp. */ |
| 58 | 58 | ||
| 59 | extern Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; | ||
| 60 | 59 | ||
| 61 | /* An enumerator for each font property. This is used as an index to | 60 | /* An enumerator for each font property. This is used as an index to |
| 62 | the vector of FONT-SPEC and FONT-ENTITY. | 61 | the vector of FONT-SPEC and FONT-ENTITY. |
| @@ -239,17 +238,6 @@ enum font_property_index | |||
| 239 | #define FONT_BASE(f) ((f)->ascent) | 238 | #define FONT_BASE(f) ((f)->ascent) |
| 240 | #define FONT_DESCENT(f) ((f)->descent) | 239 | #define FONT_DESCENT(f) ((f)->descent) |
| 241 | 240 | ||
| 242 | extern Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClang, QCscript; | ||
| 243 | extern Lisp_Object QCavgwidth, QCantialias, QCfont_entity; | ||
| 244 | extern Lisp_Object Qp; | ||
| 245 | |||
| 246 | |||
| 247 | /* Important character set symbols. */ | ||
| 248 | extern Lisp_Object Qascii_0; | ||
| 249 | extern Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip; | ||
| 250 | |||
| 251 | /* Special ADSTYLE properties to avoid fonts used for Latin characters. */ | ||
| 252 | extern Lisp_Object Qja, Qko; | ||
| 253 | 241 | ||
| 254 | /* Structure for a font-spec. */ | 242 | /* Structure for a font-spec. */ |
| 255 | 243 | ||
| @@ -791,12 +779,11 @@ extern struct font_driver xfont_driver; | |||
| 791 | extern void syms_of_xfont (void); | 779 | extern void syms_of_xfont (void); |
| 792 | extern void syms_of_ftxfont (void); | 780 | extern void syms_of_ftxfont (void); |
| 793 | #ifdef HAVE_XFT | 781 | #ifdef HAVE_XFT |
| 794 | extern Lisp_Object Qxft; | ||
| 795 | extern struct font_driver xftfont_driver; | 782 | extern struct font_driver xftfont_driver; |
| 796 | extern void syms_of_xftfont (void); | ||
| 797 | #endif | 783 | #endif |
| 798 | #if defined HAVE_FREETYPE || defined HAVE_XFT | 784 | #if defined HAVE_FREETYPE || defined HAVE_XFT |
| 799 | extern struct font_driver ftxfont_driver; | 785 | extern struct font_driver ftxfont_driver; |
| 786 | extern void syms_of_xftfont (void); | ||
| 800 | #endif | 787 | #endif |
| 801 | #ifdef HAVE_BDFFONT | 788 | #ifdef HAVE_BDFFONT |
| 802 | extern void syms_of_bdffont (void); | 789 | extern void syms_of_bdffont (void); |
| @@ -808,7 +795,6 @@ extern struct font_driver uniscribe_font_driver; | |||
| 808 | extern void syms_of_w32font (void); | 795 | extern void syms_of_w32font (void); |
| 809 | #endif /* HAVE_NTGUI */ | 796 | #endif /* HAVE_NTGUI */ |
| 810 | #ifdef HAVE_NS | 797 | #ifdef HAVE_NS |
| 811 | extern Lisp_Object Qfontsize; | ||
| 812 | extern struct font_driver nsfont_driver; | 798 | extern struct font_driver nsfont_driver; |
| 813 | extern void syms_of_nsfont (void); | 799 | extern void syms_of_nsfont (void); |
| 814 | extern void syms_of_macfont (void); | 800 | extern void syms_of_macfont (void); |
| @@ -818,8 +804,6 @@ extern void syms_of_macfont (void); | |||
| 818 | #define FONT_DEBUG | 804 | #define FONT_DEBUG |
| 819 | #endif | 805 | #endif |
| 820 | 806 | ||
| 821 | extern Lisp_Object QCfoundry; | ||
| 822 | |||
| 823 | extern void font_add_log (const char *, Lisp_Object, Lisp_Object); | 807 | extern void font_add_log (const char *, Lisp_Object, Lisp_Object); |
| 824 | extern void font_deferred_log (const char *, Lisp_Object, Lisp_Object); | 808 | extern void font_deferred_log (const char *, Lisp_Object, Lisp_Object); |
| 825 | 809 | ||
diff --git a/src/fontset.c b/src/fontset.c index 974b144c259..b257da117b6 100644 --- a/src/fontset.c +++ b/src/fontset.c | |||
| @@ -152,11 +152,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 152 | 152 | ||
| 153 | /********** VARIABLES and FUNCTION PROTOTYPES **********/ | 153 | /********** VARIABLES and FUNCTION PROTOTYPES **********/ |
| 154 | 154 | ||
| 155 | static Lisp_Object Qfontset; | ||
| 156 | static Lisp_Object Qfontset_info; | ||
| 157 | static Lisp_Object Qprepend, Qappend; | ||
| 158 | Lisp_Object Qlatin; | ||
| 159 | |||
| 160 | /* Vector containing all fontsets. */ | 155 | /* Vector containing all fontsets. */ |
| 161 | static Lisp_Object Vfontset_table; | 156 | static Lisp_Object Vfontset_table; |
| 162 | 157 | ||
diff --git a/src/fontset.h b/src/fontset.h index e743555ef76..610394431e1 100644 --- a/src/fontset.h +++ b/src/fontset.h | |||
| @@ -36,7 +36,6 @@ extern int fontset_from_font (Lisp_Object); | |||
| 36 | extern int fs_query_fontset (Lisp_Object, int); | 36 | extern int fs_query_fontset (Lisp_Object, int); |
| 37 | extern Lisp_Object list_fontsets (struct frame *, Lisp_Object, int); | 37 | extern Lisp_Object list_fontsets (struct frame *, Lisp_Object, int); |
| 38 | 38 | ||
| 39 | extern Lisp_Object Qlatin; | ||
| 40 | extern Lisp_Object fontset_name (int); | 39 | extern Lisp_Object fontset_name (int); |
| 41 | extern Lisp_Object fontset_ascii (int); | 40 | extern Lisp_Object fontset_ascii (int); |
| 42 | 41 | ||
diff --git a/src/frame.c b/src/frame.c index 9394ae481f5..3d2ffbf624f 100644 --- a/src/frame.c +++ b/src/frame.c | |||
| @@ -55,76 +55,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 55 | #include "widget.h" | 55 | #include "widget.h" |
| 56 | #endif | 56 | #endif |
| 57 | 57 | ||
| 58 | #ifdef HAVE_NS | ||
| 59 | Lisp_Object Qns_parse_geometry; | ||
| 60 | #endif | ||
| 61 | |||
| 62 | Lisp_Object Qframep, Qframe_live_p; | ||
| 63 | Lisp_Object Qicon, Qmodeline; | ||
| 64 | Lisp_Object Qonly, Qnone; | ||
| 65 | Lisp_Object Qx, Qw32, Qpc, Qns; | ||
| 66 | Lisp_Object Qvisible; | ||
| 67 | Lisp_Object Qdisplay_type; | ||
| 68 | static Lisp_Object Qbackground_mode; | ||
| 69 | Lisp_Object Qnoelisp; | ||
| 70 | |||
| 71 | static Lisp_Object Qx_frame_parameter; | ||
| 72 | Lisp_Object Qx_resource_name; | ||
| 73 | Lisp_Object Qterminal; | ||
| 74 | |||
| 75 | /* Frame parameters (set or reported). */ | ||
| 76 | |||
| 77 | Lisp_Object Qauto_raise, Qauto_lower; | ||
| 78 | Lisp_Object Qborder_color, Qborder_width; | ||
| 79 | Lisp_Object Qcursor_color, Qcursor_type; | ||
| 80 | Lisp_Object Qheight, Qwidth; | ||
| 81 | Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name; | ||
| 82 | Lisp_Object Qtooltip; | ||
| 83 | Lisp_Object Qinternal_border_width; | ||
| 84 | Lisp_Object Qright_divider_width, Qbottom_divider_width; | ||
| 85 | Lisp_Object Qmouse_color; | ||
| 86 | Lisp_Object Qminibuffer; | ||
| 87 | Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars; | ||
| 88 | Lisp_Object Qscroll_bar_height, Qhorizontal_scroll_bars; | ||
| 89 | Lisp_Object Qvisibility; | ||
| 90 | Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background; | ||
| 91 | Lisp_Object Qscreen_gamma; | ||
| 92 | Lisp_Object Qline_spacing; | ||
| 93 | static Lisp_Object Quser_position, Quser_size; | ||
| 94 | Lisp_Object Qwait_for_wm; | ||
| 95 | static Lisp_Object Qwindow_id; | ||
| 96 | #ifdef HAVE_X_WINDOWS | ||
| 97 | static Lisp_Object Qouter_window_id; | ||
| 98 | #endif | ||
| 99 | Lisp_Object Qparent_id; | ||
| 100 | Lisp_Object Qtitle, Qname; | ||
| 101 | static Lisp_Object Qexplicit_name; | ||
| 102 | Lisp_Object Qunsplittable; | ||
| 103 | Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position; | ||
| 104 | Lisp_Object Qleft_fringe, Qright_fringe; | ||
| 105 | Lisp_Object Qbuffer_predicate; | ||
| 106 | static Lisp_Object Qbuffer_list, Qburied_buffer_list; | ||
| 107 | Lisp_Object Qtty_color_mode; | ||
| 108 | Lisp_Object Qtty, Qtty_type; | ||
| 109 | |||
| 110 | Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized; | ||
| 111 | Lisp_Object Qsticky; | ||
| 112 | Lisp_Object Qfont_backend; | ||
| 113 | Lisp_Object Qalpha; | ||
| 114 | |||
| 115 | Lisp_Object Qface_set_after_frame_default; | ||
| 116 | |||
| 117 | static Lisp_Object Qfocus_in_hook; | ||
| 118 | static Lisp_Object Qfocus_out_hook; | ||
| 119 | static Lisp_Object Qdelete_frame_functions; | ||
| 120 | static Lisp_Object Qframe_windows_min_size; | ||
| 121 | static Lisp_Object Qgeometry, Qworkarea, Qmm_size, Qframes, Qsource; | ||
| 122 | |||
| 123 | Lisp_Object Qframe_position, Qframe_outer_size, Qframe_inner_size; | ||
| 124 | Lisp_Object Qexternal_border_size, Qtitle_height; | ||
| 125 | Lisp_Object Qmenu_bar_external, Qmenu_bar_size; | ||
| 126 | Lisp_Object Qtool_bar_external, Qtool_bar_size; | ||
| 127 | |||
| 128 | /* The currently selected frame. */ | 58 | /* The currently selected frame. */ |
| 129 | 59 | ||
| 130 | Lisp_Object selected_frame; | 60 | Lisp_Object selected_frame; |
| @@ -1221,7 +1151,7 @@ to that frame. */) | |||
| 1221 | { | 1151 | { |
| 1222 | /* Preserve prefix arg that the command loop just cleared. */ | 1152 | /* Preserve prefix arg that the command loop just cleared. */ |
| 1223 | kset_prefix_arg (current_kboard, Vcurrent_prefix_arg); | 1153 | kset_prefix_arg (current_kboard, Vcurrent_prefix_arg); |
| 1224 | Frun_hooks (1, &Qmouse_leave_buffer_hook); | 1154 | run_hook (Qmouse_leave_buffer_hook); |
| 1225 | /* `switch-frame' implies a focus in. */ | 1155 | /* `switch-frame' implies a focus in. */ |
| 1226 | call1 (intern ("handle-focus-in"), event); | 1156 | call1 (intern ("handle-focus-in"), event); |
| 1227 | return do_switch_frame (event, 0, 0, Qnil); | 1157 | return do_switch_frame (event, 0, 0, Qnil); |
| @@ -2995,48 +2925,48 @@ or bottommost possible position (that stays within the screen). */) | |||
| 2995 | 2925 | ||
| 2996 | struct frame_parm_table { | 2926 | struct frame_parm_table { |
| 2997 | const char *name; | 2927 | const char *name; |
| 2998 | Lisp_Object *variable; | 2928 | int sym; |
| 2999 | }; | 2929 | }; |
| 3000 | 2930 | ||
| 3001 | static const struct frame_parm_table frame_parms[] = | 2931 | static const struct frame_parm_table frame_parms[] = |
| 3002 | { | 2932 | { |
| 3003 | {"auto-raise", &Qauto_raise}, | 2933 | {"auto-raise", SYMBOL_INDEX (Qauto_raise)}, |
| 3004 | {"auto-lower", &Qauto_lower}, | 2934 | {"auto-lower", SYMBOL_INDEX (Qauto_lower)}, |
| 3005 | {"background-color", 0}, | 2935 | {"background-color", -1}, |
| 3006 | {"border-color", &Qborder_color}, | 2936 | {"border-color", SYMBOL_INDEX (Qborder_color)}, |
| 3007 | {"border-width", &Qborder_width}, | 2937 | {"border-width", SYMBOL_INDEX (Qborder_width)}, |
| 3008 | {"cursor-color", &Qcursor_color}, | 2938 | {"cursor-color", SYMBOL_INDEX (Qcursor_color)}, |
| 3009 | {"cursor-type", &Qcursor_type}, | 2939 | {"cursor-type", SYMBOL_INDEX (Qcursor_type)}, |
| 3010 | {"font", 0}, | 2940 | {"font", -1}, |
| 3011 | {"foreground-color", 0}, | 2941 | {"foreground-color", -1}, |
| 3012 | {"icon-name", &Qicon_name}, | 2942 | {"icon-name", SYMBOL_INDEX (Qicon_name)}, |
| 3013 | {"icon-type", &Qicon_type}, | 2943 | {"icon-type", SYMBOL_INDEX (Qicon_type)}, |
| 3014 | {"internal-border-width", &Qinternal_border_width}, | 2944 | {"internal-border-width", SYMBOL_INDEX (Qinternal_border_width)}, |
| 3015 | {"right-divider-width", &Qright_divider_width}, | 2945 | {"right-divider-width", SYMBOL_INDEX (Qright_divider_width)}, |
| 3016 | {"bottom-divider-width", &Qbottom_divider_width}, | 2946 | {"bottom-divider-width", SYMBOL_INDEX (Qbottom_divider_width)}, |
| 3017 | {"menu-bar-lines", &Qmenu_bar_lines}, | 2947 | {"menu-bar-lines", SYMBOL_INDEX (Qmenu_bar_lines)}, |
| 3018 | {"mouse-color", &Qmouse_color}, | 2948 | {"mouse-color", SYMBOL_INDEX (Qmouse_color)}, |
| 3019 | {"name", &Qname}, | 2949 | {"name", SYMBOL_INDEX (Qname)}, |
| 3020 | {"scroll-bar-width", &Qscroll_bar_width}, | 2950 | {"scroll-bar-width", SYMBOL_INDEX (Qscroll_bar_width)}, |
| 3021 | {"scroll-bar-height", &Qscroll_bar_height}, | 2951 | {"scroll-bar-height", SYMBOL_INDEX (Qscroll_bar_height)}, |
| 3022 | {"title", &Qtitle}, | 2952 | {"title", SYMBOL_INDEX (Qtitle)}, |
| 3023 | {"unsplittable", &Qunsplittable}, | 2953 | {"unsplittable", SYMBOL_INDEX (Qunsplittable)}, |
| 3024 | {"vertical-scroll-bars", &Qvertical_scroll_bars}, | 2954 | {"vertical-scroll-bars", SYMBOL_INDEX (Qvertical_scroll_bars)}, |
| 3025 | {"horizontal-scroll-bars", &Qhorizontal_scroll_bars}, | 2955 | {"horizontal-scroll-bars", SYMBOL_INDEX (Qhorizontal_scroll_bars)}, |
| 3026 | {"visibility", &Qvisibility}, | 2956 | {"visibility", SYMBOL_INDEX (Qvisibility)}, |
| 3027 | {"tool-bar-lines", &Qtool_bar_lines}, | 2957 | {"tool-bar-lines", SYMBOL_INDEX (Qtool_bar_lines)}, |
| 3028 | {"scroll-bar-foreground", &Qscroll_bar_foreground}, | 2958 | {"scroll-bar-foreground", SYMBOL_INDEX (Qscroll_bar_foreground)}, |
| 3029 | {"scroll-bar-background", &Qscroll_bar_background}, | 2959 | {"scroll-bar-background", SYMBOL_INDEX (Qscroll_bar_background)}, |
| 3030 | {"screen-gamma", &Qscreen_gamma}, | 2960 | {"screen-gamma", SYMBOL_INDEX (Qscreen_gamma)}, |
| 3031 | {"line-spacing", &Qline_spacing}, | 2961 | {"line-spacing", SYMBOL_INDEX (Qline_spacing)}, |
| 3032 | {"left-fringe", &Qleft_fringe}, | 2962 | {"left-fringe", SYMBOL_INDEX (Qleft_fringe)}, |
| 3033 | {"right-fringe", &Qright_fringe}, | 2963 | {"right-fringe", SYMBOL_INDEX (Qright_fringe)}, |
| 3034 | {"wait-for-wm", &Qwait_for_wm}, | 2964 | {"wait-for-wm", SYMBOL_INDEX (Qwait_for_wm)}, |
| 3035 | {"fullscreen", &Qfullscreen}, | 2965 | {"fullscreen", SYMBOL_INDEX (Qfullscreen)}, |
| 3036 | {"font-backend", &Qfont_backend}, | 2966 | {"font-backend", SYMBOL_INDEX (Qfont_backend)}, |
| 3037 | {"alpha", &Qalpha}, | 2967 | {"alpha", SYMBOL_INDEX (Qalpha)}, |
| 3038 | {"sticky", &Qsticky}, | 2968 | {"sticky", SYMBOL_INDEX (Qsticky)}, |
| 3039 | {"tool-bar-position", &Qtool_bar_position}, | 2969 | {"tool-bar-position", SYMBOL_INDEX (Qtool_bar_position)}, |
| 3040 | }; | 2970 | }; |
| 3041 | 2971 | ||
| 3042 | #ifdef HAVE_WINDOW_SYSTEM | 2972 | #ifdef HAVE_WINDOW_SYSTEM |
| @@ -4854,17 +4784,49 @@ syms_of_frame (void) | |||
| 4854 | DEFSYM (Qns_parse_geometry, "ns-parse-geometry"); | 4784 | DEFSYM (Qns_parse_geometry, "ns-parse-geometry"); |
| 4855 | #endif | 4785 | #endif |
| 4856 | 4786 | ||
| 4787 | DEFSYM (Qalpha, "alpha"); | ||
| 4788 | DEFSYM (Qauto_lower, "auto-lower"); | ||
| 4789 | DEFSYM (Qauto_raise, "auto-raise"); | ||
| 4790 | DEFSYM (Qborder_color, "border-color"); | ||
| 4791 | DEFSYM (Qborder_width, "border-width"); | ||
| 4792 | DEFSYM (Qbottom_divider_width, "bottom-divider-width"); | ||
| 4793 | DEFSYM (Qcursor_color, "cursor-color"); | ||
| 4794 | DEFSYM (Qcursor_type, "cursor-type"); | ||
| 4795 | DEFSYM (Qfont_backend, "font-backend"); | ||
| 4796 | DEFSYM (Qfullscreen, "fullscreen"); | ||
| 4797 | DEFSYM (Qhorizontal_scroll_bars, "horizontal-scroll-bars"); | ||
| 4798 | DEFSYM (Qicon_name, "icon-name"); | ||
| 4799 | DEFSYM (Qicon_type, "icon-type"); | ||
| 4800 | DEFSYM (Qinternal_border_width, "internal-border-width"); | ||
| 4801 | DEFSYM (Qleft_fringe, "left-fringe"); | ||
| 4802 | DEFSYM (Qline_spacing, "line-spacing"); | ||
| 4803 | DEFSYM (Qmenu_bar_lines, "menu-bar-lines"); | ||
| 4804 | DEFSYM (Qmouse_color, "mouse-color"); | ||
| 4805 | DEFSYM (Qname, "name"); | ||
| 4806 | DEFSYM (Qright_divider_width, "right-divider-width"); | ||
| 4807 | DEFSYM (Qright_fringe, "right-fringe"); | ||
| 4808 | DEFSYM (Qscreen_gamma, "screen-gamma"); | ||
| 4809 | DEFSYM (Qscroll_bar_background, "scroll-bar-background"); | ||
| 4810 | DEFSYM (Qscroll_bar_foreground, "scroll-bar-foreground"); | ||
| 4811 | DEFSYM (Qscroll_bar_height, "scroll-bar-height"); | ||
| 4812 | DEFSYM (Qscroll_bar_width, "scroll-bar-width"); | ||
| 4813 | DEFSYM (Qsticky, "sticky"); | ||
| 4814 | DEFSYM (Qtitle, "title"); | ||
| 4815 | DEFSYM (Qtool_bar_lines, "tool-bar-lines"); | ||
| 4816 | DEFSYM (Qtool_bar_position, "tool-bar-position"); | ||
| 4817 | DEFSYM (Qunsplittable, "unsplittable"); | ||
| 4818 | DEFSYM (Qvertical_scroll_bars, "vertical-scroll-bars"); | ||
| 4819 | DEFSYM (Qvisibility, "visibility"); | ||
| 4820 | DEFSYM (Qwait_for_wm, "wait-for-wm"); | ||
| 4821 | |||
| 4857 | { | 4822 | { |
| 4858 | int i; | 4823 | int i; |
| 4859 | 4824 | ||
| 4860 | for (i = 0; i < ARRAYELTS (frame_parms); i++) | 4825 | for (i = 0; i < ARRAYELTS (frame_parms); i++) |
| 4861 | { | 4826 | { |
| 4862 | Lisp_Object v = intern_c_string (frame_parms[i].name); | 4827 | Lisp_Object v = (frame_parms[i].sym < 0 |
| 4863 | if (frame_parms[i].variable) | 4828 | ? intern_c_string (frame_parms[i].name) |
| 4864 | { | 4829 | : builtin_lisp_symbol (frame_parms[i].sym)); |
| 4865 | *frame_parms[i].variable = v; | ||
| 4866 | staticpro (frame_parms[i].variable); | ||
| 4867 | } | ||
| 4868 | Fput (v, Qx_frame_parameter, make_number (i)); | 4830 | Fput (v, Qx_frame_parameter, make_number (i)); |
| 4869 | } | 4831 | } |
| 4870 | } | 4832 | } |
diff --git a/src/frame.h b/src/frame.h index 80603ce5624..d1ed4d4a67e 100644 --- a/src/frame.h +++ b/src/frame.h | |||
| @@ -1095,11 +1095,6 @@ SET_FRAME_VISIBLE (struct frame *f, int v) | |||
| 1095 | (f)->iconified = (eassert (0 <= (i) && (i) <= 1), (i)) | 1095 | (f)->iconified = (eassert (0 <= (i) && (i) <= 1), (i)) |
| 1096 | 1096 | ||
| 1097 | extern Lisp_Object selected_frame; | 1097 | extern Lisp_Object selected_frame; |
| 1098 | extern Lisp_Object Qframep, Qframe_live_p; | ||
| 1099 | extern Lisp_Object Qtty, Qtty_type; | ||
| 1100 | extern Lisp_Object Qtty_color_mode; | ||
| 1101 | extern Lisp_Object Qterminal; | ||
| 1102 | extern Lisp_Object Qnoelisp; | ||
| 1103 | 1098 | ||
| 1104 | extern struct frame *decode_window_system_frame (Lisp_Object); | 1099 | extern struct frame *decode_window_system_frame (Lisp_Object); |
| 1105 | extern struct frame *decode_live_frame (Lisp_Object); | 1100 | extern struct frame *decode_live_frame (Lisp_Object); |
| @@ -1344,51 +1339,6 @@ extern Lisp_Object Vframe_list; | |||
| 1344 | Frame Parameters | 1339 | Frame Parameters |
| 1345 | ***********************************************************************/ | 1340 | ***********************************************************************/ |
| 1346 | 1341 | ||
| 1347 | extern Lisp_Object Qauto_raise, Qauto_lower; | ||
| 1348 | extern Lisp_Object Qborder_color, Qborder_width; | ||
| 1349 | extern Lisp_Object Qbuffer_predicate; | ||
| 1350 | extern Lisp_Object Qcursor_color, Qcursor_type; | ||
| 1351 | extern Lisp_Object Qfont; | ||
| 1352 | extern Lisp_Object Qicon, Qicon_name, Qicon_type, Qicon_left, Qicon_top; | ||
| 1353 | extern Lisp_Object Qinternal_border_width; | ||
| 1354 | extern Lisp_Object Qright_divider_width, Qbottom_divider_width; | ||
| 1355 | extern Lisp_Object Qtooltip; | ||
| 1356 | extern Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position; | ||
| 1357 | extern Lisp_Object Qmouse_color; | ||
| 1358 | extern Lisp_Object Qname, Qtitle; | ||
| 1359 | extern Lisp_Object Qparent_id; | ||
| 1360 | extern Lisp_Object Qunsplittable, Qvisibility; | ||
| 1361 | extern Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars; | ||
| 1362 | extern Lisp_Object Qscroll_bar_height, Qhorizontal_scroll_bars; | ||
| 1363 | extern Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background; | ||
| 1364 | extern Lisp_Object Qscreen_gamma; | ||
| 1365 | extern Lisp_Object Qline_spacing; | ||
| 1366 | extern Lisp_Object Qwait_for_wm; | ||
| 1367 | extern Lisp_Object Qfullscreen; | ||
| 1368 | extern Lisp_Object Qfullwidth, Qfullheight, Qfullboth, Qmaximized; | ||
| 1369 | extern Lisp_Object Qsticky; | ||
| 1370 | extern Lisp_Object Qfont_backend; | ||
| 1371 | extern Lisp_Object Qalpha; | ||
| 1372 | |||
| 1373 | extern Lisp_Object Qleft_fringe, Qright_fringe; | ||
| 1374 | extern Lisp_Object Qheight, Qwidth; | ||
| 1375 | extern Lisp_Object Qminibuffer, Qmodeline; | ||
| 1376 | extern Lisp_Object Qx, Qw32, Qpc, Qns; | ||
| 1377 | extern Lisp_Object Qvisible; | ||
| 1378 | extern Lisp_Object Qdisplay_type; | ||
| 1379 | |||
| 1380 | extern Lisp_Object Qx_resource_name; | ||
| 1381 | |||
| 1382 | extern Lisp_Object Qtop, Qbox, Qbottom; | ||
| 1383 | extern Lisp_Object Qdisplay; | ||
| 1384 | |||
| 1385 | extern Lisp_Object Qframe_position, Qframe_outer_size, Qframe_inner_size; | ||
| 1386 | extern Lisp_Object Qexternal_border_size, Qtitle_height; | ||
| 1387 | extern Lisp_Object Qmenu_bar_external, Qmenu_bar_size; | ||
| 1388 | extern Lisp_Object Qtool_bar_external, Qtool_bar_size; | ||
| 1389 | |||
| 1390 | extern Lisp_Object Qrun_hook_with_args; | ||
| 1391 | |||
| 1392 | #ifdef HAVE_WINDOW_SYSTEM | 1342 | #ifdef HAVE_WINDOW_SYSTEM |
| 1393 | 1343 | ||
| 1394 | /* The class of this X application. */ | 1344 | /* The class of this X application. */ |
| @@ -1399,7 +1349,6 @@ extern void x_set_scroll_bar_default_height (struct frame *); | |||
| 1399 | extern void x_set_offset (struct frame *, int, int, int); | 1349 | extern void x_set_offset (struct frame *, int, int, int); |
| 1400 | extern void x_wm_set_size_hint (struct frame *f, long flags, bool user_position); | 1350 | extern void x_wm_set_size_hint (struct frame *f, long flags, bool user_position); |
| 1401 | extern Lisp_Object x_new_font (struct frame *, Lisp_Object, int); | 1351 | extern Lisp_Object x_new_font (struct frame *, Lisp_Object, int); |
| 1402 | extern Lisp_Object Qface_set_after_frame_default; | ||
| 1403 | extern void x_set_frame_parameters (struct frame *, Lisp_Object); | 1352 | extern void x_set_frame_parameters (struct frame *, Lisp_Object); |
| 1404 | extern void x_set_fullscreen (struct frame *, Lisp_Object, Lisp_Object); | 1353 | extern void x_set_fullscreen (struct frame *, Lisp_Object, Lisp_Object); |
| 1405 | extern void x_set_line_spacing (struct frame *, Lisp_Object, Lisp_Object); | 1354 | extern void x_set_line_spacing (struct frame *, Lisp_Object, Lisp_Object); |
diff --git a/src/fringe.c b/src/fringe.c index 9d393f86f7e..c7262d19336 100644 --- a/src/fringe.c +++ b/src/fringe.c | |||
| @@ -65,10 +65,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 65 | must specify physical bitmap symbols. | 65 | must specify physical bitmap symbols. |
| 66 | */ | 66 | */ |
| 67 | 67 | ||
| 68 | static Lisp_Object Qtruncation, Qcontinuation, Qoverlay_arrow; | ||
| 69 | static Lisp_Object Qempty_line, Qtop_bottom; | ||
| 70 | static Lisp_Object Qhollow_small; | ||
| 71 | |||
| 72 | enum fringe_bitmap_align | 68 | enum fringe_bitmap_align |
| 73 | { | 69 | { |
| 74 | ALIGN_BITMAP_CENTER = 0, | 70 | ALIGN_BITMAP_CENTER = 0, |
diff --git a/src/ftfont.c b/src/ftfont.c index 81698066306..9707b6c1b71 100644 --- a/src/ftfont.c +++ b/src/ftfont.c | |||
| @@ -38,12 +38,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 38 | #include "font.h" | 38 | #include "font.h" |
| 39 | #include "ftfont.h" | 39 | #include "ftfont.h" |
| 40 | 40 | ||
| 41 | /* Symbolic type of this font-driver. */ | ||
| 42 | static Lisp_Object Qfreetype; | ||
| 43 | |||
| 44 | /* Fontconfig's generic families and their aliases. */ | ||
| 45 | static Lisp_Object Qmonospace, Qsans_serif, Qserif, Qmono, Qsans, Qsans__serif; | ||
| 46 | |||
| 47 | /* Flag to tell if FcInit is already called or not. */ | 41 | /* Flag to tell if FcInit is already called or not. */ |
| 48 | static bool fc_initialized; | 42 | static bool fc_initialized; |
| 49 | 43 | ||
| @@ -2667,7 +2661,10 @@ ftfont_filter_properties (Lisp_Object font, Lisp_Object alist) | |||
| 2667 | void | 2661 | void |
| 2668 | syms_of_ftfont (void) | 2662 | syms_of_ftfont (void) |
| 2669 | { | 2663 | { |
| 2664 | /* Symbolic type of this font-driver. */ | ||
| 2670 | DEFSYM (Qfreetype, "freetype"); | 2665 | DEFSYM (Qfreetype, "freetype"); |
| 2666 | |||
| 2667 | /* Fontconfig's generic families and their aliases. */ | ||
| 2671 | DEFSYM (Qmonospace, "monospace"); | 2668 | DEFSYM (Qmonospace, "monospace"); |
| 2672 | DEFSYM (Qsans_serif, "sans-serif"); | 2669 | DEFSYM (Qsans_serif, "sans-serif"); |
| 2673 | DEFSYM (Qserif, "serif"); | 2670 | DEFSYM (Qserif, "serif"); |
diff --git a/src/ftxfont.c b/src/ftxfont.c index 52d844597ee..cd2bf3e7415 100644 --- a/src/ftxfont.c +++ b/src/ftxfont.c | |||
| @@ -35,8 +35,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 35 | 35 | ||
| 36 | /* FTX font driver. */ | 36 | /* FTX font driver. */ |
| 37 | 37 | ||
| 38 | static Lisp_Object Qftx; | ||
| 39 | |||
| 40 | struct font_driver ftxfont_driver; | 38 | struct font_driver ftxfont_driver; |
| 41 | 39 | ||
| 42 | struct ftxfont_frame_data | 40 | struct ftxfont_frame_data |
diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 7434a373476..e03bec93541 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c | |||
| @@ -29,24 +29,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 29 | #include "process.h" | 29 | #include "process.h" |
| 30 | 30 | ||
| 31 | 31 | ||
| 32 | /* Subroutines. */ | ||
| 33 | static Lisp_Object Qgfile_add_watch; | ||
| 34 | static Lisp_Object Qgfile_rm_watch; | ||
| 35 | |||
| 36 | /* Filter objects. */ | ||
| 37 | static Lisp_Object Qwatch_mounts; /* G_FILE_MONITOR_WATCH_MOUNTS */ | ||
| 38 | static Lisp_Object Qsend_moved; /* G_FILE_MONITOR_SEND_MOVED */ | ||
| 39 | |||
| 40 | /* Event types. */ | ||
| 41 | static Lisp_Object Qchanged; /* G_FILE_MONITOR_EVENT_CHANGED */ | ||
| 42 | static Lisp_Object Qchanges_done_hint; /* G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT */ | ||
| 43 | static Lisp_Object Qdeleted; /* G_FILE_MONITOR_EVENT_DELETED */ | ||
| 44 | static Lisp_Object Qcreated; /* G_FILE_MONITOR_EVENT_CREATED */ | ||
| 45 | static Lisp_Object Qattribute_changed; /* G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED */ | ||
| 46 | static Lisp_Object Qpre_unmount; /* G_FILE_MONITOR_EVENT_PRE_UNMOUNT */ | ||
| 47 | static Lisp_Object Qunmounted; /* G_FILE_MONITOR_EVENT_UNMOUNTED */ | ||
| 48 | static Lisp_Object Qmoved; /* G_FILE_MONITOR_EVENT_MOVED */ | ||
| 49 | |||
| 50 | static Lisp_Object watch_list; | 32 | static Lisp_Object watch_list; |
| 51 | 33 | ||
| 52 | /* This is the callback function for arriving signals from | 34 | /* This is the callback function for arriving signals from |
| @@ -95,7 +77,7 @@ dir_monitor_callback (GFileMonitor *monitor, | |||
| 95 | } | 77 | } |
| 96 | 78 | ||
| 97 | /* Determine callback function. */ | 79 | /* Determine callback function. */ |
| 98 | monitor_object = XIL ((intptr_t) monitor); | 80 | monitor_object = make_pointer_integer (monitor); |
| 99 | eassert (INTEGERP (monitor_object)); | 81 | eassert (INTEGERP (monitor_object)); |
| 100 | watch_object = assq_no_quit (monitor_object, watch_list); | 82 | watch_object = assq_no_quit (monitor_object, watch_list); |
| 101 | 83 | ||
| @@ -164,7 +146,7 @@ FILE is the name of the file whose event is being reported. FILE1 | |||
| 164 | will be reported only in case of the 'moved' event. */) | 146 | will be reported only in case of the 'moved' event. */) |
| 165 | (Lisp_Object file, Lisp_Object flags, Lisp_Object callback) | 147 | (Lisp_Object file, Lisp_Object flags, Lisp_Object callback) |
| 166 | { | 148 | { |
| 167 | Lisp_Object watch_descriptor, watch_object; | 149 | Lisp_Object watch_object; |
| 168 | GFile *gfile; | 150 | GFile *gfile; |
| 169 | GFileMonitor *monitor; | 151 | GFileMonitor *monitor; |
| 170 | GFileMonitorFlags gflags = G_FILE_MONITOR_NONE; | 152 | GFileMonitorFlags gflags = G_FILE_MONITOR_NONE; |
| @@ -194,10 +176,9 @@ will be reported only in case of the 'moved' event. */) | |||
| 194 | if (! monitor) | 176 | if (! monitor) |
| 195 | xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file); | 177 | xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file); |
| 196 | 178 | ||
| 197 | /* On all known glib platforms, converting MONITOR directly to a | 179 | Lisp_Object watch_descriptor = make_pointer_integer (monitor); |
| 198 | Lisp_Object value results is a Lisp integer, which is safe. This | 180 | |
| 199 | assumption is dicey, though, so check it now. */ | 181 | /* Check the dicey assumption that make_pointer_integer is safe. */ |
| 200 | watch_descriptor = XIL ((intptr_t) monitor); | ||
| 201 | if (! INTEGERP (watch_descriptor)) | 182 | if (! INTEGERP (watch_descriptor)) |
| 202 | { | 183 | { |
| 203 | g_object_unref (monitor); | 184 | g_object_unref (monitor); |
| @@ -221,8 +202,6 @@ DEFUN ("gfile-rm-watch", Fgfile_rm_watch, Sgfile_rm_watch, 1, 1, 0, | |||
| 221 | WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */) | 202 | WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */) |
| 222 | (Lisp_Object watch_descriptor) | 203 | (Lisp_Object watch_descriptor) |
| 223 | { | 204 | { |
| 224 | intptr_t int_monitor; | ||
| 225 | GFileMonitor *monitor; | ||
| 226 | Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list); | 205 | Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list); |
| 227 | 206 | ||
| 228 | if (! CONSP (watch_object)) | 207 | if (! CONSP (watch_object)) |
| @@ -230,8 +209,7 @@ WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */) | |||
| 230 | watch_descriptor); | 209 | watch_descriptor); |
| 231 | 210 | ||
| 232 | eassert (INTEGERP (watch_descriptor)); | 211 | eassert (INTEGERP (watch_descriptor)); |
| 233 | int_monitor = XLI (watch_descriptor); | 212 | GFileMonitor *monitor = XINTPTR (watch_descriptor); |
| 234 | monitor = (GFileMonitor *) int_monitor; | ||
| 235 | if (!g_file_monitor_cancel (monitor)) | 213 | if (!g_file_monitor_cancel (monitor)) |
| 236 | xsignal2 (Qfile_notify_error, build_string ("Could not rm watch"), | 214 | xsignal2 (Qfile_notify_error, build_string ("Could not rm watch"), |
| 237 | watch_descriptor); | 215 | watch_descriptor); |
| @@ -258,23 +236,27 @@ globals_of_gfilenotify (void) | |||
| 258 | void | 236 | void |
| 259 | syms_of_gfilenotify (void) | 237 | syms_of_gfilenotify (void) |
| 260 | { | 238 | { |
| 261 | |||
| 262 | DEFSYM (Qgfile_add_watch, "gfile-add-watch"); | 239 | DEFSYM (Qgfile_add_watch, "gfile-add-watch"); |
| 263 | defsubr (&Sgfile_add_watch); | 240 | defsubr (&Sgfile_add_watch); |
| 264 | 241 | ||
| 265 | DEFSYM (Qgfile_rm_watch, "gfile-rm-watch"); | 242 | DEFSYM (Qgfile_rm_watch, "gfile-rm-watch"); |
| 266 | defsubr (&Sgfile_rm_watch); | 243 | defsubr (&Sgfile_rm_watch); |
| 267 | 244 | ||
| 268 | DEFSYM (Qwatch_mounts, "watch-mounts"); | 245 | /* Filter objects. */ |
| 269 | DEFSYM (Qsend_moved, "send-moved"); | 246 | DEFSYM (Qwatch_mounts, "watch-mounts"); /* G_FILE_MONITOR_WATCH_MOUNTS */ |
| 270 | DEFSYM (Qchanged, "changed"); | 247 | DEFSYM (Qsend_moved, "send-moved"); /* G_FILE_MONITOR_SEND_MOVED */ |
| 248 | |||
| 249 | /* Event types. */ | ||
| 250 | DEFSYM (Qchanged, "changed"); /* G_FILE_MONITOR_EVENT_CHANGED */ | ||
| 271 | DEFSYM (Qchanges_done_hint, "changes-done-hint"); | 251 | DEFSYM (Qchanges_done_hint, "changes-done-hint"); |
| 272 | DEFSYM (Qdeleted, "deleted"); | 252 | /* G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT */ |
| 273 | DEFSYM (Qcreated, "created"); | 253 | DEFSYM (Qdeleted, "deleted"); /* G_FILE_MONITOR_EVENT_DELETED */ |
| 254 | DEFSYM (Qcreated, "created"); /* G_FILE_MONITOR_EVENT_CREATED */ | ||
| 274 | DEFSYM (Qattribute_changed, "attribute-changed"); | 255 | DEFSYM (Qattribute_changed, "attribute-changed"); |
| 275 | DEFSYM (Qpre_unmount, "pre-unmount"); | 256 | /* G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED */ |
| 276 | DEFSYM (Qunmounted, "unmounted"); | 257 | DEFSYM (Qpre_unmount, "pre-unmount"); /* G_FILE_MONITOR_EVENT_PRE_UNMOUNT */ |
| 277 | DEFSYM (Qmoved, "moved"); | 258 | DEFSYM (Qunmounted, "unmounted"); /* G_FILE_MONITOR_EVENT_UNMOUNTED */ |
| 259 | DEFSYM (Qmoved, "moved"); /* G_FILE_MONITOR_EVENT_MOVED */ | ||
| 278 | 260 | ||
| 279 | staticpro (&watch_list); | 261 | staticpro (&watch_list); |
| 280 | 262 | ||
diff --git a/src/gnutls.c b/src/gnutls.c index 4d248f86878..75fe6149a55 100644 --- a/src/gnutls.c +++ b/src/gnutls.c | |||
| @@ -35,28 +35,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 35 | 35 | ||
| 36 | static bool emacs_gnutls_handle_error (gnutls_session_t, int); | 36 | static bool emacs_gnutls_handle_error (gnutls_session_t, int); |
| 37 | 37 | ||
| 38 | static Lisp_Object Qgnutls_dll; | ||
| 39 | static Lisp_Object Qgnutls_code; | ||
| 40 | static Lisp_Object Qgnutls_anon, Qgnutls_x509pki; | ||
| 41 | static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again, | ||
| 42 | Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake; | ||
| 43 | static bool gnutls_global_initialized; | 38 | static bool gnutls_global_initialized; |
| 44 | 39 | ||
| 45 | /* The following are for the property list of `gnutls-boot'. */ | ||
| 46 | static Lisp_Object QCgnutls_bootprop_priority; | ||
| 47 | static Lisp_Object QCgnutls_bootprop_trustfiles; | ||
| 48 | static Lisp_Object QCgnutls_bootprop_keylist; | ||
| 49 | static Lisp_Object QCgnutls_bootprop_crlfiles; | ||
| 50 | static Lisp_Object QCgnutls_bootprop_callbacks; | ||
| 51 | static Lisp_Object QCgnutls_bootprop_loglevel; | ||
| 52 | static Lisp_Object QCgnutls_bootprop_hostname; | ||
| 53 | static Lisp_Object QCgnutls_bootprop_min_prime_bits; | ||
| 54 | static Lisp_Object QCgnutls_bootprop_verify_flags; | ||
| 55 | static Lisp_Object QCgnutls_bootprop_verify_error; | ||
| 56 | |||
| 57 | /* Callback keys for `gnutls-boot'. Unused currently. */ | ||
| 58 | static Lisp_Object QCgnutls_bootprop_callbacks_verify; | ||
| 59 | |||
| 60 | static void gnutls_log_function (int, const char *); | 40 | static void gnutls_log_function (int, const char *); |
| 61 | static void gnutls_log_function2 (int, const char *, const char *); | 41 | static void gnutls_log_function2 (int, const char *, const char *); |
| 62 | #ifdef HAVE_GNUTLS3 | 42 | #ifdef HAVE_GNUTLS3 |
| @@ -1656,13 +1636,14 @@ syms_of_gnutls (void) | |||
| 1656 | DEFSYM (Qgnutls_code, "gnutls-code"); | 1636 | DEFSYM (Qgnutls_code, "gnutls-code"); |
| 1657 | DEFSYM (Qgnutls_anon, "gnutls-anon"); | 1637 | DEFSYM (Qgnutls_anon, "gnutls-anon"); |
| 1658 | DEFSYM (Qgnutls_x509pki, "gnutls-x509pki"); | 1638 | DEFSYM (Qgnutls_x509pki, "gnutls-x509pki"); |
| 1639 | |||
| 1640 | /* The following are for the property list of 'gnutls-boot'. */ | ||
| 1659 | DEFSYM (QCgnutls_bootprop_hostname, ":hostname"); | 1641 | DEFSYM (QCgnutls_bootprop_hostname, ":hostname"); |
| 1660 | DEFSYM (QCgnutls_bootprop_priority, ":priority"); | 1642 | DEFSYM (QCgnutls_bootprop_priority, ":priority"); |
| 1661 | DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles"); | 1643 | DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles"); |
| 1662 | DEFSYM (QCgnutls_bootprop_keylist, ":keylist"); | 1644 | DEFSYM (QCgnutls_bootprop_keylist, ":keylist"); |
| 1663 | DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles"); | 1645 | DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles"); |
| 1664 | DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks"); | 1646 | DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks"); |
| 1665 | DEFSYM (QCgnutls_bootprop_callbacks_verify, "verify"); | ||
| 1666 | DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits"); | 1647 | DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits"); |
| 1667 | DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel"); | 1648 | DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel"); |
| 1668 | DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags"); | 1649 | DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags"); |
diff --git a/src/image.c b/src/image.c index 6240c64b201..5d08a890234 100644 --- a/src/image.c +++ b/src/image.c | |||
| @@ -86,12 +86,6 @@ typedef struct w32_bitmap_record Bitmap_Record; | |||
| 86 | #define x_defined_color w32_defined_color | 86 | #define x_defined_color w32_defined_color |
| 87 | #define DefaultDepthOfScreen(screen) (one_w32_display_info.n_cbits) | 87 | #define DefaultDepthOfScreen(screen) (one_w32_display_info.n_cbits) |
| 88 | 88 | ||
| 89 | /* Versions of libpng, libgif, and libjpeg that we were compiled with, | ||
| 90 | or -1 if no PNG/GIF support was compiled in. This is tested by | ||
| 91 | w32-win.el to correctly set up the alist used to search for the | ||
| 92 | respective image libraries. */ | ||
| 93 | Lisp_Object Qlibpng_version, Qlibgif_version, Qlibjpeg_version; | ||
| 94 | |||
| 95 | #endif /* HAVE_NTGUI */ | 89 | #endif /* HAVE_NTGUI */ |
| 96 | 90 | ||
| 97 | #ifdef HAVE_NS | 91 | #ifdef HAVE_NS |
| @@ -110,11 +104,6 @@ typedef struct ns_bitmap_record Bitmap_Record; | |||
| 110 | #define DefaultDepthOfScreen(screen) x_display_list->n_planes | 104 | #define DefaultDepthOfScreen(screen) x_display_list->n_planes |
| 111 | #endif /* HAVE_NS */ | 105 | #endif /* HAVE_NS */ |
| 112 | 106 | ||
| 113 | |||
| 114 | /* The symbol `postscript' identifying images of this type. */ | ||
| 115 | |||
| 116 | static Lisp_Object Qpostscript; | ||
| 117 | |||
| 118 | static void x_disable_image (struct frame *, struct image *); | 107 | static void x_disable_image (struct frame *, struct image *); |
| 119 | static void x_edge_detection (struct frame *, struct image *, Lisp_Object, | 108 | static void x_edge_detection (struct frame *, struct image *, Lisp_Object, |
| 120 | Lisp_Object); | 109 | Lisp_Object); |
| @@ -126,8 +115,6 @@ static void free_color_table (void); | |||
| 126 | static unsigned long *colors_in_color_table (int *n); | 115 | static unsigned long *colors_in_color_table (int *n); |
| 127 | #endif | 116 | #endif |
| 128 | 117 | ||
| 129 | static Lisp_Object QCmax_width, QCmax_height; | ||
| 130 | |||
| 131 | /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap | 118 | /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap |
| 132 | id, which is just an int that this section returns. Bitmaps are | 119 | id, which is just an int that this section returns. Bitmaps are |
| 133 | reference counted so they can be shared among frames. | 120 | reference counted so they can be shared among frames. |
| @@ -537,24 +524,6 @@ x_create_bitmap_mask (struct frame *f, ptrdiff_t id) | |||
| 537 | 524 | ||
| 538 | static struct image_type *image_types; | 525 | static struct image_type *image_types; |
| 539 | 526 | ||
| 540 | /* The symbol `xbm' which is used as the type symbol for XBM images. */ | ||
| 541 | |||
| 542 | static Lisp_Object Qxbm; | ||
| 543 | |||
| 544 | /* Keywords. */ | ||
| 545 | |||
| 546 | Lisp_Object QCascent, QCmargin, QCrelief; | ||
| 547 | Lisp_Object QCconversion; | ||
| 548 | static Lisp_Object QCheuristic_mask; | ||
| 549 | static Lisp_Object QCcolor_symbols; | ||
| 550 | static Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask, QCgeometry; | ||
| 551 | static Lisp_Object QCcrop, QCrotation; | ||
| 552 | |||
| 553 | /* Other symbols. */ | ||
| 554 | |||
| 555 | static Lisp_Object Qcount, Qextension_data, Qdelay; | ||
| 556 | static Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic; | ||
| 557 | |||
| 558 | /* Forward function prototypes. */ | 527 | /* Forward function prototypes. */ |
| 559 | 528 | ||
| 560 | static struct image_type *lookup_image_type (Lisp_Object); | 529 | static struct image_type *lookup_image_type (Lisp_Object); |
| @@ -579,27 +548,29 @@ static struct image_type * | |||
| 579 | define_image_type (struct image_type *type) | 548 | define_image_type (struct image_type *type) |
| 580 | { | 549 | { |
| 581 | struct image_type *p = NULL; | 550 | struct image_type *p = NULL; |
| 582 | Lisp_Object target_type = *type->type; | 551 | int new_type = type->type; |
| 583 | bool type_valid = 1; | 552 | bool type_valid = true; |
| 584 | 553 | ||
| 585 | block_input (); | 554 | block_input (); |
| 586 | 555 | ||
| 587 | for (p = image_types; p; p = p->next) | 556 | for (p = image_types; p; p = p->next) |
| 588 | if (EQ (*p->type, target_type)) | 557 | if (p->type == new_type) |
| 589 | goto done; | 558 | goto done; |
| 590 | 559 | ||
| 591 | if (type->init) | 560 | if (type->init) |
| 592 | { | 561 | { |
| 593 | #if defined HAVE_NTGUI && defined WINDOWSNT | 562 | #if defined HAVE_NTGUI && defined WINDOWSNT |
| 594 | /* If we failed to load the library before, don't try again. */ | 563 | /* If we failed to load the library before, don't try again. */ |
| 595 | Lisp_Object tested = Fassq (target_type, Vlibrary_cache); | 564 | Lisp_Object tested = Fassq (builtin_lisp_symbol (new_type), |
| 565 | Vlibrary_cache); | ||
| 596 | if (CONSP (tested) && NILP (XCDR (tested))) | 566 | if (CONSP (tested) && NILP (XCDR (tested))) |
| 597 | type_valid = 0; | 567 | type_valid = false; |
| 598 | else | 568 | else |
| 599 | #endif | 569 | #endif |
| 600 | { | 570 | { |
| 601 | type_valid = type->init (); | 571 | type_valid = type->init (); |
| 602 | CACHE_IMAGE_TYPE (target_type, type_valid ? Qt : Qnil); | 572 | CACHE_IMAGE_TYPE (builtin_lisp_symbol (new_type), |
| 573 | type_valid ? Qt : Qnil); | ||
| 603 | } | 574 | } |
| 604 | } | 575 | } |
| 605 | 576 | ||
| @@ -1777,7 +1748,7 @@ lookup_image (struct frame *f, Lisp_Object spec) | |||
| 1777 | 1748 | ||
| 1778 | /* Do image transformations and compute masks, unless we | 1749 | /* Do image transformations and compute masks, unless we |
| 1779 | don't have the image yet. */ | 1750 | don't have the image yet. */ |
| 1780 | if (!EQ (*img->type->type, Qpostscript)) | 1751 | if (!EQ (builtin_lisp_symbol (img->type->type), Qpostscript)) |
| 1781 | postprocess_image (f, img); | 1752 | postprocess_image (f, img); |
| 1782 | } | 1753 | } |
| 1783 | 1754 | ||
| @@ -2362,7 +2333,7 @@ static const struct image_keyword xbm_format[XBM_LAST] = | |||
| 2362 | 2333 | ||
| 2363 | static struct image_type xbm_type = | 2334 | static struct image_type xbm_type = |
| 2364 | { | 2335 | { |
| 2365 | &Qxbm, | 2336 | SYMBOL_INDEX (Qxbm), |
| 2366 | xbm_image_p, | 2337 | xbm_image_p, |
| 2367 | xbm_load, | 2338 | xbm_load, |
| 2368 | x_clear_image, | 2339 | x_clear_image, |
| @@ -3121,9 +3092,6 @@ static bool xpm_load (struct frame *f, struct image *img); | |||
| 3121 | #endif /* HAVE_XPM */ | 3092 | #endif /* HAVE_XPM */ |
| 3122 | 3093 | ||
| 3123 | #if defined (HAVE_XPM) || defined (HAVE_NS) | 3094 | #if defined (HAVE_XPM) || defined (HAVE_NS) |
| 3124 | /* The symbol `xpm' identifying XPM-format images. */ | ||
| 3125 | |||
| 3126 | static Lisp_Object Qxpm; | ||
| 3127 | 3095 | ||
| 3128 | /* Indices of image specification fields in xpm_format, below. */ | 3096 | /* Indices of image specification fields in xpm_format, below. */ |
| 3129 | 3097 | ||
| @@ -3171,7 +3139,7 @@ static bool init_xpm_functions (void); | |||
| 3171 | 3139 | ||
| 3172 | static struct image_type xpm_type = | 3140 | static struct image_type xpm_type = |
| 3173 | { | 3141 | { |
| 3174 | &Qxpm, | 3142 | SYMBOL_INDEX (Qxpm), |
| 3175 | xpm_image_p, | 3143 | xpm_image_p, |
| 3176 | xpm_load, | 3144 | xpm_load, |
| 3177 | x_clear_image, | 3145 | x_clear_image, |
| @@ -5059,10 +5027,6 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how) | |||
| 5059 | static bool pbm_image_p (Lisp_Object object); | 5027 | static bool pbm_image_p (Lisp_Object object); |
| 5060 | static bool pbm_load (struct frame *f, struct image *img); | 5028 | static bool pbm_load (struct frame *f, struct image *img); |
| 5061 | 5029 | ||
| 5062 | /* The symbol `pbm' identifying images of this type. */ | ||
| 5063 | |||
| 5064 | static Lisp_Object Qpbm; | ||
| 5065 | |||
| 5066 | /* Indices of image specification fields in gs_format, below. */ | 5030 | /* Indices of image specification fields in gs_format, below. */ |
| 5067 | 5031 | ||
| 5068 | enum pbm_keyword_index | 5032 | enum pbm_keyword_index |
| @@ -5103,7 +5067,7 @@ static const struct image_keyword pbm_format[PBM_LAST] = | |||
| 5103 | 5067 | ||
| 5104 | static struct image_type pbm_type = | 5068 | static struct image_type pbm_type = |
| 5105 | { | 5069 | { |
| 5106 | &Qpbm, | 5070 | SYMBOL_INDEX (Qpbm), |
| 5107 | pbm_image_p, | 5071 | pbm_image_p, |
| 5108 | pbm_load, | 5072 | pbm_load, |
| 5109 | x_clear_image, | 5073 | x_clear_image, |
| @@ -5446,10 +5410,6 @@ pbm_load (struct frame *f, struct image *img) | |||
| 5446 | static bool png_image_p (Lisp_Object object); | 5410 | static bool png_image_p (Lisp_Object object); |
| 5447 | static bool png_load (struct frame *f, struct image *img); | 5411 | static bool png_load (struct frame *f, struct image *img); |
| 5448 | 5412 | ||
| 5449 | /* The symbol `png' identifying images of this type. */ | ||
| 5450 | |||
| 5451 | static Lisp_Object Qpng; | ||
| 5452 | |||
| 5453 | /* Indices of image specification fields in png_format, below. */ | 5413 | /* Indices of image specification fields in png_format, below. */ |
| 5454 | 5414 | ||
| 5455 | enum png_keyword_index | 5415 | enum png_keyword_index |
| @@ -5494,7 +5454,7 @@ static bool init_png_functions (void); | |||
| 5494 | 5454 | ||
| 5495 | static struct image_type png_type = | 5455 | static struct image_type png_type = |
| 5496 | { | 5456 | { |
| 5497 | &Qpng, | 5457 | SYMBOL_INDEX (Qpng), |
| 5498 | png_image_p, | 5458 | png_image_p, |
| 5499 | png_load, | 5459 | png_load, |
| 5500 | x_clear_image, | 5460 | x_clear_image, |
| @@ -6102,10 +6062,6 @@ png_load (struct frame *f, struct image *img) | |||
| 6102 | static bool jpeg_image_p (Lisp_Object object); | 6062 | static bool jpeg_image_p (Lisp_Object object); |
| 6103 | static bool jpeg_load (struct frame *f, struct image *img); | 6063 | static bool jpeg_load (struct frame *f, struct image *img); |
| 6104 | 6064 | ||
| 6105 | /* The symbol `jpeg' identifying images of this type. */ | ||
| 6106 | |||
| 6107 | static Lisp_Object Qjpeg; | ||
| 6108 | |||
| 6109 | /* Indices of image specification fields in gs_format, below. */ | 6065 | /* Indices of image specification fields in gs_format, below. */ |
| 6110 | 6066 | ||
| 6111 | enum jpeg_keyword_index | 6067 | enum jpeg_keyword_index |
| @@ -6150,7 +6106,7 @@ static bool init_jpeg_functions (void); | |||
| 6150 | 6106 | ||
| 6151 | static struct image_type jpeg_type = | 6107 | static struct image_type jpeg_type = |
| 6152 | { | 6108 | { |
| 6153 | &Qjpeg, | 6109 | SYMBOL_INDEX (Qjpeg), |
| 6154 | jpeg_image_p, | 6110 | jpeg_image_p, |
| 6155 | jpeg_load, | 6111 | jpeg_load, |
| 6156 | x_clear_image, | 6112 | x_clear_image, |
| @@ -6704,10 +6660,6 @@ jpeg_load (struct frame *f, struct image *img) | |||
| 6704 | static bool tiff_image_p (Lisp_Object object); | 6660 | static bool tiff_image_p (Lisp_Object object); |
| 6705 | static bool tiff_load (struct frame *f, struct image *img); | 6661 | static bool tiff_load (struct frame *f, struct image *img); |
| 6706 | 6662 | ||
| 6707 | /* The symbol `tiff' identifying images of this type. */ | ||
| 6708 | |||
| 6709 | static Lisp_Object Qtiff; | ||
| 6710 | |||
| 6711 | /* Indices of image specification fields in tiff_format, below. */ | 6663 | /* Indices of image specification fields in tiff_format, below. */ |
| 6712 | 6664 | ||
| 6713 | enum tiff_keyword_index | 6665 | enum tiff_keyword_index |
| @@ -6754,7 +6706,7 @@ static bool init_tiff_functions (void); | |||
| 6754 | 6706 | ||
| 6755 | static struct image_type tiff_type = | 6707 | static struct image_type tiff_type = |
| 6756 | { | 6708 | { |
| 6757 | &Qtiff, | 6709 | SYMBOL_INDEX (Qtiff), |
| 6758 | tiff_image_p, | 6710 | tiff_image_p, |
| 6759 | tiff_load, | 6711 | tiff_load, |
| 6760 | x_clear_image, | 6712 | x_clear_image, |
| @@ -7167,10 +7119,6 @@ static bool gif_image_p (Lisp_Object object); | |||
| 7167 | static bool gif_load (struct frame *f, struct image *img); | 7119 | static bool gif_load (struct frame *f, struct image *img); |
| 7168 | static void gif_clear_image (struct frame *f, struct image *img); | 7120 | static void gif_clear_image (struct frame *f, struct image *img); |
| 7169 | 7121 | ||
| 7170 | /* The symbol `gif' identifying images of this type. */ | ||
| 7171 | |||
| 7172 | static Lisp_Object Qgif; | ||
| 7173 | |||
| 7174 | /* Indices of image specification fields in gif_format, below. */ | 7122 | /* Indices of image specification fields in gif_format, below. */ |
| 7175 | 7123 | ||
| 7176 | enum gif_keyword_index | 7124 | enum gif_keyword_index |
| @@ -7217,7 +7165,7 @@ static bool init_gif_functions (void); | |||
| 7217 | 7165 | ||
| 7218 | static struct image_type gif_type = | 7166 | static struct image_type gif_type = |
| 7219 | { | 7167 | { |
| 7220 | &Qgif, | 7168 | SYMBOL_INDEX (Qgif), |
| 7221 | gif_image_p, | 7169 | gif_image_p, |
| 7222 | gif_load, | 7170 | gif_load, |
| 7223 | gif_clear_image, | 7171 | gif_clear_image, |
| @@ -7841,8 +7789,6 @@ compute_image_size (size_t width, size_t height, | |||
| 7841 | *d_height = desired_height; | 7789 | *d_height = desired_height; |
| 7842 | } | 7790 | } |
| 7843 | 7791 | ||
| 7844 | static Lisp_Object Qimagemagick; | ||
| 7845 | |||
| 7846 | static bool imagemagick_image_p (Lisp_Object); | 7792 | static bool imagemagick_image_p (Lisp_Object); |
| 7847 | static bool imagemagick_load (struct frame *, struct image *); | 7793 | static bool imagemagick_load (struct frame *, struct image *); |
| 7848 | static void imagemagick_clear_image (struct frame *, struct image *); | 7794 | static void imagemagick_clear_image (struct frame *, struct image *); |
| @@ -7906,7 +7852,7 @@ static bool init_imagemagick_functions (void); | |||
| 7906 | 7852 | ||
| 7907 | static struct image_type imagemagick_type = | 7853 | static struct image_type imagemagick_type = |
| 7908 | { | 7854 | { |
| 7909 | &Qimagemagick, | 7855 | SYMBOL_INDEX (Qimagemagick), |
| 7910 | imagemagick_image_p, | 7856 | imagemagick_image_p, |
| 7911 | imagemagick_load, | 7857 | imagemagick_load, |
| 7912 | imagemagick_clear_image, | 7858 | imagemagick_clear_image, |
| @@ -8632,10 +8578,6 @@ static bool svg_load (struct frame *f, struct image *img); | |||
| 8632 | static bool svg_load_image (struct frame *, struct image *, | 8578 | static bool svg_load_image (struct frame *, struct image *, |
| 8633 | unsigned char *, ptrdiff_t, char *); | 8579 | unsigned char *, ptrdiff_t, char *); |
| 8634 | 8580 | ||
| 8635 | /* The symbol `svg' identifying images of this type. */ | ||
| 8636 | |||
| 8637 | static Lisp_Object Qsvg; | ||
| 8638 | |||
| 8639 | /* Indices of image specification fields in svg_format, below. */ | 8581 | /* Indices of image specification fields in svg_format, below. */ |
| 8640 | 8582 | ||
| 8641 | enum svg_keyword_index | 8583 | enum svg_keyword_index |
| @@ -8682,7 +8624,7 @@ static bool init_svg_functions (void); | |||
| 8682 | 8624 | ||
| 8683 | static struct image_type svg_type = | 8625 | static struct image_type svg_type = |
| 8684 | { | 8626 | { |
| 8685 | &Qsvg, | 8627 | SYMBOL_INDEX (Qsvg), |
| 8686 | svg_image_p, | 8628 | svg_image_p, |
| 8687 | svg_load, | 8629 | svg_load, |
| 8688 | x_clear_image, | 8630 | x_clear_image, |
| @@ -8737,8 +8679,6 @@ DEF_DLL_FN (void, g_type_init, (void)); | |||
| 8737 | DEF_DLL_FN (void, g_object_unref, (gpointer)); | 8679 | DEF_DLL_FN (void, g_object_unref, (gpointer)); |
| 8738 | DEF_DLL_FN (void, g_error_free, (GError *)); | 8680 | DEF_DLL_FN (void, g_error_free, (GError *)); |
| 8739 | 8681 | ||
| 8740 | Lisp_Object Qgdk_pixbuf, Qglib, Qgobject; | ||
| 8741 | |||
| 8742 | static bool | 8682 | static bool |
| 8743 | init_svg_functions (void) | 8683 | init_svg_functions (void) |
| 8744 | { | 8684 | { |
| @@ -9056,10 +8996,6 @@ static bool gs_image_p (Lisp_Object object); | |||
| 9056 | static bool gs_load (struct frame *f, struct image *img); | 8996 | static bool gs_load (struct frame *f, struct image *img); |
| 9057 | static void gs_clear_image (struct frame *f, struct image *img); | 8997 | static void gs_clear_image (struct frame *f, struct image *img); |
| 9058 | 8998 | ||
| 9059 | /* Keyword symbols. */ | ||
| 9060 | |||
| 9061 | static Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height; | ||
| 9062 | |||
| 9063 | /* Indices of image specification fields in gs_format, below. */ | 8999 | /* Indices of image specification fields in gs_format, below. */ |
| 9064 | 9000 | ||
| 9065 | enum gs_keyword_index | 9001 | enum gs_keyword_index |
| @@ -9104,7 +9040,7 @@ static const struct image_keyword gs_format[GS_LAST] = | |||
| 9104 | 9040 | ||
| 9105 | static struct image_type gs_type = | 9041 | static struct image_type gs_type = |
| 9106 | { | 9042 | { |
| 9107 | &Qpostscript, | 9043 | SYMBOL_INDEX (Qpostscript), |
| 9108 | gs_image_p, | 9044 | gs_image_p, |
| 9109 | gs_load, | 9045 | gs_load, |
| 9110 | gs_clear_image, | 9046 | gs_clear_image, |
| @@ -9479,10 +9415,12 @@ as a ratio to the frame height and width. If the value is | |||
| 9479 | non-numeric, there is no explicit limit on the size of images. */); | 9415 | non-numeric, there is no explicit limit on the size of images. */); |
| 9480 | Vmax_image_size = make_float (MAX_IMAGE_SIZE); | 9416 | Vmax_image_size = make_float (MAX_IMAGE_SIZE); |
| 9481 | 9417 | ||
| 9418 | /* Other symbols. */ | ||
| 9482 | DEFSYM (Qcount, "count"); | 9419 | DEFSYM (Qcount, "count"); |
| 9483 | DEFSYM (Qextension_data, "extension-data"); | 9420 | DEFSYM (Qextension_data, "extension-data"); |
| 9484 | DEFSYM (Qdelay, "delay"); | 9421 | DEFSYM (Qdelay, "delay"); |
| 9485 | 9422 | ||
| 9423 | /* Keywords. */ | ||
| 9486 | DEFSYM (QCascent, ":ascent"); | 9424 | DEFSYM (QCascent, ":ascent"); |
| 9487 | DEFSYM (QCmargin, ":margin"); | 9425 | DEFSYM (QCmargin, ":margin"); |
| 9488 | DEFSYM (QCrelief, ":relief"); | 9426 | DEFSYM (QCrelief, ":relief"); |
| @@ -9497,6 +9435,7 @@ non-numeric, there is no explicit limit on the size of images. */); | |||
| 9497 | DEFSYM (QCcolor_adjustment, ":color-adjustment"); | 9435 | DEFSYM (QCcolor_adjustment, ":color-adjustment"); |
| 9498 | DEFSYM (QCmask, ":mask"); | 9436 | DEFSYM (QCmask, ":mask"); |
| 9499 | 9437 | ||
| 9438 | /* Other symbols. */ | ||
| 9500 | DEFSYM (Qlaplace, "laplace"); | 9439 | DEFSYM (Qlaplace, "laplace"); |
| 9501 | DEFSYM (Qemboss, "emboss"); | 9440 | DEFSYM (Qemboss, "emboss"); |
| 9502 | DEFSYM (Qedge_detection, "edge-detection"); | 9441 | DEFSYM (Qedge_detection, "edge-detection"); |
| @@ -9514,6 +9453,10 @@ non-numeric, there is no explicit limit on the size of images. */); | |||
| 9514 | #endif /* HAVE_GHOSTSCRIPT */ | 9453 | #endif /* HAVE_GHOSTSCRIPT */ |
| 9515 | 9454 | ||
| 9516 | #ifdef HAVE_NTGUI | 9455 | #ifdef HAVE_NTGUI |
| 9456 | /* Versions of libpng, libgif, and libjpeg that we were compiled with, | ||
| 9457 | or -1 if no PNG/GIF support was compiled in. This is tested by | ||
| 9458 | w32-win.el to correctly set up the alist used to search for the | ||
| 9459 | respective image libraries. */ | ||
| 9517 | DEFSYM (Qlibpng_version, "libpng-version"); | 9460 | DEFSYM (Qlibpng_version, "libpng-version"); |
| 9518 | Fset (Qlibpng_version, | 9461 | Fset (Qlibpng_version, |
| 9519 | #if HAVE_PNG | 9462 | #if HAVE_PNG |
diff --git a/src/inotify.c b/src/inotify.c index 8e8ab202c41..eddad73e8f7 100644 --- a/src/inotify.c +++ b/src/inotify.c | |||
| @@ -29,34 +29,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 29 | #include "frame.h" /* Required for termhooks.h. */ | 29 | #include "frame.h" /* Required for termhooks.h. */ |
| 30 | #include "termhooks.h" | 30 | #include "termhooks.h" |
| 31 | 31 | ||
| 32 | static Lisp_Object Qaccess; /* IN_ACCESS */ | ||
| 33 | static Lisp_Object Qattrib; /* IN_ATTRIB */ | ||
| 34 | static Lisp_Object Qclose_write; /* IN_CLOSE_WRITE */ | ||
| 35 | static Lisp_Object Qclose_nowrite; /* IN_CLOSE_NOWRITE */ | ||
| 36 | static Lisp_Object Qcreate; /* IN_CREATE */ | ||
| 37 | static Lisp_Object Qdelete; /* IN_DELETE */ | ||
| 38 | static Lisp_Object Qdelete_self; /* IN_DELETE_SELF */ | ||
| 39 | static Lisp_Object Qmodify; /* IN_MODIFY */ | ||
| 40 | static Lisp_Object Qmove_self; /* IN_MOVE_SELF */ | ||
| 41 | static Lisp_Object Qmoved_from; /* IN_MOVED_FROM */ | ||
| 42 | static Lisp_Object Qmoved_to; /* IN_MOVED_TO */ | ||
| 43 | static Lisp_Object Qopen; /* IN_OPEN */ | ||
| 44 | |||
| 45 | static Lisp_Object Qall_events; /* IN_ALL_EVENTS */ | ||
| 46 | static Lisp_Object Qmove; /* IN_MOVE */ | ||
| 47 | static Lisp_Object Qclose; /* IN_CLOSE */ | ||
| 48 | |||
| 49 | static Lisp_Object Qdont_follow; /* IN_DONT_FOLLOW */ | ||
| 50 | static Lisp_Object Qexcl_unlink; /* IN_EXCL_UNLINK */ | ||
| 51 | static Lisp_Object Qmask_add; /* IN_MASK_ADD */ | ||
| 52 | static Lisp_Object Qoneshot; /* IN_ONESHOT */ | ||
| 53 | static Lisp_Object Qonlydir; /* IN_ONLYDIR */ | ||
| 54 | |||
| 55 | static Lisp_Object Qignored; /* IN_IGNORED */ | ||
| 56 | static Lisp_Object Qisdir; /* IN_ISDIR */ | ||
| 57 | static Lisp_Object Qq_overflow; /* IN_Q_OVERFLOW */ | ||
| 58 | static Lisp_Object Qunmount; /* IN_UNMOUNT */ | ||
| 59 | |||
| 60 | #include <sys/inotify.h> | 32 | #include <sys/inotify.h> |
| 61 | #include <sys/ioctl.h> | 33 | #include <sys/ioctl.h> |
| 62 | 34 | ||
| @@ -398,33 +370,34 @@ See inotify_rm_watch(2) for more information. | |||
| 398 | void | 370 | void |
| 399 | syms_of_inotify (void) | 371 | syms_of_inotify (void) |
| 400 | { | 372 | { |
| 401 | DEFSYM (Qaccess, "access"); | 373 | DEFSYM (Qaccess, "access"); /* IN_ACCESS */ |
| 402 | DEFSYM (Qattrib, "attrib"); | 374 | DEFSYM (Qattrib, "attrib"); /* IN_ATTRIB */ |
| 403 | DEFSYM (Qclose_write, "close-write"); | 375 | DEFSYM (Qclose_write, "close-write"); /* IN_CLOSE_WRITE */ |
| 404 | DEFSYM (Qclose_nowrite, "close-nowrite"); | 376 | DEFSYM (Qclose_nowrite, "close-nowrite"); |
| 405 | DEFSYM (Qcreate, "create"); | 377 | /* IN_CLOSE_NOWRITE */ |
| 406 | DEFSYM (Qdelete, "delete"); | 378 | DEFSYM (Qcreate, "create"); /* IN_CREATE */ |
| 407 | DEFSYM (Qdelete_self, "delete-self"); | 379 | DEFSYM (Qdelete, "delete"); /* IN_DELETE */ |
| 408 | DEFSYM (Qmodify, "modify"); | 380 | DEFSYM (Qdelete_self, "delete-self"); /* IN_DELETE_SELF */ |
| 409 | DEFSYM (Qmove_self, "move-self"); | 381 | DEFSYM (Qmodify, "modify"); /* IN_MODIFY */ |
| 410 | DEFSYM (Qmoved_from, "moved-from"); | 382 | DEFSYM (Qmove_self, "move-self"); /* IN_MOVE_SELF */ |
| 411 | DEFSYM (Qmoved_to, "moved-to"); | 383 | DEFSYM (Qmoved_from, "moved-from"); /* IN_MOVED_FROM */ |
| 412 | DEFSYM (Qopen, "open"); | 384 | DEFSYM (Qmoved_to, "moved-to"); /* IN_MOVED_TO */ |
| 413 | 385 | DEFSYM (Qopen, "open"); /* IN_OPEN */ | |
| 414 | DEFSYM (Qall_events, "all-events"); | 386 | |
| 415 | DEFSYM (Qmove, "move"); | 387 | DEFSYM (Qall_events, "all-events"); /* IN_ALL_EVENTS */ |
| 416 | DEFSYM (Qclose, "close"); | 388 | DEFSYM (Qmove, "move"); /* IN_MOVE */ |
| 417 | 389 | DEFSYM (Qclose, "close"); /* IN_CLOSE */ | |
| 418 | DEFSYM (Qdont_follow, "dont-follow"); | 390 | |
| 419 | DEFSYM (Qexcl_unlink, "excl-unlink"); | 391 | DEFSYM (Qdont_follow, "dont-follow"); /* IN_DONT_FOLLOW */ |
| 420 | DEFSYM (Qmask_add, "mask-add"); | 392 | DEFSYM (Qexcl_unlink, "excl-unlink"); /* IN_EXCL_UNLINK */ |
| 421 | DEFSYM (Qoneshot, "oneshot"); | 393 | DEFSYM (Qmask_add, "mask-add"); /* IN_MASK_ADD */ |
| 422 | DEFSYM (Qonlydir, "onlydir"); | 394 | DEFSYM (Qoneshot, "oneshot"); /* IN_ONESHOT */ |
| 423 | 395 | DEFSYM (Qonlydir, "onlydir"); /* IN_ONLYDIR */ | |
| 424 | DEFSYM (Qignored, "ignored"); | 396 | |
| 425 | DEFSYM (Qisdir, "isdir"); | 397 | DEFSYM (Qignored, "ignored"); /* IN_IGNORED */ |
| 426 | DEFSYM (Qq_overflow, "q-overflow"); | 398 | DEFSYM (Qisdir, "isdir"); /* IN_ISDIR */ |
| 427 | DEFSYM (Qunmount, "unmount"); | 399 | DEFSYM (Qq_overflow, "q-overflow"); /* IN_Q_OVERFLOW */ |
| 400 | DEFSYM (Qunmount, "unmount"); /* IN_UNMOUNT */ | ||
| 428 | 401 | ||
| 429 | defsubr (&Sinotify_add_watch); | 402 | defsubr (&Sinotify_add_watch); |
| 430 | defsubr (&Sinotify_rm_watch); | 403 | defsubr (&Sinotify_rm_watch); |
diff --git a/src/insdel.c b/src/insdel.c index a1bec4a9a6d..4463721b897 100644 --- a/src/insdel.c +++ b/src/insdel.c | |||
| @@ -52,8 +52,6 @@ static Lisp_Object combine_after_change_list; | |||
| 52 | /* Buffer which combine_after_change_list is about. */ | 52 | /* Buffer which combine_after_change_list is about. */ |
| 53 | static Lisp_Object combine_after_change_buffer; | 53 | static Lisp_Object combine_after_change_buffer; |
| 54 | 54 | ||
| 55 | Lisp_Object Qinhibit_modification_hooks; | ||
| 56 | |||
| 57 | static void signal_before_change (ptrdiff_t, ptrdiff_t, ptrdiff_t *); | 55 | static void signal_before_change (ptrdiff_t, ptrdiff_t, ptrdiff_t *); |
| 58 | 56 | ||
| 59 | /* Also used in marker.c to enable expensive marker checks. */ | 57 | /* Also used in marker.c to enable expensive marker checks. */ |
| @@ -1781,8 +1779,6 @@ modify_text (ptrdiff_t start, ptrdiff_t end) | |||
| 1781 | bset_point_before_scroll (current_buffer, Qnil); | 1779 | bset_point_before_scroll (current_buffer, Qnil); |
| 1782 | } | 1780 | } |
| 1783 | 1781 | ||
| 1784 | Lisp_Object Qregion_extract_function; | ||
| 1785 | |||
| 1786 | /* Check that it is okay to modify the buffer between START and END, | 1782 | /* Check that it is okay to modify the buffer between START and END, |
| 1787 | which are char positions. | 1783 | which are char positions. |
| 1788 | 1784 | ||
| @@ -1995,7 +1991,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, | |||
| 1995 | { | 1991 | { |
| 1996 | PRESERVE_VALUE; | 1992 | PRESERVE_VALUE; |
| 1997 | PRESERVE_START_END; | 1993 | PRESERVE_START_END; |
| 1998 | Frun_hooks (1, &Qfirst_change_hook); | 1994 | run_hook (Qfirst_change_hook); |
| 1999 | } | 1995 | } |
| 2000 | 1996 | ||
| 2001 | /* Now run the before-change-functions if any. */ | 1997 | /* Now run the before-change-functions if any. */ |
diff --git a/src/intervals.h b/src/intervals.h index 8f0f3482ea5..b2260d002e6 100644 --- a/src/intervals.h +++ b/src/intervals.h | |||
| @@ -271,21 +271,7 @@ extern INTERVAL interval_of (ptrdiff_t, Lisp_Object); | |||
| 271 | /* Defined in xdisp.c. */ | 271 | /* Defined in xdisp.c. */ |
| 272 | extern int invisible_p (Lisp_Object, Lisp_Object); | 272 | extern int invisible_p (Lisp_Object, Lisp_Object); |
| 273 | 273 | ||
| 274 | /* Declared in textprop.c. */ | 274 | /* Defined in textprop.c. */ |
| 275 | |||
| 276 | /* Types of hooks. */ | ||
| 277 | extern Lisp_Object Qpoint_left; | ||
| 278 | extern Lisp_Object Qpoint_entered; | ||
| 279 | extern Lisp_Object Qmodification_hooks; | ||
| 280 | extern Lisp_Object Qcategory; | ||
| 281 | extern Lisp_Object Qlocal_map; | ||
| 282 | |||
| 283 | /* Visual properties text (including strings) may have. */ | ||
| 284 | extern Lisp_Object Qinvisible, Qintangible; | ||
| 285 | |||
| 286 | /* Sticky properties. */ | ||
| 287 | extern Lisp_Object Qfront_sticky, Qrear_nonsticky; | ||
| 288 | |||
| 289 | extern Lisp_Object copy_text_properties (Lisp_Object, Lisp_Object, | 275 | extern Lisp_Object copy_text_properties (Lisp_Object, Lisp_Object, |
| 290 | Lisp_Object, Lisp_Object, | 276 | Lisp_Object, Lisp_Object, |
| 291 | Lisp_Object, Lisp_Object); | 277 | Lisp_Object, Lisp_Object); |
diff --git a/src/keyboard.c b/src/keyboard.c index 9261c4b09fd..86c840d052a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -88,11 +88,6 @@ static KBOARD *all_kboards; | |||
| 88 | /* True in the single-kboard state, false in the any-kboard state. */ | 88 | /* True in the single-kboard state, false in the any-kboard state. */ |
| 89 | static bool single_kboard; | 89 | static bool single_kboard; |
| 90 | 90 | ||
| 91 | /* Non-nil disable property on a command means | ||
| 92 | do not execute it; call disabled-command-function's value instead. */ | ||
| 93 | Lisp_Object Qdisabled; | ||
| 94 | static Lisp_Object Qdisabled_command_function; | ||
| 95 | |||
| 96 | #define NUM_RECENT_KEYS (300) | 91 | #define NUM_RECENT_KEYS (300) |
| 97 | 92 | ||
| 98 | /* Index for storing next element into recent_keys. */ | 93 | /* Index for storing next element into recent_keys. */ |
| @@ -232,42 +227,11 @@ static ptrdiff_t last_point_position; | |||
| 232 | 'volatile' here. */ | 227 | 'volatile' here. */ |
| 233 | Lisp_Object internal_last_event_frame; | 228 | Lisp_Object internal_last_event_frame; |
| 234 | 229 | ||
| 235 | static Lisp_Object Qgui_set_selection, Qhandle_switch_frame; | ||
| 236 | static Lisp_Object Qhandle_select_window; | ||
| 237 | Lisp_Object QPRIMARY; | ||
| 238 | |||
| 239 | static Lisp_Object Qself_insert_command; | ||
| 240 | static Lisp_Object Qforward_char; | ||
| 241 | static Lisp_Object Qbackward_char; | ||
| 242 | Lisp_Object Qundefined; | ||
| 243 | static Lisp_Object Qtimer_event_handler; | ||
| 244 | |||
| 245 | /* `read_key_sequence' stores here the command definition of the | 230 | /* `read_key_sequence' stores here the command definition of the |
| 246 | key sequence that it reads. */ | 231 | key sequence that it reads. */ |
| 247 | static Lisp_Object read_key_sequence_cmd; | 232 | static Lisp_Object read_key_sequence_cmd; |
| 248 | static Lisp_Object read_key_sequence_remapped; | 233 | static Lisp_Object read_key_sequence_remapped; |
| 249 | 234 | ||
| 250 | static Lisp_Object Qinput_method_function; | ||
| 251 | |||
| 252 | static Lisp_Object Qdeactivate_mark; | ||
| 253 | |||
| 254 | Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook; | ||
| 255 | |||
| 256 | static Lisp_Object Qecho_area_clear_hook; | ||
| 257 | |||
| 258 | /* Hooks to run before and after each command. */ | ||
| 259 | static Lisp_Object Qpre_command_hook; | ||
| 260 | static Lisp_Object Qpost_command_hook; | ||
| 261 | |||
| 262 | static Lisp_Object Qdeferred_action_function; | ||
| 263 | |||
| 264 | static Lisp_Object Qdelayed_warnings_hook; | ||
| 265 | |||
| 266 | static Lisp_Object Qinput_method_exit_on_first_char; | ||
| 267 | static Lisp_Object Qinput_method_use_echo_area; | ||
| 268 | |||
| 269 | static Lisp_Object Qhelp_form_show; | ||
| 270 | |||
| 271 | /* File in which we write all commands we read. */ | 235 | /* File in which we write all commands we read. */ |
| 272 | static FILE *dribble; | 236 | static FILE *dribble; |
| 273 | 237 | ||
| @@ -346,86 +310,12 @@ static struct input_event * volatile kbd_store_ptr; | |||
| 346 | dequeuing functions? Such a flag could be screwed up by interrupts | 310 | dequeuing functions? Such a flag could be screwed up by interrupts |
| 347 | at inopportune times. */ | 311 | at inopportune times. */ |
| 348 | 312 | ||
| 349 | /* Symbols to head events. */ | ||
| 350 | static Lisp_Object Qmouse_movement; | ||
| 351 | static Lisp_Object Qscroll_bar_movement; | ||
| 352 | Lisp_Object Qswitch_frame; | ||
| 353 | static Lisp_Object Qfocus_in, Qfocus_out; | ||
| 354 | static Lisp_Object Qdelete_frame; | ||
| 355 | static Lisp_Object Qiconify_frame; | ||
| 356 | static Lisp_Object Qmake_frame_visible; | ||
| 357 | static Lisp_Object Qselect_window; | ||
| 358 | Lisp_Object Qhelp_echo; | ||
| 359 | |||
| 360 | static Lisp_Object Qmouse_fixup_help_message; | ||
| 361 | |||
| 362 | /* Symbols to denote kinds of events. */ | ||
| 363 | static Lisp_Object Qfunction_key; | ||
| 364 | Lisp_Object Qmouse_click; | ||
| 365 | #ifdef HAVE_NTGUI | ||
| 366 | Lisp_Object Qlanguage_change; | ||
| 367 | #endif | ||
| 368 | static Lisp_Object Qdrag_n_drop; | ||
| 369 | static Lisp_Object Qsave_session; | ||
| 370 | #ifdef HAVE_DBUS | ||
| 371 | static Lisp_Object Qdbus_event; | ||
| 372 | #endif | ||
| 373 | #ifdef HAVE_XWIDGETS | ||
| 374 | Lisp_Object Qxwidget_event; | ||
| 375 | #endif | ||
| 376 | #ifdef USE_FILE_NOTIFY | ||
| 377 | static Lisp_Object Qfile_notify; | ||
| 378 | #endif /* USE_FILE_NOTIFY */ | ||
| 379 | static Lisp_Object Qconfig_changed_event; | ||
| 380 | |||
| 381 | /* Lisp_Object Qmouse_movement; - also an event header */ | ||
| 382 | |||
| 383 | /* Properties of event headers. */ | ||
| 384 | Lisp_Object Qevent_kind; | ||
| 385 | static Lisp_Object Qevent_symbol_elements; | ||
| 386 | |||
| 387 | /* Menu and tool bar item parts. */ | ||
| 388 | static Lisp_Object Qmenu_enable; | ||
| 389 | static Lisp_Object QCenable, QCvisible, QChelp, QCkeys, QCkey_sequence; | ||
| 390 | Lisp_Object QCfilter; | ||
| 391 | |||
| 392 | /* Non-nil disable property on a command means | ||
| 393 | do not execute it; call disabled-command-function's value instead. */ | ||
| 394 | Lisp_Object QCtoggle, QCradio; | ||
| 395 | static Lisp_Object QCbutton, QClabel; | ||
| 396 | |||
| 397 | static Lisp_Object QCvert_only; | ||
| 398 | |||
| 399 | /* An event header symbol HEAD may have a property named | ||
| 400 | Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS); | ||
| 401 | BASE is the base, unmodified version of HEAD, and MODIFIERS is the | ||
| 402 | mask of modifiers applied to it. If present, this is used to help | ||
| 403 | speed up parse_modifiers. */ | ||
| 404 | Lisp_Object Qevent_symbol_element_mask; | ||
| 405 | |||
| 406 | /* An unmodified event header BASE may have a property named | ||
| 407 | Qmodifier_cache, which is an alist mapping modifier masks onto | ||
| 408 | modified versions of BASE. If present, this helps speed up | ||
| 409 | apply_modifiers. */ | ||
| 410 | static Lisp_Object Qmodifier_cache; | ||
| 411 | |||
| 412 | /* Symbols to use for parts of windows. */ | ||
| 413 | Lisp_Object Qmode_line; | ||
| 414 | Lisp_Object Qvertical_line; | ||
| 415 | Lisp_Object Qright_divider, Qbottom_divider; | ||
| 416 | Lisp_Object Qmenu_bar; | ||
| 417 | |||
| 418 | static Lisp_Object Qecho_keystrokes; | ||
| 419 | |||
| 420 | static void recursive_edit_unwind (Lisp_Object buffer); | 313 | static void recursive_edit_unwind (Lisp_Object buffer); |
| 421 | static Lisp_Object command_loop (void); | 314 | static Lisp_Object command_loop (void); |
| 422 | static Lisp_Object Qcommand_execute; | ||
| 423 | 315 | ||
| 424 | static void echo_now (void); | 316 | static void echo_now (void); |
| 425 | static ptrdiff_t echo_length (void); | 317 | static ptrdiff_t echo_length (void); |
| 426 | 318 | ||
| 427 | static Lisp_Object Qpolling_period; | ||
| 428 | |||
| 429 | /* Incremented whenever a timer is run. */ | 319 | /* Incremented whenever a timer is run. */ |
| 430 | unsigned timers_run; | 320 | unsigned timers_run; |
| 431 | 321 | ||
| @@ -1716,10 +1606,7 @@ command_loop_1 (void) | |||
| 1716 | } | 1606 | } |
| 1717 | 1607 | ||
| 1718 | if (current_buffer != prev_buffer || MODIFF != prev_modiff) | 1608 | if (current_buffer != prev_buffer || MODIFF != prev_modiff) |
| 1719 | { | 1609 | run_hook (intern ("activate-mark-hook")); |
| 1720 | Lisp_Object hook = intern ("activate-mark-hook"); | ||
| 1721 | Frun_hooks (1, &hook); | ||
| 1722 | } | ||
| 1723 | } | 1610 | } |
| 1724 | 1611 | ||
| 1725 | Vsaved_region_selection = Qnil; | 1612 | Vsaved_region_selection = Qnil; |
| @@ -4138,11 +4025,7 @@ kbd_buffer_get_event (KBOARD **kbp, | |||
| 4138 | { | 4025 | { |
| 4139 | #ifdef HAVE_W32NOTIFY | 4026 | #ifdef HAVE_W32NOTIFY |
| 4140 | /* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */ | 4027 | /* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */ |
| 4141 | obj = list3 (Qfile_notify, | 4028 | obj = list3 (Qfile_notify, event->arg, event->frame_or_window); |
| 4142 | list3 (make_number (event->code), | ||
| 4143 | XCAR (event->arg), | ||
| 4144 | XCDR (event->arg)), | ||
| 4145 | event->frame_or_window); | ||
| 4146 | #else | 4029 | #else |
| 4147 | obj = make_lispy_event (event); | 4030 | obj = make_lispy_event (event); |
| 4148 | #endif | 4031 | #endif |
| @@ -5295,22 +5178,17 @@ static const char *const lispy_drag_n_drop_names[] = | |||
| 5295 | "drag-n-drop" | 5178 | "drag-n-drop" |
| 5296 | }; | 5179 | }; |
| 5297 | 5180 | ||
| 5298 | /* Scroll bar parts. */ | 5181 | /* An array of symbol indexes of scroll bar parts, indexed by an enum |
| 5299 | static Lisp_Object Qabove_handle, Qhandle, Qbelow_handle; | 5182 | scroll_bar_part value. Note that Qnil corresponds to |
| 5300 | static Lisp_Object Qbefore_handle, Qhorizontal_handle, Qafter_handle; | 5183 | scroll_bar_nowhere and should not appear in Lisp events. */ |
| 5301 | Lisp_Object Qup, Qdown, Qtop, Qbottom; | 5184 | static short const scroll_bar_parts[] = { |
| 5302 | static Lisp_Object Qleftmost, Qrightmost; | 5185 | SYMBOL_INDEX (Qnil), SYMBOL_INDEX (Qabove_handle), SYMBOL_INDEX (Qhandle), |
| 5303 | static Lisp_Object Qend_scroll; | 5186 | SYMBOL_INDEX (Qbelow_handle), SYMBOL_INDEX (Qup), SYMBOL_INDEX (Qdown), |
| 5304 | static Lisp_Object Qratio; | 5187 | SYMBOL_INDEX (Qtop), SYMBOL_INDEX (Qbottom), SYMBOL_INDEX (Qend_scroll), |
| 5305 | 5188 | SYMBOL_INDEX (Qratio), SYMBOL_INDEX (Qbefore_handle), | |
| 5306 | /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. | 5189 | SYMBOL_INDEX (Qhorizontal_handle), SYMBOL_INDEX (Qafter_handle), |
| 5307 | Note that Qnil corresponds to scroll_bar_nowhere and should not appear | 5190 | SYMBOL_INDEX (Qleft), SYMBOL_INDEX (Qright), SYMBOL_INDEX (Qleftmost), |
| 5308 | in Lisp events. */ | 5191 | SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio) |
| 5309 | static Lisp_Object *const scroll_bar_parts[] = { | ||
| 5310 | &Qnil, &Qabove_handle, &Qhandle, &Qbelow_handle, | ||
| 5311 | &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio, | ||
| 5312 | &Qbefore_handle, &Qhorizontal_handle, &Qafter_handle, | ||
| 5313 | &Qleft, &Qright, &Qleftmost, &Qrightmost, &Qend_scroll, &Qratio | ||
| 5314 | }; | 5192 | }; |
| 5315 | 5193 | ||
| 5316 | /* A vector, indexed by button number, giving the down-going location | 5194 | /* A vector, indexed by button number, giving the down-going location |
| @@ -5583,7 +5461,8 @@ static Lisp_Object | |||
| 5583 | make_scroll_bar_position (struct input_event *ev, Lisp_Object type) | 5461 | make_scroll_bar_position (struct input_event *ev, Lisp_Object type) |
| 5584 | { | 5462 | { |
| 5585 | return list5 (ev->frame_or_window, type, Fcons (ev->x, ev->y), | 5463 | return list5 (ev->frame_or_window, type, Fcons (ev->x, ev->y), |
| 5586 | make_number (ev->timestamp), *scroll_bar_parts[ev->part]); | 5464 | make_number (ev->timestamp), |
| 5465 | builtin_lisp_symbol (scroll_bar_parts[ev->part])); | ||
| 5587 | } | 5466 | } |
| 5588 | 5467 | ||
| 5589 | /* Given a struct input_event, build the lisp event which represents | 5468 | /* Given a struct input_event, build the lisp event which represents |
| @@ -6231,7 +6110,7 @@ make_lispy_movement (struct frame *frame, Lisp_Object bar_window, enum scroll_ba | |||
| 6231 | { | 6110 | { |
| 6232 | Lisp_Object part_sym; | 6111 | Lisp_Object part_sym; |
| 6233 | 6112 | ||
| 6234 | part_sym = *scroll_bar_parts[(int) part]; | 6113 | part_sym = builtin_lisp_symbol (scroll_bar_parts[part]); |
| 6235 | return list2 (Qscroll_bar_movement, | 6114 | return list2 (Qscroll_bar_movement, |
| 6236 | list5 (bar_window, | 6115 | list5 (bar_window, |
| 6237 | Qvertical_scroll_bar, | 6116 | Qvertical_scroll_bar, |
| @@ -8095,11 +7974,6 @@ static Lisp_Object tool_bar_item_properties; | |||
| 8095 | 7974 | ||
| 8096 | static int ntool_bar_items; | 7975 | static int ntool_bar_items; |
| 8097 | 7976 | ||
| 8098 | /* The symbols `:image' and `:rtl'. */ | ||
| 8099 | |||
| 8100 | static Lisp_Object QCimage; | ||
| 8101 | static Lisp_Object QCrtl; | ||
| 8102 | |||
| 8103 | /* Function prototypes. */ | 7977 | /* Function prototypes. */ |
| 8104 | 7978 | ||
| 8105 | static void init_tool_bar_items (Lisp_Object); | 7979 | static void init_tool_bar_items (Lisp_Object); |
| @@ -10358,7 +10232,6 @@ On such systems, Emacs starts a subshell instead of suspending. */) | |||
| 10358 | int old_height, old_width; | 10232 | int old_height, old_width; |
| 10359 | int width, height; | 10233 | int width, height; |
| 10360 | struct gcpro gcpro1; | 10234 | struct gcpro gcpro1; |
| 10361 | Lisp_Object hook; | ||
| 10362 | 10235 | ||
| 10363 | if (tty_list && tty_list->next) | 10236 | if (tty_list && tty_list->next) |
| 10364 | error ("There are other tty frames open; close them before suspending Emacs"); | 10237 | error ("There are other tty frames open; close them before suspending Emacs"); |
| @@ -10366,9 +10239,7 @@ On such systems, Emacs starts a subshell instead of suspending. */) | |||
| 10366 | if (!NILP (stuffstring)) | 10239 | if (!NILP (stuffstring)) |
| 10367 | CHECK_STRING (stuffstring); | 10240 | CHECK_STRING (stuffstring); |
| 10368 | 10241 | ||
| 10369 | /* Run the functions in suspend-hook. */ | 10242 | run_hook (intern ("suspend-hook")); |
| 10370 | hook = intern ("suspend-hook"); | ||
| 10371 | Frun_hooks (1, &hook); | ||
| 10372 | 10243 | ||
| 10373 | GCPRO1 (stuffstring); | 10244 | GCPRO1 (stuffstring); |
| 10374 | get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height); | 10245 | get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height); |
| @@ -10392,9 +10263,7 @@ On such systems, Emacs starts a subshell instead of suspending. */) | |||
| 10392 | height - FRAME_MENU_BAR_LINES (SELECTED_FRAME ()), | 10263 | height - FRAME_MENU_BAR_LINES (SELECTED_FRAME ()), |
| 10393 | 0, 0, 0, 0); | 10264 | 0, 0, 0, 0); |
| 10394 | 10265 | ||
| 10395 | /* Run suspend-resume-hook. */ | 10266 | run_hook (intern ("suspend-resume-hook")); |
| 10396 | hook = intern ("suspend-resume-hook"); | ||
| 10397 | Frun_hooks (1, &hook); | ||
| 10398 | 10267 | ||
| 10399 | UNGCPRO; | 10268 | UNGCPRO; |
| 10400 | return Qnil; | 10269 | return Qnil; |
| @@ -11138,26 +11007,29 @@ init_keyboard (void) | |||
| 11138 | #endif | 11007 | #endif |
| 11139 | } | 11008 | } |
| 11140 | 11009 | ||
| 11141 | /* This type's only use is in syms_of_keyboard, to initialize the | 11010 | /* This type's only use is in syms_of_keyboard, to put properties on the |
| 11142 | event header symbols and put properties on them. */ | 11011 | event header symbols. */ |
| 11143 | struct event_head { | 11012 | struct event_head |
| 11144 | Lisp_Object *var; | 11013 | { |
| 11145 | const char *name; | 11014 | short var; |
| 11146 | Lisp_Object *kind; | 11015 | short kind; |
| 11147 | }; | 11016 | }; |
| 11148 | 11017 | ||
| 11149 | static const struct event_head head_table[] = { | 11018 | static const struct event_head head_table[] = { |
| 11150 | {&Qmouse_movement, "mouse-movement", &Qmouse_movement}, | 11019 | {SYMBOL_INDEX (Qmouse_movement), SYMBOL_INDEX (Qmouse_movement)}, |
| 11151 | {&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement}, | 11020 | {SYMBOL_INDEX (Qscroll_bar_movement), SYMBOL_INDEX (Qmouse_movement)}, |
| 11152 | {&Qswitch_frame, "switch-frame", &Qswitch_frame}, | 11021 | |
| 11153 | {&Qfocus_in, "focus-in", &Qfocus_in}, | 11022 | /* Some of the event heads. */ |
| 11154 | {&Qfocus_out, "focus-out", &Qfocus_out}, | 11023 | {SYMBOL_INDEX (Qswitch_frame), SYMBOL_INDEX (Qswitch_frame)}, |
| 11155 | {&Qdelete_frame, "delete-frame", &Qdelete_frame}, | 11024 | |
| 11156 | {&Qiconify_frame, "iconify-frame", &Qiconify_frame}, | 11025 | {SYMBOL_INDEX (Qfocus_in), SYMBOL_INDEX (Qfocus_in)}, |
| 11157 | {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible}, | 11026 | {SYMBOL_INDEX (Qfocus_out), SYMBOL_INDEX (Qfocus_out)}, |
| 11027 | {SYMBOL_INDEX (Qdelete_frame), SYMBOL_INDEX (Qdelete_frame)}, | ||
| 11028 | {SYMBOL_INDEX (Qiconify_frame), SYMBOL_INDEX (Qiconify_frame)}, | ||
| 11029 | {SYMBOL_INDEX (Qmake_frame_visible), SYMBOL_INDEX (Qmake_frame_visible)}, | ||
| 11158 | /* `select-window' should be handled just like `switch-frame' | 11030 | /* `select-window' should be handled just like `switch-frame' |
| 11159 | in read_key_sequence. */ | 11031 | in read_key_sequence. */ |
| 11160 | {&Qselect_window, "select-window", &Qswitch_frame} | 11032 | {SYMBOL_INDEX (Qselect_window), SYMBOL_INDEX (Qswitch_frame)} |
| 11161 | }; | 11033 | }; |
| 11162 | 11034 | ||
| 11163 | void | 11035 | void |
| @@ -11196,17 +11068,29 @@ syms_of_keyboard (void) | |||
| 11196 | DEFSYM (Qself_insert_command, "self-insert-command"); | 11068 | DEFSYM (Qself_insert_command, "self-insert-command"); |
| 11197 | DEFSYM (Qforward_char, "forward-char"); | 11069 | DEFSYM (Qforward_char, "forward-char"); |
| 11198 | DEFSYM (Qbackward_char, "backward-char"); | 11070 | DEFSYM (Qbackward_char, "backward-char"); |
| 11071 | |||
| 11072 | /* Non-nil disable property on a command means do not execute it; | ||
| 11073 | call disabled-command-function's value instead. */ | ||
| 11199 | DEFSYM (Qdisabled, "disabled"); | 11074 | DEFSYM (Qdisabled, "disabled"); |
| 11075 | |||
| 11200 | DEFSYM (Qundefined, "undefined"); | 11076 | DEFSYM (Qundefined, "undefined"); |
| 11077 | |||
| 11078 | /* Hooks to run before and after each command. */ | ||
| 11201 | DEFSYM (Qpre_command_hook, "pre-command-hook"); | 11079 | DEFSYM (Qpre_command_hook, "pre-command-hook"); |
| 11202 | DEFSYM (Qpost_command_hook, "post-command-hook"); | 11080 | DEFSYM (Qpost_command_hook, "post-command-hook"); |
| 11081 | |||
| 11203 | DEFSYM (Qdeferred_action_function, "deferred-action-function"); | 11082 | DEFSYM (Qdeferred_action_function, "deferred-action-function"); |
| 11204 | DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook"); | 11083 | DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook"); |
| 11205 | DEFSYM (Qfunction_key, "function-key"); | 11084 | DEFSYM (Qfunction_key, "function-key"); |
| 11085 | |||
| 11086 | /* The values of Qevent_kind properties. */ | ||
| 11206 | DEFSYM (Qmouse_click, "mouse-click"); | 11087 | DEFSYM (Qmouse_click, "mouse-click"); |
| 11088 | |||
| 11207 | DEFSYM (Qdrag_n_drop, "drag-n-drop"); | 11089 | DEFSYM (Qdrag_n_drop, "drag-n-drop"); |
| 11208 | DEFSYM (Qsave_session, "save-session"); | 11090 | DEFSYM (Qsave_session, "save-session"); |
| 11209 | DEFSYM (Qconfig_changed_event, "config-changed-event"); | 11091 | DEFSYM (Qconfig_changed_event, "config-changed-event"); |
| 11092 | |||
| 11093 | /* Menu and tool bar item parts. */ | ||
| 11210 | DEFSYM (Qmenu_enable, "menu-enable"); | 11094 | DEFSYM (Qmenu_enable, "menu-enable"); |
| 11211 | 11095 | ||
| 11212 | #ifdef HAVE_NTGUI | 11096 | #ifdef HAVE_NTGUI |
| @@ -11225,6 +11109,7 @@ syms_of_keyboard (void) | |||
| 11225 | DEFSYM (Qfile_notify, "file-notify"); | 11109 | DEFSYM (Qfile_notify, "file-notify"); |
| 11226 | #endif /* USE_FILE_NOTIFY */ | 11110 | #endif /* USE_FILE_NOTIFY */ |
| 11227 | 11111 | ||
| 11112 | /* Menu and tool bar item parts. */ | ||
| 11228 | DEFSYM (QCenable, ":enable"); | 11113 | DEFSYM (QCenable, ":enable"); |
| 11229 | DEFSYM (QCvisible, ":visible"); | 11114 | DEFSYM (QCvisible, ":visible"); |
| 11230 | DEFSYM (QChelp, ":help"); | 11115 | DEFSYM (QChelp, ":help"); |
| @@ -11232,14 +11117,16 @@ syms_of_keyboard (void) | |||
| 11232 | DEFSYM (QCbutton, ":button"); | 11117 | DEFSYM (QCbutton, ":button"); |
| 11233 | DEFSYM (QCkeys, ":keys"); | 11118 | DEFSYM (QCkeys, ":keys"); |
| 11234 | DEFSYM (QCkey_sequence, ":key-sequence"); | 11119 | DEFSYM (QCkey_sequence, ":key-sequence"); |
| 11120 | |||
| 11121 | /* Non-nil disable property on a command means | ||
| 11122 | do not execute it; call disabled-command-function's value instead. */ | ||
| 11235 | DEFSYM (QCtoggle, ":toggle"); | 11123 | DEFSYM (QCtoggle, ":toggle"); |
| 11236 | DEFSYM (QCradio, ":radio"); | 11124 | DEFSYM (QCradio, ":radio"); |
| 11237 | DEFSYM (QClabel, ":label"); | 11125 | DEFSYM (QClabel, ":label"); |
| 11238 | DEFSYM (QCvert_only, ":vert-only"); | 11126 | DEFSYM (QCvert_only, ":vert-only"); |
| 11239 | 11127 | ||
| 11240 | DEFSYM (Qmode_line, "mode-line"); | 11128 | /* Symbols to use for parts of windows. */ |
| 11241 | DEFSYM (Qvertical_line, "vertical-line"); | 11129 | DEFSYM (Qvertical_line, "vertical-line"); |
| 11242 | DEFSYM (Qmenu_bar, "menu-bar"); | ||
| 11243 | DEFSYM (Qright_divider, "right-divider"); | 11130 | DEFSYM (Qright_divider, "right-divider"); |
| 11244 | DEFSYM (Qbottom_divider, "bottom-divider"); | 11131 | DEFSYM (Qbottom_divider, "bottom-divider"); |
| 11245 | 11132 | ||
| @@ -11262,9 +11149,21 @@ syms_of_keyboard (void) | |||
| 11262 | DEFSYM (Qleftmost, "leftmost"); | 11149 | DEFSYM (Qleftmost, "leftmost"); |
| 11263 | DEFSYM (Qrightmost, "rightmost"); | 11150 | DEFSYM (Qrightmost, "rightmost"); |
| 11264 | 11151 | ||
| 11152 | /* Properties of event headers. */ | ||
| 11265 | DEFSYM (Qevent_kind, "event-kind"); | 11153 | DEFSYM (Qevent_kind, "event-kind"); |
| 11266 | DEFSYM (Qevent_symbol_elements, "event-symbol-elements"); | 11154 | DEFSYM (Qevent_symbol_elements, "event-symbol-elements"); |
| 11155 | |||
| 11156 | /* An event header symbol HEAD may have a property named | ||
| 11157 | Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS); | ||
| 11158 | BASE is the base, unmodified version of HEAD, and MODIFIERS is the | ||
| 11159 | mask of modifiers applied to it. If present, this is used to help | ||
| 11160 | speed up parse_modifiers. */ | ||
| 11267 | DEFSYM (Qevent_symbol_element_mask, "event-symbol-element-mask"); | 11161 | DEFSYM (Qevent_symbol_element_mask, "event-symbol-element-mask"); |
| 11162 | |||
| 11163 | /* An unmodified event header BASE may have a property named | ||
| 11164 | Qmodifier_cache, which is an alist mapping modifier masks onto | ||
| 11165 | modified versions of BASE. If present, this helps speed up | ||
| 11166 | apply_modifiers. */ | ||
| 11268 | DEFSYM (Qmodifier_cache, "modifier-cache"); | 11167 | DEFSYM (Qmodifier_cache, "modifier-cache"); |
| 11269 | 11168 | ||
| 11270 | DEFSYM (Qrecompute_lucid_menubar, "recompute-lucid-menubar"); | 11169 | DEFSYM (Qrecompute_lucid_menubar, "recompute-lucid-menubar"); |
| @@ -11273,7 +11172,10 @@ syms_of_keyboard (void) | |||
| 11273 | DEFSYM (Qpolling_period, "polling-period"); | 11172 | DEFSYM (Qpolling_period, "polling-period"); |
| 11274 | 11173 | ||
| 11275 | DEFSYM (Qgui_set_selection, "gui-set-selection"); | 11174 | DEFSYM (Qgui_set_selection, "gui-set-selection"); |
| 11175 | |||
| 11176 | /* The primary selection. */ | ||
| 11276 | DEFSYM (QPRIMARY, "PRIMARY"); | 11177 | DEFSYM (QPRIMARY, "PRIMARY"); |
| 11178 | |||
| 11277 | DEFSYM (Qhandle_switch_frame, "handle-switch-frame"); | 11179 | DEFSYM (Qhandle_switch_frame, "handle-switch-frame"); |
| 11278 | DEFSYM (Qhandle_select_window, "handle-select-window"); | 11180 | DEFSYM (Qhandle_select_window, "handle-select-window"); |
| 11279 | 11181 | ||
| @@ -11288,17 +11190,26 @@ syms_of_keyboard (void) | |||
| 11288 | Fset (Qinput_method_exit_on_first_char, Qnil); | 11190 | Fset (Qinput_method_exit_on_first_char, Qnil); |
| 11289 | Fset (Qinput_method_use_echo_area, Qnil); | 11191 | Fset (Qinput_method_use_echo_area, Qnil); |
| 11290 | 11192 | ||
| 11193 | /* Symbols to head events. */ | ||
| 11194 | DEFSYM (Qmouse_movement, "mouse-movement"); | ||
| 11195 | DEFSYM (Qscroll_bar_movement, "scroll-bar-movement"); | ||
| 11196 | DEFSYM (Qswitch_frame, "switch-frame"); | ||
| 11197 | DEFSYM (Qfocus_in, "focus-in"); | ||
| 11198 | DEFSYM (Qfocus_out, "focus-out"); | ||
| 11199 | DEFSYM (Qdelete_frame, "delete-frame"); | ||
| 11200 | DEFSYM (Qiconify_frame, "iconify-frame"); | ||
| 11201 | DEFSYM (Qmake_frame_visible, "make-frame-visible"); | ||
| 11202 | DEFSYM (Qselect_window, "select-window"); | ||
| 11291 | { | 11203 | { |
| 11292 | int i; | 11204 | int i; |
| 11293 | int len = ARRAYELTS (head_table); | ||
| 11294 | 11205 | ||
| 11295 | for (i = 0; i < len; i++) | 11206 | for (i = 0; i < ARRAYELTS (head_table); i++) |
| 11296 | { | 11207 | { |
| 11297 | const struct event_head *p = &head_table[i]; | 11208 | const struct event_head *p = &head_table[i]; |
| 11298 | *p->var = intern_c_string (p->name); | 11209 | Lisp_Object var = builtin_lisp_symbol (p->var); |
| 11299 | staticpro (p->var); | 11210 | Lisp_Object kind = builtin_lisp_symbol (p->kind); |
| 11300 | Fput (*p->var, Qevent_kind, *p->kind); | 11211 | Fput (var, Qevent_kind, kind); |
| 11301 | Fput (*p->var, Qevent_symbol_elements, list1 (*p->var)); | 11212 | Fput (var, Qevent_symbol_elements, list1 (var)); |
| 11302 | } | 11213 | } |
| 11303 | } | 11214 | } |
| 11304 | 11215 | ||
| @@ -11624,13 +11535,13 @@ with no modifiers; thus, setting `extra-keyboard-modifiers' to zero | |||
| 11624 | cancels any modification. */); | 11535 | cancels any modification. */); |
| 11625 | extra_keyboard_modifiers = 0; | 11536 | extra_keyboard_modifiers = 0; |
| 11626 | 11537 | ||
| 11538 | DEFSYM (Qdeactivate_mark, "deactivate-mark"); | ||
| 11627 | DEFVAR_LISP ("deactivate-mark", Vdeactivate_mark, | 11539 | DEFVAR_LISP ("deactivate-mark", Vdeactivate_mark, |
| 11628 | doc: /* If an editing command sets this to t, deactivate the mark afterward. | 11540 | doc: /* If an editing command sets this to t, deactivate the mark afterward. |
| 11629 | The command loop sets this to nil before each command, | 11541 | The command loop sets this to nil before each command, |
| 11630 | and tests the value when the command returns. | 11542 | and tests the value when the command returns. |
| 11631 | Buffer modification stores t in this variable. */); | 11543 | Buffer modification stores t in this variable. */); |
| 11632 | Vdeactivate_mark = Qnil; | 11544 | Vdeactivate_mark = Qnil; |
| 11633 | DEFSYM (Qdeactivate_mark, "deactivate-mark"); | ||
| 11634 | Fmake_variable_buffer_local (Qdeactivate_mark); | 11545 | Fmake_variable_buffer_local (Qdeactivate_mark); |
| 11635 | 11546 | ||
| 11636 | DEFVAR_LISP ("pre-command-hook", Vpre_command_hook, | 11547 | DEFVAR_LISP ("pre-command-hook", Vpre_command_hook, |
diff --git a/src/keyboard.h b/src/keyboard.h index 534e2018a52..0ce6d184482 100644 --- a/src/keyboard.h +++ b/src/keyboard.h | |||
| @@ -248,8 +248,6 @@ extern ptrdiff_t this_command_key_count; | |||
| 248 | generated by the next character. */ | 248 | generated by the next character. */ |
| 249 | extern Lisp_Object internal_last_event_frame; | 249 | extern Lisp_Object internal_last_event_frame; |
| 250 | 250 | ||
| 251 | extern Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook; | ||
| 252 | |||
| 253 | /* This holds a Lisp vector that holds the properties of a single | 251 | /* This holds a Lisp vector that holds the properties of a single |
| 254 | menu item while decoding it in parse_menu_item. | 252 | menu item while decoding it in parse_menu_item. |
| 255 | Using a Lisp vector to hold this information while we decode it | 253 | Using a Lisp vector to hold this information while we decode it |
| @@ -387,25 +385,10 @@ extern void unuse_menu_items (void); | |||
| 387 | #define POSN_INBUFFER_P(posn) (NILP (POSN_STRING (posn))) | 385 | #define POSN_INBUFFER_P(posn) (NILP (POSN_STRING (posn))) |
| 388 | #define POSN_BUFFER_POSN(posn) (Fnth (make_number (5), (posn))) | 386 | #define POSN_BUFFER_POSN(posn) (Fnth (make_number (5), (posn))) |
| 389 | 387 | ||
| 390 | /* Some of the event heads. */ | ||
| 391 | extern Lisp_Object Qswitch_frame; | ||
| 392 | |||
| 393 | /* Properties on event heads. */ | ||
| 394 | extern Lisp_Object Qevent_kind; | ||
| 395 | |||
| 396 | /* The values of Qevent_kind properties. */ | ||
| 397 | extern Lisp_Object Qmouse_click; | ||
| 398 | |||
| 399 | extern Lisp_Object Qhelp_echo; | ||
| 400 | |||
| 401 | /* Getting the kind of an event head. */ | 388 | /* Getting the kind of an event head. */ |
| 402 | #define EVENT_HEAD_KIND(event_head) \ | 389 | #define EVENT_HEAD_KIND(event_head) \ |
| 403 | (Fget ((event_head), Qevent_kind)) | 390 | (Fget ((event_head), Qevent_kind)) |
| 404 | 391 | ||
| 405 | /* Symbols to use for non-text mouse positions. */ | ||
| 406 | extern Lisp_Object Qmode_line, Qvertical_line, Qheader_line; | ||
| 407 | extern Lisp_Object Qright_divider, Qbottom_divider; | ||
| 408 | |||
| 409 | /* True while doing kbd input. */ | 392 | /* True while doing kbd input. */ |
| 410 | extern bool waiting_for_input; | 393 | extern bool waiting_for_input; |
| 411 | 394 | ||
| @@ -415,9 +398,6 @@ extern struct timespec *input_available_clear_time; | |||
| 415 | 398 | ||
| 416 | extern bool ignore_mouse_drag_p; | 399 | extern bool ignore_mouse_drag_p; |
| 417 | 400 | ||
| 418 | /* The primary selection. */ | ||
| 419 | extern Lisp_Object QPRIMARY; | ||
| 420 | |||
| 421 | extern Lisp_Object parse_modifiers (Lisp_Object); | 401 | extern Lisp_Object parse_modifiers (Lisp_Object); |
| 422 | extern Lisp_Object reorder_modifiers (Lisp_Object); | 402 | extern Lisp_Object reorder_modifiers (Lisp_Object); |
| 423 | extern Lisp_Object read_char (int, Lisp_Object, Lisp_Object, | 403 | extern Lisp_Object read_char (int, Lisp_Object, Lisp_Object, |
| @@ -428,17 +408,6 @@ extern int parse_solitary_modifier (Lisp_Object symbol); | |||
| 428 | /* This is like Vthis_command, except that commands never set it. */ | 408 | /* This is like Vthis_command, except that commands never set it. */ |
| 429 | extern Lisp_Object real_this_command; | 409 | extern Lisp_Object real_this_command; |
| 430 | 410 | ||
| 431 | /* Non-nil disable property on a command means | ||
| 432 | do not execute it; call disabled-command-function's value instead. */ | ||
| 433 | extern Lisp_Object QCtoggle, QCradio; | ||
| 434 | |||
| 435 | /* An event header symbol HEAD may have a property named | ||
| 436 | Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS); | ||
| 437 | BASE is the base, unmodified version of HEAD, and MODIFIERS is the | ||
| 438 | mask of modifiers applied to it. If present, this is used to help | ||
| 439 | speed up parse_modifiers. */ | ||
| 440 | extern Lisp_Object Qevent_symbol_element_mask; | ||
| 441 | |||
| 442 | extern int quit_char; | 411 | extern int quit_char; |
| 443 | 412 | ||
| 444 | extern unsigned int timers_run; | 413 | extern unsigned int timers_run; |
diff --git a/src/keymap.c b/src/keymap.c index ab21a226271..9c7b4d29a3e 100644 --- a/src/keymap.c +++ b/src/keymap.c | |||
| @@ -76,12 +76,6 @@ Lisp_Object control_x_map; /* The keymap used for globally bound | |||
| 76 | bindings when spaces are not encouraged | 76 | bindings when spaces are not encouraged |
| 77 | in the minibuf. */ | 77 | in the minibuf. */ |
| 78 | 78 | ||
| 79 | /* Keymap used for minibuffers when doing completion. */ | ||
| 80 | /* Keymap used for minibuffers when doing completion and require a match. */ | ||
| 81 | static Lisp_Object Qkeymapp, Qnon_ascii; | ||
| 82 | Lisp_Object Qkeymap, Qmenu_item, Qremap; | ||
| 83 | static Lisp_Object QCadvertised_binding; | ||
| 84 | |||
| 85 | /* Alist of elements like (DEL . "\d"). */ | 79 | /* Alist of elements like (DEL . "\d"). */ |
| 86 | static Lisp_Object exclude_keys; | 80 | static Lisp_Object exclude_keys; |
| 87 | 81 | ||
| @@ -654,8 +648,6 @@ map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, | |||
| 654 | UNGCPRO; | 648 | UNGCPRO; |
| 655 | } | 649 | } |
| 656 | 650 | ||
| 657 | static Lisp_Object Qkeymap_canonicalize; | ||
| 658 | |||
| 659 | /* Same as map_keymap, but does it right, properly eliminating duplicate | 651 | /* Same as map_keymap, but does it right, properly eliminating duplicate |
| 660 | bindings due to inheritance. */ | 652 | bindings due to inheritance. */ |
| 661 | void | 653 | void |
| @@ -1998,7 +1990,6 @@ then the value includes only maps for prefixes that start with PREFIX. */) | |||
| 1998 | } | 1990 | } |
| 1999 | return maps; | 1991 | return maps; |
| 2000 | } | 1992 | } |
| 2001 | static Lisp_Object Qsingle_key_description, Qkey_description; | ||
| 2002 | 1993 | ||
| 2003 | /* This function cannot GC. */ | 1994 | /* This function cannot GC. */ |
| 2004 | 1995 | ||
| @@ -3734,12 +3725,15 @@ be preferred. */); | |||
| 3734 | Vwhere_is_preferred_modifier = Qnil; | 3725 | Vwhere_is_preferred_modifier = Qnil; |
| 3735 | where_is_preferred_modifier = 0; | 3726 | where_is_preferred_modifier = 0; |
| 3736 | 3727 | ||
| 3728 | DEFSYM (Qmenu_bar, "menu-bar"); | ||
| 3729 | DEFSYM (Qmode_line, "mode-line"); | ||
| 3730 | |||
| 3737 | staticpro (&Vmouse_events); | 3731 | staticpro (&Vmouse_events); |
| 3738 | Vmouse_events = listn (CONSTYPE_PURE, 9, | 3732 | Vmouse_events = listn (CONSTYPE_PURE, 9, |
| 3739 | intern_c_string ("menu-bar"), | 3733 | Qmenu_bar, |
| 3740 | intern_c_string ("tool-bar"), | 3734 | intern_c_string ("tool-bar"), |
| 3741 | intern_c_string ("header-line"), | 3735 | intern_c_string ("header-line"), |
| 3742 | intern_c_string ("mode-line"), | 3736 | Qmode_line, |
| 3743 | intern_c_string ("mouse-1"), | 3737 | intern_c_string ("mouse-1"), |
| 3744 | intern_c_string ("mouse-2"), | 3738 | intern_c_string ("mouse-2"), |
| 3745 | intern_c_string ("mouse-3"), | 3739 | intern_c_string ("mouse-3"), |
| @@ -3748,6 +3742,9 @@ be preferred. */); | |||
| 3748 | 3742 | ||
| 3749 | DEFSYM (Qsingle_key_description, "single-key-description"); | 3743 | DEFSYM (Qsingle_key_description, "single-key-description"); |
| 3750 | DEFSYM (Qkey_description, "key-description"); | 3744 | DEFSYM (Qkey_description, "key-description"); |
| 3745 | |||
| 3746 | /* Keymap used for minibuffers when doing completion. */ | ||
| 3747 | /* Keymap used for minibuffers when doing completion and require a match. */ | ||
| 3751 | DEFSYM (Qkeymapp, "keymapp"); | 3748 | DEFSYM (Qkeymapp, "keymapp"); |
| 3752 | DEFSYM (Qnon_ascii, "non-ascii"); | 3749 | DEFSYM (Qnon_ascii, "non-ascii"); |
| 3753 | DEFSYM (Qmenu_item, "menu-item"); | 3750 | DEFSYM (Qmenu_item, "menu-item"); |
diff --git a/src/keymap.h b/src/keymap.h index 4649acb719f..215dd3f289f 100644 --- a/src/keymap.h +++ b/src/keymap.h | |||
| @@ -30,9 +30,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 30 | #define KEY_DESCRIPTION_SIZE ((2 * 6) + 1 + (CHARACTERBITS / 3) + 1 + 1) | 30 | #define KEY_DESCRIPTION_SIZE ((2 * 6) + 1 + (CHARACTERBITS / 3) + 1 + 1) |
| 31 | 31 | ||
| 32 | #define KEYMAPP(m) (!NILP (get_keymap (m, false, false))) | 32 | #define KEYMAPP(m) (!NILP (get_keymap (m, false, false))) |
| 33 | extern Lisp_Object Qkeymap, Qmenu_bar; | ||
| 34 | extern Lisp_Object Qremap; | ||
| 35 | extern Lisp_Object Qmenu_item; | ||
| 36 | extern Lisp_Object current_global_map; | 33 | extern Lisp_Object current_global_map; |
| 37 | extern char *push_key_description (EMACS_INT, char *); | 34 | extern char *push_key_description (EMACS_INT, char *); |
| 38 | extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool); | 35 | extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool); |
diff --git a/src/lisp.h b/src/lisp.h index d416661e5f4..9e1f1501464 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -233,8 +233,8 @@ extern bool suppress_checking EXTERNALLY_VISIBLE; | |||
| 233 | 233 | ||
| 234 | USE_LSB_TAG not only requires the least 3 bits of pointers returned by | 234 | USE_LSB_TAG not only requires the least 3 bits of pointers returned by |
| 235 | malloc to be 0 but also needs to be able to impose a mult-of-8 alignment | 235 | malloc to be 0 but also needs to be able to impose a mult-of-8 alignment |
| 236 | on the few static Lisp_Objects used: all the defsubr as well | 236 | on the few static Lisp_Objects used: lispsym, all the defsubr, and |
| 237 | as the two special buffers buffer_defaults and buffer_local_symbols. */ | 237 | the two special buffers buffer_defaults and buffer_local_symbols. */ |
| 238 | 238 | ||
| 239 | enum Lisp_Bits | 239 | enum Lisp_Bits |
| 240 | { | 240 | { |
| @@ -354,9 +354,8 @@ error !; | |||
| 354 | #define lisp_h_XCONS(a) \ | 354 | #define lisp_h_XCONS(a) \ |
| 355 | (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) | 355 | (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) |
| 356 | #define lisp_h_XHASH(a) XUINT (a) | 356 | #define lisp_h_XHASH(a) XUINT (a) |
| 357 | #define lisp_h_XPNTR(a) ((void *) (intptr_t) (XLI (a) & VALMASK)) | 357 | #define lisp_h_XPNTR(a) \ |
| 358 | #define lisp_h_XSYMBOL(a) \ | 358 | (SYMBOLP (a) ? XSYMBOL (a) : (void *) ((intptr_t) (XLI (a) & VALMASK))) |
| 359 | (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) | ||
| 360 | #ifndef GC_CHECK_CONS_LIST | 359 | #ifndef GC_CHECK_CONS_LIST |
| 361 | # define lisp_h_check_cons_list() ((void) 0) | 360 | # define lisp_h_check_cons_list() ((void) 0) |
| 362 | #endif | 361 | #endif |
| @@ -365,8 +364,12 @@ error !; | |||
| 365 | XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0)) | 364 | XIL ((EMACS_INT) (((EMACS_UINT) (n) << INTTYPEBITS) + Lisp_Int0)) |
| 366 | # define lisp_h_XFASTINT(a) XINT (a) | 365 | # define lisp_h_XFASTINT(a) XINT (a) |
| 367 | # define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS) | 366 | # define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS) |
| 367 | # define lisp_h_XSYMBOL(a) \ | ||
| 368 | (eassert (SYMBOLP (a)), \ | ||
| 369 | (struct Lisp_Symbol *) ((uintptr_t) XLI (a) - Lisp_Symbol \ | ||
| 370 | + (char *) lispsym)) | ||
| 368 | # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) | 371 | # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) |
| 369 | # define lisp_h_XUNTAG(a, type) ((void *) (XLI (a) - (type))) | 372 | # define lisp_h_XUNTAG(a, type) ((void *) (intptr_t) (XLI (a) - (type))) |
| 370 | #endif | 373 | #endif |
| 371 | 374 | ||
| 372 | /* When compiling via gcc -O0, define the key operations as macros, as | 375 | /* When compiling via gcc -O0, define the key operations as macros, as |
| @@ -398,7 +401,6 @@ error !; | |||
| 398 | # define XCONS(a) lisp_h_XCONS (a) | 401 | # define XCONS(a) lisp_h_XCONS (a) |
| 399 | # define XHASH(a) lisp_h_XHASH (a) | 402 | # define XHASH(a) lisp_h_XHASH (a) |
| 400 | # define XPNTR(a) lisp_h_XPNTR (a) | 403 | # define XPNTR(a) lisp_h_XPNTR (a) |
| 401 | # define XSYMBOL(a) lisp_h_XSYMBOL (a) | ||
| 402 | # ifndef GC_CHECK_CONS_LIST | 404 | # ifndef GC_CHECK_CONS_LIST |
| 403 | # define check_cons_list() lisp_h_check_cons_list () | 405 | # define check_cons_list() lisp_h_check_cons_list () |
| 404 | # endif | 406 | # endif |
| @@ -406,6 +408,7 @@ error !; | |||
| 406 | # define make_number(n) lisp_h_make_number (n) | 408 | # define make_number(n) lisp_h_make_number (n) |
| 407 | # define XFASTINT(a) lisp_h_XFASTINT (a) | 409 | # define XFASTINT(a) lisp_h_XFASTINT (a) |
| 408 | # define XINT(a) lisp_h_XINT (a) | 410 | # define XINT(a) lisp_h_XINT (a) |
| 411 | # define XSYMBOL(a) lisp_h_XSYMBOL (a) | ||
| 409 | # define XTYPE(a) lisp_h_XTYPE (a) | 412 | # define XTYPE(a) lisp_h_XTYPE (a) |
| 410 | # define XUNTAG(a, type) lisp_h_XUNTAG (a, type) | 413 | # define XUNTAG(a, type) lisp_h_XUNTAG (a, type) |
| 411 | # endif | 414 | # endif |
| @@ -447,20 +450,20 @@ error !; | |||
| 447 | 450 | ||
| 448 | enum Lisp_Type | 451 | enum Lisp_Type |
| 449 | { | 452 | { |
| 450 | /* Integer. XINT (obj) is the integer value. */ | ||
| 451 | Lisp_Int0 = 0, | ||
| 452 | Lisp_Int1 = USE_LSB_TAG ? 1 << INTTYPEBITS : 1, | ||
| 453 | |||
| 454 | /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ | 453 | /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */ |
| 455 | Lisp_Symbol = 2, | 454 | Lisp_Symbol = 0, |
| 456 | 455 | ||
| 457 | /* Miscellaneous. XMISC (object) points to a union Lisp_Misc, | 456 | /* Miscellaneous. XMISC (object) points to a union Lisp_Misc, |
| 458 | whose first member indicates the subtype. */ | 457 | whose first member indicates the subtype. */ |
| 459 | Lisp_Misc = 3, | 458 | Lisp_Misc = 1, |
| 459 | |||
| 460 | /* Integer. XINT (obj) is the integer value. */ | ||
| 461 | Lisp_Int0 = 2, | ||
| 462 | Lisp_Int1 = USE_LSB_TAG ? 6 : 3, | ||
| 460 | 463 | ||
| 461 | /* String. XSTRING (object) points to a struct Lisp_String. | 464 | /* String. XSTRING (object) points to a struct Lisp_String. |
| 462 | The length of the string, and its contents, are stored therein. */ | 465 | The length of the string, and its contents, are stored therein. */ |
| 463 | Lisp_String = USE_LSB_TAG ? 1 : 1 << INTTYPEBITS, | 466 | Lisp_String = 4, |
| 464 | 467 | ||
| 465 | /* Vector of Lisp objects, or something resembling it. | 468 | /* Vector of Lisp objects, or something resembling it. |
| 466 | XVECTOR (object) points to a struct Lisp_Vector, which contains | 469 | XVECTOR (object) points to a struct Lisp_Vector, which contains |
| @@ -469,7 +472,7 @@ enum Lisp_Type | |||
| 469 | Lisp_Vectorlike = 5, | 472 | Lisp_Vectorlike = 5, |
| 470 | 473 | ||
| 471 | /* Cons. XCONS (object) points to a struct Lisp_Cons. */ | 474 | /* Cons. XCONS (object) points to a struct Lisp_Cons. */ |
| 472 | Lisp_Cons = 6, | 475 | Lisp_Cons = USE_LSB_TAG ? 3 : 6, |
| 473 | 476 | ||
| 474 | Lisp_Float = 7 | 477 | Lisp_Float = 7 |
| 475 | }; | 478 | }; |
| @@ -562,7 +565,7 @@ enum Lisp_Fwd_Type | |||
| 562 | 565 | ||
| 563 | typedef struct { EMACS_INT i; } Lisp_Object; | 566 | typedef struct { EMACS_INT i; } Lisp_Object; |
| 564 | 567 | ||
| 565 | #define LISP_INITIALLY_ZERO {0} | 568 | #define LISP_INITIALLY(i) {i} |
| 566 | 569 | ||
| 567 | #undef CHECK_LISP_OBJECT_TYPE | 570 | #undef CHECK_LISP_OBJECT_TYPE |
| 568 | enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true }; | 571 | enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true }; |
| @@ -571,9 +574,11 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true }; | |||
| 571 | /* If a struct type is not wanted, define Lisp_Object as just a number. */ | 574 | /* If a struct type is not wanted, define Lisp_Object as just a number. */ |
| 572 | 575 | ||
| 573 | typedef EMACS_INT Lisp_Object; | 576 | typedef EMACS_INT Lisp_Object; |
| 574 | #define LISP_INITIALLY_ZERO 0 | 577 | #define LISP_INITIALLY(i) (i) |
| 575 | enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; | 578 | enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; |
| 576 | #endif /* CHECK_LISP_OBJECT_TYPE */ | 579 | #endif /* CHECK_LISP_OBJECT_TYPE */ |
| 580 | |||
| 581 | #define LISP_INITIALLY_ZERO LISP_INITIALLY (0) | ||
| 577 | 582 | ||
| 578 | /* Forward declarations. */ | 583 | /* Forward declarations. */ |
| 579 | 584 | ||
| @@ -604,18 +609,15 @@ INLINE bool (SYMBOLP) (Lisp_Object); | |||
| 604 | INLINE bool (VECTORLIKEP) (Lisp_Object); | 609 | INLINE bool (VECTORLIKEP) (Lisp_Object); |
| 605 | INLINE bool WINDOWP (Lisp_Object); | 610 | INLINE bool WINDOWP (Lisp_Object); |
| 606 | 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); | ||
| 613 | INLINE enum Lisp_Type (XTYPE) (Lisp_Object); | ||
| 614 | INLINE void *(XUNTAG) (Lisp_Object, int); | ||
| 607 | 615 | ||
| 608 | /* Defined in chartab.c. */ | 616 | /* Defined in chartab.c. */ |
| 609 | extern Lisp_Object char_table_ref (Lisp_Object, int); | 617 | extern Lisp_Object char_table_ref (Lisp_Object, int); |
| 610 | extern void char_table_set (Lisp_Object, int, Lisp_Object); | 618 | extern void char_table_set (Lisp_Object, int, Lisp_Object); |
| 611 | 619 | ||
| 612 | /* Defined in data.c. */ | 620 | /* Defined in data.c. */ |
| 613 | extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p; | ||
| 614 | extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil; | ||
| 615 | extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qt, Qvectorp; | ||
| 616 | extern Lisp_Object Qbool_vector_p; | ||
| 617 | extern Lisp_Object Qvector_or_char_table_p, Qwholenump; | ||
| 618 | extern Lisp_Object Qwindow; | ||
| 619 | extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); | 621 | extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); |
| 620 | extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); | 622 | extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); |
| 621 | 623 | ||
| @@ -625,22 +627,122 @@ extern bool might_dump; | |||
| 625 | Used during startup to detect startup of dumped Emacs. */ | 627 | Used during startup to detect startup of dumped Emacs. */ |
| 626 | extern bool initialized; | 628 | extern bool initialized; |
| 627 | 629 | ||
| 628 | /* Defined in eval.c. */ | ||
| 629 | extern Lisp_Object Qautoload; | ||
| 630 | |||
| 631 | /* Defined in floatfns.c. */ | 630 | /* Defined in floatfns.c. */ |
| 632 | extern double extract_float (Lisp_Object); | 631 | extern double extract_float (Lisp_Object); |
| 633 | 632 | ||
| 634 | /* Defined in process.c. */ | 633 | |
| 635 | extern Lisp_Object Qprocessp; | 634 | /* Interned state of a symbol. */ |
| 635 | |||
| 636 | enum symbol_interned | ||
| 637 | { | ||
| 638 | SYMBOL_UNINTERNED = 0, | ||
| 639 | SYMBOL_INTERNED = 1, | ||
| 640 | SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2 | ||
| 641 | }; | ||
| 636 | 642 | ||
| 637 | /* Defined in window.c. */ | 643 | enum symbol_redirect |
| 638 | extern Lisp_Object Qwindowp; | 644 | { |
| 645 | SYMBOL_PLAINVAL = 4, | ||
| 646 | SYMBOL_VARALIAS = 1, | ||
| 647 | SYMBOL_LOCALIZED = 2, | ||
| 648 | SYMBOL_FORWARDED = 3 | ||
| 649 | }; | ||
| 650 | |||
| 651 | struct Lisp_Symbol | ||
| 652 | { | ||
| 653 | bool_bf gcmarkbit : 1; | ||
| 654 | |||
| 655 | /* Indicates where the value can be found: | ||
| 656 | 0 : it's a plain var, the value is in the `value' field. | ||
| 657 | 1 : it's a varalias, the value is really in the `alias' symbol. | ||
| 658 | 2 : it's a localized var, the value is in the `blv' object. | ||
| 659 | 3 : it's a forwarding variable, the value is in `forward'. */ | ||
| 660 | ENUM_BF (symbol_redirect) redirect : 3; | ||
| 661 | |||
| 662 | /* Non-zero means symbol is constant, i.e. changing its value | ||
| 663 | should signal an error. If the value is 3, then the var | ||
| 664 | can be changed, but only by `defconst'. */ | ||
| 665 | unsigned constant : 2; | ||
| 666 | |||
| 667 | /* Interned state of the symbol. This is an enumerator from | ||
| 668 | enum symbol_interned. */ | ||
| 669 | unsigned interned : 2; | ||
| 670 | |||
| 671 | /* True means that this variable has been explicitly declared | ||
| 672 | special (with `defvar' etc), and shouldn't be lexically bound. */ | ||
| 673 | bool_bf declared_special : 1; | ||
| 674 | |||
| 675 | /* True if pointed to from purespace and hence can't be GC'd. */ | ||
| 676 | bool_bf pinned : 1; | ||
| 677 | |||
| 678 | /* The symbol's name, as a Lisp string. */ | ||
| 679 | Lisp_Object name; | ||
| 680 | |||
| 681 | /* Value of the symbol or Qunbound if unbound. Which alternative of the | ||
| 682 | union is used depends on the `redirect' field above. */ | ||
| 683 | union { | ||
| 684 | Lisp_Object value; | ||
| 685 | struct Lisp_Symbol *alias; | ||
| 686 | struct Lisp_Buffer_Local_Value *blv; | ||
| 687 | union Lisp_Fwd *fwd; | ||
| 688 | } val; | ||
| 689 | |||
| 690 | /* Function value of the symbol or Qnil if not fboundp. */ | ||
| 691 | Lisp_Object function; | ||
| 692 | |||
| 693 | /* The symbol's property list. */ | ||
| 694 | Lisp_Object plist; | ||
| 695 | |||
| 696 | /* Next symbol in obarray bucket, if the symbol is interned. */ | ||
| 697 | struct Lisp_Symbol *next; | ||
| 698 | }; | ||
| 699 | |||
| 700 | /* Declare a Lisp-callable function. The MAXARGS parameter has the same | ||
| 701 | meaning as in the DEFUN macro, and is used to construct a prototype. */ | ||
| 702 | /* We can use the same trick as in the DEFUN macro to generate the | ||
| 703 | appropriate prototype. */ | ||
| 704 | #define EXFUN(fnname, maxargs) \ | ||
| 705 | extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs | ||
| 706 | |||
| 707 | /* Note that the weird token-substitution semantics of ANSI C makes | ||
| 708 | this work for MANY and UNEVALLED. */ | ||
| 709 | #define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *) | ||
| 710 | #define DEFUN_ARGS_UNEVALLED (Lisp_Object) | ||
| 711 | #define DEFUN_ARGS_0 (void) | ||
| 712 | #define DEFUN_ARGS_1 (Lisp_Object) | ||
| 713 | #define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object) | ||
| 714 | #define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object) | ||
| 715 | #define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) | ||
| 716 | #define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ | ||
| 717 | Lisp_Object) | ||
| 718 | #define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ | ||
| 719 | Lisp_Object, Lisp_Object) | ||
| 720 | #define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ | ||
| 721 | Lisp_Object, Lisp_Object, Lisp_Object) | ||
| 722 | #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ | ||
| 723 | Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) | ||
| 724 | |||
| 725 | /* Yield an integer that contains TAG along with PTR. */ | ||
| 726 | #define TAG_PTR(tag, ptr) \ | ||
| 727 | ((USE_LSB_TAG ? (tag) : (EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (ptr)) | ||
| 728 | |||
| 729 | /* Yield an integer that contains a symbol tag along with OFFSET. | ||
| 730 | OFFSET should be the offset in bytes from 'lispsym' to the symbol. */ | ||
| 731 | #define TAG_SYMOFFSET(offset) \ | ||
| 732 | TAG_PTR (Lisp_Symbol, \ | ||
| 733 | ((uintptr_t) (offset) >> (USE_LSB_TAG ? 0 : GCTYPEBITS))) | ||
| 734 | |||
| 735 | /* Declare extern constants for Lisp symbols. These can be helpful | ||
| 736 | when using a debugger like GDB, on older platforms where the debug | ||
| 737 | format does not represent C macros. */ | ||
| 738 | #define DEFINE_LISP_SYMBOL_BEGIN(name) \ | ||
| 739 | DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) | ||
| 740 | #define DEFINE_LISP_SYMBOL_END(name) \ | ||
| 741 | DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (TAG_SYMOFFSET (i##name \ | ||
| 742 | * sizeof *lispsym))) | ||
| 743 | |||
| 744 | #include "globals.h" | ||
| 639 | 745 | ||
| 640 | /* Defined in xdisp.c. */ | ||
| 641 | extern Lisp_Object Qimage; | ||
| 642 | extern Lisp_Object Qfontification_functions; | ||
| 643 | |||
| 644 | /* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa. | 746 | /* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa. |
| 645 | At the machine level, these operations are no-ops. */ | 747 | At the machine level, these operations are no-ops. */ |
| 646 | LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o)) | 748 | LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o)) |
| @@ -731,6 +833,7 @@ LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a)) | |||
| 731 | LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n)) | 833 | LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n)) |
| 732 | LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a)) | 834 | LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a)) |
| 733 | LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a)) | 835 | LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a)) |
| 836 | LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a)) | ||
| 734 | LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a)) | 837 | LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a)) |
| 735 | LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type)) | 838 | LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type)) |
| 736 | 839 | ||
| @@ -785,6 +888,17 @@ XFASTINT (Lisp_Object a) | |||
| 785 | return n; | 888 | return n; |
| 786 | } | 889 | } |
| 787 | 890 | ||
| 891 | /* Extract A's value as a symbol. */ | ||
| 892 | INLINE struct Lisp_Symbol * | ||
| 893 | XSYMBOL (Lisp_Object a) | ||
| 894 | { | ||
| 895 | uintptr_t i = (uintptr_t) XUNTAG (a, Lisp_Symbol); | ||
| 896 | if (! USE_LSB_TAG) | ||
| 897 | i <<= GCTYPEBITS; | ||
| 898 | void *p = (char *) lispsym + i; | ||
| 899 | return p; | ||
| 900 | } | ||
| 901 | |||
| 788 | /* Extract A's type. */ | 902 | /* Extract A's type. */ |
| 789 | INLINE enum Lisp_Type | 903 | INLINE enum Lisp_Type |
| 790 | XTYPE (Lisp_Object a) | 904 | XTYPE (Lisp_Object a) |
| @@ -797,12 +911,8 @@ XTYPE (Lisp_Object a) | |||
| 797 | INLINE void * | 911 | INLINE void * |
| 798 | XUNTAG (Lisp_Object a, int type) | 912 | XUNTAG (Lisp_Object a, int type) |
| 799 | { | 913 | { |
| 800 | if (USE_LSB_TAG) | 914 | intptr_t i = USE_LSB_TAG ? XLI (a) - type : XLI (a) & VALMASK; |
| 801 | { | 915 | return (void *) i; |
| 802 | intptr_t i = XLI (a) - type; | ||
| 803 | return (void *) i; | ||
| 804 | } | ||
| 805 | return XPNTR (a); | ||
| 806 | } | 916 | } |
| 807 | 917 | ||
| 808 | #endif /* ! USE_LSB_TAG */ | 918 | #endif /* ! USE_LSB_TAG */ |
| @@ -864,7 +974,9 @@ XSTRING (Lisp_Object a) | |||
| 864 | return XUNTAG (a, Lisp_String); | 974 | return XUNTAG (a, Lisp_String); |
| 865 | } | 975 | } |
| 866 | 976 | ||
| 867 | LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a)) | 977 | /* The index of the C-defined Lisp symbol SYM. |
| 978 | This can be used in a static initializer. */ | ||
| 979 | #define SYMBOL_INDEX(sym) i##sym | ||
| 868 | 980 | ||
| 869 | INLINE struct Lisp_Float * | 981 | INLINE struct Lisp_Float * |
| 870 | XFLOAT (Lisp_Object a) | 982 | XFLOAT (Lisp_Object a) |
| @@ -935,14 +1047,26 @@ XBOOL_VECTOR (Lisp_Object a) | |||
| 935 | INLINE Lisp_Object | 1047 | INLINE Lisp_Object |
| 936 | make_lisp_ptr (void *ptr, enum Lisp_Type type) | 1048 | make_lisp_ptr (void *ptr, enum Lisp_Type type) |
| 937 | { | 1049 | { |
| 938 | EMACS_UINT utype = type; | 1050 | Lisp_Object a = XIL (TAG_PTR (type, ptr)); |
| 939 | EMACS_UINT typebits = USE_LSB_TAG ? type : utype << VALBITS; | ||
| 940 | Lisp_Object a = XIL (typebits | (uintptr_t) ptr); | ||
| 941 | eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr); | 1051 | eassert (XTYPE (a) == type && XUNTAG (a, type) == ptr); |
| 942 | return a; | 1052 | return a; |
| 943 | } | 1053 | } |
| 944 | 1054 | ||
| 945 | INLINE Lisp_Object | 1055 | INLINE Lisp_Object |
| 1056 | make_lisp_symbol (struct Lisp_Symbol *sym) | ||
| 1057 | { | ||
| 1058 | Lisp_Object a = XIL (TAG_SYMOFFSET ((char *) sym - (char *) lispsym)); | ||
| 1059 | eassert (XSYMBOL (a) == sym); | ||
| 1060 | return a; | ||
| 1061 | } | ||
| 1062 | |||
| 1063 | INLINE Lisp_Object | ||
| 1064 | builtin_lisp_symbol (int index) | ||
| 1065 | { | ||
| 1066 | return make_lisp_symbol (lispsym + index); | ||
| 1067 | } | ||
| 1068 | |||
| 1069 | INLINE Lisp_Object | ||
| 946 | make_lisp_proc (struct Lisp_Process *p) | 1070 | make_lisp_proc (struct Lisp_Process *p) |
| 947 | { | 1071 | { |
| 948 | return make_lisp_ptr (p, Lisp_Vectorlike); | 1072 | return make_lisp_ptr (p, Lisp_Vectorlike); |
| @@ -953,7 +1077,7 @@ make_lisp_proc (struct Lisp_Process *p) | |||
| 953 | #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) | 1077 | #define XSETCONS(a, b) ((a) = make_lisp_ptr (b, Lisp_Cons)) |
| 954 | #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) | 1078 | #define XSETVECTOR(a, b) ((a) = make_lisp_ptr (b, Lisp_Vectorlike)) |
| 955 | #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) | 1079 | #define XSETSTRING(a, b) ((a) = make_lisp_ptr (b, Lisp_String)) |
| 956 | #define XSETSYMBOL(a, b) ((a) = make_lisp_ptr (b, Lisp_Symbol)) | 1080 | #define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) |
| 957 | #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) | 1081 | #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) |
| 958 | #define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc)) | 1082 | #define XSETMISC(a, b) ((a) = make_lisp_ptr (b, Lisp_Misc)) |
| 959 | 1083 | ||
| @@ -991,6 +1115,25 @@ make_lisp_proc (struct Lisp_Process *p) | |||
| 991 | #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) | 1115 | #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) |
| 992 | #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) | 1116 | #define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) |
| 993 | 1117 | ||
| 1118 | /* Efficiently convert a pointer to a Lisp object and back. The | ||
| 1119 | pointer is represented as a Lisp integer, so the garbage collector | ||
| 1120 | does not know about it. The pointer should not have both Lisp_Int1 | ||
| 1121 | bits set, which makes this conversion inherently unportable. */ | ||
| 1122 | |||
| 1123 | INLINE void * | ||
| 1124 | XINTPTR (Lisp_Object a) | ||
| 1125 | { | ||
| 1126 | return XUNTAG (a, Lisp_Int0); | ||
| 1127 | } | ||
| 1128 | |||
| 1129 | INLINE Lisp_Object | ||
| 1130 | make_pointer_integer (void *p) | ||
| 1131 | { | ||
| 1132 | Lisp_Object a = XIL (TAG_PTR (Lisp_Int0, p)); | ||
| 1133 | eassert (INTEGERP (a) && XINTPTR (a) == p); | ||
| 1134 | return a; | ||
| 1135 | } | ||
| 1136 | |||
| 994 | /* Type checking. */ | 1137 | /* Type checking. */ |
| 995 | 1138 | ||
| 996 | LISP_MACRO_DEFUN_VOID (CHECK_TYPE, | 1139 | LISP_MACRO_DEFUN_VOID (CHECK_TYPE, |
| @@ -1560,72 +1703,6 @@ verify ((offsetof (struct Lisp_Sub_Char_Table, contents) | |||
| 1560 | Symbols | 1703 | Symbols |
| 1561 | ***********************************************************************/ | 1704 | ***********************************************************************/ |
| 1562 | 1705 | ||
| 1563 | /* Interned state of a symbol. */ | ||
| 1564 | |||
| 1565 | enum symbol_interned | ||
| 1566 | { | ||
| 1567 | SYMBOL_UNINTERNED = 0, | ||
| 1568 | SYMBOL_INTERNED = 1, | ||
| 1569 | SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2 | ||
| 1570 | }; | ||
| 1571 | |||
| 1572 | enum symbol_redirect | ||
| 1573 | { | ||
| 1574 | SYMBOL_PLAINVAL = 4, | ||
| 1575 | SYMBOL_VARALIAS = 1, | ||
| 1576 | SYMBOL_LOCALIZED = 2, | ||
| 1577 | SYMBOL_FORWARDED = 3 | ||
| 1578 | }; | ||
| 1579 | |||
| 1580 | struct Lisp_Symbol | ||
| 1581 | { | ||
| 1582 | bool_bf gcmarkbit : 1; | ||
| 1583 | |||
| 1584 | /* Indicates where the value can be found: | ||
| 1585 | 0 : it's a plain var, the value is in the `value' field. | ||
| 1586 | 1 : it's a varalias, the value is really in the `alias' symbol. | ||
| 1587 | 2 : it's a localized var, the value is in the `blv' object. | ||
| 1588 | 3 : it's a forwarding variable, the value is in `forward'. */ | ||
| 1589 | ENUM_BF (symbol_redirect) redirect : 3; | ||
| 1590 | |||
| 1591 | /* Non-zero means symbol is constant, i.e. changing its value | ||
| 1592 | should signal an error. If the value is 3, then the var | ||
| 1593 | can be changed, but only by `defconst'. */ | ||
| 1594 | unsigned constant : 2; | ||
| 1595 | |||
| 1596 | /* Interned state of the symbol. This is an enumerator from | ||
| 1597 | enum symbol_interned. */ | ||
| 1598 | unsigned interned : 2; | ||
| 1599 | |||
| 1600 | /* True means that this variable has been explicitly declared | ||
| 1601 | special (with `defvar' etc), and shouldn't be lexically bound. */ | ||
| 1602 | bool_bf declared_special : 1; | ||
| 1603 | |||
| 1604 | /* True if pointed to from purespace and hence can't be GC'd. */ | ||
| 1605 | bool_bf pinned : 1; | ||
| 1606 | |||
| 1607 | /* The symbol's name, as a Lisp string. */ | ||
| 1608 | Lisp_Object name; | ||
| 1609 | |||
| 1610 | /* Value of the symbol or Qunbound if unbound. Which alternative of the | ||
| 1611 | union is used depends on the `redirect' field above. */ | ||
| 1612 | union { | ||
| 1613 | Lisp_Object value; | ||
| 1614 | struct Lisp_Symbol *alias; | ||
| 1615 | struct Lisp_Buffer_Local_Value *blv; | ||
| 1616 | union Lisp_Fwd *fwd; | ||
| 1617 | } val; | ||
| 1618 | |||
| 1619 | /* Function value of the symbol or Qnil if not fboundp. */ | ||
| 1620 | Lisp_Object function; | ||
| 1621 | |||
| 1622 | /* The symbol's property list. */ | ||
| 1623 | Lisp_Object plist; | ||
| 1624 | |||
| 1625 | /* Next symbol in obarray bucket, if the symbol is interned. */ | ||
| 1626 | struct Lisp_Symbol *next; | ||
| 1627 | }; | ||
| 1628 | |||
| 1629 | /* Value is name of symbol. */ | 1706 | /* Value is name of symbol. */ |
| 1630 | 1707 | ||
| 1631 | LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym)) | 1708 | LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym)) |
| @@ -1699,8 +1776,9 @@ SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) | |||
| 1699 | 1776 | ||
| 1700 | LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym)) | 1777 | LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym)) |
| 1701 | 1778 | ||
| 1702 | #define DEFSYM(sym, name) \ | 1779 | /* Placeholder for make-docfile to process. The actual symbol |
| 1703 | do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (false) | 1780 | definition is done by lread.c's defsym. */ |
| 1781 | #define DEFSYM(sym, name) /* empty */ | ||
| 1704 | 1782 | ||
| 1705 | 1783 | ||
| 1706 | /*********************************************************************** | 1784 | /*********************************************************************** |
| @@ -2694,24 +2772,6 @@ CHECK_NUMBER_CDR (Lisp_Object x) | |||
| 2694 | Lisp_Object fnname | 2772 | Lisp_Object fnname |
| 2695 | #endif | 2773 | #endif |
| 2696 | 2774 | ||
| 2697 | /* Note that the weird token-substitution semantics of ANSI C makes | ||
| 2698 | this work for MANY and UNEVALLED. */ | ||
| 2699 | #define DEFUN_ARGS_MANY (ptrdiff_t, Lisp_Object *) | ||
| 2700 | #define DEFUN_ARGS_UNEVALLED (Lisp_Object) | ||
| 2701 | #define DEFUN_ARGS_0 (void) | ||
| 2702 | #define DEFUN_ARGS_1 (Lisp_Object) | ||
| 2703 | #define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object) | ||
| 2704 | #define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object) | ||
| 2705 | #define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) | ||
| 2706 | #define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ | ||
| 2707 | Lisp_Object) | ||
| 2708 | #define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ | ||
| 2709 | Lisp_Object, Lisp_Object) | ||
| 2710 | #define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ | ||
| 2711 | Lisp_Object, Lisp_Object, Lisp_Object) | ||
| 2712 | #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ | ||
| 2713 | Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) | ||
| 2714 | |||
| 2715 | /* True if OBJ is a Lisp function. */ | 2775 | /* True if OBJ is a Lisp function. */ |
| 2716 | INLINE bool | 2776 | INLINE bool |
| 2717 | FUNCTIONP (Lisp_Object obj) | 2777 | FUNCTIONP (Lisp_Object obj) |
| @@ -3260,15 +3320,6 @@ extern int gcpro_level; | |||
| 3260 | 3320 | ||
| 3261 | void staticpro (Lisp_Object *); | 3321 | void staticpro (Lisp_Object *); |
| 3262 | 3322 | ||
| 3263 | /* Declare a Lisp-callable function. The MAXARGS parameter has the same | ||
| 3264 | meaning as in the DEFUN macro, and is used to construct a prototype. */ | ||
| 3265 | /* We can use the same trick as in the DEFUN macro to generate the | ||
| 3266 | appropriate prototype. */ | ||
| 3267 | #define EXFUN(fnname, maxargs) \ | ||
| 3268 | extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs | ||
| 3269 | |||
| 3270 | #include "globals.h" | ||
| 3271 | |||
| 3272 | /* Forward declarations for prototypes. */ | 3323 | /* Forward declarations for prototypes. */ |
| 3273 | struct window; | 3324 | struct window; |
| 3274 | struct frame; | 3325 | struct frame; |
| @@ -3387,30 +3438,6 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) | |||
| 3387 | } | 3438 | } |
| 3388 | 3439 | ||
| 3389 | /* Defined in data.c. */ | 3440 | /* Defined in data.c. */ |
| 3390 | extern Lisp_Object Qquote, Qunbound; | ||
| 3391 | extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; | ||
| 3392 | extern Lisp_Object Qerror, Qquit, Qargs_out_of_range; | ||
| 3393 | extern Lisp_Object Qvoid_variable, Qvoid_function; | ||
| 3394 | extern Lisp_Object Qinvalid_read_syntax; | ||
| 3395 | extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; | ||
| 3396 | extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive; | ||
| 3397 | extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; | ||
| 3398 | extern Lisp_Object Qtext_read_only; | ||
| 3399 | extern Lisp_Object Qinteractive_form; | ||
| 3400 | extern Lisp_Object Qcircular_list; | ||
| 3401 | extern Lisp_Object Qsequencep; | ||
| 3402 | extern Lisp_Object Qchar_or_string_p, Qinteger_or_marker_p; | ||
| 3403 | extern Lisp_Object Qfboundp; | ||
| 3404 | |||
| 3405 | extern Lisp_Object Qcdr; | ||
| 3406 | |||
| 3407 | extern Lisp_Object Qrange_error, Qoverflow_error; | ||
| 3408 | |||
| 3409 | extern Lisp_Object Qnumber_or_marker_p; | ||
| 3410 | |||
| 3411 | extern Lisp_Object Qbuffer, Qinteger, Qsymbol; | ||
| 3412 | |||
| 3413 | /* Defined in data.c. */ | ||
| 3414 | extern Lisp_Object indirect_function (Lisp_Object); | 3441 | extern Lisp_Object indirect_function (Lisp_Object); |
| 3415 | extern Lisp_Object find_symbol_value (Lisp_Object); | 3442 | extern Lisp_Object find_symbol_value (Lisp_Object); |
| 3416 | enum Arith_Comparison { | 3443 | enum Arith_Comparison { |
| @@ -3466,7 +3493,6 @@ extern void syms_of_cmds (void); | |||
| 3466 | extern void keys_of_cmds (void); | 3493 | extern void keys_of_cmds (void); |
| 3467 | 3494 | ||
| 3468 | /* Defined in coding.c. */ | 3495 | /* Defined in coding.c. */ |
| 3469 | extern Lisp_Object Qcharset; | ||
| 3470 | extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t, | 3496 | extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t, |
| 3471 | ptrdiff_t, bool, bool, Lisp_Object); | 3497 | ptrdiff_t, bool, bool, Lisp_Object); |
| 3472 | extern void init_coding (void); | 3498 | extern void init_coding (void); |
| @@ -3490,14 +3516,10 @@ extern void init_syntax_once (void); | |||
| 3490 | extern void syms_of_syntax (void); | 3516 | extern void syms_of_syntax (void); |
| 3491 | 3517 | ||
| 3492 | /* Defined in fns.c. */ | 3518 | /* Defined in fns.c. */ |
| 3493 | extern Lisp_Object QCrehash_size, QCrehash_threshold; | ||
| 3494 | enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; | 3519 | enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; |
| 3495 | extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; | 3520 | extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; |
| 3496 | extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); | 3521 | extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); |
| 3497 | extern void sweep_weak_hash_tables (void); | 3522 | extern void sweep_weak_hash_tables (void); |
| 3498 | extern Lisp_Object Qcursor_in_echo_area; | ||
| 3499 | extern Lisp_Object Qstring_lessp; | ||
| 3500 | extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq; | ||
| 3501 | EMACS_UINT hash_string (char const *, ptrdiff_t); | 3523 | EMACS_UINT hash_string (char const *, ptrdiff_t); |
| 3502 | EMACS_UINT sxhash (Lisp_Object, int); | 3524 | EMACS_UINT sxhash (Lisp_Object, int); |
| 3503 | Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, | 3525 | Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, |
| @@ -3537,15 +3559,11 @@ extern void init_fringe_once (void); | |||
| 3537 | #endif /* HAVE_WINDOW_SYSTEM */ | 3559 | #endif /* HAVE_WINDOW_SYSTEM */ |
| 3538 | 3560 | ||
| 3539 | /* Defined in image.c. */ | 3561 | /* Defined in image.c. */ |
| 3540 | extern Lisp_Object QCascent, QCmargin, QCrelief; | ||
| 3541 | extern Lisp_Object QCconversion; | ||
| 3542 | extern int x_bitmap_mask (struct frame *, ptrdiff_t); | 3562 | extern int x_bitmap_mask (struct frame *, ptrdiff_t); |
| 3543 | extern void reset_image_types (void); | 3563 | extern void reset_image_types (void); |
| 3544 | extern void syms_of_image (void); | 3564 | extern void syms_of_image (void); |
| 3545 | 3565 | ||
| 3546 | /* Defined in insdel.c. */ | 3566 | /* Defined in insdel.c. */ |
| 3547 | extern Lisp_Object Qinhibit_modification_hooks; | ||
| 3548 | extern Lisp_Object Qregion_extract_function; | ||
| 3549 | extern void move_gap_both (ptrdiff_t, ptrdiff_t); | 3567 | extern void move_gap_both (ptrdiff_t, ptrdiff_t); |
| 3550 | extern _Noreturn void buffer_overflow (void); | 3568 | extern _Noreturn void buffer_overflow (void); |
| 3551 | extern void make_gap (ptrdiff_t); | 3569 | extern void make_gap (ptrdiff_t); |
| @@ -3600,18 +3618,6 @@ extern Lisp_Object Vwindow_system; | |||
| 3600 | extern Lisp_Object sit_for (Lisp_Object, bool, int); | 3618 | extern Lisp_Object sit_for (Lisp_Object, bool, int); |
| 3601 | 3619 | ||
| 3602 | /* Defined in xdisp.c. */ | 3620 | /* Defined in xdisp.c. */ |
| 3603 | extern Lisp_Object Qinhibit_point_motion_hooks; | ||
| 3604 | extern Lisp_Object Qinhibit_redisplay; | ||
| 3605 | extern Lisp_Object Qmenu_bar_update_hook; | ||
| 3606 | extern Lisp_Object Qwindow_scroll_functions; | ||
| 3607 | extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map; | ||
| 3608 | extern Lisp_Object Qtext, Qboth, Qboth_horiz, Qtext_image_horiz; | ||
| 3609 | extern Lisp_Object Qspace, Qcenter, QCalign_to; | ||
| 3610 | extern Lisp_Object Qbar, Qhbar, Qhollow; | ||
| 3611 | extern Lisp_Object Qleft_margin, Qright_margin; | ||
| 3612 | extern Lisp_Object QCdata, QCfile; | ||
| 3613 | extern Lisp_Object QCmap; | ||
| 3614 | extern Lisp_Object Qrisky_local_variable; | ||
| 3615 | extern bool noninteractive_need_newline; | 3621 | extern bool noninteractive_need_newline; |
| 3616 | extern Lisp_Object echo_area_buffer[2]; | 3622 | extern Lisp_Object echo_area_buffer[2]; |
| 3617 | extern void add_to_log (const char *, Lisp_Object, Lisp_Object); | 3623 | extern void add_to_log (const char *, Lisp_Object, Lisp_Object); |
| @@ -3745,8 +3751,6 @@ build_string (const char *str) | |||
| 3745 | 3751 | ||
| 3746 | extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); | 3752 | extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); |
| 3747 | extern void make_byte_code (struct Lisp_Vector *); | 3753 | extern void make_byte_code (struct Lisp_Vector *); |
| 3748 | extern Lisp_Object Qautomatic_gc; | ||
| 3749 | extern Lisp_Object Qchar_table_extra_slots; | ||
| 3750 | extern struct Lisp_Vector *allocate_vector (EMACS_INT); | 3754 | extern struct Lisp_Vector *allocate_vector (EMACS_INT); |
| 3751 | 3755 | ||
| 3752 | /* Make an uninitialized vector for SIZE objects. NOTE: you must | 3756 | /* Make an uninitialized vector for SIZE objects. NOTE: you must |
| @@ -3850,11 +3854,8 @@ extern void syms_of_chartab (void); | |||
| 3850 | /* Defined in print.c. */ | 3854 | /* Defined in print.c. */ |
| 3851 | extern Lisp_Object Vprin1_to_string_buffer; | 3855 | extern Lisp_Object Vprin1_to_string_buffer; |
| 3852 | extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE; | 3856 | extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE; |
| 3853 | extern Lisp_Object Qstandard_output; | ||
| 3854 | extern Lisp_Object Qexternal_debugging_output; | ||
| 3855 | extern void temp_output_buffer_setup (const char *); | 3857 | extern void temp_output_buffer_setup (const char *); |
| 3856 | extern int print_level; | 3858 | extern int print_level; |
| 3857 | extern Lisp_Object Qprint_escape_newlines; | ||
| 3858 | extern void write_string (const char *, int); | 3859 | extern void write_string (const char *, int); |
| 3859 | extern void print_error_message (Lisp_Object, Lisp_Object, const char *, | 3860 | extern void print_error_message (Lisp_Object, Lisp_Object, const char *, |
| 3860 | Lisp_Object); | 3861 | Lisp_Object); |
| @@ -3878,13 +3879,11 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char const *, ptrdiff_t, | |||
| 3878 | ATTRIBUTE_FORMAT_PRINTF (5, 0); | 3879 | ATTRIBUTE_FORMAT_PRINTF (5, 0); |
| 3879 | 3880 | ||
| 3880 | /* Defined in lread.c. */ | 3881 | /* Defined in lread.c. */ |
| 3881 | extern Lisp_Object Qsize, Qvariable_documentation, Qstandard_input; | ||
| 3882 | extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; | ||
| 3883 | extern Lisp_Object Qlexical_binding; | ||
| 3884 | extern Lisp_Object check_obarray (Lisp_Object); | 3882 | extern Lisp_Object check_obarray (Lisp_Object); |
| 3885 | extern Lisp_Object intern_1 (const char *, ptrdiff_t); | 3883 | extern Lisp_Object intern_1 (const char *, ptrdiff_t); |
| 3886 | extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); | 3884 | extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); |
| 3887 | extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, ptrdiff_t); | 3885 | extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object); |
| 3886 | extern void init_symbol (Lisp_Object, Lisp_Object); | ||
| 3888 | extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); | 3887 | extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); |
| 3889 | INLINE void | 3888 | INLINE void |
| 3890 | LOADHIST_ATTACH (Lisp_Object x) | 3889 | LOADHIST_ATTACH (Lisp_Object x) |
| @@ -3916,10 +3915,8 @@ intern_c_string (const char *str) | |||
| 3916 | 3915 | ||
| 3917 | /* Defined in eval.c. */ | 3916 | /* Defined in eval.c. */ |
| 3918 | extern EMACS_INT lisp_eval_depth; | 3917 | extern EMACS_INT lisp_eval_depth; |
| 3919 | extern Lisp_Object Qexit, Qinteractive, Qcommandp, Qmacro; | ||
| 3920 | extern Lisp_Object Qinhibit_quit, Qinternal_interpreter_environment, Qclosure; | ||
| 3921 | extern Lisp_Object Qand_rest; | ||
| 3922 | extern Lisp_Object Vautoload_queue; | 3918 | extern Lisp_Object Vautoload_queue; |
| 3919 | extern Lisp_Object Vrun_hooks; | ||
| 3923 | extern Lisp_Object Vsignaling_function; | 3920 | extern Lisp_Object Vsignaling_function; |
| 3924 | extern Lisp_Object inhibit_lisp_code; | 3921 | extern Lisp_Object inhibit_lisp_code; |
| 3925 | extern struct handler *handlerlist; | 3922 | extern struct handler *handlerlist; |
| @@ -3931,7 +3928,7 @@ extern struct handler *handlerlist; | |||
| 3931 | call1 (Vrun_hooks, Qmy_funny_hook); | 3928 | call1 (Vrun_hooks, Qmy_funny_hook); |
| 3932 | 3929 | ||
| 3933 | should no longer be used. */ | 3930 | should no longer be used. */ |
| 3934 | extern Lisp_Object Vrun_hooks; | 3931 | extern void run_hook (Lisp_Object); |
| 3935 | extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object); | 3932 | extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object); |
| 3936 | extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, | 3933 | extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, |
| 3937 | Lisp_Object (*funcall) | 3934 | Lisp_Object (*funcall) |
| @@ -3992,7 +3989,6 @@ extern bool let_shadows_global_binding_p (Lisp_Object symbol); | |||
| 3992 | 3989 | ||
| 3993 | 3990 | ||
| 3994 | /* Defined in editfns.c. */ | 3991 | /* Defined in editfns.c. */ |
| 3995 | extern Lisp_Object Qfield; | ||
| 3996 | extern void insert1 (Lisp_Object); | 3992 | extern void insert1 (Lisp_Object); |
| 3997 | extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object); | 3993 | extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object); |
| 3998 | extern Lisp_Object save_excursion_save (void); | 3994 | extern Lisp_Object save_excursion_save (void); |
| @@ -4039,12 +4035,6 @@ extern void syms_of_marker (void); | |||
| 4039 | 4035 | ||
| 4040 | /* Defined in fileio.c. */ | 4036 | /* Defined in fileio.c. */ |
| 4041 | 4037 | ||
| 4042 | extern Lisp_Object Qfile_error; | ||
| 4043 | extern Lisp_Object Qfile_notify_error; | ||
| 4044 | extern Lisp_Object Qfile_exists_p; | ||
| 4045 | extern Lisp_Object Qfile_directory_p; | ||
| 4046 | extern Lisp_Object Qinsert_file_contents; | ||
| 4047 | extern Lisp_Object Qfile_name_history; | ||
| 4048 | extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object); | 4038 | extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object); |
| 4049 | extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, | 4039 | extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, |
| 4050 | Lisp_Object, Lisp_Object, Lisp_Object, | 4040 | Lisp_Object, Lisp_Object, Lisp_Object, |
| @@ -4061,7 +4051,6 @@ extern bool file_accessible_directory_p (Lisp_Object); | |||
| 4061 | extern void init_fileio (void); | 4051 | extern void init_fileio (void); |
| 4062 | extern void syms_of_fileio (void); | 4052 | extern void syms_of_fileio (void); |
| 4063 | extern Lisp_Object make_temp_name (Lisp_Object, bool); | 4053 | extern Lisp_Object make_temp_name (Lisp_Object, bool); |
| 4064 | extern Lisp_Object Qdelete_file; | ||
| 4065 | 4054 | ||
| 4066 | /* Defined in search.c. */ | 4055 | /* Defined in search.c. */ |
| 4067 | extern void shrink_regexp_cache (void); | 4056 | extern void shrink_regexp_cache (void); |
| @@ -4091,7 +4080,6 @@ extern void clear_regexp_cache (void); | |||
| 4091 | 4080 | ||
| 4092 | /* Defined in minibuf.c. */ | 4081 | /* Defined in minibuf.c. */ |
| 4093 | 4082 | ||
| 4094 | extern Lisp_Object Qcompletion_ignore_case; | ||
| 4095 | extern Lisp_Object Vminibuffer_list; | 4083 | extern Lisp_Object Vminibuffer_list; |
| 4096 | extern Lisp_Object last_minibuf_string; | 4084 | extern Lisp_Object last_minibuf_string; |
| 4097 | extern Lisp_Object get_minibuffer (EMACS_INT); | 4085 | extern Lisp_Object get_minibuffer (EMACS_INT); |
| @@ -4100,15 +4088,10 @@ extern void syms_of_minibuf (void); | |||
| 4100 | 4088 | ||
| 4101 | /* Defined in callint.c. */ | 4089 | /* Defined in callint.c. */ |
| 4102 | 4090 | ||
| 4103 | extern Lisp_Object Qminus, Qplus; | ||
| 4104 | extern Lisp_Object Qprogn; | ||
| 4105 | extern Lisp_Object Qwhen; | ||
| 4106 | extern Lisp_Object Qmouse_leave_buffer_hook; | ||
| 4107 | extern void syms_of_callint (void); | 4091 | extern void syms_of_callint (void); |
| 4108 | 4092 | ||
| 4109 | /* Defined in casefiddle.c. */ | 4093 | /* Defined in casefiddle.c. */ |
| 4110 | 4094 | ||
| 4111 | extern Lisp_Object Qidentity; | ||
| 4112 | extern void syms_of_casefiddle (void); | 4095 | extern void syms_of_casefiddle (void); |
| 4113 | extern void keys_of_casefiddle (void); | 4096 | extern void keys_of_casefiddle (void); |
| 4114 | 4097 | ||
| @@ -4122,8 +4105,6 @@ extern void syms_of_casetab (void); | |||
| 4122 | extern Lisp_Object echo_message_buffer; | 4105 | extern Lisp_Object echo_message_buffer; |
| 4123 | extern struct kboard *echo_kboard; | 4106 | extern struct kboard *echo_kboard; |
| 4124 | extern void cancel_echoing (void); | 4107 | extern void cancel_echoing (void); |
| 4125 | extern Lisp_Object Qdisabled, QCfilter; | ||
| 4126 | extern Lisp_Object Qup, Qdown; | ||
| 4127 | extern Lisp_Object last_undo_boundary; | 4108 | extern Lisp_Object last_undo_boundary; |
| 4128 | extern bool input_pending; | 4109 | extern bool input_pending; |
| 4129 | #ifdef HAVE_STACK_OVERFLOW_HANDLING | 4110 | #ifdef HAVE_STACK_OVERFLOW_HANDLING |
| @@ -4157,7 +4138,6 @@ extern bool indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT); | |||
| 4157 | extern void syms_of_indent (void); | 4138 | extern void syms_of_indent (void); |
| 4158 | 4139 | ||
| 4159 | /* Defined in frame.c. */ | 4140 | /* Defined in frame.c. */ |
| 4160 | extern Lisp_Object Qonly, Qnone; | ||
| 4161 | extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object); | 4141 | extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object); |
| 4162 | extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object); | 4142 | extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object); |
| 4163 | extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object); | 4143 | extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object); |
| @@ -4173,9 +4153,7 @@ extern bool display_arg; | |||
| 4173 | #endif | 4153 | #endif |
| 4174 | extern Lisp_Object decode_env_path (const char *, const char *, bool); | 4154 | extern Lisp_Object decode_env_path (const char *, const char *, bool); |
| 4175 | extern Lisp_Object empty_unibyte_string, empty_multibyte_string; | 4155 | extern Lisp_Object empty_unibyte_string, empty_multibyte_string; |
| 4176 | extern Lisp_Object Qfile_name_handler_alist; | ||
| 4177 | extern _Noreturn void terminate_due_to_signal (int, int); | 4156 | extern _Noreturn void terminate_due_to_signal (int, int); |
| 4178 | extern Lisp_Object Qkill_emacs; | ||
| 4179 | #ifdef WINDOWSNT | 4157 | #ifdef WINDOWSNT |
| 4180 | extern Lisp_Object Vlibrary_cache; | 4158 | extern Lisp_Object Vlibrary_cache; |
| 4181 | #endif | 4159 | #endif |
| @@ -4210,7 +4188,6 @@ extern bool inhibit_window_system; | |||
| 4210 | extern bool running_asynch_code; | 4188 | extern bool running_asynch_code; |
| 4211 | 4189 | ||
| 4212 | /* Defined in process.c. */ | 4190 | /* Defined in process.c. */ |
| 4213 | extern Lisp_Object QCtype, Qlocal; | ||
| 4214 | extern void kill_buffer_processes (Lisp_Object); | 4191 | extern void kill_buffer_processes (Lisp_Object); |
| 4215 | extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object, | 4192 | extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object, |
| 4216 | struct Lisp_Process *, int); | 4193 | struct Lisp_Process *, int); |
| @@ -4246,7 +4223,6 @@ extern void set_initial_environment (void); | |||
| 4246 | extern void syms_of_callproc (void); | 4223 | extern void syms_of_callproc (void); |
| 4247 | 4224 | ||
| 4248 | /* Defined in doc.c. */ | 4225 | /* Defined in doc.c. */ |
| 4249 | extern Lisp_Object Qfunction_documentation; | ||
| 4250 | extern Lisp_Object read_doc_string (Lisp_Object); | 4226 | extern Lisp_Object read_doc_string (Lisp_Object); |
| 4251 | extern Lisp_Object get_doc_string (Lisp_Object, bool, bool); | 4227 | extern Lisp_Object get_doc_string (Lisp_Object, bool, bool); |
| 4252 | extern void syms_of_doc (void); | 4228 | extern void syms_of_doc (void); |
| @@ -4267,8 +4243,6 @@ extern void init_macros (void); | |||
| 4267 | extern void syms_of_macros (void); | 4243 | extern void syms_of_macros (void); |
| 4268 | 4244 | ||
| 4269 | /* Defined in undo.c. */ | 4245 | /* Defined in undo.c. */ |
| 4270 | extern Lisp_Object Qapply; | ||
| 4271 | extern Lisp_Object Qinhibit_read_only; | ||
| 4272 | extern void truncate_undo_list (struct buffer *); | 4246 | extern void truncate_undo_list (struct buffer *); |
| 4273 | extern void record_insert (ptrdiff_t, ptrdiff_t); | 4247 | extern void record_insert (ptrdiff_t, ptrdiff_t); |
| 4274 | extern void record_delete (ptrdiff_t, Lisp_Object, bool); | 4248 | extern void record_delete (ptrdiff_t, Lisp_Object, bool); |
| @@ -4278,11 +4252,8 @@ extern void record_property_change (ptrdiff_t, ptrdiff_t, | |||
| 4278 | Lisp_Object, Lisp_Object, | 4252 | Lisp_Object, Lisp_Object, |
| 4279 | Lisp_Object); | 4253 | Lisp_Object); |
| 4280 | extern void syms_of_undo (void); | 4254 | extern void syms_of_undo (void); |
| 4281 | /* Defined in textprop.c. */ | ||
| 4282 | extern Lisp_Object Qmouse_face; | ||
| 4283 | extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks; | ||
| 4284 | extern Lisp_Object Qminibuffer_prompt; | ||
| 4285 | 4255 | ||
| 4256 | /* Defined in textprop.c. */ | ||
| 4286 | extern void report_interval_modification (Lisp_Object, Lisp_Object); | 4257 | extern void report_interval_modification (Lisp_Object, Lisp_Object); |
| 4287 | 4258 | ||
| 4288 | /* Defined in menu.c. */ | 4259 | /* Defined in menu.c. */ |
| @@ -4366,9 +4337,6 @@ extern void init_font (void); | |||
| 4366 | #ifdef HAVE_WINDOW_SYSTEM | 4337 | #ifdef HAVE_WINDOW_SYSTEM |
| 4367 | /* Defined in fontset.c. */ | 4338 | /* Defined in fontset.c. */ |
| 4368 | extern void syms_of_fontset (void); | 4339 | extern void syms_of_fontset (void); |
| 4369 | |||
| 4370 | /* Defined in xfns.c, w32fns.c, or macfns.c. */ | ||
| 4371 | extern Lisp_Object Qfont_param; | ||
| 4372 | #endif | 4340 | #endif |
| 4373 | 4341 | ||
| 4374 | /* Defined in gfilenotify.c */ | 4342 | /* Defined in gfilenotify.c */ |
| @@ -4388,16 +4356,6 @@ extern void syms_of_w32notify (void); | |||
| 4388 | #endif | 4356 | #endif |
| 4389 | 4357 | ||
| 4390 | /* Defined in xfaces.c. */ | 4358 | /* Defined in xfaces.c. */ |
| 4391 | extern Lisp_Object Qdefault, Qfringe; | ||
| 4392 | extern Lisp_Object Qscroll_bar, Qcursor; | ||
| 4393 | extern Lisp_Object Qmode_line_inactive; | ||
| 4394 | extern Lisp_Object Qface; | ||
| 4395 | extern Lisp_Object Qnormal; | ||
| 4396 | extern Lisp_Object QCfamily, QCweight, QCslant; | ||
| 4397 | extern Lisp_Object QCheight, QCname, QCwidth, QCforeground, QCbackground; | ||
| 4398 | extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold; | ||
| 4399 | extern Lisp_Object Qbold, Qextra_bold, Qultra_bold; | ||
| 4400 | extern Lisp_Object Qoblique, Qitalic; | ||
| 4401 | extern Lisp_Object Vface_alternative_font_family_alist; | 4359 | extern Lisp_Object Vface_alternative_font_family_alist; |
| 4402 | extern Lisp_Object Vface_alternative_font_registry_alist; | 4360 | extern Lisp_Object Vface_alternative_font_registry_alist; |
| 4403 | extern void syms_of_xfaces (void); | 4361 | extern void syms_of_xfaces (void); |
diff --git a/src/lread.c b/src/lread.c index 6463e1051b5..7f7bd8985d9 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -18,6 +18,8 @@ GNU General Public License for more details. | |||
| 18 | You should have received a copy of the GNU General Public License | 18 | You should have received a copy of the GNU General Public License |
| 19 | along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | 19 | along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 20 | 20 | ||
| 21 | /* Tell globals.h to define tables needed by init_obarray. */ | ||
| 22 | #define DEFINE_SYMBOLS | ||
| 21 | 23 | ||
| 22 | #include <config.h> | 24 | #include <config.h> |
| 23 | #include "sysstdio.h" | 25 | #include "sysstdio.h" |
| @@ -64,32 +66,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 64 | #define file_tell ftell | 66 | #define file_tell ftell |
| 65 | #endif | 67 | #endif |
| 66 | 68 | ||
| 67 | /* Hash table read constants. */ | ||
| 68 | static Lisp_Object Qhash_table, Qdata; | ||
| 69 | static Lisp_Object Qtest; | ||
| 70 | Lisp_Object Qsize; | ||
| 71 | static Lisp_Object Qweakness; | ||
| 72 | static Lisp_Object Qrehash_size; | ||
| 73 | static Lisp_Object Qrehash_threshold; | ||
| 74 | |||
| 75 | static Lisp_Object Qread_char, Qget_file_char, Qcurrent_load_list; | ||
| 76 | Lisp_Object Qstandard_input; | ||
| 77 | Lisp_Object Qvariable_documentation; | ||
| 78 | static Lisp_Object Qascii_character, Qload, Qload_file_name; | ||
| 79 | Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; | ||
| 80 | static Lisp_Object Qinhibit_file_name_operation; | ||
| 81 | static Lisp_Object Qeval_buffer_list; | ||
| 82 | Lisp_Object Qlexical_binding; | ||
| 83 | static Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */ | ||
| 84 | |||
| 85 | /* Used instead of Qget_file_char while loading *.elc files compiled | ||
| 86 | by Emacs 21 or older. */ | ||
| 87 | static Lisp_Object Qget_emacs_mule_file_char; | ||
| 88 | |||
| 89 | static Lisp_Object Qload_force_doc_strings; | ||
| 90 | |||
| 91 | static Lisp_Object Qload_in_progress; | ||
| 92 | |||
| 93 | /* The association list of objects read with the #n=object form. | 69 | /* The association list of objects read with the #n=object form. |
| 94 | Each member of the list has the form (n . object), and is used to | 70 | Each member of the list has the form (n . object), and is used to |
| 95 | look up the object for the corresponding #n# construct. | 71 | look up the object for the corresponding #n# construct. |
| @@ -133,7 +109,6 @@ static file_offset prev_saved_doc_string_position; | |||
| 133 | Fread initializes this to false, so we need not specbind it | 109 | Fread initializes this to false, so we need not specbind it |
| 134 | or worry about what happens to it when there is an error. */ | 110 | or worry about what happens to it when there is an error. */ |
| 135 | static bool new_backquote_flag; | 111 | static bool new_backquote_flag; |
| 136 | static Lisp_Object Qold_style_backquotes; | ||
| 137 | 112 | ||
| 138 | /* A list of file names for files being loaded in Fload. Used to | 113 | /* A list of file names for files being loaded in Fload. Used to |
| 139 | check for recursive loads. */ | 114 | check for recursive loads. */ |
| @@ -1430,8 +1405,6 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) | |||
| 1430 | return file; | 1405 | return file; |
| 1431 | } | 1406 | } |
| 1432 | 1407 | ||
| 1433 | static Lisp_Object Qdir_ok; | ||
| 1434 | |||
| 1435 | /* Search for a file whose name is STR, looking in directories | 1408 | /* Search for a file whose name is STR, looking in directories |
| 1436 | in the Lisp list PATH, and trying suffixes from SUFFIX. | 1409 | in the Lisp list PATH, and trying suffixes from SUFFIX. |
| 1437 | On success, return a file descriptor (or 1 or -2 as described below). | 1410 | On success, return a file descriptor (or 1 or -2 as described below). |
| @@ -3792,30 +3765,38 @@ check_obarray (Lisp_Object obarray) | |||
| 3792 | return obarray; | 3765 | return obarray; |
| 3793 | } | 3766 | } |
| 3794 | 3767 | ||
| 3795 | /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */ | 3768 | /* Intern symbol SYM in OBARRAY using bucket INDEX. */ |
| 3796 | 3769 | ||
| 3797 | Lisp_Object | 3770 | static Lisp_Object |
| 3798 | intern_driver (Lisp_Object string, Lisp_Object obarray, ptrdiff_t index) | 3771 | intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) |
| 3799 | { | 3772 | { |
| 3800 | Lisp_Object *ptr, sym = Fmake_symbol (string); | 3773 | Lisp_Object *ptr; |
| 3801 | 3774 | ||
| 3802 | XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray) | 3775 | XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray) |
| 3803 | ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY | 3776 | ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY |
| 3804 | : SYMBOL_INTERNED); | 3777 | : SYMBOL_INTERNED); |
| 3805 | 3778 | ||
| 3806 | if ((SREF (string, 0) == ':') && EQ (obarray, initial_obarray)) | 3779 | if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) |
| 3807 | { | 3780 | { |
| 3808 | XSYMBOL (sym)->constant = 1; | 3781 | XSYMBOL (sym)->constant = 1; |
| 3809 | XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; | 3782 | XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; |
| 3810 | SET_SYMBOL_VAL (XSYMBOL (sym), sym); | 3783 | SET_SYMBOL_VAL (XSYMBOL (sym), sym); |
| 3811 | } | 3784 | } |
| 3812 | 3785 | ||
| 3813 | ptr = aref_addr (obarray, index); | 3786 | ptr = aref_addr (obarray, XINT (index)); |
| 3814 | set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); | 3787 | set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); |
| 3815 | *ptr = sym; | 3788 | *ptr = sym; |
| 3816 | return sym; | 3789 | return sym; |
| 3817 | } | 3790 | } |
| 3818 | 3791 | ||
| 3792 | /* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */ | ||
| 3793 | |||
| 3794 | Lisp_Object | ||
| 3795 | intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index) | ||
| 3796 | { | ||
| 3797 | return intern_sym (Fmake_symbol (string), obarray, index); | ||
| 3798 | } | ||
| 3799 | |||
| 3819 | /* Intern the C string STR: return a symbol with that name, | 3800 | /* Intern the C string STR: return a symbol with that name, |
| 3820 | interned in the current obarray. */ | 3801 | interned in the current obarray. */ |
| 3821 | 3802 | ||
| @@ -3826,7 +3807,7 @@ intern_1 (const char *str, ptrdiff_t len) | |||
| 3826 | Lisp_Object tem = oblookup (obarray, str, len, len); | 3807 | Lisp_Object tem = oblookup (obarray, str, len, len); |
| 3827 | 3808 | ||
| 3828 | return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len), | 3809 | return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len), |
| 3829 | obarray, XINT (tem)); | 3810 | obarray, tem); |
| 3830 | } | 3811 | } |
| 3831 | 3812 | ||
| 3832 | Lisp_Object | 3813 | Lisp_Object |
| @@ -3840,10 +3821,27 @@ intern_c_string_1 (const char *str, ptrdiff_t len) | |||
| 3840 | /* Creating a non-pure string from a string literal not implemented yet. | 3821 | /* Creating a non-pure string from a string literal not implemented yet. |
| 3841 | We could just use make_string here and live with the extra copy. */ | 3822 | We could just use make_string here and live with the extra copy. */ |
| 3842 | eassert (!NILP (Vpurify_flag)); | 3823 | eassert (!NILP (Vpurify_flag)); |
| 3843 | tem = intern_driver (make_pure_c_string (str, len), obarray, XINT (tem)); | 3824 | tem = intern_driver (make_pure_c_string (str, len), obarray, tem); |
| 3844 | } | 3825 | } |
| 3845 | return tem; | 3826 | return tem; |
| 3846 | } | 3827 | } |
| 3828 | |||
| 3829 | static void | ||
| 3830 | define_symbol (Lisp_Object sym, char const *str) | ||
| 3831 | { | ||
| 3832 | ptrdiff_t len = strlen (str); | ||
| 3833 | Lisp_Object string = make_pure_c_string (str, len); | ||
| 3834 | init_symbol (sym, string); | ||
| 3835 | |||
| 3836 | /* Qunbound is uninterned, so that it's not confused with any symbol | ||
| 3837 | 'unbound' created by a Lisp program. */ | ||
| 3838 | if (! EQ (sym, Qunbound)) | ||
| 3839 | { | ||
| 3840 | Lisp_Object bucket = oblookup (initial_obarray, str, len, len); | ||
| 3841 | eassert (INTEGERP (bucket)); | ||
| 3842 | intern_sym (sym, initial_obarray, bucket); | ||
| 3843 | } | ||
| 3844 | } | ||
| 3847 | 3845 | ||
| 3848 | DEFUN ("intern", Fintern, Sintern, 1, 2, 0, | 3846 | DEFUN ("intern", Fintern, Sintern, 1, 2, 0, |
| 3849 | doc: /* Return the canonical symbol whose name is STRING. | 3847 | doc: /* Return the canonical symbol whose name is STRING. |
| @@ -3859,8 +3857,8 @@ it defaults to the value of `obarray'. */) | |||
| 3859 | 3857 | ||
| 3860 | tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); | 3858 | tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); |
| 3861 | if (!SYMBOLP (tem)) | 3859 | if (!SYMBOLP (tem)) |
| 3862 | tem = intern_driver (NILP (Vpurify_flag) ? string | 3860 | tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string), |
| 3863 | : Fpurecopy (string), obarray, XINT (tem)); | 3861 | obarray, tem); |
| 3864 | return tem; | 3862 | return tem; |
| 3865 | } | 3863 | } |
| 3866 | 3864 | ||
| @@ -4059,24 +4057,17 @@ init_obarray (void) | |||
| 4059 | initial_obarray = Vobarray; | 4057 | initial_obarray = Vobarray; |
| 4060 | staticpro (&initial_obarray); | 4058 | staticpro (&initial_obarray); |
| 4061 | 4059 | ||
| 4062 | Qunbound = Fmake_symbol (build_pure_c_string ("unbound")); | 4060 | for (int i = 0; i < ARRAYELTS (lispsym); i++) |
| 4063 | /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the | 4061 | define_symbol (builtin_lisp_symbol (i), defsym_name[i]); |
| 4064 | NILP (Vpurify_flag) check in intern_c_string. */ | 4062 | |
| 4065 | Qnil = make_number (-1); Vpurify_flag = make_number (1); | 4063 | DEFSYM (Qunbound, "unbound"); |
| 4066 | Qnil = intern_c_string ("nil"); | 4064 | |
| 4067 | 4065 | DEFSYM (Qnil, "nil"); | |
| 4068 | /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil, | ||
| 4069 | so those two need to be fixed manually. */ | ||
| 4070 | SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); | ||
| 4071 | set_symbol_function (Qunbound, Qnil); | ||
| 4072 | set_symbol_plist (Qunbound, Qnil); | ||
| 4073 | SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); | 4066 | SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); |
| 4074 | XSYMBOL (Qnil)->constant = 1; | 4067 | XSYMBOL (Qnil)->constant = 1; |
| 4075 | XSYMBOL (Qnil)->declared_special = true; | 4068 | XSYMBOL (Qnil)->declared_special = true; |
| 4076 | set_symbol_plist (Qnil, Qnil); | ||
| 4077 | set_symbol_function (Qnil, Qnil); | ||
| 4078 | 4069 | ||
| 4079 | Qt = intern_c_string ("t"); | 4070 | DEFSYM (Qt, "t"); |
| 4080 | SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); | 4071 | SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); |
| 4081 | XSYMBOL (Qt)->constant = 1; | 4072 | XSYMBOL (Qt)->constant = 1; |
| 4082 | XSYMBOL (Qt)->declared_special = true; | 4073 | XSYMBOL (Qt)->declared_special = true; |
| @@ -4729,7 +4720,11 @@ that are loaded before your customizations are read! */); | |||
| 4729 | DEFSYM (Qstandard_input, "standard-input"); | 4720 | DEFSYM (Qstandard_input, "standard-input"); |
| 4730 | DEFSYM (Qread_char, "read-char"); | 4721 | DEFSYM (Qread_char, "read-char"); |
| 4731 | DEFSYM (Qget_file_char, "get-file-char"); | 4722 | DEFSYM (Qget_file_char, "get-file-char"); |
| 4723 | |||
| 4724 | /* Used instead of Qget_file_char while loading *.elc files compiled | ||
| 4725 | by Emacs 21 or older. */ | ||
| 4732 | DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char"); | 4726 | DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char"); |
| 4727 | |||
| 4733 | DEFSYM (Qload_force_doc_strings, "load-force-doc-strings"); | 4728 | DEFSYM (Qload_force_doc_strings, "load-force-doc-strings"); |
| 4734 | 4729 | ||
| 4735 | DEFSYM (Qbackquote, "`"); | 4730 | DEFSYM (Qbackquote, "`"); |
diff --git a/src/macfont.m b/src/macfont.m index fb28dc85d0f..f569934128f 100644 --- a/src/macfont.m +++ b/src/macfont.m | |||
| @@ -40,9 +40,6 @@ Original author: YAMAMOTO Mitsuharu | |||
| 40 | 40 | ||
| 41 | static struct font_driver macfont_driver; | 41 | static struct font_driver macfont_driver; |
| 42 | 42 | ||
| 43 | /* Core Text, for Mac OS X. */ | ||
| 44 | static Lisp_Object Qmac_ct; | ||
| 45 | |||
| 46 | static double mac_ctfont_get_advance_width_for_glyph (CTFontRef, CGGlyph); | 43 | static double mac_ctfont_get_advance_width_for_glyph (CTFontRef, CGGlyph); |
| 47 | static CGRect mac_ctfont_get_bounding_rect_for_glyph (CTFontRef, CGGlyph); | 44 | static CGRect mac_ctfont_get_bounding_rect_for_glyph (CTFontRef, CGGlyph); |
| 48 | static CFArrayRef mac_ctfont_create_available_families (void); | 45 | static CFArrayRef mac_ctfont_create_available_families (void); |
| @@ -69,18 +66,6 @@ static CGGlyph mac_ctfont_get_glyph_for_cid (CTFontRef, | |||
| 69 | CGFontIndex); | 66 | CGFontIndex); |
| 70 | #endif | 67 | #endif |
| 71 | 68 | ||
| 72 | /* The font property key specifying the font design destination. The | ||
| 73 | value is an unsigned integer code: 0 for WYSIWYG, and 1 for Video | ||
| 74 | text. (See the documentation of X Logical Font Description | ||
| 75 | Conventions.) In the Mac font driver, 1 means the screen font is | ||
| 76 | used for calculating some glyph metrics. You can see the | ||
| 77 | difference with Monaco 8pt or 9pt, for example. */ | ||
| 78 | static Lisp_Object QCdestination; | ||
| 79 | |||
| 80 | /* The boolean-valued font property key specifying the use of | ||
| 81 | leading. */ | ||
| 82 | static Lisp_Object QCminspace; | ||
| 83 | |||
| 84 | struct macfont_metrics; | 69 | struct macfont_metrics; |
| 85 | 70 | ||
| 86 | /* The actual structure for Mac font that can be cast to struct font. */ | 71 | /* The actual structure for Mac font that can be cast to struct font. */ |
| @@ -3927,10 +3912,19 @@ syms_of_macfont (void) | |||
| 3927 | { | 3912 | { |
| 3928 | static struct font_driver mac_font_driver; | 3913 | static struct font_driver mac_font_driver; |
| 3929 | 3914 | ||
| 3915 | /* Core Text, for Mac OS X. */ | ||
| 3930 | DEFSYM (Qmac_ct, "mac-ct"); | 3916 | DEFSYM (Qmac_ct, "mac-ct"); |
| 3931 | macfont_driver.type = Qmac_ct; | 3917 | macfont_driver.type = Qmac_ct; |
| 3932 | register_font_driver (&macfont_driver, NULL); | 3918 | register_font_driver (&macfont_driver, NULL); |
| 3933 | 3919 | ||
| 3920 | /* The font property key specifying the font design destination. The | ||
| 3921 | value is an unsigned integer code: 0 for WYSIWYG, and 1 for Video | ||
| 3922 | text. (See the documentation of X Logical Font Description | ||
| 3923 | Conventions.) In the Mac font driver, 1 means the screen font is | ||
| 3924 | used for calculating some glyph metrics. You can see the | ||
| 3925 | difference with Monaco 8pt or 9pt, for example. */ | ||
| 3934 | DEFSYM (QCdestination, ":destination"); | 3926 | DEFSYM (QCdestination, ":destination"); |
| 3927 | |||
| 3928 | /* The boolean-valued font property key specifying the use of leading. */ | ||
| 3935 | DEFSYM (QCminspace, ":minspace"); | 3929 | DEFSYM (QCminspace, ":minspace"); |
| 3936 | } | 3930 | } |
diff --git a/src/macros.c b/src/macros.c index 0801f0ac288..e5b8ab70870 100644 --- a/src/macros.c +++ b/src/macros.c | |||
| @@ -28,9 +28,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 28 | #include "window.h" | 28 | #include "window.h" |
| 29 | #include "keyboard.h" | 29 | #include "keyboard.h" |
| 30 | 30 | ||
| 31 | static Lisp_Object Qexecute_kbd_macro; | ||
| 32 | static Lisp_Object Qkbd_macro_termination_hook; | ||
| 33 | |||
| 34 | /* Number of successful iterations so far | 31 | /* Number of successful iterations so far |
| 35 | for innermost keyboard macro. | 32 | for innermost keyboard macro. |
| 36 | This is not bound at each level, | 33 | This is not bound at each level, |
| @@ -280,7 +277,7 @@ pop_kbd_macro (Lisp_Object info) | |||
| 280 | tem = XCDR (info); | 277 | tem = XCDR (info); |
| 281 | executing_kbd_macro_index = XINT (XCAR (tem)); | 278 | executing_kbd_macro_index = XINT (XCAR (tem)); |
| 282 | Vreal_this_command = XCDR (tem); | 279 | Vreal_this_command = XCDR (tem); |
| 283 | Frun_hooks (1, &Qkbd_macro_termination_hook); | 280 | run_hook (Qkbd_macro_termination_hook); |
| 284 | } | 281 | } |
| 285 | 282 | ||
| 286 | DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0, | 283 | DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0, |
diff --git a/src/menu.h b/src/menu.h index 182a1819b35..de586a5e101 100644 --- a/src/menu.h +++ b/src/menu.h | |||
| @@ -22,10 +22,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 22 | #include "systime.h" /* for Time */ | 22 | #include "systime.h" /* for Time */ |
| 23 | #include "../lwlib/lwlib-widget.h" | 23 | #include "../lwlib/lwlib-widget.h" |
| 24 | 24 | ||
| 25 | #ifdef HAVE_NTGUI | ||
| 26 | extern Lisp_Object Qunsupported__w32_dialog; | ||
| 27 | #endif | ||
| 28 | |||
| 29 | /* Bit fields used by terminal-specific menu_show_hook. */ | 25 | /* Bit fields used by terminal-specific menu_show_hook. */ |
| 30 | 26 | ||
| 31 | enum { | 27 | enum { |
diff --git a/src/minibuf.c b/src/minibuf.c index b43bf7c39e9..07f489258e1 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -54,37 +54,10 @@ static Lisp_Object minibuf_save_list; | |||
| 54 | 54 | ||
| 55 | EMACS_INT minibuf_level; | 55 | EMACS_INT minibuf_level; |
| 56 | 56 | ||
| 57 | /* The maximum length of a minibuffer history. */ | ||
| 58 | |||
| 59 | static Lisp_Object Qhistory_length; | ||
| 60 | |||
| 61 | /* Fread_minibuffer leaves the input here as a string. */ | 57 | /* Fread_minibuffer leaves the input here as a string. */ |
| 62 | 58 | ||
| 63 | Lisp_Object last_minibuf_string; | 59 | Lisp_Object last_minibuf_string; |
| 64 | 60 | ||
| 65 | static Lisp_Object Qminibuffer_history, Qbuffer_name_history; | ||
| 66 | |||
| 67 | static Lisp_Object Qread_file_name_internal; | ||
| 68 | |||
| 69 | /* Normal hooks for entry to and exit from minibuffer. */ | ||
| 70 | |||
| 71 | static Lisp_Object Qminibuffer_setup_hook; | ||
| 72 | static Lisp_Object Qminibuffer_exit_hook; | ||
| 73 | |||
| 74 | Lisp_Object Qcompletion_ignore_case; | ||
| 75 | static Lisp_Object Qminibuffer_completion_table; | ||
| 76 | static Lisp_Object Qminibuffer_completion_predicate; | ||
| 77 | static Lisp_Object Qminibuffer_completion_confirm; | ||
| 78 | static Lisp_Object Qcustom_variable_p; | ||
| 79 | |||
| 80 | static Lisp_Object Qminibuffer_default; | ||
| 81 | |||
| 82 | static Lisp_Object Qcurrent_input_method, Qactivate_input_method; | ||
| 83 | |||
| 84 | static Lisp_Object Qcase_fold_search; | ||
| 85 | |||
| 86 | static Lisp_Object Qread_expression_history; | ||
| 87 | |||
| 88 | /* Prompt to display in front of the mini-buffer contents. */ | 61 | /* Prompt to display in front of the mini-buffer contents. */ |
| 89 | 62 | ||
| 90 | static Lisp_Object minibuf_prompt; | 63 | static Lisp_Object minibuf_prompt; |
| @@ -699,7 +672,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, | |||
| 699 | if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) | 672 | if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) |
| 700 | call1 (Qactivate_input_method, input_method); | 673 | call1 (Qactivate_input_method, input_method); |
| 701 | 674 | ||
| 702 | Frun_hooks (1, &Qminibuffer_setup_hook); | 675 | run_hook (Qminibuffer_setup_hook); |
| 703 | 676 | ||
| 704 | /* Don't allow the user to undo past this point. */ | 677 | /* Don't allow the user to undo past this point. */ |
| 705 | bset_undo_list (current_buffer, Qnil); | 678 | bset_undo_list (current_buffer, Qnil); |
| @@ -1821,8 +1794,6 @@ the values STRING, PREDICATE and `lambda'. */) | |||
| 1821 | return Qt; | 1794 | return Qt; |
| 1822 | } | 1795 | } |
| 1823 | 1796 | ||
| 1824 | static Lisp_Object Qmetadata; | ||
| 1825 | |||
| 1826 | DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0, | 1797 | DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0, |
| 1827 | doc: /* Perform completion on buffer names. | 1798 | doc: /* Perform completion on buffer names. |
| 1828 | STRING and PREDICATE have the same meanings as in `try-completion', | 1799 | STRING and PREDICATE have the same meanings as in `try-completion', |
| @@ -1956,9 +1927,14 @@ syms_of_minibuf (void) | |||
| 1956 | Fset (Qbuffer_name_history, Qnil); | 1927 | Fset (Qbuffer_name_history, Qnil); |
| 1957 | 1928 | ||
| 1958 | DEFSYM (Qcustom_variable_p, "custom-variable-p"); | 1929 | DEFSYM (Qcustom_variable_p, "custom-variable-p"); |
| 1930 | |||
| 1931 | /* Normal hooks for entry to and exit from minibuffer. */ | ||
| 1959 | DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook"); | 1932 | DEFSYM (Qminibuffer_setup_hook, "minibuffer-setup-hook"); |
| 1960 | DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook"); | 1933 | DEFSYM (Qminibuffer_exit_hook, "minibuffer-exit-hook"); |
| 1934 | |||
| 1935 | /* The maximum length of a minibuffer history. */ | ||
| 1961 | DEFSYM (Qhistory_length, "history-length"); | 1936 | DEFSYM (Qhistory_length, "history-length"); |
| 1937 | |||
| 1962 | DEFSYM (Qcurrent_input_method, "current-input-method"); | 1938 | DEFSYM (Qcurrent_input_method, "current-input-method"); |
| 1963 | DEFSYM (Qactivate_input_method, "activate-input-method"); | 1939 | DEFSYM (Qactivate_input_method, "activate-input-method"); |
| 1964 | DEFSYM (Qcase_fold_search, "case-fold-search"); | 1940 | DEFSYM (Qcase_fold_search, "case-fold-search"); |
diff --git a/src/nsfns.m b/src/nsfns.m index 42929b9f440..828ee88e635 100644 --- a/src/nsfns.m +++ b/src/nsfns.m | |||
| @@ -61,35 +61,6 @@ int fns_trace_num = 1; | |||
| 61 | 61 | ||
| 62 | extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types; | 62 | extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types; |
| 63 | 63 | ||
| 64 | extern Lisp_Object Qforeground_color; | ||
| 65 | extern Lisp_Object Qbackground_color; | ||
| 66 | extern Lisp_Object Qcursor_color; | ||
| 67 | extern Lisp_Object Qinternal_border_width; | ||
| 68 | extern Lisp_Object Qvisibility; | ||
| 69 | extern Lisp_Object Qcursor_type; | ||
| 70 | extern Lisp_Object Qicon_type; | ||
| 71 | extern Lisp_Object Qicon_name; | ||
| 72 | extern Lisp_Object Qicon_left; | ||
| 73 | extern Lisp_Object Qicon_top; | ||
| 74 | extern Lisp_Object Qtop; | ||
| 75 | extern Lisp_Object Qdisplay; | ||
| 76 | extern Lisp_Object Qvertical_scroll_bars; | ||
| 77 | extern Lisp_Object Qhorizontal_scroll_bars; | ||
| 78 | extern Lisp_Object Qauto_raise; | ||
| 79 | extern Lisp_Object Qauto_lower; | ||
| 80 | extern Lisp_Object Qbox; | ||
| 81 | extern Lisp_Object Qscroll_bar_width; | ||
| 82 | extern Lisp_Object Qscroll_bar_height; | ||
| 83 | extern Lisp_Object Qx_resource_name; | ||
| 84 | extern Lisp_Object Qface_set_after_frame_default; | ||
| 85 | extern Lisp_Object Qunderline, Qundefined; | ||
| 86 | extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth; | ||
| 87 | extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle; | ||
| 88 | |||
| 89 | |||
| 90 | Lisp_Object Qbuffered; | ||
| 91 | Lisp_Object Qfontsize; | ||
| 92 | |||
| 93 | EmacsTooltip *ns_tooltip = nil; | 64 | EmacsTooltip *ns_tooltip = nil; |
| 94 | 65 | ||
| 95 | /* Need forward declaration here to preserve organizational integrity of file */ | 66 | /* Need forward declaration here to preserve organizational integrity of file */ |
diff --git a/src/nsfont.m b/src/nsfont.m index 22b37290a6b..f5e89d32bfc 100644 --- a/src/nsfont.m +++ b/src/nsfont.m | |||
| @@ -45,11 +45,6 @@ Author: Adrian Robert (arobert@cogsci.ucsd.edu) | |||
| 45 | #define NSFONT_TRACE 0 | 45 | #define NSFONT_TRACE 0 |
| 46 | #define LCD_SMOOTHING_MARGIN 2 | 46 | #define LCD_SMOOTHING_MARGIN 2 |
| 47 | 47 | ||
| 48 | extern Lisp_Object Qns; | ||
| 49 | extern Lisp_Object Qnormal, Qbold, Qitalic; | ||
| 50 | static Lisp_Object Qapple, Qroman, Qmedium; | ||
| 51 | static Lisp_Object Qcondensed, Qexpanded; | ||
| 52 | extern Lisp_Object Qappend; | ||
| 53 | extern float ns_antialias_threshold; | 48 | extern float ns_antialias_threshold; |
| 54 | 49 | ||
| 55 | 50 | ||
| @@ -1493,7 +1488,7 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block) | |||
| 1493 | characterIndex: (NSUInteger)charIndex | 1488 | characterIndex: (NSUInteger)charIndex |
| 1494 | { | 1489 | { |
| 1495 | len = glyphIndex+length; | 1490 | len = glyphIndex+length; |
| 1496 | for (i =glyphIndex; i<len; i++) | 1491 | for (i =glyphIndex; i<len; i++) |
| 1497 | cglyphs[i] = glyphs[i-glyphIndex]; | 1492 | cglyphs[i] = glyphs[i-glyphIndex]; |
| 1498 | if (len > maxGlyph) | 1493 | if (len > maxGlyph) |
| 1499 | maxGlyph = len; | 1494 | maxGlyph = len; |
diff --git a/src/nsimage.m b/src/nsimage.m index 2da22f239f3..f37ad38ad1e 100644 --- a/src/nsimage.m +++ b/src/nsimage.m | |||
| @@ -34,8 +34,6 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) | |||
| 34 | #include "nsterm.h" | 34 | #include "nsterm.h" |
| 35 | #include "frame.h" | 35 | #include "frame.h" |
| 36 | 36 | ||
| 37 | extern Lisp_Object QCfile, QCdata; | ||
| 38 | |||
| 39 | /* call tracing */ | 37 | /* call tracing */ |
| 40 | #if 0 | 38 | #if 0 |
| 41 | int image_trace_num = 0; | 39 | int image_trace_num = 0; |
diff --git a/src/nsmenu.m b/src/nsmenu.m index 0e2f4d1f17c..26fe26e5e0d 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m | |||
| @@ -59,12 +59,6 @@ int menu_trace_num = 0; | |||
| 59 | #include "nsmenu_common.c" | 59 | #include "nsmenu_common.c" |
| 60 | #endif | 60 | #endif |
| 61 | 61 | ||
| 62 | extern Lisp_Object Qundefined, Qmenu_enable, Qmenu_bar_update_hook; | ||
| 63 | extern Lisp_Object QCtoggle, QCradio; | ||
| 64 | |||
| 65 | Lisp_Object Qdebug_on_next_call; | ||
| 66 | extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map; | ||
| 67 | |||
| 68 | extern long context_menu_value; | 62 | extern long context_menu_value; |
| 69 | EmacsMenu *mainMenu, *svcsMenu, *dockMenu; | 63 | EmacsMenu *mainMenu, *svcsMenu, *dockMenu; |
| 70 | 64 | ||
diff --git a/src/nsselect.m b/src/nsselect.m index e2e5aadc10d..1544b16dc9d 100644 --- a/src/nsselect.m +++ b/src/nsselect.m | |||
| @@ -34,8 +34,6 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) | |||
| 34 | #include "termhooks.h" | 34 | #include "termhooks.h" |
| 35 | #include "keyboard.h" | 35 | #include "keyboard.h" |
| 36 | 36 | ||
| 37 | static Lisp_Object QCLIPBOARD, QSECONDARY, QTEXT, QFILE_NAME; | ||
| 38 | |||
| 39 | static Lisp_Object Vselection_alist; | 37 | static Lisp_Object Vselection_alist; |
| 40 | 38 | ||
| 41 | /* NSGeneralPboard is pretty much analogous to X11 CLIPBOARD */ | 39 | /* NSGeneralPboard is pretty much analogous to X11 CLIPBOARD */ |
diff --git a/src/nsterm.h b/src/nsterm.h index 30c14249d83..9035ee1a328 100644 --- a/src/nsterm.h +++ b/src/nsterm.h | |||
| @@ -792,7 +792,6 @@ struct glyph_string; | |||
| 792 | void ns_dump_glyphstring (struct glyph_string *s); | 792 | void ns_dump_glyphstring (struct glyph_string *s); |
| 793 | 793 | ||
| 794 | /* Implemented in nsterm, published in or needed from nsfns. */ | 794 | /* Implemented in nsterm, published in or needed from nsfns. */ |
| 795 | extern Lisp_Object Qfontsize; | ||
| 796 | extern Lisp_Object ns_list_fonts (struct frame *f, Lisp_Object pattern, | 795 | extern Lisp_Object ns_list_fonts (struct frame *f, Lisp_Object pattern, |
| 797 | int size, int maxnames); | 796 | int size, int maxnames); |
| 798 | extern void ns_clear_frame (struct frame *f); | 797 | extern void ns_clear_frame (struct frame *f); |
diff --git a/src/nsterm.m b/src/nsterm.m index 4a831a8667b..bf3192bf432 100644 --- a/src/nsterm.m +++ b/src/nsterm.m | |||
| @@ -225,14 +225,6 @@ static unsigned convert_ns_to_X_keysym[] = | |||
| 225 | 0x1B, 0x1B /* escape */ | 225 | 0x1B, 0x1B /* escape */ |
| 226 | }; | 226 | }; |
| 227 | 227 | ||
| 228 | static Lisp_Object Qmodifier_value; | ||
| 229 | Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper; | ||
| 230 | extern Lisp_Object Qcursor_color, Qcursor_type, Qns; | ||
| 231 | |||
| 232 | static Lisp_Object QUTF8_STRING; | ||
| 233 | static Lisp_Object Qcocoa, Qgnustep; | ||
| 234 | static Lisp_Object Qfile, Qurl; | ||
| 235 | |||
| 236 | /* On OS X picks up the default NSGlobalDomain AppleAntiAliasingThreshold, | 228 | /* On OS X picks up the default NSGlobalDomain AppleAntiAliasingThreshold, |
| 237 | the maximum font size to NOT antialias. On GNUstep there is currently | 229 | the maximum font size to NOT antialias. On GNUstep there is currently |
| 238 | no way to control this behavior. */ | 230 | no way to control this behavior. */ |
| @@ -1412,15 +1404,8 @@ x_set_window_size (struct frame *f, | |||
| 1412 | [view setBoundsOrigin: origin]; | 1404 | [view setBoundsOrigin: origin]; |
| 1413 | } | 1405 | } |
| 1414 | 1406 | ||
| 1415 | change_frame_size (f, width, height, 0, 1, 0, pixelwise); | 1407 | [view updateFrameSize: NO]; |
| 1416 | /* SET_FRAME_GARBAGED (f); // this short-circuits expose call in drawRect */ | ||
| 1417 | |||
| 1418 | mark_window_cursors_off (XWINDOW (f->root_window)); | ||
| 1419 | cancel_mouse_face (f); | ||
| 1420 | |||
| 1421 | unblock_input (); | 1408 | unblock_input (); |
| 1422 | |||
| 1423 | do_pending_window_change (0); | ||
| 1424 | } | 1409 | } |
| 1425 | 1410 | ||
| 1426 | 1411 | ||
diff --git a/src/print.c b/src/print.c index d3ece334eb7..963979e809a 100644 --- a/src/print.c +++ b/src/print.c | |||
| @@ -75,9 +75,6 @@ static ptrdiff_t print_buffer_pos; | |||
| 75 | /* Bytes stored in print_buffer. */ | 75 | /* Bytes stored in print_buffer. */ |
| 76 | static ptrdiff_t print_buffer_pos_byte; | 76 | static ptrdiff_t print_buffer_pos_byte; |
| 77 | 77 | ||
| 78 | Lisp_Object Qprint_escape_newlines; | ||
| 79 | static Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii; | ||
| 80 | |||
| 81 | /* Vprint_number_table is a table, that keeps objects that are going to | 78 | /* Vprint_number_table is a table, that keeps objects that are going to |
| 82 | be printed, to allow use of #n= and #n# to express sharing. | 79 | be printed, to allow use of #n= and #n# to express sharing. |
| 83 | For any given object, the table can give the following values: | 80 | For any given object, the table can give the following values: |
| @@ -510,7 +507,7 @@ temp_output_buffer_setup (const char *bufname) | |||
| 510 | Ferase_buffer (); | 507 | Ferase_buffer (); |
| 511 | XSETBUFFER (buf, current_buffer); | 508 | XSETBUFFER (buf, current_buffer); |
| 512 | 509 | ||
| 513 | Frun_hooks (1, &Qtemp_buffer_setup_hook); | 510 | run_hook (Qtemp_buffer_setup_hook); |
| 514 | 511 | ||
| 515 | unbind_to (count, Qnil); | 512 | unbind_to (count, Qnil); |
| 516 | 513 | ||
| @@ -719,10 +716,6 @@ is used instead. */) | |||
| 719 | return object; | 716 | return object; |
| 720 | } | 717 | } |
| 721 | 718 | ||
| 722 | /* The subroutine object for external-debugging-output is kept here | ||
| 723 | for the convenience of the debugger. */ | ||
| 724 | Lisp_Object Qexternal_debugging_output; | ||
| 725 | |||
| 726 | DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, | 719 | DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, |
| 727 | doc: /* Write CHARACTER to stderr. | 720 | doc: /* Write CHARACTER to stderr. |
| 728 | You can call print while debugging emacs, and pass it this function | 721 | You can call print while debugging emacs, and pass it this function |
| @@ -2235,7 +2228,10 @@ print_interval (INTERVAL interval, Lisp_Object printcharfun) | |||
| 2235 | void | 2228 | void |
| 2236 | init_print_once (void) | 2229 | init_print_once (void) |
| 2237 | { | 2230 | { |
| 2231 | /* The subroutine object for external-debugging-output is kept here | ||
| 2232 | for the convenience of the debugger. */ | ||
| 2238 | DEFSYM (Qexternal_debugging_output, "external-debugging-output"); | 2233 | DEFSYM (Qexternal_debugging_output, "external-debugging-output"); |
| 2234 | |||
| 2239 | defsubr (&Sexternal_debugging_output); | 2235 | defsubr (&Sexternal_debugging_output); |
| 2240 | } | 2236 | } |
| 2241 | 2237 | ||
diff --git a/src/process.c b/src/process.c index 6eb0f9e2ab4..9015383b8b5 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -140,12 +140,6 @@ extern int sys_select (int, fd_set *, fd_set *, fd_set *, | |||
| 140 | #if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3) | 140 | #if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3) |
| 141 | # pragma GCC diagnostic ignored "-Wstrict-overflow" | 141 | # pragma GCC diagnostic ignored "-Wstrict-overflow" |
| 142 | #endif | 142 | #endif |
| 143 | |||
| 144 | Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid; | ||
| 145 | Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime; | ||
| 146 | Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs; | ||
| 147 | Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime; | ||
| 148 | Lisp_Object QCname, QCtype; | ||
| 149 | 143 | ||
| 150 | /* True if keyboard input is on hold, zero otherwise. */ | 144 | /* True if keyboard input is on hold, zero otherwise. */ |
| 151 | 145 | ||
| @@ -191,27 +185,6 @@ process_socket (int domain, int type, int protocol) | |||
| 191 | # define socket(domain, type, protocol) process_socket (domain, type, protocol) | 185 | # define socket(domain, type, protocol) process_socket (domain, type, protocol) |
| 192 | #endif | 186 | #endif |
| 193 | 187 | ||
| 194 | Lisp_Object Qprocessp; | ||
| 195 | static Lisp_Object Qrun, Qstop, Qsignal; | ||
| 196 | static Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten; | ||
| 197 | Lisp_Object Qlocal; | ||
| 198 | static Lisp_Object Qipv4, Qdatagram, Qseqpacket; | ||
| 199 | static Lisp_Object Qreal, Qnetwork, Qserial; | ||
| 200 | #ifdef AF_INET6 | ||
| 201 | static Lisp_Object Qipv6; | ||
| 202 | #endif | ||
| 203 | static Lisp_Object QCport, QCprocess; | ||
| 204 | Lisp_Object QCspeed; | ||
| 205 | Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven; | ||
| 206 | Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary; | ||
| 207 | static Lisp_Object QCbuffer, QChost, QCservice; | ||
| 208 | static Lisp_Object QClocal, QCremote, QCcoding; | ||
| 209 | static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop; | ||
| 210 | static Lisp_Object QCsentinel, QClog, QCoptions, QCplist; | ||
| 211 | static Lisp_Object Qlast_nonmenu_event; | ||
| 212 | static Lisp_Object Qinternal_default_process_sentinel; | ||
| 213 | static Lisp_Object Qinternal_default_process_filter; | ||
| 214 | |||
| 215 | #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork)) | 188 | #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork)) |
| 216 | #define NETCONN1_P(p) (EQ (p->type, Qnetwork)) | 189 | #define NETCONN1_P(p) (EQ (p->type, Qnetwork)) |
| 217 | #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial)) | 190 | #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial)) |
| @@ -7228,10 +7201,7 @@ syms_of_process (void) | |||
| 7228 | DEFSYM (Qsignal, "signal"); | 7201 | DEFSYM (Qsignal, "signal"); |
| 7229 | 7202 | ||
| 7230 | /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it | 7203 | /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it |
| 7231 | here again. | 7204 | here again. */ |
| 7232 | |||
| 7233 | Qexit = intern_c_string ("exit"); | ||
| 7234 | staticpro (&Qexit); */ | ||
| 7235 | 7205 | ||
| 7236 | DEFSYM (Qopen, "open"); | 7206 | DEFSYM (Qopen, "open"); |
| 7237 | DEFSYM (Qclosed, "closed"); | 7207 | DEFSYM (Qclosed, "closed"); |
diff --git a/src/process.h b/src/process.h index 1c463502a5e..7803672d61a 100644 --- a/src/process.h +++ b/src/process.h | |||
| @@ -197,15 +197,6 @@ pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val) | |||
| 197 | when exiting. */ | 197 | when exiting. */ |
| 198 | extern bool inhibit_sentinels; | 198 | extern bool inhibit_sentinels; |
| 199 | 199 | ||
| 200 | extern Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname; | ||
| 201 | extern Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime; | ||
| 202 | extern Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs; | ||
| 203 | extern Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtpgid, Qcstime; | ||
| 204 | extern Lisp_Object Qtime, Qctime; | ||
| 205 | extern Lisp_Object QCspeed; | ||
| 206 | extern Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven; | ||
| 207 | extern Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary; | ||
| 208 | |||
| 209 | /* Exit statuses for GNU programs that exec other programs. */ | 200 | /* Exit statuses for GNU programs that exec other programs. */ |
| 210 | enum | 201 | enum |
| 211 | { | 202 | { |
diff --git a/src/profiler.c b/src/profiler.c index 3d2c001507b..1b49afe0331 100644 --- a/src/profiler.c +++ b/src/profiler.c | |||
| @@ -35,7 +35,6 @@ saturated_add (EMACS_INT a, EMACS_INT b) | |||
| 35 | 35 | ||
| 36 | typedef struct Lisp_Hash_Table log_t; | 36 | typedef struct Lisp_Hash_Table log_t; |
| 37 | 37 | ||
| 38 | static Lisp_Object Qprofiler_backtrace_equal; | ||
| 39 | static struct hash_table_test hashtest_profiler; | 38 | static struct hash_table_test hashtest_profiler; |
| 40 | 39 | ||
| 41 | static Lisp_Object | 40 | static Lisp_Object |
diff --git a/src/search.c b/src/search.c index 2e9c992dc24..0252542a361 100644 --- a/src/search.c +++ b/src/search.c | |||
| @@ -84,12 +84,6 @@ static struct re_registers search_regs; | |||
| 84 | Qnil if no searching has been done yet. */ | 84 | Qnil if no searching has been done yet. */ |
| 85 | static Lisp_Object last_thing_searched; | 85 | static Lisp_Object last_thing_searched; |
| 86 | 86 | ||
| 87 | /* Error condition signaled when regexp compile_pattern fails. */ | ||
| 88 | static Lisp_Object Qinvalid_regexp; | ||
| 89 | |||
| 90 | /* Error condition used for failing searches. */ | ||
| 91 | static Lisp_Object Qsearch_failed; | ||
| 92 | |||
| 93 | static void set_search_regs (ptrdiff_t, ptrdiff_t); | 87 | static void set_search_regs (ptrdiff_t, ptrdiff_t); |
| 94 | static void save_search_regs (void); | 88 | static void save_search_regs (void); |
| 95 | static EMACS_INT simple_search (EMACS_INT, unsigned char *, ptrdiff_t, | 89 | static EMACS_INT simple_search (EMACS_INT, unsigned char *, ptrdiff_t, |
| @@ -3329,7 +3323,10 @@ syms_of_search (void) | |||
| 3329 | } | 3323 | } |
| 3330 | searchbuf_head = &searchbufs[0]; | 3324 | searchbuf_head = &searchbufs[0]; |
| 3331 | 3325 | ||
| 3326 | /* Error condition used for failing searches. */ | ||
| 3332 | DEFSYM (Qsearch_failed, "search-failed"); | 3327 | DEFSYM (Qsearch_failed, "search-failed"); |
| 3328 | |||
| 3329 | /* Error condition signaled when regexp compile_pattern fails. */ | ||
| 3333 | DEFSYM (Qinvalid_regexp, "invalid-regexp"); | 3330 | DEFSYM (Qinvalid_regexp, "invalid-regexp"); |
| 3334 | 3331 | ||
| 3335 | Fput (Qsearch_failed, Qerror_conditions, | 3332 | Fput (Qsearch_failed, Qerror_conditions, |
diff --git a/src/sound.c b/src/sound.c index 88d86f6f84a..6f7e2adecc9 100644 --- a/src/sound.c +++ b/src/sound.c | |||
| @@ -99,12 +99,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 99 | 99 | ||
| 100 | /* BEGIN: Common Definitions */ | 100 | /* BEGIN: Common Definitions */ |
| 101 | 101 | ||
| 102 | /* Symbols. */ | ||
| 103 | |||
| 104 | static Lisp_Object QCvolume, QCdevice; | ||
| 105 | static Lisp_Object Qsound; | ||
| 106 | static Lisp_Object Qplay_sound_functions; | ||
| 107 | |||
| 108 | /* Indices of attributes in a sound attributes vector. */ | 102 | /* Indices of attributes in a sound attributes vector. */ |
| 109 | 103 | ||
| 110 | enum sound_attr | 104 | enum sound_attr |
diff --git a/src/syntax.c b/src/syntax.c index a7ca6ec9748..2f821564294 100644 --- a/src/syntax.c +++ b/src/syntax.c | |||
| @@ -137,9 +137,6 @@ enum | |||
| 137 | ST_STRING_STYLE = 256 + 2 | 137 | ST_STRING_STYLE = 256 + 2 |
| 138 | }; | 138 | }; |
| 139 | 139 | ||
| 140 | static Lisp_Object Qsyntax_table_p; | ||
| 141 | static Lisp_Object Qsyntax_table, Qscan_error; | ||
| 142 | |||
| 143 | /* This is the internal form of the parse state used in parse-partial-sexp. */ | 140 | /* This is the internal form of the parse state used in parse-partial-sexp. */ |
| 144 | 141 | ||
| 145 | struct lisp_parse_state | 142 | struct lisp_parse_state |
| @@ -3500,11 +3497,6 @@ init_syntax_once (void) | |||
| 3500 | /* This has to be done here, before we call Fmake_char_table. */ | 3497 | /* This has to be done here, before we call Fmake_char_table. */ |
| 3501 | DEFSYM (Qsyntax_table, "syntax-table"); | 3498 | DEFSYM (Qsyntax_table, "syntax-table"); |
| 3502 | 3499 | ||
| 3503 | /* This variable is DEFSYMed in alloc.c and not initialized yet, so | ||
| 3504 | intern it here. NOTE: you must guarantee that init_syntax_once | ||
| 3505 | is called before all other users of this variable. */ | ||
| 3506 | Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots"); | ||
| 3507 | |||
| 3508 | /* Create objects which can be shared among syntax tables. */ | 3500 | /* Create objects which can be shared among syntax tables. */ |
| 3509 | Vsyntax_code_object = make_uninit_vector (Smax); | 3501 | Vsyntax_code_object = make_uninit_vector (Smax); |
| 3510 | for (i = 0; i < Smax; i++) | 3502 | for (i = 0; i < Smax; i++) |
diff --git a/src/term.c b/src/term.c index 48447bce5fd..d48bf7b6eaf 100644 --- a/src/term.c +++ b/src/term.c | |||
| @@ -130,9 +130,6 @@ enum no_color_bit | |||
| 130 | 130 | ||
| 131 | static int max_frame_cols; | 131 | static int max_frame_cols; |
| 132 | 132 | ||
| 133 | static Lisp_Object Qtty_mode_set_strings; | ||
| 134 | static Lisp_Object Qtty_mode_reset_strings; | ||
| 135 | |||
| 136 | 133 | ||
| 137 | 134 | ||
| 138 | #ifdef HAVE_GPM | 135 | #ifdef HAVE_GPM |
| @@ -2710,12 +2707,6 @@ static const char *menu_help_message, *prev_menu_help_message; | |||
| 2710 | last menu help message. */ | 2707 | last menu help message. */ |
| 2711 | static int menu_help_paneno, menu_help_itemno; | 2708 | static int menu_help_paneno, menu_help_itemno; |
| 2712 | 2709 | ||
| 2713 | static Lisp_Object Qtty_menu_navigation_map, Qtty_menu_exit; | ||
| 2714 | static Lisp_Object Qtty_menu_prev_item, Qtty_menu_next_item; | ||
| 2715 | static Lisp_Object Qtty_menu_next_menu, Qtty_menu_prev_menu; | ||
| 2716 | static Lisp_Object Qtty_menu_select, Qtty_menu_ignore; | ||
| 2717 | static Lisp_Object Qtty_menu_mouse_movement; | ||
| 2718 | |||
| 2719 | typedef struct tty_menu_struct | 2710 | typedef struct tty_menu_struct |
| 2720 | { | 2711 | { |
| 2721 | int count; | 2712 | int count; |
diff --git a/src/terminal.c b/src/terminal.c index 65b68955dbf..92befd28543 100644 --- a/src/terminal.c +++ b/src/terminal.c | |||
| @@ -37,10 +37,6 @@ static int next_terminal_id; | |||
| 37 | /* The initial terminal device, created by initial_term_init. */ | 37 | /* The initial terminal device, created by initial_term_init. */ |
| 38 | struct terminal *initial_terminal; | 38 | struct terminal *initial_terminal; |
| 39 | 39 | ||
| 40 | Lisp_Object Qrun_hook_with_args; | ||
| 41 | static Lisp_Object Qterminal_live_p; | ||
| 42 | static Lisp_Object Qdelete_terminal_functions; | ||
| 43 | |||
| 44 | static void delete_initial_terminal (struct terminal *); | 40 | static void delete_initial_terminal (struct terminal *); |
| 45 | 41 | ||
| 46 | /* This setter is used only in this file, so it can be private. */ | 42 | /* This setter is used only in this file, so it can be private. */ |
diff --git a/src/textprop.c b/src/textprop.c index 27ab08f628c..35f22bf454e 100644 --- a/src/textprop.c +++ b/src/textprop.c | |||
| @@ -44,21 +44,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 44 | is enforced by the subrs installing properties onto the intervals. */ | 44 | is enforced by the subrs installing properties onto the intervals. */ |
| 45 | 45 | ||
| 46 | 46 | ||
| 47 | /* Types of hooks. */ | ||
| 48 | static Lisp_Object Qmouse_left; | ||
| 49 | static Lisp_Object Qmouse_entered; | ||
| 50 | Lisp_Object Qpoint_left; | ||
| 51 | Lisp_Object Qpoint_entered; | ||
| 52 | Lisp_Object Qcategory; | ||
| 53 | Lisp_Object Qlocal_map; | ||
| 54 | |||
| 55 | /* Visual properties text (including strings) may have. */ | ||
| 56 | static Lisp_Object Qforeground, Qbackground, Qunderline; | ||
| 57 | Lisp_Object Qfont; | ||
| 58 | static Lisp_Object Qstipple; | ||
| 59 | Lisp_Object Qinvisible, Qintangible, Qmouse_face; | ||
| 60 | static Lisp_Object Qread_only; | ||
| 61 | Lisp_Object Qminibuffer_prompt; | ||
| 62 | 47 | ||
| 63 | enum property_set_type | 48 | enum property_set_type |
| 64 | { | 49 | { |
| @@ -67,9 +52,6 @@ enum property_set_type | |||
| 67 | TEXT_PROPERTY_APPEND | 52 | TEXT_PROPERTY_APPEND |
| 68 | }; | 53 | }; |
| 69 | 54 | ||
| 70 | /* Sticky properties. */ | ||
| 71 | Lisp_Object Qfront_sticky, Qrear_nonsticky; | ||
| 72 | |||
| 73 | /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to | 55 | /* If o1 is a cons whose cdr is a cons, return non-zero and set o2 to |
| 74 | the o1's cdr. Otherwise, return zero. This is handy for | 56 | the o1's cdr. Otherwise, return zero. This is handy for |
| 75 | traversing plists. */ | 57 | traversing plists. */ |
| @@ -2383,7 +2365,7 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and | |||
| 2383 | interval_insert_in_front_hooks = Qnil; | 2365 | interval_insert_in_front_hooks = Qnil; |
| 2384 | 2366 | ||
| 2385 | 2367 | ||
| 2386 | /* Common attributes one might give text */ | 2368 | /* Common attributes one might give text. */ |
| 2387 | 2369 | ||
| 2388 | DEFSYM (Qforeground, "foreground"); | 2370 | DEFSYM (Qforeground, "foreground"); |
| 2389 | DEFSYM (Qbackground, "background"); | 2371 | DEFSYM (Qbackground, "background"); |
| @@ -2401,7 +2383,7 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and | |||
| 2401 | DEFSYM (Qmouse_face, "mouse-face"); | 2383 | DEFSYM (Qmouse_face, "mouse-face"); |
| 2402 | DEFSYM (Qminibuffer_prompt, "minibuffer-prompt"); | 2384 | DEFSYM (Qminibuffer_prompt, "minibuffer-prompt"); |
| 2403 | 2385 | ||
| 2404 | /* Properties that text might use to specify certain actions */ | 2386 | /* Properties that text might use to specify certain actions. */ |
| 2405 | 2387 | ||
| 2406 | DEFSYM (Qmouse_left, "mouse-left"); | 2388 | DEFSYM (Qmouse_left, "mouse-left"); |
| 2407 | DEFSYM (Qmouse_entered, "mouse-entered"); | 2389 | DEFSYM (Qmouse_entered, "mouse-entered"); |
diff --git a/src/undo.c b/src/undo.c index 46b467ac6b4..948dcf9ec1a 100644 --- a/src/undo.c +++ b/src/undo.c | |||
| @@ -34,12 +34,6 @@ static struct buffer *last_undo_buffer; | |||
| 34 | static struct buffer *last_boundary_buffer; | 34 | static struct buffer *last_boundary_buffer; |
| 35 | static ptrdiff_t last_boundary_position; | 35 | static ptrdiff_t last_boundary_position; |
| 36 | 36 | ||
| 37 | Lisp_Object Qinhibit_read_only; | ||
| 38 | |||
| 39 | /* Marker for function call undo list elements. */ | ||
| 40 | |||
| 41 | Lisp_Object Qapply; | ||
| 42 | |||
| 43 | /* The first time a command records something for undo. | 37 | /* The first time a command records something for undo. |
| 44 | it also allocates the undo-boundary object | 38 | it also allocates the undo-boundary object |
| 45 | which will be added to the list at the end of the command. | 39 | which will be added to the list at the end of the command. |
| @@ -461,6 +455,8 @@ void | |||
| 461 | syms_of_undo (void) | 455 | syms_of_undo (void) |
| 462 | { | 456 | { |
| 463 | DEFSYM (Qinhibit_read_only, "inhibit-read-only"); | 457 | DEFSYM (Qinhibit_read_only, "inhibit-read-only"); |
| 458 | |||
| 459 | /* Marker for function call undo list elements. */ | ||
| 464 | DEFSYM (Qapply, "apply"); | 460 | DEFSYM (Qapply, "apply"); |
| 465 | 461 | ||
| 466 | pending_boundary = Qnil; | 462 | pending_boundary = Qnil; |
| @@ -242,8 +242,6 @@ typedef struct _REPARSE_DATA_BUFFER { | |||
| 242 | typedef HRESULT (WINAPI * ShGetFolderPath_fn) | 242 | typedef HRESULT (WINAPI * ShGetFolderPath_fn) |
| 243 | (IN HWND, IN int, IN HANDLE, IN DWORD, OUT char *); | 243 | (IN HWND, IN int, IN HANDLE, IN DWORD, OUT char *); |
| 244 | 244 | ||
| 245 | Lisp_Object QCloaded_from; | ||
| 246 | |||
| 247 | void globals_of_w32 (void); | 245 | void globals_of_w32 (void); |
| 248 | static DWORD get_rid (PSID); | 246 | static DWORD get_rid (PSID); |
| 249 | static int is_symlink (const char *); | 247 | static int is_symlink (const char *); |
| @@ -172,7 +172,6 @@ extern void init_timers (void); | |||
| 172 | extern int _sys_read_ahead (int fd); | 172 | extern int _sys_read_ahead (int fd); |
| 173 | extern int _sys_wait_accept (int fd); | 173 | extern int _sys_wait_accept (int fd); |
| 174 | 174 | ||
| 175 | extern Lisp_Object QCloaded_from; | ||
| 176 | extern HMODULE w32_delayed_load (Lisp_Object); | 175 | extern HMODULE w32_delayed_load (Lisp_Object); |
| 177 | 176 | ||
| 178 | extern int (WINAPI *pMultiByteToWideChar)(UINT,DWORD,LPCSTR,int,LPWSTR,int); | 177 | extern int (WINAPI *pMultiByteToWideChar)(UINT,DWORD,LPCSTR,int,LPWSTR,int); |
diff --git a/src/w32fns.c b/src/w32fns.c index 26eeb5f76fb..789a91a3c96 100644 --- a/src/w32fns.c +++ b/src/w32fns.c | |||
| @@ -93,19 +93,6 @@ extern char * w32_strerror (int error_no); | |||
| 93 | #define IDC_HAND MAKEINTRESOURCE(32649) | 93 | #define IDC_HAND MAKEINTRESOURCE(32649) |
| 94 | #endif | 94 | #endif |
| 95 | 95 | ||
| 96 | Lisp_Object Qundefined_color; | ||
| 97 | Lisp_Object Qcancel_timer; | ||
| 98 | Lisp_Object Qfont_param; | ||
| 99 | Lisp_Object Qhyper; | ||
| 100 | Lisp_Object Qsuper; | ||
| 101 | Lisp_Object Qmeta; | ||
| 102 | Lisp_Object Qalt; | ||
| 103 | Lisp_Object Qctrl; | ||
| 104 | Lisp_Object Qcontrol; | ||
| 105 | Lisp_Object Qshift; | ||
| 106 | static Lisp_Object Qgeometry, Qworkarea, Qmm_size, Qframes; | ||
| 107 | |||
| 108 | |||
| 109 | /* Prefix for system colors. */ | 96 | /* Prefix for system colors. */ |
| 110 | #define SYSTEM_COLOR_PREFIX "System" | 97 | #define SYSTEM_COLOR_PREFIX "System" |
| 111 | #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1) | 98 | #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1) |
| @@ -6141,7 +6128,7 @@ Text larger than the specified size is clipped. */) | |||
| 6141 | place the cursor there. Don't include the width of | 6128 | place the cursor there. Don't include the width of |
| 6142 | this glyph. */ | 6129 | this glyph. */ |
| 6143 | last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; | 6130 | last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; |
| 6144 | if (INTEGERP (last->object)) | 6131 | if (NILP (last->object)) |
| 6145 | row_width -= last->pixel_width; | 6132 | row_width -= last->pixel_width; |
| 6146 | } | 6133 | } |
| 6147 | else | 6134 | else |
| @@ -6151,7 +6138,7 @@ Text larger than the specified size is clipped. */) | |||
| 6151 | Don't count that glyph. */ | 6138 | Don't count that glyph. */ |
| 6152 | struct glyph *g = row->glyphs[TEXT_AREA]; | 6139 | struct glyph *g = row->glyphs[TEXT_AREA]; |
| 6153 | 6140 | ||
| 6154 | if (g->type == STRETCH_GLYPH && INTEGERP (g->object)) | 6141 | if (g->type == STRETCH_GLYPH && NILP (g->object)) |
| 6155 | { | 6142 | { |
| 6156 | row_width -= g->pixel_width; | 6143 | row_width -= g->pixel_width; |
| 6157 | seen_reversed_p = 1; | 6144 | seen_reversed_p = 1; |
| @@ -6200,7 +6187,7 @@ Text larger than the specified size is clipped. */) | |||
| 6200 | if (row->used[TEXT_AREA] && !row->reversed_p) | 6187 | if (row->used[TEXT_AREA] && !row->reversed_p) |
| 6201 | { | 6188 | { |
| 6202 | last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; | 6189 | last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; |
| 6203 | if (INTEGERP (last->object)) | 6190 | if (NILP (last->object)) |
| 6204 | row_width -= last->pixel_width; | 6191 | row_width -= last->pixel_width; |
| 6205 | } | 6192 | } |
| 6206 | 6193 | ||
| @@ -7248,7 +7235,7 @@ The return value is the hotkey-id if registered, otherwise nil. */) | |||
| 7248 | /* Notify input thread about new hot-key definition, so that it | 7235 | /* Notify input thread about new hot-key definition, so that it |
| 7249 | takes effect without needing to switch focus. */ | 7236 | takes effect without needing to switch focus. */ |
| 7250 | PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY, | 7237 | PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY, |
| 7251 | (WPARAM) XLI (key), 0); | 7238 | (WPARAM) XINT (key), 0); |
| 7252 | } | 7239 | } |
| 7253 | 7240 | ||
| 7254 | return key; | 7241 | return key; |
diff --git a/src/w32font.c b/src/w32font.c index 1b0a8a2e7c4..ab772679908 100644 --- a/src/w32font.c +++ b/src/w32font.c | |||
| @@ -57,51 +57,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 57 | #define JOHAB_CHARSET 130 | 57 | #define JOHAB_CHARSET 130 |
| 58 | #endif | 58 | #endif |
| 59 | 59 | ||
| 60 | Lisp_Object Qgdi; | ||
| 61 | Lisp_Object Quniscribe; | ||
| 62 | static Lisp_Object QCformat; | ||
| 63 | static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif; | ||
| 64 | static Lisp_Object Qserif, Qscript, Qdecorative; | ||
| 65 | static Lisp_Object Qraster, Qoutline, Qunknown; | ||
| 66 | |||
| 67 | /* antialiasing */ | ||
| 68 | static Lisp_Object Qstandard, Qsubpixel, Qnatural; | ||
| 69 | |||
| 70 | /* languages */ | ||
| 71 | static Lisp_Object Qzh; | ||
| 72 | |||
| 73 | /* scripts */ | ||
| 74 | static Lisp_Object Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew; | ||
| 75 | static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali; | ||
| 76 | static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu; | ||
| 77 | static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao; | ||
| 78 | static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic; | ||
| 79 | static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic; | ||
| 80 | static Lisp_Object Qkhmer, Qmongolian, Qbraille, Qhan; | ||
| 81 | static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo; | ||
| 82 | static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol; | ||
| 83 | static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic; | ||
| 84 | /* Not defined in characters.el, but referenced in fontset.el. */ | ||
| 85 | static Lisp_Object Qbalinese, Qbuginese, Qbuhid, Qcuneiform, Qcypriot; | ||
| 86 | static Lisp_Object Qdeseret, Qglagolitic, Qgothic, Qhanunoo, Qkharoshthi; | ||
| 87 | static Lisp_Object Qlimbu, Qlinear_b, Qold_italic, Qold_persian, Qosmanya; | ||
| 88 | static Lisp_Object Qphags_pa, Qphoenician, Qshavian, Qsyloti_nagri; | ||
| 89 | static Lisp_Object Qtagalog, Qtagbanwa, Qtai_le, Qtifinagh, Qugaritic; | ||
| 90 | |||
| 91 | /* W32 charsets: for use in Vw32_charset_info_alist. */ | ||
| 92 | static Lisp_Object Qw32_charset_ansi, Qw32_charset_default; | ||
| 93 | static Lisp_Object Qw32_charset_symbol, Qw32_charset_shiftjis; | ||
| 94 | static Lisp_Object Qw32_charset_hangeul, Qw32_charset_gb2312; | ||
| 95 | static Lisp_Object Qw32_charset_chinesebig5, Qw32_charset_oem; | ||
| 96 | static Lisp_Object Qw32_charset_easteurope, Qw32_charset_turkish; | ||
| 97 | static Lisp_Object Qw32_charset_baltic, Qw32_charset_russian; | ||
| 98 | static Lisp_Object Qw32_charset_arabic, Qw32_charset_greek; | ||
| 99 | static Lisp_Object Qw32_charset_hebrew, Qw32_charset_vietnamese; | ||
| 100 | static Lisp_Object Qw32_charset_thai, Qw32_charset_johab, Qw32_charset_mac; | ||
| 101 | |||
| 102 | /* Font spacing symbols - defined in font.c. */ | ||
| 103 | extern Lisp_Object Qc, Qp, Qm; | ||
| 104 | |||
| 105 | static void fill_in_logfont (struct frame *, LOGFONT *, Lisp_Object); | 60 | static void fill_in_logfont (struct frame *, LOGFONT *, Lisp_Object); |
| 106 | 61 | ||
| 107 | static BYTE w32_antialias_type (Lisp_Object); | 62 | static BYTE w32_antialias_type (Lisp_Object); |
| @@ -291,7 +246,7 @@ intern_font_name (char * string) | |||
| 291 | Lisp_Object obarray = check_obarray (Vobarray); | 246 | Lisp_Object obarray = check_obarray (Vobarray); |
| 292 | Lisp_Object tem = oblookup (obarray, SDATA (str), len, len); | 247 | Lisp_Object tem = oblookup (obarray, SDATA (str), len, len); |
| 293 | /* This code is similar to intern function from lread.c. */ | 248 | /* This code is similar to intern function from lread.c. */ |
| 294 | return SYMBOLP (tem) ? tem : intern_driver (str, obarray, XINT (tem)); | 249 | return SYMBOLP (tem) ? tem : intern_driver (str, obarray, tem); |
| 295 | } | 250 | } |
| 296 | 251 | ||
| 297 | /* w32 implementation of get_cache for font backend. | 252 | /* w32 implementation of get_cache for font backend. |
diff --git a/src/w32inevt.c b/src/w32inevt.c index daf4a5c2375..e09903f99be 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c | |||
| @@ -657,11 +657,12 @@ handle_file_notifications (struct input_event *hold_quit) | |||
| 657 | Lisp_Object action = lispy_file_action (fni->Action); | 657 | Lisp_Object action = lispy_file_action (fni->Action); |
| 658 | 658 | ||
| 659 | inev.kind = FILE_NOTIFY_EVENT; | 659 | inev.kind = FILE_NOTIFY_EVENT; |
| 660 | inev.code = (ptrdiff_t)XINT (XIL ((EMACS_INT)notifications_desc)); | ||
| 661 | inev.timestamp = GetTickCount (); | 660 | inev.timestamp = GetTickCount (); |
| 662 | inev.modifiers = 0; | 661 | inev.modifiers = 0; |
| 663 | inev.frame_or_window = callback; | 662 | inev.frame_or_window = callback; |
| 664 | inev.arg = Fcons (action, fname); | 663 | inev.arg = Fcons (action, fname); |
| 664 | inev.arg = list3 (make_pointer_integer (notifications_desc), | ||
| 665 | action, fname); | ||
| 665 | kbd_buffer_store_event_hold (&inev, hold_quit); | 666 | kbd_buffer_store_event_hold (&inev, hold_quit); |
| 666 | 667 | ||
| 667 | if (!fni->NextEntryOffset) | 668 | if (!fni->NextEntryOffset) |
diff --git a/src/w32menu.c b/src/w32menu.c index 72e0cab2ce8..7a946d2dc75 100644 --- a/src/w32menu.c +++ b/src/w32menu.c | |||
| @@ -98,8 +98,6 @@ AppendMenuW_Proc unicode_append_menu = NULL; | |||
| 98 | MessageBoxW_Proc unicode_message_box = NULL; | 98 | MessageBoxW_Proc unicode_message_box = NULL; |
| 99 | #endif /* NTGUI_UNICODE */ | 99 | #endif /* NTGUI_UNICODE */ |
| 100 | 100 | ||
| 101 | Lisp_Object Qdebug_on_next_call, Qunsupported__w32_dialog; | ||
| 102 | |||
| 103 | void set_frame_menubar (struct frame *, bool, bool); | 101 | void set_frame_menubar (struct frame *, bool, bool); |
| 104 | 102 | ||
| 105 | #ifdef HAVE_DIALOGS | 103 | #ifdef HAVE_DIALOGS |
diff --git a/src/w32notify.c b/src/w32notify.c index 764ded6559f..ab6cd12ab93 100644 --- a/src/w32notify.c +++ b/src/w32notify.c | |||
| @@ -118,9 +118,7 @@ BYTE file_notifications[16384]; | |||
| 118 | DWORD notifications_size; | 118 | DWORD notifications_size; |
| 119 | void *notifications_desc; | 119 | void *notifications_desc; |
| 120 | 120 | ||
| 121 | static Lisp_Object Qfile_name, Qdirectory_name, Qattributes; | 121 | static Lisp_Object watch_list; |
| 122 | static Lisp_Object Qlast_write_time, Qlast_access_time, Qcreation_time; | ||
| 123 | static Lisp_Object Qsecurity_desc, Qsubtree, watch_list; | ||
| 124 | 122 | ||
| 125 | /* Signal to the main thread that we have file notifications for it to | 123 | /* Signal to the main thread that we have file notifications for it to |
| 126 | process. */ | 124 | process. */ |
| @@ -582,7 +580,7 @@ generate notifications correctly, though. */) | |||
| 582 | report_file_error ("Cannot watch file", Fcons (file, Qnil)); | 580 | report_file_error ("Cannot watch file", Fcons (file, Qnil)); |
| 583 | } | 581 | } |
| 584 | /* Store watch object in watch list. */ | 582 | /* Store watch object in watch list. */ |
| 585 | watch_descriptor = XIL ((EMACS_INT)dirwatch); | 583 | watch_descriptor = make_pointer_integer (dirwatch); |
| 586 | watch_object = Fcons (watch_descriptor, callback); | 584 | watch_object = Fcons (watch_descriptor, callback); |
| 587 | watch_list = Fcons (watch_object, watch_list); | 585 | watch_list = Fcons (watch_object, watch_list); |
| 588 | 586 | ||
| @@ -607,7 +605,7 @@ WATCH-DESCRIPTOR should be an object returned by `w32notify-add-watch'. */) | |||
| 607 | if (!NILP (watch_object)) | 605 | if (!NILP (watch_object)) |
| 608 | { | 606 | { |
| 609 | watch_list = Fdelete (watch_object, watch_list); | 607 | watch_list = Fdelete (watch_object, watch_list); |
| 610 | dirwatch = (struct notification *)XLI (watch_descriptor); | 608 | dirwatch = (struct notification *)XINTPTR (watch_descriptor); |
| 611 | if (w32_valid_pointer_p (dirwatch, sizeof(struct notification))) | 609 | if (w32_valid_pointer_p (dirwatch, sizeof(struct notification))) |
| 612 | status = remove_watch (dirwatch); | 610 | status = remove_watch (dirwatch); |
| 613 | } | 611 | } |
| @@ -622,7 +620,7 @@ WATCH-DESCRIPTOR should be an object returned by `w32notify-add-watch'. */) | |||
| 622 | Lisp_Object | 620 | Lisp_Object |
| 623 | w32_get_watch_object (void *desc) | 621 | w32_get_watch_object (void *desc) |
| 624 | { | 622 | { |
| 625 | Lisp_Object descriptor = XIL ((EMACS_INT)desc); | 623 | Lisp_Object descriptor = make_pointer_integer (desc); |
| 626 | 624 | ||
| 627 | /* This is called from the input queue handling code, inside a | 625 | /* This is called from the input queue handling code, inside a |
| 628 | critical section, so we cannot possibly QUIT if watch_list is not | 626 | critical section, so we cannot possibly QUIT if watch_list is not |
diff --git a/src/w32proc.c b/src/w32proc.c index 0c178e7a2f6..26cfa2996d0 100644 --- a/src/w32proc.c +++ b/src/w32proc.c | |||
| @@ -72,8 +72,6 @@ extern BOOL WINAPI IsValidLocale (LCID, DWORD); | |||
| 72 | + ((DWORD_PTR)(var) - (section)->VirtualAddress) \ | 72 | + ((DWORD_PTR)(var) - (section)->VirtualAddress) \ |
| 73 | + (filedata).file_base)) | 73 | + (filedata).file_base)) |
| 74 | 74 | ||
| 75 | Lisp_Object Qhigh, Qlow; | ||
| 76 | |||
| 77 | /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */ | 75 | /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */ |
| 78 | static signal_handler sig_handlers[NSIG]; | 76 | static signal_handler sig_handlers[NSIG]; |
| 79 | 77 | ||
diff --git a/src/w32select.c b/src/w32select.c index f133f6d44e3..3c554c622ae 100644 --- a/src/w32select.c +++ b/src/w32select.c | |||
| @@ -107,17 +107,11 @@ static Lisp_Object validate_coding_system (Lisp_Object coding_system); | |||
| 107 | static void setup_windows_coding_system (Lisp_Object coding_system, | 107 | static void setup_windows_coding_system (Lisp_Object coding_system, |
| 108 | struct coding_system * coding); | 108 | struct coding_system * coding); |
| 109 | 109 | ||
| 110 | |||
| 111 | /* A remnant from X11: Symbol for the CLIPBORD selection type. Other | ||
| 112 | selections are not used on Windows, so we don't need symbols for | ||
| 113 | PRIMARY and SECONDARY. */ | ||
| 114 | Lisp_Object QCLIPBOARD; | ||
| 115 | |||
| 116 | /* Internal pseudo-constants, initialized in globals_of_w32select() | 110 | /* Internal pseudo-constants, initialized in globals_of_w32select() |
| 117 | based on current system parameters. */ | 111 | based on current system parameters. */ |
| 118 | static LCID DEFAULT_LCID; | 112 | static LCID DEFAULT_LCID; |
| 119 | static UINT ANSICP, OEMCP; | 113 | static UINT ANSICP, OEMCP; |
| 120 | static Lisp_Object QUNICODE, QANSICP, QOEMCP; | 114 | static Lisp_Object QANSICP, QOEMCP; |
| 121 | 115 | ||
| 122 | /* A hidden window just for the clipboard management. */ | 116 | /* A hidden window just for the clipboard management. */ |
| 123 | static HWND clipboard_owner; | 117 | static HWND clipboard_owner; |
diff --git a/src/w32term.c b/src/w32term.c index e692d9df475..ce28e05a45b 100644 --- a/src/w32term.c +++ b/src/w32term.c | |||
| @@ -220,10 +220,6 @@ static void w32fullscreen_hook (struct frame *); | |||
| 220 | static void x_check_font (struct frame *, struct font *); | 220 | static void x_check_font (struct frame *, struct font *); |
| 221 | #endif | 221 | #endif |
| 222 | 222 | ||
| 223 | static Lisp_Object Qvendor_specific_keysyms; | ||
| 224 | static Lisp_Object Qadded, Qremoved, Qmodified; | ||
| 225 | static Lisp_Object Qrenamed_from, Qrenamed_to; | ||
| 226 | |||
| 227 | 223 | ||
| 228 | /*********************************************************************** | 224 | /*********************************************************************** |
| 229 | Debugging | 225 | Debugging |
| @@ -3251,12 +3247,11 @@ queue_notifications (struct input_event *event, W32Msg *msg, struct frame *f, | |||
| 3251 | Lisp_Object action = lispy_file_action (fni->Action); | 3247 | Lisp_Object action = lispy_file_action (fni->Action); |
| 3252 | 3248 | ||
| 3253 | event->kind = FILE_NOTIFY_EVENT; | 3249 | event->kind = FILE_NOTIFY_EVENT; |
| 3254 | event->code | ||
| 3255 | = (ptrdiff_t)XINT (XIL ((EMACS_INT)notifications_desc)); | ||
| 3256 | event->timestamp = msg->msg.time; | 3250 | event->timestamp = msg->msg.time; |
| 3257 | event->modifiers = 0; | 3251 | event->modifiers = 0; |
| 3258 | event->frame_or_window = callback; | 3252 | event->frame_or_window = callback; |
| 3259 | event->arg = Fcons (action, fname); | 3253 | event->arg = list3 (make_pointer_integer (notifications_desc), |
| 3254 | action, fname); | ||
| 3260 | kbd_buffer_store_event (event); | 3255 | kbd_buffer_store_event (event); |
| 3261 | (*evcount)++; | 3256 | (*evcount)++; |
| 3262 | 3257 | ||
diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 29fea6a0b11..2a7fe2e6f91 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c | |||
| @@ -47,10 +47,6 @@ struct uniscribe_font_info | |||
| 47 | 47 | ||
| 48 | int uniscribe_available = 0; | 48 | int uniscribe_available = 0; |
| 49 | 49 | ||
| 50 | /* Defined in w32font.c, since it is required there as well. */ | ||
| 51 | extern Lisp_Object Quniscribe; | ||
| 52 | extern Lisp_Object Qopentype; | ||
| 53 | |||
| 54 | /* EnumFontFamiliesEx callback. */ | 50 | /* EnumFontFamiliesEx callback. */ |
| 55 | static int CALLBACK ALIGN_STACK add_opentype_font_name_to_list (ENUMLOGFONTEX *, | 51 | static int CALLBACK ALIGN_STACK add_opentype_font_name_to_list (ENUMLOGFONTEX *, |
| 56 | NEWTEXTMETRICEX *, | 52 | NEWTEXTMETRICEX *, |
diff --git a/src/window.c b/src/window.c index 4da33501323..4dec9768e2c 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -48,20 +48,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 48 | #include "xwidget.h" | 48 | #include "xwidget.h" |
| 49 | #endif | 49 | #endif |
| 50 | 50 | ||
| 51 | Lisp_Object Qwindowp, Qwindow_live_p; | ||
| 52 | static Lisp_Object Qwindow_valid_p; | ||
| 53 | static Lisp_Object Qwindow_configuration_p; | ||
| 54 | static Lisp_Object Qrecord_window_buffer; | ||
| 55 | static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; | ||
| 56 | static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; | ||
| 57 | static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; | ||
| 58 | static Lisp_Object Qwindow_sanitize_window_sizes; | ||
| 59 | static Lisp_Object Qwindow_pixel_to_total; | ||
| 60 | static Lisp_Object Qscroll_up, Qscroll_down, Qscroll_command; | ||
| 61 | static Lisp_Object Qsafe, Qabove, Qbelow, Qwindow_size, Qclone_of; | ||
| 62 | static Lisp_Object Qfloor, Qceiling; | ||
| 63 | static Lisp_Object Qwindow_point_insertion_type; | ||
| 64 | |||
| 65 | static int displayed_window_lines (struct window *); | 51 | static int displayed_window_lines (struct window *); |
| 66 | static int count_windows (struct window *); | 52 | static int count_windows (struct window *); |
| 67 | static int get_leaf_windows (struct window *, struct window **, int); | 53 | static int get_leaf_windows (struct window *, struct window **, int); |
| @@ -118,15 +104,9 @@ Lisp_Object minibuf_window; | |||
| 118 | shown as the selected window when the minibuffer is selected. */ | 104 | shown as the selected window when the minibuffer is selected. */ |
| 119 | Lisp_Object minibuf_selected_window; | 105 | Lisp_Object minibuf_selected_window; |
| 120 | 106 | ||
| 121 | /* Hook run at end of temp_output_buffer_show. */ | ||
| 122 | static Lisp_Object Qtemp_buffer_show_hook; | ||
| 123 | |||
| 124 | /* Incremented for each window created. */ | 107 | /* Incremented for each window created. */ |
| 125 | static int sequence_number; | 108 | static int sequence_number; |
| 126 | 109 | ||
| 127 | /* Hook to run when window config changes. */ | ||
| 128 | static Lisp_Object Qwindow_configuration_change_hook; | ||
| 129 | |||
| 130 | /* Used by the function window_scroll_pixel_based. */ | 110 | /* Used by the function window_scroll_pixel_based. */ |
| 131 | static int window_scroll_pixel_based_preserve_x; | 111 | static int window_scroll_pixel_based_preserve_x; |
| 132 | static int window_scroll_pixel_based_preserve_y; | 112 | static int window_scroll_pixel_based_preserve_y; |
| @@ -997,7 +977,10 @@ or scroll bars. | |||
| 997 | If PIXELWISE is nil, return the largest integer smaller than WINDOW's | 977 | If PIXELWISE is nil, return the largest integer smaller than WINDOW's |
| 998 | pixel width divided by the character width of WINDOW's frame. This | 978 | pixel width divided by the character width of WINDOW's frame. This |
| 999 | means that if a column at the right of the text area is only partially | 979 | means that if a column at the right of the text area is only partially |
| 1000 | visible, that column is not counted. */) | 980 | visible, that column is not counted. |
| 981 | |||
| 982 | Note that the returned value includes the column reserved for the | ||
| 983 | continuation glyph. */) | ||
| 1001 | (Lisp_Object window, Lisp_Object pixelwise) | 984 | (Lisp_Object window, Lisp_Object pixelwise) |
| 1002 | { | 985 | { |
| 1003 | return make_number (window_body_width (decode_live_window (window), | 986 | return make_number (window_body_width (decode_live_window (window), |
| @@ -3656,7 +3639,7 @@ temp_output_buffer_show (register Lisp_Object buf) | |||
| 3656 | record_unwind_protect (select_window_norecord, prev_window); | 3639 | record_unwind_protect (select_window_norecord, prev_window); |
| 3657 | Fselect_window (window, Qt); | 3640 | Fselect_window (window, Qt); |
| 3658 | Fset_buffer (w->contents); | 3641 | Fset_buffer (w->contents); |
| 3659 | Frun_hooks (1, &Qtemp_buffer_show_hook); | 3642 | run_hook (Qtemp_buffer_show_hook); |
| 3660 | unbind_to (count, Qnil); | 3643 | unbind_to (count, Qnil); |
| 3661 | } | 3644 | } |
| 3662 | } | 3645 | } |
diff --git a/src/window.h b/src/window.h index 2ed0f3e9fbc..2ec28ab4e56 100644 --- a/src/window.h +++ b/src/window.h | |||
| @@ -1085,7 +1085,6 @@ struct glyph *get_phys_cursor_glyph (struct window *w); | |||
| 1085 | CHECK_TYPE (WINDOW_LIVE_P (WINDOW), Qwindow_live_p, WINDOW) | 1085 | CHECK_TYPE (WINDOW_LIVE_P (WINDOW), Qwindow_live_p, WINDOW) |
| 1086 | 1086 | ||
| 1087 | /* These used to be in lisp.h. */ | 1087 | /* These used to be in lisp.h. */ |
| 1088 | extern Lisp_Object Qwindow_live_p; | ||
| 1089 | extern Lisp_Object Vwindow_list; | 1088 | extern Lisp_Object Vwindow_list; |
| 1090 | 1089 | ||
| 1091 | extern Lisp_Object window_list (void); | 1090 | extern Lisp_Object window_list (void); |
diff --git a/src/xdisp.c b/src/xdisp.c index bd6ab628d43..8b68ab7ddf7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -327,52 +327,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 327 | 327 | ||
| 328 | #define INFINITY 10000000 | 328 | #define INFINITY 10000000 |
| 329 | 329 | ||
| 330 | Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map; | ||
| 331 | Lisp_Object Qwindow_scroll_functions; | ||
| 332 | static Lisp_Object Qwindow_text_change_functions; | ||
| 333 | static Lisp_Object Qredisplay_end_trigger_functions; | ||
| 334 | Lisp_Object Qinhibit_point_motion_hooks; | ||
| 335 | static Lisp_Object QCeval, QCpropertize; | ||
| 336 | Lisp_Object QCfile, QCdata; | ||
| 337 | static Lisp_Object Qfontified; | ||
| 338 | static Lisp_Object Qgrow_only; | ||
| 339 | static Lisp_Object Qinhibit_eval_during_redisplay; | ||
| 340 | static Lisp_Object Qbuffer_position, Qposition, Qobject; | ||
| 341 | static Lisp_Object Qright_to_left, Qleft_to_right; | ||
| 342 | |||
| 343 | /* Cursor shapes. */ | ||
| 344 | Lisp_Object Qbar, Qhbar, Qbox, Qhollow; | ||
| 345 | |||
| 346 | /* Pointer shapes. */ | ||
| 347 | static Lisp_Object Qarrow, Qhand; | ||
| 348 | Lisp_Object Qtext; | ||
| 349 | |||
| 350 | /* Holds the list (error). */ | 330 | /* Holds the list (error). */ |
| 351 | static Lisp_Object list_of_error; | 331 | static Lisp_Object list_of_error; |
| 352 | 332 | ||
| 353 | Lisp_Object Qfontification_functions; | ||
| 354 | |||
| 355 | static Lisp_Object Qwrap_prefix; | ||
| 356 | static Lisp_Object Qline_prefix; | ||
| 357 | static Lisp_Object Qredisplay_internal; | ||
| 358 | |||
| 359 | /* Non-nil means don't actually do any redisplay. */ | ||
| 360 | |||
| 361 | Lisp_Object Qinhibit_redisplay; | ||
| 362 | |||
| 363 | /* Names of text properties relevant for redisplay. */ | ||
| 364 | |||
| 365 | Lisp_Object Qdisplay; | ||
| 366 | |||
| 367 | Lisp_Object Qspace, QCalign_to; | ||
| 368 | static Lisp_Object QCrelative_width, QCrelative_height; | ||
| 369 | Lisp_Object Qleft_margin, Qright_margin; | ||
| 370 | static Lisp_Object Qspace_width, Qraise; | ||
| 371 | static Lisp_Object Qslice; | ||
| 372 | Lisp_Object Qcenter; | ||
| 373 | static Lisp_Object Qmargin, Qpointer; | ||
| 374 | static Lisp_Object Qline_height; | ||
| 375 | |||
| 376 | #ifdef HAVE_WINDOW_SYSTEM | 333 | #ifdef HAVE_WINDOW_SYSTEM |
| 377 | 334 | ||
| 378 | /* Test if overflow newline into fringe. Called with iterator IT | 335 | /* Test if overflow newline into fringe. Called with iterator IT |
| @@ -406,31 +363,6 @@ static Lisp_Object Qline_height; | |||
| 406 | && (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \ | 363 | && (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \ |
| 407 | || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) \ | 364 | || *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) \ |
| 408 | 365 | ||
| 409 | /* Name of the face used to highlight trailing whitespace. */ | ||
| 410 | |||
| 411 | static Lisp_Object Qtrailing_whitespace; | ||
| 412 | |||
| 413 | /* Name and number of the face used to highlight escape glyphs. */ | ||
| 414 | |||
| 415 | static Lisp_Object Qescape_glyph; | ||
| 416 | |||
| 417 | /* Name and number of the face used to highlight non-breaking spaces. */ | ||
| 418 | |||
| 419 | static Lisp_Object Qnobreak_space; | ||
| 420 | |||
| 421 | /* The symbol `image' which is the car of the lists used to represent | ||
| 422 | images in Lisp. Also a tool bar style. */ | ||
| 423 | |||
| 424 | Lisp_Object Qimage; | ||
| 425 | |||
| 426 | /* The image map types. */ | ||
| 427 | Lisp_Object QCmap; | ||
| 428 | static Lisp_Object QCpointer; | ||
| 429 | static Lisp_Object Qrect, Qcircle, Qpoly; | ||
| 430 | |||
| 431 | /* Tool bar styles */ | ||
| 432 | Lisp_Object Qboth, Qboth_horiz, Qtext_image_horiz; | ||
| 433 | |||
| 434 | /* Non-zero means print newline to stdout before next mini-buffer | 366 | /* Non-zero means print newline to stdout before next mini-buffer |
| 435 | message. */ | 367 | message. */ |
| 436 | 368 | ||
| @@ -480,21 +412,6 @@ static struct text_pos this_line_min_pos; | |||
| 480 | 412 | ||
| 481 | static struct buffer *this_line_buffer; | 413 | static struct buffer *this_line_buffer; |
| 482 | 414 | ||
| 483 | |||
| 484 | /* Values of those variables at last redisplay are stored as | ||
| 485 | properties on `overlay-arrow-position' symbol. However, if | ||
| 486 | Voverlay_arrow_position is a marker, last-arrow-position is its | ||
| 487 | numerical position. */ | ||
| 488 | |||
| 489 | static Lisp_Object Qlast_arrow_position, Qlast_arrow_string; | ||
| 490 | |||
| 491 | /* Alternative overlay-arrow-string and overlay-arrow-bitmap | ||
| 492 | properties on a symbol in overlay-arrow-variable-list. */ | ||
| 493 | |||
| 494 | static Lisp_Object Qoverlay_arrow_string, Qoverlay_arrow_bitmap; | ||
| 495 | |||
| 496 | Lisp_Object Qmenu_bar_update_hook; | ||
| 497 | |||
| 498 | /* Nonzero if an overlay arrow has been displayed in this window. */ | 415 | /* Nonzero if an overlay arrow has been displayed in this window. */ |
| 499 | 416 | ||
| 500 | static bool overlay_arrow_seen; | 417 | static bool overlay_arrow_seen; |
| @@ -570,11 +487,6 @@ static bool display_last_displayed_message_p; | |||
| 570 | 487 | ||
| 571 | static bool message_buf_print; | 488 | static bool message_buf_print; |
| 572 | 489 | ||
| 573 | /* The symbol `inhibit-menubar-update' and its DEFVAR_BOOL variable. */ | ||
| 574 | |||
| 575 | static Lisp_Object Qinhibit_menubar_update; | ||
| 576 | static Lisp_Object Qmessage_truncate_lines; | ||
| 577 | |||
| 578 | /* Set to 1 in clear_message to make redisplay_internal aware | 490 | /* Set to 1 in clear_message to make redisplay_internal aware |
| 579 | of an emptied echo area. */ | 491 | of an emptied echo area. */ |
| 580 | 492 | ||
| @@ -694,8 +606,6 @@ int trace_move; | |||
| 694 | #define TRACE_MOVE(x) (void) 0 | 606 | #define TRACE_MOVE(x) (void) 0 |
| 695 | #endif | 607 | #endif |
| 696 | 608 | ||
| 697 | static Lisp_Object Qauto_hscroll_mode; | ||
| 698 | |||
| 699 | /* Buffer being redisplayed -- for redisplay_window_error. */ | 609 | /* Buffer being redisplayed -- for redisplay_window_error. */ |
| 700 | 610 | ||
| 701 | static struct buffer *displayed_buffer; | 611 | static struct buffer *displayed_buffer; |
| @@ -715,8 +625,8 @@ enum prop_handled | |||
| 715 | 625 | ||
| 716 | struct props | 626 | struct props |
| 717 | { | 627 | { |
| 718 | /* The name of the property. */ | 628 | /* The symbol index of the name of the property. */ |
| 719 | Lisp_Object *name; | 629 | short name; |
| 720 | 630 | ||
| 721 | /* A unique index for the property. */ | 631 | /* A unique index for the property. */ |
| 722 | enum prop_idx idx; | 632 | enum prop_idx idx; |
| @@ -737,14 +647,14 @@ static enum prop_handled handle_fontified_prop (struct it *); | |||
| 737 | 647 | ||
| 738 | static struct props it_props[] = | 648 | static struct props it_props[] = |
| 739 | { | 649 | { |
| 740 | {&Qfontified, FONTIFIED_PROP_IDX, handle_fontified_prop}, | 650 | {SYMBOL_INDEX (Qfontified), FONTIFIED_PROP_IDX, handle_fontified_prop}, |
| 741 | /* Handle `face' before `display' because some sub-properties of | 651 | /* Handle `face' before `display' because some sub-properties of |
| 742 | `display' need to know the face. */ | 652 | `display' need to know the face. */ |
| 743 | {&Qface, FACE_PROP_IDX, handle_face_prop}, | 653 | {SYMBOL_INDEX (Qface), FACE_PROP_IDX, handle_face_prop}, |
| 744 | {&Qdisplay, DISPLAY_PROP_IDX, handle_display_prop}, | 654 | {SYMBOL_INDEX (Qdisplay), DISPLAY_PROP_IDX, handle_display_prop}, |
| 745 | {&Qinvisible, INVISIBLE_PROP_IDX, handle_invisible_prop}, | 655 | {SYMBOL_INDEX (Qinvisible), INVISIBLE_PROP_IDX, handle_invisible_prop}, |
| 746 | {&Qcomposition, COMPOSITION_PROP_IDX, handle_composition_prop}, | 656 | {SYMBOL_INDEX (Qcomposition), COMPOSITION_PROP_IDX, handle_composition_prop}, |
| 747 | {NULL, 0, NULL} | 657 | {0, 0, NULL} |
| 748 | }; | 658 | }; |
| 749 | 659 | ||
| 750 | /* Value is the position described by X. If X is a marker, value is | 660 | /* Value is the position described by X. If X is a marker, value is |
| @@ -799,9 +709,6 @@ static struct glyph_slice null_glyph_slice = { 0, 0, 0, 0 }; | |||
| 799 | 709 | ||
| 800 | bool redisplaying_p; | 710 | bool redisplaying_p; |
| 801 | 711 | ||
| 802 | static Lisp_Object Qinhibit_free_realized_faces; | ||
| 803 | static Lisp_Object Qmode_line_default_help_echo; | ||
| 804 | |||
| 805 | /* If a string, XTread_socket generates an event to display that string. | 712 | /* If a string, XTread_socket generates an event to display that string. |
| 806 | (The display is done in read_char.) */ | 713 | (The display is done in read_char.) */ |
| 807 | 714 | ||
| @@ -827,15 +734,6 @@ static struct atimer *hourglass_atimer; | |||
| 827 | 734 | ||
| 828 | #endif /* HAVE_WINDOW_SYSTEM */ | 735 | #endif /* HAVE_WINDOW_SYSTEM */ |
| 829 | 736 | ||
| 830 | /* Name of the face used to display glyphless characters. */ | ||
| 831 | static Lisp_Object Qglyphless_char; | ||
| 832 | |||
| 833 | /* Symbol for the purpose of Vglyphless_char_display. */ | ||
| 834 | static Lisp_Object Qglyphless_char_display; | ||
| 835 | |||
| 836 | /* Method symbols for Vglyphless_char_display. */ | ||
| 837 | static Lisp_Object Qhex_code, Qempty_box, Qthin_space, Qzero_width; | ||
| 838 | |||
| 839 | /* Default number of seconds to wait before displaying an hourglass | 737 | /* Default number of seconds to wait before displaying an hourglass |
| 840 | cursor. */ | 738 | cursor. */ |
| 841 | #define DEFAULT_HOURGLASS_DELAY 1 | 739 | #define DEFAULT_HOURGLASS_DELAY 1 |
| @@ -2702,8 +2600,6 @@ safe__call1 (bool inhibit_quit, Lisp_Object fn, ...) | |||
| 2702 | return retval; | 2600 | return retval; |
| 2703 | } | 2601 | } |
| 2704 | 2602 | ||
| 2705 | static Lisp_Object Qeval; | ||
| 2706 | |||
| 2707 | Lisp_Object | 2603 | Lisp_Object |
| 2708 | safe_eval (Lisp_Object sexpr) | 2604 | safe_eval (Lisp_Object sexpr) |
| 2709 | { | 2605 | { |
| @@ -3626,7 +3522,8 @@ compute_stop_pos (struct it *it) | |||
| 3626 | 3522 | ||
| 3627 | /* Get properties here. */ | 3523 | /* Get properties here. */ |
| 3628 | for (p = it_props; p->handler; ++p) | 3524 | for (p = it_props; p->handler; ++p) |
| 3629 | values_here[p->idx] = textget (iv->plist, *p->name); | 3525 | values_here[p->idx] = textget (iv->plist, |
| 3526 | builtin_lisp_symbol (p->name)); | ||
| 3630 | 3527 | ||
| 3631 | /* Look for an interval following iv that has different | 3528 | /* Look for an interval following iv that has different |
| 3632 | properties. */ | 3529 | properties. */ |
| @@ -3638,9 +3535,8 @@ compute_stop_pos (struct it *it) | |||
| 3638 | { | 3535 | { |
| 3639 | for (p = it_props; p->handler; ++p) | 3536 | for (p = it_props; p->handler; ++p) |
| 3640 | { | 3537 | { |
| 3641 | Lisp_Object new_value; | 3538 | Lisp_Object new_value = textget (next_iv->plist, |
| 3642 | 3539 | builtin_lisp_symbol (p->name)); | |
| 3643 | new_value = textget (next_iv->plist, *p->name); | ||
| 3644 | if (!EQ (values_here[p->idx], new_value)) | 3540 | if (!EQ (values_here[p->idx], new_value)) |
| 3645 | break; | 3541 | break; |
| 3646 | } | 3542 | } |
| @@ -8081,7 +7977,7 @@ next_element_from_c_string (struct it *it) | |||
| 8081 | eassert (!it->bidi_p || it->s == it->bidi_it.string.s); | 7977 | eassert (!it->bidi_p || it->s == it->bidi_it.string.s); |
| 8082 | it->what = IT_CHARACTER; | 7978 | it->what = IT_CHARACTER; |
| 8083 | BYTEPOS (it->position) = CHARPOS (it->position) = 0; | 7979 | BYTEPOS (it->position) = CHARPOS (it->position) = 0; |
| 8084 | it->object = Qnil; | 7980 | it->object = make_number (0); |
| 8085 | 7981 | ||
| 8086 | /* With bidi reordering, the character to display might not be the | 7982 | /* With bidi reordering, the character to display might not be the |
| 8087 | character at IT_CHARPOS. BIDI_IT.FIRST_ELT non-zero means that | 7983 | character at IT_CHARPOS. BIDI_IT.FIRST_ELT non-zero means that |
| @@ -13534,7 +13430,7 @@ redisplay_internal (void) | |||
| 13534 | specbind (Qinhibit_free_realized_faces, Qnil); | 13430 | specbind (Qinhibit_free_realized_faces, Qnil); |
| 13535 | 13431 | ||
| 13536 | /* Record this function, so it appears on the profiler's backtraces. */ | 13432 | /* Record this function, so it appears on the profiler's backtraces. */ |
| 13537 | record_in_backtrace (Qredisplay_internal, &Qnil, 0); | 13433 | record_in_backtrace (Qredisplay_internal, 0, 0); |
| 13538 | 13434 | ||
| 13539 | FOR_EACH_FRAME (tail, frame) | 13435 | FOR_EACH_FRAME (tail, frame) |
| 13540 | XFRAME (frame)->already_hscrolled_p = 0; | 13436 | XFRAME (frame)->already_hscrolled_p = 0; |
| @@ -14441,14 +14337,14 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, | |||
| 14441 | if (!row->reversed_p) | 14337 | if (!row->reversed_p) |
| 14442 | { | 14338 | { |
| 14443 | while (glyph < end | 14339 | while (glyph < end |
| 14444 | && INTEGERP (glyph->object) | 14340 | && NILP (glyph->object) |
| 14445 | && glyph->charpos < 0) | 14341 | && glyph->charpos < 0) |
| 14446 | { | 14342 | { |
| 14447 | x += glyph->pixel_width; | 14343 | x += glyph->pixel_width; |
| 14448 | ++glyph; | 14344 | ++glyph; |
| 14449 | } | 14345 | } |
| 14450 | while (end > glyph | 14346 | while (end > glyph |
| 14451 | && INTEGERP ((end - 1)->object) | 14347 | && NILP ((end - 1)->object) |
| 14452 | /* CHARPOS is zero for blanks and stretch glyphs | 14348 | /* CHARPOS is zero for blanks and stretch glyphs |
| 14453 | inserted by extend_face_to_end_of_line. */ | 14349 | inserted by extend_face_to_end_of_line. */ |
| 14454 | && (end - 1)->charpos <= 0) | 14350 | && (end - 1)->charpos <= 0) |
| @@ -14466,20 +14362,20 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, | |||
| 14466 | glyph += row->used[TEXT_AREA] - 1; | 14362 | glyph += row->used[TEXT_AREA] - 1; |
| 14467 | 14363 | ||
| 14468 | while (glyph > end + 1 | 14364 | while (glyph > end + 1 |
| 14469 | && INTEGERP (glyph->object) | 14365 | && NILP (glyph->object) |
| 14470 | && glyph->charpos < 0) | 14366 | && glyph->charpos < 0) |
| 14471 | { | 14367 | { |
| 14472 | --glyph; | 14368 | --glyph; |
| 14473 | x -= glyph->pixel_width; | 14369 | x -= glyph->pixel_width; |
| 14474 | } | 14370 | } |
| 14475 | if (INTEGERP (glyph->object) && glyph->charpos < 0) | 14371 | if (NILP (glyph->object) && glyph->charpos < 0) |
| 14476 | --glyph; | 14372 | --glyph; |
| 14477 | /* By default, in reversed rows we put the cursor on the | 14373 | /* By default, in reversed rows we put the cursor on the |
| 14478 | rightmost (first in the reading order) glyph. */ | 14374 | rightmost (first in the reading order) glyph. */ |
| 14479 | for (g = end + 1; g < glyph; g++) | 14375 | for (g = end + 1; g < glyph; g++) |
| 14480 | x += g->pixel_width; | 14376 | x += g->pixel_width; |
| 14481 | while (end < glyph | 14377 | while (end < glyph |
| 14482 | && INTEGERP ((end + 1)->object) | 14378 | && NILP ((end + 1)->object) |
| 14483 | && (end + 1)->charpos <= 0) | 14379 | && (end + 1)->charpos <= 0) |
| 14484 | ++end; | 14380 | ++end; |
| 14485 | glyph_before = glyph + 1; | 14381 | glyph_before = glyph + 1; |
| @@ -14510,7 +14406,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, | |||
| 14510 | while (/* not marched to end of glyph row */ | 14406 | while (/* not marched to end of glyph row */ |
| 14511 | glyph < end | 14407 | glyph < end |
| 14512 | /* glyph was not inserted by redisplay for internal purposes */ | 14408 | /* glyph was not inserted by redisplay for internal purposes */ |
| 14513 | && !INTEGERP (glyph->object)) | 14409 | && !NILP (glyph->object)) |
| 14514 | { | 14410 | { |
| 14515 | if (BUFFERP (glyph->object)) | 14411 | if (BUFFERP (glyph->object)) |
| 14516 | { | 14412 | { |
| @@ -14598,7 +14494,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, | |||
| 14598 | ++glyph; | 14494 | ++glyph; |
| 14599 | } | 14495 | } |
| 14600 | else if (glyph > end) /* row is reversed */ | 14496 | else if (glyph > end) /* row is reversed */ |
| 14601 | while (!INTEGERP (glyph->object)) | 14497 | while (!NILP (glyph->object)) |
| 14602 | { | 14498 | { |
| 14603 | if (BUFFERP (glyph->object)) | 14499 | if (BUFFERP (glyph->object)) |
| 14604 | { | 14500 | { |
| @@ -14675,16 +14571,16 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, | |||
| 14675 | && BUFFERP (glyph->object) && glyph->charpos == pt_old) | 14571 | && BUFFERP (glyph->object) && glyph->charpos == pt_old) |
| 14676 | && !(bpos_max <= pt_old && pt_old <= bpos_covered)) | 14572 | && !(bpos_max <= pt_old && pt_old <= bpos_covered)) |
| 14677 | { | 14573 | { |
| 14678 | /* An empty line has a single glyph whose OBJECT is zero and | 14574 | /* An empty line has a single glyph whose OBJECT is nil and |
| 14679 | whose CHARPOS is the position of a newline on that line. | 14575 | whose CHARPOS is the position of a newline on that line. |
| 14680 | Note that on a TTY, there are more glyphs after that, which | 14576 | Note that on a TTY, there are more glyphs after that, which |
| 14681 | were produced by extend_face_to_end_of_line, but their | 14577 | were produced by extend_face_to_end_of_line, but their |
| 14682 | CHARPOS is zero or negative. */ | 14578 | CHARPOS is zero or negative. */ |
| 14683 | int empty_line_p = | 14579 | int empty_line_p = |
| 14684 | (row->reversed_p ? glyph > glyphs_end : glyph < glyphs_end) | 14580 | (row->reversed_p ? glyph > glyphs_end : glyph < glyphs_end) |
| 14685 | && INTEGERP (glyph->object) && glyph->charpos > 0 | 14581 | && NILP (glyph->object) && glyph->charpos > 0 |
| 14686 | /* On a TTY, continued and truncated rows also have a glyph at | 14582 | /* On a TTY, continued and truncated rows also have a glyph at |
| 14687 | their end whose OBJECT is zero and whose CHARPOS is | 14583 | their end whose OBJECT is nil and whose CHARPOS is |
| 14688 | positive (the continuation and truncation glyphs), but such | 14584 | positive (the continuation and truncation glyphs), but such |
| 14689 | rows are obviously not "empty". */ | 14585 | rows are obviously not "empty". */ |
| 14690 | && !(row->continued_p || row->truncated_on_right_p); | 14586 | && !(row->continued_p || row->truncated_on_right_p); |
| @@ -14961,7 +14857,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, | |||
| 14961 | && string_from_text_prop) | 14857 | && string_from_text_prop) |
| 14962 | /* this candidate is from newline and its | 14858 | /* this candidate is from newline and its |
| 14963 | position is not an exact match */ | 14859 | position is not an exact match */ |
| 14964 | || (INTEGERP (glyph->object) | 14860 | || (NILP (glyph->object) |
| 14965 | && glyph->charpos != pt_old))))) | 14861 | && glyph->charpos != pt_old))))) |
| 14966 | return 0; | 14862 | return 0; |
| 14967 | /* If this candidate gives an exact match, use that. */ | 14863 | /* If this candidate gives an exact match, use that. */ |
| @@ -14970,7 +14866,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, | |||
| 14970 | terminating newline of a line, and point is on that | 14866 | terminating newline of a line, and point is on that |
| 14971 | newline, it wins because it's an exact match. */ | 14867 | newline, it wins because it's an exact match. */ |
| 14972 | || (!row->continued_p | 14868 | || (!row->continued_p |
| 14973 | && INTEGERP (glyph->object) | 14869 | && NILP (glyph->object) |
| 14974 | && glyph->charpos == 0 | 14870 | && glyph->charpos == 0 |
| 14975 | && pt_old == MATRIX_ROW_END_CHARPOS (row) - 1)) | 14871 | && pt_old == MATRIX_ROW_END_CHARPOS (row) - 1)) |
| 14976 | /* Otherwise, keep the candidate that comes from a row | 14872 | /* Otherwise, keep the candidate that comes from a row |
| @@ -15813,7 +15709,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste | |||
| 15813 | 15709 | ||
| 15814 | exact_match_p = | 15710 | exact_match_p = |
| 15815 | (BUFFERP (g->object) && g->charpos == PT) | 15711 | (BUFFERP (g->object) && g->charpos == PT) |
| 15816 | || (INTEGERP (g->object) | 15712 | || (NILP (g->object) |
| 15817 | && (g->charpos == PT | 15713 | && (g->charpos == PT |
| 15818 | || (g->charpos == 0 && endpos - 1 == PT))); | 15714 | || (g->charpos == 0 && endpos - 1 == PT))); |
| 15819 | } | 15715 | } |
| @@ -18674,7 +18570,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area) | |||
| 18674 | ? 'B' | 18570 | ? 'B' |
| 18675 | : (STRINGP (glyph->object) | 18571 | : (STRINGP (glyph->object) |
| 18676 | ? 'S' | 18572 | ? 'S' |
| 18677 | : (INTEGERP (glyph->object) | 18573 | : (NILP (glyph->object) |
| 18678 | ? '0' | 18574 | ? '0' |
| 18679 | : '-'))), | 18575 | : '-'))), |
| 18680 | glyph->pixel_width, | 18576 | glyph->pixel_width, |
| @@ -18697,7 +18593,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area) | |||
| 18697 | ? 'B' | 18593 | ? 'B' |
| 18698 | : (STRINGP (glyph->object) | 18594 | : (STRINGP (glyph->object) |
| 18699 | ? 'S' | 18595 | ? 'S' |
| 18700 | : (INTEGERP (glyph->object) | 18596 | : (NILP (glyph->object) |
| 18701 | ? '0' | 18597 | ? '0' |
| 18702 | : '-'))), | 18598 | : '-'))), |
| 18703 | glyph->pixel_width, | 18599 | glyph->pixel_width, |
| @@ -18718,7 +18614,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area) | |||
| 18718 | ? 'B' | 18614 | ? 'B' |
| 18719 | : (STRINGP (glyph->object) | 18615 | : (STRINGP (glyph->object) |
| 18720 | ? 'S' | 18616 | ? 'S' |
| 18721 | : (INTEGERP (glyph->object) | 18617 | : (NILP (glyph->object) |
| 18722 | ? '0' | 18618 | ? '0' |
| 18723 | : '-'))), | 18619 | : '-'))), |
| 18724 | glyph->pixel_width, | 18620 | glyph->pixel_width, |
| @@ -18739,7 +18635,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area) | |||
| 18739 | ? 'B' | 18635 | ? 'B' |
| 18740 | : (STRINGP (glyph->object) | 18636 | : (STRINGP (glyph->object) |
| 18741 | ? 'S' | 18637 | ? 'S' |
| 18742 | : (INTEGERP (glyph->object) | 18638 | : (NILP (glyph->object) |
| 18743 | ? '0' | 18639 | ? '0' |
| 18744 | : '-'))), | 18640 | : '-'))), |
| 18745 | glyph->pixel_width, | 18641 | glyph->pixel_width, |
| @@ -18862,7 +18758,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs) | |||
| 18862 | struct glyph *glyph = row->glyphs[area] + i; | 18758 | struct glyph *glyph = row->glyphs[area] + i; |
| 18863 | if (i == row->used[area] - 1 | 18759 | if (i == row->used[area] - 1 |
| 18864 | && area == TEXT_AREA | 18760 | && area == TEXT_AREA |
| 18865 | && INTEGERP (glyph->object) | 18761 | && NILP (glyph->object) |
| 18866 | && glyph->type == CHAR_GLYPH | 18762 | && glyph->type == CHAR_GLYPH |
| 18867 | && glyph->u.ch == ' ') | 18763 | && glyph->u.ch == ' ') |
| 18868 | { | 18764 | { |
| @@ -19092,7 +18988,7 @@ insert_left_trunc_glyphs (struct it *it) | |||
| 19092 | truncate_it.area = TEXT_AREA; | 18988 | truncate_it.area = TEXT_AREA; |
| 19093 | truncate_it.glyph_row->used[TEXT_AREA] = 0; | 18989 | truncate_it.glyph_row->used[TEXT_AREA] = 0; |
| 19094 | CHARPOS (truncate_it.position) = BYTEPOS (truncate_it.position) = -1; | 18990 | CHARPOS (truncate_it.position) = BYTEPOS (truncate_it.position) = -1; |
| 19095 | truncate_it.object = make_number (0); | 18991 | truncate_it.object = Qnil; |
| 19096 | produce_special_glyphs (&truncate_it, IT_TRUNCATION); | 18992 | produce_special_glyphs (&truncate_it, IT_TRUNCATION); |
| 19097 | 18993 | ||
| 19098 | /* Overwrite glyphs from IT with truncation glyphs. */ | 18994 | /* Overwrite glyphs from IT with truncation glyphs. */ |
| @@ -19375,7 +19271,7 @@ append_space_for_newline (struct it *it, int default_face_p) | |||
| 19375 | 19271 | ||
| 19376 | it->what = IT_CHARACTER; | 19272 | it->what = IT_CHARACTER; |
| 19377 | memset (&it->position, 0, sizeof it->position); | 19273 | memset (&it->position, 0, sizeof it->position); |
| 19378 | it->object = make_number (0); | 19274 | it->object = Qnil; |
| 19379 | it->c = it->char_to_display = ' '; | 19275 | it->c = it->char_to_display = ' '; |
| 19380 | it->len = 1; | 19276 | it->len = 1; |
| 19381 | 19277 | ||
| @@ -19567,7 +19463,7 @@ extend_face_to_end_of_line (struct it *it) | |||
| 19567 | else | 19463 | else |
| 19568 | it->face_id = face->id; | 19464 | it->face_id = face->id; |
| 19569 | it->start_of_box_run_p = 0; | 19465 | it->start_of_box_run_p = 0; |
| 19570 | append_stretch_glyph (it, make_number (0), stretch_width, | 19466 | append_stretch_glyph (it, Qnil, stretch_width, |
| 19571 | it->ascent + it->descent, stretch_ascent); | 19467 | it->ascent + it->descent, stretch_ascent); |
| 19572 | it->position = saved_pos; | 19468 | it->position = saved_pos; |
| 19573 | it->avoid_cursor_p = saved_avoid_cursor; | 19469 | it->avoid_cursor_p = saved_avoid_cursor; |
| @@ -19597,7 +19493,7 @@ extend_face_to_end_of_line (struct it *it) | |||
| 19597 | 19493 | ||
| 19598 | it->what = IT_CHARACTER; | 19494 | it->what = IT_CHARACTER; |
| 19599 | memset (&it->position, 0, sizeof it->position); | 19495 | memset (&it->position, 0, sizeof it->position); |
| 19600 | it->object = make_number (0); | 19496 | it->object = Qnil; |
| 19601 | it->c = it->char_to_display = ' '; | 19497 | it->c = it->char_to_display = ' '; |
| 19602 | it->len = 1; | 19498 | it->len = 1; |
| 19603 | 19499 | ||
| @@ -19726,14 +19622,14 @@ highlight_trailing_whitespace (struct frame *f, struct glyph_row *row) | |||
| 19726 | { | 19622 | { |
| 19727 | while (glyph >= start | 19623 | while (glyph >= start |
| 19728 | && glyph->type == CHAR_GLYPH | 19624 | && glyph->type == CHAR_GLYPH |
| 19729 | && INTEGERP (glyph->object)) | 19625 | && NILP (glyph->object)) |
| 19730 | --glyph; | 19626 | --glyph; |
| 19731 | } | 19627 | } |
| 19732 | else | 19628 | else |
| 19733 | { | 19629 | { |
| 19734 | while (glyph <= start | 19630 | while (glyph <= start |
| 19735 | && glyph->type == CHAR_GLYPH | 19631 | && glyph->type == CHAR_GLYPH |
| 19736 | && INTEGERP (glyph->object)) | 19632 | && NILP (glyph->object)) |
| 19737 | ++glyph; | 19633 | ++glyph; |
| 19738 | } | 19634 | } |
| 19739 | 19635 | ||
| @@ -20096,10 +19992,9 @@ find_row_edges (struct it *it, struct glyph_row *row, | |||
| 20096 | { | 19992 | { |
| 20097 | start = r1->glyphs[TEXT_AREA]; | 19993 | start = r1->glyphs[TEXT_AREA]; |
| 20098 | end = start + r1->used[TEXT_AREA]; | 19994 | end = start + r1->used[TEXT_AREA]; |
| 20099 | /* Glyphs inserted by redisplay have an integer (zero) | 19995 | /* Glyphs inserted by redisplay have nil as their object. */ |
| 20100 | as their object. */ | ||
| 20101 | while (end > start | 19996 | while (end > start |
| 20102 | && INTEGERP ((end - 1)->object) | 19997 | && NILP ((end - 1)->object) |
| 20103 | && (end - 1)->charpos <= 0) | 19998 | && (end - 1)->charpos <= 0) |
| 20104 | --end; | 19999 | --end; |
| 20105 | if (end > start) | 20000 | if (end > start) |
| @@ -20120,7 +20015,7 @@ find_row_edges (struct it *it, struct glyph_row *row, | |||
| 20120 | end = r1->glyphs[TEXT_AREA] - 1; | 20015 | end = r1->glyphs[TEXT_AREA] - 1; |
| 20121 | start = end + r1->used[TEXT_AREA]; | 20016 | start = end + r1->used[TEXT_AREA]; |
| 20122 | while (end < start | 20017 | while (end < start |
| 20123 | && INTEGERP ((end + 1)->object) | 20018 | && NILP ((end + 1)->object) |
| 20124 | && (end + 1)->charpos <= 0) | 20019 | && (end + 1)->charpos <= 0) |
| 20125 | ++end; | 20020 | ++end; |
| 20126 | if (end < start) | 20021 | if (end < start) |
| @@ -21273,7 +21168,7 @@ Value is the new character position of point. */) | |||
| 21273 | 21168 | ||
| 21274 | #define ROW_GLYPH_NEWLINE_P(ROW,GLYPH) \ | 21169 | #define ROW_GLYPH_NEWLINE_P(ROW,GLYPH) \ |
| 21275 | (!(ROW)->continued_p \ | 21170 | (!(ROW)->continued_p \ |
| 21276 | && INTEGERP ((GLYPH)->object) \ | 21171 | && NILP ((GLYPH)->object) \ |
| 21277 | && (GLYPH)->type == CHAR_GLYPH \ | 21172 | && (GLYPH)->type == CHAR_GLYPH \ |
| 21278 | && (GLYPH)->u.ch == ' ' \ | 21173 | && (GLYPH)->u.ch == ' ' \ |
| 21279 | && (GLYPH)->charpos >= 0 \ | 21174 | && (GLYPH)->charpos >= 0 \ |
| @@ -21315,7 +21210,7 @@ Value is the new character position of point. */) | |||
| 21315 | w->cursor.vpos = -1; | 21210 | w->cursor.vpos = -1; |
| 21316 | return make_number (PT); | 21211 | return make_number (PT); |
| 21317 | } | 21212 | } |
| 21318 | else if (!INTEGERP (g->object) && !EQ (g->object, gpt->object)) | 21213 | else if (!NILP (g->object) && !EQ (g->object, gpt->object)) |
| 21319 | { | 21214 | { |
| 21320 | ptrdiff_t new_pos; | 21215 | ptrdiff_t new_pos; |
| 21321 | 21216 | ||
| @@ -21352,7 +21247,7 @@ Value is the new character position of point. */) | |||
| 21352 | return make_number (PT); | 21247 | return make_number (PT); |
| 21353 | } | 21248 | } |
| 21354 | } | 21249 | } |
| 21355 | if (g == e || INTEGERP (g->object)) | 21250 | if (g == e || NILP (g->object)) |
| 21356 | { | 21251 | { |
| 21357 | if (row->truncated_on_left_p || row->truncated_on_right_p) | 21252 | if (row->truncated_on_left_p || row->truncated_on_right_p) |
| 21358 | goto simulate_display; | 21253 | goto simulate_display; |
| @@ -21385,7 +21280,7 @@ Value is the new character position of point. */) | |||
| 21385 | EOB also has one glyph, but its charpos is -1. */ | 21280 | EOB also has one glyph, but its charpos is -1. */ |
| 21386 | || (row->ends_at_zv_p | 21281 | || (row->ends_at_zv_p |
| 21387 | && !row->reversed_p | 21282 | && !row->reversed_p |
| 21388 | && INTEGERP (g->object) | 21283 | && NILP (g->object) |
| 21389 | && g->type == CHAR_GLYPH | 21284 | && g->type == CHAR_GLYPH |
| 21390 | && g->u.ch == ' ')) | 21285 | && g->u.ch == ' ')) |
| 21391 | { | 21286 | { |
| @@ -21423,7 +21318,7 @@ Value is the new character position of point. */) | |||
| 21423 | || g->type == STRETCH_GLYPH | 21318 | || g->type == STRETCH_GLYPH |
| 21424 | || (row->ends_at_zv_p | 21319 | || (row->ends_at_zv_p |
| 21425 | && row->reversed_p | 21320 | && row->reversed_p |
| 21426 | && INTEGERP (g->object) | 21321 | && NILP (g->object) |
| 21427 | && g->type == CHAR_GLYPH | 21322 | && g->type == CHAR_GLYPH |
| 21428 | && g->u.ch == ' ')) | 21323 | && g->u.ch == ' ')) |
| 21429 | { | 21324 | { |
| @@ -21787,13 +21682,13 @@ Emacs UBA implementation, in particular with the test suite. */) | |||
| 21787 | /* Skip over glyphs at the start of the row that was | 21682 | /* Skip over glyphs at the start of the row that was |
| 21788 | generated by redisplay for its own needs. */ | 21683 | generated by redisplay for its own needs. */ |
| 21789 | while (g < e | 21684 | while (g < e |
| 21790 | && INTEGERP (g->object) | 21685 | && NILP (g->object) |
| 21791 | && g->charpos < 0) | 21686 | && g->charpos < 0) |
| 21792 | g++; | 21687 | g++; |
| 21793 | g1 = g; | 21688 | g1 = g; |
| 21794 | 21689 | ||
| 21795 | /* Count the "interesting" glyphs in this row. */ | 21690 | /* Count the "interesting" glyphs in this row. */ |
| 21796 | for (nglyphs = 0; g < e && !INTEGERP (g->object); g++) | 21691 | for (nglyphs = 0; g < e && !NILP (g->object); g++) |
| 21797 | nglyphs++; | 21692 | nglyphs++; |
| 21798 | 21693 | ||
| 21799 | /* Create and fill the array. */ | 21694 | /* Create and fill the array. */ |
| @@ -21806,11 +21701,11 @@ Emacs UBA implementation, in particular with the test suite. */) | |||
| 21806 | g = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1; | 21701 | g = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1; |
| 21807 | e = row->glyphs[TEXT_AREA] - 1; | 21702 | e = row->glyphs[TEXT_AREA] - 1; |
| 21808 | while (g > e | 21703 | while (g > e |
| 21809 | && INTEGERP (g->object) | 21704 | && NILP (g->object) |
| 21810 | && g->charpos < 0) | 21705 | && g->charpos < 0) |
| 21811 | g--; | 21706 | g--; |
| 21812 | g1 = g; | 21707 | g1 = g; |
| 21813 | for (nglyphs = 0; g > e && !INTEGERP (g->object); g--) | 21708 | for (nglyphs = 0; g > e && !NILP (g->object); g--) |
| 21814 | nglyphs++; | 21709 | nglyphs++; |
| 21815 | levels = make_uninit_vector (nglyphs); | 21710 | levels = make_uninit_vector (nglyphs); |
| 21816 | for (i = 0; g1 > g; i++, g1--) | 21711 | for (i = 0; g1 > g; i++, g1--) |
| @@ -26273,7 +26168,7 @@ produce_special_glyphs (struct it *it, enum display_element_type what) | |||
| 26273 | GLYPH glyph; | 26168 | GLYPH glyph; |
| 26274 | 26169 | ||
| 26275 | temp_it = *it; | 26170 | temp_it = *it; |
| 26276 | temp_it.object = make_number (0); | 26171 | temp_it.object = Qnil; |
| 26277 | memset (&temp_it.current, 0, sizeof temp_it.current); | 26172 | memset (&temp_it.current, 0, sizeof temp_it.current); |
| 26278 | 26173 | ||
| 26279 | if (what == IT_CONTINUATION) | 26174 | if (what == IT_CONTINUATION) |
| @@ -26336,7 +26231,7 @@ produce_special_glyphs (struct it *it, enum display_element_type what) | |||
| 26336 | (((temp_it.ascent + temp_it.descent) | 26231 | (((temp_it.ascent + temp_it.descent) |
| 26337 | * FONT_BASE (font)) / FONT_HEIGHT (font)); | 26232 | * FONT_BASE (font)) / FONT_HEIGHT (font)); |
| 26338 | 26233 | ||
| 26339 | append_stretch_glyph (&temp_it, make_number (0), stretch_width, | 26234 | append_stretch_glyph (&temp_it, Qnil, stretch_width, |
| 26340 | temp_it.ascent + temp_it.descent, | 26235 | temp_it.ascent + temp_it.descent, |
| 26341 | stretch_ascent); | 26236 | stretch_ascent); |
| 26342 | } | 26237 | } |
| @@ -28522,7 +28417,7 @@ rows_from_pos_range (struct window *w, | |||
| 28522 | 28417 | ||
| 28523 | while (g < e) | 28418 | while (g < e) |
| 28524 | { | 28419 | { |
| 28525 | if (((BUFFERP (g->object) || INTEGERP (g->object)) | 28420 | if (((BUFFERP (g->object) || NILP (g->object)) |
| 28526 | && start_charpos <= g->charpos && g->charpos < end_charpos) | 28421 | && start_charpos <= g->charpos && g->charpos < end_charpos) |
| 28527 | /* A glyph that comes from DISP_STRING is by | 28422 | /* A glyph that comes from DISP_STRING is by |
| 28528 | definition to be highlighted. */ | 28423 | definition to be highlighted. */ |
| @@ -28577,7 +28472,7 @@ rows_from_pos_range (struct window *w, | |||
| 28577 | 28472 | ||
| 28578 | while (g < e) | 28473 | while (g < e) |
| 28579 | { | 28474 | { |
| 28580 | if (((BUFFERP (g->object) || INTEGERP (g->object)) | 28475 | if (((BUFFERP (g->object) || NILP (g->object)) |
| 28581 | && ((start_charpos <= g->charpos && g->charpos < end_charpos) | 28476 | && ((start_charpos <= g->charpos && g->charpos < end_charpos) |
| 28582 | /* If the buffer position of the first glyph in | 28477 | /* If the buffer position of the first glyph in |
| 28583 | the row is equal to END_CHARPOS, it means | 28478 | the row is equal to END_CHARPOS, it means |
| @@ -28659,7 +28554,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, | |||
| 28659 | { | 28554 | { |
| 28660 | struct glyph *beg = prev->glyphs[TEXT_AREA]; | 28555 | struct glyph *beg = prev->glyphs[TEXT_AREA]; |
| 28661 | glyph = beg + prev->used[TEXT_AREA]; | 28556 | glyph = beg + prev->used[TEXT_AREA]; |
| 28662 | while (--glyph >= beg && INTEGERP (glyph->object)); | 28557 | while (--glyph >= beg && NILP (glyph->object)); |
| 28663 | if (glyph < beg | 28558 | if (glyph < beg |
| 28664 | || !(EQ (glyph->object, before_string) | 28559 | || !(EQ (glyph->object, before_string) |
| 28665 | || EQ (glyph->object, disp_string))) | 28560 | || EQ (glyph->object, disp_string))) |
| @@ -28723,7 +28618,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, | |||
| 28723 | /* Skip truncation glyphs at the start of the glyph row. */ | 28618 | /* Skip truncation glyphs at the start of the glyph row. */ |
| 28724 | if (MATRIX_ROW_DISPLAYS_TEXT_P (r1)) | 28619 | if (MATRIX_ROW_DISPLAYS_TEXT_P (r1)) |
| 28725 | for (; glyph < end | 28620 | for (; glyph < end |
| 28726 | && INTEGERP (glyph->object) | 28621 | && NILP (glyph->object) |
| 28727 | && glyph->charpos < 0; | 28622 | && glyph->charpos < 0; |
| 28728 | ++glyph) | 28623 | ++glyph) |
| 28729 | x += glyph->pixel_width; | 28624 | x += glyph->pixel_width; |
| @@ -28732,7 +28627,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, | |||
| 28732 | or DISP_STRING, and the first glyph from buffer whose | 28627 | or DISP_STRING, and the first glyph from buffer whose |
| 28733 | position is between START_CHARPOS and END_CHARPOS. */ | 28628 | position is between START_CHARPOS and END_CHARPOS. */ |
| 28734 | for (; glyph < end | 28629 | for (; glyph < end |
| 28735 | && !INTEGERP (glyph->object) | 28630 | && !NILP (glyph->object) |
| 28736 | && !EQ (glyph->object, disp_string) | 28631 | && !EQ (glyph->object, disp_string) |
| 28737 | && !(BUFFERP (glyph->object) | 28632 | && !(BUFFERP (glyph->object) |
| 28738 | && (glyph->charpos >= start_charpos | 28633 | && (glyph->charpos >= start_charpos |
| @@ -28774,7 +28669,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, | |||
| 28774 | /* Skip truncation glyphs at the start of the glyph row. */ | 28669 | /* Skip truncation glyphs at the start of the glyph row. */ |
| 28775 | if (MATRIX_ROW_DISPLAYS_TEXT_P (r1)) | 28670 | if (MATRIX_ROW_DISPLAYS_TEXT_P (r1)) |
| 28776 | for (; glyph > end | 28671 | for (; glyph > end |
| 28777 | && INTEGERP (glyph->object) | 28672 | && NILP (glyph->object) |
| 28778 | && glyph->charpos < 0; | 28673 | && glyph->charpos < 0; |
| 28779 | --glyph) | 28674 | --glyph) |
| 28780 | ; | 28675 | ; |
| @@ -28783,7 +28678,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, | |||
| 28783 | or DISP_STRING, and the first glyph from buffer whose | 28678 | or DISP_STRING, and the first glyph from buffer whose |
| 28784 | position is between START_CHARPOS and END_CHARPOS. */ | 28679 | position is between START_CHARPOS and END_CHARPOS. */ |
| 28785 | for (; glyph > end | 28680 | for (; glyph > end |
| 28786 | && !INTEGERP (glyph->object) | 28681 | && !NILP (glyph->object) |
| 28787 | && !EQ (glyph->object, disp_string) | 28682 | && !EQ (glyph->object, disp_string) |
| 28788 | && !(BUFFERP (glyph->object) | 28683 | && !(BUFFERP (glyph->object) |
| 28789 | && (glyph->charpos >= start_charpos | 28684 | && (glyph->charpos >= start_charpos |
| @@ -28840,7 +28735,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, | |||
| 28840 | row, and also blanks and stretch glyphs inserted by | 28735 | row, and also blanks and stretch glyphs inserted by |
| 28841 | extend_face_to_end_of_line. */ | 28736 | extend_face_to_end_of_line. */ |
| 28842 | while (end > glyph | 28737 | while (end > glyph |
| 28843 | && INTEGERP ((end - 1)->object)) | 28738 | && NILP ((end - 1)->object)) |
| 28844 | --end; | 28739 | --end; |
| 28845 | /* Scan the rest of the glyph row from the end, looking for the | 28740 | /* Scan the rest of the glyph row from the end, looking for the |
| 28846 | first glyph that comes from BEFORE_STRING, AFTER_STRING, or | 28741 | first glyph that comes from BEFORE_STRING, AFTER_STRING, or |
| @@ -28848,7 +28743,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, | |||
| 28848 | and END_CHARPOS */ | 28743 | and END_CHARPOS */ |
| 28849 | for (--end; | 28744 | for (--end; |
| 28850 | end > glyph | 28745 | end > glyph |
| 28851 | && !INTEGERP (end->object) | 28746 | && !NILP (end->object) |
| 28852 | && !EQ (end->object, disp_string) | 28747 | && !EQ (end->object, disp_string) |
| 28853 | && !(BUFFERP (end->object) | 28748 | && !(BUFFERP (end->object) |
| 28854 | && (end->charpos >= start_charpos | 28749 | && (end->charpos >= start_charpos |
| @@ -28886,7 +28781,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, | |||
| 28886 | x = r2->x; | 28781 | x = r2->x; |
| 28887 | end++; | 28782 | end++; |
| 28888 | while (end < glyph | 28783 | while (end < glyph |
| 28889 | && INTEGERP (end->object)) | 28784 | && NILP (end->object)) |
| 28890 | { | 28785 | { |
| 28891 | x += end->pixel_width; | 28786 | x += end->pixel_width; |
| 28892 | ++end; | 28787 | ++end; |
| @@ -28897,7 +28792,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, | |||
| 28897 | and END_CHARPOS */ | 28792 | and END_CHARPOS */ |
| 28898 | for ( ; | 28793 | for ( ; |
| 28899 | end < glyph | 28794 | end < glyph |
| 28900 | && !INTEGERP (end->object) | 28795 | && !NILP (end->object) |
| 28901 | && !EQ (end->object, disp_string) | 28796 | && !EQ (end->object, disp_string) |
| 28902 | && !(BUFFERP (end->object) | 28797 | && !(BUFFERP (end->object) |
| 28903 | && (end->charpos >= start_charpos | 28798 | && (end->charpos >= start_charpos |
| @@ -29829,12 +29724,12 @@ note_mouse_highlight (struct frame *f, int x, int y) | |||
| 29829 | if (glyph == NULL | 29724 | if (glyph == NULL |
| 29830 | || area != TEXT_AREA | 29725 | || area != TEXT_AREA |
| 29831 | || !MATRIX_ROW_DISPLAYS_TEXT_P (MATRIX_ROW (w->current_matrix, vpos)) | 29726 | || !MATRIX_ROW_DISPLAYS_TEXT_P (MATRIX_ROW (w->current_matrix, vpos)) |
| 29832 | /* Glyph's OBJECT is an integer for glyphs inserted by the | 29727 | /* Glyph's OBJECT is nil for glyphs inserted by the |
| 29833 | display engine for its internal purposes, like truncation | 29728 | display engine for its internal purposes, like truncation |
| 29834 | and continuation glyphs and blanks beyond the end of | 29729 | and continuation glyphs and blanks beyond the end of |
| 29835 | line's text on text terminals. If we are over such a | 29730 | line's text on text terminals. If we are over such a |
| 29836 | glyph, we are not over any text. */ | 29731 | glyph, we are not over any text. */ |
| 29837 | || INTEGERP (glyph->object) | 29732 | || NILP (glyph->object) |
| 29838 | /* R2L rows have a stretch glyph at their front, which | 29733 | /* R2L rows have a stretch glyph at their front, which |
| 29839 | stands for no text, whereas L2R rows have no glyphs at | 29734 | stands for no text, whereas L2R rows have no glyphs at |
| 29840 | all beyond the end of text. Treat such stretch glyphs | 29735 | all beyond the end of text. Treat such stretch glyphs |
| @@ -30806,7 +30701,9 @@ syms_of_xdisp (void) | |||
| 30806 | Vmessage_stack = Qnil; | 30701 | Vmessage_stack = Qnil; |
| 30807 | staticpro (&Vmessage_stack); | 30702 | staticpro (&Vmessage_stack); |
| 30808 | 30703 | ||
| 30704 | /* Non-nil means don't actually do any redisplay. */ | ||
| 30809 | DEFSYM (Qinhibit_redisplay, "inhibit-redisplay"); | 30705 | DEFSYM (Qinhibit_redisplay, "inhibit-redisplay"); |
| 30706 | |||
| 30810 | DEFSYM (Qredisplay_internal, "redisplay_internal (C function)"); | 30707 | DEFSYM (Qredisplay_internal, "redisplay_internal (C function)"); |
| 30811 | 30708 | ||
| 30812 | message_dolog_marker1 = Fmake_marker (); | 30709 | message_dolog_marker1 = Fmake_marker (); |
| @@ -30845,6 +30742,8 @@ syms_of_xdisp (void) | |||
| 30845 | DEFSYM (Qinhibit_point_motion_hooks, "inhibit-point-motion-hooks"); | 30742 | DEFSYM (Qinhibit_point_motion_hooks, "inhibit-point-motion-hooks"); |
| 30846 | DEFSYM (Qeval, "eval"); | 30743 | DEFSYM (Qeval, "eval"); |
| 30847 | DEFSYM (QCdata, ":data"); | 30744 | DEFSYM (QCdata, ":data"); |
| 30745 | |||
| 30746 | /* Names of text properties relevant for redisplay. */ | ||
| 30848 | DEFSYM (Qdisplay, "display"); | 30747 | DEFSYM (Qdisplay, "display"); |
| 30849 | DEFSYM (Qspace_width, "space-width"); | 30748 | DEFSYM (Qspace_width, "space-width"); |
| 30850 | DEFSYM (Qraise, "raise"); | 30749 | DEFSYM (Qraise, "raise"); |
| @@ -30864,40 +30763,69 @@ syms_of_xdisp (void) | |||
| 30864 | DEFSYM (QCfile, ":file"); | 30763 | DEFSYM (QCfile, ":file"); |
| 30865 | DEFSYM (Qfontified, "fontified"); | 30764 | DEFSYM (Qfontified, "fontified"); |
| 30866 | DEFSYM (Qfontification_functions, "fontification-functions"); | 30765 | DEFSYM (Qfontification_functions, "fontification-functions"); |
| 30766 | |||
| 30767 | /* Name of the face used to highlight trailing whitespace. */ | ||
| 30867 | DEFSYM (Qtrailing_whitespace, "trailing-whitespace"); | 30768 | DEFSYM (Qtrailing_whitespace, "trailing-whitespace"); |
| 30769 | |||
| 30770 | /* Name and number of the face used to highlight escape glyphs. */ | ||
| 30868 | DEFSYM (Qescape_glyph, "escape-glyph"); | 30771 | DEFSYM (Qescape_glyph, "escape-glyph"); |
| 30772 | |||
| 30773 | /* Name and number of the face used to highlight non-breaking spaces. */ | ||
| 30869 | DEFSYM (Qnobreak_space, "nobreak-space"); | 30774 | DEFSYM (Qnobreak_space, "nobreak-space"); |
| 30775 | |||
| 30776 | /* The symbol 'image' which is the car of the lists used to represent | ||
| 30777 | images in Lisp. Also a tool bar style. */ | ||
| 30870 | DEFSYM (Qimage, "image"); | 30778 | DEFSYM (Qimage, "image"); |
| 30779 | |||
| 30780 | /* Tool bar styles. */ | ||
| 30871 | DEFSYM (Qtext, "text"); | 30781 | DEFSYM (Qtext, "text"); |
| 30872 | DEFSYM (Qboth, "both"); | 30782 | DEFSYM (Qboth, "both"); |
| 30873 | DEFSYM (Qboth_horiz, "both-horiz"); | 30783 | DEFSYM (Qboth_horiz, "both-horiz"); |
| 30874 | DEFSYM (Qtext_image_horiz, "text-image-horiz"); | 30784 | DEFSYM (Qtext_image_horiz, "text-image-horiz"); |
| 30785 | |||
| 30786 | /* The image map types. */ | ||
| 30875 | DEFSYM (QCmap, ":map"); | 30787 | DEFSYM (QCmap, ":map"); |
| 30876 | DEFSYM (QCpointer, ":pointer"); | 30788 | DEFSYM (QCpointer, ":pointer"); |
| 30877 | DEFSYM (Qrect, "rect"); | 30789 | DEFSYM (Qrect, "rect"); |
| 30878 | DEFSYM (Qcircle, "circle"); | 30790 | DEFSYM (Qcircle, "circle"); |
| 30879 | DEFSYM (Qpoly, "poly"); | 30791 | DEFSYM (Qpoly, "poly"); |
| 30792 | |||
| 30793 | /* The symbol `inhibit-menubar-update' and its DEFVAR_BOOL variable. */ | ||
| 30794 | DEFSYM (Qinhibit_menubar_update, "inhibit-menubar-update"); | ||
| 30880 | DEFSYM (Qmessage_truncate_lines, "message-truncate-lines"); | 30795 | DEFSYM (Qmessage_truncate_lines, "message-truncate-lines"); |
| 30796 | |||
| 30881 | DEFSYM (Qgrow_only, "grow-only"); | 30797 | DEFSYM (Qgrow_only, "grow-only"); |
| 30882 | DEFSYM (Qinhibit_menubar_update, "inhibit-menubar-update"); | ||
| 30883 | DEFSYM (Qinhibit_eval_during_redisplay, "inhibit-eval-during-redisplay"); | 30798 | DEFSYM (Qinhibit_eval_during_redisplay, "inhibit-eval-during-redisplay"); |
| 30884 | DEFSYM (Qposition, "position"); | 30799 | DEFSYM (Qposition, "position"); |
| 30885 | DEFSYM (Qbuffer_position, "buffer-position"); | 30800 | DEFSYM (Qbuffer_position, "buffer-position"); |
| 30886 | DEFSYM (Qobject, "object"); | 30801 | DEFSYM (Qobject, "object"); |
| 30802 | |||
| 30803 | /* Cursor shapes. */ | ||
| 30887 | DEFSYM (Qbar, "bar"); | 30804 | DEFSYM (Qbar, "bar"); |
| 30888 | DEFSYM (Qhbar, "hbar"); | 30805 | DEFSYM (Qhbar, "hbar"); |
| 30889 | DEFSYM (Qbox, "box"); | 30806 | DEFSYM (Qbox, "box"); |
| 30890 | DEFSYM (Qhollow, "hollow"); | 30807 | DEFSYM (Qhollow, "hollow"); |
| 30808 | |||
| 30809 | /* Pointer shapes. */ | ||
| 30891 | DEFSYM (Qhand, "hand"); | 30810 | DEFSYM (Qhand, "hand"); |
| 30892 | DEFSYM (Qarrow, "arrow"); | 30811 | DEFSYM (Qarrow, "arrow"); |
| 30812 | /* also Qtext */ | ||
| 30813 | |||
| 30893 | DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces"); | 30814 | DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces"); |
| 30894 | 30815 | ||
| 30895 | list_of_error = list1 (list2 (intern_c_string ("error"), | 30816 | list_of_error = list1 (list2 (intern_c_string ("error"), |
| 30896 | intern_c_string ("void-variable"))); | 30817 | intern_c_string ("void-variable"))); |
| 30897 | staticpro (&list_of_error); | 30818 | staticpro (&list_of_error); |
| 30898 | 30819 | ||
| 30820 | /* Values of those variables at last redisplay are stored as | ||
| 30821 | properties on 'overlay-arrow-position' symbol. However, if | ||
| 30822 | Voverlay_arrow_position is a marker, last-arrow-position is its | ||
| 30823 | numerical position. */ | ||
| 30899 | DEFSYM (Qlast_arrow_position, "last-arrow-position"); | 30824 | DEFSYM (Qlast_arrow_position, "last-arrow-position"); |
| 30900 | DEFSYM (Qlast_arrow_string, "last-arrow-string"); | 30825 | DEFSYM (Qlast_arrow_string, "last-arrow-string"); |
| 30826 | |||
| 30827 | /* Alternative overlay-arrow-string and overlay-arrow-bitmap | ||
| 30828 | properties on a symbol in overlay-arrow-variable-list. */ | ||
| 30901 | DEFSYM (Qoverlay_arrow_string, "overlay-arrow-string"); | 30829 | DEFSYM (Qoverlay_arrow_string, "overlay-arrow-string"); |
| 30902 | DEFSYM (Qoverlay_arrow_bitmap, "overlay-arrow-bitmap"); | 30830 | DEFSYM (Qoverlay_arrow_bitmap, "overlay-arrow-bitmap"); |
| 30903 | 30831 | ||
| @@ -31397,7 +31325,10 @@ cursor shapes. */); | |||
| 31397 | hourglass_shown_p = 0; | 31325 | hourglass_shown_p = 0; |
| 31398 | #endif /* HAVE_WINDOW_SYSTEM */ | 31326 | #endif /* HAVE_WINDOW_SYSTEM */ |
| 31399 | 31327 | ||
| 31328 | /* Name of the face used to display glyphless characters. */ | ||
| 31400 | DEFSYM (Qglyphless_char, "glyphless-char"); | 31329 | DEFSYM (Qglyphless_char, "glyphless-char"); |
| 31330 | |||
| 31331 | /* Method symbols for Vglyphless_char_display. */ | ||
| 31401 | DEFSYM (Qhex_code, "hex-code"); | 31332 | DEFSYM (Qhex_code, "hex-code"); |
| 31402 | DEFSYM (Qempty_box, "empty-box"); | 31333 | DEFSYM (Qempty_box, "empty-box"); |
| 31403 | DEFSYM (Qthin_space, "thin-space"); | 31334 | DEFSYM (Qthin_space, "thin-space"); |
| @@ -31410,6 +31341,7 @@ be redisplayed. This set can be nil (meaning, only the selected window), | |||
| 31410 | or t (meaning all windows). */); | 31341 | or t (meaning all windows). */); |
| 31411 | Vpre_redisplay_function = intern ("ignore"); | 31342 | Vpre_redisplay_function = intern ("ignore"); |
| 31412 | 31343 | ||
| 31344 | /* Symbol for the purpose of Vglyphless_char_display. */ | ||
| 31413 | DEFSYM (Qglyphless_char_display, "glyphless-char-display"); | 31345 | DEFSYM (Qglyphless_char_display, "glyphless-char-display"); |
| 31414 | Fput (Qglyphless_char_display, Qchar_table_extra_slots, make_number (1)); | 31346 | Fput (Qglyphless_char_display, Qchar_table_extra_slots, make_number (1)); |
| 31415 | 31347 | ||
diff --git a/src/xfaces.c b/src/xfaces.c index 0600f53ba1e..6ecd857d685 100644 --- a/src/xfaces.c +++ b/src/xfaces.c | |||
| @@ -278,57 +278,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 278 | 278 | ||
| 279 | #define FACE_CACHE_BUCKETS_SIZE 1001 | 279 | #define FACE_CACHE_BUCKETS_SIZE 1001 |
| 280 | 280 | ||
| 281 | /* Keyword symbols used for face attribute names. */ | ||
| 282 | |||
| 283 | Lisp_Object QCfamily, QCheight, QCweight, QCslant; | ||
| 284 | static Lisp_Object QCunderline; | ||
| 285 | static Lisp_Object QCinverse_video, QCstipple; | ||
| 286 | Lisp_Object QCforeground, QCbackground; | ||
| 287 | Lisp_Object QCwidth; | ||
| 288 | static Lisp_Object QCfont, QCbold, QCitalic; | ||
| 289 | static Lisp_Object QCreverse_video; | ||
| 290 | static Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit; | ||
| 291 | static Lisp_Object QCfontset, QCdistant_foreground; | ||
| 292 | |||
| 293 | /* Symbols used for attribute values. */ | ||
| 294 | |||
| 295 | Lisp_Object Qnormal; | ||
| 296 | Lisp_Object Qbold; | ||
| 297 | static Lisp_Object Qline, Qwave; | ||
| 298 | Lisp_Object Qextra_light, Qlight; | ||
| 299 | Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold; | ||
| 300 | Lisp_Object Qoblique; | ||
| 301 | Lisp_Object Qitalic; | ||
| 302 | static Lisp_Object Qreleased_button, Qpressed_button; | ||
| 303 | static Lisp_Object QCstyle, QCcolor, QCline_width; | ||
| 304 | Lisp_Object Qunspecified; /* used in dosfns.c */ | ||
| 305 | static Lisp_Object QCignore_defface; | ||
| 306 | |||
| 307 | char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg"; | 281 | char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg"; |
| 308 | 282 | ||
| 309 | /* The name of the function to call when the background of the frame | ||
| 310 | has changed, frame_set_background_mode. */ | ||
| 311 | |||
| 312 | static Lisp_Object Qframe_set_background_mode; | ||
| 313 | |||
| 314 | /* Names of basic faces. */ | ||
| 315 | |||
| 316 | Lisp_Object Qdefault, Qtool_bar, Qfringe; | ||
| 317 | static Lisp_Object Qregion; | ||
| 318 | Lisp_Object Qheader_line, Qscroll_bar, Qcursor; | ||
| 319 | static Lisp_Object Qborder, Qmouse, Qmenu; | ||
| 320 | Lisp_Object Qmode_line_inactive; | ||
| 321 | static Lisp_Object Qvertical_border; | ||
| 322 | static Lisp_Object Qwindow_divider; | ||
| 323 | static Lisp_Object Qwindow_divider_first_pixel; | ||
| 324 | static Lisp_Object Qwindow_divider_last_pixel; | ||
| 325 | |||
| 326 | /* The symbol `face-alias'. A symbols having that property is an | ||
| 327 | alias for another face. Value of the property is the name of | ||
| 328 | the aliased face. */ | ||
| 329 | |||
| 330 | static Lisp_Object Qface_alias; | ||
| 331 | |||
| 332 | /* Alist of alternative font families. Each element is of the form | 283 | /* Alist of alternative font families. Each element is of the form |
| 333 | (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded, | 284 | (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded, |
| 334 | try FAMILY1, then FAMILY2, ... */ | 285 | try FAMILY1, then FAMILY2, ... */ |
| @@ -341,32 +292,6 @@ Lisp_Object Vface_alternative_font_family_alist; | |||
| 341 | 292 | ||
| 342 | Lisp_Object Vface_alternative_font_registry_alist; | 293 | Lisp_Object Vface_alternative_font_registry_alist; |
| 343 | 294 | ||
| 344 | /* Allowed scalable fonts. A value of nil means don't allow any | ||
| 345 | scalable fonts. A value of t means allow the use of any scalable | ||
| 346 | font. Otherwise, value must be a list of regular expressions. A | ||
| 347 | font may be scaled if its name matches a regular expression in the | ||
| 348 | list. */ | ||
| 349 | |||
| 350 | static Lisp_Object Qscalable_fonts_allowed; | ||
| 351 | |||
| 352 | /* The symbols `foreground-color' and `background-color' which can be | ||
| 353 | used as part of a `face' property. This is for compatibility with | ||
| 354 | Emacs 20.2. */ | ||
| 355 | |||
| 356 | Lisp_Object Qforeground_color, Qbackground_color; | ||
| 357 | |||
| 358 | /* The symbols `face' and `mouse-face' used as text properties. */ | ||
| 359 | |||
| 360 | Lisp_Object Qface; | ||
| 361 | |||
| 362 | /* Property for basic faces which other faces cannot inherit. */ | ||
| 363 | |||
| 364 | static Lisp_Object Qface_no_inherit; | ||
| 365 | |||
| 366 | /* Error symbol for wrong_type_argument in load_pixmap. */ | ||
| 367 | |||
| 368 | static Lisp_Object Qbitmap_spec_p; | ||
| 369 | |||
| 370 | /* The next ID to assign to Lisp faces. */ | 295 | /* The next ID to assign to Lisp faces. */ |
| 371 | 296 | ||
| 372 | static int next_lface_id; | 297 | static int next_lface_id; |
| @@ -376,14 +301,6 @@ static int next_lface_id; | |||
| 376 | static Lisp_Object *lface_id_to_name; | 301 | static Lisp_Object *lface_id_to_name; |
| 377 | static ptrdiff_t lface_id_to_name_size; | 302 | static ptrdiff_t lface_id_to_name_size; |
| 378 | 303 | ||
| 379 | /* TTY color-related functions (defined in tty-colors.el). */ | ||
| 380 | |||
| 381 | static Lisp_Object Qtty_color_desc, Qtty_color_by_index, Qtty_color_standard_values; | ||
| 382 | |||
| 383 | /* The name of the function used to compute colors on TTYs. */ | ||
| 384 | |||
| 385 | static Lisp_Object Qtty_color_alist; | ||
| 386 | |||
| 387 | #ifdef HAVE_WINDOW_SYSTEM | 304 | #ifdef HAVE_WINDOW_SYSTEM |
| 388 | 305 | ||
| 389 | /* Counter for calls to clear_face_cache. If this counter reaches | 306 | /* Counter for calls to clear_face_cache. If this counter reaches |
| @@ -6397,9 +6314,17 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources, | |||
| 6397 | void | 6314 | void |
| 6398 | syms_of_xfaces (void) | 6315 | syms_of_xfaces (void) |
| 6399 | { | 6316 | { |
| 6317 | /* The symbols `face' and `mouse-face' used as text properties. */ | ||
| 6400 | DEFSYM (Qface, "face"); | 6318 | DEFSYM (Qface, "face"); |
| 6319 | |||
| 6320 | /* Property for basic faces which other faces cannot inherit. */ | ||
| 6401 | DEFSYM (Qface_no_inherit, "face-no-inherit"); | 6321 | DEFSYM (Qface_no_inherit, "face-no-inherit"); |
| 6322 | |||
| 6323 | /* Error symbol for wrong_type_argument in load_pixmap. */ | ||
| 6402 | DEFSYM (Qbitmap_spec_p, "bitmap-spec-p"); | 6324 | DEFSYM (Qbitmap_spec_p, "bitmap-spec-p"); |
| 6325 | |||
| 6326 | /* The name of the function to call when the background of the frame | ||
| 6327 | has changed, frame_set_background_mode. */ | ||
| 6403 | DEFSYM (Qframe_set_background_mode, "frame-set-background-mode"); | 6328 | DEFSYM (Qframe_set_background_mode, "frame-set-background-mode"); |
| 6404 | 6329 | ||
| 6405 | /* Lisp face attribute keywords. */ | 6330 | /* Lisp face attribute keywords. */ |
| @@ -6442,12 +6367,22 @@ syms_of_xfaces (void) | |||
| 6442 | DEFSYM (Qultra_bold, "ultra-bold"); | 6367 | DEFSYM (Qultra_bold, "ultra-bold"); |
| 6443 | DEFSYM (Qoblique, "oblique"); | 6368 | DEFSYM (Qoblique, "oblique"); |
| 6444 | DEFSYM (Qitalic, "italic"); | 6369 | DEFSYM (Qitalic, "italic"); |
| 6370 | |||
| 6371 | /* The symbols `foreground-color' and `background-color' which can be | ||
| 6372 | used as part of a `face' property. This is for compatibility with | ||
| 6373 | Emacs 20.2. */ | ||
| 6445 | DEFSYM (Qbackground_color, "background-color"); | 6374 | DEFSYM (Qbackground_color, "background-color"); |
| 6446 | DEFSYM (Qforeground_color, "foreground-color"); | 6375 | DEFSYM (Qforeground_color, "foreground-color"); |
| 6376 | |||
| 6447 | DEFSYM (Qunspecified, "unspecified"); | 6377 | DEFSYM (Qunspecified, "unspecified"); |
| 6448 | DEFSYM (QCignore_defface, ":ignore-defface"); | 6378 | DEFSYM (QCignore_defface, ":ignore-defface"); |
| 6449 | 6379 | ||
| 6380 | /* The symbol `face-alias'. A symbol having that property is an | ||
| 6381 | alias for another face. Value of the property is the name of | ||
| 6382 | the aliased face. */ | ||
| 6450 | DEFSYM (Qface_alias, "face-alias"); | 6383 | DEFSYM (Qface_alias, "face-alias"); |
| 6384 | |||
| 6385 | /* Names of basic faces. */ | ||
| 6451 | DEFSYM (Qdefault, "default"); | 6386 | DEFSYM (Qdefault, "default"); |
| 6452 | DEFSYM (Qtool_bar, "tool-bar"); | 6387 | DEFSYM (Qtool_bar, "tool-bar"); |
| 6453 | DEFSYM (Qregion, "region"); | 6388 | DEFSYM (Qregion, "region"); |
| @@ -6460,13 +6395,23 @@ syms_of_xfaces (void) | |||
| 6460 | DEFSYM (Qmouse, "mouse"); | 6395 | DEFSYM (Qmouse, "mouse"); |
| 6461 | DEFSYM (Qmode_line_inactive, "mode-line-inactive"); | 6396 | DEFSYM (Qmode_line_inactive, "mode-line-inactive"); |
| 6462 | DEFSYM (Qvertical_border, "vertical-border"); | 6397 | DEFSYM (Qvertical_border, "vertical-border"); |
| 6398 | |||
| 6399 | /* TTY color-related functions (defined in tty-colors.el). */ | ||
| 6463 | DEFSYM (Qwindow_divider, "window-divider"); | 6400 | DEFSYM (Qwindow_divider, "window-divider"); |
| 6464 | DEFSYM (Qwindow_divider_first_pixel, "window-divider-first-pixel"); | 6401 | DEFSYM (Qwindow_divider_first_pixel, "window-divider-first-pixel"); |
| 6465 | DEFSYM (Qwindow_divider_last_pixel, "window-divider-last-pixel"); | 6402 | DEFSYM (Qwindow_divider_last_pixel, "window-divider-last-pixel"); |
| 6466 | DEFSYM (Qtty_color_desc, "tty-color-desc"); | 6403 | DEFSYM (Qtty_color_desc, "tty-color-desc"); |
| 6467 | DEFSYM (Qtty_color_standard_values, "tty-color-standard-values"); | 6404 | DEFSYM (Qtty_color_standard_values, "tty-color-standard-values"); |
| 6468 | DEFSYM (Qtty_color_by_index, "tty-color-by-index"); | 6405 | DEFSYM (Qtty_color_by_index, "tty-color-by-index"); |
| 6406 | |||
| 6407 | /* The name of the function used to compute colors on TTYs. */ | ||
| 6469 | DEFSYM (Qtty_color_alist, "tty-color-alist"); | 6408 | DEFSYM (Qtty_color_alist, "tty-color-alist"); |
| 6409 | |||
| 6410 | /* Allowed scalable fonts. A value of nil means don't allow any | ||
| 6411 | scalable fonts. A value of t means allow the use of any scalable | ||
| 6412 | font. Otherwise, value must be a list of regular expressions. A | ||
| 6413 | font may be scaled if its name matches a regular expression in the | ||
| 6414 | list. */ | ||
| 6470 | DEFSYM (Qscalable_fonts_allowed, "scalable-fonts-allowed"); | 6415 | DEFSYM (Qscalable_fonts_allowed, "scalable-fonts-allowed"); |
| 6471 | 6416 | ||
| 6472 | Vparam_value_alist = list1 (Fcons (Qnil, Qnil)); | 6417 | Vparam_value_alist = list1 (Fcons (Qnil, Qnil)); |
diff --git a/src/xfns.c b/src/xfns.c index 2ea5f06e063..4a417526dcd 100644 --- a/src/xfns.c +++ b/src/xfns.c | |||
| @@ -125,10 +125,6 @@ extern LWLIB_ID widget_id_tick; | |||
| 125 | 125 | ||
| 126 | #define MAXREQUEST(dpy) (XMaxRequestSize (dpy)) | 126 | #define MAXREQUEST(dpy) (XMaxRequestSize (dpy)) |
| 127 | 127 | ||
| 128 | static Lisp_Object Qundefined_color; | ||
| 129 | static Lisp_Object Qcompound_text, Qcancel_timer; | ||
| 130 | Lisp_Object Qfont_param; | ||
| 131 | |||
| 132 | #ifdef GLYPH_DEBUG | 128 | #ifdef GLYPH_DEBUG |
| 133 | static ptrdiff_t image_cache_refcount; | 129 | static ptrdiff_t image_cache_refcount; |
| 134 | static int dpyinfo_refcount; | 130 | static int dpyinfo_refcount; |
| @@ -5498,7 +5494,7 @@ Text larger than the specified size is clipped. */) | |||
| 5498 | if (!row->reversed_p) | 5494 | if (!row->reversed_p) |
| 5499 | { | 5495 | { |
| 5500 | last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; | 5496 | last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; |
| 5501 | if (INTEGERP (last->object)) | 5497 | if (NILP (last->object)) |
| 5502 | row_width -= last->pixel_width; | 5498 | row_width -= last->pixel_width; |
| 5503 | } | 5499 | } |
| 5504 | else | 5500 | else |
| @@ -5508,7 +5504,7 @@ Text larger than the specified size is clipped. */) | |||
| 5508 | Don't count that glyph. */ | 5504 | Don't count that glyph. */ |
| 5509 | struct glyph *g = row->glyphs[TEXT_AREA]; | 5505 | struct glyph *g = row->glyphs[TEXT_AREA]; |
| 5510 | 5506 | ||
| 5511 | if (g->type == STRETCH_GLYPH && INTEGERP (g->object)) | 5507 | if (g->type == STRETCH_GLYPH && NILP (g->object)) |
| 5512 | { | 5508 | { |
| 5513 | row_width -= g->pixel_width; | 5509 | row_width -= g->pixel_width; |
| 5514 | seen_reversed_p = 1; | 5510 | seen_reversed_p = 1; |
| @@ -5552,7 +5548,7 @@ Text larger than the specified size is clipped. */) | |||
| 5552 | if (row->used[TEXT_AREA] && !row->reversed_p) | 5548 | if (row->used[TEXT_AREA] && !row->reversed_p) |
| 5553 | { | 5549 | { |
| 5554 | last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; | 5550 | last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1]; |
| 5555 | if (INTEGERP (last->object)) | 5551 | if (NILP (last->object)) |
| 5556 | row_width -= last->pixel_width; | 5552 | row_width -= last->pixel_width; |
| 5557 | } | 5553 | } |
| 5558 | 5554 | ||
diff --git a/src/xftfont.c b/src/xftfont.c index f0ad8db0c28..c587d814efa 100644 --- a/src/xftfont.c +++ b/src/xftfont.c | |||
| @@ -38,9 +38,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 38 | 38 | ||
| 39 | /* Xft font driver. */ | 39 | /* Xft font driver. */ |
| 40 | 40 | ||
| 41 | Lisp_Object Qxft; | ||
| 42 | static Lisp_Object QChinting, QCautohint, QChintstyle, QCrgba, QCembolden, | ||
| 43 | QClcdfilter; | ||
| 44 | 41 | ||
| 45 | /* The actual structure for Xft font that can be cast to struct | 42 | /* The actual structure for Xft font that can be cast to struct |
| 46 | font. */ | 43 | font. */ |
diff --git a/src/xmenu.c b/src/xmenu.c index c6bb9faee66..fd667a84343 100644 --- a/src/xmenu.c +++ b/src/xmenu.c | |||
| @@ -108,8 +108,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 108 | #define TRUE 1 | 108 | #define TRUE 1 |
| 109 | #endif /* no TRUE */ | 109 | #endif /* no TRUE */ |
| 110 | 110 | ||
| 111 | static Lisp_Object Qdebug_on_next_call; | 111 | |
| 112 | |||
| 113 | /* Flag which when set indicates a dialog or menu has been posted by | 112 | /* Flag which when set indicates a dialog or menu has been posted by |
| 114 | Xt on behalf of one of the widget sets. */ | 113 | Xt on behalf of one of the widget sets. */ |
| 115 | static int popup_activated_flag; | 114 | static int popup_activated_flag; |
| @@ -29,8 +29,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 29 | #include "buffer.h" | 29 | #include "buffer.h" |
| 30 | 30 | ||
| 31 | 31 | ||
| 32 | static Lisp_Object Qlibxml2_dll; | ||
| 33 | |||
| 34 | #ifdef WINDOWSNT | 32 | #ifdef WINDOWSNT |
| 35 | 33 | ||
| 36 | # include <windows.h> | 34 | # include <windows.h> |
diff --git a/src/xselect.c b/src/xselect.c index 92460d115db..33ff366b89c 100644 --- a/src/xselect.c +++ b/src/xselect.c | |||
| @@ -80,19 +80,6 @@ static void lisp_data_to_selection_data (struct x_display_info *, Lisp_Object, | |||
| 80 | #define TRACE2(fmt, a0, a1) (void) 0 | 80 | #define TRACE2(fmt, a0, a1) (void) 0 |
| 81 | #endif | 81 | #endif |
| 82 | 82 | ||
| 83 | |||
| 84 | static Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, | ||
| 85 | QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, | ||
| 86 | QATOM_PAIR, QCLIPBOARD_MANAGER, QSAVE_TARGETS; | ||
| 87 | |||
| 88 | static Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */ | ||
| 89 | static Lisp_Object QUTF8_STRING; /* This is a type of selection. */ | ||
| 90 | |||
| 91 | static Lisp_Object Qcompound_text_with_extensions; | ||
| 92 | |||
| 93 | static Lisp_Object Qforeign_selection; | ||
| 94 | static Lisp_Object Qx_lost_selection_functions, Qx_sent_selection_functions; | ||
| 95 | |||
| 96 | /* Bytes needed to represent 'long' data. This is as per libX11; it | 83 | /* Bytes needed to represent 'long' data. This is as per libX11; it |
| 97 | is not necessarily sizeof (long). */ | 84 | is not necessarily sizeof (long). */ |
| 98 | #define X_LONG_SIZE 4 | 85 | #define X_LONG_SIZE 4 |
| @@ -2687,8 +2674,11 @@ A value of 0 means wait as long as necessary. This is initialized from the | |||
| 2687 | DEFSYM (QCLIPBOARD, "CLIPBOARD"); | 2674 | DEFSYM (QCLIPBOARD, "CLIPBOARD"); |
| 2688 | DEFSYM (QTIMESTAMP, "TIMESTAMP"); | 2675 | DEFSYM (QTIMESTAMP, "TIMESTAMP"); |
| 2689 | DEFSYM (QTEXT, "TEXT"); | 2676 | DEFSYM (QTEXT, "TEXT"); |
| 2677 | |||
| 2678 | /* These are types of selection. */ | ||
| 2690 | DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT"); | 2679 | DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT"); |
| 2691 | DEFSYM (QUTF8_STRING, "UTF8_STRING"); | 2680 | DEFSYM (QUTF8_STRING, "UTF8_STRING"); |
| 2681 | |||
| 2692 | DEFSYM (QDELETE, "DELETE"); | 2682 | DEFSYM (QDELETE, "DELETE"); |
| 2693 | DEFSYM (QMULTIPLE, "MULTIPLE"); | 2683 | DEFSYM (QMULTIPLE, "MULTIPLE"); |
| 2694 | DEFSYM (QINCR, "INCR"); | 2684 | DEFSYM (QINCR, "INCR"); |
diff --git a/src/xsettings.c b/src/xsettings.c index ec45d47f9b7..8dbc7d990fe 100644 --- a/src/xsettings.c +++ b/src/xsettings.c | |||
| @@ -51,8 +51,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 51 | static char *current_mono_font; | 51 | static char *current_mono_font; |
| 52 | static char *current_font; | 52 | static char *current_font; |
| 53 | static struct x_display_info *first_dpyinfo; | 53 | static struct x_display_info *first_dpyinfo; |
| 54 | static Lisp_Object Qmonospace_font_name, Qfont_name, Qfont_render, | ||
| 55 | Qtool_bar_style; | ||
| 56 | static Lisp_Object current_tool_bar_style; | 54 | static Lisp_Object current_tool_bar_style; |
| 57 | 55 | ||
| 58 | /* Store an config changed event in to the event queue. */ | 56 | /* Store an config changed event in to the event queue. */ |
diff --git a/src/xterm.c b/src/xterm.c index e3f473986b2..9a87a1ee49c 100644 --- a/src/xterm.c +++ b/src/xterm.c | |||
| @@ -183,17 +183,9 @@ static Time ignore_next_mouse_click_timeout; | |||
| 183 | 183 | ||
| 184 | static int x_noop_count; | 184 | static int x_noop_count; |
| 185 | 185 | ||
| 186 | static Lisp_Object Qalt, Qhyper, Qmeta, Qsuper, Qmodifier_value; | ||
| 187 | |||
| 188 | static Lisp_Object Qvendor_specific_keysyms; | ||
| 189 | static Lisp_Object Qlatin_1; | ||
| 190 | |||
| 191 | #ifdef USE_GTK | 186 | #ifdef USE_GTK |
| 192 | /* The name of the Emacs icon file. */ | 187 | /* The name of the Emacs icon file. */ |
| 193 | static Lisp_Object xg_default_icon_file; | 188 | static Lisp_Object xg_default_icon_file; |
| 194 | |||
| 195 | /* Used in gtkutil.c. */ | ||
| 196 | Lisp_Object Qx_gtk_map_stock; | ||
| 197 | #endif | 189 | #endif |
| 198 | 190 | ||
| 199 | /* Some functions take this as char *, not const char *. */ | 191 | /* Some functions take this as char *, not const char *. */ |
diff --git a/src/xterm.h b/src/xterm.h index 25ce67b55d0..f2aff72e3ac 100644 --- a/src/xterm.h +++ b/src/xterm.h | |||
| @@ -1111,9 +1111,6 @@ extern bool x_session_have_connection (void); | |||
| 1111 | extern void x_session_close (void); | 1111 | extern void x_session_close (void); |
| 1112 | #endif | 1112 | #endif |
| 1113 | 1113 | ||
| 1114 | /* Defined in xterm.c */ | ||
| 1115 | |||
| 1116 | extern Lisp_Object Qx_gtk_map_stock; | ||
| 1117 | 1114 | ||
| 1118 | /* Is the frame embedded into another application? */ | 1115 | /* Is the frame embedded into another application? */ |
| 1119 | 1116 | ||
diff --git a/test/ChangeLog b/test/ChangeLog index bb061478b30..83bb8bf00c7 100644 --- a/test/ChangeLog +++ b/test/ChangeLog | |||
| @@ -1,3 +1,57 @@ | |||
| 1 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * automated/eieio-tests.el (eieio-test-23-inheritance-check): Don't use | ||
| 4 | <foo>-child-p. | ||
| 5 | |||
| 6 | * automated/eieio-test-methodinvoke.el (eieio-test-method-store): | ||
| 7 | Update reference to eieio--generic-call-key. | ||
| 8 | |||
| 9 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 10 | |||
| 11 | * automated/eieio-tests.el: Use cl-lib. Don't use <class> as a variable. | ||
| 12 | Don't use <class>-list types and <class>-list-p predicates. | ||
| 13 | |||
| 14 | * automated/eieio-test-persist.el (persistent-with-objs-list-slot): | ||
| 15 | Don't use <class>-list type. | ||
| 16 | |||
| 17 | * automated/eieio-test-methodinvoke.el | ||
| 18 | (eieio-test-method-order-list-4): | ||
| 19 | Don't use <class> as a variable. | ||
| 20 | |||
| 21 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 22 | |||
| 23 | * automated/eieio-tests.el (eieio-test-04-static-method) | ||
| 24 | (eieio-test-05-static-method-2): Use oref-default to access | ||
| 25 | class slots. | ||
| 26 | (eieio-test-23-inheritance-check): Don't assume that | ||
| 27 | eieio-class-parents returns class names, or that a class can only have | ||
| 28 | a single name. | ||
| 29 | |||
| 30 | * automated/eieio-test-persist.el (eieio--attribute-to-initarg): | ||
| 31 | Move from eieio-core.el. Rename from eieio-attribute-to-initarg. | ||
| 32 | Change arg to be a class object. Update all callers. | ||
| 33 | |||
| 34 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 35 | |||
| 36 | * automated/eieio-test-methodinvoke.el (eieio-test-method-store): | ||
| 37 | Adjust to new semantics of eieio--scoped-class. | ||
| 38 | (eieio-test-match): Improve error feedback. | ||
| 39 | |||
| 40 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 41 | |||
| 42 | * automated/eieio-tests.el: Remove dummy object names. | ||
| 43 | |||
| 44 | * automated/eieio-test-persist.el (persistent-with-objs-slot-subs): | ||
| 45 | The type FOO-child is the same as FOO. | ||
| 46 | |||
| 47 | 2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 48 | |||
| 49 | * automated/eieio-test-methodinvoke.el (eieio-test-method-store): | ||
| 50 | Remove use of eieio-generic-call-methodname. | ||
| 51 | (eieio-test-method-order-list-3, eieio-test-method-order-list-6) | ||
| 52 | (eieio-test-method-order-list-7, eieio-test-method-order-list-8): | ||
| 53 | Adjust the expected result accordingly. | ||
| 54 | |||
| 1 | 2015-01-01 Michael Albinus <michael.albinus@gmx.de> | 55 | 2015-01-01 Michael Albinus <michael.albinus@gmx.de> |
| 2 | 56 | ||
| 3 | * automated/tramp-tests.el (tramp--test-smb-or-windows-nt-p): | 57 | * automated/tramp-tests.el (tramp--test-smb-or-windows-nt-p): |
| @@ -19,8 +73,7 @@ | |||
| 19 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> | 73 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> |
| 20 | 74 | ||
| 21 | * automated/python-tests.el | 75 | * automated/python-tests.el |
| 22 | (python-shell-completion-native-interpreter-disabled-p-1): New | 76 | (python-shell-completion-native-interpreter-disabled-p-1): New test. |
| 23 | test. | ||
| 24 | 77 | ||
| 25 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> | 78 | 2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> |
| 26 | 79 | ||
| @@ -110,8 +163,8 @@ | |||
| 110 | (vc-test--create-repo-function): Rename from | 163 | (vc-test--create-repo-function): Rename from |
| 111 | `vc-test--create-repo-if-not-supported'. Adapt all callees. | 164 | `vc-test--create-repo-if-not-supported'. Adapt all callees. |
| 112 | (vc-test--create-repo): Check also for revision-granularity. | 165 | (vc-test--create-repo): Check also for revision-granularity. |
| 113 | (vc-test--unregister-function): Additional argument FILE. Adapt | 166 | (vc-test--unregister-function): Additional argument FILE. |
| 114 | all callees. | 167 | Adapt all callees. |
| 115 | (vc-test--working-revision): New defun. | 168 | (vc-test--working-revision): New defun. |
| 116 | (vc-test-*-working-revision): New tests. | 169 | (vc-test-*-working-revision): New tests. |
| 117 | 170 | ||
| @@ -148,7 +201,7 @@ | |||
| 148 | 2014-11-21 Ulf Jasper <ulf.jasper@web.de> | 201 | 2014-11-21 Ulf Jasper <ulf.jasper@web.de> |
| 149 | 202 | ||
| 150 | * automated/libxml-tests.el | 203 | * automated/libxml-tests.el |
| 151 | (libxml-tests--data-comments-preserved): Renamed from | 204 | (libxml-tests--data-comments-preserved): Rename from |
| 152 | 'libxml-tests--data'. | 205 | 'libxml-tests--data'. |
| 153 | (libxml-tests--data-comments-discarded): New. | 206 | (libxml-tests--data-comments-discarded): New. |
| 154 | (libxml-tests): Check whether 'libxml-parse-xml-region' is | 207 | (libxml-tests): Check whether 'libxml-parse-xml-region' is |
| @@ -175,8 +228,8 @@ | |||
| 175 | 228 | ||
| 176 | 2014-11-17 Ulf Jasper <ulf.jasper@web.de> | 229 | 2014-11-17 Ulf Jasper <ulf.jasper@web.de> |
| 177 | 230 | ||
| 178 | * automated/icalendar-tests.el (icalendar-tests--test-export): New | 231 | * automated/icalendar-tests.el (icalendar-tests--test-export): |
| 179 | optional parameter `alarms'. | 232 | New optional parameter `alarms'. |
| 180 | (icalendar-export-alarms): New test for exporting icalendar | 233 | (icalendar-export-alarms): New test for exporting icalendar |
| 181 | alarms. | 234 | alarms. |
| 182 | (icalendar-tests--test-cycle): Let `icalendar-export-alarms' be nil. | 235 | (icalendar-tests--test-cycle): Let `icalendar-export-alarms' be nil. |
| @@ -190,8 +243,8 @@ | |||
| 190 | 243 | ||
| 191 | 2014-11-16 Ulf Jasper <ulf.jasper@web.de> | 244 | 2014-11-16 Ulf Jasper <ulf.jasper@web.de> |
| 192 | 245 | ||
| 193 | * automated/icalendar-tests.el (icalendar--parse-vtimezone): Add | 246 | * automated/icalendar-tests.el (icalendar--parse-vtimezone): |
| 194 | testcase where offsets of standard time and daylight saving time | 247 | Add testcase where offsets of standard time and daylight saving time |
| 195 | are equal. | 248 | are equal. |
| 196 | (icalendar-real-world): Fix error in test case. Expected result | 249 | (icalendar-real-world): Fix error in test case. Expected result |
| 197 | was wrong when offsets of standard time and daylight saving time | 250 | was wrong when offsets of standard time and daylight saving time |
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el index f2fe37836f3..2de836ceda5 100644 --- a/test/automated/eieio-test-methodinvoke.el +++ b/test/automated/eieio-test-methodinvoke.el | |||
| @@ -61,16 +61,17 @@ | |||
| 61 | (defun eieio-test-method-store () | 61 | (defun eieio-test-method-store () |
| 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 | (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ] |
| 64 | (or eieio-generic-call-key 0))) | 64 | (or eieio--generic-call-key 0))) |
| 65 | (c (list eieio-generic-call-methodname keysym (eieio--scoped-class)))) | 65 | ;; FIXME: Don't depend on `eieio--scoped-class'! |
| 66 | (setq eieio-test-method-order-list | 66 | (c (list keysym (eieio--class-symbol (eieio--scoped-class))))) |
| 67 | (cons c eieio-test-method-order-list)))) | 67 | (push c eieio-test-method-order-list))) |
| 68 | 68 | ||
| 69 | (defun eieio-test-match (rightanswer) | 69 | (defun eieio-test-match (rightanswer) |
| 70 | "Do a test match." | 70 | "Do a test match." |
| 71 | (if (equal rightanswer eieio-test-method-order-list) | 71 | (if (equal rightanswer eieio-test-method-order-list) |
| 72 | t | 72 | t |
| 73 | (error "eieio-test-methodinvoke.el: Test Failed!"))) | 73 | (error "eieio-test-methodinvoke.el: Test Failed: %S != %S" |
| 74 | rightanswer eieio-test-method-order-list))) | ||
| 74 | 75 | ||
| 75 | (defvar eieio-test-call-next-method-arguments nil | 76 | (defvar eieio-test-call-next-method-arguments nil |
| 76 | "List of passed to methods during execution of `call-next-method'.") | 77 | "List of passed to methods during execution of `call-next-method'.") |
| @@ -121,17 +122,17 @@ | |||
| 121 | (ert-deftest eieio-test-method-order-list-3 () | 122 | (ert-deftest eieio-test-method-order-list-3 () |
| 122 | (let ((eieio-test-method-order-list nil) | 123 | (let ((eieio-test-method-order-list nil) |
| 123 | (ans '( | 124 | (ans '( |
| 124 | (eitest-F :BEFORE eitest-B) | 125 | (:BEFORE eitest-B) |
| 125 | (eitest-F :BEFORE eitest-B-base1) | 126 | (:BEFORE eitest-B-base1) |
| 126 | (eitest-F :BEFORE eitest-B-base2) | 127 | (:BEFORE eitest-B-base2) |
| 127 | 128 | ||
| 128 | (eitest-F :PRIMARY eitest-B) | 129 | (:PRIMARY eitest-B) |
| 129 | (eitest-F :PRIMARY eitest-B-base1) | 130 | (:PRIMARY eitest-B-base1) |
| 130 | (eitest-F :PRIMARY eitest-B-base2) | 131 | (:PRIMARY eitest-B-base2) |
| 131 | 132 | ||
| 132 | (eitest-F :AFTER eitest-B-base2) | 133 | (:AFTER eitest-B-base2) |
| 133 | (eitest-F :AFTER eitest-B-base1) | 134 | (:AFTER eitest-B-base1) |
| 134 | (eitest-F :AFTER eitest-B) | 135 | (:AFTER eitest-B) |
| 135 | ))) | 136 | ))) |
| 136 | (eitest-F (eitest-B nil)) | 137 | (eitest-F (eitest-B nil)) |
| 137 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) | 138 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) |
| @@ -145,7 +146,7 @@ | |||
| 145 | 146 | ||
| 146 | (ert-deftest eieio-test-method-order-list-4 () | 147 | (ert-deftest eieio-test-method-order-list-4 () |
| 147 | ;; Both of these situations should succeed. | 148 | ;; Both of these situations should succeed. |
| 148 | (should (eitest-H eitest-A)) | 149 | (should (eitest-H 'eitest-A)) |
| 149 | (should (eitest-H (eitest-A nil)))) | 150 | (should (eitest-H (eitest-A nil)))) |
| 150 | 151 | ||
| 151 | ;;; Return value from :PRIMARY | 152 | ;;; Return value from :PRIMARY |
| @@ -176,17 +177,18 @@ | |||
| 176 | (defclass C-base2 () ()) | 177 | (defclass C-base2 () ()) |
| 177 | (defclass C (C-base1 C-base2) ()) | 178 | (defclass C (C-base1 C-base2) ()) |
| 178 | 179 | ||
| 180 | ;; Just use the obsolete name once, to make sure it also works. | ||
| 179 | (defmethod constructor :STATIC ((p C-base1) &rest args) | 181 | (defmethod constructor :STATIC ((p C-base1) &rest args) |
| 180 | (eieio-test-method-store) | 182 | (eieio-test-method-store) |
| 181 | (if (next-method-p) (call-next-method)) | 183 | (if (next-method-p) (call-next-method)) |
| 182 | ) | 184 | ) |
| 183 | 185 | ||
| 184 | (defmethod constructor :STATIC ((p C-base2) &rest args) | 186 | (defmethod eieio-constructor :STATIC ((p C-base2) &rest args) |
| 185 | (eieio-test-method-store) | 187 | (eieio-test-method-store) |
| 186 | (if (next-method-p) (call-next-method)) | 188 | (if (next-method-p) (call-next-method)) |
| 187 | ) | 189 | ) |
| 188 | 190 | ||
| 189 | (defmethod constructor :STATIC ((p C) &rest args) | 191 | (defmethod eieio-constructor :STATIC ((p C) &rest args) |
| 190 | (eieio-test-method-store) | 192 | (eieio-test-method-store) |
| 191 | (call-next-method) | 193 | (call-next-method) |
| 192 | ) | 194 | ) |
| @@ -194,9 +196,9 @@ | |||
| 194 | (ert-deftest eieio-test-method-order-list-6 () | 196 | (ert-deftest eieio-test-method-order-list-6 () |
| 195 | (let ((eieio-test-method-order-list nil) | 197 | (let ((eieio-test-method-order-list nil) |
| 196 | (ans '( | 198 | (ans '( |
| 197 | (constructor :STATIC C) | 199 | (:STATIC C) |
| 198 | (constructor :STATIC C-base1) | 200 | (:STATIC C-base1) |
| 199 | (constructor :STATIC C-base2) | 201 | (:STATIC C-base2) |
| 200 | ))) | 202 | ))) |
| 201 | (C nil) | 203 | (C nil) |
| 202 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) | 204 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) |
| @@ -239,10 +241,10 @@ | |||
| 239 | (ert-deftest eieio-test-method-order-list-7 () | 241 | (ert-deftest eieio-test-method-order-list-7 () |
| 240 | (let ((eieio-test-method-order-list nil) | 242 | (let ((eieio-test-method-order-list nil) |
| 241 | (ans '( | 243 | (ans '( |
| 242 | (eitest-F :PRIMARY D) | 244 | (:PRIMARY D) |
| 243 | (eitest-F :PRIMARY D-base1) | 245 | (:PRIMARY D-base1) |
| 244 | ;; (eitest-F :PRIMARY D-base2) | 246 | ;; (:PRIMARY D-base2) |
| 245 | (eitest-F :PRIMARY D-base0) | 247 | (:PRIMARY D-base0) |
| 246 | ))) | 248 | ))) |
| 247 | (eitest-F (D nil)) | 249 | (eitest-F (D nil)) |
| 248 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) | 250 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) |
| @@ -278,10 +280,10 @@ | |||
| 278 | (ert-deftest eieio-test-method-order-list-8 () | 280 | (ert-deftest eieio-test-method-order-list-8 () |
| 279 | (let ((eieio-test-method-order-list nil) | 281 | (let ((eieio-test-method-order-list nil) |
| 280 | (ans '( | 282 | (ans '( |
| 281 | (eitest-F :PRIMARY E) | 283 | (:PRIMARY E) |
| 282 | (eitest-F :PRIMARY E-base1) | 284 | (:PRIMARY E-base1) |
| 283 | (eitest-F :PRIMARY E-base2) | 285 | (:PRIMARY E-base2) |
| 284 | (eitest-F :PRIMARY E-base0) | 286 | (:PRIMARY E-base0) |
| 285 | ))) | 287 | ))) |
| 286 | (eitest-F (E nil)) | 288 | (eitest-F (E nil)) |
| 287 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) | 289 | (setq eieio-test-method-order-list (nreverse eieio-test-method-order-list)) |
diff --git a/test/automated/eieio-test-persist.el b/test/automated/eieio-test-persist.el index 2db1dbe6698..7bb2f1ca779 100644 --- a/test/automated/eieio-test-persist.el +++ b/test/automated/eieio-test-persist.el | |||
| @@ -32,6 +32,14 @@ | |||
| 32 | (require 'eieio-base) | 32 | (require 'eieio-base) |
| 33 | (require 'ert) | 33 | (require 'ert) |
| 34 | 34 | ||
| 35 | (defun eieio--attribute-to-initarg (class attribute) | ||
| 36 | "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag. | ||
| 37 | This is usually a symbol that starts with `:'." | ||
| 38 | (let ((tuple (rassoc attribute (eieio--class-initarg-tuples class)))) | ||
| 39 | (if tuple | ||
| 40 | (car tuple) | ||
| 41 | nil))) | ||
| 42 | |||
| 35 | (defun persist-test-save-and-compare (original) | 43 | (defun persist-test-save-and-compare (original) |
| 36 | "Compare the object ORIGINAL against the one read fromdisk." | 44 | "Compare the object ORIGINAL against the one read fromdisk." |
| 37 | 45 | ||
| @@ -40,7 +48,7 @@ | |||
| 40 | (let* ((file (oref original :file)) | 48 | (let* ((file (oref original :file)) |
| 41 | (class (eieio-object-class original)) | 49 | (class (eieio-object-class original)) |
| 42 | (fromdisk (eieio-persistent-read file class)) | 50 | (fromdisk (eieio-persistent-read file class)) |
| 43 | (cv (class-v class)) | 51 | (cv (eieio--class-v class)) |
| 44 | (slot-names (eieio--class-public-a cv)) | 52 | (slot-names (eieio--class-public-a cv)) |
| 45 | (slot-deflt (eieio--class-public-d cv)) | 53 | (slot-deflt (eieio--class-public-d cv)) |
| 46 | ) | 54 | ) |
| @@ -53,7 +61,8 @@ | |||
| 53 | (let* ((oneslot (car slot-names)) | 61 | (let* ((oneslot (car slot-names)) |
| 54 | (origvalue (eieio-oref original oneslot)) | 62 | (origvalue (eieio-oref original oneslot)) |
| 55 | (fromdiskvalue (eieio-oref fromdisk oneslot)) | 63 | (fromdiskvalue (eieio-oref fromdisk oneslot)) |
| 56 | (initarg-p (eieio-attribute-to-initarg class oneslot)) | 64 | (initarg-p (eieio--attribute-to-initarg |
| 65 | (eieio--class-v class) oneslot)) | ||
| 57 | ) | 66 | ) |
| 58 | 67 | ||
| 59 | (if initarg-p | 68 | (if initarg-p |
| @@ -175,7 +184,7 @@ persistent class.") | |||
| 175 | 184 | ||
| 176 | (defclass persistent-with-objs-slot-subs (eieio-persistent) | 185 | (defclass persistent-with-objs-slot-subs (eieio-persistent) |
| 177 | ((pnp :initarg :pnp | 186 | ((pnp :initarg :pnp |
| 178 | :type (or null persist-not-persistent-child) | 187 | :type (or null persist-not-persistent) |
| 179 | :initform nil)) | 188 | :initform nil)) |
| 180 | "Class for testing the saving of slots with objects in them.") | 189 | "Class for testing the saving of slots with objects in them.") |
| 181 | 190 | ||
| @@ -194,7 +203,7 @@ persistent class.") | |||
| 194 | ;; A slot that contains another object that isn't persistent | 203 | ;; A slot that contains another object that isn't persistent |
| 195 | (defclass persistent-with-objs-list-slot (eieio-persistent) | 204 | (defclass persistent-with-objs-list-slot (eieio-persistent) |
| 196 | ((pnp :initarg :pnp | 205 | ((pnp :initarg :pnp |
| 197 | :type persist-not-persistent-list | 206 | :type (list-of persist-not-persistent) |
| 198 | :initform nil)) | 207 | :initform nil)) |
| 199 | "Class for testing the saving of slots with objects in them.") | 208 | "Class for testing the saving of slots with objects in them.") |
| 200 | 209 | ||
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el index 15b65042ba4..0b1ff1fd93b 100644 --- a/test/automated/eieio-tests.el +++ b/test/automated/eieio-tests.el | |||
| @@ -29,7 +29,7 @@ | |||
| 29 | (require 'eieio-base) | 29 | (require 'eieio-base) |
| 30 | (require 'eieio-opt) | 30 | (require 'eieio-opt) |
| 31 | 31 | ||
| 32 | (eval-when-compile (require 'cl)) | 32 | (eval-when-compile (require 'cl-lib)) |
| 33 | 33 | ||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | ;; Set up some test classes | 35 | ;; Set up some test classes |
| @@ -158,7 +158,7 @@ | |||
| 158 | (ert-deftest eieio-test-02-abstract-class () | 158 | (ert-deftest eieio-test-02-abstract-class () |
| 159 | ;; Abstract classes cannot be instantiated, so this should throw an | 159 | ;; Abstract classes cannot be instantiated, so this should throw an |
| 160 | ;; error | 160 | ;; error |
| 161 | (should-error (abstract-class "Test"))) | 161 | (should-error (abstract-class))) |
| 162 | 162 | ||
| 163 | (defgeneric generic1 () "First generic function") | 163 | (defgeneric generic1 () "First generic function") |
| 164 | 164 | ||
| @@ -180,7 +180,7 @@ | |||
| 180 | "Method generic1 that can take a non-object." | 180 | "Method generic1 that can take a non-object." |
| 181 | not-an-object) | 181 | not-an-object) |
| 182 | 182 | ||
| 183 | (let ((ans-obj (generic1 (class-a "test"))) | 183 | (let ((ans-obj (generic1 (class-a))) |
| 184 | (ans-num (generic1 666))) | 184 | (ans-num (generic1 666))) |
| 185 | (should (eq ans-obj 'monkey)) | 185 | (should (eq ans-obj 'monkey)) |
| 186 | (should (eq ans-num 666)))) | 186 | (should (eq ans-num 666)))) |
| @@ -199,10 +199,10 @@ Argument C is the class bound to this static method." | |||
| 199 | 199 | ||
| 200 | (ert-deftest eieio-test-04-static-method () | 200 | (ert-deftest eieio-test-04-static-method () |
| 201 | ;; Call static method on a class and see if it worked | 201 | ;; Call static method on a class and see if it worked |
| 202 | (static-method-class-method static-method-class 'class) | 202 | (static-method-class-method 'static-method-class 'class) |
| 203 | (should (eq (oref static-method-class some-slot) 'class)) | 203 | (should (eq (oref-default 'static-method-class some-slot) 'class)) |
| 204 | (static-method-class-method (static-method-class "test") 'object) | 204 | (static-method-class-method (static-method-class) 'object) |
| 205 | (should (eq (oref static-method-class some-slot) 'object))) | 205 | (should (eq (oref-default 'static-method-class some-slot) 'object))) |
| 206 | 206 | ||
| 207 | (ert-deftest eieio-test-05-static-method-2 () | 207 | (ert-deftest eieio-test-05-static-method-2 () |
| 208 | (defclass static-method-class-2 (static-method-class) | 208 | (defclass static-method-class-2 (static-method-class) |
| @@ -215,10 +215,10 @@ Argument C is the class bound to this static method." | |||
| 215 | (if (eieio-object-p c) (setq c (eieio-object-class c))) | 215 | (if (eieio-object-p c) (setq c (eieio-object-class c))) |
| 216 | (oset-default c some-slot (intern (concat "moose-" (symbol-name value))))) | 216 | (oset-default c some-slot (intern (concat "moose-" (symbol-name value))))) |
| 217 | 217 | ||
| 218 | (static-method-class-method static-method-class-2 'class) | 218 | (static-method-class-method 'static-method-class-2 'class) |
| 219 | (should (eq (oref static-method-class-2 some-slot) 'moose-class)) | 219 | (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class)) |
| 220 | (static-method-class-method (static-method-class-2 "test") 'object) | 220 | (static-method-class-method (static-method-class-2) 'object) |
| 221 | (should (eq (oref static-method-class-2 some-slot) 'moose-object))) | 221 | (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-object))) |
| 222 | 222 | ||
| 223 | 223 | ||
| 224 | ;;; Perform method testing | 224 | ;;; Perform method testing |
| @@ -231,14 +231,14 @@ Argument C is the class bound to this static method." | |||
| 231 | (defvar eitest-b nil) | 231 | (defvar eitest-b nil) |
| 232 | (ert-deftest eieio-test-06-allocate-objects () | 232 | (ert-deftest eieio-test-06-allocate-objects () |
| 233 | ;; allocate an object to use | 233 | ;; allocate an object to use |
| 234 | (should (setq eitest-ab (class-ab "abby"))) | 234 | (should (setq eitest-ab (class-ab))) |
| 235 | (should (setq eitest-a (class-a "aye"))) | 235 | (should (setq eitest-a (class-a))) |
| 236 | (should (setq eitest-b (class-b "fooby")))) | 236 | (should (setq eitest-b (class-b)))) |
| 237 | 237 | ||
| 238 | (ert-deftest eieio-test-07-make-instance () | 238 | (ert-deftest eieio-test-07-make-instance () |
| 239 | (should (make-instance 'class-ab)) | 239 | (should (make-instance 'class-ab)) |
| 240 | (should (make-instance 'class-a :water 'cho)) | 240 | (should (make-instance 'class-a :water 'cho)) |
| 241 | (should (make-instance 'class-b "a name"))) | 241 | (should (make-instance 'class-b))) |
| 242 | 242 | ||
| 243 | (defmethod class-cn ((a class-a)) | 243 | (defmethod class-cn ((a class-a)) |
| 244 | "Try calling `call-next-method' when there isn't one. | 244 | "Try calling `call-next-method' when there isn't one. |
| @@ -355,7 +355,7 @@ METHOD is the method that was attempting to be called." | |||
| 355 | (call-next-method) | 355 | (call-next-method) |
| 356 | (oset a test-tag 1)) | 356 | (oset a test-tag 1)) |
| 357 | 357 | ||
| 358 | (let ((ca (class-a "class act"))) | 358 | (let ((ca (class-a))) |
| 359 | (should-not (/= (oref ca test-tag) 2)))) | 359 | (should-not (/= (oref ca test-tag) 2)))) |
| 360 | 360 | ||
| 361 | 361 | ||
| @@ -404,7 +404,7 @@ METHOD is the method that was attempting to be called." | |||
| 404 | (t (call-next-method)))) | 404 | (t (call-next-method)))) |
| 405 | 405 | ||
| 406 | (ert-deftest eieio-test-17-virtual-slot () | 406 | (ert-deftest eieio-test-17-virtual-slot () |
| 407 | (setq eitest-vsca (virtual-slot-class "eitest-vsca" :base-value 1)) | 407 | (setq eitest-vsca (virtual-slot-class :base-value 1)) |
| 408 | ;; Check slot values | 408 | ;; Check slot values |
| 409 | (should (= (oref eitest-vsca :base-value) 1)) | 409 | (should (= (oref eitest-vsca :base-value) 1)) |
| 410 | (should (= (oref eitest-vsca :derived-value) 2)) | 410 | (should (= (oref eitest-vsca :derived-value) 2)) |
| @@ -419,7 +419,7 @@ METHOD is the method that was attempting to be called." | |||
| 419 | 419 | ||
| 420 | ;; should also be possible to initialize instance using virtual slot | 420 | ;; should also be possible to initialize instance using virtual slot |
| 421 | 421 | ||
| 422 | (setq eitest-vscb (virtual-slot-class "eitest-vscb" :derived-value 5)) | 422 | (setq eitest-vscb (virtual-slot-class :derived-value 5)) |
| 423 | (should (= (oref eitest-vscb :base-value) 4)) | 423 | (should (= (oref eitest-vscb :base-value) 4)) |
| 424 | (should (= (oref eitest-vscb :derived-value) 5))) | 424 | (should (= (oref eitest-vscb :derived-value) 5))) |
| 425 | 425 | ||
| @@ -445,7 +445,7 @@ METHOD is the method that was attempting to be called." | |||
| 445 | ;; After setting 'water to 'moose, make sure a new object has | 445 | ;; After setting 'water to 'moose, make sure a new object has |
| 446 | ;; the right stuff. | 446 | ;; the right stuff. |
| 447 | (oset-default (eieio-object-class eitest-a) water 'penguin) | 447 | (oset-default (eieio-object-class eitest-a) water 'penguin) |
| 448 | (should (eq (oref (class-a "foo") water) 'penguin)) | 448 | (should (eq (oref (class-a) water) 'penguin)) |
| 449 | 449 | ||
| 450 | ;; Revert the above | 450 | ;; Revert the above |
| 451 | (defmethod slot-unbound ((a class-a) &rest foo) | 451 | (defmethod slot-unbound ((a class-a) &rest foo) |
| @@ -459,12 +459,12 @@ METHOD is the method that was attempting to be called." | |||
| 459 | ;; We should not be able to set a string here | 459 | ;; We should not be able to set a string here |
| 460 | (should-error (oset eitest-ab water "a string, not a symbol") :type 'invalid-slot-type) | 460 | (should-error (oset eitest-ab water "a string, not a symbol") :type 'invalid-slot-type) |
| 461 | (should-error (oset eitest-ab classslot "a string, not a symbol") :type 'invalid-slot-type) | 461 | (should-error (oset eitest-ab classslot "a string, not a symbol") :type 'invalid-slot-type) |
| 462 | (should-error (class-a "broken-type-a" :water "a string not a symbol") :type 'invalid-slot-type)) | 462 | (should-error (class-a :water "a string not a symbol") :type 'invalid-slot-type)) |
| 463 | 463 | ||
| 464 | (ert-deftest eieio-test-20-class-allocated-slots () | 464 | (ert-deftest eieio-test-20-class-allocated-slots () |
| 465 | ;; Test out class allocated slots | 465 | ;; Test out class allocated slots |
| 466 | (defvar eitest-aa nil) | 466 | (defvar eitest-aa nil) |
| 467 | (setq eitest-aa (class-a "another")) | 467 | (setq eitest-aa (class-a)) |
| 468 | 468 | ||
| 469 | ;; Make sure class slots do not track between objects | 469 | ;; Make sure class slots do not track between objects |
| 470 | (let ((newval 'moose)) | 470 | (let ((newval 'moose)) |
| @@ -474,12 +474,12 @@ METHOD is the method that was attempting to be called." | |||
| 474 | 474 | ||
| 475 | ;; Slot should be bound | 475 | ;; Slot should be bound |
| 476 | (should (slot-boundp eitest-a 'classslot)) | 476 | (should (slot-boundp eitest-a 'classslot)) |
| 477 | (should (slot-boundp class-a 'classslot)) | 477 | (should (slot-boundp 'class-a 'classslot)) |
| 478 | 478 | ||
| 479 | (slot-makeunbound eitest-a 'classslot) | 479 | (slot-makeunbound eitest-a 'classslot) |
| 480 | 480 | ||
| 481 | (should-not (slot-boundp eitest-a 'classslot)) | 481 | (should-not (slot-boundp eitest-a 'classslot)) |
| 482 | (should-not (slot-boundp class-a 'classslot))) | 482 | (should-not (slot-boundp 'class-a 'classslot))) |
| 483 | 483 | ||
| 484 | 484 | ||
| 485 | (defvar eieio-test-permuting-value nil) | 485 | (defvar eieio-test-permuting-value nil) |
| @@ -499,7 +499,7 @@ METHOD is the method that was attempting to be called." | |||
| 499 | (ert-deftest eieio-test-21-eval-at-construction-time () | 499 | (ert-deftest eieio-test-21-eval-at-construction-time () |
| 500 | ;; initforms that need to be evalled at construction time. | 500 | ;; initforms that need to be evalled at construction time. |
| 501 | (setq eieio-test-permuting-value 2) | 501 | (setq eieio-test-permuting-value 2) |
| 502 | (setq eitest-pvinit (inittest "permuteme")) | 502 | (setq eitest-pvinit (inittest)) |
| 503 | 503 | ||
| 504 | (should (eq (oref eitest-pvinit staticval) 1)) | 504 | (should (eq (oref eitest-pvinit staticval) 1)) |
| 505 | (should (eq (oref eitest-pvinit symval) 'eieio-test-permuting-value)) | 505 | (should (eq (oref eitest-pvinit symval) 'eieio-test-permuting-value)) |
| @@ -515,11 +515,11 @@ METHOD is the method that was attempting to be called." | |||
| 515 | "Test class that will be a calculated value.") | 515 | "Test class that will be a calculated value.") |
| 516 | 516 | ||
| 517 | (defclass eitest-superior nil | 517 | (defclass eitest-superior nil |
| 518 | ((sub :initform (eitest-subordinate "test") | 518 | ((sub :initform (eitest-subordinate) |
| 519 | :type eitest-subordinate)) | 519 | :type eitest-subordinate)) |
| 520 | "A class with an initform that creates a class.") | 520 | "A class with an initform that creates a class.") |
| 521 | 521 | ||
| 522 | (should (setq eitest-tests (eitest-superior "test"))) | 522 | (should (setq eitest-tests (eitest-superior))) |
| 523 | 523 | ||
| 524 | (should-error | 524 | (should-error |
| 525 | (eval | 525 | (eval |
| @@ -530,33 +530,35 @@ METHOD is the method that was attempting to be called." | |||
| 530 | :type 'invalid-slot-type)) | 530 | :type 'invalid-slot-type)) |
| 531 | 531 | ||
| 532 | (ert-deftest eieio-test-23-inheritance-check () | 532 | (ert-deftest eieio-test-23-inheritance-check () |
| 533 | (should (child-of-class-p class-ab class-a)) | 533 | (should (child-of-class-p 'class-ab 'class-a)) |
| 534 | (should (child-of-class-p class-ab class-b)) | 534 | (should (child-of-class-p 'class-ab 'class-b)) |
| 535 | (should (object-of-class-p eitest-a class-a)) | 535 | (should (object-of-class-p eitest-a 'class-a)) |
| 536 | (should (object-of-class-p eitest-ab class-a)) | 536 | (should (object-of-class-p eitest-ab 'class-a)) |
| 537 | (should (object-of-class-p eitest-ab class-b)) | 537 | (should (object-of-class-p eitest-ab 'class-b)) |
| 538 | (should (object-of-class-p eitest-ab class-ab)) | 538 | (should (object-of-class-p eitest-ab 'class-ab)) |
| 539 | (should (eq (eieio-class-parents class-a) nil)) | 539 | (should (eq (eieio-class-parents 'class-a) nil)) |
| 540 | (should (equal (eieio-class-parents class-ab) '(class-a class-b))) | 540 | ;; FIXME: eieio-class-parents now returns class objects! |
| 541 | (should (same-class-p eitest-a class-a)) | 541 | (should (equal (mapcar #'eieio-class-object (eieio-class-parents 'class-ab)) |
| 542 | (mapcar #'eieio-class-object '(class-a class-b)))) | ||
| 543 | (should (same-class-p eitest-a 'class-a)) | ||
| 542 | (should (class-a-p eitest-a)) | 544 | (should (class-a-p eitest-a)) |
| 543 | (should (not (class-a-p eitest-ab))) | 545 | (should (not (class-a-p eitest-ab))) |
| 544 | (should (class-a-child-p eitest-a)) | 546 | (should (cl-typep eitest-a 'class-a)) |
| 545 | (should (class-a-child-p eitest-ab)) | 547 | (should (cl-typep eitest-ab 'class-a)) |
| 546 | (should (not (class-a-p "foo"))) | 548 | (should (not (class-a-p "foo"))) |
| 547 | (should (not (class-a-child-p "foo")))) | 549 | (should (not (cl-typep "foo" 'class-a)))) |
| 548 | 550 | ||
| 549 | (ert-deftest eieio-test-24-object-predicates () | 551 | (ert-deftest eieio-test-24-object-predicates () |
| 550 | (let ((listooa (list (class-ab "ab") (class-a "a"))) | 552 | (let ((listooa (list (class-ab) (class-a))) |
| 551 | (listoob (list (class-ab "ab") (class-b "b")))) | 553 | (listoob (list (class-ab) (class-b)))) |
| 552 | (should (class-a-list-p listooa)) | 554 | (should (cl-typep listooa '(list-of class-a))) |
| 553 | (should (class-b-list-p listoob)) | 555 | (should (cl-typep listoob '(list-of class-b))) |
| 554 | (should-not (class-b-list-p listooa)) | 556 | (should-not (cl-typep listooa '(list-of class-b))) |
| 555 | (should-not (class-a-list-p listoob)))) | 557 | (should-not (cl-typep listoob '(list-of class-a))))) |
| 556 | 558 | ||
| 557 | (defvar eitest-t1 nil) | 559 | (defvar eitest-t1 nil) |
| 558 | (ert-deftest eieio-test-25-slot-tests () | 560 | (ert-deftest eieio-test-25-slot-tests () |
| 559 | (setq eitest-t1 (class-c "C1")) | 561 | (setq eitest-t1 (class-c)) |
| 560 | ;; Slot initialization | 562 | ;; Slot initialization |
| 561 | (should (eq (oref eitest-t1 slot-1) 'moose)) | 563 | (should (eq (oref eitest-t1 slot-1) 'moose)) |
| 562 | (should (eq (oref eitest-t1 :moose) 'moose)) | 564 | (should (eq (oref eitest-t1 :moose) 'moose)) |
| @@ -565,9 +567,9 @@ METHOD is the method that was attempting to be called." | |||
| 565 | ;; Check private slot accessor | 567 | ;; Check private slot accessor |
| 566 | (should (string= (get-slot-2 eitest-t1) "penguin")) | 568 | (should (string= (get-slot-2 eitest-t1) "penguin")) |
| 567 | ;; Pass string instead of symbol | 569 | ;; Pass string instead of symbol |
| 568 | (should-error (class-c "C2" :moose "not a symbol") :type 'invalid-slot-type) | 570 | (should-error (class-c :moose "not a symbol") :type 'invalid-slot-type) |
| 569 | (should (eq (get-slot-3 eitest-t1) 'emu)) | 571 | (should (eq (get-slot-3 eitest-t1) 'emu)) |
| 570 | (should (eq (get-slot-3 class-c) 'emu)) | 572 | (should (eq (get-slot-3 'class-c) 'emu)) |
| 571 | ;; Check setf | 573 | ;; Check setf |
| 572 | (setf (get-slot-3 eitest-t1) 'setf-emu) | 574 | (setf (get-slot-3 eitest-t1) 'setf-emu) |
| 573 | (should (eq (get-slot-3 eitest-t1) 'setf-emu)) | 575 | (should (eq (get-slot-3 eitest-t1) 'setf-emu)) |
| @@ -577,13 +579,13 @@ METHOD is the method that was attempting to be called." | |||
| 577 | (defvar eitest-t2 nil) | 579 | (defvar eitest-t2 nil) |
| 578 | (ert-deftest eieio-test-26-default-inheritance () | 580 | (ert-deftest eieio-test-26-default-inheritance () |
| 579 | ;; See previous test, nor for subclass | 581 | ;; See previous test, nor for subclass |
| 580 | (setq eitest-t2 (class-subc "subc")) | 582 | (setq eitest-t2 (class-subc)) |
| 581 | (should (eq (oref eitest-t2 slot-1) 'moose)) | 583 | (should (eq (oref eitest-t2 slot-1) 'moose)) |
| 582 | (should (eq (oref eitest-t2 :moose) 'moose)) | 584 | (should (eq (oref eitest-t2 :moose) 'moose)) |
| 583 | (should (string= (get-slot-2 eitest-t2) "linux")) | 585 | (should (string= (get-slot-2 eitest-t2) "linux")) |
| 584 | (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name) | 586 | (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name) |
| 585 | (should (string= (get-slot-2 eitest-t2) "linux")) | 587 | (should (string= (get-slot-2 eitest-t2) "linux")) |
| 586 | (should-error (class-subc "C2" :moose "not a symbol") :type 'invalid-slot-type)) | 588 | (should-error (class-subc :moose "not a symbol") :type 'invalid-slot-type)) |
| 587 | 589 | ||
| 588 | ;;(ert-deftest eieio-test-27-inherited-new-value () | 590 | ;;(ert-deftest eieio-test-27-inherited-new-value () |
| 589 | ;;; HACK ALERT: The new value of a class slot is inherited by the | 591 | ;;; HACK ALERT: The new value of a class slot is inherited by the |
| @@ -647,8 +649,8 @@ Do not override for `prot-2'." | |||
| 647 | (defvar eitest-p1 nil) | 649 | (defvar eitest-p1 nil) |
| 648 | (defvar eitest-p2 nil) | 650 | (defvar eitest-p2 nil) |
| 649 | (ert-deftest eieio-test-28-slot-protection () | 651 | (ert-deftest eieio-test-28-slot-protection () |
| 650 | (setq eitest-p1 (prot-1 "")) | 652 | (setq eitest-p1 (prot-1)) |
| 651 | (setq eitest-p2 (prot-2 "")) | 653 | (setq eitest-p2 (prot-2)) |
| 652 | ;; Access public slots | 654 | ;; Access public slots |
| 653 | (oref eitest-p1 slot-1) | 655 | (oref eitest-p1 slot-1) |
| 654 | (oref eitest-p2 slot-1) | 656 | (oref eitest-p2 slot-1) |
| @@ -743,7 +745,7 @@ Subclasses to override slot attributes.") | |||
| 743 | "This class should throw an error."))) | 745 | "This class should throw an error."))) |
| 744 | 746 | ||
| 745 | ;; Initform should override instance allocation | 747 | ;; Initform should override instance allocation |
| 746 | (let ((obj (slotattr-ok "moose"))) | 748 | (let ((obj (slotattr-ok))) |
| 747 | (should (eq (oref obj initform) 'no-init)))) | 749 | (should (eq (oref obj initform) 'no-init)))) |
| 748 | 750 | ||
| 749 | (defclass slotattr-class-base () | 751 | (defclass slotattr-class-base () |
| @@ -792,10 +794,10 @@ Subclasses to override slot attributes.") | |||
| 792 | ((type :type string) | 794 | ((type :type string) |
| 793 | ) | 795 | ) |
| 794 | "This class should throw an error."))) | 796 | "This class should throw an error."))) |
| 795 | (should (eq (oref-default slotattr-class-ok initform) 'no-init))) | 797 | (should (eq (oref-default 'slotattr-class-ok initform) 'no-init))) |
| 796 | 798 | ||
| 797 | (ert-deftest eieio-test-32-slot-attribute-override-2 () | 799 | (ert-deftest eieio-test-32-slot-attribute-override-2 () |
| 798 | (let* ((cv (class-v 'slotattr-ok)) | 800 | (let* ((cv (eieio--class-v 'slotattr-ok)) |
| 799 | (docs (eieio--class-public-doc cv)) | 801 | (docs (eieio--class-public-doc cv)) |
| 800 | (names (eieio--class-public-a cv)) | 802 | (names (eieio--class-public-a cv)) |
| 801 | (cust (eieio--class-public-custom cv)) | 803 | (cust (eieio--class-public-custom cv)) |
| @@ -826,7 +828,7 @@ Subclasses to override slot attributes.") | |||
| 826 | 828 | ||
| 827 | (ert-deftest eieio-test-32-test-clone-boring-objects () | 829 | (ert-deftest eieio-test-32-test-clone-boring-objects () |
| 828 | ;; A simple make instance with EIEIO extension | 830 | ;; A simple make instance with EIEIO extension |
| 829 | (should (setq eitest-CLONETEST1 (make-instance 'class-a "a"))) | 831 | (should (setq eitest-CLONETEST1 (make-instance 'class-a))) |
| 830 | (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1))) | 832 | (should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1))) |
| 831 | 833 | ||
| 832 | ;; CLOS form of make-instance | 834 | ;; CLOS form of make-instance |
| @@ -840,7 +842,7 @@ Subclasses to override slot attributes.") | |||
| 840 | 842 | ||
| 841 | (ert-deftest eieio-test-33-instance-tracker () | 843 | (ert-deftest eieio-test-33-instance-tracker () |
| 842 | (let (IT-list IT1) | 844 | (let (IT-list IT1) |
| 843 | (should (setq IT1 (IT "trackme"))) | 845 | (should (setq IT1 (IT))) |
| 844 | ;; The instance tracker must find this | 846 | ;; The instance tracker must find this |
| 845 | (should (eieio-instance-tracker-find 'die 'slot1 'IT-list)) | 847 | (should (eieio-instance-tracker-find 'die 'slot1 'IT-list)) |
| 846 | ;; Test deletion | 848 | ;; Test deletion |
| @@ -852,8 +854,8 @@ Subclasses to override slot attributes.") | |||
| 852 | "A Singleton test object.") | 854 | "A Singleton test object.") |
| 853 | 855 | ||
| 854 | (ert-deftest eieio-test-34-singletons () | 856 | (ert-deftest eieio-test-34-singletons () |
| 855 | (let ((obj1 (SINGLE "Moose")) | 857 | (let ((obj1 (SINGLE)) |
| 856 | (obj2 (SINGLE "Cow"))) | 858 | (obj2 (SINGLE))) |
| 857 | (should (eieio-object-p obj1)) | 859 | (should (eieio-object-p obj1)) |
| 858 | (should (eieio-object-p obj2)) | 860 | (should (eieio-object-p obj2)) |
| 859 | (should (eq obj1 obj2)) | 861 | (should (eq obj1 obj2)) |
| @@ -866,7 +868,7 @@ Subclasses to override slot attributes.") | |||
| 866 | 868 | ||
| 867 | (ert-deftest eieio-test-35-named-object () | 869 | (ert-deftest eieio-test-35-named-object () |
| 868 | (let (N) | 870 | (let (N) |
| 869 | (should (setq N (NAMED "Foo"))) | 871 | (should (setq N (NAMED :object-name "Foo"))) |
| 870 | (should (string= "Foo" (oref N object-name))) | 872 | (should (string= "Foo" (oref N object-name))) |
| 871 | (should-error (oref N missing-slot) :type 'invalid-slot-name) | 873 | (should-error (oref N missing-slot) :type 'invalid-slot-name) |
| 872 | (oset N object-name "NewName") | 874 | (oset N object-name "NewName") |
| @@ -882,8 +884,8 @@ Subclasses to override slot attributes.") | |||
| 882 | "Instantiable child") | 884 | "Instantiable child") |
| 883 | 885 | ||
| 884 | (ert-deftest eieio-test-36-build-class-alist () | 886 | (ert-deftest eieio-test-36-build-class-alist () |
| 885 | (should (= (length (eieio-build-class-alist opt-test1 nil)) 2)) | 887 | (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2)) |
| 886 | (should (= (length (eieio-build-class-alist opt-test1 t)) 1))) | 888 | (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1))) |
| 887 | 889 | ||
| 888 | (provide 'eieio-tests) | 890 | (provide 'eieio-tests) |
| 889 | 891 | ||