aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJoakim Verona2015-01-11 18:40:21 +0100
committerJoakim Verona2015-01-11 18:40:21 +0100
commitcc7cb20d6abc0f862e5513b24831bba0eaecaa5f (patch)
treeafc2fc05401504aa0c28699dc3bc155c5b0d7f58
parentd972b504f30ff4300ba368940751e8736dddf0b4 (diff)
parent9a57bda31569294ecaf8138a06e5edda9c0d87e3 (diff)
downloademacs-cc7cb20d6abc0f862e5513b24831bba0eaecaa5f.tar.gz
emacs-cc7cb20d6abc0f862e5513b24831bba0eaecaa5f.zip
merge master, fix conflicts
-rw-r--r--ChangeLog19
-rw-r--r--INSTALL7
-rw-r--r--admin/ChangeLog4
-rw-r--r--admin/authors.el1
-rw-r--r--configure.ac4
-rw-r--r--doc/lispref/display.texi27
-rw-r--r--etc/ChangeLog9
-rw-r--r--etc/NEWS24
-rw-r--r--etc/NEWS.243
-rw-r--r--lib-src/ChangeLog38
-rw-r--r--lib-src/make-docfile.c289
-rw-r--r--lib/stdio.in.h7
-rw-r--r--lisp/ChangeLog355
-rw-r--r--lisp/cedet/ChangeLog49
-rw-r--r--lisp/cedet/ede.el10
-rw-r--r--lisp/cedet/ede/base.el21
-rw-r--r--lisp/cedet/ede/custom.el4
-rw-r--r--lisp/cedet/ede/proj.el2
-rw-r--r--lisp/cedet/ede/project-am.el8
-rw-r--r--lisp/cedet/ede/speedbar.el8
-rw-r--r--lisp/cedet/semantic.el87
-rw-r--r--lisp/cedet/semantic/bovine/make.el5
-rw-r--r--lisp/cedet/semantic/complete.el4
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el2
-rw-r--r--lisp/cedet/semantic/db-el.el2
-rw-r--r--lisp/cedet/semantic/db-file.el3
-rw-r--r--lisp/cedet/semantic/db-find.el6
-rw-r--r--lisp/cedet/semantic/db-typecache.el2
-rw-r--r--lisp/cedet/semantic/db.el4
-rw-r--r--lisp/cedet/semantic/ede-grammar.el2
-rw-r--r--lisp/cedet/semantic/fw.el19
-rw-r--r--lisp/cedet/semantic/grammar.el9
-rw-r--r--lisp/cedet/semantic/scope.el4
-rw-r--r--lisp/cedet/srecode/compile.el8
-rw-r--r--lisp/cedet/srecode/fields.el2
-rw-r--r--lisp/cedet/srecode/insert.el10
-rw-r--r--lisp/cedet/srecode/map.el2
-rw-r--r--lisp/emacs-lisp/chart.el10
-rw-r--r--lisp/emacs-lisp/eieio-base.el123
-rw-r--r--lisp/emacs-lisp/eieio-core.el1797
-rw-r--r--lisp/emacs-lisp/eieio-custom.el50
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el14
-rw-r--r--lisp/emacs-lisp/eieio-generic.el904
-rw-r--r--lisp/emacs-lisp/eieio-opt.el175
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el10
-rw-r--r--lisp/emacs-lisp/eieio.el498
-rw-r--r--lisp/files.el32
-rw-r--r--lisp/gnus/ChangeLog14
-rw-r--r--lisp/gnus/gnus-group.el42
-rw-r--r--lisp/gnus/registry.el2
-rw-r--r--lisp/international/ccl.el49
-rw-r--r--lisp/minibuffer.el29
-rw-r--r--lisp/net/eww.el15
-rw-r--r--lisp/net/shr.el7
-rw-r--r--lisp/progmodes/js.el5
-rw-r--r--lisp/progmodes/xref.el3
-rw-r--r--lisp/shell.el9
-rw-r--r--lisp/simple.el12
-rw-r--r--lisp/subr.el1
-rw-r--r--lisp/vc/vc-hooks.el2
-rw-r--r--m4/stdio_h.m420
-rw-r--r--src/.gdbinit18
-rw-r--r--src/ChangeLog247
-rw-r--r--src/alloc.c147
-rw-r--r--src/bidi.c1
-rw-r--r--src/buffer.c41
-rw-r--r--src/buffer.h6
-rw-r--r--src/bytecode.c1
-rw-r--r--src/callint.c14
-rw-r--r--src/casefiddle.c2
-rw-r--r--src/casetab.c1
-rw-r--r--src/category.c2
-rw-r--r--src/ccl.c24
-rw-r--r--src/ccl.h2
-rw-r--r--src/character.c6
-rw-r--r--src/character.h1
-rw-r--r--src/charset.c20
-rw-r--r--src/charset.h3
-rw-r--r--src/chartab.c4
-rw-r--r--src/cmds.c13
-rw-r--r--src/coding.c51
-rw-r--r--src/coding.h19
-rw-r--r--src/composite.c4
-rw-r--r--src/composite.h1
-rw-r--r--src/conf_post.h4
-rw-r--r--src/data.c56
-rw-r--r--src/dbusbind.c39
-rw-r--r--src/decompress.c2
-rw-r--r--src/dired.c8
-rw-r--r--src/dispextern.h28
-rw-r--r--src/dispnew.c12
-rw-r--r--src/disptab.h3
-rw-r--r--src/doc.c2
-rw-r--r--src/dosfns.c2
-rw-r--r--src/editfns.c24
-rw-r--r--src/emacs.c9
-rw-r--r--src/eval.c38
-rw-r--r--src/fileio.c99
-rw-r--r--src/fns.c22
-rw-r--r--src/font.c70
-rw-r--r--src/font.h18
-rw-r--r--src/fontset.c5
-rw-r--r--src/fontset.h1
-rw-r--r--src/frame.c192
-rw-r--r--src/frame.h51
-rw-r--r--src/fringe.c4
-rw-r--r--src/ftfont.c9
-rw-r--r--src/ftxfont.c2
-rw-r--r--src/gfilenotify.c56
-rw-r--r--src/gnutls.c23
-rw-r--r--src/image.c109
-rw-r--r--src/inotify.c81
-rw-r--r--src/insdel.c6
-rw-r--r--src/intervals.h16
-rw-r--r--src/keyboard.c257
-rw-r--r--src/keyboard.h31
-rw-r--r--src/keymap.c19
-rw-r--r--src/keymap.h3
-rw-r--r--src/lisp.h434
-rw-r--r--src/lread.c101
-rw-r--r--src/macfont.m24
-rw-r--r--src/macros.c5
-rw-r--r--src/menu.h4
-rw-r--r--src/minibuf.c36
-rw-r--r--src/nsfns.m29
-rw-r--r--src/nsfont.m7
-rw-r--r--src/nsimage.m2
-rw-r--r--src/nsmenu.m6
-rw-r--r--src/nsselect.m2
-rw-r--r--src/nsterm.h1
-rw-r--r--src/nsterm.m17
-rw-r--r--src/print.c12
-rw-r--r--src/process.c32
-rw-r--r--src/process.h9
-rw-r--r--src/profiler.c1
-rw-r--r--src/search.c9
-rw-r--r--src/sound.c6
-rw-r--r--src/syntax.c8
-rw-r--r--src/term.c9
-rw-r--r--src/terminal.c4
-rw-r--r--src/textprop.c22
-rw-r--r--src/undo.c8
-rw-r--r--src/w32.c2
-rw-r--r--src/w32.h1
-rw-r--r--src/w32fns.c21
-rw-r--r--src/w32font.c47
-rw-r--r--src/w32inevt.c3
-rw-r--r--src/w32menu.c2
-rw-r--r--src/w32notify.c10
-rw-r--r--src/w32proc.c2
-rw-r--r--src/w32select.c8
-rw-r--r--src/w32term.c9
-rw-r--r--src/w32uniscribe.c4
-rw-r--r--src/window.c27
-rw-r--r--src/window.h1
-rw-r--r--src/xdisp.c274
-rw-r--r--src/xfaces.c111
-rw-r--r--src/xfns.c10
-rw-r--r--src/xftfont.c3
-rw-r--r--src/xmenu.c3
-rw-r--r--src/xml.c2
-rw-r--r--src/xselect.c16
-rw-r--r--src/xsettings.c2
-rw-r--r--src/xterm.c8
-rw-r--r--src/xterm.h3
-rw-r--r--test/ChangeLog71
-rw-r--r--test/automated/eieio-test-methodinvoke.el58
-rw-r--r--test/automated/eieio-test-persist.el17
-rw-r--r--test/automated/eieio-tests.el124
169 files changed, 4079 insertions, 4360 deletions
diff --git a/ChangeLog b/ChangeLog
index 36edfe638d4..cca9100ddf7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,22 @@
12015-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
142015-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
12015-01-04 Paul Eggert <eggert@cs.ucla.edu> 202015-01-04 Paul Eggert <eggert@cs.ucla.edu>
2 21
3 * INSTALL: Mention 'make WERROR_CFLAGS='. 22 * INSTALL: Mention 'make WERROR_CFLAGS='.
diff --git a/INSTALL b/INSTALL
index 1ed26985477..55320207fa3 100644
--- a/INSTALL
+++ b/INSTALL
@@ -316,10 +316,9 @@ generated warnings may still be useful, though you may prefer building
316with 'make WERROR_CFLAGS=' so that the warnings are not treated as 316with 'make WERROR_CFLAGS=' so that the warnings are not treated as
317errors. 317errors.
318 318
319Use --enable-silent-rules to cause 'make' to chatter less. This is 319Use --disable-silent-rules to cause 'make' to give more details about
320helpful when combined with options like --enable-gcc-warnings that 320the commands it executes. This can be helpful when debugging a build
321generate long shell-command lines. 'make V=0' also suppresses the 321that goes awry. 'make V=1' also enables the extra chatter.
322chatter.
323 322
324Use --enable-link-time-optimization to enable link-time optimizer. If 323Use --enable-link-time-optimization to enable link-time optimizer. If
325you're using GNU compiler, this feature is supported since version 4.5.0. 324you'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 @@
12015-01-08 Glenn Morris <rgm@gnu.org>
2
3 * authors.el (authors-aliases): Add an entry to ignore.
4
12015-01-04 Paul Eggert <eggert@cs.ucla.edu> 52015-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
1014fi) 1014fi)
1015 1015
1016dnl Prefer silent make output. For verbose output, use
1017dnl 'configure --disable-silent-rules' or 'make V=1' .
1018AM_SILENT_RULES([yes])
1016dnl Port to Automake 1.11. 1019dnl Port to Automake 1.11.
1017dnl This section can be removed once we assume Automake 1.14 or later. 1020dnl 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}
1021AC_SUBST([AM_V]) 1023AC_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
88This function tries immediately to redisplay. The optional argument 88This 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,
90instead of being preempted, even if input is pending and the variable 90instead 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
93function redisplays in any case, i.e., @var{force} does nothing.
94 91
95The function returns @code{t} if it actually tried to redisplay, and 92The 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
98newly arriving input. 95newly arriving input.
99@end defun 96@end defun
100 97
101@defvar redisplay-dont-pause
102If this variable is @code{nil}, arriving input events preempt
103redisplay; Emacs avoids starting a redisplay, and stops any redisplay
104that is in progress, until the input has been processed. In
105particular, @code{(redisplay)} returns @code{nil} without actually
106redisplaying, if there is pending input.
107
108The default value is @code{t}, which means that pending input does not
109preempt redisplay.
110@end defvar
111
112@defvar redisplay-preemption-period
113If @code{redisplay-dont-pause} is @code{nil}, this variable specifies
114how many seconds Emacs waits between checks for new input during
115redisplay; if input arrives during this interval, redisplay stops and
116the 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
119This variable has no effect when @code{redisplay-dont-pause} is
120non-@code{nil} (the default).
121@end defvar
122
123@defvar pre-redisplay-function 98@defvar pre-redisplay-function
124A function run just before redisplay. It is called with one argument, 99A function run just before redisplay. It is called with one argument,
125the set of windows to redisplay. 100the 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 @@
12015-01-11 Paul Eggert <eggert@cs.ucla.edu>
2
3 Default to 'configure --enable-silent-rules'
4 * NEWS: Document this.
5
62015-01-10 Daniel Colascione <dancol@dancol.org>
7
8 * NEWS: Fix typo
9
12015-01-04 Paul Eggert <eggert@cs.ucla.edu> 102015-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"
diff --git a/etc/NEWS b/etc/NEWS
index ac42a9ff6dc..b3267e1ce60 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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.
41Use './configure PKG_CONFIG=/full/name/of/pkg-config' if you need to. 41Use './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. 44and silent rules are now quieter. To get the old behavior where
45'make' chatters a lot, configure with '--disable-silent-rules' or
46build 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
142buffers to allow certain parts of the text to be writable. 144buffers 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
145to all the files and subdirectories of a directory, similarly to the C
146library function `ftw'.
147
148** A new function `directory-files-recursively' returns all matching 146** A new function `directory-files-recursively' returns all matching
149files (recursively) under a directory. 147files (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
192When you invoke `shell' interactively, the *shell* buffer will now 192When you invoke `shell' interactively, the *shell* buffer will now
193display in a new window. However, you can customize this behavior via 193display in a new window. However, you can customize this behavior via
194the new `shell-display-buffer-actions' variable. For example, to get 194the `display-buffer-alist' variable. For example, to get
195the old behavior -- *shell* buffer displays in current window -- use 195the 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
200Bury the buffer at the head of `ido-matches', analogous to how C-k 206Bury 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
611frame's text height. This means that the text height stands only for 617frame's text height. This means that the text height stands only for
612the height of the frame's root window plus that of the echo area (if 618the height of the frame's root window plus that of the echo area (if
613present). This was already the behavior for frames with external tool 619present). 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 @@
12015-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
132015-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
12015-01-04 Paul Eggert <eggert@cs.ucla.edu> 392015-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/>. */
63static int scan_file (char *filename); 64static int scan_file (char *filename);
64static int scan_lisp_file (const char *filename, const char *mode); 65static int scan_lisp_file (const char *filename, const char *mode);
65static int scan_c_file (char *filename, const char *mode); 66static int scan_c_file (char *filename, const char *mode);
67static int scan_c_stream (FILE *infile);
66static void start_globals (void); 68static void start_globals (void);
67static void write_globals (void); 69static 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
113static char *
114xstrdup (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
111static void * 124static 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. */
532enum global_type 550enum 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;
553struct global *globals; 576struct global *globals;
554 577
555static void 578static void
556add_global (enum global_type type, char *name, int value) 579add_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
593static void 629static void
594close_emacs_globals (void) 630close_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
600static void 642static void
601write_globals (void) 643write_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
692scan_c_file (char *filename, const char *mode) 789scan_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
820static int
821scan_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 @@
12015-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
62015-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
112015-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
212015-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
262015-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
322015-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
492015-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
652015-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
1082015-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
1732015-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
2012015-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
2352015-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
2442015-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
2842015-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
2902015-01-08 Glenn Morris <rgm@gnu.org>
291
292 * files.el (file-tree-walk): Remove; of unknown authorship. (Bug#19325)
293
2942015-01-07 K. Handa <handa@gnu.org>
295
296 * international/ccl.el (define-ccl-program): Improve the docstring.
297
2982015-01-06 Sam Steingold <sds@gnu.org>
299
300 * shell.el (shell-display-buffer-actions): Remove,
301 use `display-buffer-alist' instead.
302
3032015-01-05 Dmitry Gutov <dgutov@yandex.ru>
304
305 * progmodes/xref.el (xref--insert-xrefs): Add `help-echo' property
306 to the references.
307
3082015-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
12015-01-04 Dmitry Gutov <dgutov@yandex.ru> 3142015-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 @@
302015-01-04 Dmitry Gutov <dgutov@yandex.ru> 3422015-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
362015-01-03 Dmitry Gutov <dgutov@yandex.ru> 3472015-01-03 Dmitry Gutov <dgutov@yandex.ru>
@@ -144,11 +455,9 @@
1442014-12-29 Dmitry Gutov <dgutov@yandex.ru> 4552014-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 @@
2172014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> 5262014-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 @@
2662014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> 5732014-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
2742014-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
2812014-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
3442014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> 6442014-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
3482014-12-27 Michael Albinus <michael.albinus@gmx.de> 6482014-12-27 Michael Albinus <michael.albinus@gmx.de>
349 649
@@ -416,7 +716,6 @@
4162014-12-26 Fabián Ezequiel Gallina <fgallina@gnu.org> 7162014-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 @@
5392014-12-19 Alan Mackenzie <acm@muc.de> 8382014-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
5762014-12-18 Artur Malabarba <bruce.connor.am@gmail.com> 8752014-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
5812014-12-18 Sam Steingold <sds@gnu.org> 8792014-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
7122014-12-14 Alan Mackenzie <acm@muc.de> 10072014-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
7162014-12-14 Artur Malabarba <bruce.connor.am@gmail.com> 10112014-12-14 Artur Malabarba <bruce.connor.am@gmail.com>
717 1012
@@ -1857,7 +2152,7 @@
1857 2152
18582014-11-19 Artur Malabarba <bruce.connor.am@gmail.com> 21532014-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
18632014-11-18 Juri Linkov <juri@linkov.net> 21582014-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 @@
12015-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
12014-12-22 Stefan Monnier <monnier@iro.umontreal.ca> 502014-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.
73OBJ is the target object to customize." 73OBJ 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
297the PROJECT being read in is the root project." 297the 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.
180Uses default implementation, and also gets a list of filenames." 180Uses 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.
189Keeps STRINGS only in the history.") 189Keeps 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.
1877Use this to enable custom editing.") 1879Use 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'."
192If DIRECTORY is found to be defunct, it won't load the DB, and will 192If DIRECTORY is found to be defunct, it won't load the DB, and will
193warn instead." 193warn 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.
1114If optional argument BRUTISH is non-nil, then ignore include statements, 1114If optional argument BRUTISH is non-nil, then ignore include statements,
1115and search all tables in this project tree." 1115and 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.
182If there is no table, create one, and fill it in." 182If 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
378if a user presses any key during execution, this form macro 378if a user presses any key during execution, this form macro
379will exit with the value passed to `semantic-throw-on-input'. 379will exit with the value passed to `semantic-throw-on-input'.
380If FORMS completes, then the return value is the same as `progn'." 380If 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
391calling this one." 391calling 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.
1670EXPANDER is the name of the function that expands MACRO." 1672EXPANDER 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.")
87Useful if something goes wrong in SRecode, and the active template 87Useful if something goes wrong in SRecode, and the active template
88stack is broken." 88stack 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.
577Optional arguments: 577Optional arguments:
578Set the chart's max element display to MAX, and sort lists with 578Set the chart's max element display to MAX, and sort lists with
579SORT-PRED if desired." 579SORT-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.
46If a slot of this class is referenced, and is unbound, then the parent 46If 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.
68All slots are unbound, except those initialized with PARAMS." 68All 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."))
155A singleton is a class which will only ever have one instance." 140A 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.
160NAME and SLOTS initialize the new object. 145NAME and SLOTS initialize the new object.
161This constructor guarantees that no matter how many you request, 146This constructor guarantees that no matter how many you request,
@@ -270,7 +255,7 @@ malicious code.
270Note: This function recurses when a slot of :type of some object is 255Note: This function recurses when a slot of :type of some object is
271identified, and needing more object creation." 256identified, 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.
305Second, any text properties will be stripped from strings." 290Second, 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.
379If no class is referenced there, then return nil." 366If 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."
473Name storage already occurs in an object. This object provides get/set
474access 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)
480For variable `eieio-named', provide an imaginary `object-name' slot. 480 (symbol-name (eieio-object-class obj))))
481Argument OBJ is the named object. 481
482Argument SLOT-NAME is the slot that was attempted to be accessed. 482(defmethod eieio-object-set-name-string ((obj eieio-named) name)
483OPERATION is the type of access, such as `oref' or `oset'. 483 "Set the string which is OBJ's NAME."
484NEW-VALUE is the value that was being set into SLOT if OPERATION were 484 (eieio--check-type stringp name)
485a 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 489All 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.
40More specifically, it has no side-effects at all when the new function 41More specifically, it has no side-effects at all when the new function
41definition is the same (`eq') as the old one." 42definition 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.
83Currently 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.
162This will speed up instantiation time as only a `copy-sequence' will
163be needed, instead of looping over all the values and setting them
164from the default.")
165 (options "storage location of tagged class options.
166Stored 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.
211CLASS is a symbol." 233CLASS 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)
242Only 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.
248Only methods have the symbol `eieio-method-obarray' as a property (which
249contains a list of all bindings to that method type.)
250Methods 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.
264Only methods have the symbol `eieio-method-obarray' as a property (which
265contains a list of all bindings to that method type.)
266Methods 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.
284Return nil if that option doesn't exist." 262Return 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.
297Abstract classes cannot be instantiated." 276Abstract 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.
302Abstract classes cannot be instantiated." 281Abstract 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.
322It creates an autoload function for CNAME's constructor." 301It 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.
405SLOTS are the slots residing in that class definition, and options or 371SLOTS are the slots residing in that class definition, and OPTIONS
406documentation OPTIONS-AND-DOC is the toplevel documentation for this class. 372holds the class options.
407See `defclass' for more information." 373See `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.
812If SKIPNIL is non-nil, then if VALUE is nil return t instead." 619If 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.
822If A already exists in NEWC, then do nothing. If it doesn't exist, 629If 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.
1046Follow the rules of not overwriting early parents when applying to 853Follow the rules of not overwriting early parents when applying to
1047the new child class." 854the 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.
1133All methods should call the same EIEIO function for dispatch.
1134DOC-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.
1146All methods should call the same EIEIO function for dispatch.
1147DOC-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.
1164All methods should call the same EIEIO function for dispatch.
1165DOC-STRING is the documentation attached to METHOD.
1166CLASS is the class symbol needed for private method access.
1167IMPL 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.
1224It will leave the original generic function in place,
1225but 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.
1289Checks the :type specifier. 931Checks the :type specifier.
1290SLOT is the slot that is being checked, and is only used when throwing 932SLOT 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.
1302Checks the :type specifier. 945Checks the :type specifier.
1303SLOT is the slot that is being checked, and is only used when throwing 946SLOT is the slot that is being checked, and is only used when throwing
1304an error." 947an 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
1315slot. If the slot is ok, return VALUE. 959slot. If the slot is ok, return VALUE.
1316Argument FN is the function calling this verifier." 960Argument 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."
1349Fills in OBJ's SLOT with its default value." 996Fills 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."
1384Fills in OBJ's SLOT with VALUE." 1035Fills 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'.
1407Fills in the default value in CLASS' in SLOT with VALUE." 1059Fills 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.
1436This is for testing if the class currently in scope is the class that defines SLOT 1090This is for testing if the class currently in scope is the class that defines SLOT
1437so that we can protect private slots." 1091so 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.
1451The slot is a symbol which is installed in CLASS by the `defclass' 1104The slot is a symbol which is installed in CLASS by the `defclass'
1452call. OBJ can be nil, but if it is an object, and the slot in question 1105call. OBJ can be nil, but if it is an object, and the slot in question
@@ -1455,36 +1108,41 @@ scoped class.
1455If SLOT is the value created with :initarg instead, 1108If SLOT is the value created with :initarg instead,
1456reverse-lookup that name, and recurse with the associated slot value." 1109reverse-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.
1482The slot is a symbol which is installed in CLASS by the `defclass' 1140The slot is a symbol which is installed in CLASS by the `defclass'
1483call. If SLOT is the value created with :initarg instead, 1141call. If SLOT is the value created with :initarg instead,
1484reverse-lookup that name, and recurse with the associated slot value." 1142reverse-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."
1501If SET-ALL is non-nil, then when a default is nil, that value is 1159If SET-ALL is non-nil, then when a default is nil, that value is
1502reset. If SET-ALL is nil, the slots are only reset if the default is 1160reset. If SET-ALL is nil, the slots are only reset if the default is
1503not nil." 1161not 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.
1515If there is no translation, pass it in directly (so we can cheat if 1173If there is no translation, pass it in directly (so we can cheat if
1516need be... May remove that later...)" 1174need 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.
1524This 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.
1545If a consistent order does not exist, signal an error." 1195If 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.
1636The order, in which the parents are returned depends on the 1283The order, in which the parents are returned depends on the
1637method invocation orders of the involved classes." 1284method 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.
1660Keys 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'.
1663During executions, the list is first generated, then as each next method
1664is 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.
1670The hook function must accept one argument, the list of forms
1671about to be executed.")
1672
1673(defun eieio-generic-call (method args)
1674 "Call METHOD with ARGS.
1675ARGS provides the context on which implementation to use.
1676This 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.
1810ARGS provides the context on which implementation to use.
1811This should only be called from a generic function.
1812
1813This method is like `eieio-generic-call', but only
1814implementations in the :PRIMARY slot are queried. After many
1815years of use, it appears that over 90% of methods in use
1816have :PRIMARY implementations only. We can therefore optimize
1817for 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.
1885METHOD is the method name.
1886KEY represents either :before, or :after methods.
1887CLASS is the starting class to search from in the method tree.
1888If 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.
1937Do 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.
1954METHOD-NAME is the name created by a call to `defgeneric'.
1955METHOD are the forms for a given implementation.
1956KEY is an integer (see comment in eieio.el near this function) which
1957is associated with the :static :before :primary and :after tags.
1958It also indicates if CLASS is defined or not.
1959CLASS 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.
1997If CLASS is a superclass, return variable `eieio-default-superclass'.
1998If CLASS is variable `eieio-default-superclass' then return nil.
1999This is different from function `class-parent' as class parent returns
2000nil 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.
2026If CLASS is not a class then use `generic' instead. If class has
2027no form, but has a parent class, then trace to that parent class.
2028The first time a form is requested from a symbol, an optimized path
2029is 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.
141Optional argument IGNORE is an extraneous parameter." 141Optional 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.
326This method is called by the default widget-edit commands. 327This method is called by the default widget-edit commands.
327User made commands should also call this method when applying changes. 328User 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.
390Argument OBJ is the object being customized." 391Argument 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.
463Return the symbol for the group, or nil" 462Return 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.
56Only 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.
62Only methods have the symbol `eieio-method-hashtable' as a property (which
63contains a list of all bindings to that method type.)
64Methods 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.
78Only methods have the symbol `eieio-method-hashtable' as a property (which
79contains a list of all bindings to that method type.)
80Methods 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.
112All methods should call the same EIEIO function for dispatch.
113DOC-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.
119All methods should call the same EIEIO function for dispatch.
120DOC-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.
128Keys 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'.
131During executions, the list is first generated, then as each next method
132is 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.
136All methods should call the same EIEIO function for dispatch.
137CLASS is the class symbol needed for private method access.
138IMPL 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.
169It will leave the original generic function in place,
170but 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.
239The hook function must accept one argument, the list of forms
240about to be executed.")
241
242(defun eieio--generic-call (method args)
243 "Call METHOD with ARGS.
244ARGS provides the context on which implementation to use.
245This 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.
377ARGS provides the context on which implementation to use.
378This should only be called from a generic function.
379
380This method is like `eieio--generic-call', but only
381implementations in the :PRIMARY slot are queried. After many
382years of use, it appears that over 90% of methods in use
383have :PRIMARY implementations only. We can therefore optimize
384for 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.
447METHOD is the method name.
448KEY represents either :before, or :after methods.
449CLASS is the starting class to search from in the method tree.
450If 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.
499Do 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.
513METHOD-NAME is the name created by a call to `defgeneric'.
514METHOD are the forms for a given implementation.
515KEY is an integer (see comment in eieio.el near this function) which
516is associated with the :static :before :primary and :after tags.
517It also indicates if CLASS is defined or not.
518CLASS 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.
553If CLASS is a superclass, return variable `eieio-default-superclass'.
554If CLASS is variable `eieio-default-superclass' then return nil.
555This is different from function `class-parent' as class parent returns
556nil 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.
580If CLASS is not a class then use `generic' instead. If class has
581no form, but has a parent class, then trace to that parent class.
582The first time a form is requested from a symbol, an optimized path
583is 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.
632DOC-STRING is the base documentation for this class. A generic
633function has no body, as its purpose is to decide which method body
634is appropriate to use. Uses `defmethod' to create methods, and calls
635`defgeneric' for you. With this implementation the ARGS are
636currently ignored. You can use `defgeneric' to apply specialized
637top 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
645The optional second argument KEY is a specifier that
646modifies 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
651The next argument is the ARGLIST. The ARGLIST specifies the arguments
652to the method as with `defun'. The first argument can have a type
653specifier, such as:
654 ((VARNAME CLASS) ARG2 ...)
655where VARNAME is the name of the local variable for the method being
656created. The CLASS is a class symbol for a class made with `defclass'.
657A DOCSTRING comes after the ARGLIST, and is optional.
658All the rest of the args are the BODY of the method. A method will
659return the value of the last form in the BODY.
660
661Summary:
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.
699Returns a list of lambda expressions which is the `next-method'
700order."
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.
705The superclass method is specified in the current method list,
706and is called the next method.
707
708If REPLACEMENT-ARGS is non-nil, then use them instead of
709`eieio--generic-call-arglst'. The generic arg list are the
710arguments passed in at the top level.
711
712Use `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.
737OBJECT is the object which has no method implementation.
738ARGS are the arguments that were passed to METHOD.
739
740Implement this for a class to block this signal. The return
741value 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.
749OBJECT is othe object being called on `call-next-method'.
750ARGS are the arguments it is called by.
751This method signals `no-next-method' by default. Override this
752method to not throw an error, and its return value becomes the
753return 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.
60Argument CH-PREFIX is another character prefix to display." 60Argument 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.
151Outputs to the current buffer." 151Outputs 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.
231If INSTANTIABLE-ONLY is non nil, only allow names of classes which 230If INSTANTIABLE-ONLY is non nil, only allow names of classes which
232are not abstract, otherwise allow all classes. 231are not abstract, otherwise allow all classes.
233Optional argument BUILDLIST is more list to attach and is used internally." 232Optional 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.
379Optional CLASS argument returns only those functions that contain 316Optional CLASS argument returns only those functions that contain
380methods for CLASS." 317methods 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.
398If there is not an explicit method for CLASS in GENERIC, or if that 334If there is not an explicit method for CLASS in GENERIC, or if that
399function has no documentation, then return nil." 335function 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'.
432This is because `generic-p' is a macro.
433Argument 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.
438Optional argument HISTORYVAR is the variable to use as history." 365Optional 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.
632DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the 559DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the
633current expansion depth." 560current 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.
681INDENT is the current indentation level." 608INDENT 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.
345The object is at indentation level INDENT." 345The 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.
417If the return value is a list of OBJECTs, then those objects are 417If the return value is a list of OBJECTs, then those objects are
418queried for details. If the return list is made of strings, 418queried 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.
62OPTIONS-AND-DOC is used as the class' options and base documentation. 63OPTIONS-AND-DOC is used as the class' options and base documentation.
63SUPERCLASS is a list of superclasses to inherit from, with SLOTS 64SUPERCLASSES is a list of superclasses to inherit from, with SLOTS
64being the slots residing in that class definition. NOTE: Currently 65being the slots residing in that class definition. Supported tags are:
65only one slot may exist in SUPERCLASS as multiple inheritance is not
66yet 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:
114Due to the way class options are set up, you can add any tags you wish, 113Due to the way class options are set up, you can add any tags you wish,
115and reference them using the function `class-option'." 114and 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
145class is used as the name slot instead when INITARGS doesn't start with 310class is used as the name slot instead when INITARGS doesn't start with
146a string." 311a 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.
159DOC-STRING is the base documentation for this class. A generic
160function has no body, as its purpose is to decide which method body
161is appropriate to use. Uses `defmethod' to create methods, and calls
162`defgeneric' for you. With this implementation the ARGS are
163currently ignored. You can use `defgeneric' to apply specialized
164top 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
172The optional second argument KEY is a specifier that
173modifies 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
178The next argument is the ARGLIST. The ARGLIST specifies the arguments
179to the method as with `defun'. The first argument can have a type
180specifier, such as:
181 ((VARNAME CLASS) ARG2 ...)
182where VARNAME is the name of the local variable for the method being
183created. The CLASS is a class symbol for a class made with `defclass'.
184A DOCSTRING comes after the ARGLIST, and is optional.
185All the rest of the args are the BODY of the method. A method will
186return the value of the last form in the BODY.
187
188Summary:
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.
214Slot is the name of the slot when created by `defclass' or the label 319Slot is the name of the slot when created by `defclass' or the label
215created by the :initarg tag." 320created 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."
223The default value is the value installed in a class with the :initform 329The default value is the value installed in a class with the :initform
224tag. SLOT can be the slot name, or the tag specified by the :initarg 330tag. SLOT can be the slot name, or the tag specified by the :initarg
225tag in the `defclass' call." 331tag 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:
246Where each VAR is the local variable given to the associated 353Where each VAR is the local variable given to the associated
247SLOT. A slot specified without a variable name is given a 354SLOT. A slot specified without a variable name is given a
248variable name of the same name as the slot." 355variable 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.
268If EXTRA, include that in the string returned to represent the symbol." 375If 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
305The CLOS function `class-direct-superclasses' is aliased to this function." 422The 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.
312The CLOS function `class-direct-subclasses' is aliased to this function." 430The 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.
372SLOT is the slot name as specified in `defclass' or the tag created 496SLOT is the slot name as specified in `defclass' or the tag created
373with in the :initarg slot. VALUE can be any Lisp object." 497with 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."
378The default value is usually set with the :initform tag during class 503The default value is usually set with the :initform tag during class
379creation. This allows users to change the default behavior of classes 504creation. This allows users to change the default behavior of classes
380after they are created." 505after 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.
504Returns a list of lambda expressions which is the `next-method'
505order."
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.
510The superclass method is specified in the current method list,
511and is called the next method.
512
513If REPLACEMENT-ARGS is non-nil, then use them instead of
514`eieio-generic-call-arglst'. The generic arg list are the
515arguments passed in at the top level.
516
517Use `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.
556This class is not stored in the `parent' slot of a class vector." 642This 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'.
567NEWNAME is the name to be given to the constructed object.
568SLOTS are the initialization slots used by `shared-initialize'. 657SLOTS are the initialization slots used by `shared-initialize'.
569This static method is called when an object is constructed. 658This static method is called when an object is constructed.
570It allocates the vector used to represent an EIEIO object, and then 659It allocates the vector used to represent an EIEIO object, and then
571calls `shared-initialize' on that object." 660calls `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.
587Called from the constructor routine." 674Called 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
609dynamically set from SLOTS." 696dynamically 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.
671OBJECT is the object which has no method implementation.
672ARGS are the arguments that were passed to METHOD.
673
674Implement this for a class to block this signal. The return
675value 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.
685OBJECT is othe object being called on `call-next-method'.
686ARGS are the arguments it is called by.
687This method signals `no-next-method' by default. Override this
688method to not throw an error, and its return value becomes the
689return 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.
695PARAMS is a parameter list of the same form used by `initialize-instance'. 754PARAMS 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'."
859Used as advice around `edebug-prin1-to-string', held in the 910Used as advice around `edebug-prin1-to-string', held in the
860variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to 911variable 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" "\
931Describe 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.
734For each file, the function calls ACTION as follows:
735
736 \(ACTION DIRECTORY BASENAME ARGS\)
737
738Where 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
742The ACTION is applied to each subdirectory before descending into
743it, and if nil is returned at that point, the descent will be
744prevented. 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 @@
12015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * registry.el: Don't use <class> as a variable.
4
12014-12-29 Paul Eggert <eggert@cs.ucla.edu> 52014-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
172014-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
132014-12-18 Paul Eggert <eggert@cs.ucla.edu> 232014-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
682014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> 782014-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
742014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org> 842014-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)
1355BRANCH := (branch EXPRESSION CCL_BLOCK_0 [CCL_BLOCK_1 ...]) 1355BRANCH := (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.
1358LOOP := (loop STATEMENT [STATEMENT ...]) 1366LOOP := (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
1503TRANSLATE := 1511TRANSLATE :=
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
1507LOOKUP := 1526LOOKUP :=
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
1511MAP := 1542MAP :=
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
1515MAP-IDs := MAP-ID ... 1548MAP-IDs := MAP-ID ...
1516MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET 1549MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
1517MAP-ID := integer 1550MAP-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.
833Each entry has the shape (CATEGORY . ALIST) where ALIST is
834an 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.
837Categories are symbols such as `buffer' and `file', used when
838completing buffer and file names, respectively.")
839
840(defcustom completion-category-overrides nil
841 "List of category-specific user overrides for completion styles.
832Each override has the shape (CATEGORY . ALIST) where ALIST is 842Each override has the shape (CATEGORY . ALIST) where ALIST is
833an association list that can specify properties such as: 843an 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.
836Categories are symbols such as `buffer' and `file', used when 846Categories are symbols such as `buffer' and `file', used when
837completing buffer and file names, respectively." 847completing buffer and file names, respectively.
838 :version "24.1" 848This 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.
253Match group 1 is the name of the function.") 253Match 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.
321Thus, this does not include the shell's current directory.") 314Thus, 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
2dnl Copyright (C) 2007-2015 Free Software Foundation, Inc. 2dnl Copyright (C) 2007-2015 Free Software Foundation, Inc.
3dnl This file is free software; the Free Software Foundation 3dnl This file is free software; the Free Software Foundation
4dnl gives unlimited permission to copy and/or distribute it, 4dnl 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)
71end 71end
72 72
73# Access the name of a symbol
74define 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
81end
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
1074define xprintsym 1084define 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
1080end 1090end
@@ -1258,8 +1268,8 @@ tbreak init_sys_modes
1258commands 1268commands
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 @@
12015-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
82015-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
372015-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
582015-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
762015-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
1092015-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
1372015-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
1422015-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
1482015-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
1542015-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
12015-01-04 Paul Eggert <eggert@cs.ucla.edu> 2442015-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
3922014-12-27 Eli Zaretskii <eliz@gnu.org>
393
394 * window.c (Fwindow_body_width): Doc fix. (Bug#19395)
395
1492014-12-27 Stefan Monnier <monnier@iro.umontreal.ca> 3962014-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
266static Lisp_Object Qconses;
267static Lisp_Object Qsymbols;
268static Lisp_Object Qmiscs;
269static Lisp_Object Qstrings;
270static Lisp_Object Qvectors;
271static Lisp_Object Qfloats;
272static Lisp_Object Qintervals;
273static Lisp_Object Qbuffers;
274static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
275static Lisp_Object Qgc_cons_threshold;
276Lisp_Object Qautomatic_gc;
277Lisp_Object Qchar_table_extra_slots;
278
279/* Hook run after GC has finished. */
280
281static Lisp_Object Qpost_gc_hook;
282
283static void mark_terminals (void); 266static void mark_terminals (void);
284static void gc_sweep (void); 267static void gc_sweep (void);
285static Lisp_Object make_pure_vector (ptrdiff_t); 268static 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
3396void
3397init_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
3413DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, 3413DEFUN ("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.
3415Its value is void, and its function definition and property list are nil. */) 3415Its 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
4916static bool
4917c_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. */
4930static int 4926static 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 */
6720static void 6733static void
6721sweep_symbols (void) 6734sweep_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
6993static bool
6994symbol_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)
7154void 7184void
7155init_alloc_once (void) 7185init_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
264static Lisp_Object paragraph_start_re, paragraph_separate_re; 264static Lisp_Object paragraph_start_re, paragraph_separate_re;
265static 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. */
119Lisp_Object Vbuffer_alist; 119Lisp_Object Vbuffer_alist;
120 120
121static Lisp_Object Qkill_buffer_query_functions;
122
123/* Hook run before changing a major mode. */
124static Lisp_Object Qchange_major_mode_hook;
125
126Lisp_Object Qfirst_change_hook;
127Lisp_Object Qbefore_change_functions;
128Lisp_Object Qafter_change_functions;
129
130static Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
131static Lisp_Object Qpermanent_local_hook;
132
133static Lisp_Object Qprotected_field;
134
135static Lisp_Object QSFundamental; /* A string "Fundamental". */ 121static Lisp_Object QSFundamental; /* A string "Fundamental". */
136 122
137static Lisp_Object Qkill_buffer_hook;
138static Lisp_Object Qbuffer_list_update_hook;
139
140static Lisp_Object Qget_file_buffer;
141
142static Lisp_Object Qoverlayp;
143
144Lisp_Object Qpriority, Qbefore_string, Qafter_string;
145
146static Lisp_Object Qevaporate;
147
148Lisp_Object Qmodification_hooks;
149Lisp_Object Qinsert_in_front_hooks;
150Lisp_Object Qinsert_behind_hooks;
151
152Lisp_Object Qchoice, Qrange, Qleft, Qright;
153Lisp_Object Qvertical_scroll_bar, Qhorizontal_scroll_bar;
154static Lisp_Object Qoverwrite_mode, Qfraction;
155
156static void alloc_buffer_text (struct buffer *, ptrdiff_t); 123static void alloc_buffer_text (struct buffer *, ptrdiff_t);
157static void free_buffer_text (struct buffer *b); 124static void free_buffer_text (struct buffer *b);
158static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *); 125static 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
2748the normal hook `change-major-mode-hook'. */) 2715the 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
1143extern Lisp_Object Vbuffer_alist; 1143extern Lisp_Object Vbuffer_alist;
1144extern Lisp_Object Qbefore_change_functions;
1145extern Lisp_Object Qafter_change_functions;
1146extern Lisp_Object Qfirst_change_hook;
1147extern Lisp_Object Qpriority, Qbefore_string, Qafter_string;
1148extern Lisp_Object Qchoice, Qrange, Qleft, Qright;
1149extern 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
72Lisp_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
31Lisp_Object Qminus, Qplus;
32static Lisp_Object Qfuncall_interactively;
33static Lisp_Object Qcommand_debug_status;
34static Lisp_Object Qenable_recursive_minibuffers;
35
36static Lisp_Object Qhandle_shift_selection;
37static Lisp_Object Qread_number;
38
39Lisp_Object Qmouse_leave_buffer_hook;
40
41static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qif;
42Lisp_Object Qwhen, Qprogn;
43static Lisp_Object preserved_fns; 31static 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
32enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; 32enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP};
33
34Lisp_Object Qidentity;
35 33
36static Lisp_Object 34static Lisp_Object
37casify_object (enum case_action flag, Lisp_Object obj) 35casify_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
27static Lisp_Object Qcase_table_p, Qcase_table;
28Lisp_Object Vascii_downcase_table; 27Lisp_Object Vascii_downcase_table;
29static Lisp_Object Vascii_upcase_table; 28static Lisp_Object Vascii_upcase_table;
30Lisp_Object Vascii_canon_table; 29Lisp_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. */
55static int category_table_version; 55static int category_table_version;
56
57static Lisp_Object Qcategory_table, Qcategoryp, Qcategorysetp, Qcategory_table_p;
58 56
59/* Category set staff. */ 57/* Category set staff. */
60 58
diff --git a/src/ccl.c b/src/ccl.c
index 109d6c0948c..053544c8274 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -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
37Lisp_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. */
41static Lisp_Object Qccl_program;
42
43/* These symbols are properties which associate with code conversion
44 map and their ID respectively. */
45static Lisp_Object Qcode_conversion_map;
46static 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. */
50static 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
diff --git a/src/ccl.h b/src/ccl.h
index b01a73f3a2d..7b72dc74104 100644
--- a/src/ccl.h
+++ b/src/ccl.h
@@ -81,8 +81,6 @@ extern bool setup_ccl_program (struct ccl_program *, Lisp_Object);
81extern void ccl_driver (struct ccl_program *, int *, int *, int, int, 81extern void ccl_driver (struct ccl_program *, int *, int *, int, int,
82 Lisp_Object); 82 Lisp_Object);
83 83
84extern 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
51Lisp_Object Qcharacterp;
52
53static 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. */
57Lisp_Object Vchar_unify_table; 53Lisp_Object Vchar_unify_table;
58 54
59static 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,
657extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t, 657extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t,
658 ptrdiff_t *, ptrdiff_t *); 658 ptrdiff_t *, ptrdiff_t *);
659 659
660extern Lisp_Object Qcharacterp;
661extern Lisp_Object Vchar_unify_table; 660extern Lisp_Object Vchar_unify_table;
662extern Lisp_Object string_escape_byte8 (Lisp_Object); 661extern 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;
66static ptrdiff_t charset_table_size; 66static ptrdiff_t charset_table_size;
67static int charset_table_used; 67static int charset_table_used;
68 68
69Lisp_Object Qcharsetp; 69/* Special charsets corresponding to symbols. */
70
71/* Special charset symbols. */
72Lisp_Object Qascii;
73static Lisp_Object Qeight_bit;
74static Lisp_Object Qiso_8859_1;
75static Lisp_Object Qunicode;
76static Lisp_Object Qemacs;
77
78/* The corresponding charsets. */
79int charset_ascii; 70int charset_ascii;
80int charset_eight_bit; 71int charset_eight_bit;
81static int charset_iso_8859_1; 72static int charset_iso_8859_1;
@@ -88,9 +79,6 @@ int charset_jisx0208_1978;
88int charset_jisx0208; 79int charset_jisx0208;
89int charset_ksc5601; 80int charset_ksc5601;
90 81
91/* Value of charset attribute `charset-iso-plane'. */
92static Lisp_Object Qgl, Qgr;
93
94/* Charset of unibyte characters. */ 82/* Charset of unibyte characters. */
95int charset_unibyte; 83int 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
522extern Lisp_Object Qcharsetp;
523
524extern Lisp_Object Qascii;
525extern int charset_ascii, charset_eight_bit; 522extern int charset_ascii, charset_eight_bit;
526extern int charset_unicode; 523extern int charset_unicode;
527extern int charset_jisx0201_roman; 524extern 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. */
61static 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. */
64typedef Lisp_Object (*uniprop_decoder_t) (Lisp_Object, Lisp_Object); 61typedef Lisp_Object (*uniprop_decoder_t) (Lisp_Object, Lisp_Object);
65typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object); 62typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object);
@@ -1378,6 +1375,7 @@ CHAR-TABLE must be what returned by `unicode-property-table-internal'. */)
1378void 1375void
1379syms_of_chartab (void) 1376syms_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
34static Lisp_Object Qkill_forward_chars, Qkill_backward_chars;
35
36/* A possible value for a buffer's overwrite-mode variable. */
37static Lisp_Object Qoverwrite_mode_binary;
38
39static int internal_self_insert (int, EMACS_INT); 34static int internal_self_insert (int, EMACS_INT);
40 35
41DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, 36DEFUN ("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
325static Lisp_Object Qexpand_abbrev;
326static Lisp_Object Qpost_self_insert_hook;
327
328static int 320static int
329internal_self_insert (int c, EMACS_INT n) 321internal_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
304Lisp_Object Vcoding_system_hash_table; 304Lisp_Object Vcoding_system_hash_table;
305 305
306static Lisp_Object Qcoding_system, Qeol_type;
307static Lisp_Object Qcoding_aliases;
308Lisp_Object Qunix, Qdos;
309static Lisp_Object Qmac;
310Lisp_Object Qbuffer_file_coding_system;
311static Lisp_Object Qpost_read_conversion, Qpre_write_conversion;
312static Lisp_Object Qdefault_char;
313Lisp_Object Qno_conversion, Qundecided;
314Lisp_Object Qcharset, Qutf_8;
315static Lisp_Object Qiso_2022;
316static Lisp_Object Qutf_16, Qshift_jis, Qbig5;
317static Lisp_Object Qbig, Qlittle;
318static Lisp_Object Qcoding_system_history;
319static Lisp_Object Qvalid_codes;
320static Lisp_Object QCcategory, QCmnemonic, QCdefault_char;
321static Lisp_Object QCdecode_translation_table, QCencode_translation_table;
322static Lisp_Object QCpost_read_conversion, QCpre_write_conversion;
323static Lisp_Object QCascii_compatible_p;
324
325Lisp_Object Qcall_process, Qcall_process_region;
326Lisp_Object Qstart_process, Qopen_network_stream;
327static Lisp_Object Qtarget_idx;
328
329static 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. */
333static 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
343Lisp_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. */
347Lisp_Object Qemacs_mule, Qraw_text;
348Lisp_Object Qutf_8_emacs;
349
350#if defined (WINDOWSNT) || defined (CYGWIN)
351static 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
362Lisp_Object Qtranslation_table;
363Lisp_Object Qtranslation_table_id;
364static Lisp_Object Qtranslation_table_for_decode;
365static Lisp_Object Qtranslation_table_for_encode;
366
367/* Two special coding systems. */ 322/* Two special coding systems. */
368static Lisp_Object Vsjis_coding_system; 323static Lisp_Object Vsjis_coding_system;
369static Lisp_Object Vbig5_coding_system; 324static 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);
763extern Lisp_Object preferred_coding_system (void); 763extern Lisp_Object preferred_coding_system (void);
764 764
765 765
766extern Lisp_Object Qutf_8, Qutf_8_emacs;
767
768extern Lisp_Object Qcoding_category_index;
769extern Lisp_Object Qcoding_system_p;
770extern Lisp_Object Qraw_text, Qemacs_mule, Qno_conversion, Qundecided;
771extern Lisp_Object Qbuffer_file_coding_system;
772
773extern Lisp_Object Qunix, Qdos;
774
775extern Lisp_Object Qtranslation_table;
776extern Lisp_Object Qtranslation_table_id;
777
778#ifdef emacs 766#ifdef emacs
779extern Lisp_Object Qfile_coding_system;
780extern Lisp_Object Qcall_process, Qcall_process_region;
781extern Lisp_Object Qstart_process, Qopen_network_stream;
782extern Lisp_Object Qwrite_region;
783 767
784extern char *emacs_strerror (int); 768extern 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 */
793extern Lisp_Object Qcoding_system_error;
794
795extern char emacs_mule_bytes[256]; 776extern 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
137Lisp_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. */
153Lisp_Object composition_hash_table; 151Lisp_Object composition_hash_table;
154 152
155static Lisp_Object Qauto_composed;
156static 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
193extern Lisp_Object Qcomposition;
194extern Lisp_Object composition_hash_table; 193extern Lisp_Object composition_hash_table;
195extern ptrdiff_t get_composition_id (ptrdiff_t, ptrdiff_t, ptrdiff_t, 194extern 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
40Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
41static Lisp_Object Qsubr;
42Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
43Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range;
44static Lisp_Object Qwrong_length_argument;
45static Lisp_Object Qwrong_type_argument;
46Lisp_Object Qvoid_variable, Qvoid_function;
47static Lisp_Object Qcyclic_function_indirection;
48static Lisp_Object Qcyclic_variable_indirection;
49Lisp_Object Qcircular_list;
50static Lisp_Object Qsetting_constant;
51Lisp_Object Qinvalid_read_syntax;
52Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
53Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
54Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
55Lisp_Object Qtext_read_only;
56
57Lisp_Object Qintegerp, Qwholenump, Qsymbolp, Qlistp, Qconsp;
58static Lisp_Object Qnatnump;
59Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
60Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
61Lisp_Object Qbool_vector_p;
62Lisp_Object Qbuffer_or_string_p;
63static Lisp_Object Qkeywordp, Qboundp;
64Lisp_Object Qfboundp;
65Lisp_Object Qchar_table_p, Qvector_or_char_table_p;
66
67Lisp_Object Qcdr;
68static Lisp_Object Qad_advice_info, Qad_activate_internal;
69
70static Lisp_Object Qdomain_error, Qsingularity_error, Qunderflow_error;
71Lisp_Object Qrange_error, Qoverflow_error;
72
73Lisp_Object Qfloatp;
74Lisp_Object Qnumberp, Qnumber_or_marker_p;
75
76Lisp_Object Qinteger, Qsymbol;
77static Lisp_Object Qcons, Qfloat, Qmisc, Qstring, Qvector;
78Lisp_Object Qwindow;
79static Lisp_Object Qoverlay, Qwindow_configuration;
80static Lisp_Object Qprocess, Qmarker;
81static Lisp_Object Qcompiled_function, Qframe;
82Lisp_Object Qbuffer;
83static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
84static Lisp_Object Qsubrp;
85static Lisp_Object Qmany, Qunevalled;
86Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
87static Lisp_Object Qdefun;
88
89Lisp_Object Qinteractive_form;
90static Lisp_Object Qdefalias_fset_function;
91
92static void swap_in_symval_forwarding (struct Lisp_Symbol *, 40static 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. */
45static Lisp_Object Qdbus__init_bus;
46static Lisp_Object Qdbus_get_unique_name;
47static Lisp_Object Qdbus_message_internal;
48
49/* D-Bus error symbol. */
50static Lisp_Object Qdbus_error;
51
52/* Lisp symbols of the system and session buses. */
53static Lisp_Object QCdbus_system_bus, QCdbus_session_bus;
54
55/* Lisp symbol for method call timeout. */
56static Lisp_Object QCdbus_timeout;
57
58/* Lisp symbols of D-Bus types. */
59static Lisp_Object QCdbus_type_byte, QCdbus_type_boolean;
60static Lisp_Object QCdbus_type_int16, QCdbus_type_uint16;
61static Lisp_Object QCdbus_type_int32, QCdbus_type_uint32;
62static Lisp_Object QCdbus_type_int64, QCdbus_type_uint64;
63static Lisp_Object QCdbus_type_double, QCdbus_type_string;
64static Lisp_Object QCdbus_type_object_path, QCdbus_type_signature;
65#ifdef DBUS_TYPE_UNIX_FD
66static Lisp_Object QCdbus_type_unix_fd;
67#endif
68static Lisp_Object QCdbus_type_array, QCdbus_type_variant;
69static Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry;
70
71/* Lisp symbols of objects in `dbus-registered-objects-table'. */
72static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method;
73static 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
31static 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
54static Lisp_Object Qdirectory_files;
55static Lisp_Object Qdirectory_files_and_attributes;
56static Lisp_Object Qfile_name_completion;
57static Lisp_Object Qfile_name_all_completions;
58static Lisp_Object Qfile_attributes;
59static Lisp_Object Qfile_attributes_lessp;
60
61static ptrdiff_t scmp (const char *, const char *, ptrdiff_t); 54static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
62static Lisp_Object file_attributes (int, char const *, Lisp_Object); 55static 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
452static int file_name_completion_stat (int, struct dirent *, struct stat *); 445static int file_name_completion_stat (int, struct dirent *, struct stat *);
453static Lisp_Object Qdefault_directory;
454 446
455static Lisp_Object 447static Lisp_Object
456file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, 448file_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
2935struct image_type 2934struct 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);
3250bool in_display_vector_p (struct it *); 3249bool in_display_vector_p (struct it *);
3251int frame_mode_line_height (struct frame *); 3250int frame_mode_line_height (struct frame *);
3252extern Lisp_Object Qtool_bar;
3253extern bool redisplaying_p; 3251extern bool redisplaying_p;
3254extern bool help_echo_showing_p; 3252extern bool help_echo_showing_p;
3255extern Lisp_Object help_echo_string, help_echo_window; 3253extern Lisp_Object help_echo_string, help_echo_window;
@@ -3429,7 +3427,6 @@ int face_at_string_position (struct window *w, Lisp_Object string,
3429int merge_faces (struct frame *, Lisp_Object, int, int); 3427int merge_faces (struct frame *, Lisp_Object, int, int);
3430int compute_char_face (struct frame *, int, Lisp_Object); 3428int compute_char_face (struct frame *, int, Lisp_Object);
3431void free_all_realized_faces (Lisp_Object); 3429void free_all_realized_faces (Lisp_Object);
3432extern Lisp_Object Qforeground_color, Qbackground_color;
3433extern char unspecified_fg[], unspecified_bg[]; 3430extern 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);
3519void change_frame_size (struct frame *, int, int, bool, bool, bool, bool); 3516void change_frame_size (struct frame *, int, int, bool, bool, bool, bool);
3520void init_display (void); 3517void init_display (void);
3521void syms_of_display (void); 3518void syms_of_display (void);
3522extern Lisp_Object Qredisplay_dont_pause;
3523extern void spec_glyph_lookup_face (struct window *, GLYPH *); 3519extern void spec_glyph_lookup_face (struct window *, GLYPH *);
3524extern void fill_up_frame_row_with_spaces (struct glyph_row *, int); 3520extern 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
107bool display_completed; 107bool display_completed;
108 108
109Lisp_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
113static bool delayed_size_change; 111static 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. */
49extern struct Lisp_Char_Table *buffer_display_table (void); 49extern struct Lisp_Char_Table *buffer_display_table (void);
50 50
51/* This is the `purpose' slot of a display table. */
52extern 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 \
diff --git a/src/doc.c b/src/doc.c
index 33594442152..a6ef84b4db6 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -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
38Lisp_Object Qfunction_documentation;
39
40/* Buffer used for reading from documentation file. */ 38/* Buffer used for reading from documentation file. */
41static char *get_doc_string_buffer; 39static char *get_doc_string_buffer;
42static ptrdiff_t get_doc_string_buffer_size; 40static 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)
409Lisp_Object 409Lisp_Object
410msdos_stdcolor_name (int idx) 410msdos_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
79static Lisp_Object Qbuffer_access_fontify_functions;
80
81/* Symbol for the text property used to mark fields. */
82
83Lisp_Object Qfield;
84
85/* A special value for Qfield properties. */
86
87static 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. */
90static char const *initial_tz; 80static 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;
151extern void malloc_enable_thread (void); 151extern void malloc_enable_thread (void);
152#endif 152#endif
153 153
154Lisp_Object Qfile_name_handler_alist;
155
156Lisp_Object Qrisky_local_variable;
157
158Lisp_Object Qkill_emacs;
159static 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. */
163bool inhibit_window_system; 156bool 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;
38int gcpro_level; 38int gcpro_level;
39#endif 39#endif
40 40
41Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp;
42Lisp_Object Qinhibit_quit;
43Lisp_Object Qand_rest;
44static Lisp_Object Qand_optional;
45static Lisp_Object Qinhibit_debugger;
46static Lisp_Object Qdeclare;
47Lisp_Object Qinternal_interpreter_environment, Qclosure;
48
49static 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
55Lisp_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
62Lisp_Object Vautoload_queue; 46Lisp_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. */
51Lisp_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.
2363usage: (run-hooks &rest HOOKS) */) 2352usage: (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
2526void
2527run_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
2541void 2534void
@@ -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;
113static bool valid_timestamp_file_system; 113static bool valid_timestamp_file_system;
114static dev_t timestamp_file_system; 114static 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. */
121static Lisp_Object Qauto_save_coding;
122
123/* Property name of a file name handler,
124 which gives a list of operations it handles.. */
125static Lisp_Object Qoperations;
126
127/* Lisp functions for translating file formats. */
128static 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. */
132static Lisp_Object Qafter_insert_file_set_coding;
133
134static 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. */
137static Lisp_Object Vwrite_region_annotation_buffers; 118static Lisp_Object Vwrite_region_annotation_buffers;
138 119
139static Lisp_Object Qdelete_by_moving_to_trash;
140
141/* Lisp function for moving files to trash. */
142static Lisp_Object Qmove_file_to_trash;
143
144/* Lisp function for recursively copying directories. */
145static Lisp_Object Qcopy_directory;
146
147/* Lisp function for recursively deleting directories. */
148static Lisp_Object Qdelete_directory;
149
150static Lisp_Object Qsubstitute_env_in_file_name;
151static Lisp_Object Qget_buffer_window_list;
152
153Lisp_Object Qfile_error, Qfile_notify_error;
154static Lisp_Object Qfile_already_exists, Qfile_date_error;
155static Lisp_Object Qexcl;
156Lisp_Object Qfile_name_history;
157
158static Lisp_Object Qcar_less_than_car;
159
160static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, 120static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
161 Lisp_Object *, struct coding_system *); 121 Lisp_Object *, struct coding_system *);
162static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, 122static 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
294static Lisp_Object Qexpand_file_name;
295static Lisp_Object Qsubstitute_in_file_name;
296static Lisp_Object Qdirectory_file_name;
297static Lisp_Object Qfile_name_directory;
298static Lisp_Object Qfile_name_nondirectory;
299static Lisp_Object Qunhandled_file_name_directory;
300static Lisp_Object Qfile_name_as_directory;
301static Lisp_Object Qcopy_file;
302static Lisp_Object Qmake_directory_internal;
303static Lisp_Object Qmake_directory;
304static Lisp_Object Qdelete_directory_internal;
305Lisp_Object Qdelete_file;
306static Lisp_Object Qrename_file;
307static Lisp_Object Qadd_name_to_file;
308static Lisp_Object Qmake_symbolic_link;
309Lisp_Object Qfile_exists_p;
310static Lisp_Object Qfile_executable_p;
311static Lisp_Object Qfile_readable_p;
312static Lisp_Object Qfile_writable_p;
313static Lisp_Object Qfile_symlink_p;
314static Lisp_Object Qaccess_file;
315Lisp_Object Qfile_directory_p;
316static Lisp_Object Qfile_regular_p;
317static Lisp_Object Qfile_accessible_directory_p;
318static Lisp_Object Qfile_modes;
319static Lisp_Object Qset_file_modes;
320static Lisp_Object Qset_file_times;
321static Lisp_Object Qfile_selinux_context;
322static Lisp_Object Qset_file_selinux_context;
323static Lisp_Object Qfile_acl;
324static Lisp_Object Qset_file_acl;
325static Lisp_Object Qfile_newer_than_file_p;
326Lisp_Object Qinsert_file_contents;
327Lisp_Object Qwrite_region;
328static Lisp_Object Qverify_visited_file_modtime;
329static Lisp_Object Qset_visited_file_modtime;
330
331DEFUN ("find-file-name-handler", Ffind_file_name_handler, 254DEFUN ("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)
5866void 5789void
5867syms_of_fileio (void) 5790syms_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
5938behaves as if file names were encoded in `utf-8'. */); 5870behaves 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
6094This includes interactive calls to `delete-file' and 6031This 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
diff --git a/src/fns.c b/src/fns.c
index 9c9501a4989..7739663b775 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -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
44Lisp_Object Qstring_lessp;
45static Lisp_Object Qstring_collate_lessp, Qstring_collate_equalp;
46static Lisp_Object Qprovide, Qrequire;
47static Lisp_Object Qyes_or_no_p_history;
48Lisp_Object Qcursor_in_echo_area;
49static Lisp_Object Qwidget_type;
50static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper;
51
52static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;
53
54static void sort_vector_copy (Lisp_Object, ptrdiff_t, 44static void sort_vector_copy (Lisp_Object, ptrdiff_t,
55 Lisp_Object [restrict], Lisp_Object [restrict]); 45 Lisp_Object [restrict], Lisp_Object [restrict]);
56static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object); 46static 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
2791static Lisp_Object Qsubfeatures;
2792
2793DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 2, 0, 2781DEFUN ("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
2811static Lisp_Object Qfuncall;
2812
2813DEFUN ("provide", Fprovide, Sprovide, 1, 2, 0, 2799DEFUN ("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.
2815The optional argument SUBFEATURES should be a list of symbols listing 2801The 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
3597static struct Lisp_Hash_Table *weak_hash_tables; 3583static struct Lisp_Hash_Table *weak_hash_tables;
3598 3584
3599/* Various symbols. */
3600
3601static Lisp_Object Qhash_table_p;
3602static Lisp_Object Qkey, Qvalue, Qeql;
3603Lisp_Object Qeq, Qequal;
3604Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
3605static 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
44Lisp_Object Qopentype;
45
46/* Important character set strings. */
47Lisp_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'. */
52static 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. */
55static Lisp_Object font_style_table; 47static 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
113Lisp_Object QCfoundry;
114static Lisp_Object QCadstyle, QCregistry;
115/* Symbols representing keys of font extra info. */
116Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClang, QCscript, QCavgwidth;
117Lisp_Object QCantialias, QCfont_entity;
118static Lisp_Object QCfc_unknown_spec;
119/* Symbols representing values of font spacing property. */
120static Lisp_Object Qc, Qm, Qd;
121Lisp_Object Qp;
122/* Special ADSTYLE properties to avoid fonts used for Latin
123 characters; used in xfont.c and ftfont.c. */
124Lisp_Object Qja, Qko;
125
126static 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. */
663static const struct 640static 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
59extern 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
242extern Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClang, QCscript;
243extern Lisp_Object QCavgwidth, QCantialias, QCfont_entity;
244extern Lisp_Object Qp;
245
246
247/* Important character set symbols. */
248extern Lisp_Object Qascii_0;
249extern Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip;
250
251/* Special ADSTYLE properties to avoid fonts used for Latin characters. */
252extern 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;
791extern void syms_of_xfont (void); 779extern void syms_of_xfont (void);
792extern void syms_of_ftxfont (void); 780extern void syms_of_ftxfont (void);
793#ifdef HAVE_XFT 781#ifdef HAVE_XFT
794extern Lisp_Object Qxft;
795extern struct font_driver xftfont_driver; 782extern struct font_driver xftfont_driver;
796extern 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
799extern struct font_driver ftxfont_driver; 785extern struct font_driver ftxfont_driver;
786extern void syms_of_xftfont (void);
800#endif 787#endif
801#ifdef HAVE_BDFFONT 788#ifdef HAVE_BDFFONT
802extern void syms_of_bdffont (void); 789extern void syms_of_bdffont (void);
@@ -808,7 +795,6 @@ extern struct font_driver uniscribe_font_driver;
808extern void syms_of_w32font (void); 795extern void syms_of_w32font (void);
809#endif /* HAVE_NTGUI */ 796#endif /* HAVE_NTGUI */
810#ifdef HAVE_NS 797#ifdef HAVE_NS
811extern Lisp_Object Qfontsize;
812extern struct font_driver nsfont_driver; 798extern struct font_driver nsfont_driver;
813extern void syms_of_nsfont (void); 799extern void syms_of_nsfont (void);
814extern void syms_of_macfont (void); 800extern 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
821extern Lisp_Object QCfoundry;
822
823extern void font_add_log (const char *, Lisp_Object, Lisp_Object); 807extern void font_add_log (const char *, Lisp_Object, Lisp_Object);
824extern void font_deferred_log (const char *, Lisp_Object, Lisp_Object); 808extern 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
155static Lisp_Object Qfontset;
156static Lisp_Object Qfontset_info;
157static Lisp_Object Qprepend, Qappend;
158Lisp_Object Qlatin;
159
160/* Vector containing all fontsets. */ 155/* Vector containing all fontsets. */
161static Lisp_Object Vfontset_table; 156static 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);
36extern int fs_query_fontset (Lisp_Object, int); 36extern int fs_query_fontset (Lisp_Object, int);
37extern Lisp_Object list_fontsets (struct frame *, Lisp_Object, int); 37extern Lisp_Object list_fontsets (struct frame *, Lisp_Object, int);
38 38
39extern Lisp_Object Qlatin;
40extern Lisp_Object fontset_name (int); 39extern Lisp_Object fontset_name (int);
41extern Lisp_Object fontset_ascii (int); 40extern 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
59Lisp_Object Qns_parse_geometry;
60#endif
61
62Lisp_Object Qframep, Qframe_live_p;
63Lisp_Object Qicon, Qmodeline;
64Lisp_Object Qonly, Qnone;
65Lisp_Object Qx, Qw32, Qpc, Qns;
66Lisp_Object Qvisible;
67Lisp_Object Qdisplay_type;
68static Lisp_Object Qbackground_mode;
69Lisp_Object Qnoelisp;
70
71static Lisp_Object Qx_frame_parameter;
72Lisp_Object Qx_resource_name;
73Lisp_Object Qterminal;
74
75/* Frame parameters (set or reported). */
76
77Lisp_Object Qauto_raise, Qauto_lower;
78Lisp_Object Qborder_color, Qborder_width;
79Lisp_Object Qcursor_color, Qcursor_type;
80Lisp_Object Qheight, Qwidth;
81Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name;
82Lisp_Object Qtooltip;
83Lisp_Object Qinternal_border_width;
84Lisp_Object Qright_divider_width, Qbottom_divider_width;
85Lisp_Object Qmouse_color;
86Lisp_Object Qminibuffer;
87Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
88Lisp_Object Qscroll_bar_height, Qhorizontal_scroll_bars;
89Lisp_Object Qvisibility;
90Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
91Lisp_Object Qscreen_gamma;
92Lisp_Object Qline_spacing;
93static Lisp_Object Quser_position, Quser_size;
94Lisp_Object Qwait_for_wm;
95static Lisp_Object Qwindow_id;
96#ifdef HAVE_X_WINDOWS
97static Lisp_Object Qouter_window_id;
98#endif
99Lisp_Object Qparent_id;
100Lisp_Object Qtitle, Qname;
101static Lisp_Object Qexplicit_name;
102Lisp_Object Qunsplittable;
103Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
104Lisp_Object Qleft_fringe, Qright_fringe;
105Lisp_Object Qbuffer_predicate;
106static Lisp_Object Qbuffer_list, Qburied_buffer_list;
107Lisp_Object Qtty_color_mode;
108Lisp_Object Qtty, Qtty_type;
109
110Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
111Lisp_Object Qsticky;
112Lisp_Object Qfont_backend;
113Lisp_Object Qalpha;
114
115Lisp_Object Qface_set_after_frame_default;
116
117static Lisp_Object Qfocus_in_hook;
118static Lisp_Object Qfocus_out_hook;
119static Lisp_Object Qdelete_frame_functions;
120static Lisp_Object Qframe_windows_min_size;
121static Lisp_Object Qgeometry, Qworkarea, Qmm_size, Qframes, Qsource;
122
123Lisp_Object Qframe_position, Qframe_outer_size, Qframe_inner_size;
124Lisp_Object Qexternal_border_size, Qtitle_height;
125Lisp_Object Qmenu_bar_external, Qmenu_bar_size;
126Lisp_Object Qtool_bar_external, Qtool_bar_size;
127
128/* The currently selected frame. */ 58/* The currently selected frame. */
129 59
130Lisp_Object selected_frame; 60Lisp_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
2996struct frame_parm_table { 2926struct frame_parm_table {
2997 const char *name; 2927 const char *name;
2998 Lisp_Object *variable; 2928 int sym;
2999}; 2929};
3000 2930
3001static const struct frame_parm_table frame_parms[] = 2931static 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
1097extern Lisp_Object selected_frame; 1097extern Lisp_Object selected_frame;
1098extern Lisp_Object Qframep, Qframe_live_p;
1099extern Lisp_Object Qtty, Qtty_type;
1100extern Lisp_Object Qtty_color_mode;
1101extern Lisp_Object Qterminal;
1102extern Lisp_Object Qnoelisp;
1103 1098
1104extern struct frame *decode_window_system_frame (Lisp_Object); 1099extern struct frame *decode_window_system_frame (Lisp_Object);
1105extern struct frame *decode_live_frame (Lisp_Object); 1100extern 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
1347extern Lisp_Object Qauto_raise, Qauto_lower;
1348extern Lisp_Object Qborder_color, Qborder_width;
1349extern Lisp_Object Qbuffer_predicate;
1350extern Lisp_Object Qcursor_color, Qcursor_type;
1351extern Lisp_Object Qfont;
1352extern Lisp_Object Qicon, Qicon_name, Qicon_type, Qicon_left, Qicon_top;
1353extern Lisp_Object Qinternal_border_width;
1354extern Lisp_Object Qright_divider_width, Qbottom_divider_width;
1355extern Lisp_Object Qtooltip;
1356extern Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position;
1357extern Lisp_Object Qmouse_color;
1358extern Lisp_Object Qname, Qtitle;
1359extern Lisp_Object Qparent_id;
1360extern Lisp_Object Qunsplittable, Qvisibility;
1361extern Lisp_Object Qscroll_bar_width, Qvertical_scroll_bars;
1362extern Lisp_Object Qscroll_bar_height, Qhorizontal_scroll_bars;
1363extern Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
1364extern Lisp_Object Qscreen_gamma;
1365extern Lisp_Object Qline_spacing;
1366extern Lisp_Object Qwait_for_wm;
1367extern Lisp_Object Qfullscreen;
1368extern Lisp_Object Qfullwidth, Qfullheight, Qfullboth, Qmaximized;
1369extern Lisp_Object Qsticky;
1370extern Lisp_Object Qfont_backend;
1371extern Lisp_Object Qalpha;
1372
1373extern Lisp_Object Qleft_fringe, Qright_fringe;
1374extern Lisp_Object Qheight, Qwidth;
1375extern Lisp_Object Qminibuffer, Qmodeline;
1376extern Lisp_Object Qx, Qw32, Qpc, Qns;
1377extern Lisp_Object Qvisible;
1378extern Lisp_Object Qdisplay_type;
1379
1380extern Lisp_Object Qx_resource_name;
1381
1382extern Lisp_Object Qtop, Qbox, Qbottom;
1383extern Lisp_Object Qdisplay;
1384
1385extern Lisp_Object Qframe_position, Qframe_outer_size, Qframe_inner_size;
1386extern Lisp_Object Qexternal_border_size, Qtitle_height;
1387extern Lisp_Object Qmenu_bar_external, Qmenu_bar_size;
1388extern Lisp_Object Qtool_bar_external, Qtool_bar_size;
1389
1390extern 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 *);
1399extern void x_set_offset (struct frame *, int, int, int); 1349extern void x_set_offset (struct frame *, int, int, int);
1400extern void x_wm_set_size_hint (struct frame *f, long flags, bool user_position); 1350extern void x_wm_set_size_hint (struct frame *f, long flags, bool user_position);
1401extern Lisp_Object x_new_font (struct frame *, Lisp_Object, int); 1351extern Lisp_Object x_new_font (struct frame *, Lisp_Object, int);
1402extern Lisp_Object Qface_set_after_frame_default;
1403extern void x_set_frame_parameters (struct frame *, Lisp_Object); 1352extern void x_set_frame_parameters (struct frame *, Lisp_Object);
1404extern void x_set_fullscreen (struct frame *, Lisp_Object, Lisp_Object); 1353extern void x_set_fullscreen (struct frame *, Lisp_Object, Lisp_Object);
1405extern void x_set_line_spacing (struct frame *, Lisp_Object, Lisp_Object); 1354extern 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
68static Lisp_Object Qtruncation, Qcontinuation, Qoverlay_arrow;
69static Lisp_Object Qempty_line, Qtop_bottom;
70static Lisp_Object Qhollow_small;
71
72enum fringe_bitmap_align 68enum 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. */
42static Lisp_Object Qfreetype;
43
44/* Fontconfig's generic families and their aliases. */
45static 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. */
48static bool fc_initialized; 42static bool fc_initialized;
49 43
@@ -2667,7 +2661,10 @@ ftfont_filter_properties (Lisp_Object font, Lisp_Object alist)
2667void 2661void
2668syms_of_ftfont (void) 2662syms_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
38static Lisp_Object Qftx;
39
40struct font_driver ftxfont_driver; 38struct font_driver ftxfont_driver;
41 39
42struct ftxfont_frame_data 40struct 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. */
33static Lisp_Object Qgfile_add_watch;
34static Lisp_Object Qgfile_rm_watch;
35
36/* Filter objects. */
37static Lisp_Object Qwatch_mounts; /* G_FILE_MONITOR_WATCH_MOUNTS */
38static Lisp_Object Qsend_moved; /* G_FILE_MONITOR_SEND_MOVED */
39
40/* Event types. */
41static Lisp_Object Qchanged; /* G_FILE_MONITOR_EVENT_CHANGED */
42static Lisp_Object Qchanges_done_hint; /* G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT */
43static Lisp_Object Qdeleted; /* G_FILE_MONITOR_EVENT_DELETED */
44static Lisp_Object Qcreated; /* G_FILE_MONITOR_EVENT_CREATED */
45static Lisp_Object Qattribute_changed; /* G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED */
46static Lisp_Object Qpre_unmount; /* G_FILE_MONITOR_EVENT_PRE_UNMOUNT */
47static Lisp_Object Qunmounted; /* G_FILE_MONITOR_EVENT_UNMOUNTED */
48static Lisp_Object Qmoved; /* G_FILE_MONITOR_EVENT_MOVED */
49
50static Lisp_Object watch_list; 32static 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
164will be reported only in case of the 'moved' event. */) 146will 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,
221WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */) 202WATCH-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)
258void 236void
259syms_of_gfilenotify (void) 237syms_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
36static bool emacs_gnutls_handle_error (gnutls_session_t, int); 36static bool emacs_gnutls_handle_error (gnutls_session_t, int);
37 37
38static Lisp_Object Qgnutls_dll;
39static Lisp_Object Qgnutls_code;
40static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
41static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
42 Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
43static bool gnutls_global_initialized; 38static bool gnutls_global_initialized;
44 39
45/* The following are for the property list of `gnutls-boot'. */
46static Lisp_Object QCgnutls_bootprop_priority;
47static Lisp_Object QCgnutls_bootprop_trustfiles;
48static Lisp_Object QCgnutls_bootprop_keylist;
49static Lisp_Object QCgnutls_bootprop_crlfiles;
50static Lisp_Object QCgnutls_bootprop_callbacks;
51static Lisp_Object QCgnutls_bootprop_loglevel;
52static Lisp_Object QCgnutls_bootprop_hostname;
53static Lisp_Object QCgnutls_bootprop_min_prime_bits;
54static Lisp_Object QCgnutls_bootprop_verify_flags;
55static Lisp_Object QCgnutls_bootprop_verify_error;
56
57/* Callback keys for `gnutls-boot'. Unused currently. */
58static Lisp_Object QCgnutls_bootprop_callbacks_verify;
59
60static void gnutls_log_function (int, const char *); 40static void gnutls_log_function (int, const char *);
61static void gnutls_log_function2 (int, const char *, const char *); 41static 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. */
93Lisp_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
116static Lisp_Object Qpostscript;
117
118static void x_disable_image (struct frame *, struct image *); 107static void x_disable_image (struct frame *, struct image *);
119static void x_edge_detection (struct frame *, struct image *, Lisp_Object, 108static 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);
126static unsigned long *colors_in_color_table (int *n); 115static unsigned long *colors_in_color_table (int *n);
127#endif 116#endif
128 117
129static 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
538static struct image_type *image_types; 525static struct image_type *image_types;
539 526
540/* The symbol `xbm' which is used as the type symbol for XBM images. */
541
542static Lisp_Object Qxbm;
543
544/* Keywords. */
545
546Lisp_Object QCascent, QCmargin, QCrelief;
547Lisp_Object QCconversion;
548static Lisp_Object QCheuristic_mask;
549static Lisp_Object QCcolor_symbols;
550static Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask, QCgeometry;
551static Lisp_Object QCcrop, QCrotation;
552
553/* Other symbols. */
554
555static Lisp_Object Qcount, Qextension_data, Qdelay;
556static Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
557
558/* Forward function prototypes. */ 527/* Forward function prototypes. */
559 528
560static struct image_type *lookup_image_type (Lisp_Object); 529static struct image_type *lookup_image_type (Lisp_Object);
@@ -579,27 +548,29 @@ static struct image_type *
579define_image_type (struct image_type *type) 548define_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
2363static struct image_type xbm_type = 2334static 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
3126static 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
3172static struct image_type xpm_type = 3140static 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)
5059static bool pbm_image_p (Lisp_Object object); 5027static bool pbm_image_p (Lisp_Object object);
5060static bool pbm_load (struct frame *f, struct image *img); 5028static bool pbm_load (struct frame *f, struct image *img);
5061 5029
5062/* The symbol `pbm' identifying images of this type. */
5063
5064static 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
5068enum pbm_keyword_index 5032enum pbm_keyword_index
@@ -5103,7 +5067,7 @@ static const struct image_keyword pbm_format[PBM_LAST] =
5103 5067
5104static struct image_type pbm_type = 5068static 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)
5446static bool png_image_p (Lisp_Object object); 5410static bool png_image_p (Lisp_Object object);
5447static bool png_load (struct frame *f, struct image *img); 5411static bool png_load (struct frame *f, struct image *img);
5448 5412
5449/* The symbol `png' identifying images of this type. */
5450
5451static 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
5455enum png_keyword_index 5415enum png_keyword_index
@@ -5494,7 +5454,7 @@ static bool init_png_functions (void);
5494 5454
5495static struct image_type png_type = 5455static 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)
6102static bool jpeg_image_p (Lisp_Object object); 6062static bool jpeg_image_p (Lisp_Object object);
6103static bool jpeg_load (struct frame *f, struct image *img); 6063static bool jpeg_load (struct frame *f, struct image *img);
6104 6064
6105/* The symbol `jpeg' identifying images of this type. */
6106
6107static 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
6111enum jpeg_keyword_index 6067enum jpeg_keyword_index
@@ -6150,7 +6106,7 @@ static bool init_jpeg_functions (void);
6150 6106
6151static struct image_type jpeg_type = 6107static 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)
6704static bool tiff_image_p (Lisp_Object object); 6660static bool tiff_image_p (Lisp_Object object);
6705static bool tiff_load (struct frame *f, struct image *img); 6661static bool tiff_load (struct frame *f, struct image *img);
6706 6662
6707/* The symbol `tiff' identifying images of this type. */
6708
6709static 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
6713enum tiff_keyword_index 6665enum tiff_keyword_index
@@ -6754,7 +6706,7 @@ static bool init_tiff_functions (void);
6754 6706
6755static struct image_type tiff_type = 6707static 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);
7167static bool gif_load (struct frame *f, struct image *img); 7119static bool gif_load (struct frame *f, struct image *img);
7168static void gif_clear_image (struct frame *f, struct image *img); 7120static void gif_clear_image (struct frame *f, struct image *img);
7169 7121
7170/* The symbol `gif' identifying images of this type. */
7171
7172static 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
7176enum gif_keyword_index 7124enum gif_keyword_index
@@ -7217,7 +7165,7 @@ static bool init_gif_functions (void);
7217 7165
7218static struct image_type gif_type = 7166static 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
7844static Lisp_Object Qimagemagick;
7845
7846static bool imagemagick_image_p (Lisp_Object); 7792static bool imagemagick_image_p (Lisp_Object);
7847static bool imagemagick_load (struct frame *, struct image *); 7793static bool imagemagick_load (struct frame *, struct image *);
7848static void imagemagick_clear_image (struct frame *, struct image *); 7794static void imagemagick_clear_image (struct frame *, struct image *);
@@ -7906,7 +7852,7 @@ static bool init_imagemagick_functions (void);
7906 7852
7907static struct image_type imagemagick_type = 7853static 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);
8632static bool svg_load_image (struct frame *, struct image *, 8578static 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
8637static 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
8641enum svg_keyword_index 8583enum svg_keyword_index
@@ -8682,7 +8624,7 @@ static bool init_svg_functions (void);
8682 8624
8683static struct image_type svg_type = 8625static 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));
8737DEF_DLL_FN (void, g_object_unref, (gpointer)); 8679DEF_DLL_FN (void, g_object_unref, (gpointer));
8738DEF_DLL_FN (void, g_error_free, (GError *)); 8680DEF_DLL_FN (void, g_error_free, (GError *));
8739 8681
8740Lisp_Object Qgdk_pixbuf, Qglib, Qgobject;
8741
8742static bool 8682static bool
8743init_svg_functions (void) 8683init_svg_functions (void)
8744{ 8684{
@@ -9056,10 +8996,6 @@ static bool gs_image_p (Lisp_Object object);
9056static bool gs_load (struct frame *f, struct image *img); 8996static bool gs_load (struct frame *f, struct image *img);
9057static void gs_clear_image (struct frame *f, struct image *img); 8997static void gs_clear_image (struct frame *f, struct image *img);
9058 8998
9059/* Keyword symbols. */
9060
9061static 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
9065enum gs_keyword_index 9001enum gs_keyword_index
@@ -9104,7 +9040,7 @@ static const struct image_keyword gs_format[GS_LAST] =
9104 9040
9105static struct image_type gs_type = 9041static 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
9479non-numeric, there is no explicit limit on the size of images. */); 9415non-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
32static Lisp_Object Qaccess; /* IN_ACCESS */
33static Lisp_Object Qattrib; /* IN_ATTRIB */
34static Lisp_Object Qclose_write; /* IN_CLOSE_WRITE */
35static Lisp_Object Qclose_nowrite; /* IN_CLOSE_NOWRITE */
36static Lisp_Object Qcreate; /* IN_CREATE */
37static Lisp_Object Qdelete; /* IN_DELETE */
38static Lisp_Object Qdelete_self; /* IN_DELETE_SELF */
39static Lisp_Object Qmodify; /* IN_MODIFY */
40static Lisp_Object Qmove_self; /* IN_MOVE_SELF */
41static Lisp_Object Qmoved_from; /* IN_MOVED_FROM */
42static Lisp_Object Qmoved_to; /* IN_MOVED_TO */
43static Lisp_Object Qopen; /* IN_OPEN */
44
45static Lisp_Object Qall_events; /* IN_ALL_EVENTS */
46static Lisp_Object Qmove; /* IN_MOVE */
47static Lisp_Object Qclose; /* IN_CLOSE */
48
49static Lisp_Object Qdont_follow; /* IN_DONT_FOLLOW */
50static Lisp_Object Qexcl_unlink; /* IN_EXCL_UNLINK */
51static Lisp_Object Qmask_add; /* IN_MASK_ADD */
52static Lisp_Object Qoneshot; /* IN_ONESHOT */
53static Lisp_Object Qonlydir; /* IN_ONLYDIR */
54
55static Lisp_Object Qignored; /* IN_IGNORED */
56static Lisp_Object Qisdir; /* IN_ISDIR */
57static Lisp_Object Qq_overflow; /* IN_Q_OVERFLOW */
58static 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.
398void 370void
399syms_of_inotify (void) 371syms_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. */
53static Lisp_Object combine_after_change_buffer; 53static Lisp_Object combine_after_change_buffer;
54 54
55Lisp_Object Qinhibit_modification_hooks;
56
57static void signal_before_change (ptrdiff_t, ptrdiff_t, ptrdiff_t *); 55static 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
1784Lisp_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. */
272extern int invisible_p (Lisp_Object, Lisp_Object); 272extern int invisible_p (Lisp_Object, Lisp_Object);
273 273
274/* Declared in textprop.c. */ 274/* Defined in textprop.c. */
275
276/* Types of hooks. */
277extern Lisp_Object Qpoint_left;
278extern Lisp_Object Qpoint_entered;
279extern Lisp_Object Qmodification_hooks;
280extern Lisp_Object Qcategory;
281extern Lisp_Object Qlocal_map;
282
283/* Visual properties text (including strings) may have. */
284extern Lisp_Object Qinvisible, Qintangible;
285
286/* Sticky properties. */
287extern Lisp_Object Qfront_sticky, Qrear_nonsticky;
288
289extern Lisp_Object copy_text_properties (Lisp_Object, Lisp_Object, 275extern 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. */
89static bool single_kboard; 89static 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. */
93Lisp_Object Qdisabled;
94static 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. */
233Lisp_Object internal_last_event_frame; 228Lisp_Object internal_last_event_frame;
234 229
235static Lisp_Object Qgui_set_selection, Qhandle_switch_frame;
236static Lisp_Object Qhandle_select_window;
237Lisp_Object QPRIMARY;
238
239static Lisp_Object Qself_insert_command;
240static Lisp_Object Qforward_char;
241static Lisp_Object Qbackward_char;
242Lisp_Object Qundefined;
243static 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. */
247static Lisp_Object read_key_sequence_cmd; 232static Lisp_Object read_key_sequence_cmd;
248static Lisp_Object read_key_sequence_remapped; 233static Lisp_Object read_key_sequence_remapped;
249 234
250static Lisp_Object Qinput_method_function;
251
252static Lisp_Object Qdeactivate_mark;
253
254Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
255
256static Lisp_Object Qecho_area_clear_hook;
257
258/* Hooks to run before and after each command. */
259static Lisp_Object Qpre_command_hook;
260static Lisp_Object Qpost_command_hook;
261
262static Lisp_Object Qdeferred_action_function;
263
264static Lisp_Object Qdelayed_warnings_hook;
265
266static Lisp_Object Qinput_method_exit_on_first_char;
267static Lisp_Object Qinput_method_use_echo_area;
268
269static 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. */
272static FILE *dribble; 236static 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. */
350static Lisp_Object Qmouse_movement;
351static Lisp_Object Qscroll_bar_movement;
352Lisp_Object Qswitch_frame;
353static Lisp_Object Qfocus_in, Qfocus_out;
354static Lisp_Object Qdelete_frame;
355static Lisp_Object Qiconify_frame;
356static Lisp_Object Qmake_frame_visible;
357static Lisp_Object Qselect_window;
358Lisp_Object Qhelp_echo;
359
360static Lisp_Object Qmouse_fixup_help_message;
361
362/* Symbols to denote kinds of events. */
363static Lisp_Object Qfunction_key;
364Lisp_Object Qmouse_click;
365#ifdef HAVE_NTGUI
366Lisp_Object Qlanguage_change;
367#endif
368static Lisp_Object Qdrag_n_drop;
369static Lisp_Object Qsave_session;
370#ifdef HAVE_DBUS
371static Lisp_Object Qdbus_event;
372#endif
373#ifdef HAVE_XWIDGETS
374Lisp_Object Qxwidget_event;
375#endif
376#ifdef USE_FILE_NOTIFY
377static Lisp_Object Qfile_notify;
378#endif /* USE_FILE_NOTIFY */
379static Lisp_Object Qconfig_changed_event;
380
381/* Lisp_Object Qmouse_movement; - also an event header */
382
383/* Properties of event headers. */
384Lisp_Object Qevent_kind;
385static Lisp_Object Qevent_symbol_elements;
386
387/* Menu and tool bar item parts. */
388static Lisp_Object Qmenu_enable;
389static Lisp_Object QCenable, QCvisible, QChelp, QCkeys, QCkey_sequence;
390Lisp_Object QCfilter;
391
392/* Non-nil disable property on a command means
393 do not execute it; call disabled-command-function's value instead. */
394Lisp_Object QCtoggle, QCradio;
395static Lisp_Object QCbutton, QClabel;
396
397static 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. */
404Lisp_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. */
410static Lisp_Object Qmodifier_cache;
411
412/* Symbols to use for parts of windows. */
413Lisp_Object Qmode_line;
414Lisp_Object Qvertical_line;
415Lisp_Object Qright_divider, Qbottom_divider;
416Lisp_Object Qmenu_bar;
417
418static Lisp_Object Qecho_keystrokes;
419
420static void recursive_edit_unwind (Lisp_Object buffer); 313static void recursive_edit_unwind (Lisp_Object buffer);
421static Lisp_Object command_loop (void); 314static Lisp_Object command_loop (void);
422static Lisp_Object Qcommand_execute;
423 315
424static void echo_now (void); 316static void echo_now (void);
425static ptrdiff_t echo_length (void); 317static ptrdiff_t echo_length (void);
426 318
427static Lisp_Object Qpolling_period;
428
429/* Incremented whenever a timer is run. */ 319/* Incremented whenever a timer is run. */
430unsigned timers_run; 320unsigned 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
5299static Lisp_Object Qabove_handle, Qhandle, Qbelow_handle; 5182 scroll_bar_part value. Note that Qnil corresponds to
5300static Lisp_Object Qbefore_handle, Qhorizontal_handle, Qafter_handle; 5183 scroll_bar_nowhere and should not appear in Lisp events. */
5301Lisp_Object Qup, Qdown, Qtop, Qbottom; 5184static short const scroll_bar_parts[] = {
5302static Lisp_Object Qleftmost, Qrightmost; 5185 SYMBOL_INDEX (Qnil), SYMBOL_INDEX (Qabove_handle), SYMBOL_INDEX (Qhandle),
5303static Lisp_Object Qend_scroll; 5186 SYMBOL_INDEX (Qbelow_handle), SYMBOL_INDEX (Qup), SYMBOL_INDEX (Qdown),
5304static 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)
5309static 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
5583make_scroll_bar_position (struct input_event *ev, Lisp_Object type) 5461make_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
8096static int ntool_bar_items; 7975static int ntool_bar_items;
8097 7976
8098/* The symbols `:image' and `:rtl'. */
8099
8100static Lisp_Object QCimage;
8101static Lisp_Object QCrtl;
8102
8103/* Function prototypes. */ 7977/* Function prototypes. */
8104 7978
8105static void init_tool_bar_items (Lisp_Object); 7979static 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. */
11143struct event_head { 11012struct 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
11149static const struct event_head head_table[] = { 11018static 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
11163void 11035void
@@ -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
11624cancels any modification. */); 11535cancels 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.
11629The command loop sets this to nil before each command, 11541The command loop sets this to nil before each command,
11630and tests the value when the command returns. 11542and tests the value when the command returns.
11631Buffer modification stores t in this variable. */); 11543Buffer 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. */
249extern Lisp_Object internal_last_event_frame; 249extern Lisp_Object internal_last_event_frame;
250 250
251extern 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. */
391extern Lisp_Object Qswitch_frame;
392
393/* Properties on event heads. */
394extern Lisp_Object Qevent_kind;
395
396/* The values of Qevent_kind properties. */
397extern Lisp_Object Qmouse_click;
398
399extern 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. */
406extern Lisp_Object Qmode_line, Qvertical_line, Qheader_line;
407extern Lisp_Object Qright_divider, Qbottom_divider;
408
409/* True while doing kbd input. */ 392/* True while doing kbd input. */
410extern bool waiting_for_input; 393extern bool waiting_for_input;
411 394
@@ -415,9 +398,6 @@ extern struct timespec *input_available_clear_time;
415 398
416extern bool ignore_mouse_drag_p; 399extern bool ignore_mouse_drag_p;
417 400
418/* The primary selection. */
419extern Lisp_Object QPRIMARY;
420
421extern Lisp_Object parse_modifiers (Lisp_Object); 401extern Lisp_Object parse_modifiers (Lisp_Object);
422extern Lisp_Object reorder_modifiers (Lisp_Object); 402extern Lisp_Object reorder_modifiers (Lisp_Object);
423extern Lisp_Object read_char (int, Lisp_Object, Lisp_Object, 403extern 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. */
429extern Lisp_Object real_this_command; 409extern 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. */
433extern 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. */
440extern Lisp_Object Qevent_symbol_element_mask;
441
442extern int quit_char; 411extern int quit_char;
443 412
444extern unsigned int timers_run; 413extern 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. */
81static Lisp_Object Qkeymapp, Qnon_ascii;
82Lisp_Object Qkeymap, Qmenu_item, Qremap;
83static Lisp_Object QCadvertised_binding;
84
85/* Alist of elements like (DEL . "\d"). */ 79/* Alist of elements like (DEL . "\d"). */
86static Lisp_Object exclude_keys; 80static 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
657static 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. */
661void 653void
@@ -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}
2001static 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)))
33extern Lisp_Object Qkeymap, Qmenu_bar;
34extern Lisp_Object Qremap;
35extern Lisp_Object Qmenu_item;
36extern Lisp_Object current_global_map; 33extern Lisp_Object current_global_map;
37extern char *push_key_description (EMACS_INT, char *); 34extern char *push_key_description (EMACS_INT, char *);
38extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool); 35extern 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
239enum Lisp_Bits 239enum 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
448enum Lisp_Type 451enum 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
563typedef struct { EMACS_INT i; } Lisp_Object; 566typedef 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
568enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true }; 571enum 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
573typedef EMACS_INT Lisp_Object; 576typedef EMACS_INT Lisp_Object;
574#define LISP_INITIALLY_ZERO 0 577#define LISP_INITIALLY(i) (i)
575enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false }; 578enum 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);
604INLINE bool (VECTORLIKEP) (Lisp_Object); 609INLINE bool (VECTORLIKEP) (Lisp_Object);
605INLINE bool WINDOWP (Lisp_Object); 610INLINE bool WINDOWP (Lisp_Object);
606INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object); 611INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
612INLINE struct Lisp_Symbol *(XSYMBOL) (Lisp_Object);
613INLINE enum Lisp_Type (XTYPE) (Lisp_Object);
614INLINE void *(XUNTAG) (Lisp_Object, int);
607 615
608/* Defined in chartab.c. */ 616/* Defined in chartab.c. */
609extern Lisp_Object char_table_ref (Lisp_Object, int); 617extern Lisp_Object char_table_ref (Lisp_Object, int);
610extern void char_table_set (Lisp_Object, int, Lisp_Object); 618extern void char_table_set (Lisp_Object, int, Lisp_Object);
611 619
612/* Defined in data.c. */ 620/* Defined in data.c. */
613extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p;
614extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil;
615extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qt, Qvectorp;
616extern Lisp_Object Qbool_vector_p;
617extern Lisp_Object Qvector_or_char_table_p, Qwholenump;
618extern Lisp_Object Qwindow;
619extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); 621extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
620extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object); 622extern _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. */
626extern bool initialized; 628extern bool initialized;
627 629
628/* Defined in eval.c. */
629extern Lisp_Object Qautoload;
630
631/* Defined in floatfns.c. */ 630/* Defined in floatfns.c. */
632extern double extract_float (Lisp_Object); 631extern double extract_float (Lisp_Object);
633 632
634/* Defined in process.c. */ 633
635extern Lisp_Object Qprocessp; 634/* Interned state of a symbol. */
635
636enum 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. */ 643enum symbol_redirect
638extern Lisp_Object Qwindowp; 644{
645 SYMBOL_PLAINVAL = 4,
646 SYMBOL_VARALIAS = 1,
647 SYMBOL_LOCALIZED = 2,
648 SYMBOL_FORWARDED = 3
649};
650
651struct 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. */
641extern Lisp_Object Qimage;
642extern 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. */
646LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o)) 748LISP_MACRO_DEFUN (XLI, EMACS_INT, (Lisp_Object o), (o))
@@ -731,6 +833,7 @@ LISP_MACRO_DEFUN (XPNTR, void *, (Lisp_Object a), (a))
731LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n)) 833LISP_MACRO_DEFUN (make_number, Lisp_Object, (EMACS_INT n), (n))
732LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a)) 834LISP_MACRO_DEFUN (XINT, EMACS_INT, (Lisp_Object a), (a))
733LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a)) 835LISP_MACRO_DEFUN (XFASTINT, EMACS_INT, (Lisp_Object a), (a))
836LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a))
734LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a)) 837LISP_MACRO_DEFUN (XTYPE, enum Lisp_Type, (Lisp_Object a), (a))
735LISP_MACRO_DEFUN (XUNTAG, void *, (Lisp_Object a, int type), (a, type)) 838LISP_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. */
892INLINE struct Lisp_Symbol *
893XSYMBOL (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. */
789INLINE enum Lisp_Type 903INLINE enum Lisp_Type
790XTYPE (Lisp_Object a) 904XTYPE (Lisp_Object a)
@@ -797,12 +911,8 @@ XTYPE (Lisp_Object a)
797INLINE void * 911INLINE void *
798XUNTAG (Lisp_Object a, int type) 912XUNTAG (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
867LISP_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
869INLINE struct Lisp_Float * 981INLINE struct Lisp_Float *
870XFLOAT (Lisp_Object a) 982XFLOAT (Lisp_Object a)
@@ -935,14 +1047,26 @@ XBOOL_VECTOR (Lisp_Object a)
935INLINE Lisp_Object 1047INLINE Lisp_Object
936make_lisp_ptr (void *ptr, enum Lisp_Type type) 1048make_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
945INLINE Lisp_Object 1055INLINE Lisp_Object
1056make_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
1063INLINE Lisp_Object
1064builtin_lisp_symbol (int index)
1065{
1066 return make_lisp_symbol (lispsym + index);
1067}
1068
1069INLINE Lisp_Object
946make_lisp_proc (struct Lisp_Process *p) 1070make_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
1123INLINE void *
1124XINTPTR (Lisp_Object a)
1125{
1126 return XUNTAG (a, Lisp_Int0);
1127}
1128
1129INLINE Lisp_Object
1130make_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
996LISP_MACRO_DEFUN_VOID (CHECK_TYPE, 1139LISP_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
1565enum symbol_interned
1566{
1567 SYMBOL_UNINTERNED = 0,
1568 SYMBOL_INTERNED = 1,
1569 SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
1570};
1571
1572enum symbol_redirect
1573{
1574 SYMBOL_PLAINVAL = 4,
1575 SYMBOL_VARALIAS = 1,
1576 SYMBOL_LOCALIZED = 2,
1577 SYMBOL_FORWARDED = 3
1578};
1579
1580struct 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
1631LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym)) 1708LISP_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
1700LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym)) 1777LISP_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. */
2716INLINE bool 2776INLINE bool
2717FUNCTIONP (Lisp_Object obj) 2777FUNCTIONP (Lisp_Object obj)
@@ -3260,15 +3320,6 @@ extern int gcpro_level;
3260 3320
3261void staticpro (Lisp_Object *); 3321void 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. */
3273struct window; 3324struct window;
3274struct frame; 3325struct 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. */
3390extern Lisp_Object Qquote, Qunbound;
3391extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
3392extern Lisp_Object Qerror, Qquit, Qargs_out_of_range;
3393extern Lisp_Object Qvoid_variable, Qvoid_function;
3394extern Lisp_Object Qinvalid_read_syntax;
3395extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
3396extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive;
3397extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
3398extern Lisp_Object Qtext_read_only;
3399extern Lisp_Object Qinteractive_form;
3400extern Lisp_Object Qcircular_list;
3401extern Lisp_Object Qsequencep;
3402extern Lisp_Object Qchar_or_string_p, Qinteger_or_marker_p;
3403extern Lisp_Object Qfboundp;
3404
3405extern Lisp_Object Qcdr;
3406
3407extern Lisp_Object Qrange_error, Qoverflow_error;
3408
3409extern Lisp_Object Qnumber_or_marker_p;
3410
3411extern Lisp_Object Qbuffer, Qinteger, Qsymbol;
3412
3413/* Defined in data.c. */
3414extern Lisp_Object indirect_function (Lisp_Object); 3441extern Lisp_Object indirect_function (Lisp_Object);
3415extern Lisp_Object find_symbol_value (Lisp_Object); 3442extern Lisp_Object find_symbol_value (Lisp_Object);
3416enum Arith_Comparison { 3443enum Arith_Comparison {
@@ -3466,7 +3493,6 @@ extern void syms_of_cmds (void);
3466extern void keys_of_cmds (void); 3493extern void keys_of_cmds (void);
3467 3494
3468/* Defined in coding.c. */ 3495/* Defined in coding.c. */
3469extern Lisp_Object Qcharset;
3470extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t, 3496extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
3471 ptrdiff_t, bool, bool, Lisp_Object); 3497 ptrdiff_t, bool, bool, Lisp_Object);
3472extern void init_coding (void); 3498extern void init_coding (void);
@@ -3490,14 +3516,10 @@ extern void init_syntax_once (void);
3490extern void syms_of_syntax (void); 3516extern void syms_of_syntax (void);
3491 3517
3492/* Defined in fns.c. */ 3518/* Defined in fns.c. */
3493extern Lisp_Object QCrehash_size, QCrehash_threshold;
3494enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; 3519enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
3495extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; 3520extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
3496extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); 3521extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
3497extern void sweep_weak_hash_tables (void); 3522extern void sweep_weak_hash_tables (void);
3498extern Lisp_Object Qcursor_in_echo_area;
3499extern Lisp_Object Qstring_lessp;
3500extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq;
3501EMACS_UINT hash_string (char const *, ptrdiff_t); 3523EMACS_UINT hash_string (char const *, ptrdiff_t);
3502EMACS_UINT sxhash (Lisp_Object, int); 3524EMACS_UINT sxhash (Lisp_Object, int);
3503Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, 3525Lisp_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. */
3540extern Lisp_Object QCascent, QCmargin, QCrelief;
3541extern Lisp_Object QCconversion;
3542extern int x_bitmap_mask (struct frame *, ptrdiff_t); 3562extern int x_bitmap_mask (struct frame *, ptrdiff_t);
3543extern void reset_image_types (void); 3563extern void reset_image_types (void);
3544extern void syms_of_image (void); 3564extern void syms_of_image (void);
3545 3565
3546/* Defined in insdel.c. */ 3566/* Defined in insdel.c. */
3547extern Lisp_Object Qinhibit_modification_hooks;
3548extern Lisp_Object Qregion_extract_function;
3549extern void move_gap_both (ptrdiff_t, ptrdiff_t); 3567extern void move_gap_both (ptrdiff_t, ptrdiff_t);
3550extern _Noreturn void buffer_overflow (void); 3568extern _Noreturn void buffer_overflow (void);
3551extern void make_gap (ptrdiff_t); 3569extern void make_gap (ptrdiff_t);
@@ -3600,18 +3618,6 @@ extern Lisp_Object Vwindow_system;
3600extern Lisp_Object sit_for (Lisp_Object, bool, int); 3618extern Lisp_Object sit_for (Lisp_Object, bool, int);
3601 3619
3602/* Defined in xdisp.c. */ 3620/* Defined in xdisp.c. */
3603extern Lisp_Object Qinhibit_point_motion_hooks;
3604extern Lisp_Object Qinhibit_redisplay;
3605extern Lisp_Object Qmenu_bar_update_hook;
3606extern Lisp_Object Qwindow_scroll_functions;
3607extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
3608extern Lisp_Object Qtext, Qboth, Qboth_horiz, Qtext_image_horiz;
3609extern Lisp_Object Qspace, Qcenter, QCalign_to;
3610extern Lisp_Object Qbar, Qhbar, Qhollow;
3611extern Lisp_Object Qleft_margin, Qright_margin;
3612extern Lisp_Object QCdata, QCfile;
3613extern Lisp_Object QCmap;
3614extern Lisp_Object Qrisky_local_variable;
3615extern bool noninteractive_need_newline; 3621extern bool noninteractive_need_newline;
3616extern Lisp_Object echo_area_buffer[2]; 3622extern Lisp_Object echo_area_buffer[2];
3617extern void add_to_log (const char *, Lisp_Object, Lisp_Object); 3623extern void add_to_log (const char *, Lisp_Object, Lisp_Object);
@@ -3745,8 +3751,6 @@ build_string (const char *str)
3745 3751
3746extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); 3752extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
3747extern void make_byte_code (struct Lisp_Vector *); 3753extern void make_byte_code (struct Lisp_Vector *);
3748extern Lisp_Object Qautomatic_gc;
3749extern Lisp_Object Qchar_table_extra_slots;
3750extern struct Lisp_Vector *allocate_vector (EMACS_INT); 3754extern 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. */
3851extern Lisp_Object Vprin1_to_string_buffer; 3855extern Lisp_Object Vprin1_to_string_buffer;
3852extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE; 3856extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
3853extern Lisp_Object Qstandard_output;
3854extern Lisp_Object Qexternal_debugging_output;
3855extern void temp_output_buffer_setup (const char *); 3857extern void temp_output_buffer_setup (const char *);
3856extern int print_level; 3858extern int print_level;
3857extern Lisp_Object Qprint_escape_newlines;
3858extern void write_string (const char *, int); 3859extern void write_string (const char *, int);
3859extern void print_error_message (Lisp_Object, Lisp_Object, const char *, 3860extern 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. */
3881extern Lisp_Object Qsize, Qvariable_documentation, Qstandard_input;
3882extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
3883extern Lisp_Object Qlexical_binding;
3884extern Lisp_Object check_obarray (Lisp_Object); 3882extern Lisp_Object check_obarray (Lisp_Object);
3885extern Lisp_Object intern_1 (const char *, ptrdiff_t); 3883extern Lisp_Object intern_1 (const char *, ptrdiff_t);
3886extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t); 3884extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
3887extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, ptrdiff_t); 3885extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object);
3886extern void init_symbol (Lisp_Object, Lisp_Object);
3888extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t); 3887extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
3889INLINE void 3888INLINE void
3890LOADHIST_ATTACH (Lisp_Object x) 3889LOADHIST_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. */
3918extern EMACS_INT lisp_eval_depth; 3917extern EMACS_INT lisp_eval_depth;
3919extern Lisp_Object Qexit, Qinteractive, Qcommandp, Qmacro;
3920extern Lisp_Object Qinhibit_quit, Qinternal_interpreter_environment, Qclosure;
3921extern Lisp_Object Qand_rest;
3922extern Lisp_Object Vautoload_queue; 3918extern Lisp_Object Vautoload_queue;
3919extern Lisp_Object Vrun_hooks;
3923extern Lisp_Object Vsignaling_function; 3920extern Lisp_Object Vsignaling_function;
3924extern Lisp_Object inhibit_lisp_code; 3921extern Lisp_Object inhibit_lisp_code;
3925extern struct handler *handlerlist; 3922extern 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. */
3934extern Lisp_Object Vrun_hooks; 3931extern void run_hook (Lisp_Object);
3935extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object); 3932extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
3936extern Lisp_Object run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, 3933extern 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. */
3995extern Lisp_Object Qfield;
3996extern void insert1 (Lisp_Object); 3992extern void insert1 (Lisp_Object);
3997extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object); 3993extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object);
3998extern Lisp_Object save_excursion_save (void); 3994extern 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
4042extern Lisp_Object Qfile_error;
4043extern Lisp_Object Qfile_notify_error;
4044extern Lisp_Object Qfile_exists_p;
4045extern Lisp_Object Qfile_directory_p;
4046extern Lisp_Object Qinsert_file_contents;
4047extern Lisp_Object Qfile_name_history;
4048extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object); 4038extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
4049extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, 4039extern 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);
4061extern void init_fileio (void); 4051extern void init_fileio (void);
4062extern void syms_of_fileio (void); 4052extern void syms_of_fileio (void);
4063extern Lisp_Object make_temp_name (Lisp_Object, bool); 4053extern Lisp_Object make_temp_name (Lisp_Object, bool);
4064extern Lisp_Object Qdelete_file;
4065 4054
4066/* Defined in search.c. */ 4055/* Defined in search.c. */
4067extern void shrink_regexp_cache (void); 4056extern 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
4094extern Lisp_Object Qcompletion_ignore_case;
4095extern Lisp_Object Vminibuffer_list; 4083extern Lisp_Object Vminibuffer_list;
4096extern Lisp_Object last_minibuf_string; 4084extern Lisp_Object last_minibuf_string;
4097extern Lisp_Object get_minibuffer (EMACS_INT); 4085extern 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
4103extern Lisp_Object Qminus, Qplus;
4104extern Lisp_Object Qprogn;
4105extern Lisp_Object Qwhen;
4106extern Lisp_Object Qmouse_leave_buffer_hook;
4107extern void syms_of_callint (void); 4091extern void syms_of_callint (void);
4108 4092
4109/* Defined in casefiddle.c. */ 4093/* Defined in casefiddle.c. */
4110 4094
4111extern Lisp_Object Qidentity;
4112extern void syms_of_casefiddle (void); 4095extern void syms_of_casefiddle (void);
4113extern void keys_of_casefiddle (void); 4096extern void keys_of_casefiddle (void);
4114 4097
@@ -4122,8 +4105,6 @@ extern void syms_of_casetab (void);
4122extern Lisp_Object echo_message_buffer; 4105extern Lisp_Object echo_message_buffer;
4123extern struct kboard *echo_kboard; 4106extern struct kboard *echo_kboard;
4124extern void cancel_echoing (void); 4107extern void cancel_echoing (void);
4125extern Lisp_Object Qdisabled, QCfilter;
4126extern Lisp_Object Qup, Qdown;
4127extern Lisp_Object last_undo_boundary; 4108extern Lisp_Object last_undo_boundary;
4128extern bool input_pending; 4109extern 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);
4157extern void syms_of_indent (void); 4138extern void syms_of_indent (void);
4158 4139
4159/* Defined in frame.c. */ 4140/* Defined in frame.c. */
4160extern Lisp_Object Qonly, Qnone;
4161extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object); 4141extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object);
4162extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object); 4142extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object);
4163extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object); 4143extern Lisp_Object do_switch_frame (Lisp_Object, int, int, Lisp_Object);
@@ -4173,9 +4153,7 @@ extern bool display_arg;
4173#endif 4153#endif
4174extern Lisp_Object decode_env_path (const char *, const char *, bool); 4154extern Lisp_Object decode_env_path (const char *, const char *, bool);
4175extern Lisp_Object empty_unibyte_string, empty_multibyte_string; 4155extern Lisp_Object empty_unibyte_string, empty_multibyte_string;
4176extern Lisp_Object Qfile_name_handler_alist;
4177extern _Noreturn void terminate_due_to_signal (int, int); 4156extern _Noreturn void terminate_due_to_signal (int, int);
4178extern Lisp_Object Qkill_emacs;
4179#ifdef WINDOWSNT 4157#ifdef WINDOWSNT
4180extern Lisp_Object Vlibrary_cache; 4158extern Lisp_Object Vlibrary_cache;
4181#endif 4159#endif
@@ -4210,7 +4188,6 @@ extern bool inhibit_window_system;
4210extern bool running_asynch_code; 4188extern bool running_asynch_code;
4211 4189
4212/* Defined in process.c. */ 4190/* Defined in process.c. */
4213extern Lisp_Object QCtype, Qlocal;
4214extern void kill_buffer_processes (Lisp_Object); 4191extern void kill_buffer_processes (Lisp_Object);
4215extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object, 4192extern 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);
4246extern void syms_of_callproc (void); 4223extern void syms_of_callproc (void);
4247 4224
4248/* Defined in doc.c. */ 4225/* Defined in doc.c. */
4249extern Lisp_Object Qfunction_documentation;
4250extern Lisp_Object read_doc_string (Lisp_Object); 4226extern Lisp_Object read_doc_string (Lisp_Object);
4251extern Lisp_Object get_doc_string (Lisp_Object, bool, bool); 4227extern Lisp_Object get_doc_string (Lisp_Object, bool, bool);
4252extern void syms_of_doc (void); 4228extern void syms_of_doc (void);
@@ -4267,8 +4243,6 @@ extern void init_macros (void);
4267extern void syms_of_macros (void); 4243extern void syms_of_macros (void);
4268 4244
4269/* Defined in undo.c. */ 4245/* Defined in undo.c. */
4270extern Lisp_Object Qapply;
4271extern Lisp_Object Qinhibit_read_only;
4272extern void truncate_undo_list (struct buffer *); 4246extern void truncate_undo_list (struct buffer *);
4273extern void record_insert (ptrdiff_t, ptrdiff_t); 4247extern void record_insert (ptrdiff_t, ptrdiff_t);
4274extern void record_delete (ptrdiff_t, Lisp_Object, bool); 4248extern 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);
4280extern void syms_of_undo (void); 4254extern void syms_of_undo (void);
4281/* Defined in textprop.c. */
4282extern Lisp_Object Qmouse_face;
4283extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
4284extern Lisp_Object Qminibuffer_prompt;
4285 4255
4256/* Defined in textprop.c. */
4286extern void report_interval_modification (Lisp_Object, Lisp_Object); 4257extern 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. */
4368extern void syms_of_fontset (void); 4339extern void syms_of_fontset (void);
4369
4370/* Defined in xfns.c, w32fns.c, or macfns.c. */
4371extern 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. */
4391extern Lisp_Object Qdefault, Qfringe;
4392extern Lisp_Object Qscroll_bar, Qcursor;
4393extern Lisp_Object Qmode_line_inactive;
4394extern Lisp_Object Qface;
4395extern Lisp_Object Qnormal;
4396extern Lisp_Object QCfamily, QCweight, QCslant;
4397extern Lisp_Object QCheight, QCname, QCwidth, QCforeground, QCbackground;
4398extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold;
4399extern Lisp_Object Qbold, Qextra_bold, Qultra_bold;
4400extern Lisp_Object Qoblique, Qitalic;
4401extern Lisp_Object Vface_alternative_font_family_alist; 4359extern Lisp_Object Vface_alternative_font_family_alist;
4402extern Lisp_Object Vface_alternative_font_registry_alist; 4360extern Lisp_Object Vface_alternative_font_registry_alist;
4403extern void syms_of_xfaces (void); 4361extern 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.
18You should have received a copy of the GNU General Public License 18You should have received a copy of the GNU General Public License
19along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ 19along 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. */
68static Lisp_Object Qhash_table, Qdata;
69static Lisp_Object Qtest;
70Lisp_Object Qsize;
71static Lisp_Object Qweakness;
72static Lisp_Object Qrehash_size;
73static Lisp_Object Qrehash_threshold;
74
75static Lisp_Object Qread_char, Qget_file_char, Qcurrent_load_list;
76Lisp_Object Qstandard_input;
77Lisp_Object Qvariable_documentation;
78static Lisp_Object Qascii_character, Qload, Qload_file_name;
79Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
80static Lisp_Object Qinhibit_file_name_operation;
81static Lisp_Object Qeval_buffer_list;
82Lisp_Object Qlexical_binding;
83static 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. */
87static Lisp_Object Qget_emacs_mule_file_char;
88
89static Lisp_Object Qload_force_doc_strings;
90
91static 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. */
135static bool new_backquote_flag; 111static bool new_backquote_flag;
136static 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
1433static 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
3797Lisp_Object 3770static Lisp_Object
3798intern_driver (Lisp_Object string, Lisp_Object obarray, ptrdiff_t index) 3771intern_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
3794Lisp_Object
3795intern_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
3832Lisp_Object 3813Lisp_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
3829static void
3830define_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
3848DEFUN ("intern", Fintern, Sintern, 1, 2, 0, 3846DEFUN ("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
41static struct font_driver macfont_driver; 41static struct font_driver macfont_driver;
42 42
43/* Core Text, for Mac OS X. */
44static Lisp_Object Qmac_ct;
45
46static double mac_ctfont_get_advance_width_for_glyph (CTFontRef, CGGlyph); 43static double mac_ctfont_get_advance_width_for_glyph (CTFontRef, CGGlyph);
47static CGRect mac_ctfont_get_bounding_rect_for_glyph (CTFontRef, CGGlyph); 44static CGRect mac_ctfont_get_bounding_rect_for_glyph (CTFontRef, CGGlyph);
48static CFArrayRef mac_ctfont_create_available_families (void); 45static 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. */
78static Lisp_Object QCdestination;
79
80/* The boolean-valued font property key specifying the use of
81 leading. */
82static Lisp_Object QCminspace;
83
84struct macfont_metrics; 69struct 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
31static Lisp_Object Qexecute_kbd_macro;
32static 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
286DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0, 283DEFUN ("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
26extern 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
31enum { 27enum {
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
55EMACS_INT minibuf_level; 55EMACS_INT minibuf_level;
56 56
57/* The maximum length of a minibuffer history. */
58
59static 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
63Lisp_Object last_minibuf_string; 59Lisp_Object last_minibuf_string;
64 60
65static Lisp_Object Qminibuffer_history, Qbuffer_name_history;
66
67static Lisp_Object Qread_file_name_internal;
68
69/* Normal hooks for entry to and exit from minibuffer. */
70
71static Lisp_Object Qminibuffer_setup_hook;
72static Lisp_Object Qminibuffer_exit_hook;
73
74Lisp_Object Qcompletion_ignore_case;
75static Lisp_Object Qminibuffer_completion_table;
76static Lisp_Object Qminibuffer_completion_predicate;
77static Lisp_Object Qminibuffer_completion_confirm;
78static Lisp_Object Qcustom_variable_p;
79
80static Lisp_Object Qminibuffer_default;
81
82static Lisp_Object Qcurrent_input_method, Qactivate_input_method;
83
84static Lisp_Object Qcase_fold_search;
85
86static 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
90static Lisp_Object minibuf_prompt; 63static 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
1824static Lisp_Object Qmetadata;
1825
1826DEFUN ("internal-complete-buffer", Finternal_complete_buffer, Sinternal_complete_buffer, 3, 3, 0, 1797DEFUN ("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.
1828STRING and PREDICATE have the same meanings as in `try-completion', 1799STRING 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
62extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types; 62extern NSArray *ns_send_types, *ns_return_types, *ns_drag_types;
63 63
64extern Lisp_Object Qforeground_color;
65extern Lisp_Object Qbackground_color;
66extern Lisp_Object Qcursor_color;
67extern Lisp_Object Qinternal_border_width;
68extern Lisp_Object Qvisibility;
69extern Lisp_Object Qcursor_type;
70extern Lisp_Object Qicon_type;
71extern Lisp_Object Qicon_name;
72extern Lisp_Object Qicon_left;
73extern Lisp_Object Qicon_top;
74extern Lisp_Object Qtop;
75extern Lisp_Object Qdisplay;
76extern Lisp_Object Qvertical_scroll_bars;
77extern Lisp_Object Qhorizontal_scroll_bars;
78extern Lisp_Object Qauto_raise;
79extern Lisp_Object Qauto_lower;
80extern Lisp_Object Qbox;
81extern Lisp_Object Qscroll_bar_width;
82extern Lisp_Object Qscroll_bar_height;
83extern Lisp_Object Qx_resource_name;
84extern Lisp_Object Qface_set_after_frame_default;
85extern Lisp_Object Qunderline, Qundefined;
86extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
87extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
88
89
90Lisp_Object Qbuffered;
91Lisp_Object Qfontsize;
92
93EmacsTooltip *ns_tooltip = nil; 64EmacsTooltip *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
48extern Lisp_Object Qns;
49extern Lisp_Object Qnormal, Qbold, Qitalic;
50static Lisp_Object Qapple, Qroman, Qmedium;
51static Lisp_Object Qcondensed, Qexpanded;
52extern Lisp_Object Qappend;
53extern float ns_antialias_threshold; 48extern 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
37extern Lisp_Object QCfile, QCdata;
38
39/* call tracing */ 37/* call tracing */
40#if 0 38#if 0
41int image_trace_num = 0; 39int 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
62extern Lisp_Object Qundefined, Qmenu_enable, Qmenu_bar_update_hook;
63extern Lisp_Object QCtoggle, QCradio;
64
65Lisp_Object Qdebug_on_next_call;
66extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
67
68extern long context_menu_value; 62extern long context_menu_value;
69EmacsMenu *mainMenu, *svcsMenu, *dockMenu; 63EmacsMenu *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
37static Lisp_Object QCLIPBOARD, QSECONDARY, QTEXT, QFILE_NAME;
38
39static Lisp_Object Vselection_alist; 37static 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;
792void ns_dump_glyphstring (struct glyph_string *s); 792void 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. */
795extern Lisp_Object Qfontsize;
796extern Lisp_Object ns_list_fonts (struct frame *f, Lisp_Object pattern, 795extern Lisp_Object ns_list_fonts (struct frame *f, Lisp_Object pattern,
797 int size, int maxnames); 796 int size, int maxnames);
798extern void ns_clear_frame (struct frame *f); 797extern 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
228static Lisp_Object Qmodifier_value;
229Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper;
230extern Lisp_Object Qcursor_color, Qcursor_type, Qns;
231
232static Lisp_Object QUTF8_STRING;
233static Lisp_Object Qcocoa, Qgnustep;
234static 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. */
76static ptrdiff_t print_buffer_pos_byte; 76static ptrdiff_t print_buffer_pos_byte;
77 77
78Lisp_Object Qprint_escape_newlines;
79static 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. */
724Lisp_Object Qexternal_debugging_output;
725
726DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, 719DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
727 doc: /* Write CHARACTER to stderr. 720 doc: /* Write CHARACTER to stderr.
728You can call print while debugging emacs, and pass it this function 721You can call print while debugging emacs, and pass it this function
@@ -2235,7 +2228,10 @@ print_interval (INTERVAL interval, Lisp_Object printcharfun)
2235void 2228void
2236init_print_once (void) 2229init_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
144Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
145Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
146Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
147Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;
148Lisp_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
194Lisp_Object Qprocessp;
195static Lisp_Object Qrun, Qstop, Qsignal;
196static Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
197Lisp_Object Qlocal;
198static Lisp_Object Qipv4, Qdatagram, Qseqpacket;
199static Lisp_Object Qreal, Qnetwork, Qserial;
200#ifdef AF_INET6
201static Lisp_Object Qipv6;
202#endif
203static Lisp_Object QCport, QCprocess;
204Lisp_Object QCspeed;
205Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
206Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
207static Lisp_Object QCbuffer, QChost, QCservice;
208static Lisp_Object QClocal, QCremote, QCcoding;
209static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
210static Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
211static Lisp_Object Qlast_nonmenu_event;
212static Lisp_Object Qinternal_default_process_sentinel;
213static 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. */
198extern bool inhibit_sentinels; 198extern bool inhibit_sentinels;
199 199
200extern Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname;
201extern Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime;
202extern Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
203extern Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtpgid, Qcstime;
204extern Lisp_Object Qtime, Qctime;
205extern Lisp_Object QCspeed;
206extern Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
207extern 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. */
210enum 201enum
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
36typedef struct Lisp_Hash_Table log_t; 36typedef struct Lisp_Hash_Table log_t;
37 37
38static Lisp_Object Qprofiler_backtrace_equal;
39static struct hash_table_test hashtest_profiler; 38static struct hash_table_test hashtest_profiler;
40 39
41static Lisp_Object 40static 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. */
85static Lisp_Object last_thing_searched; 85static Lisp_Object last_thing_searched;
86 86
87/* Error condition signaled when regexp compile_pattern fails. */
88static Lisp_Object Qinvalid_regexp;
89
90/* Error condition used for failing searches. */
91static Lisp_Object Qsearch_failed;
92
93static void set_search_regs (ptrdiff_t, ptrdiff_t); 87static void set_search_regs (ptrdiff_t, ptrdiff_t);
94static void save_search_regs (void); 88static void save_search_regs (void);
95static EMACS_INT simple_search (EMACS_INT, unsigned char *, ptrdiff_t, 89static 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
104static Lisp_Object QCvolume, QCdevice;
105static Lisp_Object Qsound;
106static 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
110enum sound_attr 104enum 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
140static Lisp_Object Qsyntax_table_p;
141static 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
145struct lisp_parse_state 142struct 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
131static int max_frame_cols; 131static int max_frame_cols;
132 132
133static Lisp_Object Qtty_mode_set_strings;
134static 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. */
2711static int menu_help_paneno, menu_help_itemno; 2708static int menu_help_paneno, menu_help_itemno;
2712 2709
2713static Lisp_Object Qtty_menu_navigation_map, Qtty_menu_exit;
2714static Lisp_Object Qtty_menu_prev_item, Qtty_menu_next_item;
2715static Lisp_Object Qtty_menu_next_menu, Qtty_menu_prev_menu;
2716static Lisp_Object Qtty_menu_select, Qtty_menu_ignore;
2717static Lisp_Object Qtty_menu_mouse_movement;
2718
2719typedef struct tty_menu_struct 2710typedef 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. */
38struct terminal *initial_terminal; 38struct terminal *initial_terminal;
39 39
40Lisp_Object Qrun_hook_with_args;
41static Lisp_Object Qterminal_live_p;
42static Lisp_Object Qdelete_terminal_functions;
43
44static void delete_initial_terminal (struct terminal *); 40static 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. */
48static Lisp_Object Qmouse_left;
49static Lisp_Object Qmouse_entered;
50Lisp_Object Qpoint_left;
51Lisp_Object Qpoint_entered;
52Lisp_Object Qcategory;
53Lisp_Object Qlocal_map;
54
55/* Visual properties text (including strings) may have. */
56static Lisp_Object Qforeground, Qbackground, Qunderline;
57Lisp_Object Qfont;
58static Lisp_Object Qstipple;
59Lisp_Object Qinvisible, Qintangible, Qmouse_face;
60static Lisp_Object Qread_only;
61Lisp_Object Qminibuffer_prompt;
62 47
63enum property_set_type 48enum 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. */
71Lisp_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;
34static struct buffer *last_boundary_buffer; 34static struct buffer *last_boundary_buffer;
35static ptrdiff_t last_boundary_position; 35static ptrdiff_t last_boundary_position;
36 36
37Lisp_Object Qinhibit_read_only;
38
39/* Marker for function call undo list elements. */
40
41Lisp_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
461syms_of_undo (void) 455syms_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;
diff --git a/src/w32.c b/src/w32.c
index 3237c7b04c7..31b13289b57 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -242,8 +242,6 @@ typedef struct _REPARSE_DATA_BUFFER {
242typedef HRESULT (WINAPI * ShGetFolderPath_fn) 242typedef 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
245Lisp_Object QCloaded_from;
246
247void globals_of_w32 (void); 245void globals_of_w32 (void);
248static DWORD get_rid (PSID); 246static DWORD get_rid (PSID);
249static int is_symlink (const char *); 247static int is_symlink (const char *);
diff --git a/src/w32.h b/src/w32.h
index a8a525cbd90..835557d5ec7 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -172,7 +172,6 @@ extern void init_timers (void);
172extern int _sys_read_ahead (int fd); 172extern int _sys_read_ahead (int fd);
173extern int _sys_wait_accept (int fd); 173extern int _sys_wait_accept (int fd);
174 174
175extern Lisp_Object QCloaded_from;
176extern HMODULE w32_delayed_load (Lisp_Object); 175extern HMODULE w32_delayed_load (Lisp_Object);
177 176
178extern int (WINAPI *pMultiByteToWideChar)(UINT,DWORD,LPCSTR,int,LPWSTR,int); 177extern 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
96Lisp_Object Qundefined_color;
97Lisp_Object Qcancel_timer;
98Lisp_Object Qfont_param;
99Lisp_Object Qhyper;
100Lisp_Object Qsuper;
101Lisp_Object Qmeta;
102Lisp_Object Qalt;
103Lisp_Object Qctrl;
104Lisp_Object Qcontrol;
105Lisp_Object Qshift;
106static 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
60Lisp_Object Qgdi;
61Lisp_Object Quniscribe;
62static Lisp_Object QCformat;
63static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif;
64static Lisp_Object Qserif, Qscript, Qdecorative;
65static Lisp_Object Qraster, Qoutline, Qunknown;
66
67/* antialiasing */
68static Lisp_Object Qstandard, Qsubpixel, Qnatural;
69
70/* languages */
71static Lisp_Object Qzh;
72
73/* scripts */
74static Lisp_Object Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew;
75static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali;
76static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu;
77static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao;
78static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic;
79static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic;
80static Lisp_Object Qkhmer, Qmongolian, Qbraille, Qhan;
81static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo;
82static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol;
83static Lisp_Object Qmusical_symbol, Qmathematical, Qcham, Qphonetic;
84/* Not defined in characters.el, but referenced in fontset.el. */
85static Lisp_Object Qbalinese, Qbuginese, Qbuhid, Qcuneiform, Qcypriot;
86static Lisp_Object Qdeseret, Qglagolitic, Qgothic, Qhanunoo, Qkharoshthi;
87static Lisp_Object Qlimbu, Qlinear_b, Qold_italic, Qold_persian, Qosmanya;
88static Lisp_Object Qphags_pa, Qphoenician, Qshavian, Qsyloti_nagri;
89static Lisp_Object Qtagalog, Qtagbanwa, Qtai_le, Qtifinagh, Qugaritic;
90
91/* W32 charsets: for use in Vw32_charset_info_alist. */
92static Lisp_Object Qw32_charset_ansi, Qw32_charset_default;
93static Lisp_Object Qw32_charset_symbol, Qw32_charset_shiftjis;
94static Lisp_Object Qw32_charset_hangeul, Qw32_charset_gb2312;
95static Lisp_Object Qw32_charset_chinesebig5, Qw32_charset_oem;
96static Lisp_Object Qw32_charset_easteurope, Qw32_charset_turkish;
97static Lisp_Object Qw32_charset_baltic, Qw32_charset_russian;
98static Lisp_Object Qw32_charset_arabic, Qw32_charset_greek;
99static Lisp_Object Qw32_charset_hebrew, Qw32_charset_vietnamese;
100static Lisp_Object Qw32_charset_thai, Qw32_charset_johab, Qw32_charset_mac;
101
102/* Font spacing symbols - defined in font.c. */
103extern Lisp_Object Qc, Qp, Qm;
104
105static void fill_in_logfont (struct frame *, LOGFONT *, Lisp_Object); 60static void fill_in_logfont (struct frame *, LOGFONT *, Lisp_Object);
106 61
107static BYTE w32_antialias_type (Lisp_Object); 62static 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;
98MessageBoxW_Proc unicode_message_box = NULL; 98MessageBoxW_Proc unicode_message_box = NULL;
99#endif /* NTGUI_UNICODE */ 99#endif /* NTGUI_UNICODE */
100 100
101Lisp_Object Qdebug_on_next_call, Qunsupported__w32_dialog;
102
103void set_frame_menubar (struct frame *, bool, bool); 101void 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];
118DWORD notifications_size; 118DWORD notifications_size;
119void *notifications_desc; 119void *notifications_desc;
120 120
121static Lisp_Object Qfile_name, Qdirectory_name, Qattributes; 121static Lisp_Object watch_list;
122static Lisp_Object Qlast_write_time, Qlast_access_time, Qcreation_time;
123static 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'. */)
622Lisp_Object 620Lisp_Object
623w32_get_watch_object (void *desc) 621w32_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
75Lisp_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. */
78static signal_handler sig_handlers[NSIG]; 76static 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);
107static void setup_windows_coding_system (Lisp_Object coding_system, 107static 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. */
114Lisp_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. */
118static LCID DEFAULT_LCID; 112static LCID DEFAULT_LCID;
119static UINT ANSICP, OEMCP; 113static UINT ANSICP, OEMCP;
120static Lisp_Object QUNICODE, QANSICP, QOEMCP; 114static Lisp_Object QANSICP, QOEMCP;
121 115
122/* A hidden window just for the clipboard management. */ 116/* A hidden window just for the clipboard management. */
123static HWND clipboard_owner; 117static 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 *);
220static void x_check_font (struct frame *, struct font *); 220static void x_check_font (struct frame *, struct font *);
221#endif 221#endif
222 222
223static Lisp_Object Qvendor_specific_keysyms;
224static Lisp_Object Qadded, Qremoved, Qmodified;
225static 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
48int uniscribe_available = 0; 48int uniscribe_available = 0;
49 49
50/* Defined in w32font.c, since it is required there as well. */
51extern Lisp_Object Quniscribe;
52extern Lisp_Object Qopentype;
53
54/* EnumFontFamiliesEx callback. */ 50/* EnumFontFamiliesEx callback. */
55static int CALLBACK ALIGN_STACK add_opentype_font_name_to_list (ENUMLOGFONTEX *, 51static 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
51Lisp_Object Qwindowp, Qwindow_live_p;
52static Lisp_Object Qwindow_valid_p;
53static Lisp_Object Qwindow_configuration_p;
54static Lisp_Object Qrecord_window_buffer;
55static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer;
56static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window;
57static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically;
58static Lisp_Object Qwindow_sanitize_window_sizes;
59static Lisp_Object Qwindow_pixel_to_total;
60static Lisp_Object Qscroll_up, Qscroll_down, Qscroll_command;
61static Lisp_Object Qsafe, Qabove, Qbelow, Qwindow_size, Qclone_of;
62static Lisp_Object Qfloor, Qceiling;
63static Lisp_Object Qwindow_point_insertion_type;
64
65static int displayed_window_lines (struct window *); 51static int displayed_window_lines (struct window *);
66static int count_windows (struct window *); 52static int count_windows (struct window *);
67static int get_leaf_windows (struct window *, struct window **, int); 53static 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. */
119Lisp_Object minibuf_selected_window; 105Lisp_Object minibuf_selected_window;
120 106
121/* Hook run at end of temp_output_buffer_show. */
122static Lisp_Object Qtemp_buffer_show_hook;
123
124/* Incremented for each window created. */ 107/* Incremented for each window created. */
125static int sequence_number; 108static int sequence_number;
126 109
127/* Hook to run when window config changes. */
128static 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. */
131static int window_scroll_pixel_based_preserve_x; 111static int window_scroll_pixel_based_preserve_x;
132static int window_scroll_pixel_based_preserve_y; 112static int window_scroll_pixel_based_preserve_y;
@@ -997,7 +977,10 @@ or scroll bars.
997If PIXELWISE is nil, return the largest integer smaller than WINDOW's 977If PIXELWISE is nil, return the largest integer smaller than WINDOW's
998pixel width divided by the character width of WINDOW's frame. This 978pixel width divided by the character width of WINDOW's frame. This
999means that if a column at the right of the text area is only partially 979means that if a column at the right of the text area is only partially
1000visible, that column is not counted. */) 980visible, that column is not counted.
981
982Note that the returned value includes the column reserved for the
983continuation 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. */
1088extern Lisp_Object Qwindow_live_p;
1089extern Lisp_Object Vwindow_list; 1088extern Lisp_Object Vwindow_list;
1090 1089
1091extern Lisp_Object window_list (void); 1090extern 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
330Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
331Lisp_Object Qwindow_scroll_functions;
332static Lisp_Object Qwindow_text_change_functions;
333static Lisp_Object Qredisplay_end_trigger_functions;
334Lisp_Object Qinhibit_point_motion_hooks;
335static Lisp_Object QCeval, QCpropertize;
336Lisp_Object QCfile, QCdata;
337static Lisp_Object Qfontified;
338static Lisp_Object Qgrow_only;
339static Lisp_Object Qinhibit_eval_during_redisplay;
340static Lisp_Object Qbuffer_position, Qposition, Qobject;
341static Lisp_Object Qright_to_left, Qleft_to_right;
342
343/* Cursor shapes. */
344Lisp_Object Qbar, Qhbar, Qbox, Qhollow;
345
346/* Pointer shapes. */
347static Lisp_Object Qarrow, Qhand;
348Lisp_Object Qtext;
349
350/* Holds the list (error). */ 330/* Holds the list (error). */
351static Lisp_Object list_of_error; 331static Lisp_Object list_of_error;
352 332
353Lisp_Object Qfontification_functions;
354
355static Lisp_Object Qwrap_prefix;
356static Lisp_Object Qline_prefix;
357static Lisp_Object Qredisplay_internal;
358
359/* Non-nil means don't actually do any redisplay. */
360
361Lisp_Object Qinhibit_redisplay;
362
363/* Names of text properties relevant for redisplay. */
364
365Lisp_Object Qdisplay;
366
367Lisp_Object Qspace, QCalign_to;
368static Lisp_Object QCrelative_width, QCrelative_height;
369Lisp_Object Qleft_margin, Qright_margin;
370static Lisp_Object Qspace_width, Qraise;
371static Lisp_Object Qslice;
372Lisp_Object Qcenter;
373static Lisp_Object Qmargin, Qpointer;
374static 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
411static Lisp_Object Qtrailing_whitespace;
412
413/* Name and number of the face used to highlight escape glyphs. */
414
415static Lisp_Object Qescape_glyph;
416
417/* Name and number of the face used to highlight non-breaking spaces. */
418
419static 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
424Lisp_Object Qimage;
425
426/* The image map types. */
427Lisp_Object QCmap;
428static Lisp_Object QCpointer;
429static Lisp_Object Qrect, Qcircle, Qpoly;
430
431/* Tool bar styles */
432Lisp_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
481static struct buffer *this_line_buffer; 413static 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
489static 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
494static Lisp_Object Qoverlay_arrow_string, Qoverlay_arrow_bitmap;
495
496Lisp_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
500static bool overlay_arrow_seen; 417static bool overlay_arrow_seen;
@@ -570,11 +487,6 @@ static bool display_last_displayed_message_p;
570 487
571static bool message_buf_print; 488static bool message_buf_print;
572 489
573/* The symbol `inhibit-menubar-update' and its DEFVAR_BOOL variable. */
574
575static Lisp_Object Qinhibit_menubar_update;
576static 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
697static Lisp_Object Qauto_hscroll_mode;
698
699/* Buffer being redisplayed -- for redisplay_window_error. */ 609/* Buffer being redisplayed -- for redisplay_window_error. */
700 610
701static struct buffer *displayed_buffer; 611static struct buffer *displayed_buffer;
@@ -715,8 +625,8 @@ enum prop_handled
715 625
716struct props 626struct 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
738static struct props it_props[] = 648static 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
800bool redisplaying_p; 710bool redisplaying_p;
801 711
802static Lisp_Object Qinhibit_free_realized_faces;
803static 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. */
831static Lisp_Object Qglyphless_char;
832
833/* Symbol for the purpose of Vglyphless_char_display. */
834static Lisp_Object Qglyphless_char_display;
835
836/* Method symbols for Vglyphless_char_display. */
837static 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
2705static Lisp_Object Qeval;
2706
2707Lisp_Object 2603Lisp_Object
2708safe_eval (Lisp_Object sexpr) 2604safe_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),
31410or t (meaning all windows). */); 31341or 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
283Lisp_Object QCfamily, QCheight, QCweight, QCslant;
284static Lisp_Object QCunderline;
285static Lisp_Object QCinverse_video, QCstipple;
286Lisp_Object QCforeground, QCbackground;
287Lisp_Object QCwidth;
288static Lisp_Object QCfont, QCbold, QCitalic;
289static Lisp_Object QCreverse_video;
290static Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
291static Lisp_Object QCfontset, QCdistant_foreground;
292
293/* Symbols used for attribute values. */
294
295Lisp_Object Qnormal;
296Lisp_Object Qbold;
297static Lisp_Object Qline, Qwave;
298Lisp_Object Qextra_light, Qlight;
299Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
300Lisp_Object Qoblique;
301Lisp_Object Qitalic;
302static Lisp_Object Qreleased_button, Qpressed_button;
303static Lisp_Object QCstyle, QCcolor, QCline_width;
304Lisp_Object Qunspecified; /* used in dosfns.c */
305static Lisp_Object QCignore_defface;
306
307char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg"; 281char 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
312static Lisp_Object Qframe_set_background_mode;
313
314/* Names of basic faces. */
315
316Lisp_Object Qdefault, Qtool_bar, Qfringe;
317static Lisp_Object Qregion;
318Lisp_Object Qheader_line, Qscroll_bar, Qcursor;
319static Lisp_Object Qborder, Qmouse, Qmenu;
320Lisp_Object Qmode_line_inactive;
321static Lisp_Object Qvertical_border;
322static Lisp_Object Qwindow_divider;
323static Lisp_Object Qwindow_divider_first_pixel;
324static 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
330static 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
342Lisp_Object Vface_alternative_font_registry_alist; 293Lisp_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
350static 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
356Lisp_Object Qforeground_color, Qbackground_color;
357
358/* The symbols `face' and `mouse-face' used as text properties. */
359
360Lisp_Object Qface;
361
362/* Property for basic faces which other faces cannot inherit. */
363
364static Lisp_Object Qface_no_inherit;
365
366/* Error symbol for wrong_type_argument in load_pixmap. */
367
368static 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
372static int next_lface_id; 297static int next_lface_id;
@@ -376,14 +301,6 @@ static int next_lface_id;
376static Lisp_Object *lface_id_to_name; 301static Lisp_Object *lface_id_to_name;
377static ptrdiff_t lface_id_to_name_size; 302static ptrdiff_t lface_id_to_name_size;
378 303
379/* TTY color-related functions (defined in tty-colors.el). */
380
381static 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
385static 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,
6397void 6314void
6398syms_of_xfaces (void) 6315syms_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
128static Lisp_Object Qundefined_color;
129static Lisp_Object Qcompound_text, Qcancel_timer;
130Lisp_Object Qfont_param;
131
132#ifdef GLYPH_DEBUG 128#ifdef GLYPH_DEBUG
133static ptrdiff_t image_cache_refcount; 129static ptrdiff_t image_cache_refcount;
134static int dpyinfo_refcount; 130static 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
41Lisp_Object Qxft;
42static 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
111static 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. */
115static int popup_activated_flag; 114static int popup_activated_flag;
diff --git a/src/xml.c b/src/xml.c
index 11a6e456450..3e64788f822 100644
--- a/src/xml.c
+++ b/src/xml.c
@@ -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
32static 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
84static 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
88static Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
89static Lisp_Object QUTF8_STRING; /* This is a type of selection. */
90
91static Lisp_Object Qcompound_text_with_extensions;
92
93static Lisp_Object Qforeign_selection;
94static 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/>. */
51static char *current_mono_font; 51static char *current_mono_font;
52static char *current_font; 52static char *current_font;
53static struct x_display_info *first_dpyinfo; 53static struct x_display_info *first_dpyinfo;
54static Lisp_Object Qmonospace_font_name, Qfont_name, Qfont_render,
55 Qtool_bar_style;
56static Lisp_Object current_tool_bar_style; 54static 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
184static int x_noop_count; 184static int x_noop_count;
185 185
186static Lisp_Object Qalt, Qhyper, Qmeta, Qsuper, Qmodifier_value;
187
188static Lisp_Object Qvendor_specific_keysyms;
189static 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. */
193static Lisp_Object xg_default_icon_file; 188static Lisp_Object xg_default_icon_file;
194
195/* Used in gtkutil.c. */
196Lisp_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);
1111extern void x_session_close (void); 1111extern void x_session_close (void);
1112#endif 1112#endif
1113 1113
1114/* Defined in xterm.c */
1115
1116extern 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 @@
12015-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
92015-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
212015-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
342015-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
402015-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
472015-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
12015-01-01 Michael Albinus <michael.albinus@gmx.de> 552015-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 @@
192014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> 732014-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
252014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org> 782014-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 @@
1482014-11-21 Ulf Jasper <ulf.jasper@web.de> 2012014-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
1762014-11-17 Ulf Jasper <ulf.jasper@web.de> 2292014-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
1912014-11-16 Ulf Jasper <ulf.jasper@web.de> 2442014-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.
37This 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