commit de00a933e4b35b42398582eaba58531e5fdd46ca (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Fri Mar 27 00:58:31 2020 -0700 Treat out-of-range positions consistently If a position argument to get-byte etc. is an out-of-range integer, treat it the same regardless of whether it is a fixnum or a bignum. * src/buffer.c (fix_position): New function. * src/buffer.c (validate_region): * src/character.c (Fget_byte): * src/coding.c (Ffind_coding_systems_region_internal) (Fcheck_coding_systems_region): * src/composite.c (Ffind_composition_internal): * src/editfns.c (Fposition_bytes, Fchar_after, Fchar_before) (Finsert_buffer_substring, Fcompare_buffer_substrings) (Fnarrow_to_region): * src/fns.c (Fsecure_hash_algorithms): * src/font.c (Finternal_char_font, Ffont_at): * src/fringe.c (Ffringe_bitmaps_at_pos): * src/search.c (search_command): * src/textprop.c (get_char_property_and_overlay): * src/window.c (Fpos_visible_in_window_p): * src/xdisp.c (Fwindow_text_pixel_size): Use it instead of CHECK_FIXNUM_COERCE_MARKER, so that the code is simpler and treats bignums consistently with fixnums. * src/buffer.h (CHECK_FIXNUM_COERCE_MARKER): Define here rather than in lisp.h, and reimplement in terms of fix_position so that it treats bignums consistently with fixnums. * src/lisp.h (CHECK_FIXNUM_COERCE_MARKER): Move to buffer.h. * src/textprop.c (validate_interval_range): Signal with original bounds rather than modified ones. diff --git a/src/buffer.c b/src/buffer.c index cc7d4e4817..70598a7a22 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -131,6 +131,23 @@ CHECK_OVERLAY (Lisp_Object x) CHECK_TYPE (OVERLAYP (x), Qoverlayp, x); } +/* Convert the position POS to an EMACS_INT that fits in a fixnum. + Yield POS's value if POS is already a fixnum, POS's marker position + if POS is a marker, and MOST_NEGATIVE_FIXNUM or + MOST_POSITIVE_FIXNUM if POS is a negative or positive bignum. + Signal an error if POS is not of the proper form. */ + +EMACS_INT +fix_position (Lisp_Object pos) +{ + if (FIXNUMP (pos)) + return XFIXNUM (pos); + if (MARKERP (pos)) + return marker_position (pos); + CHECK_TYPE (BIGNUMP (pos), Qinteger_or_marker_p, pos); + return !NILP (Fnatnump (pos)) ? MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM; +} + /* These setters are used only in this file, so they can be private. The public setters are inline functions defined in buffer.h. */ static void @@ -2257,19 +2274,20 @@ so the buffer is truly empty after this. */) } void -validate_region (register Lisp_Object *b, register Lisp_Object *e) +validate_region (Lisp_Object *b, Lisp_Object *e) { - CHECK_FIXNUM_COERCE_MARKER (*b); - CHECK_FIXNUM_COERCE_MARKER (*e); + EMACS_INT beg = fix_position (*b), end = fix_position (*e); - if (XFIXNUM (*b) > XFIXNUM (*e)) + if (end < beg) { - Lisp_Object tem; - tem = *b; *b = *e; *e = tem; + EMACS_INT tem = beg; beg = end; end = tem; } - if (! (BEGV <= XFIXNUM (*b) && XFIXNUM (*e) <= ZV)) + if (! (BEGV <= beg && end <= ZV)) args_out_of_range_3 (Fcurrent_buffer (), *b, *e); + + *b = make_fixnum (beg); + *e = make_fixnum (end); } /* Advance BYTE_POS up to a character boundary diff --git a/src/buffer.h b/src/buffer.h index fd05fdd37d..31f497ea40 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1150,6 +1150,8 @@ extern Lisp_Object interval_insert_behind_hooks; extern Lisp_Object interval_insert_in_front_hooks; +extern EMACS_INT fix_position (Lisp_Object); +#define CHECK_FIXNUM_COERCE_MARKER(x) ((x) = make_fixnum (fix_position (x))) extern void delete_all_overlays (struct buffer *); extern void reset_buffer (struct buffer *); extern void compact_buffer (struct buffer *); diff --git a/src/character.c b/src/character.c index 5d419a2e83..d71cb3f145 100644 --- a/src/character.c +++ b/src/character.c @@ -931,10 +931,10 @@ character is not ASCII nor 8-bit character, an error is signaled. */) } else { - CHECK_FIXNUM_COERCE_MARKER (position); - if (XFIXNUM (position) < BEGV || XFIXNUM (position) >= ZV) + EMACS_INT fixed_pos = fix_position (position); + if (! (BEGV <= fixed_pos && fixed_pos < ZV)) args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); - pos = XFIXNAT (position); + pos = fixed_pos; p = CHAR_POS_ADDR (pos); } if (NILP (BVAR (current_buffer, enable_multibyte_characters))) diff --git a/src/coding.c b/src/coding.c index 8b54281c0b..0bea2a0c2b 100644 --- a/src/coding.c +++ b/src/coding.c @@ -9023,23 +9023,23 @@ DEFUN ("find-coding-systems-region-internal", } else { - CHECK_FIXNUM_COERCE_MARKER (start); - CHECK_FIXNUM_COERCE_MARKER (end); - if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) + EMACS_INT s = fix_position (start); + EMACS_INT e = fix_position (end); + if (! (BEG <= s && s <= e && e <= Z)) args_out_of_range (start, end); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qt; - start_byte = CHAR_TO_BYTE (XFIXNUM (start)); - end_byte = CHAR_TO_BYTE (XFIXNUM (end)); - if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) + start_byte = CHAR_TO_BYTE (s); + end_byte = CHAR_TO_BYTE (e); + if (e - s == end_byte - start_byte) return Qt; - if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) + if (s < GPT && GPT < e) { - if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) - move_gap_both (XFIXNUM (start), start_byte); + if (GPT - s < e - GPT) + move_gap_both (s, start_byte); else - move_gap_both (XFIXNUM (end), end_byte); + move_gap_both (e, end_byte); } } @@ -9277,25 +9277,25 @@ is nil. */) } else { - CHECK_FIXNUM_COERCE_MARKER (start); - CHECK_FIXNUM_COERCE_MARKER (end); - if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end)) + EMACS_INT s = fix_position (start); + EMACS_INT e = fix_position (end); + if (! (BEG <= s && s <= e && e <= Z)) args_out_of_range (start, end); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qnil; - start_byte = CHAR_TO_BYTE (XFIXNUM (start)); - end_byte = CHAR_TO_BYTE (XFIXNUM (end)); - if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte) + start_byte = CHAR_TO_BYTE (s); + end_byte = CHAR_TO_BYTE (e); + if (e - s == end_byte - start_byte) return Qnil; - if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT) + if (s < GPT && GPT < e) { - if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT)) - move_gap_both (XFIXNUM (start), start_byte); + if (GPT - s < e - GPT) + move_gap_both (s, start_byte); else - move_gap_both (XFIXNUM (end), end_byte); + move_gap_both (e, end_byte); } - pos = XFIXNUM (start); + pos = s; } list = Qnil; diff --git a/src/composite.c b/src/composite.c index 84de334ce0..a00a4541f5 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1839,27 +1839,24 @@ See `find-composition' for more details. */) ptrdiff_t start, end, from, to; int id; - CHECK_FIXNUM_COERCE_MARKER (pos); + EMACS_INT fixed_pos = fix_position (pos); if (!NILP (limit)) - { - CHECK_FIXNUM_COERCE_MARKER (limit); - to = min (XFIXNUM (limit), ZV); - } + to = clip_to_bounds (PTRDIFF_MIN, fix_position (limit), ZV); else to = -1; if (!NILP (string)) { CHECK_STRING (string); - if (XFIXNUM (pos) < 0 || XFIXNUM (pos) > SCHARS (string)) + if (! (0 <= fixed_pos && fixed_pos <= SCHARS (string))) args_out_of_range (string, pos); } else { - if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) > ZV) + if (! (BEGV <= fixed_pos && fixed_pos <= ZV)) args_out_of_range (Fcurrent_buffer (), pos); } - from = XFIXNUM (pos); + from = fixed_pos; if (!find_composition (from, to, &start, &end, &prop, string)) { @@ -1870,12 +1867,12 @@ See `find-composition' for more details. */) return list3 (make_fixnum (start), make_fixnum (end), gstring); return Qnil; } - if ((end <= XFIXNUM (pos) || start > XFIXNUM (pos))) + if (! (start <= fixed_pos && fixed_pos < end)) { ptrdiff_t s, e; if (find_automatic_composition (from, to, &s, &e, &gstring, string) - && (e <= XFIXNUM (pos) ? e > end : s < start)) + && (e <= fixed_pos ? e > end : s < start)) return list3 (make_fixnum (s), make_fixnum (e), gstring); } if (!composition_valid_p (start, end, prop)) diff --git a/src/editfns.c b/src/editfns.c index cbc1082b2c..90520d0dce 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -948,10 +948,10 @@ DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0, If POSITION is out of range, the value is nil. */) (Lisp_Object position) { - CHECK_FIXNUM_COERCE_MARKER (position); - if (XFIXNUM (position) < BEG || XFIXNUM (position) > Z) + EMACS_INT pos = fix_position (position); + if (! (BEG <= pos && pos <= Z)) return Qnil; - return make_fixnum (CHAR_TO_BYTE (XFIXNUM (position))); + return make_fixnum (CHAR_TO_BYTE (pos)); } DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0, @@ -1068,11 +1068,11 @@ If POS is out of range, the value is nil. */) } else { - CHECK_FIXNUM_COERCE_MARKER (pos); - if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) >= ZV) + EMACS_INT p = fix_position (pos); + if (! (BEGV <= p && p < ZV)) return Qnil; - pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); + pos_byte = CHAR_TO_BYTE (p); } return make_fixnum (FETCH_CHAR (pos_byte)); @@ -1102,12 +1102,12 @@ If POS is out of range, the value is nil. */) } else { - CHECK_FIXNUM_COERCE_MARKER (pos); + EMACS_INT p = fix_position (pos); - if (XFIXNUM (pos) <= BEGV || XFIXNUM (pos) > ZV) + if (! (BEGV < p && p <= ZV)) return Qnil; - pos_byte = CHAR_TO_BYTE (XFIXNUM (pos)); + pos_byte = CHAR_TO_BYTE (p); } if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) @@ -1726,21 +1726,8 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */) if (!BUFFER_LIVE_P (bp)) error ("Selecting deleted buffer"); - if (NILP (start)) - b = BUF_BEGV (bp); - else - { - CHECK_FIXNUM_COERCE_MARKER (start); - b = XFIXNUM (start); - } - if (NILP (end)) - e = BUF_ZV (bp); - else - { - CHECK_FIXNUM_COERCE_MARKER (end); - e = XFIXNUM (end); - } - + b = !NILP (start) ? fix_position (start) : BUF_BEGV (bp); + e = !NILP (end) ? fix_position (end) : BUF_ZV (bp); if (b > e) temp = b, b = e, e = temp; @@ -1794,21 +1781,8 @@ determines whether case is significant or ignored. */) error ("Selecting deleted buffer"); } - if (NILP (start1)) - begp1 = BUF_BEGV (bp1); - else - { - CHECK_FIXNUM_COERCE_MARKER (start1); - begp1 = XFIXNUM (start1); - } - if (NILP (end1)) - endp1 = BUF_ZV (bp1); - else - { - CHECK_FIXNUM_COERCE_MARKER (end1); - endp1 = XFIXNUM (end1); - } - + begp1 = !NILP (start1) ? fix_position (start1) : BUF_BEGV (bp1); + endp1 = !NILP (end1) ? fix_position (end1) : BUF_ZV (bp1); if (begp1 > endp1) temp = begp1, begp1 = endp1, endp1 = temp; @@ -1832,21 +1806,8 @@ determines whether case is significant or ignored. */) error ("Selecting deleted buffer"); } - if (NILP (start2)) - begp2 = BUF_BEGV (bp2); - else - { - CHECK_FIXNUM_COERCE_MARKER (start2); - begp2 = XFIXNUM (start2); - } - if (NILP (end2)) - endp2 = BUF_ZV (bp2); - else - { - CHECK_FIXNUM_COERCE_MARKER (end2); - endp2 = XFIXNUM (end2); - } - + begp2 = !NILP (start2) ? fix_position (start2) : BUF_BEGV (bp2); + endp2 = !NILP (end2) ? fix_position (end2) : BUF_ZV (bp2); if (begp2 > endp2) temp = begp2, begp2 = endp2, endp2 = temp; @@ -2700,29 +2661,27 @@ See also `save-restriction'. When calling from Lisp, pass two arguments START and END: positions (integers or markers) bounding the text that should remain visible. */) - (register Lisp_Object start, Lisp_Object end) + (Lisp_Object start, Lisp_Object end) { - CHECK_FIXNUM_COERCE_MARKER (start); - CHECK_FIXNUM_COERCE_MARKER (end); + EMACS_INT s = fix_position (start), e = fix_position (end); - if (XFIXNUM (start) > XFIXNUM (end)) + if (e < s) { - Lisp_Object tem; - tem = start; start = end; end = tem; + EMACS_INT tem = s; s = e; e = tem; } - if (!(BEG <= XFIXNUM (start) && XFIXNUM (start) <= XFIXNUM (end) && XFIXNUM (end) <= Z)) + if (!(BEG <= s && s <= e && e <= Z)) args_out_of_range (start, end); - if (BEGV != XFIXNAT (start) || ZV != XFIXNAT (end)) + if (BEGV != s || ZV != e) current_buffer->clip_changed = 1; - SET_BUF_BEGV (current_buffer, XFIXNAT (start)); - SET_BUF_ZV (current_buffer, XFIXNAT (end)); - if (PT < XFIXNAT (start)) - SET_PT (XFIXNAT (start)); - if (PT > XFIXNAT (end)) - SET_PT (XFIXNAT (end)); + SET_BUF_BEGV (current_buffer, s); + SET_BUF_ZV (current_buffer, e); + if (PT < s) + SET_PT (s); + if (e < PT) + SET_PT (e); /* Changing the buffer bounds invalidates any recorded current column. */ invalidate_current_column (); return Qnil; diff --git a/src/fns.c b/src/fns.c index 80012fa9d2..138082e07c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5187,22 +5187,8 @@ extract_data_from_object (Lisp_Object spec, struct buffer *bp = XBUFFER (object); set_buffer_internal (bp); - if (NILP (start)) - b = BEGV; - else - { - CHECK_FIXNUM_COERCE_MARKER (start); - b = XFIXNUM (start); - } - - if (NILP (end)) - e = ZV; - else - { - CHECK_FIXNUM_COERCE_MARKER (end); - e = XFIXNUM (end); - } - + b = !NILP (start) ? fix_position (start) : BEGV; + e = !NILP (end) ? fix_position (end) : ZV; if (b > e) { EMACS_INT temp = b; diff --git a/src/font.c b/src/font.c index 2a45630061..0c9e752e08 100644 --- a/src/font.c +++ b/src/font.c @@ -4606,10 +4606,10 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, Lisp_Object window; struct window *w; - CHECK_FIXNUM_COERCE_MARKER (position); - if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) + EMACS_INT fixed_pos = fix_position (position); + if (! (BEGV <= fixed_pos && fixed_pos < ZV)) args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); - pos = XFIXNUM (position); + pos = fixed_pos; pos_byte = CHAR_TO_BYTE (pos); if (NILP (ch)) c = FETCH_CHAR (pos_byte); @@ -5013,24 +5013,26 @@ character at index specified by POSITION. */) (Lisp_Object position, Lisp_Object window, Lisp_Object string) { struct window *w = decode_live_window (window); + EMACS_INT pos; if (NILP (string)) { if (XBUFFER (w->contents) != current_buffer) error ("Specified window is not displaying the current buffer"); - CHECK_FIXNUM_COERCE_MARKER (position); - if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV)) + pos = fix_position (position); + if (! (BEGV <= pos && pos < ZV)) args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); } else { CHECK_FIXNUM (position); CHECK_STRING (string); - if (! (0 <= XFIXNUM (position) && XFIXNUM (position) < SCHARS (string))) + pos = XFIXNUM (position); + if (! (0 <= pos && pos < SCHARS (string))) args_out_of_range (string, position); } - return font_at (-1, XFIXNUM (position), NULL, w, string); + return font_at (-1, pos, NULL, w, string); } #if 0 diff --git a/src/fringe.c b/src/fringe.c index 2a46e3c34f..d8d80bb3fe 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1675,10 +1675,10 @@ Return nil if POS is not visible in WINDOW. */) if (!NILP (pos)) { - CHECK_FIXNUM_COERCE_MARKER (pos); - if (! (BEGV <= XFIXNUM (pos) && XFIXNUM (pos) <= ZV)) + EMACS_INT p = fix_position (pos); + if (! (BEGV <= p && p <= ZV)) args_out_of_range (window, pos); - textpos = XFIXNUM (pos); + textpos = p; } else if (w == XWINDOW (selected_window)) textpos = PT; diff --git a/src/lisp.h b/src/lisp.h index 49923be702..d3b1c39c8f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3012,14 +3012,6 @@ CHECK_FIXNAT (Lisp_Object x) CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ } while (false) -#define CHECK_FIXNUM_COERCE_MARKER(x) \ - do { \ - if (MARKERP ((x))) \ - XSETFASTINT (x, marker_position (x)); \ - else \ - CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x); \ - } while (false) - INLINE double XFLOATINT (Lisp_Object n) { diff --git a/src/search.c b/src/search.c index 818bb4af24..7389fbef0e 100644 --- a/src/search.c +++ b/src/search.c @@ -1028,8 +1028,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, } else { - CHECK_FIXNUM_COERCE_MARKER (bound); - lim = XFIXNUM (bound); + lim = fix_position (bound); if (n > 0 ? lim < PT : lim > PT) error ("Invalid search bound (wrong side of point)"); if (lim > ZV) diff --git a/src/textprop.c b/src/textprop.c index ee048336ac..960dba3f8d 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -131,6 +131,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, { INTERVAL i; ptrdiff_t searchpos; + Lisp_Object begin0 = *begin, end0 = *end; CHECK_STRING_OR_BUFFER (object); CHECK_FIXNUM_COERCE_MARKER (*begin); @@ -155,7 +156,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) && XFIXNUM (*end) <= BUF_ZV (b))) - args_out_of_range (*begin, *end); + args_out_of_range (begin0, end0); i = buffer_intervals (b); /* If there's no text, there are no properties. */ @@ -170,7 +171,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end) && XFIXNUM (*end) <= len)) - args_out_of_range (*begin, *end); + args_out_of_range (begin0, end0); i = string_intervals (object); if (len == 0) @@ -611,7 +612,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, { struct window *w = 0; - CHECK_FIXNUM_COERCE_MARKER (position); + EMACS_INT pos = fix_position (position); if (NILP (object)) XSETBUFFER (object, current_buffer); @@ -628,14 +629,14 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, Lisp_Object *overlay_vec; struct buffer *obuf = current_buffer; - if (XFIXNUM (position) < BUF_BEGV (XBUFFER (object)) - || XFIXNUM (position) > BUF_ZV (XBUFFER (object))) + if (! (BUF_BEGV (XBUFFER (object)) <= pos + && pos <= BUF_ZV (XBUFFER (object)))) xsignal1 (Qargs_out_of_range, position); set_buffer_temp (XBUFFER (object)); USE_SAFE_ALLOCA; - GET_OVERLAYS_AT (XFIXNUM (position), overlay_vec, noverlays, NULL, false); + GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false); noverlays = sort_overlays (overlay_vec, noverlays, w); set_buffer_temp (obuf); @@ -662,7 +663,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, /* Not a buffer, or no appropriate overlay, so fall through to the simpler case. */ - return Fget_text_property (position, prop, object); + return Fget_text_property (make_fixnum (pos), prop, object); } DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0, diff --git a/src/window.c b/src/window.c index 8cdad27b66..075fd4e550 100644 --- a/src/window.c +++ b/src/window.c @@ -1895,10 +1895,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number if (EQ (pos, Qt)) posint = -1; else if (!NILP (pos)) - { - CHECK_FIXNUM_COERCE_MARKER (pos); - posint = XFIXNUM (pos); - } + posint = fix_position (pos); else if (w == XWINDOW (selected_window)) posint = PT; else diff --git a/src/xdisp.c b/src/xdisp.c index 58d7ca5cb7..61c798c59e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10413,10 +10413,7 @@ include the height of both, if present, in the return value. */) start = pos; } else - { - CHECK_FIXNUM_COERCE_MARKER (from); - start = min (max (XFIXNUM (from), BEGV), ZV); - } + start = clip_to_bounds (BEGV, fix_position (from), ZV); if (NILP (to)) end = ZV; @@ -10430,10 +10427,7 @@ include the height of both, if present, in the return value. */) end = pos; } else - { - CHECK_FIXNUM_COERCE_MARKER (to); - end = max (start, min (XFIXNUM (to), ZV)); - } + end = clip_to_bounds (start, fix_position (to), ZV); if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX)) max_x = XFIXNUM (x_limit); commit 10bedb75c915158b7662d4dfa4afa3a231714268 Author: Juri Linkov Date: Fri Mar 27 01:44:17 2020 +0200 Disable enable-local-variables for hunk-only in diff-syntax-fontify-props * lisp/vc/diff-mode.el (diff-syntax-fontify-props): Let-bind enable-local-variables to nil when hunk-only is non-nil (bug#39190) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 8171a58515..da2d5ed50e 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2720,7 +2720,9 @@ hunk text is not found in the source file." ;; When initialization is requested, we should be in a brand new ;; temp buffer. (cl-assert (null buffer-file-name)) - (let ((enable-local-variables :safe) ;; to find `mode:' + ;; Use `:safe' to find `mode:'. In case of hunk-only, use nil because + ;; Local Variables list might be incomplete when context is truncated. + (let ((enable-local-variables (unless hunk-only :safe)) (buffer-file-name file)) ;; Don't run hooks that might assume buffer-file-name ;; really associates buffer with a file (bug#39190). commit 57f5a63d85f6c3ea1d8b428b12a8db743de3b0bc Author: Paul Eggert Date: Thu Mar 26 16:12:21 2020 -0700 Refactor and fix typo in CHECK_*_COERCE_MARKER * src/data.c (check_integer_coerce_marker) (check_number_coerce_marker): New functions. Also, fix a typo in the former, by having it use Qinteger_or_marker_p not Qnumber_or_marker_p. (arithcompare, floatop_arith_driver, bignum_arith_driver) (arith_driver, Fplus, Fminus, Ftimes, Fquo, Frem, Fmod) (minmax_driver, Flogand, Flogior, Flogxor, Fadd1, Fsub1): Use them in place of the similarly-named macros. * src/lisp.h (CHECK_NUMBER_COERCE_MARKER) (CHECK_INTEGER_COERCE_MARKER): Remove; no longer used. diff --git a/src/data.c b/src/data.c index b0d438e8b8..bce2e53cfb 100644 --- a/src/data.c +++ b/src/data.c @@ -2333,6 +2333,24 @@ bool-vector. IDX starts at 0. */) /* Arithmetic functions */ +static Lisp_Object +check_integer_coerce_marker (Lisp_Object x) +{ + if (MARKERP (x)) + return make_fixnum (marker_position (x)); + CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); + return x; +} + +static Lisp_Object +check_number_coerce_marker (Lisp_Object x) +{ + if (MARKERP (x)) + return make_fixnum (marker_position (x)); + CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); + return x; +} + Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison) @@ -2341,8 +2359,8 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, bool lt, eq = true, gt; bool test; - CHECK_NUMBER_COERCE_MARKER (num1); - CHECK_NUMBER_COERCE_MARKER (num2); + num1 = check_number_coerce_marker (num1); + num2 = check_number_coerce_marker (num2); /* If the comparison is mostly done by comparing two doubles, set LT, EQ, and GT to the <, ==, > results of that comparison, @@ -2744,9 +2762,7 @@ floatop_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, argnum++; if (argnum == nargs) return make_float (accum); - Lisp_Object val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); - next = XFLOATINT (val); + next = XFLOATINT (check_number_coerce_marker (args[argnum])); } } @@ -2808,8 +2824,7 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, argnum++; if (argnum == nargs) return make_integer_mpz (); - val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); + val = check_number_coerce_marker (args[argnum]); if (FLOATP (val)) return float_arith_driver (code, nargs, args, argnum, mpz_get_d_rounded (*accum), val); @@ -2838,8 +2853,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args, argnum++; if (argnum == nargs) return make_int (accum); - val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); + val = check_number_coerce_marker (args[argnum]); /* Set NEXT to the next value if it fits, else exit the loop. */ intmax_t next; @@ -2886,8 +2900,7 @@ usage: (+ &rest NUMBERS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (0); - Lisp_Object a = args[0]; - CHECK_NUMBER_COERCE_MARKER (a); + Lisp_Object a = check_number_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a); } @@ -2900,8 +2913,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (0); - Lisp_Object a = args[0]; - CHECK_NUMBER_COERCE_MARKER (a); + Lisp_Object a = check_number_coerce_marker (args[0]); if (nargs == 1) { if (FIXNUMP (a)) @@ -2921,8 +2933,7 @@ usage: (* &rest NUMBERS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (1); - Lisp_Object a = args[0]; - CHECK_NUMBER_COERCE_MARKER (a); + Lisp_Object a = check_number_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Amult, nargs, args, a); } @@ -2934,8 +2945,7 @@ The arguments must be numbers or markers. usage: (/ NUMBER &rest DIVISORS) */) (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object a = args[0]; - CHECK_NUMBER_COERCE_MARKER (a); + Lisp_Object a = check_number_coerce_marker (args[0]); if (nargs == 1) { if (FIXNUMP (a)) @@ -3017,10 +3027,10 @@ integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo) DEFUN ("%", Frem, Srem, 2, 2, 0, doc: /* Return remainder of X divided by Y. Both must be integers or markers. */) - (register Lisp_Object x, Lisp_Object y) + (Lisp_Object x, Lisp_Object y) { - CHECK_INTEGER_COERCE_MARKER (x); - CHECK_INTEGER_COERCE_MARKER (y); + x = check_integer_coerce_marker (x); + y = check_integer_coerce_marker (y); return integer_remainder (x, y, false); } @@ -3030,8 +3040,8 @@ The result falls between zero (inclusive) and Y (exclusive). Both X and Y must be numbers or markers. */) (Lisp_Object x, Lisp_Object y) { - CHECK_NUMBER_COERCE_MARKER (x); - CHECK_NUMBER_COERCE_MARKER (y); + x = check_number_coerce_marker (x); + y = check_number_coerce_marker (y); if (FLOATP (x) || FLOATP (y)) return fmod_float (x, y); return integer_remainder (x, y, true); @@ -3041,12 +3051,10 @@ static Lisp_Object minmax_driver (ptrdiff_t nargs, Lisp_Object *args, enum Arith_Comparison comparison) { - Lisp_Object accum = args[0]; - CHECK_NUMBER_COERCE_MARKER (accum); + Lisp_Object accum = check_number_coerce_marker (args[0]); for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) { - Lisp_Object val = args[argnum]; - CHECK_NUMBER_COERCE_MARKER (val); + Lisp_Object val = check_number_coerce_marker (args[argnum]); if (!NILP (arithcompare (val, accum, comparison))) accum = val; else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) @@ -3081,8 +3089,7 @@ usage: (logand &rest INTS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (-1); - Lisp_Object a = args[0]; - CHECK_INTEGER_COERCE_MARKER (a); + Lisp_Object a = check_integer_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a); } @@ -3094,8 +3101,7 @@ usage: (logior &rest INTS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (0); - Lisp_Object a = args[0]; - CHECK_INTEGER_COERCE_MARKER (a); + Lisp_Object a = check_integer_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a); } @@ -3107,8 +3113,7 @@ usage: (logxor &rest INTS-OR-MARKERS) */) { if (nargs == 0) return make_fixnum (0); - Lisp_Object a = args[0]; - CHECK_INTEGER_COERCE_MARKER (a); + Lisp_Object a = check_integer_coerce_marker (args[0]); return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a); } @@ -3227,9 +3232,9 @@ expt_integer (Lisp_Object x, Lisp_Object y) DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0, doc: /* Return NUMBER plus one. NUMBER may be a number or a marker. Markers are converted to integers. */) - (register Lisp_Object number) + (Lisp_Object number) { - CHECK_NUMBER_COERCE_MARKER (number); + number = check_number_coerce_marker (number); if (FIXNUMP (number)) return make_int (XFIXNUM (number) + 1); @@ -3242,9 +3247,9 @@ Markers are converted to integers. */) DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0, doc: /* Return NUMBER minus one. NUMBER may be a number or a marker. Markers are converted to integers. */) - (register Lisp_Object number) + (Lisp_Object number) { - CHECK_NUMBER_COERCE_MARKER (number); + number = check_number_coerce_marker (number); if (FIXNUMP (number)) return make_int (XFIXNUM (number) - 1); diff --git a/src/lisp.h b/src/lisp.h index cd6282390f..49923be702 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3039,22 +3039,6 @@ CHECK_INTEGER (Lisp_Object x) { CHECK_TYPE (INTEGERP (x), Qnumberp, x); } - -#define CHECK_NUMBER_COERCE_MARKER(x) \ - do { \ - if (MARKERP (x)) \ - XSETFASTINT (x, marker_position (x)); \ - else \ - CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \ - } while (false) - -#define CHECK_INTEGER_COERCE_MARKER(x) \ - do { \ - if (MARKERP (x)) \ - XSETFASTINT (x, marker_position (x)); \ - else \ - CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x); \ - } while (false) /* If we're not dumping using the legacy dumper and we might be using commit d28b00476890f791a89b65007e5f20682b3eaa0d Author: Philipp Stephani Date: Thu Mar 26 17:22:25 2020 +0100 Add a module function to open a file descriptor connected to a pipe. A common complaint about the module API is that modules can't communicate asynchronously with Emacs. While it isn't possible to call arbitrary Emacs functions asynchronously, writing to a pipe should always be fine and is a pretty low-hanging fruit. This patch implements a function that adapts an existing pipe process. That way, users can use familiar tools like process filters or 'accept-process-output'. * src/module-env-28.h: Add 'open_channel' module function. * src/emacs-module.c (module_open_channel): Provide definition for 'open_channel'. (initialize_environment): Use it. * src/process.c (open_channel_for_module): New helper function. (syms_of_process): Define necessary symbol. * test/src/emacs-module-tests.el (module/async-pipe): New unit test. * test/data/emacs-module/mod-test.c (signal_system_error): New helper function. (signal_errno): Use it. (write_to_pipe): New function running in the background. (Fmod_test_async_pipe): New test module function. (emacs_module_init): Export it. * doc/lispref/internals.texi (Module Misc): Document new module function. * doc/lispref/processes.texi (Asynchronous Processes): New anchor for pipe processes. * etc/NEWS: Document 'open_channel' function. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 442f6d156b..0c24dac777 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -2022,6 +2022,20 @@ variable values and buffer content may have been modified in arbitrary ways. @end deftypefn +@anchor{open_channel} +@deftypefun int open_channel (emacs_env *@var{env}, emacs_value @var{pipe_process}) +This function, which is available since Emacs 27, opens a channel to +an existing pipe process. @var{pipe_process} must refer to an +existing pipe process created by @code{make-pipe-process}. @ref{Pipe +Processes}. If successful, the return value will be a new file +descriptor that you can use to write to the pipe. Unlike all other +module functions, you can use the returned file descriptor from +arbitrary threads, even if no module environment is active. You can +use the @code{write} function to write to the file descriptor. Once +done, close the file descriptor using @code{close}. @ref{Low-Level +I/O,,,libc}. +@end deftypefun + @node Module Nonlocal @subsection Nonlocal Exits in Modules @cindex nonlocal exits, in modules diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index f515213615..14cd079c56 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -743,6 +743,7 @@ Some file name handlers may not support @code{make-process}. In such cases, this function does nothing and returns @code{nil}. @end defun +@anchor{Pipe Processes} @defun make-pipe-process &rest args This function creates a bidirectional pipe which can be attached to a child process. This is useful with the @code{:stderr} keyword of diff --git a/etc/NEWS b/etc/NEWS index 910d9fa2d2..a2cb4b094e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -258,6 +258,10 @@ called when the function object is garbage-collected. Use 'set_function_finalizer' to set the finalizer and 'get_function_finalizer' to retrieve it. +** Modules can now open a channel to an existing pipe process using +the new module function 'open_channel'. Modules can use this +functionality to asynchronously send data back to Emacs. + ** 'file-modes', 'set-file-modes', and 'set-file-times' now have an optional argument specifying whether to follow symbolic links. diff --git a/src/emacs-module.c b/src/emacs-module.c index 60f16418ef..cdcbe061b5 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -88,6 +88,7 @@ To add a new module function, proceed as follows: #include "dynlib.h" #include "coding.h" #include "keyboard.h" +#include "process.h" #include "syssignal.h" #include "sysstdio.h" #include "thread.h" @@ -977,6 +978,13 @@ module_make_big_integer (emacs_env *env, int sign, return lisp_to_value (env, make_integer_mpz ()); } +static int +module_open_channel (emacs_env *env, emacs_value pipe_process) +{ + MODULE_FUNCTION_BEGIN (-1); + return open_channel_for_module (value_to_lisp (pipe_process)); +} + /* Subroutines. */ @@ -1391,6 +1399,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->make_big_integer = module_make_big_integer; env->get_function_finalizer = module_get_function_finalizer; env->set_function_finalizer = module_set_function_finalizer; + env->open_channel = module_open_channel; Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); return env; } diff --git a/src/module-env-28.h b/src/module-env-28.h index a2479a8f74..5d884c148c 100644 --- a/src/module-env-28.h +++ b/src/module-env-28.h @@ -9,3 +9,6 @@ void (*set_function_finalizer) (emacs_env *env, emacs_value arg, void (*fin) (void *) EMACS_NOEXCEPT) EMACS_ATTRIBUTE_NONNULL (1); + + int (*open_channel) (emacs_env *env, emacs_value pipe_process) + EMACS_ATTRIBUTE_NONNULL (1); diff --git a/src/process.c b/src/process.c index e4e5e57aee..07881d6c5d 100644 --- a/src/process.c +++ b/src/process.c @@ -8200,6 +8200,17 @@ restore_nofile_limit (void) #endif } +int +open_channel_for_module (Lisp_Object process) +{ + CHECK_PROCESS (process); + CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process); + int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]); + if (fd == -1) + report_file_error ("Cannot duplicate file descriptor", Qnil); + return fd; +} + /* This is not called "init_process" because that is the name of a Mach system call, so it would cause problems on Darwin systems. */ @@ -8446,6 +8457,7 @@ amounts of data in one go. */); DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions"); DEFSYM (Qnull, "null"); + DEFSYM (Qpipe_process_p, "pipe-process-p"); defsubr (&Sprocessp); defsubr (&Sget_process); diff --git a/src/process.h b/src/process.h index 7884efc549..a783a31cb8 100644 --- a/src/process.h +++ b/src/process.h @@ -300,6 +300,8 @@ extern Lisp_Object remove_slash_colon (Lisp_Object); extern void update_processes_for_thread_death (Lisp_Object); extern void dissociate_controlling_tty (void); +extern int open_channel_for_module (Lisp_Object); + INLINE_HEADER_END #endif /* EMACS_PROCESS_H */ diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index ec6948921f..61733f1ef4 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -30,6 +30,9 @@ along with GNU Emacs. If not, see . */ #include #include +#include +#include + #ifdef HAVE_GMP #include #else @@ -320,9 +323,9 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, } static void -signal_errno (emacs_env *env, const char *function) +signal_system_error (emacs_env *env, int error, const char *function) { - const char *message = strerror (errno); + const char *message = strerror (error); emacs_value message_value = env->make_string (env, message, strlen (message)); emacs_value symbol = env->intern (env, "file-error"); emacs_value elements[2] @@ -331,6 +334,12 @@ signal_errno (emacs_env *env, const char *function) env->non_local_exit_signal (env, symbol, data); } +static void +signal_errno (emacs_env *env, const char *function) +{ + signal_system_error (env, errno, function); +} + /* A long-running operation that occasionally calls `should_quit' or `process_input'. */ @@ -533,6 +542,49 @@ Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs, return env->funcall (env, Flist, 2, list_args); } +static void * +write_to_pipe (void *arg) +{ + /* We sleep a bit to test that writing to a pipe is indeed possible + if no environment is active. */ + const struct timespec sleep = {0, 500000000}; + if (nanosleep (&sleep, NULL) != 0) + perror ("nanosleep"); + FILE *stream = arg; + if (fputs ("data from thread", stream) < 0) + perror ("fputs"); + if (fclose (stream) != 0) + perror ("close"); + return NULL; +} + +static emacs_value +Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args, + void *data) +{ + assert (nargs == 1); + int fd = env->open_channel (env, args[0]); + if (env->non_local_exit_check (env) != emacs_funcall_exit_return) + return NULL; + FILE *stream = fdopen (fd, "w"); + if (stream == NULL) + { + signal_errno (env, "fdopen"); + return NULL; + } + pthread_t thread; + int error + = pthread_create (&thread, NULL, write_to_pipe, stream); + if (error != 0) + { + signal_system_error (env, error, "pthread_create"); + if (fclose (stream) != 0) + perror ("fclose"); + return NULL; + } + return env->intern (env, "nil"); +} + /* Lisp utilities for easier readability (simple wrappers). */ /* Provide FEATURE to Emacs. */ @@ -614,6 +666,7 @@ emacs_module_init (struct emacs_runtime *ert) Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL); DEFUN ("mod-test-function-finalizer-calls", Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL); + DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL); #undef DEFUN diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 48d2e86a60..1f91795e1e 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -424,4 +424,18 @@ See Bug#36226." ;; but at least one. (should (> valid-after valid-before))))) +(ert-deftest module/async-pipe () + "Check that writing data from another thread works." + (with-temp-buffer + (let ((process (make-pipe-process :name "module/async-pipe" + :buffer (current-buffer) + :coding 'utf-8-unix + :noquery t))) + (unwind-protect + (progn + (mod-test-async-pipe process) + (should (accept-process-output process 1)) + (should (equal (buffer-string) "data from thread"))) + (delete-process process))))) + ;;; emacs-module-tests.el ends here commit 934b3c9ecc2b91723b9e5826080424ec1a90f264 Author: Paul Eggert Date: Thu Mar 26 13:06:12 2020 -0700 Remove COERCE_MARKER * src/xdisp.c (COERCE_MARKER): Remove. All uses replaced by Fmarker_position; this is simpler as the macro was invoked only on markers. diff --git a/src/xdisp.c b/src/xdisp.c index 04fc8aa3c4..58d7ca5cb7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -815,11 +815,6 @@ static struct props it_props[] = {0, 0, NULL} }; -/* Value is the position described by X. If X is a marker, value is - the marker_position of X. Otherwise, value is X. */ - -#define COERCE_MARKER(X) (MARKERP ((X)) ? Fmarker_position (X) : (X)) - /* Enumeration returned by some move_it_.* functions internally. */ enum move_it_result @@ -14944,7 +14939,7 @@ overlay_arrows_changed_p (bool set_redisplay) val = find_symbol_value (var); if (!MARKERP (val)) continue; - if (! EQ (COERCE_MARKER (val), + if (! EQ (Fmarker_position (val), /* FIXME: Don't we have a problem, using such a global * "last-position" if the variable is buffer-local? */ Fget (var, Qlast_arrow_position)) @@ -14987,8 +14982,7 @@ update_overlay_arrows (int up_to_date) Lisp_Object val = find_symbol_value (var); if (!MARKERP (val)) continue; - Fput (var, Qlast_arrow_position, - COERCE_MARKER (val)); + Fput (var, Qlast_arrow_position, Fmarker_position (val)); Fput (var, Qlast_arrow_string, overlay_arrow_string_or_property (var)); }