aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorPaul Eggert2011-03-29 16:35:49 -0700
committerPaul Eggert2011-03-29 16:35:49 -0700
commit8289296548281f6fa4c8b6b1ee9ead764c4c9aa3 (patch)
tree61d1528d9dab94f1be62dd0c76496c9edd00dc1f /src
parent792c7b2ba5319f436b459ff2c0d21e20207db550 (diff)
parentd806ab682a8e914345db3f2eede292f85745c98c (diff)
downloademacs-8289296548281f6fa4c8b6b1ee9ead764c4c9aa3.tar.gz
emacs-8289296548281f6fa4c8b6b1ee9ead764c4c9aa3.zip
Merge from mainline.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog80
-rw-r--r--src/character.c7
-rw-r--r--src/character.h2
-rw-r--r--src/cmds.c2
-rw-r--r--src/coding.c7
-rw-r--r--src/dispextern.h2
-rw-r--r--src/editfns.c2
-rw-r--r--src/eval.c148
-rw-r--r--src/keyboard.c82
-rw-r--r--src/keymap.c2
-rw-r--r--src/lisp.h9
-rw-r--r--src/nsmenu.m3
-rw-r--r--src/nsterm.m131
-rw-r--r--src/print.c131
-rw-r--r--src/scroll.c11
-rw-r--r--src/search.c35
-rw-r--r--src/w32.c235
-rw-r--r--src/xdisp.c76
18 files changed, 608 insertions, 357 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 6ba04202854..4e84f9510dd 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -8,8 +8,6 @@
8 * dispnew.c (update_window) [PERIODIC_PREEMPTION_CHECKING]: 8 * dispnew.c (update_window) [PERIODIC_PREEMPTION_CHECKING]:
9 Omit unused local var. 9 Omit unused local var.
10 10
112011-03-27 Paul Eggert <eggert@cs.ucla.edu>
12
13 * keyboard.c (parse_modifiers_uncached, parse_modifiers): 11 * keyboard.c (parse_modifiers_uncached, parse_modifiers):
14 Don't assume string length fits in int. 12 Don't assume string length fits in int.
15 (keyremap_step, read_key_sequence): Use size_t for sizes. 13 (keyremap_step, read_key_sequence): Use size_t for sizes.
@@ -62,12 +60,86 @@
62 * fns.c (get_key_arg): Now accepts and returns size_t, and returns 60 * fns.c (get_key_arg): Now accepts and returns size_t, and returns
63 0 if not found, not -1. All callers changed. 61 0 if not found, not -1. All callers changed.
64 62
652011-03-26 Paul Eggert <eggert@cs.ucla.edu>
66
67 * alloc.c (garbage_collect): Don't assume stack size fits in int. 63 * alloc.c (garbage_collect): Don't assume stack size fits in int.
68 (stack_copy_size): Now size_t, not int. 64 (stack_copy_size): Now size_t, not int.
69 (stack_copy, stack_copy_size): Define only if MAX_SAVE_STACK > 0. 65 (stack_copy, stack_copy_size): Define only if MAX_SAVE_STACK > 0.
70 66
672011-03-28 Juanma Barranquero <lekktu@gmail.com>
68
69 * coding.c (encode_designation_at_bol): Remove parameter `charbuf_end',
70 unused since 2002-03-01T01:17:24Z!handa@m17n.org and 2008-02-01T16:01:31Z!miles@gnu.org.
71 All callers changed.
72
73 * lisp.h (multibyte_char_to_unibyte):
74 * character.c (multibyte_char_to_unibyte): Remove parameter `rev_tbl',
75 unused since 2002-03-01T01:16:34Z!handa@m17n.org and 2008-02-01T16:01:31Z!miles@gnu.org.
76 * character.h (CHAR_TO_BYTE8):
77 * cmds.c (internal_self_insert):
78 * editfns.c (general_insert_function):
79 * keymap.c (push_key_description):
80 * search.c (Freplace_match):
81 * xdisp.c (message_dolog, set_message_1): All callers changed.
82
832011-03-28 Stefan Monnier <monnier@iro.umontreal.ca>
84
85 * keyboard.c (safe_run_hook_funcall): New function.
86 (safe_run_hooks_1, safe_run_hooks_error, safe_run_hooks): On error,
87 don't set the hook to nil, but remove the offending function instead.
88 (Qcommand_hook_internal): Remove, unused.
89 (syms_of_keyboard): Don't initialize Qcommand_hook_internal nor define
90 Vcommand_hook_internal.
91
92 * eval.c (enum run_hooks_condition): Remove.
93 (funcall_nil, funcall_not): New functions.
94 (run_hook_with_args): Call each function through a `funcall' argument.
95 Remove `cond' argument, now redundant.
96 (Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success)
97 (Frun_hook_with_args_until_failure): Adjust accordingly.
98 (run_hook_wrapped_funcall, Frun_hook_wrapped): New functions.
99
1002011-03-28 Juanma Barranquero <lekktu@gmail.com>
101
102 * dispextern.h (string_buffer_position): Remove declaration.
103
104 * print.c (strout): Remove parameter `multibyte', unused since
105 1999-08-21T19:30:21Z!gerd@gnu.org. All callers changed.
106
107 * search.c (boyer_moore): Remove parameters `len', `pos' and `lim',
108 never used since function introduction in 1998-02-08T21:33:56Z!rms@gnu.org.
109 All callers changed.
110
111 * w32.c (_wsa_errlist): Use braces for struct initializers.
112
113 * xdisp.c (string_buffer_position_lim): Remove parameter `w',
114 never used since function introduction in 2001-03-09T18:41:50Z!gerd@gnu.org.
115 All callers changed.
116 (string_buffer_position): Likewise. Also, make static (it's never
117 used outside xdisp.c).
118 (cursor_row_p): Remove parameter `w', unused since
119 2000-10-17T16:08:57Z!gerd@gnu.org. All callers changed.
120 (decode_mode_spec): Remove parameter `precision', introduced during
121 Gerd Moellmann's rewrite at 1999-07-21T21:43:52Z!gerd@gnu.org, but never used.
122 All callers changed.
123
1242011-03-27 Jan Djärv <jan.h.d@swipnet.se>
125
126 * nsterm.m (syms_of_nsterm): Use doc: for ns-auto-hide-menu-bar.
127
1282011-03-27 Anders Lindgren <andlind@gmail.com>
129
130 * nsterm.m (ns_menu_bar_is_hidden): New variable.
131 (ns_constrain_all_frames, ns_menu_bar_should_be_hidden)
132 (ns_update_auto_hide_menu_bar): New functions.
133 (ns_update_begin): Call ns_update_auto_hide_menu_bar.
134 (applicationDidBecomeActive): Call ns_update_auto_hide_menu_bar and
135 ns_constrain_all_frames.
136 (constrainFrameRect): Return at once if ns_menu_bar_should_be_hidden.
137 (syms_of_nsterm): DEFVAR ns-auto-hide-menu-bar, init to Qnil.
138
1392011-03-27 Jan Djärv <jan.h.d@swipnet.se>
140
141 * nsmenu.m (runDialogAt): Remove argument to timer_check.
142
712011-03-27 Glenn Morris <rgm@gnu.org> 1432011-03-27 Glenn Morris <rgm@gnu.org>
72 144
73 * syssignal.h: Replace RETSIGTYPE with void. 145 * syssignal.h: Replace RETSIGTYPE with void.
diff --git a/src/character.c b/src/character.c
index c106fc0ba20..bac9f6af81e 100644
--- a/src/character.c
+++ b/src/character.c
@@ -232,13 +232,10 @@ translate_char (Lisp_Object table, int c)
232} 232}
233 233
234/* Convert ASCII or 8-bit character C to unibyte. If C is none of 234/* Convert ASCII or 8-bit character C to unibyte. If C is none of
235 them, return (C & 0xFF). 235 them, return (C & 0xFF). */
236
237 The argument REV_TBL is now ignored. It will be removed in the
238 future. */
239 236
240int 237int
241multibyte_char_to_unibyte (int c, Lisp_Object rev_tbl) 238multibyte_char_to_unibyte (int c)
242{ 239{
243 if (c < 0x80) 240 if (c < 0x80)
244 return c; 241 return c;
diff --git a/src/character.h b/src/character.h
index 91020cadedc..7a75ac186fa 100644
--- a/src/character.h
+++ b/src/character.h
@@ -69,7 +69,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
69#define CHAR_TO_BYTE8(c) \ 69#define CHAR_TO_BYTE8(c) \
70 (CHAR_BYTE8_P (c) \ 70 (CHAR_BYTE8_P (c) \
71 ? (c) - 0x3FFF00 \ 71 ? (c) - 0x3FFF00 \
72 : multibyte_char_to_unibyte (c, Qnil)) 72 : multibyte_char_to_unibyte (c))
73 73
74/* Return the raw 8-bit byte for character C, 74/* Return the raw 8-bit byte for character C,
75 or -1 if C doesn't correspond to a byte. */ 75 or -1 if C doesn't correspond to a byte. */
diff --git a/src/cmds.c b/src/cmds.c
index ebbb223c2db..1cf7ff24fec 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -352,7 +352,7 @@ internal_self_insert (int c, EMACS_INT n)
352 { 352 {
353 str[0] = (SINGLE_BYTE_CHAR_P (c) 353 str[0] = (SINGLE_BYTE_CHAR_P (c)
354 ? c 354 ? c
355 : multibyte_char_to_unibyte (c, Qnil)); 355 : multibyte_char_to_unibyte (c));
356 len = 1; 356 len = 1;
357 } 357 }
358 if (!NILP (overwrite) 358 if (!NILP (overwrite)
diff --git a/src/coding.c b/src/coding.c
index a93a9a4d0e4..9e28a1c9f9b 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -853,8 +853,7 @@ static unsigned char *alloc_destination (struct coding_system *,
853 EMACS_INT, unsigned char *); 853 EMACS_INT, unsigned char *);
854static void setup_iso_safe_charsets (Lisp_Object); 854static void setup_iso_safe_charsets (Lisp_Object);
855static unsigned char *encode_designation_at_bol (struct coding_system *, 855static unsigned char *encode_designation_at_bol (struct coding_system *,
856 int *, int *, 856 int *, unsigned char *);
857 unsigned char *);
858static int detect_eol (const unsigned char *, 857static int detect_eol (const unsigned char *,
859 EMACS_INT, enum coding_category); 858 EMACS_INT, enum coding_category);
860static Lisp_Object adjust_coding_eol_type (struct coding_system *, int); 859static Lisp_Object adjust_coding_eol_type (struct coding_system *, int);
@@ -4299,7 +4298,7 @@ encode_invocation_designation (struct charset *charset,
4299 4298
4300static unsigned char * 4299static unsigned char *
4301encode_designation_at_bol (struct coding_system *coding, int *charbuf, 4300encode_designation_at_bol (struct coding_system *coding, int *charbuf,
4302 int *charbuf_end, unsigned char *dst) 4301 unsigned char *dst)
4303{ 4302{
4304 struct charset *charset; 4303 struct charset *charset;
4305 /* Table of charsets to be designated to each graphic register. */ 4304 /* Table of charsets to be designated to each graphic register. */
@@ -4390,7 +4389,7 @@ encode_coding_iso_2022 (struct coding_system *coding)
4390 unsigned char *dst_prev = dst; 4389 unsigned char *dst_prev = dst;
4391 4390
4392 /* We have to produce designation sequences if any now. */ 4391 /* We have to produce designation sequences if any now. */
4393 dst = encode_designation_at_bol (coding, charbuf, charbuf_end, dst); 4392 dst = encode_designation_at_bol (coding, charbuf, dst);
4394 bol_designation = 0; 4393 bol_designation = 0;
4395 /* We are sure that designation sequences are all ASCII bytes. */ 4394 /* We are sure that designation sequences are all ASCII bytes. */
4396 produced_chars += dst - dst_prev; 4395 produced_chars += dst - dst_prev;
diff --git a/src/dispextern.h b/src/dispextern.h
index d1e0475dd15..17a9bc39fb2 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -2953,8 +2953,6 @@ extern int bidi_mirror_char (int);
2953struct glyph_row *row_containing_pos (struct window *, EMACS_INT, 2953struct glyph_row *row_containing_pos (struct window *, EMACS_INT,
2954 struct glyph_row *, 2954 struct glyph_row *,
2955 struct glyph_row *, int); 2955 struct glyph_row *, int);
2956EMACS_INT string_buffer_position (struct window *, Lisp_Object,
2957 EMACS_INT);
2958int line_bottom_y (struct it *); 2956int line_bottom_y (struct it *);
2959int display_prop_intangible_p (Lisp_Object); 2957int display_prop_intangible_p (Lisp_Object);
2960void resize_echo_area_exactly (void); 2958void resize_echo_area_exactly (void);
diff --git a/src/editfns.c b/src/editfns.c
index 99832db1b4c..58f634fa479 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2226,7 +2226,7 @@ general_insert_function (void (*insert_func)
2226 { 2226 {
2227 str[0] = (ASCII_CHAR_P (XINT (val)) 2227 str[0] = (ASCII_CHAR_P (XINT (val))
2228 ? XINT (val) 2228 ? XINT (val)
2229 : multibyte_char_to_unibyte (XINT (val), Qnil)); 2229 : multibyte_char_to_unibyte (XINT (val)));
2230 len = 1; 2230 len = 1;
2231 } 2231 }
2232 (*insert_func) ((char *) str, len); 2232 (*insert_func) ((char *) str, len);
diff --git a/src/eval.c b/src/eval.c
index 982fec66bbf..c3f9cd158f7 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -30,8 +30,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
30#include "xterm.h" 30#include "xterm.h"
31#endif 31#endif
32 32
33/* This definition is duplicated in alloc.c and keyboard.c */ 33/* This definition is duplicated in alloc.c and keyboard.c. */
34/* Putting it in lisp.h makes cc bomb out! */ 34/* Putting it in lisp.h makes cc bomb out! */
35 35
36struct backtrace 36struct backtrace
37{ 37{
@@ -40,9 +40,9 @@ struct backtrace
40 Lisp_Object *args; /* Points to vector of args. */ 40 Lisp_Object *args; /* Points to vector of args. */
41 size_t nargs; /* Length of vector. 41 size_t nargs; /* Length of vector.
42 If nargs is (size_t) UNEVALLED, args points 42 If nargs is (size_t) UNEVALLED, args points
43 to slot holding list of unevalled args */ 43 to slot holding list of unevalled args. */
44 char evalargs; 44 char evalargs;
45 /* Nonzero means call value of debugger when done with this operation. */ 45 /* Nonzero means call value of debugger when done with this operation. */
46 char debug_on_exit; 46 char debug_on_exit;
47}; 47};
48 48
@@ -146,7 +146,7 @@ init_eval (void)
146 when_entered_debugger = -1; 146 when_entered_debugger = -1;
147} 147}
148 148
149/* unwind-protect function used by call_debugger. */ 149/* Unwind-protect function used by call_debugger. */
150 150
151static Lisp_Object 151static Lisp_Object
152restore_stack_limits (Lisp_Object data) 152restore_stack_limits (Lisp_Object data)
@@ -556,7 +556,7 @@ interactive_p (int exclude_subrs_p)
556 || btp->nargs == (size_t) UNEVALLED)) 556 || btp->nargs == (size_t) UNEVALLED))
557 btp = btp->next; 557 btp = btp->next;
558 558
559 /* btp now points at the frame of the innermost function that isn't 559 /* `btp' now points at the frame of the innermost function that isn't
560 a special form, ignoring frames for Finteractive_p and/or 560 a special form, ignoring frames for Finteractive_p and/or
561 Fbytecode at the top. If this frame is for a built-in function 561 Fbytecode at the top. If this frame is for a built-in function
562 (such as load or eval-region) return nil. */ 562 (such as load or eval-region) return nil. */
@@ -564,7 +564,7 @@ interactive_p (int exclude_subrs_p)
564 if (exclude_subrs_p && SUBRP (fun)) 564 if (exclude_subrs_p && SUBRP (fun))
565 return 0; 565 return 0;
566 566
567 /* btp points to the frame of a Lisp function that called interactive-p. 567 /* `btp' points to the frame of a Lisp function that called interactive-p.
568 Return t if that function was called interactively. */ 568 Return t if that function was called interactively. */
569 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively)) 569 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
570 return 1; 570 return 1;
@@ -965,11 +965,11 @@ usage: (let VARLIST BODY...) */)
965 965
966 varlist = Fcar (args); 966 varlist = Fcar (args);
967 967
968 /* Make space to hold the values to give the bound variables */ 968 /* Make space to hold the values to give the bound variables. */
969 elt = Flength (varlist); 969 elt = Flength (varlist);
970 SAFE_ALLOCA_LISP (temps, XFASTINT (elt)); 970 SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
971 971
972 /* Compute the values and store them in `temps' */ 972 /* Compute the values and store them in `temps'. */
973 973
974 GCPRO2 (args, *temps); 974 GCPRO2 (args, *temps);
975 gcpro2.nvars = 0; 975 gcpro2.nvars = 0;
@@ -1072,7 +1072,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1072 /* SYM is not mentioned in ENVIRONMENT. 1072 /* SYM is not mentioned in ENVIRONMENT.
1073 Look at its function definition. */ 1073 Look at its function definition. */
1074 if (EQ (def, Qunbound) || !CONSP (def)) 1074 if (EQ (def, Qunbound) || !CONSP (def))
1075 /* Not defined or definition not suitable */ 1075 /* Not defined or definition not suitable. */
1076 break; 1076 break;
1077 if (EQ (XCAR (def), Qautoload)) 1077 if (EQ (XCAR (def), Qautoload))
1078 { 1078 {
@@ -1213,10 +1213,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
1213 byte_stack_list = catch->byte_stack; 1213 byte_stack_list = catch->byte_stack;
1214 gcprolist = catch->gcpro; 1214 gcprolist = catch->gcpro;
1215#ifdef DEBUG_GCPRO 1215#ifdef DEBUG_GCPRO
1216 if (gcprolist != 0) 1216 gcpro_level = gcprolist ? gcprolist->level + 1 : gcpro_level = 0;
1217 gcpro_level = gcprolist->level + 1;
1218 else
1219 gcpro_level = 0;
1220#endif 1217#endif
1221 backtrace_list = catch->backlist; 1218 backtrace_list = catch->backlist;
1222 lisp_eval_depth = catch->lisp_eval_depth; 1219 lisp_eval_depth = catch->lisp_eval_depth;
@@ -1824,7 +1821,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
1824 ? debug_on_quit 1821 ? debug_on_quit
1825 : wants_debugger (Vdebug_on_error, conditions)) 1822 : wants_debugger (Vdebug_on_error, conditions))
1826 && ! skip_debugger (conditions, combined_data) 1823 && ! skip_debugger (conditions, combined_data)
1827 /* rms: what's this for? */ 1824 /* RMS: What's this for? */
1828 && when_entered_debugger < num_nonmacro_input_events) 1825 && when_entered_debugger < num_nonmacro_input_events)
1829 { 1826 {
1830 call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil))); 1827 call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
@@ -1891,7 +1888,7 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
1891} 1888}
1892 1889
1893 1890
1894/* dump an error message; called like vprintf */ 1891/* Dump an error message; called like vprintf. */
1895void 1892void
1896verror (const char *m, va_list ap) 1893verror (const char *m, va_list ap)
1897{ 1894{
@@ -1928,7 +1925,7 @@ verror (const char *m, va_list ap)
1928} 1925}
1929 1926
1930 1927
1931/* dump an error message; called like printf */ 1928/* Dump an error message; called like printf. */
1932 1929
1933/* VARARGS 1 */ 1930/* VARARGS 1 */
1934void 1931void
@@ -2024,7 +2021,7 @@ this does nothing and returns nil. */)
2024 CHECK_SYMBOL (function); 2021 CHECK_SYMBOL (function);
2025 CHECK_STRING (file); 2022 CHECK_STRING (file);
2026 2023
2027 /* If function is defined and not as an autoload, don't override */ 2024 /* If function is defined and not as an autoload, don't override. */
2028 if (!EQ (XSYMBOL (function)->function, Qunbound) 2025 if (!EQ (XSYMBOL (function)->function, Qunbound)
2029 && !(CONSP (XSYMBOL (function)->function) 2026 && !(CONSP (XSYMBOL (function)->function)
2030 && EQ (XCAR (XSYMBOL (function)->function), Qautoload))) 2027 && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
@@ -2159,7 +2156,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2159 2156
2160 backtrace.next = backtrace_list; 2157 backtrace.next = backtrace_list;
2161 backtrace_list = &backtrace; 2158 backtrace_list = &backtrace;
2162 backtrace.function = &original_fun; /* This also protects them from gc */ 2159 backtrace.function = &original_fun; /* This also protects them from gc. */
2163 backtrace.args = &original_args; 2160 backtrace.args = &original_args;
2164 backtrace.nargs = UNEVALLED; 2161 backtrace.nargs = UNEVALLED;
2165 backtrace.evalargs = 1; 2162 backtrace.evalargs = 1;
@@ -2169,7 +2166,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2169 do_debug_on_call (Qt); 2166 do_debug_on_call (Qt);
2170 2167
2171 /* At this point, only original_fun and original_args 2168 /* At this point, only original_fun and original_args
2172 have values that will be used below */ 2169 have values that will be used below. */
2173 retry: 2170 retry:
2174 2171
2175 /* Optimize for no indirection. */ 2172 /* Optimize for no indirection. */
@@ -2190,8 +2187,9 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2190 2187
2191 CHECK_CONS_LIST (); 2188 CHECK_CONS_LIST ();
2192 2189
2193 if (XINT (numargs) < XSUBR (fun)->min_args || 2190 if (XINT (numargs) < XSUBR (fun)->min_args
2194 (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs))) 2191 || (0 <= XSUBR (fun)->max_args
2192 && XSUBR (fun)->max_args < XINT (numargs)))
2195 xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); 2193 xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
2196 2194
2197 else if (XSUBR (fun)->max_args == UNEVALLED) 2195 else if (XSUBR (fun)->max_args == UNEVALLED)
@@ -2201,7 +2199,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2201 } 2199 }
2202 else if (XSUBR (fun)->max_args == MANY) 2200 else if (XSUBR (fun)->max_args == MANY)
2203 { 2201 {
2204 /* Pass a vector of evaluated arguments */ 2202 /* Pass a vector of evaluated arguments. */
2205 Lisp_Object *vals; 2203 Lisp_Object *vals;
2206 register size_t argnum = 0; 2204 register size_t argnum = 0;
2207 USE_SAFE_ALLOCA; 2205 USE_SAFE_ALLOCA;
@@ -2364,7 +2362,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2364 fun = indirect_function (fun); 2362 fun = indirect_function (fun);
2365 if (EQ (fun, Qunbound)) 2363 if (EQ (fun, Qunbound))
2366 { 2364 {
2367 /* Let funcall get the error */ 2365 /* Let funcall get the error. */
2368 fun = args[0]; 2366 fun = args[0];
2369 goto funcall; 2367 goto funcall;
2370 } 2368 }
@@ -2373,11 +2371,11 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2373 { 2371 {
2374 if (numargs < XSUBR (fun)->min_args 2372 if (numargs < XSUBR (fun)->min_args
2375 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) 2373 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
2376 goto funcall; /* Let funcall get the error */ 2374 goto funcall; /* Let funcall get the error. */
2377 else if (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args > numargs) 2375 else if (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args > numargs)
2378 { 2376 {
2379 /* Avoid making funcall cons up a yet another new vector of arguments 2377 /* Avoid making funcall cons up a yet another new vector of arguments
2380 by explicitly supplying nil's for optional values */ 2378 by explicitly supplying nil's for optional values. */
2381 SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args); 2379 SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
2382 for (i = numargs; i < XSUBR (fun)->max_args;) 2380 for (i = numargs; i < XSUBR (fun)->max_args;)
2383 funcall_args[++i] = Qnil; 2381 funcall_args[++i] = Qnil;
@@ -2415,9 +2413,12 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2415 2413
2416/* Run hook variables in various ways. */ 2414/* Run hook variables in various ways. */
2417 2415
2418enum run_hooks_condition {to_completion, until_success, until_failure}; 2416static Lisp_Object
2419static Lisp_Object run_hook_with_args (size_t, Lisp_Object *, 2417funcall_nil (size_t nargs, Lisp_Object *args)
2420 enum run_hooks_condition); 2418{
2419 Ffuncall (nargs, args);
2420 return Qnil;
2421}
2421 2422
2422DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0, 2423DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
2423 doc: /* Run each hook in HOOKS. 2424 doc: /* Run each hook in HOOKS.
@@ -2442,7 +2443,7 @@ usage: (run-hooks &rest HOOKS) */)
2442 for (i = 0; i < nargs; i++) 2443 for (i = 0; i < nargs; i++)
2443 { 2444 {
2444 hook[0] = args[i]; 2445 hook[0] = args[i];
2445 run_hook_with_args (1, hook, to_completion); 2446 run_hook_with_args (1, hook, funcall_nil);
2446 } 2447 }
2447 2448
2448 return Qnil; 2449 return Qnil;
@@ -2465,7 +2466,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument.
2465usage: (run-hook-with-args HOOK &rest ARGS) */) 2466usage: (run-hook-with-args HOOK &rest ARGS) */)
2466 (size_t nargs, Lisp_Object *args) 2467 (size_t nargs, Lisp_Object *args)
2467{ 2468{
2468 return run_hook_with_args (nargs, args, to_completion); 2469 return run_hook_with_args (nargs, args, funcall_nil);
2469} 2470}
2470 2471
2471DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, 2472DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
@@ -2485,7 +2486,13 @@ Instead, use `add-hook' and specify t for the LOCAL argument.
2485usage: (run-hook-with-args-until-success HOOK &rest ARGS) */) 2486usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2486 (size_t nargs, Lisp_Object *args) 2487 (size_t nargs, Lisp_Object *args)
2487{ 2488{
2488 return run_hook_with_args (nargs, args, until_success); 2489 return run_hook_with_args (nargs, args, Ffuncall);
2490}
2491
2492static Lisp_Object
2493funcall_not (size_t nargs, Lisp_Object *args)
2494{
2495 return NILP (Ffuncall (nargs, args)) ? Qt : Qnil;
2489} 2496}
2490 2497
2491DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, 2498DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
@@ -2504,22 +2511,45 @@ Instead, use `add-hook' and specify t for the LOCAL argument.
2504usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */) 2511usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2505 (size_t nargs, Lisp_Object *args) 2512 (size_t nargs, Lisp_Object *args)
2506{ 2513{
2507 return run_hook_with_args (nargs, args, until_failure); 2514 return NILP (run_hook_with_args (nargs, args, funcall_not)) ? Qt : Qnil;
2515}
2516
2517static Lisp_Object
2518run_hook_wrapped_funcall (size_t nargs, Lisp_Object *args)
2519{
2520 Lisp_Object tmp = args[0], ret;
2521 args[0] = args[1];
2522 args[1] = tmp;
2523 ret = Ffuncall (nargs, args);
2524 args[1] = args[0];
2525 args[0] = tmp;
2526 return ret;
2527}
2528
2529DEFUN ("run-hook-wrapped", Frun_hook_wrapped, Srun_hook_wrapped, 2, MANY, 0,
2530 doc: /* Run HOOK, passing each function through WRAP-FUNCTION.
2531I.e. instead of calling each function FUN directly with arguments ARGS,
2532it calls WRAP-FUNCTION with arguments FUN and ARGS.
2533As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
2534aborts and returns that value.
2535usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
2536 (size_t nargs, Lisp_Object *args)
2537{
2538 return run_hook_with_args (nargs, args, run_hook_wrapped_funcall);
2508} 2539}
2509 2540
2510/* ARGS[0] should be a hook symbol. 2541/* ARGS[0] should be a hook symbol.
2511 Call each of the functions in the hook value, passing each of them 2542 Call each of the functions in the hook value, passing each of them
2512 as arguments all the rest of ARGS (all NARGS - 1 elements). 2543 as arguments all the rest of ARGS (all NARGS - 1 elements).
2513 COND specifies a condition to test after each call 2544 FUNCALL specifies how to call each function on the hook.
2514 to decide whether to stop.
2515 The caller (or its caller, etc) must gcpro all of ARGS, 2545 The caller (or its caller, etc) must gcpro all of ARGS,
2516 except that it isn't necessary to gcpro ARGS[0]. */ 2546 except that it isn't necessary to gcpro ARGS[0]. */
2517 2547
2518static Lisp_Object 2548Lisp_Object
2519run_hook_with_args (size_t nargs, Lisp_Object *args, 2549run_hook_with_args (size_t nargs, Lisp_Object *args,
2520 enum run_hooks_condition cond) 2550 Lisp_Object (*funcall) (size_t nargs, Lisp_Object *args))
2521{ 2551{
2522 Lisp_Object sym, val, ret; 2552 Lisp_Object sym, val, ret = Qnil;
2523 struct gcpro gcpro1, gcpro2, gcpro3; 2553 struct gcpro gcpro1, gcpro2, gcpro3;
2524 2554
2525 /* If we are dying or still initializing, 2555 /* If we are dying or still initializing,
@@ -2529,14 +2559,13 @@ run_hook_with_args (size_t nargs, Lisp_Object *args,
2529 2559
2530 sym = args[0]; 2560 sym = args[0];
2531 val = find_symbol_value (sym); 2561 val = find_symbol_value (sym);
2532 ret = (cond == until_failure ? Qt : Qnil);
2533 2562
2534 if (EQ (val, Qunbound) || NILP (val)) 2563 if (EQ (val, Qunbound) || NILP (val))
2535 return ret; 2564 return ret;
2536 else if (!CONSP (val) || EQ (XCAR (val), Qlambda)) 2565 else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
2537 { 2566 {
2538 args[0] = val; 2567 args[0] = val;
2539 return Ffuncall (nargs, args); 2568 return funcall (nargs, args);
2540 } 2569 }
2541 else 2570 else
2542 { 2571 {
@@ -2544,9 +2573,7 @@ run_hook_with_args (size_t nargs, Lisp_Object *args,
2544 GCPRO3 (sym, val, global_vals); 2573 GCPRO3 (sym, val, global_vals);
2545 2574
2546 for (; 2575 for (;
2547 CONSP (val) && ((cond == to_completion) 2576 CONSP (val) && NILP (ret);
2548 || (cond == until_success ? NILP (ret)
2549 : !NILP (ret)));
2550 val = XCDR (val)) 2577 val = XCDR (val))
2551 { 2578 {
2552 if (EQ (XCAR (val), Qt)) 2579 if (EQ (XCAR (val), Qt))
@@ -2559,30 +2586,26 @@ run_hook_with_args (size_t nargs, Lisp_Object *args,
2559 if (!CONSP (global_vals) || EQ (XCAR (global_vals), Qlambda)) 2586 if (!CONSP (global_vals) || EQ (XCAR (global_vals), Qlambda))
2560 { 2587 {
2561 args[0] = global_vals; 2588 args[0] = global_vals;
2562 ret = Ffuncall (nargs, args); 2589 ret = funcall (nargs, args);
2563 } 2590 }
2564 else 2591 else
2565 { 2592 {
2566 for (; 2593 for (;
2567 (CONSP (global_vals) 2594 CONSP (global_vals) && NILP (ret);
2568 && (cond == to_completion
2569 || (cond == until_success
2570 ? NILP (ret)
2571 : !NILP (ret))));
2572 global_vals = XCDR (global_vals)) 2595 global_vals = XCDR (global_vals))
2573 { 2596 {
2574 args[0] = XCAR (global_vals); 2597 args[0] = XCAR (global_vals);
2575 /* In a global value, t should not occur. If it does, we 2598 /* In a global value, t should not occur. If it does, we
2576 must ignore it to avoid an endless loop. */ 2599 must ignore it to avoid an endless loop. */
2577 if (!EQ (args[0], Qt)) 2600 if (!EQ (args[0], Qt))
2578 ret = Ffuncall (nargs, args); 2601 ret = funcall (nargs, args);
2579 } 2602 }
2580 } 2603 }
2581 } 2604 }
2582 else 2605 else
2583 { 2606 {
2584 args[0] = XCAR (val); 2607 args[0] = XCAR (val);
2585 ret = Ffuncall (nargs, args); 2608 ret = funcall (nargs, args);
2586 } 2609 }
2587 } 2610 }
2588 2611
@@ -2604,7 +2627,7 @@ run_hook_with_args_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2)
2604 Frun_hook_with_args (3, temp); 2627 Frun_hook_with_args (3, temp);
2605} 2628}
2606 2629
2607/* Apply fn to arg */ 2630/* Apply fn to arg. */
2608Lisp_Object 2631Lisp_Object
2609apply1 (Lisp_Object fn, Lisp_Object arg) 2632apply1 (Lisp_Object fn, Lisp_Object arg)
2610{ 2633{
@@ -2623,7 +2646,7 @@ apply1 (Lisp_Object fn, Lisp_Object arg)
2623 } 2646 }
2624} 2647}
2625 2648
2626/* Call function fn on no arguments */ 2649/* Call function fn on no arguments. */
2627Lisp_Object 2650Lisp_Object
2628call0 (Lisp_Object fn) 2651call0 (Lisp_Object fn)
2629{ 2652{
@@ -2633,7 +2656,7 @@ call0 (Lisp_Object fn)
2633 RETURN_UNGCPRO (Ffuncall (1, &fn)); 2656 RETURN_UNGCPRO (Ffuncall (1, &fn));
2634} 2657}
2635 2658
2636/* Call function fn with 1 argument arg1 */ 2659/* Call function fn with 1 argument arg1. */
2637/* ARGSUSED */ 2660/* ARGSUSED */
2638Lisp_Object 2661Lisp_Object
2639call1 (Lisp_Object fn, Lisp_Object arg1) 2662call1 (Lisp_Object fn, Lisp_Object arg1)
@@ -2648,7 +2671,7 @@ call1 (Lisp_Object fn, Lisp_Object arg1)
2648 RETURN_UNGCPRO (Ffuncall (2, args)); 2671 RETURN_UNGCPRO (Ffuncall (2, args));
2649} 2672}
2650 2673
2651/* Call function fn with 2 arguments arg1, arg2 */ 2674/* Call function fn with 2 arguments arg1, arg2. */
2652/* ARGSUSED */ 2675/* ARGSUSED */
2653Lisp_Object 2676Lisp_Object
2654call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) 2677call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
@@ -2663,7 +2686,7 @@ call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
2663 RETURN_UNGCPRO (Ffuncall (3, args)); 2686 RETURN_UNGCPRO (Ffuncall (3, args));
2664} 2687}
2665 2688
2666/* Call function fn with 3 arguments arg1, arg2, arg3 */ 2689/* Call function fn with 3 arguments arg1, arg2, arg3. */
2667/* ARGSUSED */ 2690/* ARGSUSED */
2668Lisp_Object 2691Lisp_Object
2669call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) 2692call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
@@ -2679,7 +2702,7 @@ call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
2679 RETURN_UNGCPRO (Ffuncall (4, args)); 2702 RETURN_UNGCPRO (Ffuncall (4, args));
2680} 2703}
2681 2704
2682/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */ 2705/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
2683/* ARGSUSED */ 2706/* ARGSUSED */
2684Lisp_Object 2707Lisp_Object
2685call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2708call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
@@ -2697,7 +2720,7 @@ call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2697 RETURN_UNGCPRO (Ffuncall (5, args)); 2720 RETURN_UNGCPRO (Ffuncall (5, args));
2698} 2721}
2699 2722
2700/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */ 2723/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
2701/* ARGSUSED */ 2724/* ARGSUSED */
2702Lisp_Object 2725Lisp_Object
2703call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2726call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
@@ -2716,7 +2739,7 @@ call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2716 RETURN_UNGCPRO (Ffuncall (6, args)); 2739 RETURN_UNGCPRO (Ffuncall (6, args));
2717} 2740}
2718 2741
2719/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */ 2742/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
2720/* ARGSUSED */ 2743/* ARGSUSED */
2721Lisp_Object 2744Lisp_Object
2722call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2745call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
@@ -2736,7 +2759,7 @@ call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
2736 RETURN_UNGCPRO (Ffuncall (7, args)); 2759 RETURN_UNGCPRO (Ffuncall (7, args));
2737} 2760}
2738 2761
2739/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */ 2762/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
2740/* ARGSUSED */ 2763/* ARGSUSED */
2741Lisp_Object 2764Lisp_Object
2742call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2765call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
@@ -3082,7 +3105,7 @@ grow_specpdl (void)
3082 specpdl_ptr = specpdl + count; 3105 specpdl_ptr = specpdl + count;
3083} 3106}
3084 3107
3085/* specpdl_ptr->symbol is a field which describes which variable is 3108/* `specpdl_ptr->symbol' is a field which describes which variable is
3086 let-bound, so it can be properly undone when we unbind_to. 3109 let-bound, so it can be properly undone when we unbind_to.
3087 It can have the following two shapes: 3110 It can have the following two shapes:
3088 - SYMBOL : if it's a plain symbol, it means that we have let-bound 3111 - SYMBOL : if it's a plain symbol, it means that we have let-bound
@@ -3320,7 +3343,7 @@ Output stream used is value of `standard-output'. */)
3320 else 3343 else
3321 { 3344 {
3322 tem = *backlist->function; 3345 tem = *backlist->function;
3323 Fprin1 (tem, Qnil); /* This can QUIT */ 3346 Fprin1 (tem, Qnil); /* This can QUIT. */
3324 write_string ("(", -1); 3347 write_string ("(", -1);
3325 if (backlist->nargs == (size_t) MANY) 3348 if (backlist->nargs == (size_t) MANY)
3326 { 3349 {
@@ -3593,6 +3616,7 @@ The value the function returns is not used. */);
3593 defsubr (&Srun_hook_with_args); 3616 defsubr (&Srun_hook_with_args);
3594 defsubr (&Srun_hook_with_args_until_success); 3617 defsubr (&Srun_hook_with_args_until_success);
3595 defsubr (&Srun_hook_with_args_until_failure); 3618 defsubr (&Srun_hook_with_args_until_failure);
3619 defsubr (&Srun_hook_wrapped);
3596 defsubr (&Sfetch_bytecode); 3620 defsubr (&Sfetch_bytecode);
3597 defsubr (&Sbacktrace_debug); 3621 defsubr (&Sbacktrace_debug);
3598 defsubr (&Sbacktrace); 3622 defsubr (&Sbacktrace);
diff --git a/src/keyboard.c b/src/keyboard.c
index 6c706590dc4..86a2b3e8abd 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -254,7 +254,6 @@ Lisp_Object Qecho_area_clear_hook;
254/* Hooks to run before and after each command. */ 254/* Hooks to run before and after each command. */
255Lisp_Object Qpre_command_hook; 255Lisp_Object Qpre_command_hook;
256Lisp_Object Qpost_command_hook; 256Lisp_Object Qpost_command_hook;
257Lisp_Object Qcommand_hook_internal;
258 257
259Lisp_Object Qdeferred_action_function; 258Lisp_Object Qdeferred_action_function;
260 259
@@ -1815,20 +1814,63 @@ adjust_point_for_property (EMACS_INT last_pt, int modified)
1815static Lisp_Object 1814static Lisp_Object
1816safe_run_hooks_1 (void) 1815safe_run_hooks_1 (void)
1817{ 1816{
1818 return Frun_hooks (1, &Vinhibit_quit); 1817 eassert (CONSP (Vinhibit_quit));
1818 return call0 (XCDR (Vinhibit_quit));
1819} 1819}
1820 1820
1821/* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */ 1821/* Subroutine for safe_run_hooks: handle an error by clearing out the function
1822 from the hook. */
1822 1823
1823static Lisp_Object 1824static Lisp_Object
1824safe_run_hooks_error (Lisp_Object data) 1825safe_run_hooks_error (Lisp_Object error_data)
1826{
1827 Lisp_Object hook
1828 = CONSP (Vinhibit_quit) ? XCAR (Vinhibit_quit) : Vinhibit_quit;
1829 Lisp_Object fun = CONSP (Vinhibit_quit) ? XCDR (Vinhibit_quit) : Qnil;
1830 Lisp_Object args[4];
1831 args[0] = build_string ("Error in %s (%s): %s");
1832 args[1] = hook;
1833 args[2] = fun;
1834 args[3] = error_data;
1835 Fmessage (4, args);
1836 if (SYMBOLP (hook))
1837 {
1838 Lisp_Object val;
1839 int found = 0;
1840 Lisp_Object newval = Qnil;
1841 for (val = find_symbol_value (hook); CONSP (val); val = XCDR (val))
1842 if (EQ (fun, XCAR (val)))
1843 found = 1;
1844 else
1845 newval = Fcons (XCAR (val), newval);
1846 if (found)
1847 return Fset (hook, Fnreverse (newval));
1848 /* Not found in the local part of the hook. Let's look at the global
1849 part. */
1850 newval = Qnil;
1851 for (val = (NILP (Fdefault_boundp (hook)) ? Qnil
1852 : Fdefault_value (hook));
1853 CONSP (val); val = XCDR (val))
1854 if (EQ (fun, XCAR (val)))
1855 found = 1;
1856 else
1857 newval = Fcons (XCAR (val), newval);
1858 if (found)
1859 return Fset_default (hook, Fnreverse (newval));
1860 }
1861 return Qnil;
1862}
1863
1864static Lisp_Object
1865safe_run_hook_funcall (size_t nargs, Lisp_Object *args)
1825{ 1866{
1826 Lisp_Object args[3]; 1867 eassert (nargs == 1);
1827 args[0] = build_string ("Error in %s: %s"); 1868 if (CONSP (Vinhibit_quit))
1828 args[1] = Vinhibit_quit; 1869 XSETCDR (Vinhibit_quit, args[0]);
1829 args[2] = data; 1870 else
1830 Fmessage (3, args); 1871 Vinhibit_quit = Fcons (Vinhibit_quit, args[0]);
1831 return Fset (Vinhibit_quit, Qnil); 1872
1873 return internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1832} 1874}
1833 1875
1834/* If we get an error while running the hook, cause the hook variable 1876/* If we get an error while running the hook, cause the hook variable
@@ -1838,10 +1880,13 @@ safe_run_hooks_error (Lisp_Object data)
1838void 1880void
1839safe_run_hooks (Lisp_Object hook) 1881safe_run_hooks (Lisp_Object hook)
1840{ 1882{
1883 /* FIXME: our `internal_condition_case' does not provide any way to pass data
1884 to its body or to its handlers other than via globals such as
1885 dynamically-bound variables ;-) */
1841 int count = SPECPDL_INDEX (); 1886 int count = SPECPDL_INDEX ();
1842 specbind (Qinhibit_quit, hook); 1887 specbind (Qinhibit_quit, hook);
1843 1888
1844 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error); 1889 run_hook_with_args (1, &hook, safe_run_hook_funcall);
1845 1890
1846 unbind_to (count, Qnil); 1891 unbind_to (count, Qnil);
1847} 1892}
@@ -11442,9 +11487,6 @@ syms_of_keyboard (void)
11442 Qdeferred_action_function = intern_c_string ("deferred-action-function"); 11487 Qdeferred_action_function = intern_c_string ("deferred-action-function");
11443 staticpro (&Qdeferred_action_function); 11488 staticpro (&Qdeferred_action_function);
11444 11489
11445 Qcommand_hook_internal = intern_c_string ("command-hook-internal");
11446 staticpro (&Qcommand_hook_internal);
11447
11448 Qfunction_key = intern_c_string ("function-key"); 11490 Qfunction_key = intern_c_string ("function-key");
11449 staticpro (&Qfunction_key); 11491 staticpro (&Qfunction_key);
11450 Qmouse_click = intern_c_string ("mouse-click"); 11492 Qmouse_click = intern_c_string ("mouse-click");
@@ -11912,22 +11954,18 @@ Buffer modification stores t in this variable. */);
11912 Qdeactivate_mark = intern_c_string ("deactivate-mark"); 11954 Qdeactivate_mark = intern_c_string ("deactivate-mark");
11913 staticpro (&Qdeactivate_mark); 11955 staticpro (&Qdeactivate_mark);
11914 11956
11915 DEFVAR_LISP ("command-hook-internal", Vcommand_hook_internal,
11916 doc: /* Temporary storage of `pre-command-hook' or `post-command-hook'. */);
11917 Vcommand_hook_internal = Qnil;
11918
11919 DEFVAR_LISP ("pre-command-hook", Vpre_command_hook, 11957 DEFVAR_LISP ("pre-command-hook", Vpre_command_hook,
11920 doc: /* Normal hook run before each command is executed. 11958 doc: /* Normal hook run before each command is executed.
11921If an unhandled error happens in running this hook, 11959If an unhandled error happens in running this hook,
11922the hook value is set to nil, since otherwise the error 11960the function in which the error occurred is unconditionally removed, since
11923might happen repeatedly and make Emacs nonfunctional. */); 11961otherwise the error might happen repeatedly and make Emacs nonfunctional. */);
11924 Vpre_command_hook = Qnil; 11962 Vpre_command_hook = Qnil;
11925 11963
11926 DEFVAR_LISP ("post-command-hook", Vpost_command_hook, 11964 DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
11927 doc: /* Normal hook run after each command is executed. 11965 doc: /* Normal hook run after each command is executed.
11928If an unhandled error happens in running this hook, 11966If an unhandled error happens in running this hook,
11929the hook value is set to nil, since otherwise the error 11967the function in which the error occurred is unconditionally removed, since
11930might happen repeatedly and make Emacs nonfunctional. */); 11968otherwise the error might happen repeatedly and make Emacs nonfunctional. */);
11931 Vpost_command_hook = Qnil; 11969 Vpost_command_hook = Qnil;
11932 11970
11933#if 0 11971#if 0
diff --git a/src/keymap.c b/src/keymap.c
index 440df06ba4e..10000b935aa 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -2387,7 +2387,7 @@ push_key_description (register unsigned int c, register char *p, int force_multi
2387 /* Now we are sure that C is a valid character code. */ 2387 /* Now we are sure that C is a valid character code. */
2388 if (NILP (BVAR (current_buffer, enable_multibyte_characters)) 2388 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
2389 && ! force_multibyte) 2389 && ! force_multibyte)
2390 *p++ = multibyte_char_to_unibyte (c, Qnil); 2390 *p++ = multibyte_char_to_unibyte (c);
2391 else 2391 else
2392 p += CHAR_STRING (c, (unsigned char *) p); 2392 p += CHAR_STRING (c, (unsigned char *) p);
2393 } 2393 }
diff --git a/src/lisp.h b/src/lisp.h
index edf6130e5b5..85838d111db 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2278,7 +2278,7 @@ void staticpro (Lisp_Object *);
2278struct window; 2278struct window;
2279struct frame; 2279struct frame;
2280 2280
2281/* Defined in data.c */ 2281/* Defined in data.c. */
2282extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound; 2282extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
2283extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; 2283extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
2284extern Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; 2284extern Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
@@ -2403,7 +2403,7 @@ EXFUN (Fchar_width, 1);
2403EXFUN (Fstring, MANY); 2403EXFUN (Fstring, MANY);
2404extern EMACS_INT chars_in_text (const unsigned char *, EMACS_INT); 2404extern EMACS_INT chars_in_text (const unsigned char *, EMACS_INT);
2405extern EMACS_INT multibyte_chars_in_text (const unsigned char *, EMACS_INT); 2405extern EMACS_INT multibyte_chars_in_text (const unsigned char *, EMACS_INT);
2406extern int multibyte_char_to_unibyte (int, Lisp_Object); 2406extern int multibyte_char_to_unibyte (int);
2407extern int multibyte_char_to_unibyte_safe (int); 2407extern int multibyte_char_to_unibyte_safe (int);
2408extern void init_character_once (void); 2408extern void init_character_once (void);
2409extern void syms_of_character (void); 2409extern void syms_of_character (void);
@@ -2812,7 +2812,7 @@ extern void init_obarray (void);
2812extern void init_lread (void); 2812extern void init_lread (void);
2813extern void syms_of_lread (void); 2813extern void syms_of_lread (void);
2814 2814
2815/* Defined in eval.c */ 2815/* Defined in eval.c. */
2816extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; 2816extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
2817extern Lisp_Object Qinhibit_quit; 2817extern Lisp_Object Qinhibit_quit;
2818extern Lisp_Object Vautoload_queue; 2818extern Lisp_Object Vautoload_queue;
@@ -2830,6 +2830,9 @@ EXFUN (Frun_hooks, MANY);
2830EXFUN (Frun_hook_with_args, MANY); 2830EXFUN (Frun_hook_with_args, MANY);
2831EXFUN (Frun_hook_with_args_until_failure, MANY); 2831EXFUN (Frun_hook_with_args_until_failure, MANY);
2832extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object); 2832extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
2833extern Lisp_Object run_hook_with_args (size_t nargs, Lisp_Object *args,
2834 Lisp_Object (*funcall)
2835 (size_t nargs, Lisp_Object *args));
2833EXFUN (Fprogn, UNEVALLED); 2836EXFUN (Fprogn, UNEVALLED);
2834EXFUN (Finteractive_p, 0); 2837EXFUN (Finteractive_p, 0);
2835EXFUN (Fthrow, 2) NO_RETURN; 2838EXFUN (Fthrow, 2) NO_RETURN;
diff --git a/src/nsmenu.m b/src/nsmenu.m
index e8d4a256906..623c933ce8e 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -1705,7 +1705,6 @@ void process_dialog (id window, Lisp_Object list)
1705- (Lisp_Object)runDialogAt: (NSPoint)p 1705- (Lisp_Object)runDialogAt: (NSPoint)p
1706{ 1706{
1707 NSInteger ret; 1707 NSInteger ret;
1708 extern EMACS_TIME timer_check (int do_it_now); /* TODO: add to a header */
1709 1708
1710 /* initiate a session that will be ended by pop_down_menu */ 1709 /* initiate a session that will be ended by pop_down_menu */
1711 popupSession = [NSApp beginModalSessionForWindow: self]; 1710 popupSession = [NSApp beginModalSessionForWindow: self];
@@ -1715,7 +1714,7 @@ void process_dialog (id window, Lisp_Object list)
1715 { 1714 {
1716 /* Run this for timers.el, indep of atimers; might not return. 1715 /* Run this for timers.el, indep of atimers; might not return.
1717 TODO: use return value to avoid calling every iteration. */ 1716 TODO: use return value to avoid calling every iteration. */
1718 timer_check (1); 1717 timer_check ();
1719 [NSThread sleepUntilDate: [NSDate dateWithTimeIntervalSinceNow: 0.1]]; 1718 [NSThread sleepUntilDate: [NSDate dateWithTimeIntervalSinceNow: 0.1]];
1720 } 1719 }
1721 1720
diff --git a/src/nsterm.m b/src/nsterm.m
index c7cd411c614..91f0cbba585 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -170,6 +170,7 @@ BOOL ns_in_resize = NO;
170static BOOL ns_fake_keydown = NO; 170static BOOL ns_fake_keydown = NO;
171int ns_tmp_flags; /* FIXME */ 171int ns_tmp_flags; /* FIXME */
172struct nsfont_info *ns_tmp_font; /* FIXME */ 172struct nsfont_info *ns_tmp_font; /* FIXME */
173static BOOL ns_menu_bar_is_hidden = NO;
173/*static int debug_lock = 0; */ 174/*static int debug_lock = 0; */
174 175
175/* event loop */ 176/* event loop */
@@ -505,6 +506,118 @@ ns_resize_handle_rect (NSWindow *window)
505} 506}
506 507
507 508
509//
510// Window constraining
511// -------------------
512//
513// To ensure that the windows are not placed under the menu bar, they
514// are typically moved by the call-back constrainFrameRect. However,
515// by overriding it, it's possible to inhibit this, leaving the window
516// in it's original position.
517//
518// It's possible to hide the menu bar. However, technically, it's only
519// possible to hide it when the application is active. To ensure that
520// this work properly, the menu bar and window constraining are
521// deferred until the application becomes active.
522//
523// Even though it's not possible to manually move a window above the
524// top of the screen, it is allowed if it's done programmatically,
525// when the menu is hidden. This allows the editable area to cover the
526// full screen height.
527//
528// Test cases
529// ----------
530//
531// Use the following extra files:
532//
533// init.el:
534// ;; Hide menu and place frame slightly above the top of the screen.
535// (setq ns-auto-hide-menu-bar t)
536// (set-frame-position (selected-frame) 0 -20)
537//
538// Test 1:
539//
540// emacs -Q -l init.el
541//
542// Result: No menu bar, and the title bar should be above the screen.
543//
544// Test 2:
545//
546// emacs -Q
547//
548// Result: Menu bar visible, frame placed immediately below the menu.
549//
550
551static void
552ns_constrain_all_frames (void)
553{
554 Lisp_Object tail, frame;
555
556 FOR_EACH_FRAME (tail, frame)
557 {
558 struct frame *f = XFRAME (frame);
559 if (FRAME_NS_P (f))
560 {
561 NSView *view = FRAME_NS_VIEW (f);
562 /* This no-op will trigger the default window placing
563 * constriant system. */
564 f->output_data.ns->dont_constrain = 0;
565 [[view window] setFrameOrigin:[[view window] frame].origin];
566 }
567 }
568}
569
570
571/* True, if the menu bar should be hidden. */
572
573static BOOL
574ns_menu_bar_should_be_hidden (void)
575{
576 return !NILP (ns_auto_hide_menu_bar)
577 && [NSApp respondsToSelector:@selector(setPresentationOptions:)];
578}
579
580
581/* Show or hide the menu bar, based on user setting. */
582
583static void
584ns_update_auto_hide_menu_bar (void)
585{
586 BLOCK_INPUT;
587
588 NSTRACE (ns_update_auto_hide_menu_bar);
589
590 if (NSApp != nil
591 && [NSApp isActive]
592 && [NSApp respondsToSelector:@selector(setPresentationOptions:)])
593 {
594 // Note, "setPresentationOptions" triggers an error unless the
595 // application is active.
596 BOOL menu_bar_should_be_hidden = ns_menu_bar_should_be_hidden ();
597
598 if (menu_bar_should_be_hidden != ns_menu_bar_is_hidden)
599 {
600 NSApplicationPresentationOptions options
601 = NSApplicationPresentationAutoHideDock;
602
603 if (menu_bar_should_be_hidden)
604 options |= NSApplicationPresentationAutoHideMenuBar;
605
606 [NSApp setPresentationOptions: options];
607
608 ns_menu_bar_is_hidden = menu_bar_should_be_hidden;
609
610 if (!ns_menu_bar_is_hidden)
611 {
612 ns_constrain_all_frames ();
613 }
614 }
615 }
616
617 UNBLOCK_INPUT;
618}
619
620
508static void 621static void
509ns_update_begin (struct frame *f) 622ns_update_begin (struct frame *f)
510/* -------------------------------------------------------------------------- 623/* --------------------------------------------------------------------------
@@ -515,6 +628,8 @@ ns_update_begin (struct frame *f)
515 NSView *view = FRAME_NS_VIEW (f); 628 NSView *view = FRAME_NS_VIEW (f);
516 NSTRACE (ns_update_begin); 629 NSTRACE (ns_update_begin);
517 630
631 ns_update_auto_hide_menu_bar ();
632
518 ns_updating_frame = f; 633 ns_updating_frame = f;
519 [view lockFocus]; 634 [view lockFocus];
520 635
@@ -4205,7 +4320,13 @@ ns_term_shutdown (int sig)
4205} 4320}
4206- (void)applicationDidBecomeActive: (NSNotification *)notification 4321- (void)applicationDidBecomeActive: (NSNotification *)notification
4207{ 4322{
4323 NSTRACE (applicationDidBecomeActive);
4324
4208 //ns_app_active=YES; 4325 //ns_app_active=YES;
4326
4327 ns_update_auto_hide_menu_bar ();
4328 // No constrining takes place when the application is not active.
4329 ns_constrain_all_frames ();
4209} 4330}
4210- (void)applicationDidResignActive: (NSNotification *)notification 4331- (void)applicationDidResignActive: (NSNotification *)notification
4211{ 4332{
@@ -5689,7 +5810,10 @@ ns_term_shutdown (int sig)
5689 /* When making the frame visible for the first time, we want to 5810 /* When making the frame visible for the first time, we want to
5690 constrain. Other times not. */ 5811 constrain. Other times not. */
5691 struct frame *f = ((EmacsView *)[self delegate])->emacsframe; 5812 struct frame *f = ((EmacsView *)[self delegate])->emacsframe;
5692 if (f->output_data.ns->dont_constrain) 5813 NSTRACE (constrainFrameRect);
5814
5815 if (f->output_data.ns->dont_constrain
5816 || ns_menu_bar_should_be_hidden ())
5693 return frameRect; 5817 return frameRect;
5694 5818
5695 f->output_data.ns->dont_constrain = 1; 5819 f->output_data.ns->dont_constrain = 1;
@@ -6361,6 +6485,11 @@ allowing it to be used at a lower level for accented character entry.");
6361 staticpro (&last_mouse_motion_frame); 6485 staticpro (&last_mouse_motion_frame);
6362 last_mouse_motion_frame = Qnil; 6486 last_mouse_motion_frame = Qnil;
6363 6487
6488 DEFVAR_LISP ("ns-auto-hide-menu-bar", ns_auto_hide_menu_bar,
6489 doc: /* Non-nil means that the menu bar is hidden, but appears when the mouse is near.
6490Only works on OSX 10.6 or later. */);
6491 ns_auto_hide_menu_bar = Qnil;
6492
6364 /* TODO: move to common code */ 6493 /* TODO: move to common code */
6365 DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, 6494 DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars,
6366 doc: /* If not nil, Emacs uses toolkit scroll bars. */); 6495 doc: /* If not nil, Emacs uses toolkit scroll bars. */);
diff --git a/src/print.c b/src/print.c
index 5b2778cf251..e44d4d14f36 100644
--- a/src/print.c
+++ b/src/print.c
@@ -273,7 +273,7 @@ printchar (unsigned int ch, Lisp_Object fun)
273 273
274static void 274static void
275strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte, 275strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte,
276 Lisp_Object printcharfun, int multibyte) 276 Lisp_Object printcharfun)
277{ 277{
278 if (size < 0) 278 if (size < 0)
279 size_byte = size = strlen (ptr); 279 size_byte = size = strlen (ptr);
@@ -406,16 +406,13 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
406 SAFE_ALLOCA (buffer, char *, nbytes); 406 SAFE_ALLOCA (buffer, char *, nbytes);
407 memcpy (buffer, SDATA (string), nbytes); 407 memcpy (buffer, SDATA (string), nbytes);
408 408
409 strout (buffer, chars, SBYTES (string), 409 strout (buffer, chars, SBYTES (string), printcharfun);
410 printcharfun, STRING_MULTIBYTE (string));
411 410
412 SAFE_FREE (); 411 SAFE_FREE ();
413 } 412 }
414 else 413 else
415 /* No need to copy, since output to print_buffer can't GC. */ 414 /* No need to copy, since output to print_buffer can't GC. */
416 strout (SSDATA (string), 415 strout (SSDATA (string), chars, SBYTES (string), printcharfun);
417 chars, SBYTES (string),
418 printcharfun, STRING_MULTIBYTE (string));
419 } 416 }
420 else 417 else
421 { 418 {
@@ -472,7 +469,7 @@ write_string (const char *data, int size)
472 printcharfun = Vstandard_output; 469 printcharfun = Vstandard_output;
473 470
474 PRINTPREPARE; 471 PRINTPREPARE;
475 strout (data, size, size, printcharfun, 0); 472 strout (data, size, size, printcharfun);
476 PRINTFINISH; 473 PRINTFINISH;
477} 474}
478 475
@@ -486,7 +483,7 @@ write_string_1 (const char *data, int size, Lisp_Object printcharfun)
486 PRINTDECLARE; 483 PRINTDECLARE;
487 484
488 PRINTPREPARE; 485 PRINTPREPARE;
489 strout (data, size, size, printcharfun, 0); 486 strout (data, size, size, printcharfun);
490 PRINTFINISH; 487 PRINTFINISH;
491} 488}
492 489
@@ -1404,7 +1401,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1404 if (EQ (obj, being_printed[i])) 1401 if (EQ (obj, being_printed[i]))
1405 { 1402 {
1406 sprintf (buf, "#%d", i); 1403 sprintf (buf, "#%d", i);
1407 strout (buf, -1, -1, printcharfun, 0); 1404 strout (buf, -1, -1, printcharfun);
1408 return; 1405 return;
1409 } 1406 }
1410 being_printed[print_depth] = obj; 1407 being_printed[print_depth] = obj;
@@ -1420,7 +1417,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1420 { /* Add a prefix #n= if OBJ has not yet been printed; 1417 { /* Add a prefix #n= if OBJ has not yet been printed;
1421 that is, its status field is nil. */ 1418 that is, its status field is nil. */
1422 sprintf (buf, "#%d=", -n); 1419 sprintf (buf, "#%d=", -n);
1423 strout (buf, -1, -1, printcharfun, 0); 1420 strout (buf, -1, -1, printcharfun);
1424 /* OBJ is going to be printed. Remember that fact. */ 1421 /* OBJ is going to be printed. Remember that fact. */
1425 Fputhash (obj, make_number (- n), Vprint_number_table); 1422 Fputhash (obj, make_number (- n), Vprint_number_table);
1426 } 1423 }
@@ -1428,7 +1425,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1428 { 1425 {
1429 /* Just print #n# if OBJ has already been printed. */ 1426 /* Just print #n# if OBJ has already been printed. */
1430 sprintf (buf, "#%d#", n); 1427 sprintf (buf, "#%d#", n);
1431 strout (buf, -1, -1, printcharfun, 0); 1428 strout (buf, -1, -1, printcharfun);
1432 return; 1429 return;
1433 } 1430 }
1434 } 1431 }
@@ -1446,7 +1443,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1446 sprintf (buf, "%ld", (long) XINT (obj)); 1443 sprintf (buf, "%ld", (long) XINT (obj));
1447 else 1444 else
1448 abort (); 1445 abort ();
1449 strout (buf, -1, -1, printcharfun, 0); 1446 strout (buf, -1, -1, printcharfun);
1450 break; 1447 break;
1451 1448
1452 case Lisp_Float: 1449 case Lisp_Float:
@@ -1454,7 +1451,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1454 char pigbuf[FLOAT_TO_STRING_BUFSIZE]; 1451 char pigbuf[FLOAT_TO_STRING_BUFSIZE];
1455 1452
1456 float_to_string (pigbuf, XFLOAT_DATA (obj)); 1453 float_to_string (pigbuf, XFLOAT_DATA (obj));
1457 strout (pigbuf, -1, -1, printcharfun, 0); 1454 strout (pigbuf, -1, -1, printcharfun);
1458 } 1455 }
1459 break; 1456 break;
1460 1457
@@ -1532,7 +1529,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1532 sprintf (outbuf, "\\x%04x", c); 1529 sprintf (outbuf, "\\x%04x", c);
1533 need_nonhex = 1; 1530 need_nonhex = 1;
1534 } 1531 }
1535 strout (outbuf, -1, -1, printcharfun, 0); 1532 strout (outbuf, -1, -1, printcharfun);
1536 } 1533 }
1537 else if (! multibyte 1534 else if (! multibyte
1538 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c) 1535 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
@@ -1544,7 +1541,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1544 using octal escapes. */ 1541 using octal escapes. */
1545 char outbuf[5]; 1542 char outbuf[5];
1546 sprintf (outbuf, "\\%03o", c); 1543 sprintf (outbuf, "\\%03o", c);
1547 strout (outbuf, -1, -1, printcharfun, 0); 1544 strout (outbuf, -1, -1, printcharfun);
1548 } 1545 }
1549 else 1546 else
1550 { 1547 {
@@ -1557,7 +1554,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1557 if ((c >= 'a' && c <= 'f') 1554 if ((c >= 'a' && c <= 'f')
1558 || (c >= 'A' && c <= 'F') 1555 || (c >= 'A' && c <= 'F')
1559 || (c >= '0' && c <= '9')) 1556 || (c >= '0' && c <= '9'))
1560 strout ("\\ ", -1, -1, printcharfun, 0); 1557 strout ("\\ ", -1, -1, printcharfun);
1561 } 1558 }
1562 1559
1563 if (c == '\"' || c == '\\') 1560 if (c == '\"' || c == '\\')
@@ -1645,7 +1642,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1645 /* If deeper than spec'd depth, print placeholder. */ 1642 /* If deeper than spec'd depth, print placeholder. */
1646 if (INTEGERP (Vprint_level) 1643 if (INTEGERP (Vprint_level)
1647 && print_depth > XINT (Vprint_level)) 1644 && print_depth > XINT (Vprint_level))
1648 strout ("...", -1, -1, printcharfun, 0); 1645 strout ("...", -1, -1, printcharfun);
1649 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) 1646 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1650 && (EQ (XCAR (obj), Qquote))) 1647 && (EQ (XCAR (obj), Qquote)))
1651 { 1648 {
@@ -1705,7 +1702,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1705 if (i != 0 && EQ (obj, halftail)) 1702 if (i != 0 && EQ (obj, halftail))
1706 { 1703 {
1707 sprintf (buf, " . #%d", i / 2); 1704 sprintf (buf, " . #%d", i / 2);
1708 strout (buf, -1, -1, printcharfun, 0); 1705 strout (buf, -1, -1, printcharfun);
1709 goto end_of_list; 1706 goto end_of_list;
1710 } 1707 }
1711 } 1708 }
@@ -1717,7 +1714,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1717 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); 1714 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
1718 if (INTEGERP (num)) 1715 if (INTEGERP (num))
1719 { 1716 {
1720 strout (" . ", 3, 3, printcharfun, 0); 1717 strout (" . ", 3, 3, printcharfun);
1721 print_object (obj, printcharfun, escapeflag); 1718 print_object (obj, printcharfun, escapeflag);
1722 goto end_of_list; 1719 goto end_of_list;
1723 } 1720 }
@@ -1729,7 +1726,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1729 1726
1730 if (print_length && i > print_length) 1727 if (print_length && i > print_length)
1731 { 1728 {
1732 strout ("...", 3, 3, printcharfun, 0); 1729 strout ("...", 3, 3, printcharfun);
1733 goto end_of_list; 1730 goto end_of_list;
1734 } 1731 }
1735 1732
@@ -1744,7 +1741,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1744 /* OBJ non-nil here means it's the end of a dotted list. */ 1741 /* OBJ non-nil here means it's the end of a dotted list. */
1745 if (!NILP (obj)) 1742 if (!NILP (obj))
1746 { 1743 {
1747 strout (" . ", 3, 3, printcharfun, 0); 1744 strout (" . ", 3, 3, printcharfun);
1748 print_object (obj, printcharfun, escapeflag); 1745 print_object (obj, printcharfun, escapeflag);
1749 } 1746 }
1750 1747
@@ -1758,7 +1755,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1758 { 1755 {
1759 if (escapeflag) 1756 if (escapeflag)
1760 { 1757 {
1761 strout ("#<process ", -1, -1, printcharfun, 0); 1758 strout ("#<process ", -1, -1, printcharfun);
1762 print_string (XPROCESS (obj)->name, printcharfun); 1759 print_string (XPROCESS (obj)->name, printcharfun);
1763 PRINTCHAR ('>'); 1760 PRINTCHAR ('>');
1764 } 1761 }
@@ -1779,7 +1776,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1779 PRINTCHAR ('#'); 1776 PRINTCHAR ('#');
1780 PRINTCHAR ('&'); 1777 PRINTCHAR ('&');
1781 sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size); 1778 sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
1782 strout (buf, -1, -1, printcharfun, 0); 1779 strout (buf, -1, -1, printcharfun);
1783 PRINTCHAR ('\"'); 1780 PRINTCHAR ('\"');
1784 1781
1785 /* Don't print more characters than the specified maximum. 1782 /* Don't print more characters than the specified maximum.
@@ -1824,18 +1821,18 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1824 } 1821 }
1825 else if (SUBRP (obj)) 1822 else if (SUBRP (obj))
1826 { 1823 {
1827 strout ("#<subr ", -1, -1, printcharfun, 0); 1824 strout ("#<subr ", -1, -1, printcharfun);
1828 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0); 1825 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun);
1829 PRINTCHAR ('>'); 1826 PRINTCHAR ('>');
1830 } 1827 }
1831 else if (WINDOWP (obj)) 1828 else if (WINDOWP (obj))
1832 { 1829 {
1833 strout ("#<window ", -1, -1, printcharfun, 0); 1830 strout ("#<window ", -1, -1, printcharfun);
1834 sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number)); 1831 sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
1835 strout (buf, -1, -1, printcharfun, 0); 1832 strout (buf, -1, -1, printcharfun);
1836 if (!NILP (XWINDOW (obj)->buffer)) 1833 if (!NILP (XWINDOW (obj)->buffer))
1837 { 1834 {
1838 strout (" on ", -1, -1, printcharfun, 0); 1835 strout (" on ", -1, -1, printcharfun);
1839 print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); 1836 print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun);
1840 } 1837 }
1841 PRINTCHAR ('>'); 1838 PRINTCHAR ('>');
@@ -1843,13 +1840,13 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1843 else if (TERMINALP (obj)) 1840 else if (TERMINALP (obj))
1844 { 1841 {
1845 struct terminal *t = XTERMINAL (obj); 1842 struct terminal *t = XTERMINAL (obj);
1846 strout ("#<terminal ", -1, -1, printcharfun, 0); 1843 strout ("#<terminal ", -1, -1, printcharfun);
1847 sprintf (buf, "%d", t->id); 1844 sprintf (buf, "%d", t->id);
1848 strout (buf, -1, -1, printcharfun, 0); 1845 strout (buf, -1, -1, printcharfun);
1849 if (t->name) 1846 if (t->name)
1850 { 1847 {
1851 strout (" on ", -1, -1, printcharfun, 0); 1848 strout (" on ", -1, -1, printcharfun);
1852 strout (t->name, -1, -1, printcharfun, 0); 1849 strout (t->name, -1, -1, printcharfun);
1853 } 1850 }
1854 PRINTCHAR ('>'); 1851 PRINTCHAR ('>');
1855 } 1852 }
@@ -1859,21 +1856,21 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1859 int i; 1856 int i;
1860 EMACS_INT real_size, size; 1857 EMACS_INT real_size, size;
1861#if 0 1858#if 0
1862 strout ("#<hash-table", -1, -1, printcharfun, 0); 1859 strout ("#<hash-table", -1, -1, printcharfun);
1863 if (SYMBOLP (h->test)) 1860 if (SYMBOLP (h->test))
1864 { 1861 {
1865 PRINTCHAR (' '); 1862 PRINTCHAR (' ');
1866 PRINTCHAR ('\''); 1863 PRINTCHAR ('\'');
1867 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0); 1864 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun);
1868 PRINTCHAR (' '); 1865 PRINTCHAR (' ');
1869 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0); 1866 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun);
1870 PRINTCHAR (' '); 1867 PRINTCHAR (' ');
1871 sprintf (buf, "%ld/%ld", (long) h->count, 1868 sprintf (buf, "%ld/%ld", (long) h->count,
1872 (long) XVECTOR (h->next)->size); 1869 (long) XVECTOR (h->next)->size);
1873 strout (buf, -1, -1, printcharfun, 0); 1870 strout (buf, -1, -1, printcharfun);
1874 } 1871 }
1875 sprintf (buf, " 0x%lx", (unsigned long) h); 1872 sprintf (buf, " 0x%lx", (unsigned long) h);
1876 strout (buf, -1, -1, printcharfun, 0); 1873 strout (buf, -1, -1, printcharfun);
1877 PRINTCHAR ('>'); 1874 PRINTCHAR ('>');
1878#endif 1875#endif
1879 /* Implement a readable output, e.g.: 1876 /* Implement a readable output, e.g.:
@@ -1881,33 +1878,33 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1881 /* Always print the size. */ 1878 /* Always print the size. */
1882 sprintf (buf, "#s(hash-table size %ld", 1879 sprintf (buf, "#s(hash-table size %ld",
1883 (long) XVECTOR (h->next)->size); 1880 (long) XVECTOR (h->next)->size);
1884 strout (buf, -1, -1, printcharfun, 0); 1881 strout (buf, -1, -1, printcharfun);
1885 1882
1886 if (!NILP (h->test)) 1883 if (!NILP (h->test))
1887 { 1884 {
1888 strout (" test ", -1, -1, printcharfun, 0); 1885 strout (" test ", -1, -1, printcharfun);
1889 print_object (h->test, printcharfun, escapeflag); 1886 print_object (h->test, printcharfun, escapeflag);
1890 } 1887 }
1891 1888
1892 if (!NILP (h->weak)) 1889 if (!NILP (h->weak))
1893 { 1890 {
1894 strout (" weakness ", -1, -1, printcharfun, 0); 1891 strout (" weakness ", -1, -1, printcharfun);
1895 print_object (h->weak, printcharfun, escapeflag); 1892 print_object (h->weak, printcharfun, escapeflag);
1896 } 1893 }
1897 1894
1898 if (!NILP (h->rehash_size)) 1895 if (!NILP (h->rehash_size))
1899 { 1896 {
1900 strout (" rehash-size ", -1, -1, printcharfun, 0); 1897 strout (" rehash-size ", -1, -1, printcharfun);
1901 print_object (h->rehash_size, printcharfun, escapeflag); 1898 print_object (h->rehash_size, printcharfun, escapeflag);
1902 } 1899 }
1903 1900
1904 if (!NILP (h->rehash_threshold)) 1901 if (!NILP (h->rehash_threshold))
1905 { 1902 {
1906 strout (" rehash-threshold ", -1, -1, printcharfun, 0); 1903 strout (" rehash-threshold ", -1, -1, printcharfun);
1907 print_object (h->rehash_threshold, printcharfun, escapeflag); 1904 print_object (h->rehash_threshold, printcharfun, escapeflag);
1908 } 1905 }
1909 1906
1910 strout (" data ", -1, -1, printcharfun, 0); 1907 strout (" data ", -1, -1, printcharfun);
1911 1908
1912 /* Print the data here as a plist. */ 1909 /* Print the data here as a plist. */
1913 real_size = HASH_TABLE_SIZE (h); 1910 real_size = HASH_TABLE_SIZE (h);
@@ -1929,7 +1926,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1929 } 1926 }
1930 1927
1931 if (size < real_size) 1928 if (size < real_size)
1932 strout (" ...", 4, 4, printcharfun, 0); 1929 strout (" ...", 4, 4, printcharfun);
1933 1930
1934 PRINTCHAR (')'); 1931 PRINTCHAR (')');
1935 PRINTCHAR (')'); 1932 PRINTCHAR (')');
@@ -1938,10 +1935,10 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1938 else if (BUFFERP (obj)) 1935 else if (BUFFERP (obj))
1939 { 1936 {
1940 if (NILP (BVAR (XBUFFER (obj), name))) 1937 if (NILP (BVAR (XBUFFER (obj), name)))
1941 strout ("#<killed buffer>", -1, -1, printcharfun, 0); 1938 strout ("#<killed buffer>", -1, -1, printcharfun);
1942 else if (escapeflag) 1939 else if (escapeflag)
1943 { 1940 {
1944 strout ("#<buffer ", -1, -1, printcharfun, 0); 1941 strout ("#<buffer ", -1, -1, printcharfun);
1945 print_string (BVAR (XBUFFER (obj), name), printcharfun); 1942 print_string (BVAR (XBUFFER (obj), name), printcharfun);
1946 PRINTCHAR ('>'); 1943 PRINTCHAR ('>');
1947 } 1944 }
@@ -1950,16 +1947,16 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1950 } 1947 }
1951 else if (WINDOW_CONFIGURATIONP (obj)) 1948 else if (WINDOW_CONFIGURATIONP (obj))
1952 { 1949 {
1953 strout ("#<window-configuration>", -1, -1, printcharfun, 0); 1950 strout ("#<window-configuration>", -1, -1, printcharfun);
1954 } 1951 }
1955 else if (FRAMEP (obj)) 1952 else if (FRAMEP (obj))
1956 { 1953 {
1957 strout ((FRAME_LIVE_P (XFRAME (obj)) 1954 strout ((FRAME_LIVE_P (XFRAME (obj))
1958 ? "#<frame " : "#<dead frame "), 1955 ? "#<frame " : "#<dead frame "),
1959 -1, -1, printcharfun, 0); 1956 -1, -1, printcharfun);
1960 print_string (XFRAME (obj)->name, printcharfun); 1957 print_string (XFRAME (obj)->name, printcharfun);
1961 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj))); 1958 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
1962 strout (buf, -1, -1, printcharfun, 0); 1959 strout (buf, -1, -1, printcharfun);
1963 PRINTCHAR ('>'); 1960 PRINTCHAR ('>');
1964 } 1961 }
1965 else if (FONTP (obj)) 1962 else if (FONTP (obj))
@@ -1969,9 +1966,9 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1969 if (! FONT_OBJECT_P (obj)) 1966 if (! FONT_OBJECT_P (obj))
1970 { 1967 {
1971 if (FONT_SPEC_P (obj)) 1968 if (FONT_SPEC_P (obj))
1972 strout ("#<font-spec", -1, -1, printcharfun, 0); 1969 strout ("#<font-spec", -1, -1, printcharfun);
1973 else 1970 else
1974 strout ("#<font-entity", -1, -1, printcharfun, 0); 1971 strout ("#<font-entity", -1, -1, printcharfun);
1975 for (i = 0; i < FONT_SPEC_MAX; i++) 1972 for (i = 0; i < FONT_SPEC_MAX; i++)
1976 { 1973 {
1977 PRINTCHAR (' '); 1974 PRINTCHAR (' ');
@@ -1984,7 +1981,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
1984 } 1981 }
1985 else 1982 else
1986 { 1983 {
1987 strout ("#<font-object ", -1, -1, printcharfun, 0); 1984 strout ("#<font-object ", -1, -1, printcharfun);
1988 print_object (AREF (obj, FONT_NAME_INDEX), printcharfun, 1985 print_object (AREF (obj, FONT_NAME_INDEX), printcharfun,
1989 escapeflag); 1986 escapeflag);
1990 } 1987 }
@@ -2037,7 +2034,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
2037 print_object (tem, printcharfun, escapeflag); 2034 print_object (tem, printcharfun, escapeflag);
2038 } 2035 }
2039 if (size < real_size) 2036 if (size < real_size)
2040 strout (" ...", 4, 4, printcharfun, 0); 2037 strout (" ...", 4, 4, printcharfun);
2041 } 2038 }
2042 PRINTCHAR (']'); 2039 PRINTCHAR (']');
2043 } 2040 }
@@ -2047,32 +2044,32 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
2047 switch (XMISCTYPE (obj)) 2044 switch (XMISCTYPE (obj))
2048 { 2045 {
2049 case Lisp_Misc_Marker: 2046 case Lisp_Misc_Marker:
2050 strout ("#<marker ", -1, -1, printcharfun, 0); 2047 strout ("#<marker ", -1, -1, printcharfun);
2051 /* Do you think this is necessary? */ 2048 /* Do you think this is necessary? */
2052 if (XMARKER (obj)->insertion_type != 0) 2049 if (XMARKER (obj)->insertion_type != 0)
2053 strout ("(moves after insertion) ", -1, -1, printcharfun, 0); 2050 strout ("(moves after insertion) ", -1, -1, printcharfun);
2054 if (! XMARKER (obj)->buffer) 2051 if (! XMARKER (obj)->buffer)
2055 strout ("in no buffer", -1, -1, printcharfun, 0); 2052 strout ("in no buffer", -1, -1, printcharfun);
2056 else 2053 else
2057 { 2054 {
2058 sprintf (buf, "at %ld", (long)marker_position (obj)); 2055 sprintf (buf, "at %ld", (long)marker_position (obj));
2059 strout (buf, -1, -1, printcharfun, 0); 2056 strout (buf, -1, -1, printcharfun);
2060 strout (" in ", -1, -1, printcharfun, 0); 2057 strout (" in ", -1, -1, printcharfun);
2061 print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); 2058 print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
2062 } 2059 }
2063 PRINTCHAR ('>'); 2060 PRINTCHAR ('>');
2064 break; 2061 break;
2065 2062
2066 case Lisp_Misc_Overlay: 2063 case Lisp_Misc_Overlay:
2067 strout ("#<overlay ", -1, -1, printcharfun, 0); 2064 strout ("#<overlay ", -1, -1, printcharfun);
2068 if (! XMARKER (OVERLAY_START (obj))->buffer) 2065 if (! XMARKER (OVERLAY_START (obj))->buffer)
2069 strout ("in no buffer", -1, -1, printcharfun, 0); 2066 strout ("in no buffer", -1, -1, printcharfun);
2070 else 2067 else
2071 { 2068 {
2072 sprintf (buf, "from %ld to %ld in ", 2069 sprintf (buf, "from %ld to %ld in ",
2073 (long)marker_position (OVERLAY_START (obj)), 2070 (long)marker_position (OVERLAY_START (obj)),
2074 (long)marker_position (OVERLAY_END (obj))); 2071 (long)marker_position (OVERLAY_END (obj)));
2075 strout (buf, -1, -1, printcharfun, 0); 2072 strout (buf, -1, -1, printcharfun);
2076 print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), 2073 print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
2077 printcharfun); 2074 printcharfun);
2078 } 2075 }
@@ -2082,15 +2079,15 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
2082 /* Remaining cases shouldn't happen in normal usage, but let's print 2079 /* Remaining cases shouldn't happen in normal usage, but let's print
2083 them anyway for the benefit of the debugger. */ 2080 them anyway for the benefit of the debugger. */
2084 case Lisp_Misc_Free: 2081 case Lisp_Misc_Free:
2085 strout ("#<misc free cell>", -1, -1, printcharfun, 0); 2082 strout ("#<misc free cell>", -1, -1, printcharfun);
2086 break; 2083 break;
2087 2084
2088 case Lisp_Misc_Save_Value: 2085 case Lisp_Misc_Save_Value:
2089 strout ("#<save_value ", -1, -1, printcharfun, 0); 2086 strout ("#<save_value ", -1, -1, printcharfun);
2090 sprintf(buf, "ptr=0x%08lx int=%d", 2087 sprintf(buf, "ptr=0x%08lx int=%d",
2091 (unsigned long) XSAVE_VALUE (obj)->pointer, 2088 (unsigned long) XSAVE_VALUE (obj)->pointer,
2092 XSAVE_VALUE (obj)->integer); 2089 XSAVE_VALUE (obj)->integer);
2093 strout (buf, -1, -1, printcharfun, 0); 2090 strout (buf, -1, -1, printcharfun);
2094 PRINTCHAR ('>'); 2091 PRINTCHAR ('>');
2095 break; 2092 break;
2096 2093
@@ -2104,16 +2101,16 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
2104 { 2101 {
2105 /* We're in trouble if this happens! 2102 /* We're in trouble if this happens!
2106 Probably should just abort () */ 2103 Probably should just abort () */
2107 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0); 2104 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun);
2108 if (MISCP (obj)) 2105 if (MISCP (obj))
2109 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj)); 2106 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
2110 else if (VECTORLIKEP (obj)) 2107 else if (VECTORLIKEP (obj))
2111 sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size); 2108 sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size);
2112 else 2109 else
2113 sprintf (buf, "(0x%02x)", (int) XTYPE (obj)); 2110 sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
2114 strout (buf, -1, -1, printcharfun, 0); 2111 strout (buf, -1, -1, printcharfun);
2115 strout (" Save your buffers immediately and please report this bug>", 2112 strout (" Save your buffers immediately and please report this bug>",
2116 -1, -1, printcharfun, 0); 2113 -1, -1, printcharfun);
2117 } 2114 }
2118 } 2115 }
2119 2116
diff --git a/src/scroll.c b/src/scroll.c
index f013ebbee0e..fcec596daa3 100644
--- a/src/scroll.c
+++ b/src/scroll.c
@@ -239,7 +239,9 @@ calculate_scrolling (FRAME_PTR frame,
239 of lines. */ 239 of lines. */
240 240
241static void 241static void
242do_scrolling (struct frame *frame, struct glyph_matrix *current_matrix, struct matrix_elt *matrix, int window_size, int unchanged_at_top) 242do_scrolling (struct frame *frame, struct glyph_matrix *current_matrix,
243 struct matrix_elt *matrix, int window_size,
244 int unchanged_at_top)
243{ 245{
244 struct matrix_elt *p; 246 struct matrix_elt *p;
245 int i, j, k; 247 int i, j, k;
@@ -831,7 +833,9 @@ scrolling_1 (FRAME_PTR frame, int window_size, int unchanged_at_top,
831 such a line will have little weight. */ 833 such a line will have little weight. */
832 834
833int 835int
834scrolling_max_lines_saved (int start, int end, int *oldhash, int *newhash, int *cost) 836scrolling_max_lines_saved (int start, int end,
837 int *oldhash, int *newhash,
838 int *cost)
835{ 839{
836 struct { int hash; int count; } lines[01000]; 840 struct { int hash; int count; } lines[01000];
837 register int i, h; 841 register int i, h;
@@ -920,7 +924,8 @@ scroll_cost (FRAME_PTR frame, int from, int to, int amount)
920 overhead and multiply factor values */ 924 overhead and multiply factor values */
921 925
922static void 926static void
923line_ins_del (FRAME_PTR frame, int ov1, int pf1, int ovn, int pfn, register int *ov, register int *mf) 927line_ins_del (FRAME_PTR frame, int ov1, int pf1, int ovn, int pfn,
928 register int *ov, register int *mf)
924{ 929{
925 register EMACS_INT i; 930 register EMACS_INT i;
926 register EMACS_INT frame_lines = FRAME_LINES (frame); 931 register EMACS_INT frame_lines = FRAME_LINES (frame);
diff --git a/src/search.c b/src/search.c
index bf93a7fe442..682fa185bbb 100644
--- a/src/search.c
+++ b/src/search.c
@@ -95,10 +95,9 @@ static void save_search_regs (void);
95static EMACS_INT simple_search (EMACS_INT, unsigned char *, EMACS_INT, 95static EMACS_INT simple_search (EMACS_INT, unsigned char *, EMACS_INT,
96 EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT, 96 EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT,
97 EMACS_INT, EMACS_INT); 97 EMACS_INT, EMACS_INT);
98static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, EMACS_INT, EMACS_INT, 98static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, EMACS_INT,
99 Lisp_Object, Lisp_Object, 99 Lisp_Object, Lisp_Object, EMACS_INT,
100 EMACS_INT, EMACS_INT, 100 EMACS_INT, int);
101 EMACS_INT, EMACS_INT, int);
102static EMACS_INT search_buffer (Lisp_Object, EMACS_INT, EMACS_INT, 101static EMACS_INT search_buffer (Lisp_Object, EMACS_INT, EMACS_INT,
103 EMACS_INT, EMACS_INT, EMACS_INT, int, 102 EMACS_INT, EMACS_INT, EMACS_INT, int,
104 Lisp_Object, Lisp_Object, int); 103 Lisp_Object, Lisp_Object, int);
@@ -1416,15 +1415,14 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte,
1416 } 1415 }
1417 1416
1418 len_byte = pat - patbuf; 1417 len_byte = pat - patbuf;
1419 len = raw_pattern_size;
1420 pat = base_pat = patbuf; 1418 pat = base_pat = patbuf;
1421 1419
1422 if (boyer_moore_ok) 1420 if (boyer_moore_ok)
1423 return boyer_moore (n, pat, len, len_byte, trt, inverse_trt, 1421 return boyer_moore (n, pat, len_byte, trt, inverse_trt,
1424 pos, pos_byte, lim, lim_byte, 1422 pos_byte, lim_byte,
1425 char_base); 1423 char_base);
1426 else 1424 else
1427 return simple_search (n, pat, len, len_byte, trt, 1425 return simple_search (n, pat, raw_pattern_size, len_byte, trt,
1428 pos, pos_byte, lim, lim_byte); 1426 pos, pos_byte, lim, lim_byte);
1429 } 1427 }
1430} 1428}
@@ -1636,8 +1634,8 @@ simple_search (EMACS_INT n, unsigned char *pat,
1636} 1634}
1637 1635
1638/* Do Boyer-Moore search N times for the string BASE_PAT, 1636/* Do Boyer-Moore search N times for the string BASE_PAT,
1639 whose length is LEN/LEN_BYTE, 1637 whose length is LEN_BYTE,
1640 from buffer position POS/POS_BYTE until LIM/LIM_BYTE. 1638 from buffer position POS_BYTE until LIM_BYTE.
1641 DIRECTION says which direction we search in. 1639 DIRECTION says which direction we search in.
1642 TRT and INVERSE_TRT are translation tables. 1640 TRT and INVERSE_TRT are translation tables.
1643 Characters in PAT are already translated by TRT. 1641 Characters in PAT are already translated by TRT.
@@ -1652,10 +1650,10 @@ simple_search (EMACS_INT n, unsigned char *pat,
1652 1650
1653static EMACS_INT 1651static EMACS_INT
1654boyer_moore (EMACS_INT n, unsigned char *base_pat, 1652boyer_moore (EMACS_INT n, unsigned char *base_pat,
1655 EMACS_INT len, EMACS_INT len_byte, 1653 EMACS_INT len_byte,
1656 Lisp_Object trt, Lisp_Object inverse_trt, 1654 Lisp_Object trt, Lisp_Object inverse_trt,
1657 EMACS_INT pos, EMACS_INT pos_byte, 1655 EMACS_INT pos_byte, EMACS_INT lim_byte,
1658 EMACS_INT lim, EMACS_INT lim_byte, int char_base) 1656 int char_base)
1659{ 1657{
1660 int direction = ((n > 0) ? 1 : -1); 1658 int direction = ((n > 0) ? 1 : -1);
1661 register EMACS_INT dirlen; 1659 register EMACS_INT dirlen;
@@ -1776,8 +1774,8 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat,
1776 stride_for_teases = BM_tab[j]; 1774 stride_for_teases = BM_tab[j];
1777 1775
1778 BM_tab[j] = dirlen - i; 1776 BM_tab[j] = dirlen - i;
1779 /* A translation table is accompanied by its inverse -- see */ 1777 /* A translation table is accompanied by its inverse -- see
1780 /* comment following downcase_table for details */ 1778 comment following downcase_table for details. */
1781 if (ch >= 0) 1779 if (ch >= 0)
1782 { 1780 {
1783 int starting_ch = ch; 1781 int starting_ch = ch;
@@ -2636,11 +2634,8 @@ since only regular expressions have distinguished subexpressions. */)
2636 EMACS_INT substed_alloc_size, substed_len; 2634 EMACS_INT substed_alloc_size, substed_len;
2637 int buf_multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); 2635 int buf_multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
2638 int str_multibyte = STRING_MULTIBYTE (newtext); 2636 int str_multibyte = STRING_MULTIBYTE (newtext);
2639 Lisp_Object rev_tbl;
2640 int really_changed = 0; 2637 int really_changed = 0;
2641 2638
2642 rev_tbl = Qnil;
2643
2644 substed_alloc_size = length * 2 + 100; 2639 substed_alloc_size = length * 2 + 100;
2645 substed = (unsigned char *) xmalloc (substed_alloc_size + 1); 2640 substed = (unsigned char *) xmalloc (substed_alloc_size + 1);
2646 substed_len = 0; 2641 substed_len = 0;
@@ -2660,7 +2655,7 @@ since only regular expressions have distinguished subexpressions. */)
2660 { 2655 {
2661 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte); 2656 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte);
2662 if (!buf_multibyte) 2657 if (!buf_multibyte)
2663 c = multibyte_char_to_unibyte (c, rev_tbl); 2658 c = multibyte_char_to_unibyte (c);
2664 } 2659 }
2665 else 2660 else
2666 { 2661 {
@@ -2683,7 +2678,7 @@ since only regular expressions have distinguished subexpressions. */)
2683 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, 2678 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext,
2684 pos, pos_byte); 2679 pos, pos_byte);
2685 if (!buf_multibyte && !ASCII_CHAR_P (c)) 2680 if (!buf_multibyte && !ASCII_CHAR_P (c))
2686 c = multibyte_char_to_unibyte (c, rev_tbl); 2681 c = multibyte_char_to_unibyte (c);
2687 } 2682 }
2688 else 2683 else
2689 { 2684 {
diff --git a/src/w32.c b/src/w32.c
index 5643b3f073e..da403671115 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -1505,6 +1505,7 @@ w32_get_resource (char *key, LPDWORD lpdwtype)
1505} 1505}
1506 1506
1507char *get_emacs_configuration (void); 1507char *get_emacs_configuration (void);
1508
1508void 1509void
1509init_environment (char ** argv) 1510init_environment (char ** argv)
1510{ 1511{
@@ -1591,25 +1592,25 @@ init_environment (char ** argv)
1591 If not, then we can try to default to the appdata directory under the 1592 If not, then we can try to default to the appdata directory under the
1592 user's profile, which is more likely to be writable. */ 1593 user's profile, which is more likely to be writable. */
1593 if (stat ("C:/.emacs", &ignored) < 0) 1594 if (stat ("C:/.emacs", &ignored) < 0)
1594 { 1595 {
1595 HRESULT profile_result; 1596 HRESULT profile_result;
1596 /* Dynamically load ShGetFolderPath, as it won't exist on versions 1597 /* Dynamically load ShGetFolderPath, as it won't exist on versions
1597 of Windows 95 and NT4 that have not been updated to include 1598 of Windows 95 and NT4 that have not been updated to include
1598 MSIE 5. */ 1599 MSIE 5. */
1599 ShGetFolderPath_fn get_folder_path; 1600 ShGetFolderPath_fn get_folder_path;
1600 get_folder_path = (ShGetFolderPath_fn) 1601 get_folder_path = (ShGetFolderPath_fn)
1601 GetProcAddress (GetModuleHandle ("shell32.dll"), "SHGetFolderPathA"); 1602 GetProcAddress (GetModuleHandle ("shell32.dll"), "SHGetFolderPathA");
1602 1603
1603 if (get_folder_path != NULL) 1604 if (get_folder_path != NULL)
1604 { 1605 {
1605 profile_result = get_folder_path (NULL, CSIDL_APPDATA, NULL, 1606 profile_result = get_folder_path (NULL, CSIDL_APPDATA, NULL,
1606 0, default_home); 1607 0, default_home);
1607 1608
1608 /* If we can't get the appdata dir, revert to old behavior. */ 1609 /* If we can't get the appdata dir, revert to old behavior. */
1609 if (profile_result == S_OK) 1610 if (profile_result == S_OK)
1610 env_vars[0].def_value = default_home; 1611 env_vars[0].def_value = default_home;
1611 } 1612 }
1612 } 1613 }
1613 1614
1614 /* Get default locale info and use it for LANG. */ 1615 /* Get default locale info and use it for LANG. */
1615 if (GetLocaleInfo (LOCALE_USER_DEFAULT, 1616 if (GetLocaleInfo (LOCALE_USER_DEFAULT,
@@ -2082,42 +2083,42 @@ GetCachedVolumeInformation (char * root_dir)
2082 info = lookup_volume_info (root_dir); 2083 info = lookup_volume_info (root_dir);
2083 2084
2084 if (info == NULL || ! VOLINFO_STILL_VALID (root_dir, info)) 2085 if (info == NULL || ! VOLINFO_STILL_VALID (root_dir, info))
2085 { 2086 {
2086 char name[ 256 ]; 2087 char name[ 256 ];
2087 DWORD serialnum; 2088 DWORD serialnum;
2088 DWORD maxcomp; 2089 DWORD maxcomp;
2089 DWORD flags; 2090 DWORD flags;
2090 char type[ 256 ]; 2091 char type[ 256 ];
2091 2092
2092 /* Info is not cached, or is stale. */ 2093 /* Info is not cached, or is stale. */
2093 if (!GetVolumeInformation (root_dir, 2094 if (!GetVolumeInformation (root_dir,
2094 name, sizeof (name), 2095 name, sizeof (name),
2095 &serialnum, 2096 &serialnum,
2096 &maxcomp, 2097 &maxcomp,
2097 &flags, 2098 &flags,
2098 type, sizeof (type))) 2099 type, sizeof (type)))
2099 return NULL; 2100 return NULL;
2100 2101
2101 /* Cache the volume information for future use, overwriting existing 2102 /* Cache the volume information for future use, overwriting existing
2102 entry if present. */ 2103 entry if present. */
2103 if (info == NULL) 2104 if (info == NULL)
2104 { 2105 {
2105 info = (volume_info_data *) xmalloc (sizeof (volume_info_data)); 2106 info = (volume_info_data *) xmalloc (sizeof (volume_info_data));
2106 add_volume_info (root_dir, info); 2107 add_volume_info (root_dir, info);
2107 } 2108 }
2108 else 2109 else
2109 { 2110 {
2110 xfree (info->name); 2111 xfree (info->name);
2111 xfree (info->type); 2112 xfree (info->type);
2112 } 2113 }
2113 2114
2114 info->name = xstrdup (name); 2115 info->name = xstrdup (name);
2115 info->serialnum = serialnum; 2116 info->serialnum = serialnum;
2116 info->maxcomp = maxcomp; 2117 info->maxcomp = maxcomp;
2117 info->flags = flags; 2118 info->flags = flags;
2118 info->type = xstrdup (type); 2119 info->type = xstrdup (type);
2119 info->timestamp = GetTickCount (); 2120 info->timestamp = GetTickCount ();
2120 } 2121 }
2121 2122
2122 return info; 2123 return info;
2123} 2124}
@@ -4517,75 +4518,75 @@ struct {
4517 int errnum; 4518 int errnum;
4518 char * msg; 4519 char * msg;
4519} _wsa_errlist[] = { 4520} _wsa_errlist[] = {
4520 WSAEINTR , "Interrupted function call", 4521 {WSAEINTR , "Interrupted function call"},
4521 WSAEBADF , "Bad file descriptor", 4522 {WSAEBADF , "Bad file descriptor"},
4522 WSAEACCES , "Permission denied", 4523 {WSAEACCES , "Permission denied"},
4523 WSAEFAULT , "Bad address", 4524 {WSAEFAULT , "Bad address"},
4524 WSAEINVAL , "Invalid argument", 4525 {WSAEINVAL , "Invalid argument"},
4525 WSAEMFILE , "Too many open files", 4526 {WSAEMFILE , "Too many open files"},
4526 4527
4527 WSAEWOULDBLOCK , "Resource temporarily unavailable", 4528 {WSAEWOULDBLOCK , "Resource temporarily unavailable"},
4528 WSAEINPROGRESS , "Operation now in progress", 4529 {WSAEINPROGRESS , "Operation now in progress"},
4529 WSAEALREADY , "Operation already in progress", 4530 {WSAEALREADY , "Operation already in progress"},
4530 WSAENOTSOCK , "Socket operation on non-socket", 4531 {WSAENOTSOCK , "Socket operation on non-socket"},
4531 WSAEDESTADDRREQ , "Destination address required", 4532 {WSAEDESTADDRREQ , "Destination address required"},
4532 WSAEMSGSIZE , "Message too long", 4533 {WSAEMSGSIZE , "Message too long"},
4533 WSAEPROTOTYPE , "Protocol wrong type for socket", 4534 {WSAEPROTOTYPE , "Protocol wrong type for socket"},
4534 WSAENOPROTOOPT , "Bad protocol option", 4535 {WSAENOPROTOOPT , "Bad protocol option"},
4535 WSAEPROTONOSUPPORT , "Protocol not supported", 4536 {WSAEPROTONOSUPPORT , "Protocol not supported"},
4536 WSAESOCKTNOSUPPORT , "Socket type not supported", 4537 {WSAESOCKTNOSUPPORT , "Socket type not supported"},
4537 WSAEOPNOTSUPP , "Operation not supported", 4538 {WSAEOPNOTSUPP , "Operation not supported"},
4538 WSAEPFNOSUPPORT , "Protocol family not supported", 4539 {WSAEPFNOSUPPORT , "Protocol family not supported"},
4539 WSAEAFNOSUPPORT , "Address family not supported by protocol family", 4540 {WSAEAFNOSUPPORT , "Address family not supported by protocol family"},
4540 WSAEADDRINUSE , "Address already in use", 4541 {WSAEADDRINUSE , "Address already in use"},
4541 WSAEADDRNOTAVAIL , "Cannot assign requested address", 4542 {WSAEADDRNOTAVAIL , "Cannot assign requested address"},
4542 WSAENETDOWN , "Network is down", 4543 {WSAENETDOWN , "Network is down"},
4543 WSAENETUNREACH , "Network is unreachable", 4544 {WSAENETUNREACH , "Network is unreachable"},
4544 WSAENETRESET , "Network dropped connection on reset", 4545 {WSAENETRESET , "Network dropped connection on reset"},
4545 WSAECONNABORTED , "Software caused connection abort", 4546 {WSAECONNABORTED , "Software caused connection abort"},
4546 WSAECONNRESET , "Connection reset by peer", 4547 {WSAECONNRESET , "Connection reset by peer"},
4547 WSAENOBUFS , "No buffer space available", 4548 {WSAENOBUFS , "No buffer space available"},
4548 WSAEISCONN , "Socket is already connected", 4549 {WSAEISCONN , "Socket is already connected"},
4549 WSAENOTCONN , "Socket is not connected", 4550 {WSAENOTCONN , "Socket is not connected"},
4550 WSAESHUTDOWN , "Cannot send after socket shutdown", 4551 {WSAESHUTDOWN , "Cannot send after socket shutdown"},
4551 WSAETOOMANYREFS , "Too many references", /* not sure */ 4552 {WSAETOOMANYREFS , "Too many references"}, /* not sure */
4552 WSAETIMEDOUT , "Connection timed out", 4553 {WSAETIMEDOUT , "Connection timed out"},
4553 WSAECONNREFUSED , "Connection refused", 4554 {WSAECONNREFUSED , "Connection refused"},
4554 WSAELOOP , "Network loop", /* not sure */ 4555 {WSAELOOP , "Network loop"}, /* not sure */
4555 WSAENAMETOOLONG , "Name is too long", 4556 {WSAENAMETOOLONG , "Name is too long"},
4556 WSAEHOSTDOWN , "Host is down", 4557 {WSAEHOSTDOWN , "Host is down"},
4557 WSAEHOSTUNREACH , "No route to host", 4558 {WSAEHOSTUNREACH , "No route to host"},
4558 WSAENOTEMPTY , "Buffer not empty", /* not sure */ 4559 {WSAENOTEMPTY , "Buffer not empty"}, /* not sure */
4559 WSAEPROCLIM , "Too many processes", 4560 {WSAEPROCLIM , "Too many processes"},
4560 WSAEUSERS , "Too many users", /* not sure */ 4561 {WSAEUSERS , "Too many users"}, /* not sure */
4561 WSAEDQUOT , "Double quote in host name", /* really not sure */ 4562 {WSAEDQUOT , "Double quote in host name"}, /* really not sure */
4562 WSAESTALE , "Data is stale", /* not sure */ 4563 {WSAESTALE , "Data is stale"}, /* not sure */
4563 WSAEREMOTE , "Remote error", /* not sure */ 4564 {WSAEREMOTE , "Remote error"}, /* not sure */
4564 4565
4565 WSASYSNOTREADY , "Network subsystem is unavailable", 4566 {WSASYSNOTREADY , "Network subsystem is unavailable"},
4566 WSAVERNOTSUPPORTED , "WINSOCK.DLL version out of range", 4567 {WSAVERNOTSUPPORTED , "WINSOCK.DLL version out of range"},
4567 WSANOTINITIALISED , "Winsock not initialized successfully", 4568 {WSANOTINITIALISED , "Winsock not initialized successfully"},
4568 WSAEDISCON , "Graceful shutdown in progress", 4569 {WSAEDISCON , "Graceful shutdown in progress"},
4569#ifdef WSAENOMORE 4570#ifdef WSAENOMORE
4570 WSAENOMORE , "No more operations allowed", /* not sure */ 4571 {WSAENOMORE , "No more operations allowed"}, /* not sure */
4571 WSAECANCELLED , "Operation cancelled", /* not sure */ 4572 {WSAECANCELLED , "Operation cancelled"}, /* not sure */
4572 WSAEINVALIDPROCTABLE , "Invalid procedure table from service provider", 4573 {WSAEINVALIDPROCTABLE , "Invalid procedure table from service provider"},
4573 WSAEINVALIDPROVIDER , "Invalid service provider version number", 4574 {WSAEINVALIDPROVIDER , "Invalid service provider version number"},
4574 WSAEPROVIDERFAILEDINIT , "Unable to initialize a service provider", 4575 {WSAEPROVIDERFAILEDINIT , "Unable to initialize a service provider"},
4575 WSASYSCALLFAILURE , "System call failure", 4576 {WSASYSCALLFAILURE , "System call failure"},
4576 WSASERVICE_NOT_FOUND , "Service not found", /* not sure */ 4577 {WSASERVICE_NOT_FOUND , "Service not found"}, /* not sure */
4577 WSATYPE_NOT_FOUND , "Class type not found", 4578 {WSATYPE_NOT_FOUND , "Class type not found"},
4578 WSA_E_NO_MORE , "No more resources available", /* really not sure */ 4579 {WSA_E_NO_MORE , "No more resources available"}, /* really not sure */
4579 WSA_E_CANCELLED , "Operation already cancelled", /* really not sure */ 4580 {WSA_E_CANCELLED , "Operation already cancelled"}, /* really not sure */
4580 WSAEREFUSED , "Operation refused", /* not sure */ 4581 {WSAEREFUSED , "Operation refused"}, /* not sure */
4581#endif 4582#endif
4582 4583
4583 WSAHOST_NOT_FOUND , "Host not found", 4584 {WSAHOST_NOT_FOUND , "Host not found"},
4584 WSATRY_AGAIN , "Authoritative host not found during name lookup", 4585 {WSATRY_AGAIN , "Authoritative host not found during name lookup"},
4585 WSANO_RECOVERY , "Non-recoverable error during name lookup", 4586 {WSANO_RECOVERY , "Non-recoverable error during name lookup"},
4586 WSANO_DATA , "Valid name, no data record of requested type", 4587 {WSANO_DATA , "Valid name, no data record of requested type"},
4587 4588
4588 -1, NULL 4589 {-1, NULL}
4589}; 4590};
4590 4591
4591char * 4592char *
diff --git a/src/xdisp.c b/src/xdisp.c
index f286000c966..bbbf37b68ac 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -754,7 +754,7 @@ static void setup_for_ellipsis (struct it *, int);
754static void mark_window_display_accurate_1 (struct window *, int); 754static void mark_window_display_accurate_1 (struct window *, int);
755static int single_display_spec_string_p (Lisp_Object, Lisp_Object); 755static int single_display_spec_string_p (Lisp_Object, Lisp_Object);
756static int display_prop_string_p (Lisp_Object, Lisp_Object); 756static int display_prop_string_p (Lisp_Object, Lisp_Object);
757static int cursor_row_p (struct window *, struct glyph_row *); 757static int cursor_row_p (struct glyph_row *);
758static int redisplay_mode_lines (Lisp_Object, int); 758static int redisplay_mode_lines (Lisp_Object, int);
759static char *decode_mode_spec_coding (Lisp_Object, char *, int); 759static char *decode_mode_spec_coding (Lisp_Object, char *, int);
760 760
@@ -823,8 +823,7 @@ static int display_mode_lines (struct window *);
823static int display_mode_line (struct window *, enum face_id, Lisp_Object); 823static int display_mode_line (struct window *, enum face_id, Lisp_Object);
824static int display_mode_element (struct it *, int, int, int, Lisp_Object, Lisp_Object, int); 824static int display_mode_element (struct it *, int, int, int, Lisp_Object, Lisp_Object, int);
825static int store_mode_line_string (const char *, Lisp_Object, int, int, int, Lisp_Object); 825static int store_mode_line_string (const char *, Lisp_Object, int, int, int, Lisp_Object);
826static const char *decode_mode_spec (struct window *, int, int, int, 826static const char *decode_mode_spec (struct window *, int, int, Lisp_Object *);
827 Lisp_Object *);
828static void display_menu_bar (struct window *); 827static void display_menu_bar (struct window *);
829static int display_count_lines (EMACS_INT, EMACS_INT, EMACS_INT, int, 828static int display_count_lines (EMACS_INT, EMACS_INT, EMACS_INT, int,
830 EMACS_INT *); 829 EMACS_INT *);
@@ -4420,20 +4419,18 @@ display_prop_string_p (Lisp_Object prop, Lisp_Object string)
4420 return 0; 4419 return 0;
4421} 4420}
4422 4421
4423/* Look for STRING in overlays and text properties in W's buffer, 4422/* Look for STRING in overlays and text properties in the current
4424 between character positions FROM and TO (excluding TO). 4423 buffer, between character positions FROM and TO (excluding TO).
4425 BACK_P non-zero means look back (in this case, TO is supposed to be 4424 BACK_P non-zero means look back (in this case, TO is supposed to be
4426 less than FROM). 4425 less than FROM).
4427 Value is the first character position where STRING was found, or 4426 Value is the first character position where STRING was found, or
4428 zero if it wasn't found before hitting TO. 4427 zero if it wasn't found before hitting TO.
4429 4428
4430 W's buffer must be current.
4431
4432 This function may only use code that doesn't eval because it is 4429 This function may only use code that doesn't eval because it is
4433 called asynchronously from note_mouse_highlight. */ 4430 called asynchronously from note_mouse_highlight. */
4434 4431
4435static EMACS_INT 4432static EMACS_INT
4436string_buffer_position_lim (struct window *w, Lisp_Object string, 4433string_buffer_position_lim (Lisp_Object string,
4437 EMACS_INT from, EMACS_INT to, int back_p) 4434 EMACS_INT from, EMACS_INT to, int back_p)
4438{ 4435{
4439 Lisp_Object limit, prop, pos; 4436 Lisp_Object limit, prop, pos;
@@ -4471,27 +4468,25 @@ string_buffer_position_lim (struct window *w, Lisp_Object string,
4471 return found ? XINT (pos) : 0; 4468 return found ? XINT (pos) : 0;
4472} 4469}
4473 4470
4474/* Determine which buffer position in W's buffer STRING comes from. 4471/* Determine which buffer position in current buffer STRING comes from.
4475 AROUND_CHARPOS is an approximate position where it could come from. 4472 AROUND_CHARPOS is an approximate position where it could come from.
4476 Value is the buffer position or 0 if it couldn't be determined. 4473 Value is the buffer position or 0 if it couldn't be determined.
4477 4474
4478 W's buffer must be current.
4479
4480 This function is necessary because we don't record buffer positions 4475 This function is necessary because we don't record buffer positions
4481 in glyphs generated from strings (to keep struct glyph small). 4476 in glyphs generated from strings (to keep struct glyph small).
4482 This function may only use code that doesn't eval because it is 4477 This function may only use code that doesn't eval because it is
4483 called asynchronously from note_mouse_highlight. */ 4478 called asynchronously from note_mouse_highlight. */
4484 4479
4485EMACS_INT 4480static EMACS_INT
4486string_buffer_position (struct window *w, Lisp_Object string, EMACS_INT around_charpos) 4481string_buffer_position (Lisp_Object string, EMACS_INT around_charpos)
4487{ 4482{
4488 const int MAX_DISTANCE = 1000; 4483 const int MAX_DISTANCE = 1000;
4489 EMACS_INT found = string_buffer_position_lim (w, string, around_charpos, 4484 EMACS_INT found = string_buffer_position_lim (string, around_charpos,
4490 around_charpos + MAX_DISTANCE, 4485 around_charpos + MAX_DISTANCE,
4491 0); 4486 0);
4492 4487
4493 if (!found) 4488 if (!found)
4494 found = string_buffer_position_lim (w, string, around_charpos, 4489 found = string_buffer_position_lim (string, around_charpos,
4495 around_charpos - MAX_DISTANCE, 1); 4490 around_charpos - MAX_DISTANCE, 1);
4496 return found; 4491 return found;
4497} 4492}
@@ -7967,7 +7962,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte)
7967 c = string_char_and_length (msg + i, &char_bytes); 7962 c = string_char_and_length (msg + i, &char_bytes);
7968 work[0] = (ASCII_CHAR_P (c) 7963 work[0] = (ASCII_CHAR_P (c)
7969 ? c 7964 ? c
7970 : multibyte_char_to_unibyte (c, Qnil)); 7965 : multibyte_char_to_unibyte (c));
7971 insert_1_both (work, 1, 1, 1, 0, 0); 7966 insert_1_both (work, 1, 1, 1, 0, 0);
7972 } 7967 }
7973 } 7968 }
@@ -9228,7 +9223,7 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby
9228 c = string_char_and_length (msg + i, &n); 9223 c = string_char_and_length (msg + i, &n);
9229 work[0] = (ASCII_CHAR_P (c) 9224 work[0] = (ASCII_CHAR_P (c)
9230 ? c 9225 ? c
9231 : multibyte_char_to_unibyte (c, Qnil)); 9226 : multibyte_char_to_unibyte (c));
9232 insert_1_both (work, 1, 1, 1, 0, 0); 9227 insert_1_both (work, 1, 1, 1, 0, 0);
9233 } 9228 }
9234 } 9229 }
@@ -12731,7 +12726,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
12731 EMACS_INT tem; 12726 EMACS_INT tem;
12732 12727
12733 str = glyph->object; 12728 str = glyph->object;
12734 tem = string_buffer_position_lim (w, str, pos, pos_after, 0); 12729 tem = string_buffer_position_lim (str, pos, pos_after, 0);
12735 if (tem == 0 /* from overlay */ 12730 if (tem == 0 /* from overlay */
12736 || pos <= tem) 12731 || pos <= tem)
12737 { 12732 {
@@ -13457,7 +13452,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
13457 && row < w->current_matrix->rows 13452 && row < w->current_matrix->rows
13458 + w->current_matrix->nrows - 1 13453 + w->current_matrix->nrows - 1
13459 && MATRIX_ROW_START_CHARPOS (row+1) == PT 13454 && MATRIX_ROW_START_CHARPOS (row+1) == PT
13460 && !cursor_row_p (w, row)) 13455 && !cursor_row_p (row))
13461 ++row; 13456 ++row;
13462 13457
13463 /* If within the scroll margin, scroll. Note that 13458 /* If within the scroll margin, scroll. Note that
@@ -13509,7 +13504,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
13509 skip forward over overlay strings. */ 13504 skip forward over overlay strings. */
13510 while (MATRIX_ROW_BOTTOM_Y (row) < last_y 13505 while (MATRIX_ROW_BOTTOM_Y (row) < last_y
13511 && MATRIX_ROW_END_CHARPOS (row) == PT 13506 && MATRIX_ROW_END_CHARPOS (row) == PT
13512 && !cursor_row_p (w, row)) 13507 && !cursor_row_p (row))
13513 ++row; 13508 ++row;
13514 13509
13515 /* If within the scroll margin, scroll. */ 13510 /* If within the scroll margin, scroll. */
@@ -13605,7 +13600,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
13605 { 13600 {
13606 if (MATRIX_ROW_START_CHARPOS (row) <= PT 13601 if (MATRIX_ROW_START_CHARPOS (row) <= PT
13607 && PT <= MATRIX_ROW_END_CHARPOS (row) 13602 && PT <= MATRIX_ROW_END_CHARPOS (row)
13608 && cursor_row_p (w, row)) 13603 && cursor_row_p (row))
13609 rv |= set_cursor_from_row (w, row, w->current_matrix, 13604 rv |= set_cursor_from_row (w, row, w->current_matrix,
13610 0, 0, 0, 0); 13605 0, 0, 0, 0);
13611 /* As soon as we've found the first suitable row 13606 /* As soon as we've found the first suitable row
@@ -13644,7 +13639,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
13644 } 13639 }
13645 while (MATRIX_ROW_BOTTOM_Y (row) < last_y 13640 while (MATRIX_ROW_BOTTOM_Y (row) < last_y
13646 && MATRIX_ROW_START_CHARPOS (row) == PT 13641 && MATRIX_ROW_START_CHARPOS (row) == PT
13647 && cursor_row_p (w, row)); 13642 && cursor_row_p (row));
13648 } 13643 }
13649 } 13644 }
13650 } 13645 }
@@ -16968,11 +16963,11 @@ highlight_trailing_whitespace (struct frame *f, struct glyph_row *row)
16968} 16963}
16969 16964
16970 16965
16971/* Value is non-zero if glyph row ROW in window W should be 16966/* Value is non-zero if glyph row ROW should be
16972 used to hold the cursor. */ 16967 used to hold the cursor. */
16973 16968
16974static int 16969static int
16975cursor_row_p (struct window *w, struct glyph_row *row) 16970cursor_row_p (struct glyph_row *row)
16976{ 16971{
16977 int result = 1; 16972 int result = 1;
16978 16973
@@ -17885,7 +17880,7 @@ display_line (struct it *it)
17885 && !MATRIX_ROW (it->w->desired_matrix, cvpos)->ends_at_zv_p)) 17880 && !MATRIX_ROW (it->w->desired_matrix, cvpos)->ends_at_zv_p))
17886 && PT >= MATRIX_ROW_START_CHARPOS (row) 17881 && PT >= MATRIX_ROW_START_CHARPOS (row)
17887 && PT <= MATRIX_ROW_END_CHARPOS (row) 17882 && PT <= MATRIX_ROW_END_CHARPOS (row)
17888 && cursor_row_p (it->w, row)) 17883 && cursor_row_p (row))
17889 set_cursor_from_row (it->w, row, it->w->desired_matrix, 0, 0, 0, 0); 17884 set_cursor_from_row (it->w, row, it->w->desired_matrix, 0, 0, 0, 0);
17890 17885
17891 /* Highlight trailing whitespace. */ 17886 /* Highlight trailing whitespace. */
@@ -18537,7 +18532,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
18537 charpos = (STRING_MULTIBYTE (elt) 18532 charpos = (STRING_MULTIBYTE (elt)
18538 ? string_byte_to_char (elt, bytepos) 18533 ? string_byte_to_char (elt, bytepos)
18539 : bytepos); 18534 : bytepos);
18540 spec = decode_mode_spec (it->w, c, field, prec, &string); 18535 spec = decode_mode_spec (it->w, c, field, &string);
18541 multibyte = STRINGP (string) && STRING_MULTIBYTE (string); 18536 multibyte = STRINGP (string) && STRING_MULTIBYTE (string);
18542 18537
18543 switch (mode_line_target) 18538 switch (mode_line_target)
@@ -19208,9 +19203,8 @@ decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_
19208} 19203}
19209 19204
19210/* Return a string for the output of a mode line %-spec for window W, 19205/* Return a string for the output of a mode line %-spec for window W,
19211 generated by character C. PRECISION >= 0 means don't return a 19206 generated by character C. FIELD_WIDTH > 0 means pad the string
19212 string longer than that value. FIELD_WIDTH > 0 means pad the 19207 returned with spaces to that value. Return a Lisp string in
19213 string returned with spaces to that value. Return a Lisp string in
19214 *STRING if the resulting string is taken from that Lisp string. 19208 *STRING if the resulting string is taken from that Lisp string.
19215 19209
19216 Note we operate on the current buffer for most purposes, 19210 Note we operate on the current buffer for most purposes,
@@ -19220,7 +19214,7 @@ static char lots_of_dashes[] = "------------------------------------------------
19220 19214
19221static const char * 19215static const char *
19222decode_mode_spec (struct window *w, register int c, int field_width, 19216decode_mode_spec (struct window *w, register int c, int field_width,
19223 int precision, Lisp_Object *string) 19217 Lisp_Object *string)
19224{ 19218{
19225 Lisp_Object obj; 19219 Lisp_Object obj;
19226 struct frame *f = XFRAME (WINDOW_FRAME (w)); 19220 struct frame *f = XFRAME (WINDOW_FRAME (w));
@@ -24317,7 +24311,7 @@ mouse_face_from_buffer_pos (Lisp_Object window,
24317 END_CHARPOS, or if they come from an overlay. */ 24311 END_CHARPOS, or if they come from an overlay. */
24318 if (EQ (glyph->object, before_string)) 24312 if (EQ (glyph->object, before_string))
24319 { 24313 {
24320 pos = string_buffer_position (w, before_string, 24314 pos = string_buffer_position (before_string,
24321 start_charpos); 24315 start_charpos);
24322 /* If pos == 0, it means before_string came from an 24316 /* If pos == 0, it means before_string came from an
24323 overlay, not from a buffer position. */ 24317 overlay, not from a buffer position. */
@@ -24326,7 +24320,7 @@ mouse_face_from_buffer_pos (Lisp_Object window,
24326 } 24320 }
24327 else if (EQ (glyph->object, after_string)) 24321 else if (EQ (glyph->object, after_string))
24328 { 24322 {
24329 pos = string_buffer_position (w, after_string, end_charpos); 24323 pos = string_buffer_position (after_string, end_charpos);
24330 if (!pos || (pos >= start_charpos && pos < end_charpos)) 24324 if (!pos || (pos >= start_charpos && pos < end_charpos))
24331 break; 24325 break;
24332 } 24326 }
@@ -24368,7 +24362,7 @@ mouse_face_from_buffer_pos (Lisp_Object window,
24368 END_CHARPOS, or if they come from an overlay. */ 24362 END_CHARPOS, or if they come from an overlay. */
24369 if (EQ (glyph->object, before_string)) 24363 if (EQ (glyph->object, before_string))
24370 { 24364 {
24371 pos = string_buffer_position (w, before_string, start_charpos); 24365 pos = string_buffer_position (before_string, start_charpos);
24372 /* If pos == 0, it means before_string came from an 24366 /* If pos == 0, it means before_string came from an
24373 overlay, not from a buffer position. */ 24367 overlay, not from a buffer position. */
24374 if (!pos || (pos >= start_charpos && pos < end_charpos)) 24368 if (!pos || (pos >= start_charpos && pos < end_charpos))
@@ -24376,7 +24370,7 @@ mouse_face_from_buffer_pos (Lisp_Object window,
24376 } 24370 }
24377 else if (EQ (glyph->object, after_string)) 24371 else if (EQ (glyph->object, after_string))
24378 { 24372 {
24379 pos = string_buffer_position (w, after_string, end_charpos); 24373 pos = string_buffer_position (after_string, end_charpos);
24380 if (!pos || (pos >= start_charpos && pos < end_charpos)) 24374 if (!pos || (pos >= start_charpos && pos < end_charpos))
24381 break; 24375 break;
24382 } 24376 }
@@ -24434,13 +24428,13 @@ mouse_face_from_buffer_pos (Lisp_Object window,
24434 END_CHARPOS, or if they come from an overlay. */ 24428 END_CHARPOS, or if they come from an overlay. */
24435 if (EQ (end->object, before_string)) 24429 if (EQ (end->object, before_string))
24436 { 24430 {
24437 pos = string_buffer_position (w, before_string, start_charpos); 24431 pos = string_buffer_position (before_string, start_charpos);
24438 if (!pos || (pos >= start_charpos && pos < end_charpos)) 24432 if (!pos || (pos >= start_charpos && pos < end_charpos))
24439 break; 24433 break;
24440 } 24434 }
24441 else if (EQ (end->object, after_string)) 24435 else if (EQ (end->object, after_string))
24442 { 24436 {
24443 pos = string_buffer_position (w, after_string, end_charpos); 24437 pos = string_buffer_position (after_string, end_charpos);
24444 if (!pos || (pos >= start_charpos && pos < end_charpos)) 24438 if (!pos || (pos >= start_charpos && pos < end_charpos))
24445 break; 24439 break;
24446 } 24440 }
@@ -24484,13 +24478,13 @@ mouse_face_from_buffer_pos (Lisp_Object window,
24484 END_CHARPOS, or if they come from an overlay. */ 24478 END_CHARPOS, or if they come from an overlay. */
24485 if (EQ (end->object, before_string)) 24479 if (EQ (end->object, before_string))
24486 { 24480 {
24487 pos = string_buffer_position (w, before_string, start_charpos); 24481 pos = string_buffer_position (before_string, start_charpos);
24488 if (!pos || (pos >= start_charpos && pos < end_charpos)) 24482 if (!pos || (pos >= start_charpos && pos < end_charpos))
24489 break; 24483 break;
24490 } 24484 }
24491 else if (EQ (end->object, after_string)) 24485 else if (EQ (end->object, after_string))
24492 { 24486 {
24493 pos = string_buffer_position (w, after_string, end_charpos); 24487 pos = string_buffer_position (after_string, end_charpos);
24494 if (!pos || (pos >= start_charpos && pos < end_charpos)) 24488 if (!pos || (pos >= start_charpos && pos < end_charpos))
24495 break; 24489 break;
24496 } 24490 }
@@ -25473,7 +25467,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
25473 check if the text under it has one. */ 25467 check if the text under it has one. */
25474 struct glyph_row *r = MATRIX_ROW (w->current_matrix, vpos); 25468 struct glyph_row *r = MATRIX_ROW (w->current_matrix, vpos);
25475 EMACS_INT start = MATRIX_ROW_START_CHARPOS (r); 25469 EMACS_INT start = MATRIX_ROW_START_CHARPOS (r);
25476 pos = string_buffer_position (w, object, start); 25470 pos = string_buffer_position (object, start);
25477 if (pos > 0) 25471 if (pos > 0)
25478 { 25472 {
25479 mouse_face = get_char_property_and_overlay 25473 mouse_face = get_char_property_and_overlay
@@ -25583,7 +25577,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
25583 struct glyph_row *r 25577 struct glyph_row *r
25584 = MATRIX_ROW (w->current_matrix, vpos); 25578 = MATRIX_ROW (w->current_matrix, vpos);
25585 EMACS_INT start = MATRIX_ROW_START_CHARPOS (r); 25579 EMACS_INT start = MATRIX_ROW_START_CHARPOS (r);
25586 EMACS_INT p = string_buffer_position (w, obj, start); 25580 EMACS_INT p = string_buffer_position (obj, start);
25587 if (p > 0) 25581 if (p > 0)
25588 { 25582 {
25589 help = Fget_char_property (make_number (p), 25583 help = Fget_char_property (make_number (p),
@@ -25639,7 +25633,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
25639 struct glyph_row *r 25633 struct glyph_row *r
25640 = MATRIX_ROW (w->current_matrix, vpos); 25634 = MATRIX_ROW (w->current_matrix, vpos);
25641 EMACS_INT start = MATRIX_ROW_START_CHARPOS (r); 25635 EMACS_INT start = MATRIX_ROW_START_CHARPOS (r);
25642 EMACS_INT p = string_buffer_position (w, obj, start); 25636 EMACS_INT p = string_buffer_position (obj, start);
25643 if (p > 0) 25637 if (p > 0)
25644 pointer = Fget_char_property (make_number (p), 25638 pointer = Fget_char_property (make_number (p),
25645 Qpointer, w->buffer); 25639 Qpointer, w->buffer);
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-13 04:49:55 +0000