aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog.134
-rw-r--r--src/Makefile.in14
-rw-r--r--src/alloc.c93
-rw-r--r--src/bytecode.c14
-rw-r--r--src/cmds.c6
-rw-r--r--src/conf_post.h1
-rw-r--r--src/data.c24
-rw-r--r--src/dired.c48
-rw-r--r--src/dispnew.c16
-rw-r--r--src/doc.c3
-rw-r--r--src/doprnt.c2
-rw-r--r--src/dynlib.c330
-rw-r--r--src/dynlib.h34
-rw-r--r--src/emacs-module.c1134
-rw-r--r--src/emacs-module.h215
-rw-r--r--src/emacs.c12
-rw-r--r--src/eval.c219
-rw-r--r--src/fileio.c11
-rw-r--r--src/fns.c24
-rw-r--r--src/font.h42
-rw-r--r--src/frame.c27
-rw-r--r--src/gmalloc.c36
-rw-r--r--src/indent.c11
-rw-r--r--src/insdel.c23
-rw-r--r--src/keyboard.c22
-rw-r--r--src/keyboard.h12
-rw-r--r--src/lisp.h152
-rw-r--r--src/lread.c87
-rw-r--r--src/macfont.m19
-rw-r--r--src/nsfns.m74
-rw-r--r--src/nsimage.m2
-rw-r--r--src/nsmenu.m8
-rw-r--r--src/nsterm.h176
-rw-r--r--src/nsterm.m522
-rw-r--r--src/print.c13
-rw-r--r--src/puresize.h20
-rw-r--r--src/regex.c18
-rw-r--r--src/syntax.c18
-rw-r--r--src/syntax.h14
-rw-r--r--src/undo.c69
-rw-r--r--src/unexelf.c11
-rw-r--r--src/w32.c13
-rw-r--r--src/w32.h6
-rw-r--r--src/w32console.c5
-rw-r--r--src/w32fns.c28
-rw-r--r--src/w32menu.c5
-rw-r--r--src/w32term.c46
-rw-r--r--src/w32term.h2
-rw-r--r--src/window.c34
-rw-r--r--src/xdisp.c110
-rw-r--r--src/xfns.c4
51 files changed, 3121 insertions, 712 deletions
diff --git a/src/ChangeLog.13 b/src/ChangeLog.13
index ac2162830c4..fd68f5370ad 100644
--- a/src/ChangeLog.13
+++ b/src/ChangeLog.13
@@ -8339,7 +8339,7 @@
8339 * emacs.c (main): Initialize daemon_pipe[1] here ... 8339 * emacs.c (main): Initialize daemon_pipe[1] here ...
8340 (syms_of_emacs): ... instead of here. 8340 (syms_of_emacs): ... instead of here.
8341 8341
83422014-02-16 Anders Lindgern <andlind@gmail.com> 83422014-02-16 Anders Lindgren <andlind@gmail.com>
8343 8343
8344 * nsterm.m (keyDown:): Check for normal key even if NSNumericPadKeyMask 8344 * nsterm.m (keyDown:): Check for normal key even if NSNumericPadKeyMask
8345 is set (Bug#16505). 8345 is set (Bug#16505).
@@ -16566,7 +16566,7 @@
16566 (ns_draw_fringe_bitmap): Remove unused rowY. 16566 (ns_draw_fringe_bitmap): Remove unused rowY.
16567 Change #if to COCOA && >= 10_6. 16567 Change #if to COCOA && >= 10_6.
16568 (ns_draw_window_cursor): Remove unused overspill. 16568 (ns_draw_window_cursor): Remove unused overspill.
16569 (ns_draw_underwave): width and x are EamcsCGFloat. 16569 (ns_draw_underwave): width and x are EmacsCGFloat.
16570 (ns_draw_box): thickness is CGFloat. 16570 (ns_draw_box): thickness is CGFloat.
16571 (ns_dumpglyphs_image): Change #if to COCOA && >= 10_6. 16571 (ns_dumpglyphs_image): Change #if to COCOA && >= 10_6.
16572 (ns_send_appdefined): When NS_IMPL_GNUSTEP, redirect to main thread 16572 (ns_send_appdefined): When NS_IMPL_GNUSTEP, redirect to main thread
diff --git a/src/Makefile.in b/src/Makefile.in
index d7ad3954579..f96ebb2aeeb 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -231,6 +231,11 @@ LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
231 231
232LIBZ = @LIBZ@ 232LIBZ = @LIBZ@
233 233
234## system-specific libs for dynamic modules, else empty
235LIBMODULES = @LIBMODULES@
236## dynlib.o emacs-module.o if modules enabled, else empty
237MODULES_OBJ = @MODULES_OBJ@
238
234XRANDR_LIBS = @XRANDR_LIBS@ 239XRANDR_LIBS = @XRANDR_LIBS@
235XRANDR_CFLAGS = @XRANDR_CFLAGS@ 240XRANDR_CFLAGS = @XRANDR_CFLAGS@
236 241
@@ -378,7 +383,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
378 minibuf.o fileio.o dired.o \ 383 minibuf.o fileio.o dired.o \
379 cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \ 384 cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \
380 alloc.o data.o doc.o editfns.o callint.o \ 385 alloc.o data.o doc.o editfns.o callint.o \
381 eval.o floatfns.o fns.o font.o print.o lread.o \ 386 eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \
382 syntax.o $(UNEXEC_OBJ) bytecode.o \ 387 syntax.o $(UNEXEC_OBJ) bytecode.o \
383 process.o gnutls.o callproc.o \ 388 process.o gnutls.o callproc.o \
384 region-cache.o sound.o atimer.o \ 389 region-cache.o sound.o atimer.o \
@@ -469,7 +474,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
469 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ 474 $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
470 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ 475 $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
471 $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \ 476 $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) \
472 $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) 477 $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES)
473 478
474$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT) 479$(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT)
475 $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)" 480 $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)"
@@ -482,6 +487,11 @@ $(srcdir)/macuvs.h $(lispsource)/international/charprop.el: \
482 bootstrap-emacs$(EXEEXT) FORCE 487 bootstrap-emacs$(EXEEXT) FORCE
483 $(MAKE) -C ../admin/unidata all EMACS="../$(bootstrap_exe)" 488 $(MAKE) -C ../admin/unidata all EMACS="../$(bootstrap_exe)"
484 489
490## We require charprop.el to exist before ucs-normalize.el is
491## byte-compiled, because ucs-normalize.el needs to load 2 uni-*.el files.
492$(lispsource)/international/ucs-normalize.elc: | \
493 $(lispsource)/international/charprop.el
494
485lispintdir = ${lispsource}/international 495lispintdir = ${lispsource}/international
486${lispintdir}/cp51932.el ${lispintdir}/eucjp-ms.el: FORCE 496${lispintdir}/cp51932.el ${lispintdir}/eucjp-ms.el: FORCE
487 ${MAKE} -C ../admin/charsets $(notdir $@) 497 ${MAKE} -C ../admin/charsets $(notdir $@)
diff --git a/src/alloc.c b/src/alloc.c
index bee7cd1758d..fe55cde49c9 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -406,24 +406,37 @@ ALIGN (void *ptr, int alignment)
406 If A is a symbol, extract the hidden pointer's offset from lispsym, 406 If A is a symbol, extract the hidden pointer's offset from lispsym,
407 converted to void *. */ 407 converted to void *. */
408 408
409static void * 409#define macro_XPNTR_OR_SYMBOL_OFFSET(a) \
410XPNTR_OR_SYMBOL_OFFSET (Lisp_Object a) 410 ((void *) (intptr_t) (USE_LSB_TAG ? XLI (a) - XTYPE (a) : XLI (a) & VALMASK))
411{
412 intptr_t i = USE_LSB_TAG ? XLI (a) - XTYPE (a) : XLI (a) & VALMASK;
413 return (void *) i;
414}
415 411
416/* Extract the pointer hidden within A. */ 412/* Extract the pointer hidden within A. */
417 413
418static void * 414#define macro_XPNTR(a) \
415 ((void *) ((intptr_t) XPNTR_OR_SYMBOL_OFFSET (a) \
416 + (SYMBOLP (a) ? (char *) lispsym : NULL)))
417
418/* For pointer access, define XPNTR and XPNTR_OR_SYMBOL_OFFSET as
419 functions, as functions are cleaner and can be used in debuggers.
420 Also, define them as macros if being compiled with GCC without
421 optimization, for performance in that case. The macro_* names are
422 private to this section of code. */
423
424static ATTRIBUTE_UNUSED void *
425XPNTR_OR_SYMBOL_OFFSET (Lisp_Object a)
426{
427 return macro_XPNTR_OR_SYMBOL_OFFSET (a);
428}
429static ATTRIBUTE_UNUSED void *
419XPNTR (Lisp_Object a) 430XPNTR (Lisp_Object a)
420{ 431{
421 void *p = XPNTR_OR_SYMBOL_OFFSET (a); 432 return macro_XPNTR (a);
422 if (SYMBOLP (a))
423 p = (intptr_t) p + (char *) lispsym;
424 return p;
425} 433}
426 434
435#if DEFINE_KEY_OPS_AS_MACROS
436# define XPNTR_OR_SYMBOL_OFFSET(a) macro_XPNTR_OR_SYMBOL_OFFSET (a)
437# define XPNTR(a) macro_XPNTR (a)
438#endif
439
427static void 440static void
428XFLOAT_INIT (Lisp_Object f, double n) 441XFLOAT_INIT (Lisp_Object f, double n)
429{ 442{
@@ -3711,6 +3724,23 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
3711 } 3724 }
3712} 3725}
3713 3726
3727#ifdef HAVE_MODULES
3728/* Create a new module user ptr object. */
3729Lisp_Object
3730make_user_ptr (void (*finalizer) (void*), void *p)
3731{
3732 Lisp_Object obj;
3733 struct Lisp_User_Ptr *uptr;
3734
3735 obj = allocate_misc (Lisp_Misc_User_Ptr);
3736 uptr = XUSER_PTR (obj);
3737 uptr->finalizer = finalizer;
3738 uptr->p = p;
3739 return obj;
3740}
3741
3742#endif
3743
3714static void 3744static void
3715init_finalizer_list (struct Lisp_Finalizer *head) 3745init_finalizer_list (struct Lisp_Finalizer *head)
3716{ 3746{
@@ -5300,10 +5330,6 @@ total_bytes_of_live_objects (void)
5300 5330
5301#ifdef HAVE_WINDOW_SYSTEM 5331#ifdef HAVE_WINDOW_SYSTEM
5302 5332
5303/* This code has a few issues on MS-Windows, see Bug#15876 and Bug#16140. */
5304
5305#if !defined (HAVE_NTGUI)
5306
5307/* Remove unmarked font-spec and font-entity objects from ENTRY, which is 5333/* Remove unmarked font-spec and font-entity objects from ENTRY, which is
5308 (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...), and return changed entry. */ 5334 (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...), and return changed entry. */
5309 5335
@@ -5318,11 +5344,15 @@ compact_font_cache_entry (Lisp_Object entry)
5318 Lisp_Object obj = XCAR (tail); 5344 Lisp_Object obj = XCAR (tail);
5319 5345
5320 /* Consider OBJ if it is (font-spec . [font-entity font-entity ...]). */ 5346 /* Consider OBJ if it is (font-spec . [font-entity font-entity ...]). */
5321 if (CONSP (obj) && FONT_SPEC_P (XCAR (obj)) 5347 if (CONSP (obj) && GC_FONT_SPEC_P (XCAR (obj))
5322 && !VECTOR_MARKED_P (XFONT_SPEC (XCAR (obj))) 5348 && !VECTOR_MARKED_P (GC_XFONT_SPEC (XCAR (obj)))
5323 && VECTORP (XCDR (obj))) 5349 /* Don't use VECTORP here, as that calls ASIZE, which could
5350 hit assertion violation during GC. */
5351 && (VECTORLIKEP (XCDR (obj))
5352 && ! (gc_asize (XCDR (obj)) & PSEUDOVECTOR_FLAG)))
5324 { 5353 {
5325 ptrdiff_t i, size = ASIZE (XCDR (obj)) & ~ARRAY_MARK_FLAG; 5354 ptrdiff_t i, size = gc_asize (XCDR (obj));
5355 Lisp_Object obj_cdr = XCDR (obj);
5326 5356
5327 /* If font-spec is not marked, most likely all font-entities 5357 /* If font-spec is not marked, most likely all font-entities
5328 are not marked too. But we must be sure that nothing is 5358 are not marked too. But we must be sure that nothing is
@@ -5331,14 +5361,14 @@ compact_font_cache_entry (Lisp_Object entry)
5331 { 5361 {
5332 Lisp_Object objlist; 5362 Lisp_Object objlist;
5333 5363
5334 if (VECTOR_MARKED_P (XFONT_ENTITY (AREF (XCDR (obj), i)))) 5364 if (VECTOR_MARKED_P (GC_XFONT_ENTITY (AREF (obj_cdr, i))))
5335 break; 5365 break;
5336 5366
5337 objlist = AREF (AREF (XCDR (obj), i), FONT_OBJLIST_INDEX); 5367 objlist = AREF (AREF (obj_cdr, i), FONT_OBJLIST_INDEX);
5338 for (; CONSP (objlist); objlist = XCDR (objlist)) 5368 for (; CONSP (objlist); objlist = XCDR (objlist))
5339 { 5369 {
5340 Lisp_Object val = XCAR (objlist); 5370 Lisp_Object val = XCAR (objlist);
5341 struct font *font = XFONT_OBJECT (val); 5371 struct font *font = GC_XFONT_OBJECT (val);
5342 5372
5343 if (!NILP (AREF (val, FONT_TYPE_INDEX)) 5373 if (!NILP (AREF (val, FONT_TYPE_INDEX))
5344 && VECTOR_MARKED_P(font)) 5374 && VECTOR_MARKED_P(font))
@@ -5366,8 +5396,6 @@ compact_font_cache_entry (Lisp_Object entry)
5366 return entry; 5396 return entry;
5367} 5397}
5368 5398
5369#endif /* not HAVE_NTGUI */
5370
5371/* Compact font caches on all terminals and mark 5399/* Compact font caches on all terminals and mark
5372 everything which is still here after compaction. */ 5400 everything which is still here after compaction. */
5373 5401
@@ -5379,7 +5407,6 @@ compact_font_caches (void)
5379 for (t = terminal_list; t; t = t->next_terminal) 5407 for (t = terminal_list; t; t = t->next_terminal)
5380 { 5408 {
5381 Lisp_Object cache = TERMINAL_FONT_CACHE (t); 5409 Lisp_Object cache = TERMINAL_FONT_CACHE (t);
5382#if !defined (HAVE_NTGUI)
5383 if (CONSP (cache)) 5410 if (CONSP (cache))
5384 { 5411 {
5385 Lisp_Object entry; 5412 Lisp_Object entry;
@@ -5387,7 +5414,6 @@ compact_font_caches (void)
5387 for (entry = XCDR (cache); CONSP (entry); entry = XCDR (entry)) 5414 for (entry = XCDR (cache); CONSP (entry); entry = XCDR (entry))
5388 XSETCAR (entry, compact_font_cache_entry (XCAR (entry))); 5415 XSETCAR (entry, compact_font_cache_entry (XCAR (entry)));
5389 } 5416 }
5390#endif /* not HAVE_NTGUI */
5391 mark_object (cache); 5417 mark_object (cache);
5392 } 5418 }
5393} 5419}
@@ -6301,6 +6327,12 @@ mark_object (Lisp_Object arg)
6301 mark_object (XFINALIZER (obj)->function); 6327 mark_object (XFINALIZER (obj)->function);
6302 break; 6328 break;
6303 6329
6330#ifdef HAVE_MODULES
6331 case Lisp_Misc_User_Ptr:
6332 XMISCANY (obj)->gcmarkbit = true;
6333 break;
6334#endif
6335
6304 default: 6336 default:
6305 emacs_abort (); 6337 emacs_abort ();
6306 } 6338 }
@@ -6677,8 +6709,15 @@ sweep_misc (void)
6677 { 6709 {
6678 if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker) 6710 if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
6679 unchain_marker (&mblk->markers[i].m.u_marker); 6711 unchain_marker (&mblk->markers[i].m.u_marker);
6680 if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer) 6712 else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
6681 unchain_finalizer (&mblk->markers[i].m.u_finalizer); 6713 unchain_finalizer (&mblk->markers[i].m.u_finalizer);
6714#ifdef HAVE_MODULES
6715 else if (mblk->markers[i].m.u_any.type == Lisp_Misc_User_Ptr)
6716 {
6717 struct Lisp_User_Ptr *uptr = &mblk->markers[i].m.u_user_ptr;
6718 uptr->finalizer (uptr->p);
6719 }
6720#endif
6682 /* Set the type of the freed object to Lisp_Misc_Free. 6721 /* Set the type of the freed object to Lisp_Misc_Free.
6683 We could leave the type alone, since nobody checks it, 6722 We could leave the type alone, since nobody checks it,
6684 but this might catch bugs faster. */ 6723 but this might catch bugs faster. */
diff --git a/src/bytecode.c b/src/bytecode.c
index 864db1a0bed..464adc633a8 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1067,17 +1067,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1067 type = CATCHER; 1067 type = CATCHER;
1068 goto pushhandler; 1068 goto pushhandler;
1069 CASE (Bpushconditioncase): /* New in 24.4. */ 1069 CASE (Bpushconditioncase): /* New in 24.4. */
1070 type = CONDITION_CASE;
1071 pushhandler:
1070 { 1072 {
1071 struct handler *c; 1073 Lisp_Object tag = POP;
1072 Lisp_Object tag; 1074 int dest = FETCH2;
1073 int dest;
1074 1075
1075 type = CONDITION_CASE; 1076 struct handler *c = push_handler (tag, type);
1076 pushhandler:
1077 tag = POP;
1078 dest = FETCH2;
1079
1080 PUSH_HANDLER (c, tag, type);
1081 c->bytecode_dest = dest; 1077 c->bytecode_dest = dest;
1082 c->bytecode_top = top; 1078 c->bytecode_top = top;
1083 1079
diff --git a/src/cmds.c b/src/cmds.c
index 167ebb74302..650b4628c32 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -233,7 +233,7 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */)
233 CHECK_NUMBER (n); 233 CHECK_NUMBER (n);
234 234
235 if (eabs (XINT (n)) < 2) 235 if (eabs (XINT (n)) < 2)
236 call0 (Qundo_auto__amalgamate); 236 call0 (Qundo_auto_amalgamate);
237 237
238 pos = PT + XINT (n); 238 pos = PT + XINT (n);
239 if (NILP (killflag)) 239 if (NILP (killflag))
@@ -279,7 +279,7 @@ At the end, it runs `post-self-insert-hook'. */)
279 error ("Negative repetition argument %"pI"d", XINT (n)); 279 error ("Negative repetition argument %"pI"d", XINT (n));
280 280
281 if (XFASTINT (n) < 2) 281 if (XFASTINT (n) < 2)
282 call0 (Qundo_auto__amalgamate); 282 call0 (Qundo_auto_amalgamate);
283 283
284 /* Barf if the key that invoked this was not a character. */ 284 /* Barf if the key that invoked this was not a character. */
285 if (!CHARACTERP (last_command_event)) 285 if (!CHARACTERP (last_command_event))
@@ -494,7 +494,7 @@ internal_self_insert (int c, EMACS_INT n)
494void 494void
495syms_of_cmds (void) 495syms_of_cmds (void)
496{ 496{
497 DEFSYM (Qundo_auto__amalgamate, "undo-auto--amalgamate"); 497 DEFSYM (Qundo_auto_amalgamate, "undo-auto-amalgamate");
498 DEFSYM (Qundo_auto__this_command_amalgamating, 498 DEFSYM (Qundo_auto__this_command_amalgamating,
499 "undo-auto--this-command-amalgamating"); 499 "undo-auto--this-command-amalgamating");
500 500
diff --git a/src/conf_post.h b/src/conf_post.h
index 2c3eee59b77..b629e8d3df7 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -245,6 +245,7 @@ extern int emacs_setenv_TZ (char const *);
245#endif 245#endif
246 246
247#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST 247#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
248#define ATTRIBUTE_UNUSED _GL_UNUSED
248 249
249#if 3 <= __GNUC__ 250#if 3 <= __GNUC__
250# define ATTRIBUTE_MALLOC __attribute__ ((__malloc__)) 251# define ATTRIBUTE_MALLOC __attribute__ ((__malloc__))
diff --git a/src/data.c b/src/data.c
index 51546044c68..1e9cc814f00 100644
--- a/src/data.c
+++ b/src/data.c
@@ -223,6 +223,10 @@ for example, (type-of 1) returns `integer'. */)
223 return Qfloat; 223 return Qfloat;
224 case Lisp_Misc_Finalizer: 224 case Lisp_Misc_Finalizer:
225 return Qfinalizer; 225 return Qfinalizer;
226#ifdef HAVE_MODULES
227 case Lisp_Misc_User_Ptr:
228 return Quser_ptr;
229#endif
226 default: 230 default:
227 emacs_abort (); 231 emacs_abort ();
228 } 232 }
@@ -424,6 +428,17 @@ DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
424 return Qnil; 428 return Qnil;
425} 429}
426 430
431#ifdef HAVE_MODULES
432DEFUN ("user-ptrp", Fuser_ptrp, Suser_ptrp, 1, 1, 0,
433 doc: /* Return t if OBJECT is a module user pointer. */)
434 (Lisp_Object object)
435{
436 if (USER_PTRP (object))
437 return Qt;
438 return Qnil;
439}
440#endif
441
427DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, 442DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
428 doc: /* Return t if OBJECT is a built-in function. */) 443 doc: /* Return t if OBJECT is a built-in function. */)
429 (Lisp_Object object) 444 (Lisp_Object object)
@@ -3478,6 +3493,9 @@ syms_of_data (void)
3478 DEFSYM (Qbool_vector_p, "bool-vector-p"); 3493 DEFSYM (Qbool_vector_p, "bool-vector-p");
3479 DEFSYM (Qchar_or_string_p, "char-or-string-p"); 3494 DEFSYM (Qchar_or_string_p, "char-or-string-p");
3480 DEFSYM (Qmarkerp, "markerp"); 3495 DEFSYM (Qmarkerp, "markerp");
3496#ifdef HAVE_MODULES
3497 DEFSYM (Quser_ptrp, "user-ptrp");
3498#endif
3481 DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p"); 3499 DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
3482 DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p"); 3500 DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
3483 DEFSYM (Qfboundp, "fboundp"); 3501 DEFSYM (Qfboundp, "fboundp");
@@ -3569,6 +3587,9 @@ syms_of_data (void)
3569 DEFSYM (Qmarker, "marker"); 3587 DEFSYM (Qmarker, "marker");
3570 DEFSYM (Qoverlay, "overlay"); 3588 DEFSYM (Qoverlay, "overlay");
3571 DEFSYM (Qfinalizer, "finalizer"); 3589 DEFSYM (Qfinalizer, "finalizer");
3590#ifdef HAVE_MODULES
3591 DEFSYM (Quser_ptr, "user-ptr");
3592#endif
3572 DEFSYM (Qfloat, "float"); 3593 DEFSYM (Qfloat, "float");
3573 DEFSYM (Qwindow_configuration, "window-configuration"); 3594 DEFSYM (Qwindow_configuration, "window-configuration");
3574 DEFSYM (Qprocess, "process"); 3595 DEFSYM (Qprocess, "process");
@@ -3683,6 +3704,9 @@ syms_of_data (void)
3683 defsubr (&Sbyteorder); 3704 defsubr (&Sbyteorder);
3684 defsubr (&Ssubr_arity); 3705 defsubr (&Ssubr_arity);
3685 defsubr (&Ssubr_name); 3706 defsubr (&Ssubr_name);
3707#ifdef HAVE_MODULES
3708 defsubr (&Suser_ptrp);
3709#endif
3686 3710
3687 defsubr (&Sbool_vector_exclusive_or); 3711 defsubr (&Sbool_vector_exclusive_or);
3688 defsubr (&Sbool_vector_union); 3712 defsubr (&Sbool_vector_union);
diff --git a/src/dired.c b/src/dired.c
index 84bf2472262..6c34dfdfcb0 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -467,6 +467,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
467 well as "." and "..". Until shown otherwise, assume we can't exclude 467 well as "." and "..". Until shown otherwise, assume we can't exclude
468 anything. */ 468 anything. */
469 bool includeall = 1; 469 bool includeall = 1;
470 bool check_decoded = false;
470 ptrdiff_t count = SPECPDL_INDEX (); 471 ptrdiff_t count = SPECPDL_INDEX ();
471 472
472 elt = Qnil; 473 elt = Qnil;
@@ -485,6 +486,28 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
485 on the encoded file name. */ 486 on the encoded file name. */
486 encoded_file = ENCODE_FILE (file); 487 encoded_file = ENCODE_FILE (file);
487 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname)); 488 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
489
490 Lisp_Object file_encoding = Vfile_name_coding_system;
491 if (NILP (Vfile_name_coding_system))
492 file_encoding = Vdefault_file_name_coding_system;
493 /* If the file-name encoding decomposes characters, as we do for
494 HFS+ filesystems, we need to make an additional comparison of
495 decoded names in order to filter false positives, such as "a"
496 falsely matching "a-ring". */
497 if (!NILP (file_encoding)
498 && !NILP (Fplist_get (Fcoding_system_plist (file_encoding),
499 Qdecomposed_characters)))
500 {
501 check_decoded = true;
502 if (STRING_MULTIBYTE (file))
503 {
504 /* Recompute FILE to make sure any decomposed characters in
505 it are re-composed by the post-read-conversion.
506 Otherwise, any decomposed characters will be rejected by
507 the additional check below. */
508 file = DECODE_FILE (encoded_file);
509 }
510 }
488 int fd; 511 int fd;
489 DIR *d = open_directory (encoded_dir, &fd); 512 DIR *d = open_directory (encoded_dir, &fd);
490 record_unwind_protect_ptr (directory_files_internal_unwind, d); 513 record_unwind_protect_ptr (directory_files_internal_unwind, d);
@@ -637,6 +660,23 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
637 if (!NILP (predicate) && NILP (call1 (predicate, name))) 660 if (!NILP (predicate) && NILP (call1 (predicate, name)))
638 continue; 661 continue;
639 662
663 /* Reject entries where the encoded strings match, but the
664 decoded don't. For example, "a" should not match "a-ring" on
665 file systems that store decomposed characters. */
666 Lisp_Object zero = make_number (0);
667
668 if (check_decoded && SCHARS (file) <= SCHARS (name))
669 {
670 /* FIXME: This is a copy of the code below. */
671 ptrdiff_t compare = SCHARS (file);
672 Lisp_Object cmp
673 = Fcompare_strings (name, zero, make_number (compare),
674 file, zero, make_number (compare),
675 completion_ignore_case ? Qt : Qnil);
676 if (!EQ (cmp, Qt))
677 continue;
678 }
679
640 /* Suitably record this match. */ 680 /* Suitably record this match. */
641 681
642 matchcount += matchcount <= 1; 682 matchcount += matchcount <= 1;
@@ -650,14 +690,11 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
650 } 690 }
651 else 691 else
652 { 692 {
653 Lisp_Object zero = make_number (0);
654 /* FIXME: This is a copy of the code in Ftry_completion. */ 693 /* FIXME: This is a copy of the code in Ftry_completion. */
655 ptrdiff_t compare = min (bestmatchsize, SCHARS (name)); 694 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
656 Lisp_Object cmp 695 Lisp_Object cmp
657 = Fcompare_strings (bestmatch, zero, 696 = Fcompare_strings (bestmatch, zero, make_number (compare),
658 make_number (compare), 697 name, zero, make_number (compare),
659 name, zero,
660 make_number (compare),
661 completion_ignore_case ? Qt : Qnil); 698 completion_ignore_case ? Qt : Qnil);
662 ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1; 699 ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
663 700
@@ -1007,6 +1044,7 @@ syms_of_dired (void)
1007 DEFSYM (Qfile_attributes, "file-attributes"); 1044 DEFSYM (Qfile_attributes, "file-attributes");
1008 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp"); 1045 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1009 DEFSYM (Qdefault_directory, "default-directory"); 1046 DEFSYM (Qdefault_directory, "default-directory");
1047 DEFSYM (Qdecomposed_characters, "decomposed-characters");
1010 1048
1011 defsubr (&Sdirectory_files); 1049 defsubr (&Sdirectory_files);
1012 defsubr (&Sdirectory_files_and_attributes); 1050 defsubr (&Sdirectory_files_and_attributes);
diff --git a/src/dispnew.c b/src/dispnew.c
index 64c84aec6f9..1d30eee2082 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -6206,10 +6206,10 @@ It is up to you to set this variable if your terminal can do that. */);
6206 doc: /* Name of the window system that Emacs uses for the first frame. 6206 doc: /* Name of the window system that Emacs uses for the first frame.
6207The value is a symbol: 6207The value is a symbol:
6208 nil for a termcap frame (a character-only terminal), 6208 nil for a termcap frame (a character-only terminal),
6209 'x' for an Emacs frame that is really an X window, 6209 `x' for an Emacs frame that is really an X window,
6210 'w32' for an Emacs frame that is a window on MS-Windows display, 6210 `w32' for an Emacs frame that is a window on MS-Windows display,
6211 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, 6211 `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
6212 'pc' for a direct-write MS-DOS frame. 6212 `pc' for a direct-write MS-DOS frame.
6213 6213
6214Use of this variable as a boolean is deprecated. Instead, 6214Use of this variable as a boolean is deprecated. Instead,
6215use `display-graphic-p' or any of the other `display-*-p' 6215use `display-graphic-p' or any of the other `display-*-p'
@@ -6219,10 +6219,10 @@ predicates which report frame's specific UI-related capabilities. */);
6219 doc: /* Name of window system through which the selected frame is displayed. 6219 doc: /* Name of window system through which the selected frame is displayed.
6220The value is a symbol: 6220The value is a symbol:
6221 nil for a termcap frame (a character-only terminal), 6221 nil for a termcap frame (a character-only terminal),
6222 'x' for an Emacs frame that is really an X window, 6222 `x' for an Emacs frame that is really an X window,
6223 'w32' for an Emacs frame that is a window on MS-Windows display, 6223 `w32' for an Emacs frame that is a window on MS-Windows display,
6224 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, 6224 `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
6225 'pc' for a direct-write MS-DOS frame. 6225 `pc' for a direct-write MS-DOS frame.
6226 6226
6227Use of this variable as a boolean is deprecated. Instead, 6227Use of this variable as a boolean is deprecated. Instead,
6228use `display-graphic-p' or any of the other `display-*-p' 6228use `display-graphic-p' or any of the other `display-*-p'
diff --git a/src/doc.c b/src/doc.c
index 694c159fc09..6c2a3e52a2e 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -1023,7 +1023,8 @@ syms_of_doc (void)
1023 Vbuild_files = Qnil; 1023 Vbuild_files = Qnil;
1024 1024
1025 DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style, 1025 DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style,
1026 doc: /* Style to use for single quotes when generating text. 1026 doc: /* Style to use for single quotes in help and messages.
1027Its value should be a symbol.
1027`curve' means quote with curved single quotes \\=‘like this\\=’. 1028`curve' means quote with curved single quotes \\=‘like this\\=’.
1028`straight' means quote with straight apostrophes \\='like this\\='. 1029`straight' means quote with straight apostrophes \\='like this\\='.
1029`grave' means quote with grave accent and apostrophe \\=`like this\\='. 1030`grave' means quote with grave accent and apostrophe \\=`like this\\='.
diff --git a/src/doprnt.c b/src/doprnt.c
index 51f8fd72ba0..55f249f5d72 100644
--- a/src/doprnt.c
+++ b/src/doprnt.c
@@ -500,7 +500,7 @@ esprintf (char *buf, char const *format, ...)
500 return nbytes; 500 return nbytes;
501} 501}
502 502
503#if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT 503#if HAVE_MODULES || (defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT)
504 504
505/* Format to buffer *BUF of positive size *BUFSIZE, reallocating *BUF 505/* Format to buffer *BUF of positive size *BUFSIZE, reallocating *BUF
506 and updating *BUFSIZE if the buffer is too small, and otherwise 506 and updating *BUFSIZE if the buffer is too small, and otherwise
diff --git a/src/dynlib.c b/src/dynlib.c
new file mode 100644
index 00000000000..190f183fa61
--- /dev/null
+++ b/src/dynlib.c
@@ -0,0 +1,330 @@
1/* Portable API for dynamic loading.
2
3Copyright 2015 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20
21/* Assume modules are enabled on modern systems... *Yes*, the
22 preprocessor macro checks could be more precise. I don't care.
23
24 If you think the abstraction is too leaky use libltdl (libtool),
25 don't reinvent the wheel by fixing this one. */
26
27#include <config.h>
28
29#include "dynlib.h"
30
31#ifdef WINDOWSNT
32
33/* MS-Windows systems. */
34
35#include <errno.h>
36#include "lisp.h"
37#include "w32common.h" /* for os_subtype */
38#include "w32.h"
39
40static BOOL g_b_init_get_module_handle_ex;
41static DWORD dynlib_last_err;
42
43/* Some versions of w32api headers only expose the following when
44 _WIN32_WINNT is set to higher values that we use. */
45typedef BOOL (WINAPI *GetModuleHandleExA_Proc) (DWORD,LPCSTR,HMODULE*);
46#ifndef GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS
47# define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 4
48#endif
49#ifndef GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT
50# define GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT 2
51#endif
52
53/* This needs to be called at startup to countermand any non-zero
54 values recorded by temacs. */
55void
56dynlib_reset_last_error (void)
57{
58 g_b_init_get_module_handle_ex = 0;
59 dynlib_last_err = 0;
60}
61
62dynlib_handle_ptr
63dynlib_open (const char *dll_fname)
64{
65 HMODULE hdll;
66 char dll_fname_local[MAX_UTF8_PATH];
67
68 if (!dll_fname)
69 {
70 errno = ENOTSUP;
71 return NULL;
72 }
73
74 if (!dll_fname)
75 hdll = GetModuleHandle (NULL);
76 else
77 {
78 /* LoadLibrary wants backslashes. */
79 strcpy (dll_fname_local, dll_fname);
80 unixtodos_filename (dll_fname_local);
81
82 if (w32_unicode_filenames)
83 {
84 wchar_t dll_fname_w[MAX_PATH];
85
86 filename_to_utf16 (dll_fname_local, dll_fname_w);
87 hdll = LoadLibraryW (dll_fname_w);
88 }
89 else
90 {
91 char dll_fname_a[MAX_PATH];
92
93 filename_to_ansi (dll_fname_local, dll_fname_a);
94 hdll = LoadLibraryA (dll_fname_a);
95 }
96 }
97
98 if (!hdll)
99 dynlib_last_err = GetLastError ();
100
101 return (dynlib_handle_ptr) hdll;
102}
103
104void *
105dynlib_sym (dynlib_handle_ptr h, const char *sym)
106{
107 FARPROC sym_addr = NULL;
108
109 if (!h || h == INVALID_HANDLE_VALUE || !sym)
110 {
111 dynlib_last_err = ERROR_INVALID_PARAMETER;
112 return NULL;
113 }
114
115 sym_addr = GetProcAddress ((HMODULE) h, sym);
116 if (!sym_addr)
117 dynlib_last_err = GetLastError ();
118
119 return (void *)sym_addr;
120}
121
122bool
123dynlib_addr (void *addr, const char **fname, const char **symname)
124{
125 static char dll_filename[MAX_UTF8_PATH];
126 static char addr_str[22];
127 static GetModuleHandleExA_Proc s_pfn_Get_Module_HandleExA = NULL;
128 char *dll_fn = NULL;
129 HMODULE hm_kernel32 = NULL;
130 bool result = false;
131 HMODULE hm_dll = NULL;
132 wchar_t mfn_w[MAX_PATH];
133 char mfn_a[MAX_PATH];
134
135 /* Step 1: Find the handle of the module where ADDR lives. */
136 if (os_subtype == OS_9X
137 /* Windows NT family version before XP (v5.1). */
138 || ((w32_major_version + (w32_minor_version > 0)) < 6))
139 {
140 MEMORY_BASIC_INFORMATION mbi;
141
142 /* According to Matt Pietrek, the module handle is just the base
143 address where it's loaded in memory. */
144 if (VirtualQuery (addr, &mbi, sizeof(mbi)))
145 hm_dll = (HMODULE)mbi.AllocationBase;
146 }
147 else
148 {
149 /* Use the documented API when available (XP and later). */
150 if (g_b_init_get_module_handle_ex == 0)
151 {
152 g_b_init_get_module_handle_ex = 1;
153 hm_kernel32 = LoadLibrary ("kernel32.dll");
154 /* We load the ANSI version of the function because the
155 address we pass to it is not an address of a string, but
156 an address of a function. So we don't care about the
157 Unicode version. */
158 s_pfn_Get_Module_HandleExA =
159 (GetModuleHandleExA_Proc) GetProcAddress (hm_kernel32,
160 "GetModuleHandleExA");
161 }
162 if (s_pfn_Get_Module_HandleExA)
163 {
164 DWORD flags = (GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS
165 /* We don't want to call FreeLibrary at the
166 end, because then we'd need to remember
167 whether we obtained the handle by this
168 method or the above one. */
169 | GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT);
170
171 if (!s_pfn_Get_Module_HandleExA (flags, addr, &hm_dll))
172 {
173 dynlib_last_err = GetLastError ();
174 hm_dll = NULL;
175 }
176 }
177 }
178
179 /* Step 2: Find the absolute file name of the module corresponding
180 to the hm_dll handle. */
181 if (hm_dll)
182 {
183 DWORD retval;
184
185 if (w32_unicode_filenames)
186 {
187 retval = GetModuleFileNameW (hm_dll, mfn_w, MAX_PATH);
188 if (retval > 0 && retval < MAX_PATH
189 && filename_from_utf16 (mfn_w, dll_filename) == 0)
190 dll_fn = dll_filename;
191 else if (retval == MAX_PATH)
192 dynlib_last_err = ERROR_INSUFFICIENT_BUFFER;
193 else
194 dynlib_last_err = GetLastError ();
195 }
196 else
197 {
198 retval = GetModuleFileNameA (hm_dll, mfn_a, MAX_PATH);
199 if (retval > 0 && retval < MAX_PATH
200 && filename_from_ansi (mfn_a, dll_filename) == 0)
201 dll_fn = dll_filename;
202 else if (retval == MAX_PATH)
203 dynlib_last_err = ERROR_INSUFFICIENT_BUFFER;
204 else
205 dynlib_last_err = GetLastError ();
206 }
207 if (dll_fn)
208 {
209 dostounix_filename (dll_fn);
210 /* We cannot easily produce the function name, since
211 typically all of the module functions will be unexported,
212 and probably even static, which means the symbols can be
213 obtained only if we link against libbfd (and the DLL can
214 be stripped anyway). So we just show the address and the
215 file name; they can use that with addr2line or GDB to
216 recover the symbolic name. */
217 sprintf (addr_str, "at 0x%x", (DWORD_PTR)addr);
218 *symname = addr_str;
219 result = true;
220 }
221 }
222
223 *fname = dll_fn;
224 return result;
225}
226
227const char *
228dynlib_error (void)
229{
230 char *error_string = NULL;
231
232 if (dynlib_last_err)
233 {
234 error_string = w32_strerror (dynlib_last_err);
235 dynlib_last_err = 0;
236 }
237
238 return error_string;
239}
240
241int
242dynlib_close (dynlib_handle_ptr h)
243{
244 if (!h || h == INVALID_HANDLE_VALUE)
245 {
246 dynlib_last_err = ERROR_INVALID_PARAMETER;
247 return -1;
248 }
249 /* If the handle is for the main module (the .exe file), it
250 shouldn't be passed to FreeLibrary, because GetModuleHandle
251 doesn't increment the refcount, but FreeLibrary does decrement
252 it. I don't think this should matter for the main module, but
253 just in case, we avoid the call here, relying on another call to
254 GetModuleHandle to return the same value. */
255 if (h == GetModuleHandle (NULL))
256 return 0;
257
258 if (!FreeLibrary ((HMODULE) h))
259 {
260 dynlib_last_err = GetLastError ();
261 return -1;
262 }
263
264 return 0;
265}
266
267#elif defined HAVE_UNISTD_H
268
269/* POSIX systems. */
270
271#include <dlfcn.h>
272
273dynlib_handle_ptr
274dynlib_open (const char *path)
275{
276 return dlopen (path, RTLD_LAZY);
277}
278
279void *
280dynlib_sym (dynlib_handle_ptr h, const char *sym)
281{
282 return dlsym (h, sym);
283}
284
285bool
286dynlib_addr (void *ptr, const char **path, const char **sym)
287{
288#ifdef HAVE_DLADDR
289 Dl_info info;
290 if (dladdr (ptr, &info) && info.dli_fname && info.dli_sname)
291 {
292 *path = info.dli_fname;
293 *sym = info.dli_sname;
294 return true;
295 }
296#endif
297 return false;
298}
299
300const char *
301dynlib_error (void)
302{
303 return dlerror ();
304}
305
306/* FIXME: Currently there is no way to unload a module, so this
307 function is never used. */
308#if false
309int
310dynlib_close (dynlib_handle_ptr h)
311{
312 return dlclose (h) == 0;
313}
314#endif
315
316#else
317
318#error "No dynamic loading for this system"
319
320#endif
321
322#if !HAVE_DLFUNC
323# define dlfunc dynlib_sym
324#endif
325
326dynlib_function_ptr
327dynlib_func (dynlib_handle_ptr h, const char *sym)
328{
329 return (dynlib_function_ptr) dlfunc (h, sym);
330}
diff --git a/src/dynlib.h b/src/dynlib.h
new file mode 100644
index 00000000000..1c19b5db8ac
--- /dev/null
+++ b/src/dynlib.h
@@ -0,0 +1,34 @@
1/* Portable API for dynamic loading.
2
3Copyright 2015 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20#ifndef DYNLIB_H
21#define DYNLIB_H
22
23#include <stdbool.h>
24
25typedef void *dynlib_handle_ptr;
26dynlib_handle_ptr dynlib_open (const char *path);
27void *dynlib_sym (dynlib_handle_ptr h, const char *sym);
28typedef struct dynlib_function_ptr_nonce *(*dynlib_function_ptr) (void);
29dynlib_function_ptr dynlib_func (dynlib_handle_ptr h, const char *sym);
30bool dynlib_addr (void *ptr, const char **path, const char **sym);
31const char *dynlib_error (void);
32int dynlib_close (dynlib_handle_ptr h);
33
34#endif /* DYNLIB_H */
diff --git a/src/emacs-module.c b/src/emacs-module.c
new file mode 100644
index 00000000000..881ee3119de
--- /dev/null
+++ b/src/emacs-module.c
@@ -0,0 +1,1134 @@
1/* emacs-module.c - Module loading and runtime implementation
2
3Copyright (C) 2015 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20#include <config.h>
21
22#include "emacs-module.h"
23
24#include <stdbool.h>
25#include <stddef.h>
26#include <stdint.h>
27#include <stdio.h>
28#include <string.h>
29
30#include "lisp.h"
31#include "dynlib.h"
32#include "coding.h"
33#include "verify.h"
34
35
36/* Feature tests. */
37
38/* True if __attribute__ ((cleanup (...))) works, false otherwise. */
39#ifdef HAVE_VAR_ATTRIBUTE_CLEANUP
40enum { module_has_cleanup = true };
41#else
42enum { module_has_cleanup = false };
43#endif
44
45/* Handle to the main thread. Used to verify that modules call us in
46 the right thread. */
47#ifdef HAVE_PTHREAD
48# include <pthread.h>
49static pthread_t main_thread;
50#elif defined WINDOWSNT
51#include <windows.h>
52#include "w32term.h"
53static DWORD main_thread;
54#endif
55
56/* True if Lisp_Object and emacs_value have the same representation.
57 This is typically true unless WIDE_EMACS_INT. In practice, having
58 the same sizes and alignments and maximums should be a good enough
59 proxy for equality of representation. */
60enum
61 {
62 plain_values
63 = (sizeof (Lisp_Object) == sizeof (emacs_value)
64 && alignof (Lisp_Object) == alignof (emacs_value)
65 && INTPTR_MAX == EMACS_INT_MAX)
66 };
67
68
69/* Private runtime and environment members. */
70
71/* The private part of an environment stores the current non local exit state
72 and holds the `emacs_value' objects allocated during the lifetime
73 of the environment. */
74struct emacs_env_private
75{
76 enum emacs_funcall_exit pending_non_local_exit;
77
78 /* Dedicated storage for non-local exit symbol and data so that
79 storage is always available for them, even in an out-of-memory
80 situation. */
81 Lisp_Object non_local_exit_symbol, non_local_exit_data;
82};
83
84/* The private parts of an `emacs_runtime' object contain the initial
85 environment. */
86struct emacs_runtime_private
87{
88 /* FIXME: Ideally, we would just define "struct emacs_runtime_private"
89 as a synonym of "emacs_env", but I don't know how to do that in C. */
90 emacs_env pub;
91};
92
93
94/* Forward declarations. */
95
96struct module_fun_env;
97
98static Lisp_Object module_format_fun_env (const struct module_fun_env *);
99static Lisp_Object value_to_lisp (emacs_value);
100static emacs_value lisp_to_value (Lisp_Object);
101static enum emacs_funcall_exit module_non_local_exit_check (emacs_env *);
102static void check_main_thread (void);
103static void finalize_environment (struct emacs_env_private *);
104static void initialize_environment (emacs_env *, struct emacs_env_private *priv);
105static void module_args_out_of_range (emacs_env *, Lisp_Object, Lisp_Object);
106static void module_handle_signal (emacs_env *, Lisp_Object);
107static void module_handle_throw (emacs_env *, Lisp_Object);
108static void module_non_local_exit_signal_1 (emacs_env *, Lisp_Object, Lisp_Object);
109static void module_non_local_exit_throw_1 (emacs_env *, Lisp_Object, Lisp_Object);
110static void module_out_of_memory (emacs_env *);
111static void module_reset_handlerlist (const int *);
112static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object);
113
114/* We used to return NULL when emacs_value was a different type from
115 Lisp_Object, but nowadays we just use Qnil instead. Although they
116 happen to be the same thing in the current implementation, module
117 code should not assume this. */
118verify (NIL_IS_ZERO);
119static emacs_value const module_nil = 0;
120
121/* Convenience macros for non-local exit handling. */
122
123/* FIXME: The following implementation for non-local exit handling
124 does not support recovery from stack overflow, see sysdep.c. */
125
126/* Emacs uses setjmp and longjmp for non-local exits, but
127 module frames cannot be skipped because they are in general
128 not prepared for long jumps (e.g., the behavior in C++ is undefined
129 if objects with nontrivial destructors would be skipped).
130 Therefore, catch all non-local exits. There are two kinds of
131 non-local exits: `signal' and `throw'. The macros in this section
132 can be used to catch both. Use macros to avoid additional variants
133 of `internal_condition_case' etc., and to avoid worrying about
134 passing information to the handler functions. */
135
136/* Place this macro at the beginning of a function returning a number
137 or a pointer to handle non-local exits. The function must have an
138 ENV parameter. The function will return the specified value if a
139 signal or throw is caught. */
140// TODO: Have Fsignal check for CATCHER_ALL so we only have to install
141// one handler.
142#define MODULE_HANDLE_NONLOCAL_EXIT(retval) \
143 MODULE_SETJMP (CONDITION_CASE, module_handle_signal, retval); \
144 MODULE_SETJMP (CATCHER_ALL, module_handle_throw, retval)
145
146#define MODULE_SETJMP(handlertype, handlerfunc, retval) \
147 MODULE_SETJMP_1 (handlertype, handlerfunc, retval, \
148 internal_handler_##handlertype, \
149 internal_cleanup_##handlertype)
150
151/* It is very important that pushing the handler doesn't itself raise
152 a signal. Install the cleanup only after the handler has been
153 pushed. Use __attribute__ ((cleanup)) to avoid
154 non-local-exit-prone manual cleanup.
155
156 The do-while forces uses of the macro to be followed by a semicolon.
157 This macro cannot enclose its entire body inside a do-while, as the
158 code after the macro may longjmp back into the macro, which means
159 its local variable C must stay live in later code. */
160
161// TODO: Make backtraces work if this macros is used.
162
163#define MODULE_SETJMP_1(handlertype, handlerfunc, retval, c, dummy) \
164 if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
165 return retval; \
166 struct handler *c = push_handler_nosignal (Qt, handlertype); \
167 if (!c) \
168 { \
169 module_out_of_memory (env); \
170 return retval; \
171 } \
172 verify (module_has_cleanup); \
173 int dummy __attribute__ ((cleanup (module_reset_handlerlist))); \
174 if (sys_setjmp (c->jmp)) \
175 { \
176 (handlerfunc) (env, c->val); \
177 return retval; \
178 } \
179 do { } while (false)
180
181
182/* Function environments. */
183
184/* A function environment is an auxiliary structure used by
185 `module_make_function' to store information about a module
186 function. It is stored in a save pointer and retrieved by
187 `internal--module-call'. Its members correspond to the arguments
188 given to `module_make_function'. */
189
190struct module_fun_env
191{
192 ptrdiff_t min_arity, max_arity;
193 emacs_subr subr;
194 void *data;
195};
196
197
198/* Implementation of runtime and environment functions.
199
200 These should abide by the following rules:
201
202 1. The first argument should always be a pointer to emacs_env.
203
204 2. Each function should first call check_main_thread. Note that
205 this function is a no-op unless Emacs was built with
206 --enable-checking.
207
208 3. The very next thing each function should do is check that the
209 emacs_env object does not have a non-local exit indication set,
210 by calling module_non_local_exit_check. If that returns
211 anything but emacs_funcall_exit_return, the function should do
212 nothing and return immediately with an error indication, without
213 clobbering the existing error indication in emacs_env. This is
214 needed for correct reporting of Lisp errors to the Emacs Lisp
215 interpreter.
216
217 4. Any function that needs to call Emacs facilities, such as
218 encoding or decoding functions, or 'intern', or 'make_string',
219 should protect itself from signals and 'throw' in the called
220 Emacs functions, by placing the macro
221 MODULE_HANDLE_NONLOCAL_EXIT right after the above 2 tests.
222
223 5. Do NOT use 'eassert' for checking validity of user code in the
224 module. Instead, make those checks part of the code, and if the
225 check fails, call 'module_non_local_exit_signal_1' or
226 'module_non_local_exit_throw_1' to report the error. This is
227 because using 'eassert' in these situations will abort Emacs
228 instead of reporting the error back to Lisp, and also because
229 'eassert' is compiled to nothing in the release version. */
230
231/* Use MODULE_FUNCTION_BEGIN to implement steps 2 through 4 for most
232 environment functions. On error it will return its argument, which
233 should be a sentinel value. */
234
235#define MODULE_FUNCTION_BEGIN(error_retval) \
236 check_main_thread (); \
237 if (module_non_local_exit_check (env) != emacs_funcall_exit_return) \
238 return error_retval; \
239 MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
240
241/* Catch signals and throws only if the code can actually signal or
242 throw. If checking is enabled, abort if the current thread is not
243 the Emacs main thread. */
244
245static emacs_env *
246module_get_environment (struct emacs_runtime *ert)
247{
248 check_main_thread ();
249 return &ert->private_members->pub;
250}
251
252/* To make global refs (GC-protected global values) keep a hash that
253 maps global Lisp objects to reference counts. */
254
255static emacs_value
256module_make_global_ref (emacs_env *env, emacs_value ref)
257{
258 MODULE_FUNCTION_BEGIN (module_nil);
259 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
260 Lisp_Object new_obj = value_to_lisp (ref);
261 EMACS_UINT hashcode;
262 ptrdiff_t i = hash_lookup (h, new_obj, &hashcode);
263
264 if (i >= 0)
265 {
266 Lisp_Object value = HASH_VALUE (h, i);
267 EMACS_INT refcount = XFASTINT (value) + 1;
268 if (refcount > MOST_POSITIVE_FIXNUM)
269 {
270 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
271 return module_nil;
272 }
273 value = make_natnum (refcount);
274 set_hash_value_slot (h, i, value);
275 }
276 else
277 {
278 hash_put (h, new_obj, make_natnum (1), hashcode);
279 }
280
281 return lisp_to_value (new_obj);
282}
283
284static void
285module_free_global_ref (emacs_env *env, emacs_value ref)
286{
287 /* TODO: This probably never signals. */
288 /* FIXME: Wait a minute. Shouldn't this function report an error if
289 the hash lookup fails? */
290 MODULE_FUNCTION_BEGIN ();
291 struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
292 Lisp_Object obj = value_to_lisp (ref);
293 EMACS_UINT hashcode;
294 ptrdiff_t i = hash_lookup (h, obj, &hashcode);
295
296 if (i >= 0)
297 {
298 Lisp_Object value = HASH_VALUE (h, i);
299 EMACS_INT refcount = XFASTINT (value) - 1;
300 if (refcount > 0)
301 {
302 value = make_natnum (refcount);
303 set_hash_value_slot (h, i, value);
304 }
305 else
306 hash_remove_from_table (h, value);
307 }
308}
309
310static enum emacs_funcall_exit
311module_non_local_exit_check (emacs_env *env)
312{
313 check_main_thread ();
314 return env->private_members->pending_non_local_exit;
315}
316
317static void
318module_non_local_exit_clear (emacs_env *env)
319{
320 check_main_thread ();
321 env->private_members->pending_non_local_exit = emacs_funcall_exit_return;
322}
323
324static enum emacs_funcall_exit
325module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data)
326{
327 check_main_thread ();
328 struct emacs_env_private *p = env->private_members;
329 if (p->pending_non_local_exit != emacs_funcall_exit_return)
330 {
331 /* FIXME: lisp_to_value can exit non-locally. */
332 *sym = lisp_to_value (p->non_local_exit_symbol);
333 *data = lisp_to_value (p->non_local_exit_data);
334 }
335 return p->pending_non_local_exit;
336}
337
338/* Like for `signal', DATA must be a list. */
339static void
340module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data)
341{
342 check_main_thread ();
343 if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
344 module_non_local_exit_signal_1 (env, value_to_lisp (sym),
345 value_to_lisp (data));
346}
347
348static void
349module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value)
350{
351 check_main_thread ();
352 if (module_non_local_exit_check (env) == emacs_funcall_exit_return)
353 module_non_local_exit_throw_1 (env, value_to_lisp (tag),
354 value_to_lisp (value));
355}
356
357/* A module function is lambda function that calls
358 `internal--module-call', passing the function pointer of the module
359 function along with the module emacs_env pointer as arguments.
360
361 (function (lambda (&rest arglist)
362 (internal--module-call envobj arglist))) */
363
364static emacs_value
365module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
366 emacs_subr subr, const char *documentation,
367 void *data)
368{
369 MODULE_FUNCTION_BEGIN (module_nil);
370
371 if (! (0 <= min_arity
372 && (max_arity < 0
373 ? max_arity == emacs_variadic_function
374 : min_arity <= max_arity)))
375 xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity));
376
377 /* FIXME: This should be freed when envobj is GC'd. */
378 struct module_fun_env *envptr = xmalloc (sizeof *envptr);
379 envptr->min_arity = min_arity;
380 envptr->max_arity = max_arity;
381 envptr->subr = subr;
382 envptr->data = data;
383
384 Lisp_Object envobj = make_save_ptr (envptr);
385 Lisp_Object doc
386 = (documentation
387 ? code_convert_string_norecord (build_unibyte_string (documentation),
388 Qutf_8, false)
389 : Qnil);
390 /* FIXME: Use a bytecompiled object, or even better a subr. */
391 Lisp_Object ret = list4 (Qlambda,
392 list2 (Qand_rest, Qargs),
393 doc,
394 list4 (Qapply,
395 list2 (Qfunction, Qinternal_module_call),
396 envobj,
397 Qargs));
398
399 return lisp_to_value (ret);
400}
401
402static emacs_value
403module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs,
404 emacs_value args[])
405{
406 MODULE_FUNCTION_BEGIN (module_nil);
407
408 /* Make a new Lisp_Object array starting with the function as the
409 first arg, because that's what Ffuncall takes. */
410 Lisp_Object *newargs;
411 USE_SAFE_ALLOCA;
412 SAFE_ALLOCA_LISP (newargs, nargs + 1);
413 newargs[0] = value_to_lisp (fun);
414 for (ptrdiff_t i = 0; i < nargs; i++)
415 newargs[1 + i] = value_to_lisp (args[i]);
416 emacs_value result = lisp_to_value (Ffuncall (nargs + 1, newargs));
417 SAFE_FREE ();
418 return result;
419}
420
421static emacs_value
422module_intern (emacs_env *env, const char *name)
423{
424 MODULE_FUNCTION_BEGIN (module_nil);
425 return lisp_to_value (intern (name));
426}
427
428static emacs_value
429module_type_of (emacs_env *env, emacs_value value)
430{
431 MODULE_FUNCTION_BEGIN (module_nil);
432 return lisp_to_value (Ftype_of (value_to_lisp (value)));
433}
434
435static bool
436module_is_not_nil (emacs_env *env, emacs_value value)
437{
438 check_main_thread ();
439 if (module_non_local_exit_check (env) != emacs_funcall_exit_return)
440 return false;
441 return ! NILP (value_to_lisp (value));
442}
443
444static bool
445module_eq (emacs_env *env, emacs_value a, emacs_value b)
446{
447 check_main_thread ();
448 if (module_non_local_exit_check (env) != emacs_funcall_exit_return)
449 return false;
450 return EQ (value_to_lisp (a), value_to_lisp (b));
451}
452
453static intmax_t
454module_extract_integer (emacs_env *env, emacs_value n)
455{
456 MODULE_FUNCTION_BEGIN (0);
457 Lisp_Object l = value_to_lisp (n);
458 if (! INTEGERP (l))
459 {
460 module_wrong_type (env, Qintegerp, l);
461 return 0;
462 }
463 return XINT (l);
464}
465
466static emacs_value
467module_make_integer (emacs_env *env, intmax_t n)
468{
469 MODULE_FUNCTION_BEGIN (module_nil);
470 if (! (MOST_NEGATIVE_FIXNUM <= n && n <= MOST_POSITIVE_FIXNUM))
471 {
472 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
473 return module_nil;
474 }
475 return lisp_to_value (make_number (n));
476}
477
478static double
479module_extract_float (emacs_env *env, emacs_value f)
480{
481 MODULE_FUNCTION_BEGIN (0);
482 Lisp_Object lisp = value_to_lisp (f);
483 if (! FLOATP (lisp))
484 {
485 module_wrong_type (env, Qfloatp, lisp);
486 return 0;
487 }
488 return XFLOAT_DATA (lisp);
489}
490
491static emacs_value
492module_make_float (emacs_env *env, double d)
493{
494 MODULE_FUNCTION_BEGIN (module_nil);
495 return lisp_to_value (make_float (d));
496}
497
498static bool
499module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer,
500 ptrdiff_t *length)
501{
502 MODULE_FUNCTION_BEGIN (false);
503 Lisp_Object lisp_str = value_to_lisp (value);
504 if (! STRINGP (lisp_str))
505 {
506 module_wrong_type (env, Qstringp, lisp_str);
507 return false;
508 }
509
510 Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str);
511 ptrdiff_t raw_size = SBYTES (lisp_str_utf8);
512 if (raw_size == PTRDIFF_MAX)
513 {
514 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
515 return false;
516 }
517 ptrdiff_t required_buf_size = raw_size + 1;
518
519 eassert (length != NULL);
520
521 if (buffer == NULL)
522 {
523 *length = required_buf_size;
524 return true;
525 }
526
527 eassert (*length >= 0);
528
529 if (*length < required_buf_size)
530 {
531 *length = required_buf_size;
532 module_non_local_exit_signal_1 (env, Qargs_out_of_range, Qnil);
533 return false;
534 }
535
536 *length = required_buf_size;
537 memcpy (buffer, SDATA (lisp_str_utf8), raw_size + 1);
538
539 return true;
540}
541
542static emacs_value
543module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
544{
545 MODULE_FUNCTION_BEGIN (module_nil);
546 if (length > STRING_BYTES_BOUND)
547 {
548 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
549 return module_nil;
550 }
551 Lisp_Object lstr = make_unibyte_string (str, length);
552 return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
553}
554
555static emacs_value
556module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr)
557{
558 MODULE_FUNCTION_BEGIN (module_nil);
559 return lisp_to_value (make_user_ptr (fin, ptr));
560}
561
562static void *
563module_get_user_ptr (emacs_env *env, emacs_value uptr)
564{
565 MODULE_FUNCTION_BEGIN (NULL);
566 Lisp_Object lisp = value_to_lisp (uptr);
567 if (! USER_PTRP (lisp))
568 {
569 module_wrong_type (env, Quser_ptr, lisp);
570 return NULL;
571 }
572 return XUSER_PTR (lisp)->p;
573}
574
575static void
576module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
577{
578 /* FIXME: This function should return bool because it can fail. */
579 MODULE_FUNCTION_BEGIN ();
580 check_main_thread ();
581 if (module_non_local_exit_check (env) != emacs_funcall_exit_return)
582 return;
583 Lisp_Object lisp = value_to_lisp (uptr);
584 if (! USER_PTRP (lisp))
585 module_wrong_type (env, Quser_ptr, lisp);
586 XUSER_PTR (lisp)->p = ptr;
587}
588
589static emacs_finalizer_function
590module_get_user_finalizer (emacs_env *env, emacs_value uptr)
591{
592 MODULE_FUNCTION_BEGIN (NULL);
593 Lisp_Object lisp = value_to_lisp (uptr);
594 if (! USER_PTRP (lisp))
595 {
596 module_wrong_type (env, Quser_ptr, lisp);
597 return NULL;
598 }
599 return XUSER_PTR (lisp)->finalizer;
600}
601
602static void
603module_set_user_finalizer (emacs_env *env, emacs_value uptr,
604 emacs_finalizer_function fin)
605{
606 /* FIXME: This function should return bool because it can fail. */
607 MODULE_FUNCTION_BEGIN ();
608 Lisp_Object lisp = value_to_lisp (uptr);
609 if (! USER_PTRP (lisp))
610 module_wrong_type (env, Quser_ptr, lisp);
611 XUSER_PTR (lisp)->finalizer = fin;
612}
613
614static void
615module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
616{
617 /* FIXME: This function should return bool because it can fail. */
618 MODULE_FUNCTION_BEGIN ();
619 Lisp_Object lvec = value_to_lisp (vec);
620 if (! VECTORP (lvec))
621 {
622 module_wrong_type (env, Qvectorp, lvec);
623 return;
624 }
625 if (! (0 <= i && i < ASIZE (lvec)))
626 {
627 if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
628 module_args_out_of_range (env, lvec, make_number (i));
629 else
630 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
631 return;
632 }
633 ASET (lvec, i, value_to_lisp (val));
634}
635
636static emacs_value
637module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
638{
639 MODULE_FUNCTION_BEGIN (module_nil);
640 Lisp_Object lvec = value_to_lisp (vec);
641 if (! VECTORP (lvec))
642 {
643 module_wrong_type (env, Qvectorp, lvec);
644 return module_nil;
645 }
646 if (! (0 <= i && i < ASIZE (lvec)))
647 {
648 if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
649 module_args_out_of_range (env, lvec, make_number (i));
650 else
651 module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
652 return module_nil;
653 }
654 return lisp_to_value (AREF (lvec, i));
655}
656
657static ptrdiff_t
658module_vec_size (emacs_env *env, emacs_value vec)
659{
660 /* FIXME: Return a sentinel value (e.g., -1) on error. */
661 MODULE_FUNCTION_BEGIN (0);
662 Lisp_Object lvec = value_to_lisp (vec);
663 if (! VECTORP (lvec))
664 {
665 module_wrong_type (env, Qvectorp, lvec);
666 return 0;
667 }
668 return ASIZE (lvec);
669}
670
671
672/* Subroutines. */
673
674DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
675 doc: /* Load module FILE. */)
676 (Lisp_Object file)
677{
678 dynlib_handle_ptr handle;
679 emacs_init_function module_init;
680 void *gpl_sym;
681
682 CHECK_STRING (file);
683 handle = dynlib_open (SSDATA (file));
684 if (!handle)
685 error ("Cannot load file %s: %s", SDATA (file), dynlib_error ());
686
687 gpl_sym = dynlib_sym (handle, "plugin_is_GPL_compatible");
688 if (!gpl_sym)
689 error ("Module %s is not GPL compatible", SDATA (file));
690
691 module_init = (emacs_init_function) dynlib_func (handle, "emacs_module_init");
692 if (!module_init)
693 error ("Module %s does not have an init function.", SDATA (file));
694
695 struct emacs_runtime_private rt; /* Includes the public emacs_env. */
696 struct emacs_env_private priv;
697 initialize_environment (&rt.pub, &priv);
698 struct emacs_runtime pub =
699 {
700 .size = sizeof pub,
701 .private_members = &rt,
702 .get_environment = module_get_environment
703 };
704 int r = module_init (&pub);
705 finalize_environment (&priv);
706
707 if (r != 0)
708 {
709 if (! (MOST_NEGATIVE_FIXNUM <= r && r <= MOST_POSITIVE_FIXNUM))
710 xsignal0 (Qoverflow_error);
711 xsignal2 (Qmodule_load_failed, file, make_number (r));
712 }
713
714 return Qt;
715}
716
717DEFUN ("internal--module-call", Finternal_module_call, Sinternal_module_call, 1, MANY, 0,
718 doc: /* Internal function to call a module function.
719ENVOBJ is a save pointer to a module_fun_env structure.
720ARGLIST is a list of arguments passed to SUBRPTR.
721usage: (module-call ENVOBJ &rest ARGLIST) */)
722 (ptrdiff_t nargs, Lisp_Object *arglist)
723{
724 Lisp_Object envobj = arglist[0];
725 /* FIXME: Rather than use a save_value, we should create a new object type.
726 Making save_value visible to Lisp is wrong. */
727 CHECK_TYPE (SAVE_VALUEP (envobj), Qsave_value_p, envobj);
728 struct Lisp_Save_Value *save_value = XSAVE_VALUE (envobj);
729 CHECK_TYPE (save_type (save_value, 0) == SAVE_POINTER, Qsave_pointer_p, envobj);
730 /* FIXME: We have no reason to believe that XSAVE_POINTER (envobj, 0)
731 is a module_fun_env pointer. If some other part of Emacs also
732 exports save_value objects to Elisp, than we may be getting here this
733 other kind of save_value which will likely hold something completely
734 different in this field. */
735 struct module_fun_env *envptr = XSAVE_POINTER (envobj, 0);
736 EMACS_INT len = nargs - 1;
737 eassume (0 <= envptr->min_arity);
738 if (! (envptr->min_arity <= len
739 && len <= (envptr->max_arity < 0 ? PTRDIFF_MAX : envptr->max_arity)))
740 xsignal2 (Qwrong_number_of_arguments, module_format_fun_env (envptr),
741 make_number (len));
742
743 emacs_env pub;
744 struct emacs_env_private priv;
745 initialize_environment (&pub, &priv);
746
747 USE_SAFE_ALLOCA;
748 emacs_value *args;
749 if (plain_values)
750 args = (emacs_value *) arglist + 1;
751 else
752 {
753 args = SAFE_ALLOCA (len * sizeof *args);
754 for (ptrdiff_t i = 0; i < len; i++)
755 args[i] = lisp_to_value (arglist[i + 1]);
756 }
757
758 emacs_value ret = envptr->subr (&pub, len, args, envptr->data);
759 SAFE_FREE ();
760
761 eassert (&priv == pub.private_members);
762
763 switch (priv.pending_non_local_exit)
764 {
765 case emacs_funcall_exit_return:
766 finalize_environment (&priv);
767 return value_to_lisp (ret);
768 case emacs_funcall_exit_signal:
769 {
770 Lisp_Object symbol = priv.non_local_exit_symbol;
771 Lisp_Object data = priv.non_local_exit_data;
772 finalize_environment (&priv);
773 xsignal (symbol, data);
774 }
775 case emacs_funcall_exit_throw:
776 {
777 Lisp_Object tag = priv.non_local_exit_symbol;
778 Lisp_Object value = priv.non_local_exit_data;
779 finalize_environment (&priv);
780 Fthrow (tag, value);
781 }
782 default:
783 eassume (false);
784 }
785}
786
787
788/* Helper functions. */
789
790static void
791check_main_thread (void)
792{
793#ifdef HAVE_PTHREAD
794 eassert (pthread_equal (pthread_self (), main_thread));
795#elif defined WINDOWSNT
796 eassert (GetCurrentThreadId () == main_thread);
797#endif
798}
799
800static void
801module_non_local_exit_signal_1 (emacs_env *env, Lisp_Object sym,
802 Lisp_Object data)
803{
804 struct emacs_env_private *p = env->private_members;
805 if (p->pending_non_local_exit == emacs_funcall_exit_return)
806 {
807 p->pending_non_local_exit = emacs_funcall_exit_signal;
808 p->non_local_exit_symbol = sym;
809 p->non_local_exit_data = data;
810 }
811}
812
813static void
814module_non_local_exit_throw_1 (emacs_env *env, Lisp_Object tag,
815 Lisp_Object value)
816{
817 struct emacs_env_private *p = env->private_members;
818 if (p->pending_non_local_exit == emacs_funcall_exit_return)
819 {
820 p->pending_non_local_exit = emacs_funcall_exit_throw;
821 p->non_local_exit_symbol = tag;
822 p->non_local_exit_data = value;
823 }
824}
825
826/* Module version of `wrong_type_argument'. */
827static void
828module_wrong_type (emacs_env *env, Lisp_Object predicate, Lisp_Object value)
829{
830 module_non_local_exit_signal_1 (env, Qwrong_type_argument,
831 list2 (predicate, value));
832}
833
834/* Signal an out-of-memory condition to the caller. */
835static void
836module_out_of_memory (emacs_env *env)
837{
838 /* TODO: Reimplement this so it works even if memory-signal-data has
839 been modified. */
840 module_non_local_exit_signal_1 (env, XCAR (Vmemory_signal_data),
841 XCDR (Vmemory_signal_data));
842}
843
844/* Signal arguments are out of range. */
845static void
846module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2)
847{
848 module_non_local_exit_signal_1 (env, Qargs_out_of_range, list2 (a1, a2));
849}
850
851
852/* Value conversion. */
853
854/* Unique Lisp_Object used to mark those emacs_values which are really
855 just containers holding a Lisp_Object that does not fit as an emacs_value,
856 either because it is an integer out of range, or is not properly aligned.
857 Used only if !plain_values. */
858static Lisp_Object ltv_mark;
859
860/* Convert V to the corresponding internal object O, such that
861 V == lisp_to_value_bits (O). Never fails. */
862static Lisp_Object
863value_to_lisp_bits (emacs_value v)
864{
865 intptr_t i = (intptr_t) v;
866 if (plain_values || USE_LSB_TAG)
867 return XIL (i);
868
869 /* With wide EMACS_INT and when tag bits are the most significant,
870 reassembling integers differs from reassembling pointers in two
871 ways. First, save and restore the least-significant bits of the
872 integer, not the most-significant bits. Second, sign-extend the
873 integer when restoring, but zero-extend pointers because that
874 makes TAG_PTR faster. */
875
876 EMACS_UINT tag = i & (GCALIGNMENT - 1);
877 EMACS_UINT untagged = i - tag;
878 switch (tag)
879 {
880 case_Lisp_Int:
881 {
882 bool negative = tag & 1;
883 EMACS_UINT sign_extension
884 = negative ? VALMASK & ~(INTPTR_MAX >> INTTYPEBITS): 0;
885 uintptr_t u = i;
886 intptr_t all_but_sign = u >> GCTYPEBITS;
887 untagged = sign_extension + all_but_sign;
888 break;
889 }
890 }
891
892 return XIL ((tag << VALBITS) + untagged);
893}
894
895/* If V was computed from lisp_to_value (O), then return O.
896 Exits non-locally only if the stack overflows. */
897static Lisp_Object
898value_to_lisp (emacs_value v)
899{
900 Lisp_Object o = value_to_lisp_bits (v);
901 if (! plain_values && CONSP (o) && EQ (XCDR (o), ltv_mark))
902 o = XCAR (o);
903 return o;
904}
905
906/* Attempt to convert O to an emacs_value. Do not do any checking or
907 or allocate any storage; the caller should prevent or detect
908 any resulting bit pattern that is not a valid emacs_value. */
909static emacs_value
910lisp_to_value_bits (Lisp_Object o)
911{
912 EMACS_UINT u = XLI (o);
913
914 /* Compress U into the space of a pointer, possibly losing information. */
915 uintptr_t p = (plain_values || USE_LSB_TAG
916 ? u
917 : (INTEGERP (o) ? u << VALBITS : u & VALMASK) + XTYPE (o));
918 return (emacs_value) p;
919}
920
921#ifndef HAVE_STRUCT_ATTRIBUTE_ALIGNED
922enum { HAVE_STRUCT_ATTRIBUTE_ALIGNED = 0 };
923#endif
924
925/* Convert O to an emacs_value. Allocate storage if needed; this can
926 signal if memory is exhausted. Must be an injective function. */
927static emacs_value
928lisp_to_value (Lisp_Object o)
929{
930 emacs_value v = lisp_to_value_bits (o);
931
932 if (! EQ (o, value_to_lisp_bits (v)))
933 {
934 /* Package the incompressible object pointer inside a pair
935 that is compressible. */
936 Lisp_Object pair = Fcons (o, ltv_mark);
937
938 if (! HAVE_STRUCT_ATTRIBUTE_ALIGNED)
939 {
940 /* Keep calling Fcons until it returns a compressible pair.
941 This shouldn't take long. */
942 while ((intptr_t) XCONS (pair) & (GCALIGNMENT - 1))
943 pair = Fcons (o, pair);
944
945 /* Plant the mark. The garbage collector will eventually
946 reclaim any just-allocated incompressible pairs. */
947 XSETCDR (pair, ltv_mark);
948 }
949
950 v = (emacs_value) ((intptr_t) XCONS (pair) + Lisp_Cons);
951 }
952
953 eassert (EQ (o, value_to_lisp (v)));
954 return v;
955}
956
957
958/* Environment lifetime management. */
959
960/* Must be called before the environment can be used. */
961static void
962initialize_environment (emacs_env *env, struct emacs_env_private *priv)
963{
964 priv->pending_non_local_exit = emacs_funcall_exit_return;
965 env->size = sizeof *env;
966 env->private_members = priv;
967 env->make_global_ref = module_make_global_ref;
968 env->free_global_ref = module_free_global_ref;
969 env->non_local_exit_check = module_non_local_exit_check;
970 env->non_local_exit_clear = module_non_local_exit_clear;
971 env->non_local_exit_get = module_non_local_exit_get;
972 env->non_local_exit_signal = module_non_local_exit_signal;
973 env->non_local_exit_throw = module_non_local_exit_throw;
974 env->make_function = module_make_function;
975 env->funcall = module_funcall;
976 env->intern = module_intern;
977 env->type_of = module_type_of;
978 env->is_not_nil = module_is_not_nil;
979 env->eq = module_eq;
980 env->extract_integer = module_extract_integer;
981 env->make_integer = module_make_integer;
982 env->extract_float = module_extract_float;
983 env->make_float = module_make_float;
984 env->copy_string_contents = module_copy_string_contents;
985 env->make_string = module_make_string;
986 env->make_user_ptr = module_make_user_ptr;
987 env->get_user_ptr = module_get_user_ptr;
988 env->set_user_ptr = module_set_user_ptr;
989 env->get_user_finalizer = module_get_user_finalizer;
990 env->set_user_finalizer = module_set_user_finalizer;
991 env->vec_set = module_vec_set;
992 env->vec_get = module_vec_get;
993 env->vec_size = module_vec_size;
994 Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
995}
996
997/* Must be called before the lifetime of the environment object
998 ends. */
999static void
1000finalize_environment (struct emacs_env_private *env)
1001{
1002 Vmodule_environments = XCDR (Vmodule_environments);
1003}
1004
1005
1006/* Non-local exit handling. */
1007
1008/* Must be called after setting up a handler immediately before
1009 returning from the function. See the comments in lisp.h and the
1010 code in eval.c for details. The macros below arrange for this
1011 function to be called automatically. DUMMY is ignored. */
1012static void
1013module_reset_handlerlist (const int *dummy)
1014{
1015 handlerlist = handlerlist->next;
1016}
1017
1018/* Called on `signal'. ERR is a pair (SYMBOL . DATA), which gets
1019 stored in the environment. Set the pending non-local exit flag. */
1020static void
1021module_handle_signal (emacs_env *env, Lisp_Object err)
1022{
1023 module_non_local_exit_signal_1 (env, XCAR (err), XCDR (err));
1024}
1025
1026/* Called on `throw'. TAG_VAL is a pair (TAG . VALUE), which gets
1027 stored in the environment. Set the pending non-local exit flag. */
1028static void
1029module_handle_throw (emacs_env *env, Lisp_Object tag_val)
1030{
1031 module_non_local_exit_throw_1 (env, XCAR (tag_val), XCDR (tag_val));
1032}
1033
1034
1035/* Function environments. */
1036
1037/* Return a string object that contains a user-friendly
1038 representation of the function environment. */
1039static Lisp_Object
1040module_format_fun_env (const struct module_fun_env *env)
1041{
1042 /* Try to print a function name if possible. */
1043 const char *path, *sym;
1044 static char const noaddr_format[] = "#<module function at %p>";
1045 char buffer[sizeof noaddr_format + INT_STRLEN_BOUND (intptr_t) + 256];
1046 char *buf = buffer;
1047 ptrdiff_t bufsize = sizeof buffer;
1048 ptrdiff_t size
1049 = (dynlib_addr (env->subr, &path, &sym)
1050 ? exprintf (&buf, &bufsize, buffer, -1,
1051 "#<module function %s from %s>", sym, path)
1052 : sprintf (buffer, noaddr_format, env->subr));
1053 Lisp_Object unibyte_result = make_unibyte_string (buffer, size);
1054 if (buf != buffer)
1055 xfree (buf);
1056 return code_convert_string_norecord (unibyte_result, Qutf_8, false);
1057}
1058
1059
1060/* Segment initializer. */
1061
1062void
1063syms_of_module (void)
1064{
1065 if (!plain_values)
1066 ltv_mark = Fcons (Qnil, Qnil);
1067 eassert (NILP (value_to_lisp (module_nil)));
1068
1069 DEFSYM (Qmodule_refs_hash, "module-refs-hash");
1070 DEFVAR_LISP ("module-refs-hash", Vmodule_refs_hash,
1071 doc: /* Module global reference table. */);
1072
1073 Vmodule_refs_hash
1074 = make_hash_table (hashtest_eq, make_number (DEFAULT_HASH_SIZE),
1075 make_float (DEFAULT_REHASH_SIZE),
1076 make_float (DEFAULT_REHASH_THRESHOLD),
1077 Qnil);
1078 Funintern (Qmodule_refs_hash, Qnil);
1079
1080 DEFSYM (Qmodule_environments, "module-environments");
1081 DEFVAR_LISP ("module-environments", Vmodule_environments,
1082 doc: /* List of active module environments. */);
1083 Vmodule_environments = Qnil;
1084 /* Unintern `module-environments' because it is only used
1085 internally. */
1086 Funintern (Qmodule_environments, Qnil);
1087
1088 DEFSYM (Qmodule_load_failed, "module-load-failed");
1089 Fput (Qmodule_load_failed, Qerror_conditions,
1090 listn (CONSTYPE_PURE, 2, Qmodule_load_failed, Qerror));
1091 Fput (Qmodule_load_failed, Qerror_message,
1092 build_pure_c_string ("Module load failed"));
1093
1094 DEFSYM (Qinvalid_module_call, "invalid-module-call");
1095 Fput (Qinvalid_module_call, Qerror_conditions,
1096 listn (CONSTYPE_PURE, 2, Qinvalid_module_call, Qerror));
1097 Fput (Qinvalid_module_call, Qerror_message,
1098 build_pure_c_string ("Invalid module call"));
1099
1100 DEFSYM (Qinvalid_arity, "invalid-arity");
1101 Fput (Qinvalid_arity, Qerror_conditions,
1102 listn (CONSTYPE_PURE, 2, Qinvalid_arity, Qerror));
1103 Fput (Qinvalid_arity, Qerror_message,
1104 build_pure_c_string ("Invalid function arity"));
1105
1106 /* Unintern `module-refs-hash' because it is internal-only and Lisp
1107 code or modules should not access it. */
1108 Funintern (Qmodule_refs_hash, Qnil);
1109
1110 DEFSYM (Qsave_value_p, "save-value-p");
1111 DEFSYM (Qsave_pointer_p, "save-pointer-p");
1112
1113 defsubr (&Smodule_load);
1114
1115 DEFSYM (Qinternal_module_call, "internal--module-call");
1116 defsubr (&Sinternal_module_call);
1117}
1118
1119/* Unlike syms_of_module, this initializer is called even from an
1120 initialized (dumped) Emacs. */
1121
1122void
1123module_init (void)
1124{
1125 /* It is not guaranteed that dynamic initializers run in the main thread,
1126 therefore detect the main thread here. */
1127#ifdef HAVE_PTHREAD
1128 main_thread = pthread_self ();
1129#elif defined WINDOWSNT
1130 /* The 'main' function already recorded the main thread's thread ID,
1131 so we need just to use it . */
1132 main_thread = dwMainThreadId;
1133#endif
1134}
diff --git a/src/emacs-module.h b/src/emacs-module.h
new file mode 100644
index 00000000000..a3aa5017a4e
--- /dev/null
+++ b/src/emacs-module.h
@@ -0,0 +1,215 @@
1/* emacs-module.h - GNU Emacs module API.
2
3Copyright (C) 2015 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or
10(at your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20#ifndef EMACS_MODULE_H
21#define EMACS_MODULE_H
22
23#include <stdint.h>
24#include <stddef.h>
25#include <stdbool.h>
26
27#if defined __cplusplus && __cplusplus >= 201103L
28# define EMACS_NOEXCEPT noexcept
29
30/* Function prototype for module user-pointer finalizers.
31
32 NOTE: C++11 15.4: An exception-specification shall not appear in a
33 typedef declaration or alias-declaration.
34
35*/
36void emacs_dummy_finalizer_function (void *) noexcept;
37typedef decltype(emacs_dummy_finalizer_function) *emacs_finalizer_function;
38
39#else
40# define EMACS_NOEXCEPT
41typedef void (*emacs_finalizer_function) (void *);
42#endif
43
44#ifdef __cplusplus
45extern "C" {
46#endif
47
48/* Current environment. */
49typedef struct emacs_env_25 emacs_env;
50
51/* Opaque pointer representing an Emacs Lisp value.
52 BEWARE: Do not assume NULL is a valid value! */
53typedef struct emacs_value_tag *emacs_value;
54
55enum emacs_arity { emacs_variadic_function = -2 };
56
57/* Struct passed to a module init function (emacs_module_init). */
58struct emacs_runtime
59{
60 /* Structure size (for version checking). */
61 ptrdiff_t size;
62
63 /* Private data; users should not touch this. */
64 struct emacs_runtime_private *private_members;
65
66 /* Return an environment pointer. */
67 emacs_env *(*get_environment) (struct emacs_runtime *ert);
68};
69
70
71/* Function prototype for the module init function. */
72typedef int (*emacs_init_function) (struct emacs_runtime *ert);
73
74/* Function prototype for the module Lisp functions. */
75typedef emacs_value (*emacs_subr) (emacs_env *env, ptrdiff_t nargs,
76 emacs_value args[], void *data);
77
78/* Possible Emacs function call outcomes. */
79enum emacs_funcall_exit
80{
81 /* Function has returned normally. */
82 emacs_funcall_exit_return = 0,
83
84 /* Function has signaled an error using `signal'. */
85 emacs_funcall_exit_signal = 1,
86
87 /* Function has exit using `throw'. */
88 emacs_funcall_exit_throw = 2,
89};
90
91struct emacs_env_25
92{
93 /* Structure size (for version checking). */
94 ptrdiff_t size;
95
96 /* Private data; users should not touch this. */
97 struct emacs_env_private *private_members;
98
99 /* Memory management. */
100
101 emacs_value (*make_global_ref) (emacs_env *env,
102 emacs_value any_reference);
103
104 void (*free_global_ref) (emacs_env *env,
105 emacs_value global_reference);
106
107 /* Non-local exit handling. */
108
109 enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env);
110
111 void (*non_local_exit_clear) (emacs_env *env);
112
113 enum emacs_funcall_exit (*non_local_exit_get)
114 (emacs_env *env,
115 emacs_value *non_local_exit_symbol_out,
116 emacs_value *non_local_exit_data_out);
117
118 void (*non_local_exit_signal) (emacs_env *env,
119 emacs_value non_local_exit_symbol,
120 emacs_value non_local_exit_data);
121
122 void (*non_local_exit_throw) (emacs_env *env,
123 emacs_value tag,
124 emacs_value value);
125
126 /* Function registration. */
127
128 emacs_value (*make_function) (emacs_env *env,
129 ptrdiff_t min_arity,
130 ptrdiff_t max_arity,
131 emacs_value (*function) (emacs_env *env,
132 ptrdiff_t nargs,
133 emacs_value args[],
134 void *)
135 EMACS_NOEXCEPT,
136 const char *documentation,
137 void *data);
138
139 emacs_value (*funcall) (emacs_env *env,
140 emacs_value function,
141 ptrdiff_t nargs,
142 emacs_value args[]);
143
144 emacs_value (*intern) (emacs_env *env,
145 const char *symbol_name);
146
147 /* Type conversion. */
148
149 emacs_value (*type_of) (emacs_env *env,
150 emacs_value value);
151
152 bool (*is_not_nil) (emacs_env *env, emacs_value value);
153
154 bool (*eq) (emacs_env *env, emacs_value a, emacs_value b);
155
156 intmax_t (*extract_integer) (emacs_env *env, emacs_value value);
157
158 emacs_value (*make_integer) (emacs_env *env, intmax_t value);
159
160 double (*extract_float) (emacs_env *env, emacs_value value);
161
162 emacs_value (*make_float) (emacs_env *env, double value);
163
164 /* Copy the content of the Lisp string VALUE to BUFFER as an utf8
165 null-terminated string.
166
167 SIZE must point to the total size of the buffer. If BUFFER is
168 NULL or if SIZE is not big enough, write the required buffer size
169 to SIZE and return false.
170
171 Note that SIZE must include the last null byte (e.g. "abc" needs
172 a buffer of size 4).
173
174 Return true if the string was successfully copied. */
175
176 bool (*copy_string_contents) (emacs_env *env,
177 emacs_value value,
178 char *buffer,
179 ptrdiff_t *size_inout);
180
181 /* Create a Lisp string from a utf8 encoded string. */
182 emacs_value (*make_string) (emacs_env *env,
183 const char *contents, ptrdiff_t length);
184
185 /* Embedded pointer type. */
186 emacs_value (*make_user_ptr) (emacs_env *env,
187 emacs_finalizer_function fin,
188 void *ptr);
189
190 void *(*get_user_ptr) (emacs_env *env, emacs_value uptr);
191 void (*set_user_ptr) (emacs_env *env, emacs_value uptr, void *ptr);
192
193 emacs_finalizer_function (*get_user_finalizer) (emacs_env *env,
194 emacs_value uptr);
195 void (*set_user_finalizer) (emacs_env *env,
196 emacs_value uptr,
197 emacs_finalizer_function fin);
198
199 /* Vector functions. */
200 emacs_value (*vec_get) (emacs_env *env, emacs_value vec, ptrdiff_t i);
201
202 void (*vec_set) (emacs_env *env, emacs_value vec, ptrdiff_t i,
203 emacs_value val);
204
205 ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vec);
206};
207
208/* Every module should define a function as follows. */
209extern int emacs_module_init (struct emacs_runtime *ert);
210
211#ifdef __cplusplus
212}
213#endif
214
215#endif /* EMACS_MODULE_H */
diff --git a/src/emacs.c b/src/emacs.c
index 2e9f950851a..926aa989e6a 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -761,6 +761,9 @@ main (int argc, char **argv)
761 names between UTF-8 and the system's ANSI codepage. */ 761 names between UTF-8 and the system's ANSI codepage. */
762 maybe_load_unicows_dll (); 762 maybe_load_unicows_dll ();
763#endif 763#endif
764 /* This has to be done before module_init is called below, so that
765 the latter could use the thread ID of the main thread. */
766 w32_init_main_thread ();
764#endif 767#endif
765 768
766#ifdef RUN_TIME_REMAP 769#ifdef RUN_TIME_REMAP
@@ -776,6 +779,10 @@ main (int argc, char **argv)
776 779
777 atexit (close_output_streams); 780 atexit (close_output_streams);
778 781
782#ifdef HAVE_MODULES
783 module_init ();
784#endif
785
779 sort_args (argc, argv); 786 sort_args (argc, argv);
780 argc = 0; 787 argc = 0;
781 while (argv[argc]) argc++; 788 while (argv[argc]) argc++;
@@ -1454,6 +1461,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
1454 syms_of_terminal (); 1461 syms_of_terminal ();
1455 syms_of_term (); 1462 syms_of_term ();
1456 syms_of_undo (); 1463 syms_of_undo ();
1464
1465#ifdef HAVE_MODULES
1466 syms_of_module ();
1467#endif
1468
1457#ifdef HAVE_SOUND 1469#ifdef HAVE_SOUND
1458 syms_of_sound (); 1470 syms_of_sound ();
1459#endif 1471#endif
diff --git a/src/eval.c b/src/eval.c
index ac98ca11bd4..bd0cf68369c 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -61,7 +61,7 @@ union specbinding *specpdl_ptr;
61 61
62/* Depth in Lisp evaluations and function calls. */ 62/* Depth in Lisp evaluations and function calls. */
63 63
64EMACS_INT lisp_eval_depth; 64static EMACS_INT lisp_eval_depth;
65 65
66/* The value of num_nonmacro_input_events as of the last time we 66/* The value of num_nonmacro_input_events as of the last time we
67 started to enter the debugger. If we decide to enter the debugger 67 started to enter the debugger. If we decide to enter the debugger
@@ -226,9 +226,8 @@ init_eval (void)
226 { /* Put a dummy catcher at top-level so that handlerlist is never NULL. 226 { /* Put a dummy catcher at top-level so that handlerlist is never NULL.
227 This is important since handlerlist->nextfree holds the freelist 227 This is important since handlerlist->nextfree holds the freelist
228 which would otherwise leak every time we unwind back to top-level. */ 228 which would otherwise leak every time we unwind back to top-level. */
229 struct handler *c;
230 handlerlist = handlerlist_sentinel.nextfree = &handlerlist_sentinel; 229 handlerlist = handlerlist_sentinel.nextfree = &handlerlist_sentinel;
231 PUSH_HANDLER (c, Qunbound, CATCHER); 230 struct handler *c = push_handler (Qunbound, CATCHER);
232 eassert (c == &handlerlist_sentinel); 231 eassert (c == &handlerlist_sentinel);
233 handlerlist_sentinel.nextfree = NULL; 232 handlerlist_sentinel.nextfree = NULL;
234 handlerlist_sentinel.next = NULL; 233 handlerlist_sentinel.next = NULL;
@@ -488,6 +487,10 @@ usage: (setq [SYM VAL]...) */)
488 if (CONSP (args)) 487 if (CONSP (args))
489 { 488 {
490 Lisp_Object args_left = args; 489 Lisp_Object args_left = args;
490 Lisp_Object numargs = Flength (args);
491
492 if (XINT (numargs) & 1)
493 xsignal2 (Qwrong_number_of_arguments, Qsetq, numargs);
491 494
492 do 495 do
493 { 496 {
@@ -1059,18 +1062,16 @@ usage: (catch TAG BODY...) */)
1059 This is how catches are done from within C code. */ 1062 This is how catches are done from within C code. */
1060 1063
1061Lisp_Object 1064Lisp_Object
1062internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) 1065internal_catch (Lisp_Object tag,
1066 Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
1063{ 1067{
1064 /* This structure is made part of the chain `catchlist'. */ 1068 /* This structure is made part of the chain `catchlist'. */
1065 struct handler *c; 1069 struct handler *c = push_handler (tag, CATCHER);
1066
1067 /* Fill in the components of c, and put it on the list. */
1068 PUSH_HANDLER (c, tag, CATCHER);
1069 1070
1070 /* Call FUNC. */ 1071 /* Call FUNC. */
1071 if (! sys_setjmp (c->jmp)) 1072 if (! sys_setjmp (c->jmp))
1072 { 1073 {
1073 Lisp_Object val = (*func) (arg); 1074 Lisp_Object val = func (arg);
1074 clobbered_eassert (handlerlist == c); 1075 clobbered_eassert (handlerlist == c);
1075 handlerlist = handlerlist->next; 1076 handlerlist = handlerlist->next;
1076 return val; 1077 return val;
@@ -1145,6 +1146,8 @@ Both TAG and VALUE are evalled. */
1145 if (!NILP (tag)) 1146 if (!NILP (tag))
1146 for (c = handlerlist; c; c = c->next) 1147 for (c = handlerlist; c; c = c->next)
1147 { 1148 {
1149 if (c->type == CATCHER_ALL)
1150 unwind_to_catch (c, Fcons (tag, value));
1148 if (c->type == CATCHER && EQ (c->tag_or_ch, tag)) 1151 if (c->type == CATCHER && EQ (c->tag_or_ch, tag))
1149 unwind_to_catch (c, value); 1152 unwind_to_catch (c, value);
1150 } 1153 }
@@ -1211,7 +1214,6 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
1211 Lisp_Object handlers) 1214 Lisp_Object handlers)
1212{ 1215{
1213 Lisp_Object val; 1216 Lisp_Object val;
1214 struct handler *c;
1215 struct handler *oldhandlerlist = handlerlist; 1217 struct handler *oldhandlerlist = handlerlist;
1216 int clausenb = 0; 1218 int clausenb = 0;
1217 1219
@@ -1246,7 +1248,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
1246 Lisp_Object condition = XCAR (clause); 1248 Lisp_Object condition = XCAR (clause);
1247 if (!CONSP (condition)) 1249 if (!CONSP (condition))
1248 condition = Fcons (condition, Qnil); 1250 condition = Fcons (condition, Qnil);
1249 PUSH_HANDLER (c, condition, CONDITION_CASE); 1251 struct handler *c = push_handler (condition, CONDITION_CASE);
1250 if (sys_setjmp (c->jmp)) 1252 if (sys_setjmp (c->jmp))
1251 { 1253 {
1252 ptrdiff_t count = SPECPDL_INDEX (); 1254 ptrdiff_t count = SPECPDL_INDEX ();
@@ -1294,46 +1296,45 @@ Lisp_Object
1294internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers, 1296internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
1295 Lisp_Object (*hfun) (Lisp_Object)) 1297 Lisp_Object (*hfun) (Lisp_Object))
1296{ 1298{
1297 Lisp_Object val; 1299 struct handler *c = push_handler (handlers, CONDITION_CASE);
1298 struct handler *c;
1299
1300 PUSH_HANDLER (c, handlers, CONDITION_CASE);
1301 if (sys_setjmp (c->jmp)) 1300 if (sys_setjmp (c->jmp))
1302 { 1301 {
1303 Lisp_Object val = handlerlist->val; 1302 Lisp_Object val = handlerlist->val;
1304 clobbered_eassert (handlerlist == c); 1303 clobbered_eassert (handlerlist == c);
1305 handlerlist = handlerlist->next; 1304 handlerlist = handlerlist->next;
1306 return (*hfun) (val); 1305 return hfun (val);
1306 }
1307 else
1308 {
1309 Lisp_Object val = bfun ();
1310 clobbered_eassert (handlerlist == c);
1311 handlerlist = handlerlist->next;
1312 return val;
1307 } 1313 }
1308
1309 val = (*bfun) ();
1310 clobbered_eassert (handlerlist == c);
1311 handlerlist = handlerlist->next;
1312 return val;
1313} 1314}
1314 1315
1315/* Like internal_condition_case but call BFUN with ARG as its argument. */ 1316/* Like internal_condition_case but call BFUN with ARG as its argument. */
1316 1317
1317Lisp_Object 1318Lisp_Object
1318internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg, 1319internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
1319 Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object)) 1320 Lisp_Object handlers,
1321 Lisp_Object (*hfun) (Lisp_Object))
1320{ 1322{
1321 Lisp_Object val; 1323 struct handler *c = push_handler (handlers, CONDITION_CASE);
1322 struct handler *c;
1323
1324 PUSH_HANDLER (c, handlers, CONDITION_CASE);
1325 if (sys_setjmp (c->jmp)) 1324 if (sys_setjmp (c->jmp))
1326 { 1325 {
1327 Lisp_Object val = handlerlist->val; 1326 Lisp_Object val = handlerlist->val;
1328 clobbered_eassert (handlerlist == c); 1327 clobbered_eassert (handlerlist == c);
1329 handlerlist = handlerlist->next; 1328 handlerlist = handlerlist->next;
1330 return (*hfun) (val); 1329 return hfun (val);
1330 }
1331 else
1332 {
1333 Lisp_Object val = bfun (arg);
1334 clobbered_eassert (handlerlist == c);
1335 handlerlist = handlerlist->next;
1336 return val;
1331 } 1337 }
1332
1333 val = (*bfun) (arg);
1334 clobbered_eassert (handlerlist == c);
1335 handlerlist = handlerlist->next;
1336 return val;
1337} 1338}
1338 1339
1339/* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as 1340/* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
@@ -1346,22 +1347,21 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
1346 Lisp_Object handlers, 1347 Lisp_Object handlers,
1347 Lisp_Object (*hfun) (Lisp_Object)) 1348 Lisp_Object (*hfun) (Lisp_Object))
1348{ 1349{
1349 Lisp_Object val; 1350 struct handler *c = push_handler (handlers, CONDITION_CASE);
1350 struct handler *c;
1351
1352 PUSH_HANDLER (c, handlers, CONDITION_CASE);
1353 if (sys_setjmp (c->jmp)) 1351 if (sys_setjmp (c->jmp))
1354 { 1352 {
1355 Lisp_Object val = handlerlist->val; 1353 Lisp_Object val = handlerlist->val;
1356 clobbered_eassert (handlerlist == c); 1354 clobbered_eassert (handlerlist == c);
1357 handlerlist = handlerlist->next; 1355 handlerlist = handlerlist->next;
1358 return (*hfun) (val); 1356 return hfun (val);
1357 }
1358 else
1359 {
1360 Lisp_Object val = bfun (arg1, arg2);
1361 clobbered_eassert (handlerlist == c);
1362 handlerlist = handlerlist->next;
1363 return val;
1359 } 1364 }
1360
1361 val = (*bfun) (arg1, arg2);
1362 clobbered_eassert (handlerlist == c);
1363 handlerlist = handlerlist->next;
1364 return val;
1365} 1365}
1366 1366
1367/* Like internal_condition_case but call BFUN with NARGS as first, 1367/* Like internal_condition_case but call BFUN with NARGS as first,
@@ -1376,22 +1376,57 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
1376 ptrdiff_t nargs, 1376 ptrdiff_t nargs,
1377 Lisp_Object *args)) 1377 Lisp_Object *args))
1378{ 1378{
1379 Lisp_Object val; 1379 struct handler *c = push_handler (handlers, CONDITION_CASE);
1380 struct handler *c;
1381
1382 PUSH_HANDLER (c, handlers, CONDITION_CASE);
1383 if (sys_setjmp (c->jmp)) 1380 if (sys_setjmp (c->jmp))
1384 { 1381 {
1385 Lisp_Object val = handlerlist->val; 1382 Lisp_Object val = handlerlist->val;
1386 clobbered_eassert (handlerlist == c); 1383 clobbered_eassert (handlerlist == c);
1387 handlerlist = handlerlist->next; 1384 handlerlist = handlerlist->next;
1388 return (*hfun) (val, nargs, args); 1385 return hfun (val, nargs, args);
1386 }
1387 else
1388 {
1389 Lisp_Object val = bfun (nargs, args);
1390 clobbered_eassert (handlerlist == c);
1391 handlerlist = handlerlist->next;
1392 return val;
1389 } 1393 }
1394}
1390 1395
1391 val = (*bfun) (nargs, args); 1396struct handler *
1392 clobbered_eassert (handlerlist == c); 1397push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype)
1393 handlerlist = handlerlist->next; 1398{
1394 return val; 1399 struct handler *c = push_handler_nosignal (tag_ch_val, handlertype);
1400 if (!c)
1401 memory_full (sizeof *c);
1402 return c;
1403}
1404
1405struct handler *
1406push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
1407{
1408 struct handler *c = handlerlist->nextfree;
1409 if (!c)
1410 {
1411 c = malloc (sizeof *c);
1412 if (!c)
1413 return c;
1414 if (profiler_memory_running)
1415 malloc_probe (sizeof *c);
1416 c->nextfree = NULL;
1417 handlerlist->nextfree = c;
1418 }
1419 c->type = handlertype;
1420 c->tag_or_ch = tag_ch_val;
1421 c->val = Qnil;
1422 c->next = handlerlist;
1423 c->lisp_eval_depth = lisp_eval_depth;
1424 c->pdlcount = SPECPDL_INDEX ();
1425 c->poll_suppress_count = poll_suppress_count;
1426 c->interrupt_input_blocked = interrupt_input_blocked;
1427 c->byte_stack = byte_stack_list;
1428 handlerlist = c;
1429 return c;
1395} 1430}
1396 1431
1397 1432
@@ -2014,6 +2049,10 @@ eval_sub (Lisp_Object form)
2014 Lisp_Object funcar; 2049 Lisp_Object funcar;
2015 ptrdiff_t count; 2050 ptrdiff_t count;
2016 2051
2052 /* Declare here, as this array may be accessed by call_debugger near
2053 the end of this function. See Bug#21245. */
2054 Lisp_Object argvals[8];
2055
2017 if (SYMBOLP (form)) 2056 if (SYMBOLP (form))
2018 { 2057 {
2019 /* Look up its binding in the lexical environment. 2058 /* Look up its binding in the lexical environment.
@@ -2066,13 +2105,8 @@ eval_sub (Lisp_Object form)
2066 2105
2067 if (SUBRP (fun)) 2106 if (SUBRP (fun))
2068 { 2107 {
2069 Lisp_Object numargs; 2108 Lisp_Object args_left = original_args;
2070 Lisp_Object argvals[8]; 2109 Lisp_Object numargs = Flength (args_left);
2071 Lisp_Object args_left;
2072 register int i, maxargs;
2073
2074 args_left = original_args;
2075 numargs = Flength (args_left);
2076 2110
2077 check_cons_list (); 2111 check_cons_list ();
2078 2112
@@ -2101,11 +2135,20 @@ eval_sub (Lisp_Object form)
2101 set_backtrace_args (specpdl + count, vals, XINT (numargs)); 2135 set_backtrace_args (specpdl + count, vals, XINT (numargs));
2102 2136
2103 val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); 2137 val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
2138
2139 check_cons_list ();
2140 lisp_eval_depth--;
2141 /* Do the debug-on-exit now, while VALS still exists. */
2142 if (backtrace_debug_on_exit (specpdl + count))
2143 val = call_debugger (list2 (Qexit, val));
2104 SAFE_FREE (); 2144 SAFE_FREE ();
2145 specpdl_ptr--;
2146 return val;
2105 } 2147 }
2106 else 2148 else
2107 { 2149 {
2108 maxargs = XSUBR (fun)->max_args; 2150 int i, maxargs = XSUBR (fun)->max_args;
2151
2109 for (i = 0; i < maxargs; i++) 2152 for (i = 0; i < maxargs; i++)
2110 { 2153 {
2111 argvals[i] = eval_sub (Fcar (args_left)); 2154 argvals[i] = eval_sub (Fcar (args_left));
@@ -2165,7 +2208,7 @@ eval_sub (Lisp_Object form)
2165 } 2208 }
2166 } 2209 }
2167 else if (COMPILEDP (fun)) 2210 else if (COMPILEDP (fun))
2168 val = apply_lambda (fun, original_args, count); 2211 return apply_lambda (fun, original_args, count);
2169 else 2212 else
2170 { 2213 {
2171 if (NILP (fun)) 2214 if (NILP (fun))
@@ -2195,7 +2238,7 @@ eval_sub (Lisp_Object form)
2195 } 2238 }
2196 else if (EQ (funcar, Qlambda) 2239 else if (EQ (funcar, Qlambda)
2197 || EQ (funcar, Qclosure)) 2240 || EQ (funcar, Qclosure))
2198 val = apply_lambda (fun, original_args, count); 2241 return apply_lambda (fun, original_args, count);
2199 else 2242 else
2200 xsignal1 (Qinvalid_function, original_fun); 2243 xsignal1 (Qinvalid_function, original_fun);
2201 } 2244 }
@@ -2750,14 +2793,13 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
2750 set_backtrace_args (specpdl + count, arg_vector, i); 2793 set_backtrace_args (specpdl + count, arg_vector, i);
2751 tem = funcall_lambda (fun, numargs, arg_vector); 2794 tem = funcall_lambda (fun, numargs, arg_vector);
2752 2795
2796 check_cons_list ();
2797 lisp_eval_depth--;
2753 /* Do the debug-on-exit now, while arg_vector still exists. */ 2798 /* Do the debug-on-exit now, while arg_vector still exists. */
2754 if (backtrace_debug_on_exit (specpdl + count)) 2799 if (backtrace_debug_on_exit (specpdl + count))
2755 { 2800 tem = call_debugger (list2 (Qexit, tem));
2756 /* Don't do it again when we return to eval. */
2757 set_backtrace_debug_on_exit (specpdl + count, false);
2758 tem = call_debugger (list2 (Qexit, tem));
2759 }
2760 SAFE_FREE (); 2801 SAFE_FREE ();
2802 specpdl_ptr--;
2761 return tem; 2803 return tem;
2762} 2804}
2763 2805
@@ -2792,6 +2834,9 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
2792 } 2834 }
2793 else if (COMPILEDP (fun)) 2835 else if (COMPILEDP (fun))
2794 { 2836 {
2837 ptrdiff_t size = ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK;
2838 if (size <= COMPILED_STACK_DEPTH)
2839 xsignal1 (Qinvalid_function, fun);
2795 syms_left = AREF (fun, COMPILED_ARGLIST); 2840 syms_left = AREF (fun, COMPILED_ARGLIST);
2796 if (INTEGERP (syms_left)) 2841 if (INTEGERP (syms_left))
2797 /* A byte-code object with a non-nil `push args' slot means we 2842 /* A byte-code object with a non-nil `push args' slot means we
@@ -2889,19 +2934,25 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
2889{ 2934{
2890 Lisp_Object tem; 2935 Lisp_Object tem;
2891 2936
2892 if (COMPILEDP (object) && CONSP (AREF (object, COMPILED_BYTECODE))) 2937 if (COMPILEDP (object))
2893 { 2938 {
2894 tem = read_doc_string (AREF (object, COMPILED_BYTECODE)); 2939 ptrdiff_t size = ASIZE (object) & PSEUDOVECTOR_SIZE_MASK;
2895 if (!CONSP (tem)) 2940 if (size <= COMPILED_STACK_DEPTH)
2941 xsignal1 (Qinvalid_function, object);
2942 if (CONSP (AREF (object, COMPILED_BYTECODE)))
2896 { 2943 {
2897 tem = AREF (object, COMPILED_BYTECODE); 2944 tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
2898 if (CONSP (tem) && STRINGP (XCAR (tem))) 2945 if (!CONSP (tem))
2899 error ("Invalid byte code in %s", SDATA (XCAR (tem))); 2946 {
2900 else 2947 tem = AREF (object, COMPILED_BYTECODE);
2901 error ("Invalid byte code"); 2948 if (CONSP (tem) && STRINGP (XCAR (tem)))
2949 error ("Invalid byte code in %s", SDATA (XCAR (tem)));
2950 else
2951 error ("Invalid byte code");
2952 }
2953 ASET (object, COMPILED_BYTECODE, XCAR (tem));
2954 ASET (object, COMPILED_CONSTANTS, XCDR (tem));
2902 } 2955 }
2903 ASET (object, COMPILED_BYTECODE, XCAR (tem));
2904 ASET (object, COMPILED_CONSTANTS, XCDR (tem));
2905 } 2956 }
2906 return object; 2957 return object;
2907} 2958}
@@ -3145,10 +3196,11 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
3145 { /* If variable has a trivial value (no forwarding), we can 3196 { /* If variable has a trivial value (no forwarding), we can
3146 just set it. No need to check for constant symbols here, 3197 just set it. No need to check for constant symbols here,
3147 since that was already done by specbind. */ 3198 since that was already done by specbind. */
3148 struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (specpdl_ptr)); 3199 Lisp_Object sym = specpdl_symbol (specpdl_ptr);
3149 if (sym->redirect == SYMBOL_PLAINVAL) 3200 if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL)
3150 { 3201 {
3151 SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr)); 3202 SET_SYMBOL_VAL (XSYMBOL (sym),
3203 specpdl_old_value (specpdl_ptr));
3152 break; 3204 break;
3153 } 3205 }
3154 else 3206 else
@@ -3357,12 +3409,12 @@ backtrace_eval_unrewind (int distance)
3357 { /* If variable has a trivial value (no forwarding), we can 3409 { /* If variable has a trivial value (no forwarding), we can
3358 just set it. No need to check for constant symbols here, 3410 just set it. No need to check for constant symbols here,
3359 since that was already done by specbind. */ 3411 since that was already done by specbind. */
3360 struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (tmp)); 3412 Lisp_Object sym = specpdl_symbol (tmp);
3361 if (sym->redirect == SYMBOL_PLAINVAL) 3413 if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL)
3362 { 3414 {
3363 Lisp_Object old_value = specpdl_old_value (tmp); 3415 Lisp_Object old_value = specpdl_old_value (tmp);
3364 set_specpdl_old_value (tmp, SYMBOL_VAL (sym)); 3416 set_specpdl_old_value (tmp, SYMBOL_VAL (XSYMBOL (sym)));
3365 SET_SYMBOL_VAL (sym, old_value); 3417 SET_SYMBOL_VAL (XSYMBOL (sym), old_value);
3366 break; 3418 break;
3367 } 3419 }
3368 else 3420 else
@@ -3607,6 +3659,7 @@ To prevent this happening, set `quit-flag' to nil
3607before making `inhibit-quit' nil. */); 3659before making `inhibit-quit' nil. */);
3608 Vinhibit_quit = Qnil; 3660 Vinhibit_quit = Qnil;
3609 3661
3662 DEFSYM (Qsetq, "setq");
3610 DEFSYM (Qinhibit_quit, "inhibit-quit"); 3663 DEFSYM (Qinhibit_quit, "inhibit-quit");
3611 DEFSYM (Qautoload, "autoload"); 3664 DEFSYM (Qautoload, "autoload");
3612 DEFSYM (Qinhibit_debugger, "inhibit-debugger"); 3665 DEFSYM (Qinhibit_debugger, "inhibit-debugger");
diff --git a/src/fileio.c b/src/fileio.c
index 6cda1e39eed..e18ddb1a7aa 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -4263,9 +4263,14 @@ by calling `format-decode', which see. */)
4263 if (CODING_FOR_UNIBYTE (&coding) 4263 if (CODING_FOR_UNIBYTE (&coding)
4264 /* Can't do this if part of the buffer might be preserved. */ 4264 /* Can't do this if part of the buffer might be preserved. */
4265 && NILP (replace)) 4265 && NILP (replace))
4266 /* Visiting a file with these coding system makes the buffer 4266 {
4267 unibyte. */ 4267 /* Visiting a file with these coding system makes the buffer
4268 bset_enable_multibyte_characters (current_buffer, Qnil); 4268 unibyte. */
4269 if (inserted > 0)
4270 bset_enable_multibyte_characters (current_buffer, Qnil);
4271 else
4272 Fset_buffer_multibyte (Qnil);
4273 }
4269 } 4274 }
4270 4275
4271 coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); 4276 coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
diff --git a/src/fns.c b/src/fns.c
index 46956668777..4c13290158a 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -338,7 +338,7 @@ This function obeys the conventions for collation order in your
338locale settings. For example, punctuation and whitespace characters 338locale settings. For example, punctuation and whitespace characters
339might be considered less significant for sorting: 339might be considered less significant for sorting:
340 340
341(sort '("11" "12" "1 1" "1 2" "1.1" "1.2") \\='string-collate-lessp) 341(sort \\='("11" "12" "1 1" "1 2" "1.1" "1.2") \\='string-collate-lessp)
342 => ("11" "1 1" "1.1" "12" "1 2" "1.2") 342 => ("11" "1 1" "1.1" "12" "1 2" "1.2")
343 343
344The optional argument LOCALE, a string, overrides the setting of your 344The optional argument LOCALE, a string, overrides the setting of your
@@ -1580,7 +1580,8 @@ sublist by modifying its list structure, then returns the resulting
1580list. 1580list.
1581 1581
1582Write `(setq foo (delq element foo))' to be sure of correctly changing 1582Write `(setq foo (delq element foo))' to be sure of correctly changing
1583the value of a list `foo'. */) 1583the value of a list `foo'. See also `remq', which does not modify the
1584argument. */)
1584 (register Lisp_Object elt, Lisp_Object list) 1585 (register Lisp_Object elt, Lisp_Object list)
1585{ 1586{
1586 Lisp_Object tail, tortoise, prev = Qnil; 1587 Lisp_Object tail, tortoise, prev = Qnil;
@@ -2763,8 +2764,9 @@ DEFUN ("require", Frequire, Srequire, 1, 3, 0,
2763If FEATURE is not a member of the list `features', then the feature 2764If FEATURE is not a member of the list `features', then the feature
2764is not loaded; so load the file FILENAME. 2765is not loaded; so load the file FILENAME.
2765If FILENAME is omitted, the printname of FEATURE is used as the file name, 2766If FILENAME is omitted, the printname of FEATURE is used as the file name,
2766and `load' will try to load this name appended with the suffix `.elc' or 2767and `load' will try to load this name appended with the suffix `.elc',
2767`.el', in that order. The name without appended suffix will not be used. 2768`.el', or the system-dependent suffix for dynamic module files, in that
2769order. The name without appended suffix will not be used.
2768See `get-load-suffixes' for the complete list of suffixes. 2770See `get-load-suffixes' for the complete list of suffixes.
2769If the optional third argument NOERROR is non-nil, 2771If the optional third argument NOERROR is non-nil,
2770then return nil if the file is not found instead of signaling an error. 2772then return nil if the file is not found instead of signaling an error.
@@ -3619,8 +3621,7 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
3619 Low-level Functions 3621 Low-level Functions
3620 ***********************************************************************/ 3622 ***********************************************************************/
3621 3623
3622static struct hash_table_test hashtest_eq; 3624struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
3623struct hash_table_test hashtest_eql, hashtest_equal;
3624 3625
3625/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code 3626/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
3626 HASH2 in hash table H using `eql'. Value is true if KEY1 and 3627 HASH2 in hash table H using `eql'. Value is true if KEY1 and
@@ -3991,7 +3992,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
3991 3992
3992/* Remove the entry matching KEY from hash table H, if there is one. */ 3993/* Remove the entry matching KEY from hash table H, if there is one. */
3993 3994
3994static void 3995void
3995hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) 3996hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
3996{ 3997{
3997 EMACS_UINT hash_code; 3998 EMACS_UINT hash_code;
@@ -4078,13 +4079,10 @@ hash_clear (struct Lisp_Hash_Table *h)
4078static bool 4079static bool
4079sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p) 4080sweep_weak_table (struct Lisp_Hash_Table *h, bool remove_entries_p)
4080{ 4081{
4081 ptrdiff_t bucket, n; 4082 ptrdiff_t n = gc_asize (h->index);
4082 bool marked; 4083 bool marked = false;
4083
4084 n = ASIZE (h->index) & ~ARRAY_MARK_FLAG;
4085 marked = 0;
4086 4084
4087 for (bucket = 0; bucket < n; ++bucket) 4085 for (ptrdiff_t bucket = 0; bucket < n; ++bucket)
4088 { 4086 {
4089 Lisp_Object idx, next, prev; 4087 Lisp_Object idx, next, prev;
4090 4088
diff --git a/src/font.h b/src/font.h
index f6f862ac7df..3f4ccb106c2 100644
--- a/src/font.h
+++ b/src/font.h
@@ -427,6 +427,13 @@ FONT_SPEC_P (Lisp_Object x)
427 return FONTP (x) && (ASIZE (x) & PSEUDOVECTOR_SIZE_MASK) == FONT_SPEC_MAX; 427 return FONTP (x) && (ASIZE (x) & PSEUDOVECTOR_SIZE_MASK) == FONT_SPEC_MAX;
428} 428}
429 429
430/* Like FONT_SPEC_P, but can be used in the garbage collector. */
431INLINE bool
432GC_FONT_SPEC_P (Lisp_Object x)
433{
434 return FONTP (x) && (gc_asize (x) & PSEUDOVECTOR_SIZE_MASK) == FONT_SPEC_MAX;
435}
436
430/* True iff X is font-entity. */ 437/* True iff X is font-entity. */
431INLINE bool 438INLINE bool
432FONT_ENTITY_P (Lisp_Object x) 439FONT_ENTITY_P (Lisp_Object x)
@@ -434,6 +441,13 @@ FONT_ENTITY_P (Lisp_Object x)
434 return FONTP (x) && (ASIZE (x) & PSEUDOVECTOR_SIZE_MASK) == FONT_ENTITY_MAX; 441 return FONTP (x) && (ASIZE (x) & PSEUDOVECTOR_SIZE_MASK) == FONT_ENTITY_MAX;
435} 442}
436 443
444/* Like FONT_ENTITY_P, but can be used in the garbage collector. */
445INLINE bool
446GC_FONT_ENTITY_P (Lisp_Object x)
447{
448 return FONTP (x) && (gc_asize (x) & PSEUDOVECTOR_SIZE_MASK) == FONT_ENTITY_MAX;
449}
450
437/* True iff X is font-object. */ 451/* True iff X is font-object. */
438INLINE bool 452INLINE bool
439FONT_OBJECT_P (Lisp_Object x) 453FONT_OBJECT_P (Lisp_Object x)
@@ -441,6 +455,13 @@ FONT_OBJECT_P (Lisp_Object x)
441 return FONTP (x) && (ASIZE (x) & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX; 455 return FONTP (x) && (ASIZE (x) & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX;
442} 456}
443 457
458/* Like FONT_OBJECT_P, but can be used in the garbage collector. */
459INLINE bool
460GC_FONT_OBJECT_P (Lisp_Object x)
461{
462 return FONTP (x) && (gc_asize (x) & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX;
463}
464
444/* Type checking functions for various font-related objects. */ 465/* Type checking functions for various font-related objects. */
445 466
446INLINE void 467INLINE void
@@ -476,6 +497,13 @@ XFONT_SPEC (Lisp_Object p)
476 return XUNTAG (p, Lisp_Vectorlike); 497 return XUNTAG (p, Lisp_Vectorlike);
477} 498}
478 499
500INLINE struct font_spec *
501GC_XFONT_SPEC (Lisp_Object p)
502{
503 eassert (GC_FONT_SPEC_P (p));
504 return XUNTAG (p, Lisp_Vectorlike);
505}
506
479INLINE struct font_entity * 507INLINE struct font_entity *
480XFONT_ENTITY (Lisp_Object p) 508XFONT_ENTITY (Lisp_Object p)
481{ 509{
@@ -483,6 +511,13 @@ XFONT_ENTITY (Lisp_Object p)
483 return XUNTAG (p, Lisp_Vectorlike); 511 return XUNTAG (p, Lisp_Vectorlike);
484} 512}
485 513
514INLINE struct font_entity *
515GC_XFONT_ENTITY (Lisp_Object p)
516{
517 eassert (GC_FONT_ENTITY_P (p));
518 return XUNTAG (p, Lisp_Vectorlike);
519}
520
486INLINE struct font * 521INLINE struct font *
487XFONT_OBJECT (Lisp_Object p) 522XFONT_OBJECT (Lisp_Object p)
488{ 523{
@@ -490,6 +525,13 @@ XFONT_OBJECT (Lisp_Object p)
490 return XUNTAG (p, Lisp_Vectorlike); 525 return XUNTAG (p, Lisp_Vectorlike);
491} 526}
492 527
528INLINE struct font *
529GC_XFONT_OBJECT (Lisp_Object p)
530{
531 eassert (GC_FONT_OBJECT_P (p));
532 return XUNTAG (p, Lisp_Vectorlike);
533}
534
493#define XSETFONT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FONT)) 535#define XSETFONT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FONT))
494 536
495INLINE struct font * 537INLINE struct font *
diff --git a/src/frame.c b/src/frame.c
index 78f8ff71be3..4897052e1f9 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -239,10 +239,10 @@ DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
239 doc: /* Return non-nil if OBJECT is a frame. 239 doc: /* Return non-nil if OBJECT is a frame.
240Value is: 240Value is:
241 t for a termcap frame (a character-only terminal), 241 t for a termcap frame (a character-only terminal),
242 'x' for an Emacs frame that is really an X window, 242 `x' for an Emacs frame that is really an X window,
243 'w32' for an Emacs frame that is a window on MS-Windows display, 243 `w32' for an Emacs frame that is a window on MS-Windows display,
244 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, 244 `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
245 'pc' for a direct-write MS-DOS frame. 245 `pc' for a direct-write MS-DOS frame.
246See also `frame-live-p'. */) 246See also `frame-live-p'. */)
247 (Lisp_Object object) 247 (Lisp_Object object)
248{ 248{
@@ -284,10 +284,10 @@ DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0,
284 doc: /* The name of the window system that FRAME is displaying through. 284 doc: /* The name of the window system that FRAME is displaying through.
285The value is a symbol: 285The value is a symbol:
286 nil for a termcap frame (a character-only terminal), 286 nil for a termcap frame (a character-only terminal),
287 'x' for an Emacs frame that is really an X window, 287 `x' for an Emacs frame that is really an X window,
288 'w32' for an Emacs frame that is a window on MS-Windows display, 288 `w32' for an Emacs frame that is a window on MS-Windows display,
289 'ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display, 289 `ns' for an Emacs frame on a GNUstep or Macintosh Cocoa display,
290 'pc' for a direct-write MS-DOS frame. 290 `pc' for a direct-write MS-DOS frame.
291 291
292FRAME defaults to the currently selected frame. 292FRAME defaults to the currently selected frame.
293 293
@@ -2641,13 +2641,16 @@ If FRAME is nil, describe the currently selected frame. */)
2641 2641
2642DEFUN ("modify-frame-parameters", Fmodify_frame_parameters, 2642DEFUN ("modify-frame-parameters", Fmodify_frame_parameters,
2643 Smodify_frame_parameters, 2, 2, 0, 2643 Smodify_frame_parameters, 2, 2, 0,
2644 doc: /* Modify the parameters of frame FRAME according to ALIST. 2644 doc: /* Modify FRAME according to new values of its parameters in ALIST.
2645If FRAME is nil, it defaults to the selected frame. 2645If FRAME is nil, it defaults to the selected frame.
2646ALIST is an alist of parameters to change and their new values. 2646ALIST is an alist of parameters to change and their new values.
2647Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol. 2647Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
2648The meaningful PARMs depend on the kind of frame. 2648Which PARMs are meaningful depends on the kind of frame.
2649Undefined PARMs are ignored, but stored in the frame's parameter list 2649The meaningful parameters are acted upon, i.e. the frame is changed
2650so that `frame-parameters' will return them. 2650according to their new values, and are also stored in the frame's
2651parameter list so that `frame-parameters' will return them.
2652PARMs that are not meaningful are still stored in the frame's parameter
2653list, but are otherwise ignored.
2651 2654
2652The value of frame parameter FOO can also be accessed 2655The value of frame parameter FOO can also be accessed
2653as a frame-local binding for the variable FOO, if you have 2656as a frame-local binding for the variable FOO, if you have
diff --git a/src/gmalloc.c b/src/gmalloc.c
index a88f4ab75e0..90a52a1c728 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -60,7 +60,6 @@ extern void emacs_abort (void);
60 which HYBRID_MACRO is defined. Any other platform that wants to 60 which HYBRID_MACRO is defined. Any other platform that wants to
61 define it will have to define the macros DUMPED and 61 define it will have to define the macros DUMPED and
62 ALLOCATED_BEFORE_DUMPING, defined below for Cygwin. */ 62 ALLOCATED_BEFORE_DUMPING, defined below for Cygwin. */
63#ifdef HYBRID_MALLOC
64#undef malloc 63#undef malloc
65#undef realloc 64#undef realloc
66#undef calloc 65#undef calloc
@@ -70,7 +69,6 @@ extern void emacs_abort (void);
70#define calloc gcalloc 69#define calloc gcalloc
71#define aligned_alloc galigned_alloc 70#define aligned_alloc galigned_alloc
72#define free gfree 71#define free gfree
73#endif /* HYBRID_MALLOC */
74 72
75#ifdef CYGWIN 73#ifdef CYGWIN
76extern void *bss_sbrk (ptrdiff_t size); 74extern void *bss_sbrk (ptrdiff_t size);
@@ -1711,13 +1709,13 @@ valloc (size_t size)
1711 return aligned_alloc (pagesize, size); 1709 return aligned_alloc (pagesize, size);
1712} 1710}
1713 1711
1714#ifdef HYBRID_MALLOC
1715#undef malloc 1712#undef malloc
1716#undef realloc 1713#undef realloc
1717#undef calloc 1714#undef calloc
1718#undef aligned_alloc 1715#undef aligned_alloc
1719#undef free 1716#undef free
1720 1717
1718#ifdef HYBRID_MALLOC
1721/* Declare system malloc and friends. */ 1719/* Declare system malloc and friends. */
1722extern void *malloc (size_t size); 1720extern void *malloc (size_t size);
1723extern void *realloc (void *ptr, size_t size); 1721extern void *realloc (void *ptr, size_t size);
@@ -1816,6 +1814,38 @@ hybrid_get_current_dir_name (void)
1816} 1814}
1817#endif 1815#endif
1818 1816
1817#else /* ! HYBRID_MALLOC */
1818
1819void *
1820malloc (size_t size)
1821{
1822 return gmalloc (size);
1823}
1824
1825void *
1826calloc (size_t nmemb, size_t size)
1827{
1828 return gcalloc (nmemb, size);
1829}
1830
1831void
1832free (void *ptr)
1833{
1834 gfree (ptr);
1835}
1836
1837void *
1838aligned_alloc (size_t alignment, size_t size)
1839{
1840 return galigned_alloc (alignment, size);
1841}
1842
1843void *
1844realloc (void *ptr, size_t size)
1845{
1846 return grealloc (ptr, size);
1847}
1848
1819#endif /* HYBRID_MALLOC */ 1849#endif /* HYBRID_MALLOC */
1820 1850
1821#ifdef GC_MCHECK 1851#ifdef GC_MCHECK
diff --git a/src/indent.c b/src/indent.c
index 04837f8f513..33bf424b344 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -2080,11 +2080,7 @@ whether or not it is currently displayed in some window. */)
2080 } 2080 }
2081 else 2081 else
2082 it_overshoot_count = 2082 it_overshoot_count =
2083 (!(it.method == GET_FROM_IMAGE 2083 !(it.method == GET_FROM_IMAGE || it.method == GET_FROM_STRETCH);
2084 || it.method == GET_FROM_STRETCH)
2085 /* We will overshoot if lines are truncated and PT lies
2086 beyond the right margin of the window. */
2087 || it.line_wrap == TRUNCATE);
2088 2084
2089 if (start_x_given) 2085 if (start_x_given)
2090 { 2086 {
@@ -2142,6 +2138,11 @@ whether or not it is currently displayed in some window. */)
2142 screen lines we need to backtrack. */ 2138 screen lines we need to backtrack. */
2143 it_overshoot_count = it.vpos; 2139 it_overshoot_count = it.vpos;
2144 } 2140 }
2141 /* We will overshoot if lines are truncated and point lies
2142 beyond the right margin of the window. */
2143 if (it.line_wrap == TRUNCATE && it.current_x >= it.last_visible_x
2144 && it_overshoot_count == 0)
2145 it_overshoot_count = 1;
2145 if (it_overshoot_count > 0) 2146 if (it_overshoot_count > 0)
2146 move_it_by_lines (&it, -it_overshoot_count); 2147 move_it_by_lines (&it, -it_overshoot_count);
2147 2148
diff --git a/src/insdel.c b/src/insdel.c
index 24807b1e8f4..bb3171b14ce 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1765,6 +1765,18 @@ modify_text (ptrdiff_t start, ptrdiff_t end)
1765 bset_point_before_scroll (current_buffer, Qnil); 1765 bset_point_before_scroll (current_buffer, Qnil);
1766} 1766}
1767 1767
1768/* Signal that we are about to make a change that may result in new
1769 undo information.
1770 */
1771static void
1772run_undoable_change (void)
1773{
1774 if (EQ (BVAR (current_buffer, undo_list), Qt))
1775 return;
1776
1777 call0 (Qundo_auto__undoable_change);
1778}
1779
1768/* Check that it is okay to modify the buffer between START and END, 1780/* Check that it is okay to modify the buffer between START and END,
1769 which are char positions. 1781 which are char positions.
1770 1782
@@ -1773,7 +1785,12 @@ modify_text (ptrdiff_t start, ptrdiff_t end)
1773 any modification properties the text may have. 1785 any modification properties the text may have.
1774 1786
1775 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR 1787 If PRESERVE_PTR is nonzero, we relocate *PRESERVE_PTR
1776 by holding its value temporarily in a marker. */ 1788 by holding its value temporarily in a marker.
1789
1790 This function runs Lisp, which means it can GC, which means it can
1791 compact buffers, including the current buffer being worked on here.
1792 So don't you dare calling this function while manipulating the gap,
1793 or during some other similar "critical section". */
1777 1794
1778void 1795void
1779prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end, 1796prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end,
@@ -1786,6 +1803,8 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end,
1786 if (!NILP (BVAR (current_buffer, read_only))) 1803 if (!NILP (BVAR (current_buffer, read_only)))
1787 Fbarf_if_buffer_read_only (temp); 1804 Fbarf_if_buffer_read_only (temp);
1788 1805
1806 run_undoable_change();
1807
1789 bset_redisplay (current_buffer); 1808 bset_redisplay (current_buffer);
1790 1809
1791 if (buffer_intervals (current_buffer)) 1810 if (buffer_intervals (current_buffer))
@@ -2187,6 +2206,8 @@ syms_of_insdel (void)
2187 combine_after_change_list = Qnil; 2206 combine_after_change_list = Qnil;
2188 combine_after_change_buffer = Qnil; 2207 combine_after_change_buffer = Qnil;
2189 2208
2209 DEFSYM (Qundo_auto__undoable_change, "undo-auto--undoable-change");
2210
2190 DEFVAR_LISP ("combine-after-change-calls", Vcombine_after_change_calls, 2211 DEFVAR_LISP ("combine-after-change-calls", Vcombine_after_change_calls,
2191 doc: /* Used internally by the function `combine-after-change-calls' macro. */); 2212 doc: /* Used internally by the function `combine-after-change-calls' macro. */);
2192 Vcombine_after_change_calls = Qnil; 2213 Vcombine_after_change_calls = Qnil;
diff --git a/src/keyboard.c b/src/keyboard.c
index ab7cb34a030..6fa38aa1328 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -195,14 +195,15 @@ Lisp_Object unread_switch_frame;
195/* Last size recorded for a current buffer which is not a minibuffer. */ 195/* Last size recorded for a current buffer which is not a minibuffer. */
196static ptrdiff_t last_non_minibuf_size; 196static ptrdiff_t last_non_minibuf_size;
197 197
198/* Total number of times read_char has returned, modulo UINTMAX_MAX + 1. */
199uintmax_t num_input_events; 198uintmax_t num_input_events;
199ptrdiff_t point_before_last_command_or_undo;
200struct buffer *buffer_before_last_command_or_undo;
200 201
201/* Value of num_nonmacro_input_events as of last auto save. */ 202/* Value of num_nonmacro_input_events as of last auto save. */
202 203
203static EMACS_INT last_auto_save; 204static EMACS_INT last_auto_save;
204 205
205/* The value of point when the last command was started. */ 206/* The value of point when the last command was started. */
206static ptrdiff_t last_point_position; 207static ptrdiff_t last_point_position;
207 208
208/* The frame in which the last input event occurred, or Qmacro if the 209/* The frame in which the last input event occurred, or Qmacro if the
@@ -1449,6 +1450,11 @@ command_loop_1 (void)
1449 result of changes from the last command. */ 1450 result of changes from the last command. */
1450 call0 (Qundo_auto__add_boundary); 1451 call0 (Qundo_auto__add_boundary);
1451 1452
1453 /* Record point and buffer, so we can put point into the undo
1454 information if necessary. */
1455 point_before_last_command_or_undo = PT;
1456 buffer_before_last_command_or_undo = current_buffer;
1457
1452 call1 (Qcommand_execute, Vthis_command); 1458 call1 (Qcommand_execute, Vthis_command);
1453 1459
1454#ifdef HAVE_WINDOW_SYSTEM 1460#ifdef HAVE_WINDOW_SYSTEM
@@ -3313,14 +3319,12 @@ readable_events (int flags)
3313#endif 3319#endif
3314 )) 3320 ))
3315 { 3321 {
3316 union buffered_input_event *event; 3322 union buffered_input_event *event = kbd_fetch_ptr;
3317
3318 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3319 ? kbd_fetch_ptr
3320 : kbd_buffer);
3321 3323
3322 do 3324 do
3323 { 3325 {
3326 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3327 event = kbd_buffer;
3324 if (!( 3328 if (!(
3325#ifdef USE_TOOLKIT_SCROLL_BARS 3329#ifdef USE_TOOLKIT_SCROLL_BARS
3326 (flags & READABLE_EVENTS_FILTER_EVENTS) && 3330 (flags & READABLE_EVENTS_FILTER_EVENTS) &&
@@ -3337,8 +3341,6 @@ readable_events (int flags)
3337 && event->kind == BUFFER_SWITCH_EVENT)) 3341 && event->kind == BUFFER_SWITCH_EVENT))
3338 return 1; 3342 return 1;
3339 event++; 3343 event++;
3340 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3341 event = kbd_buffer;
3342 } 3344 }
3343 while (event != kbd_store_ptr); 3345 while (event != kbd_store_ptr);
3344 } 3346 }
@@ -11372,7 +11374,7 @@ If an unhandled error happens in running this hook,
11372the function in which the error occurred is unconditionally removed, since 11374the function in which the error occurred is unconditionally removed, since
11373otherwise the error might happen repeatedly and make Emacs nonfunctional. 11375otherwise the error might happen repeatedly and make Emacs nonfunctional.
11374 11376
11375See also `pre-command-hook'. */); 11377See also `post-command-hook'. */);
11376 Vpre_command_hook = Qnil; 11378 Vpre_command_hook = Qnil;
11377 11379
11378 DEFVAR_LISP ("post-command-hook", Vpost_command_hook, 11380 DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
diff --git a/src/keyboard.h b/src/keyboard.h
index 98bc86b58ed..890d24eb2d9 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -245,6 +245,18 @@ extern KBOARD *current_kboard;
245/* Total number of times read_char has returned, modulo UINTMAX_MAX + 1. */ 245/* Total number of times read_char has returned, modulo UINTMAX_MAX + 1. */
246extern uintmax_t num_input_events; 246extern uintmax_t num_input_events;
247 247
248/* The location of point immediately before the last command was
249 executed, or the last time the undo-boundary command added a
250 boundary.*/
251extern ptrdiff_t point_before_last_command_or_undo;
252
253/* The value of current_buffer immediately before the last command was
254 executed, or the last time the undo-boundary command added a
255 boundary.*/
256extern struct buffer *buffer_before_last_command_or_undo;
257
258extern struct buffer *prev_buffer;
259
248/* Nonzero means polling for input is temporarily suppressed. */ 260/* Nonzero means polling for input is temporarily suppressed. */
249extern int poll_suppress_count; 261extern int poll_suppress_count;
250 262
diff --git a/src/lisp.h b/src/lisp.h
index 426b6c949e9..ff88605fc9f 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -357,7 +357,7 @@ error !;
357# define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS) 357# define lisp_h_XINT(a) (XLI (a) >> INTTYPEBITS)
358# define lisp_h_XSYMBOL(a) \ 358# define lisp_h_XSYMBOL(a) \
359 (eassert (SYMBOLP (a)), \ 359 (eassert (SYMBOLP (a)), \
360 (struct Lisp_Symbol *) ((uintptr_t) XLI (a) - Lisp_Symbol \ 360 (struct Lisp_Symbol *) ((intptr_t) XLI (a) - Lisp_Symbol \
361 + (char *) lispsym)) 361 + (char *) lispsym))
362# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) 362# define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK))
363# define lisp_h_XUNTAG(a, type) ((void *) (intptr_t) (XLI (a) - (type))) 363# define lisp_h_XUNTAG(a, type) ((void *) (intptr_t) (XLI (a) - (type)))
@@ -369,6 +369,12 @@ error !;
369#if (defined __NO_INLINE__ \ 369#if (defined __NO_INLINE__ \
370 && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ 370 && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \
371 && ! (defined INLINING && ! INLINING)) 371 && ! (defined INLINING && ! INLINING))
372# define DEFINE_KEY_OPS_AS_MACROS true
373#else
374# define DEFINE_KEY_OPS_AS_MACROS false
375#endif
376
377#if DEFINE_KEY_OPS_AS_MACROS
372# define XLI(o) lisp_h_XLI (o) 378# define XLI(o) lisp_h_XLI (o)
373# define XIL(i) lisp_h_XIL (i) 379# define XIL(i) lisp_h_XIL (i)
374# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y) 380# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y)
@@ -468,6 +474,9 @@ enum Lisp_Misc_Type
468 Lisp_Misc_Overlay, 474 Lisp_Misc_Overlay,
469 Lisp_Misc_Save_Value, 475 Lisp_Misc_Save_Value,
470 Lisp_Misc_Finalizer, 476 Lisp_Misc_Finalizer,
477#ifdef HAVE_MODULES
478 Lisp_Misc_User_Ptr,
479#endif
471 /* Currently floats are not a misc type, 480 /* Currently floats are not a misc type,
472 but let's define this in case we want to change that. */ 481 but let's define this in case we want to change that. */
473 Lisp_Misc_Float, 482 Lisp_Misc_Float,
@@ -581,6 +590,12 @@ INLINE bool PROCESSP (Lisp_Object);
581INLINE bool PSEUDOVECTORP (Lisp_Object, int); 590INLINE bool PSEUDOVECTORP (Lisp_Object, int);
582INLINE bool SAVE_VALUEP (Lisp_Object); 591INLINE bool SAVE_VALUEP (Lisp_Object);
583INLINE bool FINALIZERP (Lisp_Object); 592INLINE bool FINALIZERP (Lisp_Object);
593
594#ifdef HAVE_MODULES
595INLINE bool USER_PTRP (Lisp_Object);
596INLINE struct Lisp_User_Ptr *(XUSER_PTR) (Lisp_Object);
597#endif
598
584INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, 599INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
585 Lisp_Object); 600 Lisp_Object);
586INLINE bool STRINGP (Lisp_Object); 601INLINE bool STRINGP (Lisp_Object);
@@ -704,9 +719,15 @@ struct Lisp_Symbol
704#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \ 719#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
705 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) 720 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
706 721
707/* Yield an integer that contains TAG along with PTR. */ 722/* Yield a signed integer that contains TAG along with PTR.
723
724 Sign-extend pointers when USE_LSB_TAG (this simplifies emacs-module.c),
725 and zero-extend otherwise (that’s a bit faster here).
726 Sign extension matters only when EMACS_INT is wider than a pointer. */
708#define TAG_PTR(tag, ptr) \ 727#define TAG_PTR(tag, ptr) \
709 ((USE_LSB_TAG ? (tag) : (EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (ptr)) 728 (USE_LSB_TAG \
729 ? (intptr_t) (ptr) + (tag) \
730 : (EMACS_INT) (((EMACS_UINT) (tag) << VALBITS) + (uintptr_t) (ptr)))
710 731
711/* Yield an integer that contains a symbol tag along with OFFSET. 732/* Yield an integer that contains a symbol tag along with OFFSET.
712 OFFSET should be the offset in bytes from 'lispsym' to the symbol. */ 733 OFFSET should be the offset in bytes from 'lispsym' to the symbol. */
@@ -838,7 +859,9 @@ INLINE EMACS_INT
838INLINE EMACS_INT 859INLINE EMACS_INT
839(XFASTINT) (Lisp_Object a) 860(XFASTINT) (Lisp_Object a)
840{ 861{
841 return lisp_h_XFASTINT (a); 862 EMACS_INT n = lisp_h_XFASTINT (a);
863 eassume (0 <= n);
864 return n;
842} 865}
843 866
844INLINE struct Lisp_Symbol * 867INLINE struct Lisp_Symbol *
@@ -906,19 +929,10 @@ XFASTINT (Lisp_Object a)
906{ 929{
907 EMACS_INT int0 = Lisp_Int0; 930 EMACS_INT int0 = Lisp_Int0;
908 EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) - (int0 << VALBITS); 931 EMACS_INT n = USE_LSB_TAG ? XINT (a) : XLI (a) - (int0 << VALBITS);
909 eassert (0 <= n); 932 eassume (0 <= n);
910 return n; 933 return n;
911} 934}
912 935
913/* Extract A's value as a symbol. */
914INLINE struct Lisp_Symbol *
915XSYMBOL (Lisp_Object a)
916{
917 uintptr_t i = (uintptr_t) XUNTAG (a, Lisp_Symbol);
918 void *p = (char *) lispsym + i;
919 return p;
920}
921
922/* Extract A's type. */ 936/* Extract A's type. */
923INLINE enum Lisp_Type 937INLINE enum Lisp_Type
924XTYPE (Lisp_Object a) 938XTYPE (Lisp_Object a)
@@ -927,6 +941,16 @@ XTYPE (Lisp_Object a)
927 return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS; 941 return USE_LSB_TAG ? i & ~VALMASK : i >> VALBITS;
928} 942}
929 943
944/* Extract A's value as a symbol. */
945INLINE struct Lisp_Symbol *
946XSYMBOL (Lisp_Object a)
947{
948 eassert (SYMBOLP (a));
949 intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol);
950 void *p = (char *) lispsym + i;
951 return p;
952}
953
930/* Extract A's pointer value, assuming A's type is TYPE. */ 954/* Extract A's pointer value, assuming A's type is TYPE. */
931INLINE void * 955INLINE void *
932XUNTAG (Lisp_Object a, int type) 956XUNTAG (Lisp_Object a, int type)
@@ -1527,7 +1551,16 @@ aref_addr (Lisp_Object array, ptrdiff_t idx)
1527INLINE ptrdiff_t 1551INLINE ptrdiff_t
1528ASIZE (Lisp_Object array) 1552ASIZE (Lisp_Object array)
1529{ 1553{
1530 return XVECTOR (array)->header.size; 1554 ptrdiff_t size = XVECTOR (array)->header.size;
1555 eassume (0 <= size);
1556 return size;
1557}
1558
1559INLINE ptrdiff_t
1560gc_asize (Lisp_Object array)
1561{
1562 /* Like ASIZE, but also can be used in the garbage collector. */
1563 return XVECTOR (array)->header.size & ~ARRAY_MARK_FLAG;
1531} 1564}
1532 1565
1533INLINE void 1566INLINE void
@@ -1542,7 +1575,7 @@ gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
1542{ 1575{
1543 /* Like ASET, but also can be used in the garbage collector: 1576 /* Like ASET, but also can be used in the garbage collector:
1544 sweep_weak_table calls set_hash_key etc. while the table is marked. */ 1577 sweep_weak_table calls set_hash_key etc. while the table is marked. */
1545 eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG)); 1578 eassert (0 <= idx && idx < gc_asize (array));
1546 XVECTOR (array)->contents[idx] = val; 1579 XVECTOR (array)->contents[idx] = val;
1547} 1580}
1548 1581
@@ -1924,21 +1957,22 @@ struct Lisp_Hash_Table
1924}; 1957};
1925 1958
1926 1959
1960INLINE bool
1961HASH_TABLE_P (Lisp_Object a)
1962{
1963 return PSEUDOVECTORP (a, PVEC_HASH_TABLE);
1964}
1965
1927INLINE struct Lisp_Hash_Table * 1966INLINE struct Lisp_Hash_Table *
1928XHASH_TABLE (Lisp_Object a) 1967XHASH_TABLE (Lisp_Object a)
1929{ 1968{
1969 eassert (HASH_TABLE_P (a));
1930 return XUNTAG (a, Lisp_Vectorlike); 1970 return XUNTAG (a, Lisp_Vectorlike);
1931} 1971}
1932 1972
1933#define XSET_HASH_TABLE(VAR, PTR) \ 1973#define XSET_HASH_TABLE(VAR, PTR) \
1934 (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) 1974 (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
1935 1975
1936INLINE bool
1937HASH_TABLE_P (Lisp_Object a)
1938{
1939 return PSEUDOVECTORP (a, PVEC_HASH_TABLE);
1940}
1941
1942/* Value is the key part of entry IDX in hash table H. */ 1976/* Value is the key part of entry IDX in hash table H. */
1943INLINE Lisp_Object 1977INLINE Lisp_Object
1944HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx) 1978HASH_KEY (struct Lisp_Hash_Table *h, ptrdiff_t idx)
@@ -2230,6 +2264,18 @@ XSAVE_OBJECT (Lisp_Object obj, int n)
2230 return XSAVE_VALUE (obj)->data[n].object; 2264 return XSAVE_VALUE (obj)->data[n].object;
2231} 2265}
2232 2266
2267#ifdef HAVE_MODULES
2268struct Lisp_User_Ptr
2269{
2270 ENUM_BF (Lisp_Misc_Type) type : 16; /* = Lisp_Misc_User_Ptr */
2271 bool_bf gcmarkbit : 1;
2272 unsigned spacer : 15;
2273
2274 void (*finalizer) (void *);
2275 void *p;
2276};
2277#endif
2278
2233/* A finalizer sentinel. */ 2279/* A finalizer sentinel. */
2234struct Lisp_Finalizer 2280struct Lisp_Finalizer
2235 { 2281 {
@@ -2265,6 +2311,9 @@ union Lisp_Misc
2265 struct Lisp_Overlay u_overlay; 2311 struct Lisp_Overlay u_overlay;
2266 struct Lisp_Save_Value u_save_value; 2312 struct Lisp_Save_Value u_save_value;
2267 struct Lisp_Finalizer u_finalizer; 2313 struct Lisp_Finalizer u_finalizer;
2314#ifdef HAVE_MODULES
2315 struct Lisp_User_Ptr u_user_ptr;
2316#endif
2268 }; 2317 };
2269 2318
2270INLINE union Lisp_Misc * 2319INLINE union Lisp_Misc *
@@ -2314,6 +2363,15 @@ XFINALIZER (Lisp_Object a)
2314 return & XMISC (a)->u_finalizer; 2363 return & XMISC (a)->u_finalizer;
2315} 2364}
2316 2365
2366#ifdef HAVE_MODULES
2367INLINE struct Lisp_User_Ptr *
2368XUSER_PTR (Lisp_Object a)
2369{
2370 eassert (USER_PTRP (a));
2371 return & XMISC (a)->u_user_ptr;
2372}
2373#endif
2374
2317 2375
2318/* Forwarding pointer to an int variable. 2376/* Forwarding pointer to an int variable.
2319 This is allowed only in the value cell of a symbol, 2377 This is allowed only in the value cell of a symbol,
@@ -2598,6 +2656,14 @@ FINALIZERP (Lisp_Object x)
2598 return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer; 2656 return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer;
2599} 2657}
2600 2658
2659#ifdef HAVE_MODULES
2660INLINE bool
2661USER_PTRP (Lisp_Object x)
2662{
2663 return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_User_Ptr;
2664}
2665#endif
2666
2601INLINE bool 2667INLINE bool
2602AUTOLOADP (Lisp_Object x) 2668AUTOLOADP (Lisp_Object x)
2603{ 2669{
@@ -3104,7 +3170,9 @@ SPECPDL_INDEX (void)
3104 A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch' 3170 A call like (throw TAG VAL) searches for a catchtag whose `tag_or_ch'
3105 member is TAG, and then unbinds to it. The `val' member is used to 3171 member is TAG, and then unbinds to it. The `val' member is used to
3106 hold VAL while the stack is unwound; `val' is returned as the value 3172 hold VAL while the stack is unwound; `val' is returned as the value
3107 of the catch form. 3173 of the catch form. If there is a handler of type CATCHER_ALL, it will
3174 be treated as a handler for all invocations of `throw'; in this case
3175 `val' will be set to (TAG . VAL).
3108 3176
3109 All the other members are concerned with restoring the interpreter 3177 All the other members are concerned with restoring the interpreter
3110 state. 3178 state.
@@ -3112,7 +3180,7 @@ SPECPDL_INDEX (void)
3112 Members are volatile if their values need to survive _longjmp when 3180 Members are volatile if their values need to survive _longjmp when
3113 a 'struct handler' is a local variable. */ 3181 a 'struct handler' is a local variable. */
3114 3182
3115enum handlertype { CATCHER, CONDITION_CASE }; 3183enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL };
3116 3184
3117struct handler 3185struct handler
3118{ 3186{
@@ -3140,28 +3208,6 @@ struct handler
3140 struct byte_stack *byte_stack; 3208 struct byte_stack *byte_stack;
3141}; 3209};
3142 3210
3143/* Fill in the components of c, and put it on the list. */
3144#define PUSH_HANDLER(c, tag_ch_val, handlertype) \
3145 if (handlerlist->nextfree) \
3146 (c) = handlerlist->nextfree; \
3147 else \
3148 { \
3149 (c) = xmalloc (sizeof (struct handler)); \
3150 (c)->nextfree = NULL; \
3151 handlerlist->nextfree = (c); \
3152 } \
3153 (c)->type = (handlertype); \
3154 (c)->tag_or_ch = (tag_ch_val); \
3155 (c)->val = Qnil; \
3156 (c)->next = handlerlist; \
3157 (c)->lisp_eval_depth = lisp_eval_depth; \
3158 (c)->pdlcount = SPECPDL_INDEX (); \
3159 (c)->poll_suppress_count = poll_suppress_count; \
3160 (c)->interrupt_input_blocked = interrupt_input_blocked;\
3161 (c)->byte_stack = byte_stack_list; \
3162 handlerlist = (c);
3163
3164
3165extern Lisp_Object memory_signal_data; 3211extern Lisp_Object memory_signal_data;
3166 3212
3167/* An address near the bottom of the stack. 3213/* An address near the bottom of the stack.
@@ -3407,7 +3453,8 @@ Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
3407ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); 3453ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
3408ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, 3454ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
3409 EMACS_UINT); 3455 EMACS_UINT);
3410extern struct hash_table_test hashtest_eql, hashtest_equal; 3456void hash_remove_from_table (struct Lisp_Hash_Table *, Lisp_Object);
3457extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
3411extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, 3458extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
3412 ptrdiff_t, ptrdiff_t *, ptrdiff_t *); 3459 ptrdiff_t, ptrdiff_t *, ptrdiff_t *);
3413extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, 3460extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
@@ -3803,7 +3850,6 @@ intern_c_string (const char *str)
3803} 3850}
3804 3851
3805/* Defined in eval.c. */ 3852/* Defined in eval.c. */
3806extern EMACS_INT lisp_eval_depth;
3807extern Lisp_Object Vautoload_queue; 3853extern Lisp_Object Vautoload_queue;
3808extern Lisp_Object Vrun_hooks; 3854extern Lisp_Object Vrun_hooks;
3809extern Lisp_Object Vsignaling_function; 3855extern Lisp_Object Vsignaling_function;
@@ -3847,6 +3893,8 @@ extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp
3847extern Lisp_Object internal_condition_case_n 3893extern Lisp_Object internal_condition_case_n
3848 (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, 3894 (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
3849 Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); 3895 Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
3896extern struct handler *push_handler (Lisp_Object, enum handlertype);
3897extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype);
3850extern void specbind (Lisp_Object, Lisp_Object); 3898extern void specbind (Lisp_Object, Lisp_Object);
3851extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); 3899extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
3852extern void record_unwind_protect_ptr (void (*) (void *), void *); 3900extern void record_unwind_protect_ptr (void (*) (void *), void *);
@@ -3877,6 +3925,14 @@ Lisp_Object backtrace_top_function (void);
3877extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); 3925extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
3878extern bool let_shadows_global_binding_p (Lisp_Object symbol); 3926extern bool let_shadows_global_binding_p (Lisp_Object symbol);
3879 3927
3928#ifdef HAVE_MODULES
3929/* Defined in alloc.c. */
3930extern Lisp_Object make_user_ptr (void (*finalizer) (void*), void *p);
3931
3932/* Defined in emacs-module.c. */
3933extern void module_init (void);
3934extern void syms_of_module (void);
3935#endif
3880 3936
3881/* Defined in editfns.c. */ 3937/* Defined in editfns.c. */
3882extern void insert1 (Lisp_Object); 3938extern void insert1 (Lisp_Object);
diff --git a/src/lread.c b/src/lread.c
index c4456f37f6d..74a5fdfe67b 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -975,9 +975,20 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
975 return Fnreverse (lst); 975 return Fnreverse (lst);
976} 976}
977 977
978/* Returns true if STRING ends with SUFFIX */
979static bool
980suffix_p (Lisp_Object string, const char *suffix)
981{
982 ptrdiff_t suffix_len = strlen (suffix);
983 ptrdiff_t string_len = SBYTES (string);
984
985 return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix);
986}
987
978DEFUN ("load", Fload, Sload, 1, 5, 0, 988DEFUN ("load", Fload, Sload, 1, 5, 0,
979 doc: /* Execute a file of Lisp code named FILE. 989 doc: /* Execute a file of Lisp code named FILE.
980First try FILE with `.elc' appended, then try with `.el', 990First try FILE with `.elc' appended, then try with `.el', then try
991with a system-dependent suffix of dynamic modules (see `load-suffixes'),
981then try FILE unmodified (the exact suffixes in the exact order are 992then try FILE unmodified (the exact suffixes in the exact order are
982determined by `load-suffixes'). Environment variable references in 993determined by `load-suffixes'). Environment variable references in
983FILE are replaced with their values by calling `substitute-in-file-name'. 994FILE are replaced with their values by calling `substitute-in-file-name'.
@@ -989,10 +1000,10 @@ Print messages at start and end of loading unless
989optional third arg NOMESSAGE is non-nil (but `force-load-messages' 1000optional third arg NOMESSAGE is non-nil (but `force-load-messages'
990overrides that). 1001overrides that).
991If optional fourth arg NOSUFFIX is non-nil, don't try adding 1002If optional fourth arg NOSUFFIX is non-nil, don't try adding
992suffixes `.elc' or `.el' to the specified name FILE. 1003suffixes to the specified name FILE.
993If optional fifth arg MUST-SUFFIX is non-nil, insist on 1004If optional fifth arg MUST-SUFFIX is non-nil, insist on
994the suffix `.elc' or `.el'; don't accept just FILE unless 1005the suffix `.elc' or `.el' or the module suffix; don't accept just
995it ends in one of those suffixes or includes a directory name. 1006FILE unless it ends in one of those suffixes or includes a directory name.
996 1007
997If NOSUFFIX is nil, then if a file could not be found, try looking for 1008If NOSUFFIX is nil, then if a file could not be found, try looking for
998a different representation of the file by adding non-empty suffixes to 1009a different representation of the file by adding non-empty suffixes to
@@ -1074,12 +1085,12 @@ Return t if the file exists and loads successfully. */)
1074 if (! NILP (must_suffix)) 1085 if (! NILP (must_suffix))
1075 { 1086 {
1076 /* Don't insist on adding a suffix if FILE already ends with one. */ 1087 /* Don't insist on adding a suffix if FILE already ends with one. */
1077 ptrdiff_t size = SBYTES (file); 1088 if (suffix_p (file, ".el")
1078 if (size > 3 1089 || suffix_p (file, ".elc")
1079 && !strcmp (SSDATA (file) + size - 3, ".el")) 1090#ifdef HAVE_MODULES
1080 must_suffix = Qnil; 1091 || suffix_p (file, MODULES_SUFFIX)
1081 else if (size > 4 1092#endif
1082 && !strcmp (SSDATA (file) + size - 4, ".elc")) 1093 )
1083 must_suffix = Qnil; 1094 must_suffix = Qnil;
1084 /* Don't insist on adding a suffix 1095 /* Don't insist on adding a suffix
1085 if the argument includes a directory name. */ 1096 if the argument includes a directory name. */
@@ -1151,6 +1162,11 @@ Return t if the file exists and loads successfully. */)
1151 record_unwind_protect_int (close_file_unwind, fd); 1162 record_unwind_protect_int (close_file_unwind, fd);
1152 } 1163 }
1153 1164
1165#ifdef HAVE_MODULES
1166 if (suffix_p (found, MODULES_SUFFIX))
1167 return unbind_to (count, Fmodule_load (found));
1168#endif
1169
1154 /* Check if we're stuck in a recursive load cycle. 1170 /* Check if we're stuck in a recursive load cycle.
1155 1171
1156 2000-09-21: It's not possible to just check for the file loaded 1172 2000-09-21: It's not possible to just check for the file loaded
@@ -1189,8 +1205,7 @@ Return t if the file exists and loads successfully. */)
1189 specbind (Qold_style_backquotes, Qnil); 1205 specbind (Qold_style_backquotes, Qnil);
1190 record_unwind_protect (load_warn_old_style_backquotes, file); 1206 record_unwind_protect (load_warn_old_style_backquotes, file);
1191 1207
1192 if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4) 1208 if (suffix_p (found, ".elc") || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
1193 || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
1194 /* Load .elc files directly, but not when they are 1209 /* Load .elc files directly, but not when they are
1195 remote and have no handler! */ 1210 remote and have no handler! */
1196 { 1211 {
@@ -1926,17 +1941,22 @@ readevalloop (Lisp_Object readcharfun,
1926} 1941}
1927 1942
1928DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "", 1943DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
1929 doc: /* Execute the current buffer as Lisp code. 1944 doc: /* Execute the accessible portion of current buffer as Lisp code.
1945You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
1930When called from a Lisp program (i.e., not interactively), this 1946When called from a Lisp program (i.e., not interactively), this
1931function accepts up to five optional arguments: 1947function accepts up to five optional arguments:
1932BUFFER is the buffer to evaluate (nil means use current buffer). 1948BUFFER is the buffer to evaluate (nil means use current buffer),
1933PRINTFLAG controls printing of output: 1949 or a name of a buffer (a string).
1934 A value of nil means discard it; anything else is stream for print. 1950PRINTFLAG controls printing of output by any output functions in the
1951 evaluated code, such as `print', `princ', and `prin1':
1952 a value of nil means discard it; anything else is the stream to print to.
1953 See Info node `(elisp)Output Streams' for details on streams.
1935FILENAME specifies the file name to use for `load-history'. 1954FILENAME specifies the file name to use for `load-history'.
1936UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this 1955UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1937 invocation. 1956 invocation.
1938DO-ALLOW-PRINT, if non-nil, specifies that `print' and related 1957DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
1939 functions should work normally even if PRINTFLAG is nil. 1958 evaluated code should work normally even if PRINTFLAG is nil, in
1959 which case the output is displayed in the echo area.
1940 1960
1941This function preserves the position of point. */) 1961This function preserves the position of point. */)
1942 (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print) 1962 (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
@@ -1977,7 +1997,8 @@ When called from programs, expects two arguments,
1977giving starting and ending indices in the current buffer 1997giving starting and ending indices in the current buffer
1978of the text to be executed. 1998of the text to be executed.
1979Programs can pass third argument PRINTFLAG which controls output: 1999Programs can pass third argument PRINTFLAG which controls output:
1980A value of nil means discard it; anything else is stream for printing it. 2000 a value of nil means discard it; anything else is stream for printing it.
2001 See Info node `(elisp)Output Streams' for details on streams.
1981Also the fourth argument READ-FUNCTION, if non-nil, is used 2002Also the fourth argument READ-FUNCTION, if non-nil, is used
1982instead of `read' to read each expression. It gets one argument 2003instead of `read' to read each expression. It gets one argument
1983which is the input stream for reading characters. 2004which is the input stream for reading characters.
@@ -3926,10 +3947,8 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
3926 Lisp_Object bucket, tem; 3947 Lisp_Object bucket, tem;
3927 3948
3928 obarray = check_obarray (obarray); 3949 obarray = check_obarray (obarray);
3929 obsize = ASIZE (obarray);
3930
3931 /* This is sometimes needed in the middle of GC. */ 3950 /* This is sometimes needed in the middle of GC. */
3932 obsize &= ~ARRAY_MARK_FLAG; 3951 obsize = gc_asize (obarray);
3933 hash = hash_string (ptr, size_byte) % obsize; 3952 hash = hash_string (ptr, size_byte) % obsize;
3934 bucket = AREF (obarray, hash); 3953 bucket = AREF (obarray, hash);
3935 oblookup_last_bucket_number = hash; 3954 oblookup_last_bucket_number = hash;
@@ -4334,7 +4353,7 @@ init_lread (void)
4334 load_path_check (default_lpath); 4353 load_path_check (default_lpath);
4335 4354
4336 /* Add the site-lisp directories to the front of the default. */ 4355 /* Add the site-lisp directories to the front of the default. */
4337 if (!no_site_lisp) 4356 if (!no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
4338 { 4357 {
4339 Lisp_Object sitelisp; 4358 Lisp_Object sitelisp;
4340 sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0); 4359 sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
@@ -4365,7 +4384,7 @@ init_lread (void)
4365 load_path_check (Vload_path); 4384 load_path_check (Vload_path);
4366 4385
4367 /* Add the site-lisp directories at the front. */ 4386 /* Add the site-lisp directories at the front. */
4368 if (initialized && !no_site_lisp) 4387 if (initialized && !no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
4369 { 4388 {
4370 Lisp_Object sitelisp; 4389 Lisp_Object sitelisp;
4371 sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0); 4390 sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
@@ -4436,7 +4455,7 @@ to find all the symbols in an obarray, use `mapatoms'. */);
4436 4455
4437 DEFVAR_LISP ("values", Vvalues, 4456 DEFVAR_LISP ("values", Vvalues,
4438 doc: /* List of values of all expressions which were read, evaluated and printed. 4457 doc: /* List of values of all expressions which were read, evaluated and printed.
4439 Order is reverse chronological. */); 4458Order is reverse chronological. */);
4440 XSYMBOL (intern ("values"))->declared_special = 0; 4459 XSYMBOL (intern ("values"))->declared_special = 0;
4441 4460
4442 DEFVAR_LISP ("standard-input", Vstandard_input, 4461 DEFVAR_LISP ("standard-input", Vstandard_input,
@@ -4487,12 +4506,26 @@ programs that process this list should tolerate directories both with
4487and without trailing slashes. */); 4506and without trailing slashes. */);
4488 4507
4489 DEFVAR_LISP ("load-suffixes", Vload_suffixes, 4508 DEFVAR_LISP ("load-suffixes", Vload_suffixes,
4490 doc: /* List of suffixes for (compiled or source) Emacs Lisp files. 4509 doc: /* List of suffixes for Emacs Lisp files and dynamic modules.
4510This list includes suffixes for both compiled and source Emacs Lisp files.
4491This list should not include the empty string. 4511This list should not include the empty string.
4492`load' and related functions try to append these suffixes, in order, 4512`load' and related functions try to append these suffixes, in order,
4493to the specified file name if a Lisp suffix is allowed or required. */); 4513to the specified file name if a suffix is allowed or required. */);
4514#ifdef HAVE_MODULES
4515 Vload_suffixes = list3 (build_pure_c_string (".elc"),
4516 build_pure_c_string (".el"),
4517 build_pure_c_string (MODULES_SUFFIX));
4518#else
4494 Vload_suffixes = list2 (build_pure_c_string (".elc"), 4519 Vload_suffixes = list2 (build_pure_c_string (".elc"),
4495 build_pure_c_string (".el")); 4520 build_pure_c_string (".el"));
4521#endif
4522 DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix,
4523 doc: /* Suffix of loadable module file, or nil of modules are not supported. */);
4524#ifdef HAVE_MODULES
4525 Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX);
4526#else
4527 Vmodule_file_suffix = Qnil;
4528#endif
4496 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes, 4529 DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
4497 doc: /* List of suffixes that indicate representations of \ 4530 doc: /* List of suffixes that indicate representations of \
4498the same file. 4531the same file.
diff --git a/src/macfont.m b/src/macfont.m
index fae284fad89..3023fbea78c 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -771,7 +771,7 @@ mac_font_descriptor_get_adjusted_weight (CTFontDescriptorRef desc, CGFloat val)
771{ 771{
772 long percent_val = lround (val * 100); 772 long percent_val = lround (val * 100);
773 773
774 if (percent_val == -40 || percent_val == 56) 774 if (percent_val == -40)
775 { 775 {
776 CTFontRef font = NULL; 776 CTFontRef font = NULL;
777 CFStringRef name = 777 CFStringRef name =
@@ -786,19 +786,10 @@ mac_font_descriptor_get_adjusted_weight (CTFontDescriptorRef desc, CGFloat val)
786 { 786 {
787 CFIndex weight = mac_font_get_weight (font); 787 CFIndex weight = mac_font_get_weight (font);
788 788
789 if (percent_val == -40) 789 /* Workaround for crash when displaying Oriya characters
790 { 790 with Arial Unicode MS on OS X 10.11. */
791 /* Workaround for crash when displaying Oriya characters 791 if (weight == 5)
792 with Arial Unicode MS on OS X 10.11. */ 792 val = 0;
793 if (weight == 5)
794 val = 0;
795 }
796 else /* percent_val == 56 */
797 {
798 if (weight == 9)
799 /* Adjustment for HiraginoSans-W7 on OS X 10.11. */
800 val = 0.4;
801 }
802 CFRelease (font); 793 CFRelease (font);
803 } 794 }
804 } 795 }
diff --git a/src/nsfns.m b/src/nsfns.m
index c24344436ad..5fa68c0a15c 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -405,10 +405,12 @@ ns_set_name_internal (struct frame *f, Lisp_Object name)
405 NSString *str; 405 NSString *str;
406 NSView *view = FRAME_NS_VIEW (f); 406 NSView *view = FRAME_NS_VIEW (f);
407 407
408
408 encoded_name = ENCODE_UTF_8 (name); 409 encoded_name = ENCODE_UTF_8 (name);
409 410
410 str = [NSString stringWithUTF8String: SSDATA (encoded_name)]; 411 str = [NSString stringWithUTF8String: SSDATA (encoded_name)];
411 412
413
412 /* Don't change the name if it's already NAME. */ 414 /* Don't change the name if it's already NAME. */
413 if (! [[[view window] title] isEqualToString: str]) 415 if (! [[[view window] title] isEqualToString: str])
414 [[view window] setTitle: str]; 416 [[view window] setTitle: str];
@@ -483,9 +485,14 @@ x_implicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
483{ 485{
484 NSTRACE ("x_implicitly_set_name"); 486 NSTRACE ("x_implicitly_set_name");
485 487
488 Lisp_Object frame_title = buffer_local_value
489 (Qframe_title_format, XWINDOW (f->selected_window)->contents);
490 Lisp_Object icon_title = buffer_local_value
491 (Qicon_title_format, XWINDOW (f->selected_window)->contents);
492
486 /* Deal with NS specific format t. */ 493 /* Deal with NS specific format t. */
487 if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (Vicon_title_format, Qt)) 494 if (FRAME_NS_P (f) && ((FRAME_ICONIFIED_P (f) && EQ (icon_title, Qt))
488 || EQ (Vframe_title_format, Qt))) 495 || EQ (frame_title, Qt)))
489 ns_set_name_as_filename (f); 496 ns_set_name_as_filename (f);
490 else 497 else
491 ns_set_name (f, arg, 0); 498 ns_set_name (f, arg, 0);
@@ -648,8 +655,15 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
648void 655void
649x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) 656x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
650{ 657{
658 /* Currently, when the tool bar change state, the frame is resized.
659
660 TODO: It would be better if this didn't occur when 1) the frame
661 is full height or maximized or 2) when specified by
662 `frame-inhibit-implied-resize'. */
651 int nlines; 663 int nlines;
652 664
665 NSTRACE ("x_set_tool_bar_lines");
666
653 if (FRAME_MINIBUF_ONLY_P (f)) 667 if (FRAME_MINIBUF_ONLY_P (f))
654 return; 668 return;
655 669
@@ -669,7 +683,21 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
669 { 683 {
670 free_frame_tool_bar (f); 684 free_frame_tool_bar (f);
671 FRAME_EXTERNAL_TOOL_BAR (f) = 0; 685 FRAME_EXTERNAL_TOOL_BAR (f) = 0;
672 } 686
687 {
688 EmacsView *view = FRAME_NS_VIEW (f);
689 int fs_state = [view fullscreenState];
690
691 if (fs_state == FULLSCREEN_MAXIMIZED)
692 {
693 [view setFSValue:FULLSCREEN_WIDTH];
694 }
695 else if (fs_state == FULLSCREEN_HEIGHT)
696 {
697 [view setFSValue:FULLSCREEN_NONE];
698 }
699 }
700 }
673 } 701 }
674 702
675 { 703 {
@@ -680,12 +708,12 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
680 || (CONSP (frame_inhibit_implied_resize) 708 || (CONSP (frame_inhibit_implied_resize)
681 && !NILP (Fmemq (Qtool_bar_lines, 709 && !NILP (Fmemq (Qtool_bar_lines,
682 frame_inhibit_implied_resize)))) 710 frame_inhibit_implied_resize))))
683 /* This will probably fail to DTRT in the
684 fullheight/-width cases. */
685 && NILP (get_frame_param (f, Qfullscreen))) 711 && NILP (get_frame_param (f, Qfullscreen)))
686 ? 0 712 ? 0
687 : 2); 713 : 2);
688 714
715 NSTRACE_MSG ("inhibit:%d", inhibit);
716
689 frame_size_history_add (f, Qupdate_frame_tool_bar, 0, 0, Qnil); 717 frame_size_history_add (f, Qupdate_frame_tool_bar, 0, 0, Qnil);
690 adjust_frame_size (f, -1, -1, inhibit, 0, Qtool_bar_lines); 718 adjust_frame_size (f, -1, -1, inhibit, 0, Qtool_bar_lines);
691 } 719 }
@@ -2071,39 +2099,6 @@ there was no result. */)
2071} 2099}
2072 2100
2073 2101
2074DEFUN ("ns-convert-utf8-nfd-to-nfc", Fns_convert_utf8_nfd_to_nfc,
2075 Sns_convert_utf8_nfd_to_nfc, 1, 1, 0,
2076 doc: /* Return an NFC string that matches the UTF-8 NFD string STR. */)
2077 (Lisp_Object str)
2078{
2079/* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping,
2080 remove this. */
2081 NSString *utfStr;
2082 Lisp_Object ret = Qnil;
2083 NSAutoreleasePool *pool;
2084
2085 CHECK_STRING (str);
2086 pool = [[NSAutoreleasePool alloc] init];
2087 utfStr = [NSString stringWithUTF8String: SSDATA (str)];
2088#ifdef NS_IMPL_COCOA
2089 if (utfStr)
2090 utfStr = [utfStr precomposedStringWithCanonicalMapping];
2091#endif
2092 if (utfStr)
2093 {
2094 const char *cstr = [utfStr UTF8String];
2095 if (cstr)
2096 ret = build_string (cstr);
2097 }
2098
2099 [pool release];
2100 if (NILP (ret))
2101 error ("Invalid UTF-8");
2102
2103 return ret;
2104}
2105
2106
2107#ifdef NS_IMPL_COCOA 2102#ifdef NS_IMPL_COCOA
2108 2103
2109/* Compile and execute the AppleScript SCRIPT and return the error 2104/* Compile and execute the AppleScript SCRIPT and return the error
@@ -3113,6 +3108,8 @@ void
3113syms_of_nsfns (void) 3108syms_of_nsfns (void)
3114{ 3109{
3115 DEFSYM (Qfontsize, "fontsize"); 3110 DEFSYM (Qfontsize, "fontsize");
3111 DEFSYM (Qframe_title_format, "frame-title-format");
3112 DEFSYM (Qicon_title_format, "icon-title-format");
3116 3113
3117 DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist, 3114 DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
3118 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames. 3115 doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
@@ -3177,7 +3174,6 @@ be used as the image of the icon representing the frame. */);
3177 defsubr (&Sns_emacs_info_panel); 3174 defsubr (&Sns_emacs_info_panel);
3178 defsubr (&Sns_list_services); 3175 defsubr (&Sns_list_services);
3179 defsubr (&Sns_perform_service); 3176 defsubr (&Sns_perform_service);
3180 defsubr (&Sns_convert_utf8_nfd_to_nfc);
3181 defsubr (&Sns_popup_font_panel); 3177 defsubr (&Sns_popup_font_panel);
3182 defsubr (&Sns_popup_color_panel); 3178 defsubr (&Sns_popup_color_panel);
3183 3179
diff --git a/src/nsimage.m b/src/nsimage.m
index bdaf6a46b83..fad2538a0cb 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -66,7 +66,7 @@ ns_image_for_XPM (int width, int height, int depth)
66void * 66void *
67ns_image_from_file (Lisp_Object file) 67ns_image_from_file (Lisp_Object file)
68{ 68{
69 NSTRACE ("ns_image_from_bitmap_file"); 69 NSTRACE ("ns_image_from_file");
70 return [EmacsImage allocInitFromFile: file]; 70 return [EmacsImage allocInitFromFile: file];
71} 71}
72 72
diff --git a/src/nsmenu.m b/src/nsmenu.m
index ddc5dc20a82..3cb61e50f7f 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -1293,6 +1293,14 @@ update_frame_tool_bar (struct frame *f)
1293 //return [identifierToItem allKeys]; 1293 //return [identifierToItem allKeys];
1294} 1294}
1295 1295
1296- (void)setVisible:(BOOL)shown
1297{
1298 NSTRACE ("[EmacsToolbar setVisible:%d]", shown);
1299
1300 [super setVisible:shown];
1301}
1302
1303
1296/* optional and unneeded */ 1304/* optional and unneeded */
1297/* - toolbarWillAddItem: (NSNotification *)notification { } */ 1305/* - toolbarWillAddItem: (NSNotification *)notification { } */
1298/* - toolbarDidRemoveItem: (NSNotification *)notification { } */ 1306/* - toolbarDidRemoveItem: (NSNotification *)notification { } */
diff --git a/src/nsterm.h b/src/nsterm.h
index 1b330f08636..7e6e8efc478 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -67,12 +67,27 @@ typedef float EmacsCGFloat;
67 67
68/* Uncomment the following line to enable trace. 68/* Uncomment the following line to enable trace.
69 69
70 Uncomment suitable NSTRACE_GROUP_xxx lines to trace more.
71
70 Hint: keep the trailing whitespace -- the version control system 72 Hint: keep the trailing whitespace -- the version control system
71 will reject accidental commits. */ 73 will reject accidental commits. */
72 74
73/* #define NSTRACE_ENABLED 1 */ 75/* #define NSTRACE_ENABLED 1 */
74 76
75 77
78/* When non-zero, trace output is enabled for all parts, except those
79 explicitly disabled. */
80/* #define NSTRACE_ALL_GROUPS 1 */
81
82/* When non-zero, trace output is enabled in the corresponding part. */
83/* #define NSTRACE_GROUP_EVENTS 1 */
84/* #define NSTRACE_GROUP_UPDATES 1 */
85/* #define NSTRACE_GROUP_FRINGE 1 */
86/* #define NSTRACE_GROUP_COLOR 1 */
87/* #define NSTRACE_GROUP_GLYPHS 1 */
88/* #define NSTRACE_GROUP_FOCUS 1 */
89
90
76/* Print a call tree containing all annotated functions. 91/* Print a call tree containing all annotated functions.
77 92
78 The call structure of the functions is represented using 93 The call structure of the functions is represented using
@@ -87,60 +102,94 @@ typedef float EmacsCGFloat;
87 The first column contains the file name, the second the line 102 The first column contains the file name, the second the line
88 number, and the third a number increasing for each trace line. 103 number, and the third a number increasing for each trace line.
89 104
105 Note, when trace output from several threads are mixed, the output
106 can become misaligned, as all threads (currently) share one state.
107 This is post prominent when the EVENTS part is enabled.
108
90 Note that the trace system, when enabled, use the GCC/Clang 109 Note that the trace system, when enabled, use the GCC/Clang
91 "cleanup" extension. 110 "cleanup" extension. */
92 111
93 For example (long lines manually split to reduce width): 112/* For example, the following is the output of `M-x
94 113 toggle-frame-maximized RET'.
95nsterm.m : 1600: [ 4428] ns_fullscreen_hook 114
96nsterm.m : 7006: [ 4429] | handleFS 115 (Long lines manually split to reduced width):
97nsterm.m : 7035: [ 4430] | +--- FULLSCREEN_MAXIMIZED 116
98nsterm.m : 7627: [ 4431] | | performZoom 117nsterm.m : 1608: [ 354] ns_fullscreen_hook
99nsterm.m : 7636: [ 4432] | | | zoom 118nsterm.m : 7180: [ 355] | [EmacsView handleFS]
100nsterm.m : 874: [ 4433] | | | | ns_update_auto_hide_menu_bar 119nsterm.m : 7209: [ 356] | +--- FULLSCREEN_MAXIMIZED
101nsterm.m : 6615: [ 4434] | | | | [windowWillUseStandardFrame: 120nsterm.m : 7706: [ 357] | | [EmacsWindow performZoom:]
102 defaultFrame:(X:0 Y:0)/(W:1600 H:1177)] 121nsterm.m : 7715: [ 358] | | | [EmacsWindow zoom:]
103nsterm.m : 99: [ 4435] | | | | +--- fs_state: FULLSCREEN_NONE 122nsterm.m : 882: [ 359] | | | | ns_update_auto_hide_menu_bar
104nsterm.m : 119: [ 4436] | | | | +--- fs_before_fs: -1 123nsterm.m : 6752: [ 360] | | | |
105nsterm.m : 115: [ 4437] | | | | +--- next_maximized: FULLSCREEN_MAXIMIZED 124 [EmacsView windowWillUseStandardFrame:defaultFrame:(X:0 Y:0)/(W:1600 H:1177)]
106nsterm.m : 6619: [ 4438] | | | | +--- ns_userRect: (X:0 Y:0)/(W:0 H:0) 125nsterm.m : 6753: [ 361] | | | | +--- fs_state: FULLSCREEN_NONE
107nsterm.m : 6620: [ 4439] | | | | +--- [sender frame]: 126nsterm.m : 6754: [ 362] | | | | +--- fs_before_fs: -1
108 (X:0 Y:626)/(W:595 H:551) 127nsterm.m : 6755: [ 363] | | | | +--- next_maximized: FULLSCREEN_MAXIMIZED
109nsterm.m : 6644: [ 4440] | | | | +--- ns_userRect (2): 128nsterm.m : 6756: [ 364] | | | | +--- ns_userRect: (X:0 Y:0)/(W:0 H:0)
110 (X:0 Y:626)/(W:595 H:551) 129nsterm.m : 6757: [ 365] | | | | +---
111nsterm.m : 6684: [ 4441] | | | | +--- FULLSCREEN_MAXIMIZED 130 [sender frame]: (X:0 Y:626)/(W:595 H:551)
112nsterm.m : 7057: [ 4442] | | | | | setFSValue 131nsterm.m : 6781: [ 366] | | | | +---
113nsterm.m : 115: [ 4443] | | | | | +--- value: FULLSCREEN_MAXIMIZED 132 ns_userRect (2): (X:0 Y:626)/(W:595 H:551)
114nsterm.m : 6711: [ 4444] | | | | +--- Final ns_userRect: 133nsterm.m : 6821: [ 367] | | | | +--- FULLSCREEN_MAXIMIZED
115 (X:0 Y:626)/(W:595 H:551) 134nsterm.m : 7232: [ 368] | | | | |
116nsterm.m : 6712: [ 4445] | | | | +--- Final maximized_width: 1600 135 [EmacsView setFSValue:FULLSCREEN_MAXIMIZED]
117nsterm.m : 6713: [ 4446] | | | | +--- Final maximized_height: 1177 136nsterm.m : 6848: [ 369] | | | | +---
118nsterm.m : 119: [ 4447] | | | | +--- Final next_maximized: -1 137 Final ns_userRect: (X:0 Y:626)/(W:595 H:551)
119nsterm.m : 6209: [ 4448] | | | | | windowWillResize: toSize: (W:1600 H:1177) 138nsterm.m : 6849: [ 370] | | | | +--- Final maximized_width: 1600
120nsterm.m : 6210: [ 4449] | | | | | +--- [sender frame]: 139nsterm.m : 6850: [ 371] | | | | +--- Final maximized_height: 1177
121 (X:0 Y:626)/(W:595 H:551) 140nsterm.m : 6851: [ 372] | | | | +--- Final next_maximized: -1
122nsterm.m : 115: [ 4450] | | | | | +--- fs_state: FULLSCREEN_MAXIMIZED 141nsterm.m : 6322: [ 373] | | | | |
123nsterm.m : 6274: [ 4451] | | | | | +--- cols: 223 rows: 79 142 [EmacsView windowWillResize:toSize: (W:1600 H:1177)]
124nsterm.m : 6299: [ 4452] | | | | | +->> (W:1596 H:1167) 143nsterm.m : 6323: [ 374] | | | | | +---
125nsterm.m : 6718: [ 4453] | | | | +->> (X:0 Y:0)/(W:1600 H:1177) 144 [sender frame]: (X:0 Y:626)/(W:595 H:551)
126 145nsterm.m : 6324: [ 375] | | | | | +--- fs_state: FULLSCREEN_MAXIMIZED
127 Here, "ns_fullscreen_hook" calls "handleFS", which is turn calls 146nsterm.m : 7027: [ 376] | | | | | | [EmacsView isFullscreen]
128 "performZoom". This function calls "[super performZoom]", which 147nsterm.m : 6387: [ 377] | | | | | +--- cols: 223 rows: 79
129 isn't annotated (so it doesn't show up in the trace). However, it 148nsterm.m : 6412: [ 378] | | | | | +->> (W:1596 H:1167)
130 calls "zoom" which is annotated so it is part of the call trace. 149nsterm.m : 6855: [ 379] | | | | +->> (X:0 Y:0)/(W:1600 H:1177)
131 Later, the method "windowWillUseStandardFrame" and the function 150*/
132 "setFSValue" are called. The lines with "+---" contain extra
133 information and lines containing "->>" represent return values. */
134 151
135#ifndef NSTRACE_ENABLED 152#ifndef NSTRACE_ENABLED
136#define NSTRACE_ENABLED 0 153#define NSTRACE_ENABLED 0
137#endif 154#endif
138 155
139#if NSTRACE_ENABLED 156#if NSTRACE_ENABLED
140extern int nstrace_num; 157
141extern int nstrace_depth; 158#ifndef NSTRACE_ALL_GROUPS
159#define NSTRACE_ALL_GROUPS 0
160#endif
161
162#ifndef NSTRACE_GROUP_EVENTS
163#define NSTRACE_GROUP_EVENTS NSTRACE_ALL_GROUPS
164#endif
165
166#ifndef NSTRACE_GROUP_UPDATES
167#define NSTRACE_GROUP_UPDATES NSTRACE_ALL_GROUPS
168#endif
169
170#ifndef NSTRACE_GROUP_FRINGE
171#define NSTRACE_GROUP_FRINGE NSTRACE_ALL_GROUPS
172#endif
173
174#ifndef NSTRACE_GROUP_COLOR
175#define NSTRACE_GROUP_COLOR NSTRACE_ALL_GROUPS
176#endif
177
178#ifndef NSTRACE_GROUP_GLYPHS
179#define NSTRACE_GROUP_GLYPHS NSTRACE_ALL_GROUPS
180#endif
181
182#ifndef NSTRACE_GROUP_FOCUS
183#define NSTRACE_GROUP_FOCUS NSTRACE_ALL_GROUPS
184#endif
185
186extern volatile int nstrace_num;
187extern volatile int nstrace_depth;
188extern volatile int nstrace_enabled_global;
142 189
143void nstrace_leave(int *); 190void nstrace_leave(int *);
191void nstrace_restore_global_trace_state(int *);
192char const * nstrace_fullscreen_type_name (int);
144 193
145/* printf-style trace output. Output is aligned with contained heading. */ 194/* printf-style trace output. Output is aligned with contained heading. */
146#define NSTRACE_MSG_NO_DASHES(...) \ 195#define NSTRACE_MSG_NO_DASHES(...) \
@@ -149,7 +198,7 @@ void nstrace_leave(int *);
149 if (nstrace_enabled) \ 198 if (nstrace_enabled) \
150 { \ 199 { \
151 fprintf (stderr, "%-10s:%5d: [%5d]%.*s", \ 200 fprintf (stderr, "%-10s:%5d: [%5d]%.*s", \
152 __FILE__, __LINE__, ++nstrace_num, \ 201 __FILE__, __LINE__, nstrace_num++, \
153 2*nstrace_depth, " | | | | | | | | | | | | | | | .."); \ 202 2*nstrace_depth, " | | | | | | | | | | | | | | | .."); \
154 fprintf (stderr, __VA_ARGS__); \ 203 fprintf (stderr, __VA_ARGS__); \
155 fprintf (stderr, "\n"); \ 204 fprintf (stderr, "\n"); \
@@ -176,6 +225,9 @@ void nstrace_leave(int *);
176#define NSTRACE_ARG_RECT(elt) \ 225#define NSTRACE_ARG_RECT(elt) \
177 NSTRACE_ARG_POINT((elt).origin), NSTRACE_ARG_SIZE((elt).size) 226 NSTRACE_ARG_POINT((elt).origin), NSTRACE_ARG_SIZE((elt).size)
178 227
228#define NSTRACE_FMT_FSTYPE "%s"
229#define NSTRACE_ARG_FSTYPE(elt) nstrace_fullscreen_type_name(elt)
230
179 231
180/* Macros for printing complex types as extra information. */ 232/* Macros for printing complex types as extra information. */
181 233
@@ -192,14 +244,8 @@ void nstrace_leave(int *);
192 NSTRACE_ARG_RECT (rect)); 244 NSTRACE_ARG_RECT (rect));
193 245
194#define NSTRACE_FSTYPE(str,fs_type) \ 246#define NSTRACE_FSTYPE(str,fs_type) \
195 do \ 247 NSTRACE_MSG (str ": " NSTRACE_FMT_FSTYPE, \
196 { \ 248 NSTRACE_ARG_FSTYPE (fs_type));
197 if (nstrace_enabled) \
198 { \
199 ns_print_fullscreen_type_name(str, fs_type); \
200 } \
201 } \
202 while(0)
203 249
204 250
205/* Return value macros. 251/* Return value macros.
@@ -242,17 +288,25 @@ void nstrace_leave(int *);
242 288
243 289
244#define NSTRACE_WHEN(cond, ...) \ 290#define NSTRACE_WHEN(cond, ...) \
291 __attribute__((cleanup(nstrace_restore_global_trace_state))) \
292 int nstrace_saved_enabled_global = nstrace_enabled_global; \
245 __attribute__((cleanup(nstrace_leave))) \ 293 __attribute__((cleanup(nstrace_leave))) \
246 int nstrace_enabled = (cond); \ 294 int nstrace_enabled = nstrace_enabled_global && (cond); \
247 if (nstrace_enabled) { ++nstrace_depth; } \ 295 if (nstrace_enabled) { ++nstrace_depth; } \
296 else { nstrace_enabled_global = 0; } \
248 NSTRACE_MSG_NO_DASHES(__VA_ARGS__); 297 NSTRACE_MSG_NO_DASHES(__VA_ARGS__);
249 298
299/* Unsilence called functions.
300
301 Concretely, this us used to allow "event" functions to be silenced
302 while trace output can be printed for functions they call. */
303#define NSTRACE_UNSILENCE() do { nstrace_enabled_global = 1; } while(0)
304
250#endif /* NSTRACE_ENABLED */ 305#endif /* NSTRACE_ENABLED */
251 306
252#define NSTRACE(...) NSTRACE_WHEN(1, __VA_ARGS__) 307#define NSTRACE(...) NSTRACE_WHEN(1, __VA_ARGS__)
253#define NSTRACE_UNLESS(cond, ...) NSTRACE_WHEN(!(cond), __VA_ARGS__) 308#define NSTRACE_UNLESS(cond, ...) NSTRACE_WHEN(!(cond), __VA_ARGS__)
254 309
255
256/* Non-trace replacement versions. */ 310/* Non-trace replacement versions. */
257#ifndef NSTRACE_WHEN 311#ifndef NSTRACE_WHEN
258#define NSTRACE_WHEN(...) 312#define NSTRACE_WHEN(...)
@@ -294,6 +348,9 @@ void nstrace_leave(int *);
294#define NSTRACE_RETURN_FSTYPE(fs_type) 348#define NSTRACE_RETURN_FSTYPE(fs_type)
295#endif 349#endif
296 350
351#ifndef NSTRACE_UNSILENCE
352#define NSTRACE_UNSILENCE()
353#endif
297 354
298 355
299/* ========================================================================== 356/* ==========================================================================
@@ -412,6 +469,13 @@ void nstrace_leave(int *);
412- (void)windowDidMove: (id)sender; 469- (void)windowDidMove: (id)sender;
413#endif 470#endif
414- (int)fullscreenState; 471- (int)fullscreenState;
472
473/* Non-notification versions of NSView methods. Used for direct calls. */
474- (void)windowWillEnterFullScreen;
475- (void)windowDidEnterFullScreen;
476- (void)windowWillExitFullScreen;
477- (void)windowDidExitFullScreen;
478- (void)windowDidBecomeKey;
415@end 479@end
416 480
417 481
diff --git a/src/nsterm.m b/src/nsterm.m
index 5c39d5c0e4d..36e08c60575 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -72,9 +72,26 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
72extern NSString *NSMenuDidBeginTrackingNotification; 72extern NSString *NSMenuDidBeginTrackingNotification;
73 73
74 74
75/* ==========================================================================
76
77 NSTRACE, Trace support.
78
79 ========================================================================== */
80
75#if NSTRACE_ENABLED 81#if NSTRACE_ENABLED
76int nstrace_num = 0; 82
77int nstrace_depth = 0; 83/* The following use "volatile" since they can be accessed from
84 parallel threads. */
85volatile int nstrace_num = 0;
86volatile int nstrace_depth = 0;
87
88/* When 0, no trace is emitted. This is used by NSTRACE_WHEN and
89 NSTRACE_UNLESS to silence functions called.
90
91 TODO: This should really be a thread-local variable, to avoid that
92 a function with disabled trace thread silence trace output in
93 another. However, in practice this seldom is a problem. */
94volatile int nstrace_enabled_global = 1;
78 95
79/* Called when nstrace_enabled goes out of scope. */ 96/* Called when nstrace_enabled goes out of scope. */
80void nstrace_leave(int * pointer_to_nstrace_enabled) 97void nstrace_leave(int * pointer_to_nstrace_enabled)
@@ -86,38 +103,24 @@ void nstrace_leave(int * pointer_to_nstrace_enabled)
86} 103}
87 104
88 105
89void ns_print_fullscreen_type_name (char const * s, int fs_type) 106/* Called when nstrace_saved_enabled_global goes out of scope. */
107void nstrace_restore_global_trace_state(int * pointer_to_saved_enabled_global)
90{ 108{
91 // This is a support function for the NSTRACE system, don't add a 109 nstrace_enabled_global = *pointer_to_saved_enabled_global;
92 // NSTRACE () here. However, a local `nstrace_enabled' variable is 110}
93 // needed by the NSTRACE_MSG macros. 111
94 int nstrace_enabled = 1;
95 112
113char const * nstrace_fullscreen_type_name (int fs_type)
114{
96 switch (fs_type) 115 switch (fs_type)
97 { 116 {
98 case FULLSCREEN_NONE: 117 case -1: return "-1";
99 NSTRACE_MSG ("%s: FULLSCREEN_NONE", s); 118 case FULLSCREEN_NONE: return "FULLSCREEN_NONE";
100 break; 119 case FULLSCREEN_WIDTH: return "FULLSCREEN_WIDTH";
101 120 case FULLSCREEN_HEIGHT: return "FULLSCREEN_HEIGHT";
102 case FULLSCREEN_WIDTH: 121 case FULLSCREEN_BOTH: return "FULLSCREEN_BOTH";
103 NSTRACE_MSG ("%s: FULLSCREEN_WIDTH", s); 122 case FULLSCREEN_MAXIMIZED: return "FULLSCREEN_MAXIMIZED";
104 break; 123 default: return "FULLSCREEN_?????";
105
106 case FULLSCREEN_HEIGHT:
107 NSTRACE_MSG ("%s: FULLSCREEN_HEIGHT", s);
108 break;
109
110 case FULLSCREEN_BOTH:
111 NSTRACE_MSG ("%s: FULLSCREEN_BOTH", s);
112 break;
113
114 case FULLSCREEN_MAXIMIZED:
115 NSTRACE_MSG ("%s: FULLSCREEN_MAXIMIZED", s);
116 break;
117
118 default:
119 NSTRACE_MSG ("%s: %d", s, fs_type);
120 break;
121 } 124 }
122} 125}
123#endif 126#endif
@@ -581,28 +584,6 @@ ns_load_path (void)
581 return NULL; 584 return NULL;
582} 585}
583 586
584static void
585ns_timeout (int usecs)
586/* --------------------------------------------------------------------------
587 Blocking timer utility used by ns_ring_bell
588 -------------------------------------------------------------------------- */
589{
590 struct timespec wakeup = timespec_add (current_timespec (),
591 make_timespec (0, usecs * 1000));
592
593 /* Keep waiting until past the time wakeup. */
594 while (1)
595 {
596 struct timespec timeout, now = current_timespec ();
597 if (timespec_cmp (wakeup, now) <= 0)
598 break;
599 timeout = timespec_sub (wakeup, now);
600
601 /* Try to wait that long--but we might wake up sooner. */
602 pselect (0, NULL, NULL, NULL, &timeout, NULL);
603 }
604}
605
606 587
607void 588void
608ns_release_object (void *obj) 589ns_release_object (void *obj)
@@ -919,7 +900,7 @@ ns_update_begin (struct frame *f)
919 -------------------------------------------------------------------------- */ 900 -------------------------------------------------------------------------- */
920{ 901{
921 EmacsView *view = FRAME_NS_VIEW (f); 902 EmacsView *view = FRAME_NS_VIEW (f);
922 NSTRACE ("ns_update_begin"); 903 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_begin");
923 904
924 ns_update_auto_hide_menu_bar (); 905 ns_update_auto_hide_menu_bar ();
925 906
@@ -976,7 +957,7 @@ ns_update_window_begin (struct window *w)
976 struct frame *f = XFRAME (WINDOW_FRAME (w)); 957 struct frame *f = XFRAME (WINDOW_FRAME (w));
977 Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); 958 Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
978 959
979 NSTRACE ("ns_update_window_begin"); 960 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_window_begin");
980 w->output_cursor = w->cursor; 961 w->output_cursor = w->cursor;
981 962
982 block_input (); 963 block_input ();
@@ -1006,7 +987,7 @@ ns_update_window_end (struct window *w, bool cursor_on_p,
1006 external (RIF) call; for one window called before update_end 987 external (RIF) call; for one window called before update_end
1007 -------------------------------------------------------------------------- */ 988 -------------------------------------------------------------------------- */
1008{ 989{
1009 NSTRACE ("update_window_end"); 990 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_window_end");
1010 991
1011 /* note: this fn is nearly identical in all terms */ 992 /* note: this fn is nearly identical in all terms */
1012 if (!w->pseudo_window_p) 993 if (!w->pseudo_window_p)
@@ -1045,7 +1026,7 @@ ns_update_end (struct frame *f)
1045{ 1026{
1046 EmacsView *view = FRAME_NS_VIEW (f); 1027 EmacsView *view = FRAME_NS_VIEW (f);
1047 1028
1048 NSTRACE ("ns_update_end"); 1029 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end");
1049 1030
1050/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */ 1031/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */
1051 MOUSE_HL_INFO (f)->mouse_face_defer = 0; 1032 MOUSE_HL_INFO (f)->mouse_face_defer = 0;
@@ -1070,11 +1051,11 @@ ns_focus (struct frame *f, NSRect *r, int n)
1070 the entire window. 1051 the entire window.
1071 -------------------------------------------------------------------------- */ 1052 -------------------------------------------------------------------------- */
1072{ 1053{
1073// NSTRACE ("ns_focus"); 1054 NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus");
1074/* static int c =0; 1055 if (r != NULL)
1075 fprintf (stderr, "focus: %d", c++); 1056 {
1076 if (r) fprintf (stderr, " (%.0f, %.0f : %.0f x %.0f)", r->origin.x, r->origin.y, r->size.width, r->size.height); 1057 NSTRACE_RECT ("r", *r);
1077 fprintf (stderr, "\n"); */ 1058 }
1078 1059
1079 if (f != ns_updating_frame) 1060 if (f != ns_updating_frame)
1080 { 1061 {
@@ -1114,7 +1095,7 @@ ns_unfocus (struct frame *f)
1114 Internal: Remove focus on given frame 1095 Internal: Remove focus on given frame
1115 -------------------------------------------------------------------------- */ 1096 -------------------------------------------------------------------------- */
1116{ 1097{
1117// NSTRACE ("ns_unfocus"); 1098 NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_unfocus");
1118 1099
1119 if (gsaved) 1100 if (gsaved)
1120 { 1101 {
@@ -1158,6 +1139,77 @@ ns_clip_to_row (struct window *w, struct glyph_row *row,
1158} 1139}
1159 1140
1160 1141
1142/* ==========================================================================
1143
1144 Visible bell and beep.
1145
1146 ========================================================================== */
1147
1148
1149@interface EmacsBell : NSImageView
1150{
1151 // Number of currently active bell:s.
1152 unsigned int nestCount;
1153}
1154- (void)show:(NSView *)view;
1155- (void)hide;
1156@end
1157
1158@implementation EmacsBell
1159
1160- (id)init;
1161{
1162 if ((self = [super init]))
1163 {
1164 nestCount = 0;
1165 self.image = [NSImage imageNamed:NSImageNameCaution];
1166 }
1167 return self;
1168}
1169
1170- (void)show:(NSView *)view
1171{
1172 NSTRACE ("[EmacsBell show:]");
1173 NSTRACE_MSG ("nestCount: %u", nestCount);
1174
1175 // Show the image, unless it's already shown.
1176 if (nestCount == 0)
1177 {
1178 NSRect rect = [view bounds];
1179 NSPoint pos;
1180 pos.x = rect.origin.x + (rect.size.width - self.image.size.width )/2;
1181 pos.y = rect.origin.y + (rect.size.height - self.image.size.height)/2;
1182
1183 [self setFrameOrigin:pos];
1184 [self setFrameSize:self.image.size];
1185
1186 [[[view window] contentView] addSubview:self
1187 positioned:NSWindowAbove
1188 relativeTo:nil];
1189 }
1190
1191 ++nestCount;
1192
1193 [self performSelector:@selector(hide) withObject:self afterDelay:0.5];
1194}
1195
1196
1197- (void)hide
1198{
1199 // Note: Trace output from this method isn't shown, reason unknown.
1200 // NSTRACE ("[EmacsBell hide]");
1201
1202 --nestCount;
1203
1204 // Remove the image once the last bell became inactive.
1205 if (nestCount == 0)
1206 {
1207 [self removeFromSuperview];
1208 }
1209}
1210
1211@end
1212
1161static void 1213static void
1162ns_ring_bell (struct frame *f) 1214ns_ring_bell (struct frame *f)
1163/* -------------------------------------------------------------------------- 1215/* --------------------------------------------------------------------------
@@ -1167,37 +1219,24 @@ ns_ring_bell (struct frame *f)
1167 NSTRACE ("ns_ring_bell"); 1219 NSTRACE ("ns_ring_bell");
1168 if (visible_bell) 1220 if (visible_bell)
1169 { 1221 {
1170 NSAutoreleasePool *pool;
1171 struct frame *frame = SELECTED_FRAME (); 1222 struct frame *frame = SELECTED_FRAME ();
1172 NSView *view; 1223 NSView *view;
1173 1224
1225 static EmacsBell * bell_view = nil;
1226 if (bell_view == nil)
1227 {
1228 bell_view = [[EmacsBell alloc] init];
1229 [bell_view retain];
1230 }
1231
1174 block_input (); 1232 block_input ();
1175 pool = [[NSAutoreleasePool alloc] init];
1176 1233
1177 view = FRAME_NS_VIEW (frame); 1234 view = FRAME_NS_VIEW (frame);
1178 if (view != nil) 1235 if (view != nil)
1179 { 1236 {
1180 NSRect r, surr; 1237 [bell_view show:view];
1181 NSPoint dim = NSMakePoint (128, 128);
1182
1183 r = [view bounds];
1184 r.origin.x += (r.size.width - dim.x) / 2;
1185 r.origin.y += (r.size.height - dim.y) / 2;
1186 r.size.width = dim.x;
1187 r.size.height = dim.y;
1188 surr = NSInsetRect (r, -2, -2);
1189 ns_focus (frame, &surr, 1);
1190 [[view window] cacheImageInRect: [view convertRect: surr toView:nil]];
1191 [ns_lookup_indexed_color (NS_FACE_FOREGROUND
1192 (FRAME_DEFAULT_FACE (frame)), frame) set];
1193 NSRectFill (r);
1194 [[view window] flushWindow];
1195 ns_timeout (150000);
1196 [[view window] restoreCachedImage];
1197 [[view window] flushWindow];
1198 ns_unfocus (frame);
1199 } 1238 }
1200 [pool release]; 1239
1201 unblock_input (); 1240 unblock_input ();
1202 } 1241 }
1203 else 1242 else
@@ -1206,6 +1245,7 @@ ns_ring_bell (struct frame *f)
1206 } 1245 }
1207} 1246}
1208 1247
1248
1209/* ========================================================================== 1249/* ==========================================================================
1210 1250
1211 Frame / window manager related functions 1251 Frame / window manager related functions
@@ -1220,6 +1260,7 @@ ns_raise_frame (struct frame *f)
1220 -------------------------------------------------------------------------- */ 1260 -------------------------------------------------------------------------- */
1221{ 1261{
1222 NSView *view; 1262 NSView *view;
1263
1223 check_window_system (f); 1264 check_window_system (f);
1224 view = FRAME_NS_VIEW (f); 1265 view = FRAME_NS_VIEW (f);
1225 block_input (); 1266 block_input ();
@@ -1236,6 +1277,7 @@ ns_lower_frame (struct frame *f)
1236 -------------------------------------------------------------------------- */ 1277 -------------------------------------------------------------------------- */
1237{ 1278{
1238 NSView *view; 1279 NSView *view;
1280
1239 check_window_system (f); 1281 check_window_system (f);
1240 view = FRAME_NS_VIEW (f); 1282 view = FRAME_NS_VIEW (f);
1241 block_input (); 1283 block_input ();
@@ -1510,8 +1552,8 @@ x_set_window_size (struct frame *f,
1510 return; 1552 return;
1511 1553
1512 NSTRACE_RECT ("current", wr); 1554 NSTRACE_RECT ("current", wr);
1513 1555 NSTRACE_MSG ("Width:%d Height:%d Pixelwise:%d", width, height, pixelwise);
1514/*fprintf (stderr, "\tsetWindowSize: %d x %d, pixelwise %d, font size %d x %d\n", width, height, pixelwise, FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f));*/ 1556 NSTRACE_MSG ("Font %d x %d", FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f));
1515 1557
1516 block_input (); 1558 block_input ();
1517 1559
@@ -1571,7 +1613,6 @@ x_set_window_size (struct frame *f,
1571 make_number (FRAME_NS_TITLEBAR_HEIGHT (f)), 1613 make_number (FRAME_NS_TITLEBAR_HEIGHT (f)),
1572 make_number (FRAME_TOOLBAR_HEIGHT (f)))); 1614 make_number (FRAME_TOOLBAR_HEIGHT (f))));
1573 1615
1574 NSTRACE_RECT ("setFrame", wr);
1575 [window setFrame: wr display: YES]; 1616 [window setFrame: wr display: YES];
1576 1617
1577 /* This is a trick to compensate for Emacs' managing the scrollbar area 1618 /* This is a trick to compensate for Emacs' managing the scrollbar area
@@ -1586,7 +1627,7 @@ x_set_window_size (struct frame *f,
1586 ? NSMakePoint (FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f) 1627 ? NSMakePoint (FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f)
1587 - NS_SCROLL_BAR_WIDTH (f), 0) 1628 - NS_SCROLL_BAR_WIDTH (f), 0)
1588 : NSMakePoint (0, 0); 1629 : NSMakePoint (0, 0);
1589 NSTRACE_RECT ("setFrame", wr); 1630
1590 [view setFrame: NSMakeRect (0, 0, pixelwidth, pixelheight)]; 1631 [view setFrame: NSMakeRect (0, 0, pixelwidth, pixelheight)];
1591 [view setBoundsOrigin: origin]; 1632 [view setBoundsOrigin: origin];
1592 } 1633 }
@@ -1728,7 +1769,8 @@ ns_get_color (const char *name, NSColor **col)
1728 float r = -1.0, g, b; 1769 float r = -1.0, g, b;
1729 NSString *nsname = [NSString stringWithUTF8String: name]; 1770 NSString *nsname = [NSString stringWithUTF8String: name];
1730 1771
1731/*fprintf (stderr, "ns_get_color: '%s'\n", name); */ 1772 NSTRACE ("ns_get_color(%s, **)", name);
1773
1732 block_input (); 1774 block_input ();
1733 1775
1734 if ([nsname isEqualToString: @"ns_selection_bg_color"]) 1776 if ([nsname isEqualToString: @"ns_selection_bg_color"])
@@ -1935,7 +1977,7 @@ ns_defined_color (struct frame *f,
1935 -------------------------------------------------------------------------- */ 1977 -------------------------------------------------------------------------- */
1936{ 1978{
1937 NSColor *col; 1979 NSColor *col;
1938 NSTRACE ("ns_defined_color"); 1980 NSTRACE_WHEN (NSTRACE_GROUP_COLOR, "ns_defined_color");
1939 1981
1940 block_input (); 1982 block_input ();
1941 if (ns_get_color (name, &col) != 0) /* Color not found */ 1983 if (ns_get_color (name, &col) != 0) /* Color not found */
@@ -1961,6 +2003,8 @@ x_set_frame_alpha (struct frame *f)
1961 double alpha = 1.0; 2003 double alpha = 1.0;
1962 double alpha_min = 1.0; 2004 double alpha_min = 1.0;
1963 2005
2006 NSTRACE ("x_set_frame_alpha");
2007
1964 if (dpyinfo->x_highlight_frame == f) 2008 if (dpyinfo->x_highlight_frame == f)
1965 alpha = f->alpha[0]; 2009 alpha = f->alpha[0];
1966 else 2010 else
@@ -2097,7 +2141,7 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
2097 position = [view convertPoint: position fromView: nil]; 2141 position = [view convertPoint: position fromView: nil];
2098 remember_mouse_glyph (f, position.x, position.y, 2142 remember_mouse_glyph (f, position.x, position.y,
2099 &dpyinfo->last_mouse_glyph); 2143 &dpyinfo->last_mouse_glyph);
2100/*fprintf (stderr, "ns_mouse_position: %.0f, %.0f\n", position.x, position.y); */ 2144 NSTRACE_POINT ("position", position);
2101 2145
2102 if (bar_window) *bar_window = Qnil; 2146 if (bar_window) *bar_window = Qnil;
2103 if (part) *part = scroll_bar_above_handle; 2147 if (part) *part = scroll_bar_above_handle;
@@ -2120,7 +2164,7 @@ ns_frame_up_to_date (struct frame *f)
2120 Can't use FRAME_MOUSE_UPDATE due to ns_frame_begin and ns_frame_end calls. 2164 Can't use FRAME_MOUSE_UPDATE due to ns_frame_begin and ns_frame_end calls.
2121 -------------------------------------------------------------------------- */ 2165 -------------------------------------------------------------------------- */
2122{ 2166{
2123 NSTRACE ("ns_frame_up_to_date"); 2167 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_frame_up_to_date");
2124 2168
2125 if (FRAME_NS_P (f)) 2169 if (FRAME_NS_P (f))
2126 { 2170 {
@@ -2231,7 +2275,7 @@ ns_clear_frame (struct frame *f)
2231 NSView *view = FRAME_NS_VIEW (f); 2275 NSView *view = FRAME_NS_VIEW (f);
2232 NSRect r; 2276 NSRect r;
2233 2277
2234 NSTRACE ("ns_clear_frame"); 2278 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame");
2235 2279
2236 /* comes on initial frame because we have 2280 /* comes on initial frame because we have
2237 after-make-frame-functions = select-frame */ 2281 after-make-frame-functions = select-frame */
@@ -2267,7 +2311,7 @@ ns_clear_frame_area (struct frame *f, int x, int y, int width, int height)
2267 if (!view || !face) 2311 if (!view || !face)
2268 return; 2312 return;
2269 2313
2270 NSTRACE ("ns_clear_frame_area"); 2314 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame_area");
2271 2315
2272 r = NSIntersectionRect (r, [view frame]); 2316 r = NSIntersectionRect (r, [view frame]);
2273 ns_focus (f, &r, 1); 2317 ns_focus (f, &r, 1);
@@ -2360,7 +2404,7 @@ ns_after_update_window_line (struct window *w, struct glyph_row *desired_row)
2360 struct frame *f; 2404 struct frame *f;
2361 int width, height; 2405 int width, height;
2362 2406
2363 NSTRACE ("ns_after_update_window_line"); 2407 NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_after_update_window_line");
2364 2408
2365 /* begin copy from other terms */ 2409 /* begin copy from other terms */
2366 eassert (w); 2410 eassert (w);
@@ -2485,7 +2529,7 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
2485 static EmacsImage **bimgs = NULL; 2529 static EmacsImage **bimgs = NULL;
2486 static int nBimgs = 0; 2530 static int nBimgs = 0;
2487 2531
2488 NSTRACE ("ns_draw_fringe_bitmap"); 2532 NSTRACE_WHEN (NSTRACE_GROUP_FRINGE, "ns_draw_fringe_bitmap");
2489 NSTRACE_MSG ("which:%d cursor:%d overlay:%d width:%d height:%d period:%d", 2533 NSTRACE_MSG ("which:%d cursor:%d overlay:%d width:%d height:%d period:%d",
2490 p->which, p->cursor_p, p->overlay_p, p->wd, p->h, p->dh); 2534 p->which, p->cursor_p, p->overlay_p, p->wd, p->h, p->dh);
2491 2535
@@ -2602,7 +2646,7 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row,
2602 in mini-buffer windows when switching between echo area glyphs 2646 in mini-buffer windows when switching between echo area glyphs
2603 and mini-buffer. */ 2647 and mini-buffer. */
2604 2648
2605 NSTRACE ("dumpcursor"); 2649 NSTRACE ("ns_draw_window_cursor");
2606 2650
2607 if (!on_p) 2651 if (!on_p)
2608 return; 2652 return;
@@ -3519,7 +3563,7 @@ ns_draw_glyph_string (struct glyph_string *s)
3519 struct font *font = s->face->font; 3563 struct font *font = s->face->font;
3520 if (! font) font = FRAME_FONT (s->f); 3564 if (! font) font = FRAME_FONT (s->f);
3521 3565
3522 NSTRACE ("ns_draw_glyph_string"); 3566 NSTRACE_WHEN (NSTRACE_GROUP_GLYPHS, "ns_draw_glyph_string");
3523 3567
3524 if (s->next && s->right_overhang && !s->for_overlaps/*&&s->hl!=DRAW_CURSOR*/) 3568 if (s->next && s->right_overhang && !s->for_overlaps/*&&s->hl!=DRAW_CURSOR*/)
3525 { 3569 {
@@ -3677,7 +3721,7 @@ ns_send_appdefined (int value)
3677 recognize and take as a command to halt the event loop. 3721 recognize and take as a command to halt the event loop.
3678 -------------------------------------------------------------------------- */ 3722 -------------------------------------------------------------------------- */
3679{ 3723{
3680 NSTRACE ("ns_send_appdefined"); 3724 NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_send_appdefined(%d)", value);
3681 3725
3682#ifdef NS_IMPL_GNUSTEP 3726#ifdef NS_IMPL_GNUSTEP
3683 // GNUstep needs postEvent to happen on the main thread. 3727 // GNUstep needs postEvent to happen on the main thread.
@@ -3851,7 +3895,7 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit)
3851 struct input_event ev; 3895 struct input_event ev;
3852 int nevents; 3896 int nevents;
3853 3897
3854/* NSTRACE ("ns_read_socket"); */ 3898 NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_read_socket");
3855 3899
3856#ifdef HAVE_NATIVE_FS 3900#ifdef HAVE_NATIVE_FS
3857 check_native_fs (); 3901 check_native_fs ();
@@ -3935,7 +3979,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
3935 struct input_event event; 3979 struct input_event event;
3936 char c; 3980 char c;
3937 3981
3938/* NSTRACE ("ns_select"); */ 3982 NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_select");
3939 3983
3940#ifdef HAVE_NATIVE_FS 3984#ifdef HAVE_NATIVE_FS
3941 check_native_fs (); 3985 check_native_fs ();
@@ -4905,7 +4949,7 @@ ns_term_shutdown (int sig)
4905 4949
4906- (void)stop: (id)sender 4950- (void)stop: (id)sender
4907{ 4951{
4908 NSTRACE ("[EmacsApp stop]"); 4952 NSTRACE ("[EmacsApp stop:]");
4909 4953
4910 shouldKeepRunning = NO; 4954 shouldKeepRunning = NO;
4911 // Stop possible dialog also. Noop if no dialog present. 4955 // Stop possible dialog also. Noop if no dialog present.
@@ -4916,7 +4960,7 @@ ns_term_shutdown (int sig)
4916 4960
4917- (void)logNotification: (NSNotification *)notification 4961- (void)logNotification: (NSNotification *)notification
4918{ 4962{
4919 NSTRACE ("[EmacsApp logNotification]"); 4963 NSTRACE ("[EmacsApp logNotification:]");
4920 4964
4921 const char *name = [[notification name] UTF8String]; 4965 const char *name = [[notification name] UTF8String];
4922 if (!strstr (name, "Update") && !strstr (name, "NSMenu") 4966 if (!strstr (name, "Update") && !strstr (name, "NSMenu")
@@ -4934,8 +4978,8 @@ ns_term_shutdown (int sig)
4934 int type = [theEvent type]; 4978 int type = [theEvent type];
4935 NSWindow *window = [theEvent window]; 4979 NSWindow *window = [theEvent window];
4936 4980
4937 NSTRACE ("[EmacsApp sendEvent]"); 4981 NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "[EmacsApp sendEvent:]");
4938/*fprintf (stderr, "received event of type %d\t%d\n", type);*/ 4982 NSTRACE_MSG ("Type: %d", type);
4939 4983
4940#ifdef NS_IMPL_GNUSTEP 4984#ifdef NS_IMPL_GNUSTEP
4941 // Keyboard events aren't propagated to file dialogs for some reason. 4985 // Keyboard events aren't propagated to file dialogs for some reason.
@@ -5021,6 +5065,8 @@ ns_term_shutdown (int sig)
5021 } 5065 }
5022#endif 5066#endif
5023 5067
5068 NSTRACE_UNSILENCE();
5069
5024 [super sendEvent: theEvent]; 5070 [super sendEvent: theEvent];
5025} 5071}
5026 5072
@@ -5041,7 +5087,7 @@ ns_term_shutdown (int sig)
5041 5087
5042- (void)newFrame: (id)sender 5088- (void)newFrame: (id)sender
5043{ 5089{
5044 NSTRACE ("[EmacsApp newFrame]"); 5090 NSTRACE ("[EmacsApp newFrame:]");
5045 5091
5046 struct frame *emacsframe = SELECTED_FRAME (); 5092 struct frame *emacsframe = SELECTED_FRAME ();
5047 NSEvent *theEvent = [NSApp currentEvent]; 5093 NSEvent *theEvent = [NSApp currentEvent];
@@ -5058,7 +5104,7 @@ ns_term_shutdown (int sig)
5058/* Open a file (used by below, after going into queue read by ns_read_socket) */ 5104/* Open a file (used by below, after going into queue read by ns_read_socket) */
5059- (BOOL) openFile: (NSString *)fileName 5105- (BOOL) openFile: (NSString *)fileName
5060{ 5106{
5061 NSTRACE ("[EmacsApp openFile]"); 5107 NSTRACE ("[EmacsApp openFile:]");
5062 5108
5063 struct frame *emacsframe = SELECTED_FRAME (); 5109 struct frame *emacsframe = SELECTED_FRAME ();
5064 NSEvent *theEvent = [NSApp currentEvent]; 5110 NSEvent *theEvent = [NSApp currentEvent];
@@ -5088,7 +5134,7 @@ ns_term_shutdown (int sig)
5088 When application is loaded, terminate event loop in ns_term_init 5134 When application is loaded, terminate event loop in ns_term_init
5089 -------------------------------------------------------------------------- */ 5135 -------------------------------------------------------------------------- */
5090{ 5136{
5091 NSTRACE ("[EmacsApp applicationDidFinishLaunching]"); 5137 NSTRACE ("[EmacsApp applicationDidFinishLaunching:]");
5092 5138
5093#ifdef NS_IMPL_GNUSTEP 5139#ifdef NS_IMPL_GNUSTEP
5094 ((EmacsApp *)self)->applicationDidFinishLaunchingCalled = YES; 5140 ((EmacsApp *)self)->applicationDidFinishLaunchingCalled = YES;
@@ -5138,7 +5184,7 @@ ns_term_shutdown (int sig)
5138 5184
5139- (void) terminate: (id)sender 5185- (void) terminate: (id)sender
5140{ 5186{
5141 NSTRACE ("[EmacsApp terminate]"); 5187 NSTRACE ("[EmacsApp terminate:]");
5142 5188
5143 struct frame *emacsframe = SELECTED_FRAME (); 5189 struct frame *emacsframe = SELECTED_FRAME ();
5144 5190
@@ -5176,7 +5222,7 @@ runAlertPanel(NSString *title,
5176 5222
5177- (NSApplicationTerminateReply)applicationShouldTerminate: (id)sender 5223- (NSApplicationTerminateReply)applicationShouldTerminate: (id)sender
5178{ 5224{
5179 NSTRACE ("[EmacsApp applicationShouldTerminate]"); 5225 NSTRACE ("[EmacsApp applicationShouldTerminate:]");
5180 5226
5181 bool ret; 5227 bool ret;
5182 5228
@@ -5257,13 +5303,13 @@ not_in_argv (NSString *arg)
5257/* TODO: these may help w/IO switching btwn terminal and NSApp */ 5303/* TODO: these may help w/IO switching btwn terminal and NSApp */
5258- (void)applicationWillBecomeActive: (NSNotification *)notification 5304- (void)applicationWillBecomeActive: (NSNotification *)notification
5259{ 5305{
5260 NSTRACE ("[EmacsApp applicationWillBecomeActive]"); 5306 NSTRACE ("[EmacsApp applicationWillBecomeActive:]");
5261 //ns_app_active=YES; 5307 //ns_app_active=YES;
5262} 5308}
5263 5309
5264- (void)applicationDidBecomeActive: (NSNotification *)notification 5310- (void)applicationDidBecomeActive: (NSNotification *)notification
5265{ 5311{
5266 NSTRACE ("[EmacsApp applicationDidBecomeActive]"); 5312 NSTRACE ("[EmacsApp applicationDidBecomeActive:]");
5267 5313
5268#ifdef NS_IMPL_GNUSTEP 5314#ifdef NS_IMPL_GNUSTEP
5269 if (! applicationDidFinishLaunchingCalled) 5315 if (! applicationDidFinishLaunchingCalled)
@@ -5277,7 +5323,7 @@ not_in_argv (NSString *arg)
5277} 5323}
5278- (void)applicationDidResignActive: (NSNotification *)notification 5324- (void)applicationDidResignActive: (NSNotification *)notification
5279{ 5325{
5280 NSTRACE ("[EmacsApp applicationDidResignActive]"); 5326 NSTRACE ("[EmacsApp applicationDidResignActive:]");
5281 5327
5282 //ns_app_active=NO; 5328 //ns_app_active=NO;
5283 ns_send_appdefined (-1); 5329 ns_send_appdefined (-1);
@@ -5422,6 +5468,8 @@ not_in_argv (NSString *arg)
5422 struct frame *emacsframe = SELECTED_FRAME (); 5468 struct frame *emacsframe = SELECTED_FRAME ();
5423 NSEvent *theEvent = [NSApp currentEvent]; 5469 NSEvent *theEvent = [NSApp currentEvent];
5424 5470
5471 NSTRACE ("[EmacsApp fulfillService:withArg:]");
5472
5425 if (!emacs_event) 5473 if (!emacs_event)
5426 return NO; 5474 return NO;
5427 5475
@@ -5452,13 +5500,15 @@ not_in_argv (NSString *arg)
5452/* needed to inform when window closed from LISP */ 5500/* needed to inform when window closed from LISP */
5453- (void) setWindowClosing: (BOOL)closing 5501- (void) setWindowClosing: (BOOL)closing
5454{ 5502{
5503 NSTRACE ("[EmacsView setWindowClosing:%d]", closing);
5504
5455 windowClosing = closing; 5505 windowClosing = closing;
5456} 5506}
5457 5507
5458 5508
5459- (void)dealloc 5509- (void)dealloc
5460{ 5510{
5461 NSTRACE ("EmacsView_dealloc"); 5511 NSTRACE ("[EmacsView dealloc]");
5462 [toolbar release]; 5512 [toolbar release];
5463 if (fs_state == FULLSCREEN_BOTH) 5513 if (fs_state == FULLSCREEN_BOTH)
5464 [nonfs_window release]; 5514 [nonfs_window release];
@@ -5476,7 +5526,7 @@ not_in_argv (NSString *arg)
5476 CGFloat size; 5526 CGFloat size;
5477 NSFont *nsfont; 5527 NSFont *nsfont;
5478 5528
5479 NSTRACE ("changeFont"); 5529 NSTRACE ("[EmacsView changeFont:]");
5480 5530
5481 if (!emacs_event) 5531 if (!emacs_event)
5482 return; 5532 return;
@@ -5506,7 +5556,7 @@ not_in_argv (NSString *arg)
5506 5556
5507- (BOOL)acceptsFirstResponder 5557- (BOOL)acceptsFirstResponder
5508{ 5558{
5509 NSTRACE ("acceptsFirstResponder"); 5559 NSTRACE ("[EmacsView acceptsFirstResponder]");
5510 return YES; 5560 return YES;
5511} 5561}
5512 5562
@@ -5515,7 +5565,7 @@ not_in_argv (NSString *arg)
5515{ 5565{
5516 NSRect visible = [self visibleRect]; 5566 NSRect visible = [self visibleRect];
5517 NSCursor *currentCursor = FRAME_POINTER_TYPE (emacsframe); 5567 NSCursor *currentCursor = FRAME_POINTER_TYPE (emacsframe);
5518 NSTRACE ("resetCursorRects"); 5568 NSTRACE ("[EmacsView resetCursorRects]");
5519 5569
5520 if (currentCursor == nil) 5570 if (currentCursor == nil)
5521 currentCursor = [NSCursor arrowCursor]; 5571 currentCursor = [NSCursor arrowCursor];
@@ -5540,7 +5590,7 @@ not_in_argv (NSString *arg)
5540 int left_is_none; 5590 int left_is_none;
5541 unsigned int flags = [theEvent modifierFlags]; 5591 unsigned int flags = [theEvent modifierFlags];
5542 5592
5543 NSTRACE ("keyDown"); 5593 NSTRACE ("[EmacsView keyDown:]");
5544 5594
5545 /* Rhapsody and OS X give up and down events for the arrow keys */ 5595 /* Rhapsody and OS X give up and down events for the arrow keys */
5546 if (ns_fake_keydown == YES) 5596 if (ns_fake_keydown == YES)
@@ -5785,6 +5835,9 @@ not_in_argv (NSString *arg)
5785{ 5835{
5786 int flags = [theEvent modifierFlags]; 5836 int flags = [theEvent modifierFlags];
5787 int code = [theEvent keyCode]; 5837 int code = [theEvent keyCode];
5838
5839 NSTRACE ("[EmacsView keyUp:]");
5840
5788 if (floor (NSAppKitVersionNumber) <= 824 /*NSAppKitVersionNumber10_4*/ && 5841 if (floor (NSAppKitVersionNumber) <= 824 /*NSAppKitVersionNumber10_4*/ &&
5789 code == 0x30 && (flags & NSControlKeyMask) && !(flags & NSCommandKeyMask)) 5842 code == 0x30 && (flags & NSControlKeyMask) && !(flags & NSCommandKeyMask))
5790 { 5843 {
@@ -5809,6 +5862,8 @@ not_in_argv (NSString *arg)
5809 int len = [(NSString *)aString length]; 5862 int len = [(NSString *)aString length];
5810 int i; 5863 int i;
5811 5864
5865 NSTRACE ("[EmacsView insertText:]");
5866
5812 if (NS_KEYLOG) 5867 if (NS_KEYLOG)
5813 NSLog (@"insertText '%@'\tlen = %d", aString, len); 5868 NSLog (@"insertText '%@'\tlen = %d", aString, len);
5814 processingCompose = NO; 5869 processingCompose = NO;
@@ -5842,6 +5897,9 @@ not_in_argv (NSString *arg)
5842{ 5897{
5843 NSString *str = [aString respondsToSelector: @selector (string)] ? 5898 NSString *str = [aString respondsToSelector: @selector (string)] ?
5844 [aString string] : aString; 5899 [aString string] : aString;
5900
5901 NSTRACE ("[EmacsView setMarkedText:selectedRange:]");
5902
5845 if (NS_KEYLOG) 5903 if (NS_KEYLOG)
5846 NSLog (@"setMarkedText '%@' len =%lu range %lu from %lu", 5904 NSLog (@"setMarkedText '%@' len =%lu range %lu from %lu",
5847 str, (unsigned long)[str length], 5905 str, (unsigned long)[str length],
@@ -5869,6 +5927,8 @@ not_in_argv (NSString *arg)
5869/* delete display of composing characters [not in <NSTextInput>] */ 5927/* delete display of composing characters [not in <NSTextInput>] */
5870- (void)deleteWorkingText 5928- (void)deleteWorkingText
5871{ 5929{
5930 NSTRACE ("[EmacsView deleteWorkingText]");
5931
5872 if (workingText == nil) 5932 if (workingText == nil)
5873 return; 5933 return;
5874 if (NS_KEYLOG) 5934 if (NS_KEYLOG)
@@ -5888,12 +5948,16 @@ not_in_argv (NSString *arg)
5888 5948
5889- (BOOL)hasMarkedText 5949- (BOOL)hasMarkedText
5890{ 5950{
5951 NSTRACE ("[EmacsView hasMarkedText]");
5952
5891 return workingText != nil; 5953 return workingText != nil;
5892} 5954}
5893 5955
5894 5956
5895- (NSRange)markedRange 5957- (NSRange)markedRange
5896{ 5958{
5959 NSTRACE ("[EmacsView markedRange]");
5960
5897 NSRange rng = workingText != nil 5961 NSRange rng = workingText != nil
5898 ? NSMakeRange (0, [workingText length]) : NSMakeRange (NSNotFound, 0); 5962 ? NSMakeRange (0, [workingText length]) : NSMakeRange (NSNotFound, 0);
5899 if (NS_KEYLOG) 5963 if (NS_KEYLOG)
@@ -5904,6 +5968,8 @@ not_in_argv (NSString *arg)
5904 5968
5905- (void)unmarkText 5969- (void)unmarkText
5906{ 5970{
5971 NSTRACE ("[EmacsView unmarkText]");
5972
5907 if (NS_KEYLOG) 5973 if (NS_KEYLOG)
5908 NSLog (@"unmark (accept) text"); 5974 NSLog (@"unmark (accept) text");
5909 [self deleteWorkingText]; 5975 [self deleteWorkingText];
@@ -5917,6 +5983,9 @@ not_in_argv (NSString *arg)
5917 NSRect rect; 5983 NSRect rect;
5918 NSPoint pt; 5984 NSPoint pt;
5919 struct window *win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe)); 5985 struct window *win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe));
5986
5987 NSTRACE ("[EmacsView firstRectForCharacterRange:]");
5988
5920 if (NS_KEYLOG) 5989 if (NS_KEYLOG)
5921 NSLog (@"firstRectForCharRange request"); 5990 NSLog (@"firstRectForCharRange request");
5922 5991
@@ -5941,6 +6010,8 @@ not_in_argv (NSString *arg)
5941 6010
5942- (void)doCommandBySelector: (SEL)aSelector 6011- (void)doCommandBySelector: (SEL)aSelector
5943{ 6012{
6013 NSTRACE ("[EmacsView doCommandBySelector:]");
6014
5944 if (NS_KEYLOG) 6015 if (NS_KEYLOG)
5945 NSLog (@"doCommandBySelector: %@", NSStringFromSelector (aSelector)); 6016 NSLog (@"doCommandBySelector: %@", NSStringFromSelector (aSelector));
5946 6017
@@ -6003,7 +6074,7 @@ not_in_argv (NSString *arg)
6003 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); 6074 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe);
6004 NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil]; 6075 NSPoint p = [self convertPoint: [theEvent locationInWindow] fromView: nil];
6005 6076
6006 NSTRACE ("mouseDown"); 6077 NSTRACE ("[EmacsView mouseDown:]");
6007 6078
6008 [self deleteWorkingText]; 6079 [self deleteWorkingText];
6009 6080
@@ -6024,7 +6095,7 @@ not_in_argv (NSString *arg)
6024 delta = [theEvent deltaX]; 6095 delta = [theEvent deltaX];
6025 if (delta == 0) 6096 if (delta == 0)
6026 { 6097 {
6027 NSTRACE ("deltaIsZero"); 6098 NSTRACE_MSG ("deltaIsZero");
6028 return; 6099 return;
6029 } 6100 }
6030 emacs_event->kind = HORIZ_WHEEL_EVENT; 6101 emacs_event->kind = HORIZ_WHEEL_EVENT;
@@ -6051,42 +6122,42 @@ not_in_argv (NSString *arg)
6051 6122
6052- (void)rightMouseDown: (NSEvent *)theEvent 6123- (void)rightMouseDown: (NSEvent *)theEvent
6053{ 6124{
6054 NSTRACE ("rightMouseDown"); 6125 NSTRACE ("[EmacsView rightMouseDown:]");
6055 [self mouseDown: theEvent]; 6126 [self mouseDown: theEvent];
6056} 6127}
6057 6128
6058 6129
6059- (void)otherMouseDown: (NSEvent *)theEvent 6130- (void)otherMouseDown: (NSEvent *)theEvent
6060{ 6131{
6061 NSTRACE ("otherMouseDown"); 6132 NSTRACE ("[EmacsView otherMouseDown:]");
6062 [self mouseDown: theEvent]; 6133 [self mouseDown: theEvent];
6063} 6134}
6064 6135
6065 6136
6066- (void)mouseUp: (NSEvent *)theEvent 6137- (void)mouseUp: (NSEvent *)theEvent
6067{ 6138{
6068 NSTRACE ("mouseUp"); 6139 NSTRACE ("[EmacsView mouseUp:]");
6069 [self mouseDown: theEvent]; 6140 [self mouseDown: theEvent];
6070} 6141}
6071 6142
6072 6143
6073- (void)rightMouseUp: (NSEvent *)theEvent 6144- (void)rightMouseUp: (NSEvent *)theEvent
6074{ 6145{
6075 NSTRACE ("rightMouseUp"); 6146 NSTRACE ("[EmacsView rightMouseUp:]");
6076 [self mouseDown: theEvent]; 6147 [self mouseDown: theEvent];
6077} 6148}
6078 6149
6079 6150
6080- (void)otherMouseUp: (NSEvent *)theEvent 6151- (void)otherMouseUp: (NSEvent *)theEvent
6081{ 6152{
6082 NSTRACE ("otherMouseUp"); 6153 NSTRACE ("[EmacsView otherMouseUp:]");
6083 [self mouseDown: theEvent]; 6154 [self mouseDown: theEvent];
6084} 6155}
6085 6156
6086 6157
6087- (void) scrollWheel: (NSEvent *)theEvent 6158- (void) scrollWheel: (NSEvent *)theEvent
6088{ 6159{
6089 NSTRACE ("scrollWheel"); 6160 NSTRACE ("[EmacsView scrollWheel:]");
6090 [self mouseDown: theEvent]; 6161 [self mouseDown: theEvent];
6091} 6162}
6092 6163
@@ -6099,7 +6170,7 @@ not_in_argv (NSString *arg)
6099 Lisp_Object frame; 6170 Lisp_Object frame;
6100 NSPoint pt; 6171 NSPoint pt;
6101 6172
6102// NSTRACE ("mouseMoved"); 6173 NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "[EmacsView mouseMoved:]");
6103 6174
6104 dpyinfo->last_mouse_movement_time = EV_TIMESTAMP (e); 6175 dpyinfo->last_mouse_movement_time = EV_TIMESTAMP (e);
6105 pt = [self convertPoint: [e locationInWindow] fromView: nil]; 6176 pt = [self convertPoint: [e locationInWindow] fromView: nil];
@@ -6119,7 +6190,7 @@ not_in_argv (NSString *arg)
6119 6190
6120 if (!NILP (Vmouse_autoselect_window)) 6191 if (!NILP (Vmouse_autoselect_window))
6121 { 6192 {
6122 NSTRACE ("mouse_autoselect_window"); 6193 NSTRACE_MSG ("mouse_autoselect_window");
6123 static Lisp_Object last_mouse_window; 6194 static Lisp_Object last_mouse_window;
6124 Lisp_Object window 6195 Lisp_Object window
6125 = window_from_coordinates (emacsframe, pt.x, pt.y, 0, 0); 6196 = window_from_coordinates (emacsframe, pt.x, pt.y, 0, 0);
@@ -6131,7 +6202,7 @@ not_in_argv (NSString *arg)
6131 || (EQ (XWINDOW (window)->frame, 6202 || (EQ (XWINDOW (window)->frame,
6132 XWINDOW (selected_window)->frame)))) 6203 XWINDOW (selected_window)->frame))))
6133 { 6204 {
6134 NSTRACE ("in_window"); 6205 NSTRACE_MSG ("in_window");
6135 emacs_event->kind = SELECT_WINDOW_EVENT; 6206 emacs_event->kind = SELECT_WINDOW_EVENT;
6136 emacs_event->frame_or_window = window; 6207 emacs_event->frame_or_window = window;
6137 EV_TRAILER2 (e); 6208 EV_TRAILER2 (e);
@@ -6161,21 +6232,21 @@ not_in_argv (NSString *arg)
6161 6232
6162- (void)mouseDragged: (NSEvent *)e 6233- (void)mouseDragged: (NSEvent *)e
6163{ 6234{
6164 NSTRACE ("mouseDragged"); 6235 NSTRACE ("[EmacsView mouseDragged:]");
6165 [self mouseMoved: e]; 6236 [self mouseMoved: e];
6166} 6237}
6167 6238
6168 6239
6169- (void)rightMouseDragged: (NSEvent *)e 6240- (void)rightMouseDragged: (NSEvent *)e
6170{ 6241{
6171 NSTRACE ("rightMouseDragged"); 6242 NSTRACE ("[EmacsView rightMouseDragged:]");
6172 [self mouseMoved: e]; 6243 [self mouseMoved: e];
6173} 6244}
6174 6245
6175 6246
6176- (void)otherMouseDragged: (NSEvent *)e 6247- (void)otherMouseDragged: (NSEvent *)e
6177{ 6248{
6178 NSTRACE ("otherMouseDragged"); 6249 NSTRACE ("[EmacsView otherMouseDragged:]");
6179 [self mouseMoved: e]; 6250 [self mouseMoved: e];
6180} 6251}
6181 6252
@@ -6184,7 +6255,7 @@ not_in_argv (NSString *arg)
6184{ 6255{
6185 NSEvent *e =[[self window] currentEvent]; 6256 NSEvent *e =[[self window] currentEvent];
6186 6257
6187 NSTRACE ("windowShouldClose"); 6258 NSTRACE ("[EmacsView windowShouldClose:]");
6188 windowClosing = YES; 6259 windowClosing = YES;
6189 if (!emacs_event) 6260 if (!emacs_event)
6190 return NO; 6261 return NO;
@@ -6206,7 +6277,7 @@ not_in_argv (NSString *arg)
6206 int oldh = FRAME_PIXEL_HEIGHT (emacsframe); 6277 int oldh = FRAME_PIXEL_HEIGHT (emacsframe);
6207 int neww, newh; 6278 int neww, newh;
6208 6279
6209 NSTRACE ("updateFrameSize"); 6280 NSTRACE ("[EmacsView updateFrameSize:]");
6210 NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh)); 6281 NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
6211 NSTRACE_RECT ("Original frame", wr); 6282 NSTRACE_RECT ("Original frame", wr);
6212 NSTRACE_MSG ("Original columns: %d", cols); 6283 NSTRACE_MSG ("Original columns: %d", cols);
@@ -6249,8 +6320,8 @@ not_in_argv (NSString *arg)
6249 if (rows < MINHEIGHT) 6320 if (rows < MINHEIGHT)
6250 rows = MINHEIGHT; 6321 rows = MINHEIGHT;
6251 6322
6252 NSTRACE_MSG ("New columns: %d", cols); 6323 NSTRACE_MSG ("New columns: %d", cols);
6253 NSTRACE_MSG ("New rows: %d", rows); 6324 NSTRACE_MSG ("New rows: %d", rows);
6254 6325
6255 if (oldr != rows || oldc != cols || neww != oldw || newh != oldh) 6326 if (oldr != rows || oldc != cols || neww != oldw || newh != oldh)
6256 { 6327 {
@@ -6265,8 +6336,9 @@ not_in_argv (NSString *arg)
6265 cancel_mouse_face (emacsframe); 6336 cancel_mouse_face (emacsframe);
6266 6337
6267 wr = NSMakeRect (0, 0, neww, newh); 6338 wr = NSMakeRect (0, 0, neww, newh);
6268 NSTRACE_RECT ("setFrame", wr); 6339
6269 [view setFrame: wr]; 6340 [view setFrame: wr];
6341
6270 // to do: consider using [NSNotificationCenter postNotificationName:]. 6342 // to do: consider using [NSNotificationCenter postNotificationName:].
6271 [self windowDidMove: // Update top/left. 6343 [self windowDidMove: // Update top/left.
6272 [NSNotification notificationWithName:NSWindowDidMoveNotification 6344 [NSNotification notificationWithName:NSWindowDidMoveNotification
@@ -6283,7 +6355,7 @@ not_in_argv (NSString *arg)
6283{ 6355{
6284 int extra = 0; 6356 int extra = 0;
6285 6357
6286 NSTRACE ("windowWillResize: toSize: " NSTRACE_FMT_SIZE, 6358 NSTRACE ("[EmacsView windowWillResize:toSize: " NSTRACE_FMT_SIZE "]",
6287 NSTRACE_ARG_SIZE (frameSize)); 6359 NSTRACE_ARG_SIZE (frameSize));
6288 NSTRACE_RECT ("[sender frame]", [sender frame]); 6360 NSTRACE_RECT ("[sender frame]", [sender frame]);
6289 NSTRACE_FSTYPE ("fs_state", fs_state); 6361 NSTRACE_FSTYPE ("fs_state", fs_state);
@@ -6382,7 +6454,7 @@ not_in_argv (NSString *arg)
6382 6454
6383- (void)windowDidResize: (NSNotification *)notification 6455- (void)windowDidResize: (NSNotification *)notification
6384{ 6456{
6385 NSTRACE ("windowDidResize"); 6457 NSTRACE ("[EmacsView windowDidResize:]");
6386 if (!FRAME_LIVE_P (emacsframe)) 6458 if (!FRAME_LIVE_P (emacsframe))
6387 { 6459 {
6388 NSTRACE_MSG ("Ignored (frame dead)"); 6460 NSTRACE_MSG ("Ignored (frame dead)");
@@ -6425,6 +6497,8 @@ not_in_argv (NSString *arg)
6425#ifdef NS_IMPL_COCOA 6497#ifdef NS_IMPL_COCOA
6426- (void)viewDidEndLiveResize 6498- (void)viewDidEndLiveResize
6427{ 6499{
6500 NSTRACE ("[EmacsView viewDidEndLiveResize]");
6501
6428 [super viewDidEndLiveResize]; 6502 [super viewDidEndLiveResize];
6429 if (old_title != 0) 6503 if (old_title != 0)
6430 { 6504 {
@@ -6440,10 +6514,16 @@ not_in_argv (NSString *arg)
6440- (void)windowDidBecomeKey: (NSNotification *)notification 6514- (void)windowDidBecomeKey: (NSNotification *)notification
6441/* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */ 6515/* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */
6442{ 6516{
6517 [self windowDidBecomeKey];
6518}
6519
6520
6521- (void)windowDidBecomeKey /* for direct calls */
6522{
6443 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); 6523 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe);
6444 struct frame *old_focus = dpyinfo->x_focus_frame; 6524 struct frame *old_focus = dpyinfo->x_focus_frame;
6445 6525
6446 NSTRACE ("windowDidBecomeKey"); 6526 NSTRACE ("[EmacsView windowDidBecomeKey]");
6447 6527
6448 if (emacsframe != old_focus) 6528 if (emacsframe != old_focus)
6449 dpyinfo->x_focus_frame = emacsframe; 6529 dpyinfo->x_focus_frame = emacsframe;
@@ -6463,7 +6543,7 @@ not_in_argv (NSString *arg)
6463{ 6543{
6464 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe); 6544 struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (emacsframe);
6465 BOOL is_focus_frame = dpyinfo->x_focus_frame == emacsframe; 6545 BOOL is_focus_frame = dpyinfo->x_focus_frame == emacsframe;
6466 NSTRACE ("windowDidResignKey"); 6546 NSTRACE ("[EmacsView windowDidResignKey:]");
6467 6547
6468 if (is_focus_frame) 6548 if (is_focus_frame)
6469 dpyinfo->x_focus_frame = 0; 6549 dpyinfo->x_focus_frame = 0;
@@ -6498,7 +6578,16 @@ not_in_argv (NSString *arg)
6498 6578
6499- (void)windowWillMiniaturize: sender 6579- (void)windowWillMiniaturize: sender
6500{ 6580{
6501 NSTRACE ("windowWillMiniaturize"); 6581 NSTRACE ("[EmacsView windowWillMiniaturize:]");
6582}
6583
6584
6585- (void)setFrame:(NSRect)frameRect;
6586{
6587 NSTRACE ("[EmacsView setFrame:" NSTRACE_FMT_RECT "]",
6588 NSTRACE_ARG_RECT (frameRect));
6589
6590 [super setFrame:(NSRect)frameRect];
6502} 6591}
6503 6592
6504 6593
@@ -6522,7 +6611,8 @@ not_in_argv (NSString *arg)
6522 NSColor *col; 6611 NSColor *col;
6523 NSString *name; 6612 NSString *name;
6524 6613
6525 NSTRACE ("initFrameFromEmacs"); 6614 NSTRACE ("[EmacsView initFrameFromEmacs:]");
6615 NSTRACE_MSG ("cols:%d lines:%d\n", f->text_cols, f->text_lines);
6526 6616
6527 windowClosing = NO; 6617 windowClosing = NO;
6528 processingCompose = NO; 6618 processingCompose = NO;
@@ -6537,8 +6627,6 @@ not_in_argv (NSString *arg)
6537 maximized_width = maximized_height = -1; 6627 maximized_width = maximized_height = -1;
6538 nonfs_window = nil; 6628 nonfs_window = nil;
6539 6629
6540/*fprintf (stderr,"init with %d, %d\n",f->text_cols, f->text_lines); */
6541
6542 ns_userRect = NSMakeRect (0, 0, 0, 0); 6630 ns_userRect = NSMakeRect (0, 0, 0, 0);
6543 r = NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols), 6631 r = NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
6544 FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines)); 6632 FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines));
@@ -6626,8 +6714,6 @@ not_in_argv (NSString *arg)
6626 IN_BOUND (-SCREENMAX, 6714 IN_BOUND (-SCREENMAX,
6627 [screen frame].size.height - NS_TOP_POS (f), SCREENMAX)); 6715 [screen frame].size.height - NS_TOP_POS (f), SCREENMAX));
6628 6716
6629 NSTRACE_POINT ("setFrameTopLeftPoint", pt);
6630
6631 [win setFrameTopLeftPoint: pt]; 6717 [win setFrameTopLeftPoint: pt];
6632 6718
6633 NSTRACE_RECT ("new frame", [win frame]); 6719 NSTRACE_RECT ("new frame", [win frame]);
@@ -6661,7 +6747,7 @@ not_in_argv (NSString *arg)
6661 NSArray *screens = [NSScreen screens]; 6747 NSArray *screens = [NSScreen screens];
6662 NSScreen *screen = [screens objectAtIndex: 0]; 6748 NSScreen *screen = [screens objectAtIndex: 0];
6663 6749
6664 NSTRACE ("windowDidMove"); 6750 NSTRACE ("[EmacsView windowDidMove:]");
6665 6751
6666 if (!emacsframe->output_data.ns) 6752 if (!emacsframe->output_data.ns)
6667 return; 6753 return;
@@ -6679,7 +6765,7 @@ not_in_argv (NSString *arg)
6679 location so set_window_size moves the frame. */ 6765 location so set_window_size moves the frame. */
6680- (BOOL)windowShouldZoom: (NSWindow *)sender toFrame: (NSRect)newFrame 6766- (BOOL)windowShouldZoom: (NSWindow *)sender toFrame: (NSRect)newFrame
6681{ 6767{
6682 NSTRACE (("[windowShouldZoom:win toFrame:" NSTRACE_FMT_RECT "]" 6768 NSTRACE (("[EmacsView windowShouldZoom:toFrame:" NSTRACE_FMT_RECT "]"
6683 NSTRACE_FMT_RETURN "YES"), 6769 NSTRACE_FMT_RETURN "YES"),
6684 NSTRACE_ARG_RECT (newFrame)); 6770 NSTRACE_ARG_RECT (newFrame));
6685 6771
@@ -6698,7 +6784,7 @@ not_in_argv (NSString *arg)
6698 // all paths. 6784 // all paths.
6699 NSRect result = [sender frame]; 6785 NSRect result = [sender frame];
6700 6786
6701 NSTRACE (("[windowWillUseStandardFrame: defaultFrame:" 6787 NSTRACE (("[EmacsView windowWillUseStandardFrame:defaultFrame:"
6702 NSTRACE_FMT_RECT "]"), 6788 NSTRACE_FMT_RECT "]"),
6703 NSTRACE_ARG_RECT (defaultFrame)); 6789 NSTRACE_ARG_RECT (defaultFrame));
6704 NSTRACE_FSTYPE ("fs_state", fs_state); 6790 NSTRACE_FSTYPE ("fs_state", fs_state);
@@ -6811,7 +6897,7 @@ not_in_argv (NSString *arg)
6811 6897
6812- (void)windowDidDeminiaturize: sender 6898- (void)windowDidDeminiaturize: sender
6813{ 6899{
6814 NSTRACE ("windowDidDeminiaturize"); 6900 NSTRACE ("[EmacsView windowDidDeminiaturize:]");
6815 if (!emacsframe->output_data.ns) 6901 if (!emacsframe->output_data.ns)
6816 return; 6902 return;
6817 6903
@@ -6829,7 +6915,7 @@ not_in_argv (NSString *arg)
6829 6915
6830- (void)windowDidExpose: sender 6916- (void)windowDidExpose: sender
6831{ 6917{
6832 NSTRACE ("windowDidExpose"); 6918 NSTRACE ("[EmacsView windowDidExpose:]");
6833 if (!emacsframe->output_data.ns) 6919 if (!emacsframe->output_data.ns)
6834 return; 6920 return;
6835 6921
@@ -6843,7 +6929,7 @@ not_in_argv (NSString *arg)
6843 6929
6844- (void)windowDidMiniaturize: sender 6930- (void)windowDidMiniaturize: sender
6845{ 6931{
6846 NSTRACE ("windowDidMiniaturize"); 6932 NSTRACE ("[EmacsView windowDidMiniaturize:]");
6847 if (!emacsframe->output_data.ns) 6933 if (!emacsframe->output_data.ns)
6848 return; 6934 return;
6849 6935
@@ -6866,33 +6952,30 @@ not_in_argv (NSString *arg)
6866} 6952}
6867#endif 6953#endif
6868 6954
6869#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7
6870#define NSWindowDidEnterFullScreenNotification "NSWindowDidEnterFullScreenNotification"
6871#endif
6872
6873- (void)windowWillEnterFullScreen:(NSNotification *)notification 6955- (void)windowWillEnterFullScreen:(NSNotification *)notification
6874{ 6956{
6957 NSTRACE ("[EmacsView windowWillEnterFullScreen:]");
6875 [self windowWillEnterFullScreen]; 6958 [self windowWillEnterFullScreen];
6876} 6959}
6877- (void)windowWillEnterFullScreen /* provided for direct calls */ 6960- (void)windowWillEnterFullScreen /* provided for direct calls */
6878{ 6961{
6879 NSTRACE ("windowWillEnterFullScreen"); 6962 NSTRACE ("[EmacsView windowWillEnterFullScreen]");
6880 fs_before_fs = fs_state; 6963 fs_before_fs = fs_state;
6881} 6964}
6882 6965
6883- (void)windowDidEnterFullScreen /* provided for direct calls */ 6966- (void)windowDidEnterFullScreen:(NSNotification *)notification
6884{ 6967{
6885 [self windowDidEnterFullScreen: 6968 NSTRACE ("[EmacsView windowDidEnterFullScreen:]");
6886 [NSNotification notificationWithName:NSWindowDidEnterFullScreenNotification 6969 [self windowDidEnterFullScreen];
6887 object:[self window]]];
6888} 6970}
6889- (void)windowDidEnterFullScreen:(NSNotification *)notification 6971
6972- (void)windowDidEnterFullScreen /* provided for direct calls */
6890{ 6973{
6891 NSTRACE ("windowDidEnterFullScreen"); 6974 NSTRACE ("[EmacsView windowDidEnterFullScreen]");
6892 [self setFSValue: FULLSCREEN_BOTH]; 6975 [self setFSValue: FULLSCREEN_BOTH];
6893 if (! [self fsIsNative]) 6976 if (! [self fsIsNative])
6894 { 6977 {
6895 [self windowDidBecomeKey:notification]; 6978 [self windowDidBecomeKey];
6896 [nonfs_window orderOut:self]; 6979 [nonfs_window orderOut:self];
6897 } 6980 }
6898 else 6981 else
@@ -6922,12 +7005,13 @@ not_in_argv (NSString *arg)
6922 7005
6923- (void)windowWillExitFullScreen:(NSNotification *)notification 7006- (void)windowWillExitFullScreen:(NSNotification *)notification
6924{ 7007{
7008 NSTRACE ("[EmacsView windowWillExitFullScreen:]");
6925 [self windowWillExitFullScreen]; 7009 [self windowWillExitFullScreen];
6926} 7010}
6927 7011
6928- (void)windowWillExitFullScreen /* provided for direct calls */ 7012- (void)windowWillExitFullScreen /* provided for direct calls */
6929{ 7013{
6930 NSTRACE ("windowWillExitFullScreen"); 7014 NSTRACE ("[EmacsView windowWillExitFullScreen]");
6931 if (!FRAME_LIVE_P (emacsframe)) 7015 if (!FRAME_LIVE_P (emacsframe))
6932 { 7016 {
6933 NSTRACE_MSG ("Ignored (frame dead)"); 7017 NSTRACE_MSG ("Ignored (frame dead)");
@@ -6939,12 +7023,13 @@ not_in_argv (NSString *arg)
6939 7023
6940- (void)windowDidExitFullScreen:(NSNotification *)notification 7024- (void)windowDidExitFullScreen:(NSNotification *)notification
6941{ 7025{
7026 NSTRACE ("[EmacsView windowDidExitFullScreen:]");
6942 [self windowDidExitFullScreen]; 7027 [self windowDidExitFullScreen];
6943} 7028}
6944 7029
6945- (void)windowDidExitFullScreen /* provided for direct calls */ 7030- (void)windowDidExitFullScreen /* provided for direct calls */
6946{ 7031{
6947 NSTRACE ("windowDidExitFullScreen"); 7032 NSTRACE ("[EmacsView windowDidExitFullScreen]");
6948 if (!FRAME_LIVE_P (emacsframe)) 7033 if (!FRAME_LIVE_P (emacsframe))
6949 { 7034 {
6950 NSTRACE_MSG ("Ignored (frame dead)"); 7035 NSTRACE_MSG ("Ignored (frame dead)");
@@ -6976,6 +7061,8 @@ not_in_argv (NSString *arg)
6976 7061
6977- (BOOL)isFullscreen 7062- (BOOL)isFullscreen
6978{ 7063{
7064 NSTRACE ("[EmacsView isFullscreen]");
7065
6979 if (! fs_is_native) return nonfs_window != nil; 7066 if (! fs_is_native) return nonfs_window != nil;
6980#ifdef HAVE_NATIVE_FS 7067#ifdef HAVE_NATIVE_FS
6981 return ([[self window] styleMask] & NSFullScreenWindowMask) != 0; 7068 return ([[self window] styleMask] & NSFullScreenWindowMask) != 0;
@@ -6987,6 +7074,8 @@ not_in_argv (NSString *arg)
6987#ifdef HAVE_NATIVE_FS 7074#ifdef HAVE_NATIVE_FS
6988- (void)updateCollectionBehavior 7075- (void)updateCollectionBehavior
6989{ 7076{
7077 NSTRACE ("[EmacsView updateCollectionBehavior]");
7078
6990 if (! [self isFullscreen]) 7079 if (! [self isFullscreen])
6991 { 7080 {
6992 NSWindow *win = [self window]; 7081 NSWindow *win = [self window];
@@ -7010,7 +7099,7 @@ not_in_argv (NSString *arg)
7010 NSRect r, wr; 7099 NSRect r, wr;
7011 NSColor *col; 7100 NSColor *col;
7012 7101
7013 NSTRACE ("toggleFullScreen"); 7102 NSTRACE ("[EmacsView toggleFullScreen:]");
7014 7103
7015 if (fs_is_native) 7104 if (fs_is_native)
7016 { 7105 {
@@ -7125,7 +7214,7 @@ not_in_argv (NSString *arg)
7125 7214
7126- (void)handleFS 7215- (void)handleFS
7127{ 7216{
7128 NSTRACE ("handleFS"); 7217 NSTRACE ("[EmacsView handleFS]");
7129 7218
7130 if (fs_state != emacsframe->want_fullscreen) 7219 if (fs_state != emacsframe->want_fullscreen)
7131 { 7220 {
@@ -7176,8 +7265,8 @@ not_in_argv (NSString *arg)
7176 7265
7177- (void) setFSValue: (int)value 7266- (void) setFSValue: (int)value
7178{ 7267{
7179 NSTRACE ("setFSValue"); 7268 NSTRACE ("[EmacsView setFSValue:" NSTRACE_FMT_FSTYPE "]",
7180 NSTRACE_FSTYPE ("value", value); 7269 NSTRACE_ARG_FSTYPE(value));
7181 7270
7182 Lisp_Object lval = Qnil; 7271 Lisp_Object lval = Qnil;
7183 switch (value) 7272 switch (value)
@@ -7201,7 +7290,7 @@ not_in_argv (NSString *arg)
7201 7290
7202- (void)mouseEntered: (NSEvent *)theEvent 7291- (void)mouseEntered: (NSEvent *)theEvent
7203{ 7292{
7204 NSTRACE ("mouseEntered"); 7293 NSTRACE ("[EmacsView mouseEntered:]");
7205 if (emacsframe) 7294 if (emacsframe)
7206 FRAME_DISPLAY_INFO (emacsframe)->last_mouse_movement_time 7295 FRAME_DISPLAY_INFO (emacsframe)->last_mouse_movement_time
7207 = EV_TIMESTAMP (theEvent); 7296 = EV_TIMESTAMP (theEvent);
@@ -7212,7 +7301,7 @@ not_in_argv (NSString *arg)
7212{ 7301{
7213 Mouse_HLInfo *hlinfo = emacsframe ? MOUSE_HL_INFO (emacsframe) : NULL; 7302 Mouse_HLInfo *hlinfo = emacsframe ? MOUSE_HL_INFO (emacsframe) : NULL;
7214 7303
7215 NSTRACE ("mouseExited"); 7304 NSTRACE ("[EmacsView mouseExited:]");
7216 7305
7217 if (!hlinfo) 7306 if (!hlinfo)
7218 return; 7307 return;
@@ -7230,7 +7319,7 @@ not_in_argv (NSString *arg)
7230 7319
7231- menuDown: sender 7320- menuDown: sender
7232{ 7321{
7233 NSTRACE ("menuDown"); 7322 NSTRACE ("[EmacsView menuDown:]");
7234 if (context_menu_value == -1) 7323 if (context_menu_value == -1)
7235 context_menu_value = [sender tag]; 7324 context_menu_value = [sender tag];
7236 else 7325 else
@@ -7258,7 +7347,7 @@ not_in_argv (NSString *arg)
7258 NSEvent *theEvent; 7347 NSEvent *theEvent;
7259 int idx = [item tag] * TOOL_BAR_ITEM_NSLOTS; 7348 int idx = [item tag] * TOOL_BAR_ITEM_NSLOTS;
7260 7349
7261 NSTRACE ("toolbarClicked"); 7350 NSTRACE ("[EmacsView toolbarClicked:]");
7262 7351
7263 if (!emacs_event) 7352 if (!emacs_event)
7264 return self; 7353 return self;
@@ -7281,6 +7370,8 @@ not_in_argv (NSString *arg)
7281 7370
7282- toggleToolbar: (id)sender 7371- toggleToolbar: (id)sender
7283{ 7372{
7373 NSTRACE ("[EmacsView toggleToolbar:]");
7374
7284 if (!emacs_event) 7375 if (!emacs_event)
7285 return self; 7376 return self;
7286 7377
@@ -7296,8 +7387,8 @@ not_in_argv (NSString *arg)
7296 int x = NSMinX (rect), y = NSMinY (rect); 7387 int x = NSMinX (rect), y = NSMinY (rect);
7297 int width = NSWidth (rect), height = NSHeight (rect); 7388 int width = NSWidth (rect), height = NSHeight (rect);
7298 7389
7299 NSTRACE ("drawRect"); 7390 NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]",
7300 NSTRACE_RECT ("input", rect); 7391 NSTRACE_ARG_RECT(rect));
7301 7392
7302 if (!emacsframe || !emacsframe->output_data.ns) 7393 if (!emacsframe || !emacsframe->output_data.ns)
7303 return; 7394 return;
@@ -7323,7 +7414,7 @@ not_in_argv (NSString *arg)
7323 7414
7324-(NSDragOperation) draggingEntered: (id <NSDraggingInfo>) sender 7415-(NSDragOperation) draggingEntered: (id <NSDraggingInfo>) sender
7325{ 7416{
7326 NSTRACE ("draggingEntered"); 7417 NSTRACE ("[EmacsView draggingEntered:]");
7327 return NSDragOperationGeneric; 7418 return NSDragOperationGeneric;
7328} 7419}
7329 7420
@@ -7344,7 +7435,7 @@ not_in_argv (NSString *arg)
7344 NSDragOperation op = [sender draggingSourceOperationMask]; 7435 NSDragOperation op = [sender draggingSourceOperationMask];
7345 int modifiers = 0; 7436 int modifiers = 0;
7346 7437
7347 NSTRACE ("performDragOperation"); 7438 NSTRACE ("[EmacsView performDragOperation:]");
7348 7439
7349 if (!emacs_event) 7440 if (!emacs_event)
7350 return NO; 7441 return NO;
@@ -7444,7 +7535,7 @@ not_in_argv (NSString *arg)
7444- (id) validRequestorForSendType: (NSString *)typeSent 7535- (id) validRequestorForSendType: (NSString *)typeSent
7445 returnType: (NSString *)typeReturned 7536 returnType: (NSString *)typeReturned
7446{ 7537{
7447 NSTRACE ("validRequestorForSendType"); 7538 NSTRACE ("[EmacsView validRequestorForSendType:returnType:]");
7448 if (typeSent != nil && [ns_send_types indexOfObject: typeSent] != NSNotFound 7539 if (typeSent != nil && [ns_send_types indexOfObject: typeSent] != NSNotFound
7449 && typeReturned == nil) 7540 && typeReturned == nil)
7450 { 7541 {
@@ -7477,6 +7568,8 @@ not_in_argv (NSString *arg)
7477 NSArray *typesDeclared; 7568 NSArray *typesDeclared;
7478 Lisp_Object val; 7569 Lisp_Object val;
7479 7570
7571 NSTRACE ("[EmacsView writeSelectionToPasteboard:types:]");
7572
7480 /* We only support NSStringPboardType */ 7573 /* We only support NSStringPboardType */
7481 if ([types containsObject:NSStringPboardType] == NO) { 7574 if ([types containsObject:NSStringPboardType] == NO) {
7482 return NO; 7575 return NO;
@@ -7506,7 +7599,7 @@ not_in_argv (NSString *arg)
7506- setMiniwindowImage: (BOOL) setMini 7599- setMiniwindowImage: (BOOL) setMini
7507{ 7600{
7508 id image = [[self window] miniwindowImage]; 7601 id image = [[self window] miniwindowImage];
7509 NSTRACE ("setMiniwindowImage"); 7602 NSTRACE ("[EmacsView setMiniwindowImage:%d]", setMini);
7510 7603
7511 /* NOTE: under Cocoa miniwindowImage always returns nil, documentation 7604 /* NOTE: under Cocoa miniwindowImage always returns nil, documentation
7512 about "AppleDockIconEnabled" notwithstanding, however the set message 7605 about "AppleDockIconEnabled" notwithstanding, however the set message
@@ -7554,6 +7647,8 @@ not_in_argv (NSString *arg)
7554 struct frame *f = SELECTED_FRAME (); 7647 struct frame *f = SELECTED_FRAME ();
7555 struct buffer *curbuf = XBUFFER (XWINDOW (f->selected_window)->contents); 7648 struct buffer *curbuf = XBUFFER (XWINDOW (f->selected_window)->contents);
7556 7649
7650 NSTRACE ("[EmacsWindow accessibilityAttributeValue:]");
7651
7557 if ([attribute isEqualToString:NSAccessibilityRoleAttribute]) 7652 if ([attribute isEqualToString:NSAccessibilityRoleAttribute])
7558 return NSAccessibilityTextFieldRole; 7653 return NSAccessibilityTextFieldRole;
7559 7654
@@ -7622,7 +7717,7 @@ not_in_argv (NSString *arg)
7622 large screen). */ 7717 large screen). */
7623- (NSRect)constrainFrameRect:(NSRect)frameRect toScreen:(NSScreen *)screen 7718- (NSRect)constrainFrameRect:(NSRect)frameRect toScreen:(NSScreen *)screen
7624{ 7719{
7625 NSTRACE ("constrainFrameRect:" NSTRACE_FMT_RECT " toScreen:", 7720 NSTRACE ("[EmacsWindow constrainFrameRect:" NSTRACE_FMT_RECT " toScreen:]",
7626 NSTRACE_ARG_RECT (frameRect)); 7721 NSTRACE_ARG_RECT (frameRect));
7627 7722
7628#ifdef NS_IMPL_COCOA 7723#ifdef NS_IMPL_COCOA
@@ -7645,7 +7740,7 @@ not_in_argv (NSString *arg)
7645 7740
7646- (void)performZoom:(id)sender 7741- (void)performZoom:(id)sender
7647{ 7742{
7648 NSTRACE ("performZoom"); 7743 NSTRACE ("[EmacsWindow performZoom:]");
7649 7744
7650 return [super performZoom:sender]; 7745 return [super performZoom:sender];
7651} 7746}
@@ -7654,7 +7749,7 @@ not_in_argv (NSString *arg)
7654{ 7749{
7655 struct frame * f = SELECTED_FRAME (); 7750 struct frame * f = SELECTED_FRAME ();
7656 7751
7657 NSTRACE ("zoom"); 7752 NSTRACE ("[EmacsWindow zoom:]");
7658 7753
7659 ns_update_auto_hide_menu_bar(); 7754 ns_update_auto_hide_menu_bar();
7660 7755
@@ -7713,7 +7808,7 @@ not_in_argv (NSString *arg)
7713 || newWr.origin.x != wr.origin.x 7808 || newWr.origin.x != wr.origin.x
7714 || newWr.origin.y != wr.origin.y) 7809 || newWr.origin.y != wr.origin.y)
7715 { 7810 {
7716 NSTRACE_RECT ("Corrected rect", newWr); 7811 NSTRACE_MSG ("New frame different");
7717 [self setFrame: newWr display: NO]; 7812 [self setFrame: newWr display: NO];
7718 } 7813 }
7719 } 7814 }
@@ -7733,6 +7828,33 @@ not_in_argv (NSString *arg)
7733#endif 7828#endif
7734} 7829}
7735 7830
7831- (void)setFrame:(NSRect)windowFrame
7832 display:(BOOL)displayViews
7833{
7834 NSTRACE ("[EmacsWindow setFrame:" NSTRACE_FMT_RECT " display:%d]",
7835 NSTRACE_ARG_RECT (windowFrame), displayViews);
7836
7837 [super setFrame:windowFrame display:displayViews];
7838}
7839
7840- (void)setFrame:(NSRect)windowFrame
7841 display:(BOOL)displayViews
7842 animate:(BOOL)performAnimation
7843{
7844 NSTRACE ("[EmacsWindow setFrame:" NSTRACE_FMT_RECT
7845 " display:%d performAnimation:%d]",
7846 NSTRACE_ARG_RECT (windowFrame), displayViews, performAnimation);
7847
7848 [super setFrame:windowFrame display:displayViews animate:performAnimation];
7849}
7850
7851- (void)setFrameTopLeftPoint:(NSPoint)point
7852{
7853 NSTRACE ("[EmacsWindow setFrameTopLeftPoint:" NSTRACE_FMT_POINT "]",
7854 NSTRACE_ARG_POINT (point));
7855
7856 [super setFrameTopLeftPoint:point];
7857}
7736@end /* EmacsWindow */ 7858@end /* EmacsWindow */
7737 7859
7738 7860
@@ -7781,7 +7903,7 @@ not_in_argv (NSString *arg)
7781 7903
7782- initFrame: (NSRect )r window: (Lisp_Object)nwin 7904- initFrame: (NSRect )r window: (Lisp_Object)nwin
7783{ 7905{
7784 NSTRACE ("EmacsScroller_initFrame"); 7906 NSTRACE ("[EmacsScroller initFrame: window:]");
7785 7907
7786 r.size.width = [EmacsScroller scrollerWidth]; 7908 r.size.width = [EmacsScroller scrollerWidth];
7787 [super initWithFrame: r/*NSMakeRect (0, 0, 0, 0)*/]; 7909 [super initWithFrame: r/*NSMakeRect (0, 0, 0, 0)*/];
@@ -7827,7 +7949,8 @@ not_in_argv (NSString *arg)
7827 7949
7828- (void)setFrame: (NSRect)newRect 7950- (void)setFrame: (NSRect)newRect
7829{ 7951{
7830 NSTRACE ("EmacsScroller_setFrame"); 7952 NSTRACE ("[EmacsScroller setFrame:]");
7953
7831/* block_input (); */ 7954/* block_input (); */
7832 pixel_height = NSHeight (newRect); 7955 pixel_height = NSHeight (newRect);
7833 if (pixel_height == 0) pixel_height = 1; 7956 if (pixel_height == 0) pixel_height = 1;
@@ -7839,7 +7962,7 @@ not_in_argv (NSString *arg)
7839 7962
7840- (void)dealloc 7963- (void)dealloc
7841{ 7964{
7842 NSTRACE ("EmacsScroller_dealloc"); 7965 NSTRACE ("[EmacsScroller dealloc]");
7843 if (window) 7966 if (window)
7844 wset_vertical_scroll_bar (window, Qnil); 7967 wset_vertical_scroll_bar (window, Qnil);
7845 window = 0; 7968 window = 0;
@@ -7849,7 +7972,7 @@ not_in_argv (NSString *arg)
7849 7972
7850- condemn 7973- condemn
7851{ 7974{
7852 NSTRACE ("condemn"); 7975 NSTRACE ("[EmacsScroller condemn]");
7853 condemned =YES; 7976 condemned =YES;
7854 return self; 7977 return self;
7855} 7978}
@@ -7857,7 +7980,7 @@ not_in_argv (NSString *arg)
7857 7980
7858- reprieve 7981- reprieve
7859{ 7982{
7860 NSTRACE ("reprieve"); 7983 NSTRACE ("[EmacsScroller reprieve]");
7861 condemned =NO; 7984 condemned =NO;
7862 return self; 7985 return self;
7863} 7986}
@@ -7865,7 +7988,7 @@ not_in_argv (NSString *arg)
7865 7988
7866-(bool)judge 7989-(bool)judge
7867{ 7990{
7868 NSTRACE ("judge"); 7991 NSTRACE ("[EmacsScroller judge]");
7869 bool ret = condemned; 7992 bool ret = condemned;
7870 if (condemned) 7993 if (condemned)
7871 { 7994 {
@@ -7889,7 +8012,7 @@ not_in_argv (NSString *arg)
7889- (void)resetCursorRects 8012- (void)resetCursorRects
7890{ 8013{
7891 NSRect visible = [self visibleRect]; 8014 NSRect visible = [self visibleRect];
7892 NSTRACE ("resetCursorRects"); 8015 NSTRACE ("[EmacsScroller resetCursorRects]");
7893 8016
7894 if (!NSIsEmptyRect (visible)) 8017 if (!NSIsEmptyRect (visible))
7895 [self addCursorRect: visible cursor: [NSCursor arrowCursor]]; 8018 [self addCursorRect: visible cursor: [NSCursor arrowCursor]];
@@ -7907,7 +8030,7 @@ not_in_argv (NSString *arg)
7907 8030
7908- setPosition: (int)position portion: (int)portion whole: (int)whole 8031- setPosition: (int)position portion: (int)portion whole: (int)whole
7909{ 8032{
7910 NSTRACE ("setPosition"); 8033 NSTRACE ("[EmacsScroller setPosition:portion:whole:]");
7911 8034
7912 em_position = position; 8035 em_position = position;
7913 em_portion = portion; 8036 em_portion = portion;
@@ -7944,6 +8067,9 @@ not_in_argv (NSString *arg)
7944- (void) sendScrollEventAtLoc: (float)loc fromEvent: (NSEvent *)e 8067- (void) sendScrollEventAtLoc: (float)loc fromEvent: (NSEvent *)e
7945{ 8068{
7946 Lisp_Object win; 8069 Lisp_Object win;
8070
8071 NSTRACE ("[EmacsScroller sendScrollEventAtLoc:fromEvent:]");
8072
7947 if (!emacs_event) 8073 if (!emacs_event)
7948 return; 8074 return;
7949 8075
@@ -7977,6 +8103,8 @@ not_in_argv (NSString *arg)
7977 NSPoint p = [[self window] mouseLocationOutsideOfEventStream]; 8103 NSPoint p = [[self window] mouseLocationOutsideOfEventStream];
7978 BOOL inKnob = [self testPart: p] == NSScrollerKnob; 8104 BOOL inKnob = [self testPart: p] == NSScrollerKnob;
7979 8105
8106 NSTRACE ("[EmacsScroller repeatScroll:]");
8107
7980 /* clear timer if need be */ 8108 /* clear timer if need be */
7981 if (inKnob || [scroll_repeat_entry timeInterval] == SCROLL_BAR_FIRST_DELAY) 8109 if (inKnob || [scroll_repeat_entry timeInterval] == SCROLL_BAR_FIRST_DELAY)
7982 { 8110 {
@@ -8012,7 +8140,7 @@ not_in_argv (NSString *arg)
8012 CGFloat inc = 0.0, loc, kloc, pos; 8140 CGFloat inc = 0.0, loc, kloc, pos;
8013 int edge = 0; 8141 int edge = 0;
8014 8142
8015 NSTRACE ("EmacsScroller_mouseDown"); 8143 NSTRACE ("[EmacsScroller mouseDown:]");
8016 8144
8017 switch (part) 8145 switch (part)
8018 { 8146 {
@@ -8109,7 +8237,7 @@ not_in_argv (NSString *arg)
8109 NSRect sr; 8237 NSRect sr;
8110 double loc, pos; 8238 double loc, pos;
8111 8239
8112 NSTRACE ("EmacsScroller_mouseDragged"); 8240 NSTRACE ("[EmacsScroller mouseDragged:]");
8113 8241
8114 sr = [self convertRect: [self rectForPart: NSScrollerKnobSlot] 8242 sr = [self convertRect: [self rectForPart: NSScrollerKnobSlot]
8115 toView: nil]; 8243 toView: nil];
@@ -8131,6 +8259,8 @@ not_in_argv (NSString *arg)
8131 8259
8132- (void)mouseUp: (NSEvent *)e 8260- (void)mouseUp: (NSEvent *)e
8133{ 8261{
8262 NSTRACE ("[EmacsScroller mouseUp:]");
8263
8134 if (scroll_repeat_entry) 8264 if (scroll_repeat_entry)
8135 { 8265 {
8136 [scroll_repeat_entry invalidate]; 8266 [scroll_repeat_entry invalidate];
@@ -8144,6 +8274,8 @@ not_in_argv (NSString *arg)
8144/* treat scrollwheel events in the bar as though they were in the main window */ 8274/* treat scrollwheel events in the bar as though they were in the main window */
8145- (void) scrollWheel: (NSEvent *)theEvent 8275- (void) scrollWheel: (NSEvent *)theEvent
8146{ 8276{
8277 NSTRACE ("[EmacsScroller scrollWheel:]");
8278
8147 EmacsView *view = (EmacsView *)FRAME_NS_VIEW (frame); 8279 EmacsView *view = (EmacsView *)FRAME_NS_VIEW (frame);
8148 [view mouseDown: theEvent]; 8280 [view mouseDown: theEvent];
8149} 8281}
diff --git a/src/print.c b/src/print.c
index 6f868ceff84..420e6f55b4c 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1990,6 +1990,19 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
1990 printchar ('>', printcharfun); 1990 printchar ('>', printcharfun);
1991 break; 1991 break;
1992 1992
1993#ifdef HAVE_MODULES
1994 case Lisp_Misc_User_Ptr:
1995 {
1996 print_c_string ("#<user-ptr ", printcharfun);
1997 int i = sprintf (buf, "ptr=%p finalizer=%p",
1998 XUSER_PTR (obj)->p,
1999 XUSER_PTR (obj)->finalizer);
2000 strout (buf, i, i, printcharfun);
2001 printchar ('>', printcharfun);
2002 break;
2003 }
2004#endif
2005
1993 case Lisp_Misc_Finalizer: 2006 case Lisp_Misc_Finalizer:
1994 print_c_string ("#<finalizer", printcharfun); 2007 print_c_string ("#<finalizer", printcharfun);
1995 if (NILP (XFINALIZER (obj)->function)) 2008 if (NILP (XFINALIZER (obj)->function))
diff --git a/src/puresize.h b/src/puresize.h
index f07562429d5..96ddcde24a6 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -81,21 +81,35 @@ extern _Noreturn void pure_write_error (Lisp_Object);
81 81
82extern EMACS_INT pure[]; 82extern EMACS_INT pure[];
83 83
84/* The puresize_h_* macros are private to this include file. */
85
84/* True if PTR is pure. */ 86/* True if PTR is pure. */
87
88#define puresize_h_PURE_P(ptr) \
89 ((uintptr_t) (ptr) - (uintptr_t) pure <= PURESIZE)
90
85INLINE bool 91INLINE bool
86PURE_P (void *ptr) 92PURE_P (void *ptr)
87{ 93{
88 return (uintptr_t) (ptr) - (uintptr_t) pure <= PURESIZE; 94 return puresize_h_PURE_P (ptr);
89} 95}
90 96
91/* Signal an error if OBJ is pure. PTR is OBJ untagged. */ 97/* Signal an error if OBJ is pure. PTR is OBJ untagged. */
98
99#define puresize_h_CHECK_IMPURE(obj, ptr) \
100 (PURE_P (ptr) ? pure_write_error (obj) : (void) 0)
101
92INLINE void 102INLINE void
93CHECK_IMPURE (Lisp_Object obj, void *ptr) 103CHECK_IMPURE (Lisp_Object obj, void *ptr)
94{ 104{
95 if (PURE_P (ptr)) 105 puresize_h_CHECK_IMPURE (obj, ptr);
96 pure_write_error (obj);
97} 106}
98 107
108#if DEFINE_KEY_OPS_AS_MACROS
109# define PURE_P(ptr) puresize_h_PURE_P (ptr)
110# define CHECK_IMPURE(obj, ptr) puresize_h_CHECK_IMPURE (obj, ptr)
111#endif
112
99INLINE_HEADER_END 113INLINE_HEADER_END
100 114
101#endif /* EMACS_PURESIZE_H */ 115#endif /* EMACS_PURESIZE_H */
diff --git a/src/regex.c b/src/regex.c
index dcf286454b3..4e00fd15dc9 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -5945,12 +5945,12 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
5945#ifdef emacs 5945#ifdef emacs
5946 ssize_t offset = PTR_TO_OFFSET (d - 1); 5946 ssize_t offset = PTR_TO_OFFSET (d - 1);
5947 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); 5947 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset);
5948 UPDATE_SYNTAX_TABLE (charpos); 5948 UPDATE_SYNTAX_TABLE_FAST (charpos);
5949#endif 5949#endif
5950 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); 5950 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2);
5951 s1 = SYNTAX (c1); 5951 s1 = SYNTAX (c1);
5952#ifdef emacs 5952#ifdef emacs
5953 UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); 5953 UPDATE_SYNTAX_TABLE_FORWARD_FAST (charpos + 1);
5954#endif 5954#endif
5955 PREFETCH_NOLIMIT (); 5955 PREFETCH_NOLIMIT ();
5956 GET_CHAR_AFTER (c2, d, dummy); 5956 GET_CHAR_AFTER (c2, d, dummy);
@@ -5987,7 +5987,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
5987#ifdef emacs 5987#ifdef emacs
5988 ssize_t offset = PTR_TO_OFFSET (d); 5988 ssize_t offset = PTR_TO_OFFSET (d);
5989 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); 5989 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset);
5990 UPDATE_SYNTAX_TABLE (charpos); 5990 UPDATE_SYNTAX_TABLE_FAST (charpos);
5991#endif 5991#endif
5992 PREFETCH (); 5992 PREFETCH ();
5993 GET_CHAR_AFTER (c2, d, dummy); 5993 GET_CHAR_AFTER (c2, d, dummy);
@@ -6032,7 +6032,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
6032#ifdef emacs 6032#ifdef emacs
6033 ssize_t offset = PTR_TO_OFFSET (d) - 1; 6033 ssize_t offset = PTR_TO_OFFSET (d) - 1;
6034 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); 6034 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset);
6035 UPDATE_SYNTAX_TABLE (charpos); 6035 UPDATE_SYNTAX_TABLE_FAST (charpos);
6036#endif 6036#endif
6037 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); 6037 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2);
6038 s1 = SYNTAX (c1); 6038 s1 = SYNTAX (c1);
@@ -6047,7 +6047,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
6047 PREFETCH_NOLIMIT (); 6047 PREFETCH_NOLIMIT ();
6048 GET_CHAR_AFTER (c2, d, dummy); 6048 GET_CHAR_AFTER (c2, d, dummy);
6049#ifdef emacs 6049#ifdef emacs
6050 UPDATE_SYNTAX_TABLE_FORWARD (charpos); 6050 UPDATE_SYNTAX_TABLE_FORWARD_FAST (charpos);
6051#endif 6051#endif
6052 s2 = SYNTAX (c2); 6052 s2 = SYNTAX (c2);
6053 6053
@@ -6076,7 +6076,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
6076#ifdef emacs 6076#ifdef emacs
6077 ssize_t offset = PTR_TO_OFFSET (d); 6077 ssize_t offset = PTR_TO_OFFSET (d);
6078 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); 6078 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset);
6079 UPDATE_SYNTAX_TABLE (charpos); 6079 UPDATE_SYNTAX_TABLE_FAST (charpos);
6080#endif 6080#endif
6081 PREFETCH (); 6081 PREFETCH ();
6082 c2 = RE_STRING_CHAR (d, target_multibyte); 6082 c2 = RE_STRING_CHAR (d, target_multibyte);
@@ -6119,7 +6119,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
6119#ifdef emacs 6119#ifdef emacs
6120 ssize_t offset = PTR_TO_OFFSET (d) - 1; 6120 ssize_t offset = PTR_TO_OFFSET (d) - 1;
6121 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); 6121 ssize_t charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset);
6122 UPDATE_SYNTAX_TABLE (charpos); 6122 UPDATE_SYNTAX_TABLE_FAST (charpos);
6123#endif 6123#endif
6124 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2); 6124 GET_CHAR_BEFORE_2 (c1, d, string1, end1, string2, end2);
6125 s1 = SYNTAX (c1); 6125 s1 = SYNTAX (c1);
@@ -6134,7 +6134,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
6134 PREFETCH_NOLIMIT (); 6134 PREFETCH_NOLIMIT ();
6135 c2 = RE_STRING_CHAR (d, target_multibyte); 6135 c2 = RE_STRING_CHAR (d, target_multibyte);
6136#ifdef emacs 6136#ifdef emacs
6137 UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); 6137 UPDATE_SYNTAX_TABLE_FORWARD_FAST (charpos + 1);
6138#endif 6138#endif
6139 s2 = SYNTAX (c2); 6139 s2 = SYNTAX (c2);
6140 6140
@@ -6157,7 +6157,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
6157 { 6157 {
6158 ssize_t offset = PTR_TO_OFFSET (d); 6158 ssize_t offset = PTR_TO_OFFSET (d);
6159 ssize_t pos1 = SYNTAX_TABLE_BYTE_TO_CHAR (offset); 6159 ssize_t pos1 = SYNTAX_TABLE_BYTE_TO_CHAR (offset);
6160 UPDATE_SYNTAX_TABLE (pos1); 6160 UPDATE_SYNTAX_TABLE_FAST (pos1);
6161 } 6161 }
6162#endif 6162#endif
6163 { 6163 {
diff --git a/src/syntax.c b/src/syntax.c
index 1dcb3a5d15d..2acbd413858 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -519,8 +519,7 @@ update_syntax_table_forward (ptrdiff_t charpos, bool init,
519 else 519 else
520 { 520 {
521 update_syntax_table (charpos, 1, init, object); 521 update_syntax_table (charpos, 1, init, object);
522 if (gl_state.e_property > syntax_propertize__done 522 if (NILP (object) && gl_state.e_property > syntax_propertize__done)
523 && NILP (object))
524 parse_sexp_propertize (charpos); 523 parse_sexp_propertize (charpos);
525 } 524 }
526} 525}
@@ -791,8 +790,10 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
791 || SYNTAX_FLAGS_COMMENT_NESTED (syntax) != comnested)) 790 || SYNTAX_FLAGS_COMMENT_NESTED (syntax) != comnested))
792 continue; 791 continue;
793 792
794 /* Ignore escaped characters, except comment-enders. */ 793 /* Ignore escaped characters, except comment-enders which cannot
795 if (code != Sendcomment && char_quoted (from, from_byte)) 794 be escaped. */
795 if ((Vcomment_end_can_be_escaped || code != Sendcomment)
796 && char_quoted (from, from_byte))
796 continue; 797 continue;
797 798
798 switch (code) 799 switch (code)
@@ -2347,7 +2348,8 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2347 if (code == Sendcomment 2348 if (code == Sendcomment
2348 && SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style 2349 && SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style
2349 && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ? 2350 && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ?
2350 (nesting > 0 && --nesting == 0) : nesting < 0)) 2351 (nesting > 0 && --nesting == 0) : nesting < 0)
2352 && !(Vcomment_end_can_be_escaped && char_quoted (from, from_byte)))
2351 /* We have encountered a comment end of the same style 2353 /* We have encountered a comment end of the same style
2352 as the comment sequence which began this comment 2354 as the comment sequence which began this comment
2353 section. */ 2355 section. */
@@ -3703,6 +3705,12 @@ character of that word.
3703In both cases, LIMIT bounds the search. */); 3705In both cases, LIMIT bounds the search. */);
3704 Vfind_word_boundary_function_table = Fmake_char_table (Qnil, Qnil); 3706 Vfind_word_boundary_function_table = Fmake_char_table (Qnil, Qnil);
3705 3707
3708 DEFVAR_BOOL ("comment-end-can-be-escaped", Vcomment_end_can_be_escaped,
3709 doc: /* Non-nil means an escaped ender inside a comment doesn'tend the comment. */);
3710 Vcomment_end_can_be_escaped = 0;
3711 DEFSYM (Qcomment_end_can_be_escaped, "comment-end-can-be-escaped");
3712 Fmake_variable_buffer_local (Qcomment_end_can_be_escaped);
3713
3706 defsubr (&Ssyntax_table_p); 3714 defsubr (&Ssyntax_table_p);
3707 defsubr (&Ssyntax_table); 3715 defsubr (&Ssyntax_table);
3708 defsubr (&Sstandard_syntax_table); 3716 defsubr (&Sstandard_syntax_table);
diff --git a/src/syntax.h b/src/syntax.h
index 06ce0ec55df..eb154e088c9 100644
--- a/src/syntax.h
+++ b/src/syntax.h
@@ -186,6 +186,13 @@ UPDATE_SYNTAX_TABLE_FORWARD (ptrdiff_t charpos)
186 false, gl_state.object); 186 false, gl_state.object);
187} 187}
188 188
189INLINE void
190UPDATE_SYNTAX_TABLE_FORWARD_FAST (ptrdiff_t charpos)
191{
192 if (parse_sexp_lookup_properties && charpos >= gl_state.e_property)
193 update_syntax_table (charpos + gl_state.offset, 1, false, gl_state.object);
194}
195
189/* Make syntax table state (gl_state) good for CHARPOS, assuming it is 196/* Make syntax table state (gl_state) good for CHARPOS, assuming it is
190 currently good for a position after CHARPOS. */ 197 currently good for a position after CHARPOS. */
191 198
@@ -205,6 +212,13 @@ UPDATE_SYNTAX_TABLE (ptrdiff_t charpos)
205 UPDATE_SYNTAX_TABLE_FORWARD (charpos); 212 UPDATE_SYNTAX_TABLE_FORWARD (charpos);
206} 213}
207 214
215INLINE void
216UPDATE_SYNTAX_TABLE_FAST (ptrdiff_t charpos)
217{
218 UPDATE_SYNTAX_TABLE_BACKWARD (charpos);
219 UPDATE_SYNTAX_TABLE_FORWARD_FAST (charpos);
220}
221
208/* Set up the buffer-global syntax table. */ 222/* Set up the buffer-global syntax table. */
209 223
210INLINE void 224INLINE void
diff --git a/src/undo.c b/src/undo.c
index 214beaeb9ea..1cc6de48393 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -22,10 +22,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 22
23#include "lisp.h" 23#include "lisp.h"
24#include "buffer.h" 24#include "buffer.h"
25 25#include "keyboard.h"
26/* Position of point last time we inserted a boundary. */
27static struct buffer *last_boundary_buffer;
28static ptrdiff_t last_boundary_position;
29 26
30/* The first time a command records something for undo. 27/* The first time a command records something for undo.
31 it also allocates the undo-boundary object 28 it also allocates the undo-boundary object
@@ -34,45 +31,42 @@ static ptrdiff_t last_boundary_position;
34 an undo-boundary. */ 31 an undo-boundary. */
35static Lisp_Object pending_boundary; 32static Lisp_Object pending_boundary;
36 33
34/* Record point as it was at beginning of this command (if necessary)
35 and prepare the undo info for recording a change.
36 Prepare the undo info for recording a change. */
37static void 37static void
38run_undoable_change (void) 38prepare_record (void)
39{ 39{
40 call0 (Qundo_auto__undoable_change); 40 /* Allocate a cons cell to be the undo boundary after this command. */
41 if (NILP (pending_boundary))
42 pending_boundary = Fcons (Qnil, Qnil);
43
44 if (MODIFF <= SAVE_MODIFF)
45 record_first_change ();
41} 46}
42 47
43/* Record point as it was at beginning of this command (if necessary) 48/* Record point as it was at beginning of this command.
44 and prepare the undo info for recording a change.
45 PT is the position of point that will naturally occur as a result of the 49 PT is the position of point that will naturally occur as a result of the
46 undo record that will be added just after this command terminates. */ 50 undo record that will be added just after this command terminates. */
47
48static void 51static void
49record_point (ptrdiff_t pt) 52record_point (ptrdiff_t pt)
50{ 53{
51 bool at_boundary;
52
53 /* Don't record position of pt when undo_inhibit_record_point holds. */ 54 /* Don't record position of pt when undo_inhibit_record_point holds. */
54 if (undo_inhibit_record_point) 55 if (undo_inhibit_record_point)
55 return; 56 return;
56 57
57 /* Allocate a cons cell to be the undo boundary after this command. */ 58 bool at_boundary;
58 if (NILP (pending_boundary))
59 pending_boundary = Fcons (Qnil, Qnil);
60
61 run_undoable_change ();
62 59
63 at_boundary = ! CONSP (BVAR (current_buffer, undo_list)) 60 at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
64 || NILP (XCAR (BVAR (current_buffer, undo_list))); 61 || NILP (XCAR (BVAR (current_buffer, undo_list)));
65 62
66 if (MODIFF <= SAVE_MODIFF) 63 prepare_record ();
67 record_first_change ();
68 64
69 /* If we are just after an undo boundary, and 65 /* If we are just after an undo boundary, and
70 point wasn't at start of deleted range, record where it was. */ 66 point wasn't at start of deleted range, record where it was. */
71 if (at_boundary 67 if (at_boundary)
72 && current_buffer == last_boundary_buffer
73 && last_boundary_position != pt)
74 bset_undo_list (current_buffer, 68 bset_undo_list (current_buffer,
75 Fcons (make_number (last_boundary_position), 69 Fcons (make_number (pt),
76 BVAR (current_buffer, undo_list))); 70 BVAR (current_buffer, undo_list)));
77} 71}
78 72
@@ -89,7 +83,7 @@ record_insert (ptrdiff_t beg, ptrdiff_t length)
89 if (EQ (BVAR (current_buffer, undo_list), Qt)) 83 if (EQ (BVAR (current_buffer, undo_list), Qt))
90 return; 84 return;
91 85
92 record_point (beg); 86 prepare_record ();
93 87
94 /* If this is following another insertion and consecutive with it 88 /* If this is following another insertion and consecutive with it
95 in the buffer, combine the two. */ 89 in the buffer, combine the two. */
@@ -130,8 +124,6 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
130 if (NILP (pending_boundary)) 124 if (NILP (pending_boundary))
131 pending_boundary = Fcons (Qnil, Qnil); 125 pending_boundary = Fcons (Qnil, Qnil);
132 126
133 run_undoable_change ();
134
135 for (m = BUF_MARKERS (current_buffer); m; m = m->next) 127 for (m = BUF_MARKERS (current_buffer); m; m = m->next)
136 { 128 {
137 charpos = m->charpos; 129 charpos = m->charpos;
@@ -163,7 +155,6 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
163/* Record that a deletion is about to take place, of the characters in 155/* Record that a deletion is about to take place, of the characters in
164 STRING, at location BEG. Optionally record adjustments for markers 156 STRING, at location BEG. Optionally record adjustments for markers
165 in the region STRING occupies in the current buffer. */ 157 in the region STRING occupies in the current buffer. */
166
167void 158void
168record_delete (ptrdiff_t beg, Lisp_Object string, bool record_markers) 159record_delete (ptrdiff_t beg, Lisp_Object string, bool record_markers)
169{ 160{
@@ -172,15 +163,19 @@ record_delete (ptrdiff_t beg, Lisp_Object string, bool record_markers)
172 if (EQ (BVAR (current_buffer, undo_list), Qt)) 163 if (EQ (BVAR (current_buffer, undo_list), Qt))
173 return; 164 return;
174 165
166 if (point_before_last_command_or_undo != beg
167 && buffer_before_last_command_or_undo == current_buffer)
168 record_point (point_before_last_command_or_undo);
169
175 if (PT == beg + SCHARS (string)) 170 if (PT == beg + SCHARS (string))
176 { 171 {
177 XSETINT (sbeg, -beg); 172 XSETINT (sbeg, -beg);
178 record_point (PT); 173 prepare_record ();
179 } 174 }
180 else 175 else
181 { 176 {
182 XSETFASTINT (sbeg, beg); 177 XSETFASTINT (sbeg, beg);
183 record_point (beg); 178 prepare_record ();
184 } 179 }
185 180
186 /* primitive-undo assumes marker adjustments are recorded 181 /* primitive-undo assumes marker adjustments are recorded
@@ -234,7 +229,7 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
234 Lisp_Object buffer) 229 Lisp_Object buffer)
235{ 230{
236 Lisp_Object lbeg, lend, entry; 231 Lisp_Object lbeg, lend, entry;
237 struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer); 232 struct buffer *buf = XBUFFER (buffer);
238 233
239 if (EQ (BVAR (buf, undo_list), Qt)) 234 if (EQ (BVAR (buf, undo_list), Qt))
240 return; 235 return;
@@ -243,11 +238,6 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
243 if (NILP (pending_boundary)) 238 if (NILP (pending_boundary))
244 pending_boundary = Fcons (Qnil, Qnil); 239 pending_boundary = Fcons (Qnil, Qnil);
245 240
246 /* Switch temporarily to the buffer that was changed. */
247 set_buffer_internal (buf);
248
249 run_undoable_change ();
250
251 if (MODIFF <= SAVE_MODIFF) 241 if (MODIFF <= SAVE_MODIFF)
252 record_first_change (); 242 record_first_change ();
253 243
@@ -256,9 +246,6 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
256 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); 246 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
257 bset_undo_list (current_buffer, 247 bset_undo_list (current_buffer,
258 Fcons (entry, BVAR (current_buffer, undo_list))); 248 Fcons (entry, BVAR (current_buffer, undo_list)));
259
260 /* Reset the buffer */
261 set_buffer_internal (obuf);
262} 249}
263 250
264DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0, 251DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
@@ -286,10 +273,11 @@ but another undo command will undo to the previous boundary. */)
286 bset_undo_list (current_buffer, 273 bset_undo_list (current_buffer,
287 Fcons (Qnil, BVAR (current_buffer, undo_list))); 274 Fcons (Qnil, BVAR (current_buffer, undo_list)));
288 } 275 }
289 last_boundary_position = PT;
290 last_boundary_buffer = current_buffer;
291 276
292 Fset (Qundo_auto__last_boundary_cause, Qexplicit); 277 Fset (Qundo_auto__last_boundary_cause, Qexplicit);
278 point_before_last_command_or_undo = PT;
279 buffer_before_last_command_or_undo = current_buffer;
280
293 return Qnil; 281 return Qnil;
294} 282}
295 283
@@ -432,7 +420,6 @@ void
432syms_of_undo (void) 420syms_of_undo (void)
433{ 421{
434 DEFSYM (Qinhibit_read_only, "inhibit-read-only"); 422 DEFSYM (Qinhibit_read_only, "inhibit-read-only");
435 DEFSYM (Qundo_auto__undoable_change, "undo-auto--undoable-change");
436 DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause"); 423 DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause");
437 DEFSYM (Qexplicit, "explicit"); 424 DEFSYM (Qexplicit, "explicit");
438 425
@@ -442,8 +429,6 @@ syms_of_undo (void)
442 pending_boundary = Qnil; 429 pending_boundary = Qnil;
443 staticpro (&pending_boundary); 430 staticpro (&pending_boundary);
444 431
445 last_boundary_buffer = NULL;
446
447 defsubr (&Sundo_boundary); 432 defsubr (&Sundo_boundary);
448 433
449 DEFVAR_INT ("undo-limit", undo_limit, 434 DEFVAR_INT ("undo-limit", undo_limit,
diff --git a/src/unexelf.c b/src/unexelf.c
index c10c7f21bf2..03e6dafe8ee 100644
--- a/src/unexelf.c
+++ b/src/unexelf.c
@@ -247,7 +247,7 @@ unexec (const char *new_name, const char *old_name)
247 247
248 ElfW (Phdr) *old_bss_seg, *new_bss_seg; 248 ElfW (Phdr) *old_bss_seg, *new_bss_seg;
249 ElfW (Addr) old_bss_addr, new_bss_addr; 249 ElfW (Addr) old_bss_addr, new_bss_addr;
250 ElfW (Word) old_bss_size, new_data2_size; 250 ElfW (Word) old_bss_size, bss_size_growth, new_data2_size;
251 ElfW (Off) old_bss_offset, new_data2_offset; 251 ElfW (Off) old_bss_offset, new_data2_offset;
252 252
253 ptrdiff_t n; 253 ptrdiff_t n;
@@ -331,7 +331,11 @@ unexec (const char *new_name, const char *old_name)
331 331
332 new_break = sbrk (0); 332 new_break = sbrk (0);
333 new_bss_addr = (ElfW (Addr)) new_break; 333 new_bss_addr = (ElfW (Addr)) new_break;
334 new_data2_size = new_bss_addr - old_bss_addr; 334 bss_size_growth = new_bss_addr - old_bss_addr;
335 new_data2_size = bss_size_growth;
336 new_data2_size += alignof (ElfW (Shdr)) - 1;
337 new_data2_size -= new_data2_size % alignof (ElfW (Shdr));
338
335 new_data2_offset = old_bss_offset; 339 new_data2_offset = old_bss_offset;
336 340
337#ifdef UNEXELF_DEBUG 341#ifdef UNEXELF_DEBUG
@@ -399,7 +403,8 @@ unexec (const char *new_name, const char *old_name)
399 new_bss_seg->p_memsz = new_bss_seg->p_filesz; 403 new_bss_seg->p_memsz = new_bss_seg->p_filesz;
400 404
401 /* Copy over what we have in memory now for the bss area. */ 405 /* Copy over what we have in memory now for the bss area. */
402 memcpy (new_base + new_data2_offset, (caddr_t) old_bss_addr, new_data2_size); 406 memcpy (new_base + new_data2_offset, (caddr_t) old_bss_addr,
407 bss_size_growth);
403 408
404 /* Walk through all section headers, copying data and updating. */ 409 /* Walk through all section headers, copying data and updating. */
405 for (n = 1; n < old_file_h->e_shnum; n++) 410 for (n = 1; n < old_file_h->e_shnum; n++)
diff --git a/src/w32.c b/src/w32.c
index 15cfd92a29a..9b1d94de786 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -7432,7 +7432,7 @@ sys_socket (int af, int type, int protocol)
7432 if (winsock_lib == NULL) 7432 if (winsock_lib == NULL)
7433 { 7433 {
7434 errno = ENETDOWN; 7434 errno = ENETDOWN;
7435 return INVALID_SOCKET; 7435 return -1;
7436 } 7436 }
7437 7437
7438 check_errno (); 7438 check_errno ();
@@ -9270,8 +9270,10 @@ maybe_load_unicows_dll (void)
9270 pointers, and assign the correct addresses to these 9270 pointers, and assign the correct addresses to these
9271 pointers at program startup (see emacs.c, which calls 9271 pointers at program startup (see emacs.c, which calls
9272 this function early on). */ 9272 this function early on). */
9273 pMultiByteToWideChar = GetProcAddress (ret, "MultiByteToWideChar"); 9273 pMultiByteToWideChar =
9274 pWideCharToMultiByte = GetProcAddress (ret, "WideCharToMultiByte"); 9274 (MultiByteToWideChar_Proc)GetProcAddress (ret, "MultiByteToWideChar");
9275 pWideCharToMultiByte =
9276 (WideCharToMultiByte_Proc)GetProcAddress (ret, "WideCharToMultiByte");
9275 return ret; 9277 return ret;
9276 } 9278 }
9277 else 9279 else
@@ -9379,6 +9381,11 @@ globals_of_w32 (void)
9379 w32_unicode_filenames = 0; 9381 w32_unicode_filenames = 0;
9380 else 9382 else
9381 w32_unicode_filenames = 1; 9383 w32_unicode_filenames = 1;
9384
9385#ifdef HAVE_MODULES
9386 extern void dynlib_reset_last_error (void);
9387 dynlib_reset_last_error ();
9388#endif
9382} 9389}
9383 9390
9384/* For make-serial-process */ 9391/* For make-serial-process */
diff --git a/src/w32.h b/src/w32.h
index 2c711502593..1efd562eadb 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -179,8 +179,10 @@ extern int _sys_wait_connect (int fd);
179 179
180extern HMODULE w32_delayed_load (Lisp_Object); 180extern HMODULE w32_delayed_load (Lisp_Object);
181 181
182extern int (WINAPI *pMultiByteToWideChar)(UINT,DWORD,LPCSTR,int,LPWSTR,int); 182typedef int (WINAPI *MultiByteToWideChar_Proc)(UINT,DWORD,LPCSTR,int,LPWSTR,int);
183extern int (WINAPI *pWideCharToMultiByte)(UINT,DWORD,LPCWSTR,int,LPSTR,int,LPCSTR,LPBOOL); 183typedef int (WINAPI *WideCharToMultiByte_Proc)(UINT,DWORD,LPCWSTR,int,LPSTR,int,LPCSTR,LPBOOL);
184extern MultiByteToWideChar_Proc pMultiByteToWideChar;
185extern WideCharToMultiByte_Proc pWideCharToMultiByte;
184 186
185extern void init_environment (char **); 187extern void init_environment (char **);
186extern void check_windows_init_file (void); 188extern void check_windows_init_file (void);
diff --git a/src/w32console.c b/src/w32console.c
index ec54f83129f..7fffabf3853 100644
--- a/src/w32console.c
+++ b/src/w32console.c
@@ -757,13 +757,8 @@ initialize_w32_display (struct terminal *term, int *width, int *height)
757 else 757 else
758 w32_console_unicode_input = 0; 758 w32_console_unicode_input = 0;
759 759
760 /* This is needed by w32notify.c:send_notifications. */
761 dwMainThreadId = GetCurrentThreadId ();
762
763 /* Setup w32_display_info structure for this frame. */ 760 /* Setup w32_display_info structure for this frame. */
764
765 w32_initialize_display_info (build_string ("Console")); 761 w32_initialize_display_info (build_string ("Console"));
766
767} 762}
768 763
769 764
diff --git a/src/w32fns.c b/src/w32fns.c
index f3391cb98f0..c1d9bff98ab 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1666,10 +1666,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
1666 FRAME_MENU_BAR_LINES (f) = 0; 1666 FRAME_MENU_BAR_LINES (f) = 0;
1667 FRAME_MENU_BAR_HEIGHT (f) = 0; 1667 FRAME_MENU_BAR_HEIGHT (f) = 0;
1668 if (nlines) 1668 if (nlines)
1669 { 1669 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1670 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1671 windows_or_buffers_changed = 23;
1672 }
1673 else 1670 else
1674 { 1671 {
1675 if (FRAME_EXTERNAL_MENU_BAR (f) == 1) 1672 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
@@ -4620,8 +4617,7 @@ my_create_tip_window (struct frame *f)
4620 rect.right = FRAME_PIXEL_WIDTH (f); 4617 rect.right = FRAME_PIXEL_WIDTH (f);
4621 rect.bottom = FRAME_PIXEL_HEIGHT (f); 4618 rect.bottom = FRAME_PIXEL_HEIGHT (f);
4622 4619
4623 AdjustWindowRect (&rect, f->output_data.w32->dwStyle, 4620 AdjustWindowRect (&rect, f->output_data.w32->dwStyle, false);
4624 FRAME_EXTERNAL_MENU_BAR (f));
4625 4621
4626 tip_window = FRAME_W32_WINDOW (f) 4622 tip_window = FRAME_W32_WINDOW (f)
4627 = CreateWindow (EMACS_CLASS, 4623 = CreateWindow (EMACS_CLASS,
@@ -6381,7 +6377,7 @@ compute_tip_xy (struct frame *f,
6381 if (INTEGERP (left)) 6377 if (INTEGERP (left))
6382 *root_x = XINT (left); 6378 *root_x = XINT (left);
6383 else if (INTEGERP (right)) 6379 else if (INTEGERP (right))
6384 *root_y = XINT (right) - width; 6380 *root_x = XINT (right) - width;
6385 else if (*root_x + XINT (dx) <= min_x) 6381 else if (*root_x + XINT (dx) <= min_x)
6386 *root_x = 0; /* Can happen for negative dx */ 6382 *root_x = 0; /* Can happen for negative dx */
6387 else if (*root_x + XINT (dx) + width <= max_x) 6383 else if (*root_x + XINT (dx) + width <= max_x)
@@ -6681,8 +6677,7 @@ Text larger than the specified size is clipped. */)
6681 rect.left = rect.top = 0; 6677 rect.left = rect.top = 0;
6682 rect.right = width; 6678 rect.right = width;
6683 rect.bottom = height; 6679 rect.bottom = height;
6684 AdjustWindowRect (&rect, f->output_data.w32->dwStyle, 6680 AdjustWindowRect (&rect, f->output_data.w32->dwStyle, false);
6685 FRAME_EXTERNAL_MENU_BAR (f));
6686 6681
6687 /* Position and size tooltip, and put it in the topmost group. 6682 /* Position and size tooltip, and put it in the topmost group.
6688 The add-on of FRAME_COLUMN_WIDTH to the 5th argument is a 6683 The add-on of FRAME_COLUMN_WIDTH to the 5th argument is a
@@ -8098,11 +8093,22 @@ The coordinates X and Y are interpreted in pixels relative to a position
8098(0, 0) of the selected frame's display. */) 8093(0, 0) of the selected frame's display. */)
8099 (Lisp_Object x, Lisp_Object y) 8094 (Lisp_Object x, Lisp_Object y)
8100{ 8095{
8096 UINT trail_num = 0;
8097 BOOL ret = false;
8098
8101 CHECK_TYPE_RANGED_INTEGER (int, x); 8099 CHECK_TYPE_RANGED_INTEGER (int, x);
8102 CHECK_TYPE_RANGED_INTEGER (int, y); 8100 CHECK_TYPE_RANGED_INTEGER (int, y);
8103 8101
8104 block_input (); 8102 block_input ();
8103 /* When "mouse trails" are in effect, moving the mouse cursor
8104 sometimes leaves behind an annoying "ghost" of the pointer.
8105 Avoid that by momentarily switching off mouse trails. */
8106 if (os_subtype == OS_NT
8107 && w32_major_version + w32_minor_version >= 6)
8108 ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0);
8105 SetCursorPos (XINT (x), XINT (y)); 8109 SetCursorPos (XINT (x), XINT (y));
8110 if (ret)
8111 SystemParametersInfo (SPI_SETMOUSETRAILS, trail_num, NULL, 0);
8106 unblock_input (); 8112 unblock_input ();
8107 8113
8108 return Qnil; 8114 return Qnil;
@@ -9925,10 +9931,6 @@ globals_of_w32fns (void)
9925 InitCommonControls (); 9931 InitCommonControls ();
9926 9932
9927 syms_of_w32uniscribe (); 9933 syms_of_w32uniscribe ();
9928
9929 /* Needed for recovery from C stack overflows in batch mode. */
9930 if (noninteractive)
9931 dwMainThreadId = GetCurrentThreadId ();
9932} 9934}
9933 9935
9934#ifdef NTGUI_UNICODE 9936#ifdef NTGUI_UNICODE
diff --git a/src/w32menu.c b/src/w32menu.c
index 6af69f482d4..964b965fac1 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -494,7 +494,10 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
494 /* Force the window size to be recomputed so that the frame's text 494 /* Force the window size to be recomputed so that the frame's text
495 area remains the same, if menubar has just been created. */ 495 area remains the same, if menubar has just been created. */
496 if (old_widget == NULL) 496 if (old_widget == NULL)
497 adjust_frame_size (f, -1, -1, 2, false, Qmenu_bar_lines); 497 {
498 windows_or_buffers_changed = 23;
499 adjust_frame_size (f, -1, -1, 2, false, Qmenu_bar_lines);
500 }
498 } 501 }
499 502
500 unblock_input (); 503 unblock_input ();
diff --git a/src/w32term.c b/src/w32term.c
index f764e250aa8..60d64f7fd0f 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -23,6 +23,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23#include "lisp.h" 23#include "lisp.h"
24#include "blockinput.h" 24#include "blockinput.h"
25#include "w32term.h" 25#include "w32term.h"
26#include "w32common.h" /* for OS version info */
26 27
27#include <ctype.h> 28#include <ctype.h>
28#include <errno.h> 29#include <errno.h>
@@ -6115,9 +6116,22 @@ x_set_window_size (struct frame *f, bool change_gravity,
6115 int pixelwidth, pixelheight; 6116 int pixelwidth, pixelheight;
6116 Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); 6117 Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
6117 RECT rect; 6118 RECT rect;
6119 MENUBARINFO info;
6120 int menu_bar_height;
6118 6121
6119 block_input (); 6122 block_input ();
6120 6123
6124 /* Get the height of the menu bar here. It's used below to detect
6125 whether the menu bar is wrapped. It's also used to specify the
6126 third argument for AdjustWindowRect. FRAME_EXTERNAL_MENU_BAR which
6127 has been used before for that reason is unreliable because it only
6128 specifies whether we _want_ a menu bar for this frame and not
6129 whether this frame _has_ a menu bar. See bug#22105. */
6130 info.cbSize = sizeof (info);
6131 info.rcBar.top = info.rcBar.bottom = 0;
6132 GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &info);
6133 menu_bar_height = info.rcBar.bottom - info.rcBar.top;
6134
6121 if (pixelwise) 6135 if (pixelwise)
6122 { 6136 {
6123 pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width); 6137 pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width);
@@ -6135,17 +6149,11 @@ x_set_window_size (struct frame *f, bool change_gravity,
6135 height of the frame then the wrapped menu bar lines are not 6149 height of the frame then the wrapped menu bar lines are not
6136 accounted for (Bug#15174 and Bug#18720). Here we add these 6150 accounted for (Bug#15174 and Bug#18720). Here we add these
6137 extra lines to the frame height. */ 6151 extra lines to the frame height. */
6138 MENUBARINFO info;
6139 int default_menu_bar_height; 6152 int default_menu_bar_height;
6140 int menu_bar_height;
6141 6153
6142 /* Why is (apparently) SM_CYMENUSIZE needed here instead of 6154 /* Why is (apparently) SM_CYMENUSIZE needed here instead of
6143 SM_CYMENU ?? */ 6155 SM_CYMENU ?? */
6144 default_menu_bar_height = GetSystemMetrics (SM_CYMENUSIZE); 6156 default_menu_bar_height = GetSystemMetrics (SM_CYMENUSIZE);
6145 info.cbSize = sizeof (info);
6146 info.rcBar.top = info.rcBar.bottom = 0;
6147 GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &info);
6148 menu_bar_height = info.rcBar.bottom - info.rcBar.top;
6149 6157
6150 if ((default_menu_bar_height > 0) 6158 if ((default_menu_bar_height > 0)
6151 && (menu_bar_height > default_menu_bar_height) 6159 && (menu_bar_height > default_menu_bar_height)
@@ -6160,8 +6168,7 @@ x_set_window_size (struct frame *f, bool change_gravity,
6160 rect.right = pixelwidth; 6168 rect.right = pixelwidth;
6161 rect.bottom = pixelheight; 6169 rect.bottom = pixelheight;
6162 6170
6163 AdjustWindowRect (&rect, f->output_data.w32->dwStyle, 6171 AdjustWindowRect (&rect, f->output_data.w32->dwStyle, menu_bar_height > 0);
6164 FRAME_EXTERNAL_MENU_BAR (f));
6165 6172
6166 if (!(f->after_make_frame) 6173 if (!(f->after_make_frame)
6167 && !(f->want_fullscreen & FULLSCREEN_WAIT) 6174 && !(f->want_fullscreen & FULLSCREEN_WAIT)
@@ -6231,6 +6238,8 @@ x_set_window_size (struct frame *f, bool change_gravity,
6231void 6238void
6232frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) 6239frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
6233{ 6240{
6241 UINT trail_num = 0;
6242 BOOL ret = false;
6234 RECT rect; 6243 RECT rect;
6235 POINT pt; 6244 POINT pt;
6236 6245
@@ -6241,7 +6250,15 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
6241 pt.y = rect.top + pix_y; 6250 pt.y = rect.top + pix_y;
6242 ClientToScreen (FRAME_W32_WINDOW (f), &pt); 6251 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
6243 6252
6253 /* When "mouse trails" are in effect, moving the mouse cursor
6254 sometimes leaves behind an annoying "ghost" of the pointer.
6255 Avoid that by momentarily switching off mouse trails. */
6256 if (os_subtype == OS_NT
6257 && w32_major_version + w32_minor_version >= 6)
6258 ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0);
6244 SetCursorPos (pt.x, pt.y); 6259 SetCursorPos (pt.x, pt.y);
6260 if (ret)
6261 SystemParametersInfo (SPI_SETMOUSETRAILS, trail_num, NULL, 0);
6245 6262
6246 unblock_input (); 6263 unblock_input ();
6247} 6264}
@@ -6925,6 +6942,15 @@ x_delete_display (struct w32_display_info *dpyinfo)
6925 6942
6926/* Set up use of W32. */ 6943/* Set up use of W32. */
6927 6944
6945void
6946w32_init_main_thread (void)
6947{
6948 dwMainThreadId = GetCurrentThreadId ();
6949 DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
6950 GetCurrentProcess (), &hMainThread, 0, TRUE,
6951 DUPLICATE_SAME_ACCESS);
6952}
6953
6928DWORD WINAPI w32_msg_worker (void * arg); 6954DWORD WINAPI w32_msg_worker (void * arg);
6929 6955
6930static void 6956static void
@@ -6985,10 +7011,6 @@ w32_initialize (void)
6985 terminates */ 7011 terminates */
6986 init_crit (); 7012 init_crit ();
6987 7013
6988 dwMainThreadId = GetCurrentThreadId ();
6989 DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
6990 GetCurrentProcess (), &hMainThread, 0, TRUE, DUPLICATE_SAME_ACCESS);
6991
6992 /* Wait for thread to start */ 7014 /* Wait for thread to start */
6993 { 7015 {
6994 MSG msg; 7016 MSG msg;
diff --git a/src/w32term.h b/src/w32term.h
index 467da10c3b7..3377b53608e 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -855,6 +855,8 @@ extern void globals_of_w32menu (void);
855extern void globals_of_w32fns (void); 855extern void globals_of_w32fns (void);
856extern void globals_of_w32notify (void); 856extern void globals_of_w32notify (void);
857 857
858extern void w32_init_main_thread (void);
859
858#ifdef CYGWIN 860#ifdef CYGWIN
859extern int w32_message_fd; 861extern int w32_message_fd;
860#endif /* CYGWIN */ 862#endif /* CYGWIN */
diff --git a/src/window.c b/src/window.c
index 0ac76d41861..9f6b489e74a 100644
--- a/src/window.c
+++ b/src/window.c
@@ -4064,37 +4064,6 @@ resize_frame_windows (struct frame *f, int size, bool horflag, bool pixelwise)
4064 { 4064 {
4065 window_resize_apply (r, horflag); 4065 window_resize_apply (r, horflag);
4066 window_pixel_to_total (r->frame, horflag ? Qt : Qnil); 4066 window_pixel_to_total (r->frame, horflag ? Qt : Qnil);
4067#if false /* Let's try without safe sizes and/or killing other windows. */
4068 }
4069 else
4070 {
4071 /* Finally, try with "safe" minimum sizes. */
4072 resize_root_window (root, delta, horflag ? Qt : Qnil, Qsafe,
4073 pixelwise ? Qt : Qnil);
4074 if (window_resize_check (r, horflag)
4075 && new_pixel_size == XINT (r->new_pixel))
4076 {
4077 window_resize_apply (r, horflag);
4078 window_pixel_to_total (r->frame, horflag ? Qt : Qnil);
4079 }
4080 else
4081 {
4082 /* We lost. Delete all windows but the frame's
4083 selected one. */
4084 root = f->selected_window;
4085 Fdelete_other_windows_internal (root, Qnil);
4086 if (horflag)
4087 {
4088 XWINDOW (root)->total_cols = new_size;
4089 XWINDOW (root)->pixel_width = new_pixel_size;
4090 }
4091 else
4092 {
4093 XWINDOW (root)->total_lines = new_size;
4094 XWINDOW (root)->pixel_height = new_pixel_size;
4095 }
4096 }
4097#endif /* false */
4098 } 4067 }
4099 } 4068 }
4100 } 4069 }
@@ -4117,6 +4086,7 @@ resize_frame_windows (struct frame *f, int size, bool horflag, bool pixelwise)
4117 } 4086 }
4118 } 4087 }
4119 4088
4089 FRAME_WINDOW_SIZES_CHANGED (f) = true;
4120 fset_redisplay (f); 4090 fset_redisplay (f);
4121} 4091}
4122 4092
@@ -4555,6 +4525,7 @@ grow_mini_window (struct window *w, int delta, bool pixelwise)
4555 /* Enforce full redisplay of the frame. */ 4525 /* Enforce full redisplay of the frame. */
4556 /* FIXME: Shouldn't window--resize-root-window-vertically do it? */ 4526 /* FIXME: Shouldn't window--resize-root-window-vertically do it? */
4557 fset_redisplay (f); 4527 fset_redisplay (f);
4528 FRAME_WINDOW_SIZES_CHANGED (f) = true;
4558 adjust_frame_glyphs (f); 4529 adjust_frame_glyphs (f);
4559 unblock_input (); 4530 unblock_input ();
4560 } 4531 }
@@ -4594,6 +4565,7 @@ shrink_mini_window (struct window *w, bool pixelwise)
4594 /* Enforce full redisplay of the frame. */ 4565 /* Enforce full redisplay of the frame. */
4595 /* FIXME: Shouldn't window--resize-root-window-vertically do it? */ 4566 /* FIXME: Shouldn't window--resize-root-window-vertically do it? */
4596 fset_redisplay (f); 4567 fset_redisplay (f);
4568 FRAME_WINDOW_SIZES_CHANGED (f) = true;
4597 adjust_frame_glyphs (f); 4569 adjust_frame_glyphs (f);
4598 unblock_input (); 4570 unblock_input ();
4599 } 4571 }
diff --git a/src/xdisp.c b/src/xdisp.c
index 30dfac55601..37dc6047e58 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -10733,6 +10733,9 @@ display_echo_area (struct window *w)
10733 reset the echo_area_buffer in question to nil at the end because 10733 reset the echo_area_buffer in question to nil at the end because
10734 with_echo_area_buffer will sets it to an empty buffer. */ 10734 with_echo_area_buffer will sets it to an empty buffer. */
10735 bool i = display_last_displayed_message_p; 10735 bool i = display_last_displayed_message_p;
10736 /* According to the C99, C11 and C++11 standards, the integral value
10737 of a "bool" is always 0 or 1, so this array access is safe here,
10738 if oddly typed. */
10736 no_message_p = NILP (echo_area_buffer[i]); 10739 no_message_p = NILP (echo_area_buffer[i]);
10737 10740
10738 window_height_changed_p 10741 window_height_changed_p
@@ -13536,6 +13539,32 @@ redisplay_internal (void)
13536 { 13539 {
13537 echo_area_display (false); 13540 echo_area_display (false);
13538 13541
13542 /* If echo_area_display resizes the mini-window, the redisplay and
13543 window_sizes_changed flags of the selected frame are set, but
13544 it's too late for the hooks in window-size-change-functions,
13545 which have been examined already in prepare_menu_bars. So in
13546 that case we call the hooks here only for the selected frame. */
13547 if (sf->redisplay && FRAME_WINDOW_SIZES_CHANGED (sf))
13548 {
13549 Lisp_Object functions;
13550 ptrdiff_t count1 = SPECPDL_INDEX ();
13551
13552 record_unwind_save_match_data ();
13553
13554 /* Clear flag first in case we get an error below. */
13555 FRAME_WINDOW_SIZES_CHANGED (sf) = false;
13556 functions = Vwindow_size_change_functions;
13557
13558 while (CONSP (functions))
13559 {
13560 if (!EQ (XCAR (functions), Qt))
13561 call1 (XCAR (functions), selected_frame);
13562 functions = XCDR (functions);
13563 }
13564
13565 unbind_to (count1, Qnil);
13566 }
13567
13539 if (message_cleared_p) 13568 if (message_cleared_p)
13540 update_miniwindow_p = true; 13569 update_miniwindow_p = true;
13541 13570
@@ -13552,6 +13581,27 @@ redisplay_internal (void)
13552 && (current_buffer->clip_changed || window_outdated (w)) 13581 && (current_buffer->clip_changed || window_outdated (w))
13553 && resize_mini_window (w, false)) 13582 && resize_mini_window (w, false))
13554 { 13583 {
13584 if (sf->redisplay)
13585 {
13586 Lisp_Object functions;
13587 ptrdiff_t count1 = SPECPDL_INDEX ();
13588
13589 record_unwind_save_match_data ();
13590
13591 /* Clear flag first in case we get an error below. */
13592 FRAME_WINDOW_SIZES_CHANGED (sf) = false;
13593 functions = Vwindow_size_change_functions;
13594
13595 while (CONSP (functions))
13596 {
13597 if (!EQ (XCAR (functions), Qt))
13598 call1 (XCAR (functions), selected_frame);
13599 functions = XCDR (functions);
13600 }
13601
13602 unbind_to (count1, Qnil);
13603 }
13604
13555 /* Resized active mini-window to fit the size of what it is 13605 /* Resized active mini-window to fit the size of what it is
13556 showing if its contents might have changed. */ 13606 showing if its contents might have changed. */
13557 must_finish = true; 13607 must_finish = true;
@@ -16251,9 +16301,33 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16251 if (w->cursor.vpos < 0) 16301 if (w->cursor.vpos < 0)
16252 { 16302 {
16253 /* If point does not appear, try to move point so it does 16303 /* If point does not appear, try to move point so it does
16254 appear. The desired matrix has been built above, so we 16304 appear. The desired matrix has been built above, so we
16255 can use it here. */ 16305 can use it here. First see if point is in invisible
16256 new_vpos = window_box_height (w) / 2; 16306 text, and if so, move it to the first visible buffer
16307 position past that. */
16308 struct glyph_row *r = NULL;
16309 Lisp_Object invprop =
16310 get_char_property_and_overlay (make_number (PT), Qinvisible,
16311 Qnil, NULL);
16312
16313 if (TEXT_PROP_MEANS_INVISIBLE (invprop) != 0)
16314 {
16315 ptrdiff_t alt_pt;
16316 Lisp_Object invprop_end =
16317 Fnext_single_char_property_change (make_number (PT), Qinvisible,
16318 Qnil, Qnil);
16319
16320 if (NATNUMP (invprop_end))
16321 alt_pt = XFASTINT (invprop_end);
16322 else
16323 alt_pt = ZV;
16324 r = row_containing_pos (w, alt_pt, w->desired_matrix->rows,
16325 NULL, 0);
16326 }
16327 if (r)
16328 new_vpos = MATRIX_ROW_BOTTOM_Y (r);
16329 else /* Give up and just move to the middle of the window. */
16330 new_vpos = window_box_height (w) / 2;
16257 } 16331 }
16258 16332
16259 if (!cursor_row_fully_visible_p (w, false, false)) 16333 if (!cursor_row_fully_visible_p (w, false, false))
@@ -16670,6 +16744,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16670 startp = run_window_scroll_functions (window, it.current.pos); 16744 startp = run_window_scroll_functions (window, it.current.pos);
16671 16745
16672 /* Redisplay the window. */ 16746 /* Redisplay the window. */
16747 bool use_desired_matrix = false;
16673 if (!current_matrix_up_to_date_p 16748 if (!current_matrix_up_to_date_p
16674 || windows_or_buffers_changed 16749 || windows_or_buffers_changed
16675 || f->cursor_type_changed 16750 || f->cursor_type_changed
@@ -16680,7 +16755,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16680 || MINI_WINDOW_P (w) 16755 || MINI_WINDOW_P (w)
16681 || !(used_current_matrix_p 16756 || !(used_current_matrix_p
16682 = try_window_reusing_current_matrix (w))) 16757 = try_window_reusing_current_matrix (w)))
16683 try_window (window, startp, 0); 16758 use_desired_matrix = (try_window (window, startp, 0) == 1);
16684 16759
16685 /* If new fonts have been loaded (due to fontsets), give up. We 16760 /* If new fonts have been loaded (due to fontsets), give up. We
16686 have to start a new redisplay since we need to re-adjust glyph 16761 have to start a new redisplay since we need to re-adjust glyph
@@ -16720,9 +16795,15 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16720 and similar ones. */ 16795 and similar ones. */
16721 if (w->cursor.vpos < 0) 16796 if (w->cursor.vpos < 0)
16722 { 16797 {
16798 /* Prefer the desired matrix to the current matrix, if possible,
16799 in the fallback calculations below. This is because using
16800 the current matrix might completely goof, e.g. if its first
16801 row is after point. */
16802 struct glyph_matrix *matrix =
16803 use_desired_matrix ? w->desired_matrix : w->current_matrix;
16723 /* First, try locating the proper glyph row for PT. */ 16804 /* First, try locating the proper glyph row for PT. */
16724 struct glyph_row *row = 16805 struct glyph_row *row =
16725 row_containing_pos (w, PT, w->current_matrix->rows, NULL, 0); 16806 row_containing_pos (w, PT, matrix->rows, NULL, 0);
16726 16807
16727 /* Sometimes point is at the beginning of invisible text that is 16808 /* Sometimes point is at the beginning of invisible text that is
16728 before the 1st character displayed in the row. In that case, 16809 before the 1st character displayed in the row. In that case,
@@ -16747,8 +16828,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16747 alt_pos = XFASTINT (invis_end); 16828 alt_pos = XFASTINT (invis_end);
16748 else 16829 else
16749 alt_pos = ZV; 16830 alt_pos = ZV;
16750 row = row_containing_pos (w, alt_pos, w->current_matrix->rows, 16831 row = row_containing_pos (w, alt_pos, matrix->rows, NULL, 0);
16751 NULL, 0);
16752 } 16832 }
16753 } 16833 }
16754 /* Finally, fall back on the first row of the window after the 16834 /* Finally, fall back on the first row of the window after the
@@ -16756,11 +16836,11 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
16756 displaying the cursor at all. */ 16836 displaying the cursor at all. */
16757 if (!row) 16837 if (!row)
16758 { 16838 {
16759 row = w->current_matrix->rows; 16839 row = matrix->rows;
16760 if (row->mode_line_p) 16840 if (row->mode_line_p)
16761 ++row; 16841 ++row;
16762 } 16842 }
16763 set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0); 16843 set_cursor_from_row (w, row, matrix, 0, 0, 0, 0);
16764 } 16844 }
16765 16845
16766 if (!cursor_row_fully_visible_p (w, false, false)) 16846 if (!cursor_row_fully_visible_p (w, false, false))
@@ -17745,7 +17825,7 @@ row_containing_pos (struct window *w, ptrdiff_t charpos,
17745 while (true) 17825 while (true)
17746 { 17826 {
17747 /* Give up if we have gone too far. */ 17827 /* Give up if we have gone too far. */
17748 if (end && row >= end) 17828 if ((end && row >= end) || !row->enabled_p)
17749 return NULL; 17829 return NULL;
17750 /* This formerly returned if they were equal. 17830 /* This formerly returned if they were equal.
17751 I think that both quantities are of a "last plus one" type; 17831 I think that both quantities are of a "last plus one" type;
@@ -31132,11 +31212,13 @@ the buffer when it becomes large. */);
31132 Vmessage_log_max = make_number (1000); 31212 Vmessage_log_max = make_number (1000);
31133 31213
31134 DEFVAR_LISP ("window-size-change-functions", Vwindow_size_change_functions, 31214 DEFVAR_LISP ("window-size-change-functions", Vwindow_size_change_functions,
31135 doc: /* Functions called before redisplay, if window sizes have changed. 31215 doc: /* Functions called during redisplay, if window sizes have changed.
31136The value should be a list of functions that take one argument. 31216The value should be a list of functions that take one argument.
31137Just before redisplay, for each frame, if any of its windows have changed 31217During the first part of redisplay, for each frame, if any of its windows
31138size since the last redisplay, or have been split or deleted, 31218have changed size since the last redisplay, or have been split or deleted,
31139all the functions in the list are called, with the frame as argument. */); 31219all the functions in the list are called, with the frame as argument.
31220If redisplay decides to resize the minibuffer window, it calls these
31221functions on behalf of that as well. */);
31140 Vwindow_size_change_functions = Qnil; 31222 Vwindow_size_change_functions = Qnil;
31141 31223
31142 DEFVAR_LISP ("window-scroll-functions", Vwindow_scroll_functions, 31224 DEFVAR_LISP ("window-scroll-functions", Vwindow_scroll_functions,
diff --git a/src/xfns.c b/src/xfns.c
index 313ac52f12a..3f95f7b79fb 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -5582,6 +5582,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo,
5582 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN); 5582 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
5583 x_default_parameter (f, parms, Qcursor_type, Qbox, 5583 x_default_parameter (f, parms, Qcursor_type, Qbox,
5584 "cursorType", "CursorType", RES_TYPE_SYMBOL); 5584 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5585 x_default_parameter (f, parms, Qalpha, Qnil,
5586 "alpha", "Alpha", RES_TYPE_NUMBER);
5585 5587
5586 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size. 5588 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
5587 Change will not be effected unless different from the current 5589 Change will not be effected unless different from the current
@@ -5719,7 +5721,7 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, Lisp_Object
5719 if (INTEGERP (left)) 5721 if (INTEGERP (left))
5720 *root_x = XINT (left); 5722 *root_x = XINT (left);
5721 else if (INTEGERP (right)) 5723 else if (INTEGERP (right))
5722 *root_y = XINT (right) - width; 5724 *root_x = XINT (right) - width;
5723 else if (*root_x + XINT (dx) <= 0) 5725 else if (*root_x + XINT (dx) <= 0)
5724 *root_x = 0; /* Can happen for negative dx */ 5726 *root_x = 0; /* Can happen for negative dx */
5725 else if (*root_x + XINT (dx) + width 5727 else if (*root_x + XINT (dx) + width
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-17 20:45:09 +0000