commit bec5cfee7660f6e283efbd30a693a6f8e9ea46b8 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sun Apr 5 01:17:32 2020 -0700 Improve integer range checking * src/bignum.c (check_integer_range, check_uinteger_max) (check_int_nonnegative): New functions. * src/frame.c (check_frame_pixels): New function. (Fset_frame_height, Fset_frame_width, Fset_frame_size): Use it. * src/lisp.h (CHECK_RANGED_INTEGER, CHECK_TYPE_RANGED_INTEGER): Remove these macros. Unless otherwise specified, all callers replaced by calls to check_integer_range, check_uinteger_range, check_int_nonnegative. * src/frame.c (gui_set_right_divider_width) (gui_set_bottom_divider_width): * src/nsfns.m (ns_set_internal_border_width): * src/xfns.c (x_set_internal_border_width): Using check_int_nonnegative means these functions no longer incorrectly reject negative bignums; they treat them as 0, just like negative fixnums. diff --git a/src/bignum.c b/src/bignum.c index 51d90ffaef..859896cdcf 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -431,3 +431,39 @@ make_bignum_str (char const *num, int base) eassert (check == 0); return make_lisp_ptr (b, Lisp_Vectorlike); } + +/* Check that X is a Lisp integer in the range LO..HI. + Return X's value as an intmax_t. */ + +intmax_t +check_integer_range (Lisp_Object x, intmax_t lo, intmax_t hi) +{ + CHECK_INTEGER (x); + intmax_t i; + if (! (integer_to_intmax (x, &i) && lo <= i && i <= hi)) + args_out_of_range_3 (x, make_int (lo), make_int (hi)); + return i; +} + +/* Check that X is a Lisp integer in the range 0..HI. + Return X's value as an uintmax_t. */ + +uintmax_t +check_uinteger_max (Lisp_Object x, uintmax_t hi) +{ + CHECK_INTEGER (x); + uintmax_t i; + if (! (integer_to_uintmax (x, &i) && i <= hi)) + args_out_of_range_3 (x, make_fixnum (0), make_uint (hi)); + return i; +} + +/* Check that X is a Lisp integer no greater than INT_MAX, + and return its value or zero, whichever is greater. */ + +int +check_int_nonnegative (Lisp_Object x) +{ + CHECK_INTEGER (x); + return Fnatnump (x) ? check_integer_range (x, 0, INT_MAX) : 0; +} diff --git a/src/character.c b/src/character.c index a566cacb02..c938e9fe41 100644 --- a/src/character.c +++ b/src/character.c @@ -876,10 +876,7 @@ usage: (unibyte-string &rest BYTES) */) Lisp_Object str = make_uninit_string (n); unsigned char *p = SDATA (str); for (ptrdiff_t i = 0; i < n; i++) - { - CHECK_RANGED_INTEGER (args[i], 0, 255); - *p++ = XFIXNUM (args[i]); - } + *p++ = check_integer_range (args[i], 0, 255); return str; } diff --git a/src/charset.c b/src/charset.c index 2771b0ba2a..9e55d0c7fe 100644 --- a/src/charset.c +++ b/src/charset.c @@ -866,15 +866,10 @@ usage: (define-charset-internal ...) */) val = args[charset_arg_code_space]; for (i = 0, dimension = 0, nchars = 1; ; i++) { - Lisp_Object min_byte_obj, max_byte_obj; - int min_byte, max_byte; - - min_byte_obj = Faref (val, make_fixnum (i * 2)); - max_byte_obj = Faref (val, make_fixnum (i * 2 + 1)); - CHECK_RANGED_INTEGER (min_byte_obj, 0, 255); - min_byte = XFIXNUM (min_byte_obj); - CHECK_RANGED_INTEGER (max_byte_obj, min_byte, 255); - max_byte = XFIXNUM (max_byte_obj); + Lisp_Object min_byte_obj = Faref (val, make_fixnum (i * 2)); + Lisp_Object max_byte_obj = Faref (val, make_fixnum (i * 2 + 1)); + int min_byte = check_integer_range (min_byte_obj, 0, 255); + int max_byte = check_integer_range (max_byte_obj, min_byte, 255); charset.code_space[i * 4] = min_byte; charset.code_space[i * 4 + 1] = max_byte; charset.code_space[i * 4 + 2] = max_byte - min_byte + 1; @@ -887,13 +882,8 @@ usage: (define-charset-internal ...) */) } val = args[charset_arg_dimension]; - if (NILP (val)) - charset.dimension = dimension; - else - { - CHECK_RANGED_INTEGER (val, 1, 4); - charset.dimension = XFIXNUM (val); - } + charset.dimension + = !NILP (val) ? check_integer_range (val, 1, 4) : dimension; charset.code_linear_p = (charset.dimension == 1 @@ -979,13 +969,7 @@ usage: (define-charset-internal ...) */) } val = args[charset_arg_iso_revision]; - if (NILP (val)) - charset.iso_revision = -1; - else - { - CHECK_RANGED_INTEGER (val, -1, 63); - charset.iso_revision = XFIXNUM (val); - } + charset.iso_revision = !NILP (val) ? check_integer_range (val, -1, 63) : -1; val = args[charset_arg_emacs_mule_id]; if (NILP (val)) @@ -1090,8 +1074,7 @@ usage: (define-charset-internal ...) */) car_part = XCAR (elt); cdr_part = XCDR (elt); CHECK_CHARSET_GET_ID (car_part, this_id); - CHECK_TYPE_RANGED_INTEGER (int, cdr_part); - offset = XFIXNUM (cdr_part); + offset = check_integer_range (cdr_part, INT_MIN, INT_MAX); } else { diff --git a/src/coding.c b/src/coding.c index 0bea2a0c2b..f0fc37dbdf 100644 --- a/src/coding.c +++ b/src/coding.c @@ -11061,10 +11061,8 @@ usage: (define-coding-system-internal ...) */) else { CHECK_CONS (val); - CHECK_RANGED_INTEGER (XCAR (val), 0, 255); - from = XFIXNUM (XCAR (val)); - CHECK_RANGED_INTEGER (XCDR (val), from, 255); - to = XFIXNUM (XCDR (val)); + from = check_integer_range (XCAR (val), 0, 255); + to = check_integer_range (XCDR (val), from, 255); } for (int i = from; i <= to; i++) SSET (valids, i, 1); @@ -11149,7 +11147,7 @@ usage: (define-coding-system-internal ...) */) val = XCAR (tail); CHECK_CONS (val); CHECK_CHARSET_GET_ID (XCAR (val), id); - CHECK_RANGED_INTEGER (XCDR (val), 0, 3); + check_integer_range (XCDR (val), 0, 3); XSETCAR (val, make_fixnum (id)); } diff --git a/src/fileio.c b/src/fileio.c index 978a373d39..2f1d2f8243 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5682,8 +5682,8 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */) struct timespec mtime; if (FIXNUMP (time_flag)) { - CHECK_RANGED_INTEGER (time_flag, -1, 0); - mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XFIXNUM (time_flag)); + int flag = check_integer_range (time_flag, -1, 0); + mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - flag); } else mtime = lisp_time_argument (time_flag); diff --git a/src/frame.c b/src/frame.c index c7e4f2f6bd..884de2f534 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2558,26 +2558,26 @@ before calling this function on it, like this. (Lisp_Object frame, Lisp_Object x, Lisp_Object y) { CHECK_LIVE_FRAME (frame); - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ - frame_set_mouse_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y)); + frame_set_mouse_position (XFRAME (frame), xval, yval); #else #if defined (MSDOS) if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); - mouse_moveto (XFIXNUM (x), XFIXNUM (y)); + mouse_moveto (xval, yval); } #else #ifdef HAVE_GPM { Fselect_frame (frame, Qnil); - term_mouse_moveto (XFIXNUM (x), XFIXNUM (y)); + term_mouse_moveto (xval, yval); } #endif #endif @@ -2599,26 +2599,26 @@ before calling this function on it, like this. (Lisp_Object frame, Lisp_Object x, Lisp_Object y) { CHECK_LIVE_FRAME (frame); - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (XFRAME (frame))) /* Warping the mouse will cause enternotify and focus events. */ - frame_set_mouse_pixel_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y)); + frame_set_mouse_pixel_position (XFRAME (frame), xval, yval); #else #if defined (MSDOS) if (FRAME_MSDOS_P (XFRAME (frame))) { Fselect_frame (frame, Qnil); - mouse_moveto (XFIXNUM (x), XFIXNUM (y)); + mouse_moveto (xval, yval); } #else #ifdef HAVE_GPM { Fselect_frame (frame, Qnil); - term_mouse_moveto (XFIXNUM (x), XFIXNUM (y)); + term_mouse_moveto (xval, yval); } #endif #endif @@ -3545,6 +3545,21 @@ DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_widt return make_fixnum (FRAME_BOTTOM_DIVIDER_WIDTH (decode_any_frame (frame))); } +static int +check_frame_pixels (Lisp_Object size, Lisp_Object pixelwise, int item_size) +{ + CHECK_INTEGER (size); + if (!NILP (pixelwise)) + item_size = 1; + intmax_t sz; + int pixel_size; /* size * item_size */ + if (! integer_to_intmax (size, &sz) + || INT_MULTIPLY_WRAPV (sz, item_size, &pixel_size)) + args_out_of_range_3 (size, make_int (INT_MIN / item_size), + make_int (INT_MAX / item_size)); + return pixel_size; +} + DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, "(list (selected-frame) (prefix-numeric-value current-prefix-arg))", doc: /* Set text height of frame FRAME to HEIGHT lines. @@ -3562,15 +3577,9 @@ currently selected frame will be set to this height. */) (Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); - int pixel_height; - - CHECK_TYPE_RANGED_INTEGER (int, height); - - pixel_height = (!NILP (pixelwise) - ? XFIXNUM (height) - : XFIXNUM (height) * FRAME_LINE_HEIGHT (f)); + int pixel_height = check_frame_pixels (height, pixelwise, + FRAME_LINE_HEIGHT (f)); adjust_frame_size (f, -1, pixel_height, 1, !NILP (pretend), Qheight); - return Qnil; } @@ -3591,15 +3600,9 @@ currently selected frame will be set to this width. */) (Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); - int pixel_width; - - CHECK_TYPE_RANGED_INTEGER (int, width); - - pixel_width = (!NILP (pixelwise) - ? XFIXNUM (width) - : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f)); + int pixel_width = check_frame_pixels (width, pixelwise, + FRAME_COLUMN_WIDTH (f)); adjust_frame_size (f, pixel_width, -1, 1, !NILP (pretend), Qwidth); - return Qnil; } @@ -3613,19 +3616,11 @@ font height. */) (Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); - int pixel_width, pixel_height; - - CHECK_TYPE_RANGED_INTEGER (int, width); - CHECK_TYPE_RANGED_INTEGER (int, height); - - pixel_width = (!NILP (pixelwise) - ? XFIXNUM (width) - : XFIXNUM (width) * FRAME_COLUMN_WIDTH (f)); - pixel_height = (!NILP (pixelwise) - ? XFIXNUM (height) - : XFIXNUM (height) * FRAME_LINE_HEIGHT (f)); + int pixel_width = check_frame_pixels (width, pixelwise, + FRAME_COLUMN_WIDTH (f)); + int pixel_height = check_frame_pixels (height, pixelwise, + FRAME_LINE_HEIGHT (f)); adjust_frame_size (f, pixel_width, pixel_height, 1, 0, Qsize); - return Qnil; } @@ -3655,18 +3650,14 @@ bottom edge of FRAME's display. */) (Lisp_Object frame, Lisp_Object x, Lisp_Object y) { struct frame *f = decode_live_frame (frame); - - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); if (FRAME_WINDOW_P (f)) { #ifdef HAVE_WINDOW_SYSTEM if (FRAME_TERMINAL (f)->set_frame_offset_hook) - FRAME_TERMINAL (f)->set_frame_offset_hook (f, - XFIXNUM (x), - XFIXNUM (y), - 1); + FRAME_TERMINAL (f)->set_frame_offset_hook (f, xval, yval, 1); #endif } @@ -4641,23 +4632,22 @@ gui_set_right_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_va void gui_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - CHECK_TYPE_RANGED_INTEGER (int, arg); + int border_width = check_integer_range (arg, INT_MIN, INT_MAX); - if (XFIXNUM (arg) == f->border_width) + if (border_width == f->border_width) return; if (FRAME_NATIVE_WINDOW (f) != 0) error ("Cannot change the border width of a frame"); - f->border_width = XFIXNUM (arg); + f->border_width = border_width; } void gui_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int old = FRAME_RIGHT_DIVIDER_WIDTH (f); - CHECK_TYPE_RANGED_INTEGER (int, arg); - int new = max (0, XFIXNUM (arg)); + int new = check_int_nonnegative (arg); if (new != old) { f->right_divider_width = new; @@ -4671,8 +4661,7 @@ void gui_set_bottom_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int old = FRAME_BOTTOM_DIVIDER_WIDTH (f); - CHECK_TYPE_RANGED_INTEGER (int, arg); - int new = max (0, XFIXNUM (arg)); + int new = check_int_nonnegative (arg); if (new != old) { f->bottom_divider_width = new; @@ -5651,8 +5640,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, f->top_pos = 0; else { - CHECK_TYPE_RANGED_INTEGER (int, top); - f->top_pos = XFIXNUM (top); + f->top_pos = check_integer_range (top, INT_MIN, INT_MAX); if (f->top_pos < 0) window_prompting |= YNegative; } @@ -5682,8 +5670,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p, f->left_pos = 0; else { - CHECK_TYPE_RANGED_INTEGER (int, left); - f->left_pos = XFIXNUM (left); + f->left_pos = check_integer_range (left, INT_MIN, INT_MAX); if (f->left_pos < 0) window_prompting |= XNegative; } diff --git a/src/lcms.c b/src/lcms.c index c19397f4ba..924bdd299d 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -254,8 +254,7 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp, #define PARSE_VIEW_CONDITION_INT(field) \ if (CONSP (view) && FIXNATP (XCAR (view))) \ { \ - CHECK_RANGED_INTEGER (XCAR (view), 1, 4); \ - vc->field = XFIXNUM (XCAR (view)); \ + vc->field = check_integer_range (XCAR (view), 1, 4); \ view = XCDR (view); \ } \ else \ diff --git a/src/lisp.h b/src/lisp.h index 23ff89a977..c3efabaf52 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -589,15 +589,19 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t, Lisp_Object); /* Defined in bignum.c. */ +extern int check_int_nonnegative (Lisp_Object); +extern intmax_t check_integer_range (Lisp_Object, intmax_t, intmax_t); extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST; extern Lisp_Object make_bigint (intmax_t); extern Lisp_Object make_biguint (uintmax_t); +extern uintmax_t check_uinteger_max (Lisp_Object, uintmax_t); /* Defined in chartab.c. */ extern Lisp_Object char_table_ref (Lisp_Object, int); extern void char_table_set (Lisp_Object, int, Lisp_Object); /* Defined in data.c. */ +extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object default_value (Lisp_Object symbol); @@ -3002,20 +3006,6 @@ CHECK_FIXNAT (Lisp_Object x) CHECK_TYPE (FIXNATP (x), Qwholenump, x); } -#define CHECK_RANGED_INTEGER(x, lo, hi) \ - do { \ - CHECK_FIXNUM (x); \ - if (! ((lo) <= XFIXNUM (x) && XFIXNUM (x) <= (hi))) \ - args_out_of_range_3 (x, INT_TO_INTEGER (lo), INT_TO_INTEGER (hi)); \ - } while (false) -#define CHECK_TYPE_RANGED_INTEGER(type, x) \ - do { \ - if (TYPE_SIGNED (type)) \ - CHECK_RANGED_INTEGER (x, TYPE_MINIMUM (type), TYPE_MAXIMUM (type)); \ - else \ - CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \ - } while (false) - INLINE double XFLOATINT (Lisp_Object n) { @@ -3581,7 +3571,6 @@ extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t); extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *); extern AVOID args_out_of_range (Lisp_Object, Lisp_Object); -extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID circular_list (Lisp_Object); extern Lisp_Object do_symval_forwarding (lispfwd); enum Set_Internal_Bind { diff --git a/src/menu.c b/src/menu.c index 28bfcae05d..6b8b5dd121 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1253,18 +1253,16 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) but I don't want to make one now. */ CHECK_WINDOW (window); - CHECK_RANGED_INTEGER (x, - (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM - ? (EMACS_INT) INT_MIN - xpos - : MOST_NEGATIVE_FIXNUM), - INT_MAX - xpos); - CHECK_RANGED_INTEGER (y, - (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM - ? (EMACS_INT) INT_MIN - ypos - : MOST_NEGATIVE_FIXNUM), - INT_MAX - ypos); - xpos += XFIXNUM (x); - ypos += XFIXNUM (y); + xpos += check_integer_range (x, + (xpos < INT_MIN - MOST_NEGATIVE_FIXNUM + ? (EMACS_INT) INT_MIN - xpos + : MOST_NEGATIVE_FIXNUM), + INT_MAX - xpos); + ypos += check_integer_range (y, + (ypos < INT_MIN - MOST_NEGATIVE_FIXNUM + ? (EMACS_INT) INT_MIN - ypos + : MOST_NEGATIVE_FIXNUM), + INT_MAX - ypos); XSETFRAME (Vmenu_updating_frame, f); } diff --git a/src/nsfns.m b/src/nsfns.m index f6e7f4e9ac..273fb5f759 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -706,14 +706,11 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. ns_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int old_width = FRAME_INTERNAL_BORDER_WIDTH (f); + int new_width = check_int_nonnegative (arg); - CHECK_TYPE_RANGED_INTEGER (int, arg); - f->internal_border_width = XFIXNUM (arg); - if (FRAME_INTERNAL_BORDER_WIDTH (f) < 0) - f->internal_border_width = 0; - - if (FRAME_INTERNAL_BORDER_WIDTH (f) == old_width) + if (new_width == old_width) return; + f->internal_border_width = new_width; if (FRAME_NATIVE_WINDOW (f) != 0) adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width); @@ -2956,16 +2953,16 @@ value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are if (FRAME_INITIAL_P (f) || !FRAME_NS_P (f)) return Qnil; - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); - mouse_x = screen_frame.origin.x + XFIXNUM (x); + mouse_x = screen_frame.origin.x + xval; if (screen == primary_screen) - mouse_y = screen_frame.origin.y + XFIXNUM (y); + mouse_y = screen_frame.origin.y + yval; else mouse_y = (primary_screen_height - screen_frame.size.height - - screen_frame.origin.y) + XFIXNUM (y); + - screen_frame.origin.y) + yval; CGPoint mouse_pos = CGPointMake(mouse_x, mouse_y); CGWarpMouseCursorPosition (mouse_pos); diff --git a/src/process.c b/src/process.c index e6d18fbaad..6e5bcf307a 100644 --- a/src/process.c +++ b/src/process.c @@ -1392,14 +1392,12 @@ nil otherwise. */) CHECK_PROCESS (process); /* All known platforms store window sizes as 'unsigned short'. */ - CHECK_RANGED_INTEGER (height, 0, USHRT_MAX); - CHECK_RANGED_INTEGER (width, 0, USHRT_MAX); + unsigned short h = check_uinteger_max (height, USHRT_MAX); + unsigned short w = check_uinteger_max (width, USHRT_MAX); if (NETCONN_P (process) || XPROCESS (process)->infd < 0 - || (set_window_size (XPROCESS (process)->infd, - XFIXNUM (height), XFIXNUM (width)) - < 0)) + || set_window_size (XPROCESS (process)->infd, h, w) < 0) return Qnil; else return Qt; @@ -7075,10 +7073,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) } if (FIXNUMP (sigcode)) - { - CHECK_TYPE_RANGED_INTEGER (int, sigcode); - signo = XFIXNUM (sigcode); - } + signo = check_integer_range (sigcode, INT_MIN, INT_MAX); else { char *name; diff --git a/src/search.c b/src/search.c index 7389fbef0e..08b57c5faf 100644 --- a/src/search.c +++ b/src/search.c @@ -2392,14 +2392,7 @@ since only regular expressions have distinguished subexpressions. */) if (num_regs <= 0) error ("`replace-match' called before any match found"); - if (NILP (subexp)) - sub = 0; - else - { - CHECK_RANGED_INTEGER (subexp, 0, num_regs - 1); - sub = XFIXNUM (subexp); - } - + sub = !NILP (subexp) ? check_integer_range (subexp, 0, num_regs - 1) : 0; ptrdiff_t sub_start = search_regs.start[sub]; ptrdiff_t sub_end = search_regs.end[sub]; eassert (sub_start <= sub_end); diff --git a/src/w32fns.c b/src/w32fns.c index 2f01fb52e9..9bb4e27b01 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -1700,10 +1700,8 @@ w32_clear_under_internal_border (struct frame *f) static void w32_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int border; - - CHECK_TYPE_RANGED_INTEGER (int, arg); - border = max (XFIXNUM (arg), 0); + int argval = check_integer_range (arg, INT_MIN, INT_MAX); + int border = max (argval, 0); if (border != FRAME_INTERNAL_BORDER_WIDTH (f)) { @@ -9203,8 +9201,8 @@ The coordinates X and Y are interpreted in pixels relative to a position UINT trail_num = 0; BOOL ret = false; - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); block_input (); /* When "mouse trails" are in effect, moving the mouse cursor @@ -9213,7 +9211,7 @@ The coordinates X and Y are interpreted in pixels relative to a position if (os_subtype == OS_NT && w32_major_version + w32_minor_version >= 6) ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0); - SetCursorPos (XFIXNUM (x), XFIXNUM (y)); + SetCursorPos (xval, yval); if (ret) SystemParametersInfo (SPI_SETMOUSETRAILS, trail_num, NULL, 0); unblock_input (); diff --git a/src/window.c b/src/window.c index 075fd4e550..e2dea8b70e 100644 --- a/src/window.c +++ b/src/window.c @@ -2108,30 +2108,20 @@ though when run from an idle timer with a delay of zero seconds. */) || window_outdated (w)) return Qnil; - if (NILP (first)) - row = (NILP (body) - ? MATRIX_ROW (w->current_matrix, 0) - : MATRIX_FIRST_TEXT_ROW (w->current_matrix)); - else if (FIXNUMP (first)) - { - CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows); - row = MATRIX_ROW (w->current_matrix, XFIXNUM (first)); - } - else - error ("Invalid specification of first line"); - - if (NILP (last)) - - end_row = (NILP (body) - ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows) - : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)); - else if (FIXNUMP (last)) - { - CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows); - end_row = MATRIX_ROW (w->current_matrix, XFIXNUM (last)); - } - else - error ("Invalid specification of last line"); + row = (!NILP (first) + ? MATRIX_ROW (w->current_matrix, + check_integer_range (first, 0, + w->current_matrix->nrows)) + : NILP (body) + ? MATRIX_ROW (w->current_matrix, 0) + : MATRIX_FIRST_TEXT_ROW (w->current_matrix)); + end_row = (!NILP (last) + ? MATRIX_ROW (w->current_matrix, + check_integer_range (last, 0, + w->current_matrix->nrows)) + : NILP (body) + ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows) + : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)); while (row <= end_row && row->enabled_p && row->y + row->height < max_y) @@ -4325,11 +4315,11 @@ Note: This function does not operate on any child windows of WINDOW. */) EMACS_INT size_min = NILP (add) ? 0 : - XFIXNUM (w->new_pixel); EMACS_INT size_max = size_min + min (INT_MAX, MOST_POSITIVE_FIXNUM); - CHECK_RANGED_INTEGER (size, size_min, size_max); + int checked_size = check_integer_range (size, size_min, size_max); if (NILP (add)) wset_new_pixel (w, size); else - wset_new_pixel (w, make_fixnum (XFIXNUM (w->new_pixel) + XFIXNUM (size))); + wset_new_pixel (w, make_fixnum (XFIXNUM (w->new_pixel) + checked_size)); return w->new_pixel; } @@ -7506,8 +7496,7 @@ extract_dimension (Lisp_Object dimension) { if (NILP (dimension)) return -1; - CHECK_RANGED_INTEGER (dimension, 0, INT_MAX); - return XFIXNUM (dimension); + return check_integer_range (dimension, 0, INT_MAX); } static struct window * diff --git a/src/xfns.c b/src/xfns.c index 8de4c8bfd9..ebe51b70a5 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1230,13 +1230,10 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) for (i = 0; i < mouse_cursor_max; i++) { Lisp_Object shape_var = *mouse_cursor_types[i].shape_var_ptr; - if (!NILP (shape_var)) - { - CHECK_TYPE_RANGED_INTEGER (unsigned, shape_var); - cursor_data.cursor_num[i] = XFIXNUM (shape_var); - } - else - cursor_data.cursor_num[i] = mouse_cursor_types[i].default_shape; + cursor_data.cursor_num[i] + = (!NILP (shape_var) + ? check_uinteger_max (shape_var, UINT_MAX) + : mouse_cursor_types[i].default_shape); } block_input (); @@ -1801,10 +1798,7 @@ x_change_tool_bar_height (struct frame *f, int height) static void x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int border; - - CHECK_TYPE_RANGED_INTEGER (int, arg); - border = max (XFIXNUM (arg), 0); + int border = check_int_nonnegative (arg); if (border != FRAME_INTERNAL_BORDER_WIDTH (f)) { @@ -3376,10 +3370,12 @@ x_icon (struct frame *f, Lisp_Object parms) = gui_frame_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER); Lisp_Object icon_y = gui_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); + int icon_xval, icon_yval; + if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) { - CHECK_TYPE_RANGED_INTEGER (int, icon_x); - CHECK_TYPE_RANGED_INTEGER (int, icon_y); + icon_xval = check_integer_range (icon_x, INT_MIN, INT_MAX); + icon_yval = check_integer_range (icon_y, INT_MIN, INT_MAX); } else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); @@ -3387,7 +3383,7 @@ x_icon (struct frame *f, Lisp_Object parms) block_input (); if (! EQ (icon_x, Qunbound)) - x_wm_set_icon_position (f, XFIXNUM (icon_x), XFIXNUM (icon_y)); + x_wm_set_icon_position (f, icon_xval, icon_yval); #if false /* gui_display_get_arg removes the visibility parameter as a side effect, but x_create_frame still needs it. */ @@ -5550,12 +5546,12 @@ The coordinates X and Y are interpreted in pixels relative to a position if (FRAME_INITIAL_P (f) || !FRAME_X_P (f)) return Qnil; - CHECK_TYPE_RANGED_INTEGER (int, x); - CHECK_TYPE_RANGED_INTEGER (int, y); + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); block_input (); XWarpPointer (FRAME_X_DISPLAY (f), None, DefaultRootWindow (FRAME_X_DISPLAY (f)), - 0, 0, 0, 0, XFIXNUM (x), XFIXNUM (y)); + 0, 0, 0, 0, xval, yval); unblock_input (); return Qnil; diff --git a/src/xwidget.c b/src/xwidget.c index ea8987f5b3..0347f1e648 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -750,11 +750,9 @@ DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, (Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height) { CHECK_XWIDGET (xwidget); - CHECK_RANGED_INTEGER (new_width, 0, INT_MAX); - CHECK_RANGED_INTEGER (new_height, 0, INT_MAX); + int w = check_integer_range (new_width, 0, INT_MAX); + int h = check_integer_range (new_height, 0, INT_MAX); struct xwidget *xw = XXWIDGET (xwidget); - int w = XFIXNAT (new_width); - int h = XFIXNAT (new_height); xw->width = w; xw->height = h; commit 9b8dacdb264412b919782920da916e306102262a Author: Paul Eggert Date: Sun Apr 5 01:00:35 2020 -0700 * src/lisp.h: Update overly-optimistic comment. diff --git a/src/lisp.h b/src/lisp.h index 7fc3af992e..23ff89a977 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -331,8 +331,8 @@ typedef EMACS_INT Lisp_Word; used elsewhere. FIXME: Remove the lisp_h_OP macros, and define just the inline OP - functions, once "gcc -Og" (new to GCC 4.8) works well enough for - Emacs developers. Maybe in the year 2020. See Bug#11935. + functions, once "gcc -Og" (new to GCC 4.8) or equivalent works well + enough for Emacs developers. Maybe in the year 2025. See Bug#11935. For the macros that have corresponding functions (defined later), see these functions for commentary. */ commit 95a7c6ec58c8c8c905f3e11be49419750737ec97 Author: Stefan Monnier Date: Sat Apr 4 22:46:29 2020 -0400 * lisp/arc-mode.el: Rewrite displaying the summaries Completely rewrite the code that displayes the summaries, so all backends share the same code. (archive--summarize-descs): New function. (archive-arc-summarize, archive-lzh-summarize, archive-zip-summarize) (archive-zoo-summarize, archive-rar-summarize, archive-7z-summarize) (archive-ar-summarize): Use it. (archive-hidden-columns): New custom. (archive-alternate-hidden-columns): New const. (archive-mode-map): Always enable `archive-alternate-display`. (archive-alternate-display): Set `archive-hidden-columns`. (archive-hideshow-column): New command. (archive--fit, archive--fit2, archive--enabled-p): New aux functions. diff --git a/etc/NEWS b/etc/NEWS index fa33364054..81a70e9a97 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -101,6 +101,12 @@ horizontal movements now stop at the edge of the board. * Changes in Specialized Modes and Packages in Emacs 28.1 +** archive-mode +*** Can now modify members of 'ar' archives. +*** Display of summaries unified between backends +*** New var 'archive-hidden-columns' and cmd 'archive-hideshow-column' +These let you control which columns are displayed and which are kept hidden + ** Emacs-Lisp mode *** The mode-line now indicates whether we're using lexical or dynamic scoping. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index aae6dd684c..4d36667969 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -137,11 +137,24 @@ If nil, visiting such an archive displays the archive summary." :version "25.1" :type '(choice (const :tag "Visit the single file" t) (const :tag "Show the archive summary" nil))) + +(defcustom archive-hidden-columns '(Ids) + "Columns hidden from display." + :version "28.1" + :type '(set (const Mode) + (const Ids) + (const Date&Time) + (const Ratio))) + +(defconst archive-alternate-hidden-columns '(Mode Date&Time) + "Columns hidden when `archive-alternate-display' is used.") + ;; ------------------------------ ;; Arc archive configuration ;; We always go via a local file since there seems to be no reliable way ;; to extract to stdout without junk getting added. + (defgroup archive-arc nil "ARC-specific options to archive." :group 'archive) @@ -413,7 +426,6 @@ file. Archive and member name will be added." (cons "Immediate" (make-sparse-keymap "Immediate"))) (define-key map [menu-bar immediate alternate] '(menu-item "Alternate Display" archive-alternate-display - :enable (boundp (archive-name "alternate-display")) :help "Toggle alternate file info display")) (define-key map [menu-bar immediate view] '(menu-item "View This File" archive-view @@ -827,7 +839,27 @@ To avoid very long lines archive mode does not show all information. This function changes the set of information shown for each files." (interactive) (setq archive-alternate-display (not archive-alternate-display)) + (setq-local archive-hidden-columns + (if archive-alternate-display + archive-alternate-hidden-columns + (eval (car (or (get 'archive-hidden-columns 'customized-value) + (get 'archive-hidden-columns 'standard-value))) + t))) + (archive-resummarize)) + +(defun archive-hideshow-column (column) + "Toggle visibility of COLUMN." + (interactive + (list (intern + (completing-read "Toggle visibility of: " + '(Mode Ids Ratio Date&Time) + nil t)))) + (setq-local archive-hidden-columns + (if (memq column archive-hidden-columns) + (remove column archive-hidden-columns) + (cons column archive-hidden-columns))) (archive-resummarize)) + ;; ------------------------------------------------------------------------- ;;; Section: Local archive copy handling @@ -1454,15 +1486,134 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (let ((inhibit-read-only t)) (undo))) +(defun archive--fit (str len) + (let* ((spaces (- len (string-width str))) + (pre (/ spaces 2))) + (if (< spaces 1) + (substring str 0 len) + (concat (make-string pre ?\s) str (make-string (- spaces pre) ?\s))))) + +(defun archive--fit2 (str1 str2 len) + (let* ((spaces (- len (string-width str1) (string-width str2)))) + (if (< spaces 1) + (substring (concat str1 str2) 0 len) + (concat str1 (make-string spaces ?\s) str2)))) + +(defun archive--enabled-p (column) + (not (memq column archive-hidden-columns))) + +(defun archive--summarize-descs (descs) + (goto-char (point-min)) + (if (null descs) + (progn (insert "M ... Filename\n") + (insert "- ----- ---------------\n") + (archive-summarize-files nil) + (insert "- ----- ---------------\n")) + (let* ((sample (car descs)) + (maxsize 0) + (maxidlen 0) + (totalsize 0) + (times (archive--enabled-p 'Date&Time)) + (ids (and (archive--enabled-p 'Ids) + (or (archive--file-desc-uid sample) + (archive--file-desc-gid sample)))) + ;; For ratio, date/time, and mode, we presume that + ;; they're either present on all entries or on nonel, and that they + ;; take the same space on each of them. + (ratios (and (archive--enabled-p 'Ratio) + (archive--file-desc-ratio sample))) + (ratiolen (if ratios (string-width ratios))) + (timelen (length (archive--file-desc-time sample))) + (samplemode (and (archive--enabled-p 'Mode) + (archive--file-desc-mode sample))) + (modelen (length (if samplemode (archive-int-to-mode samplemode))))) + (dolist (desc descs) + (when ids + (let* ((uid (archive--file-desc-uid desc)) + (gid (archive--file-desc-uid desc)) + (len (cond + ((not uid) (string-width gid)) + ((not gid) (string-width uid)) + (t (+ (string-width uid) (string-width gid) 1))))) + (if (> len maxidlen) (setq maxidlen len)))) + (let ((size (archive--file-desc-size desc))) + (cl-incf totalsize size) + (if (> size maxsize) (setq maxsize size)))) + (let* ((sizelen (length (number-to-string maxsize))) + (dash + (concat + "- " + (if (> modelen 0) (concat (make-string modelen ?-) " ")) + (if ids (concat (make-string maxidlen ?-) " ")) + (make-string sizelen ?-) " " + (if ratios (concat (make-string (1+ ratiolen) ?-) " ")) + " " + (if times (concat (make-string timelen ?-) " ")) + "----------------\n")) + (startcol (+ 2 + (if (> modelen 0) (+ 2 modelen) 0) + (if ids (+ maxidlen 2) 0) + sizelen 2 + (if ratios (+ 2 ratiolen) 0) + (if times (+ timelen 2) 0)))) + (insert + (concat "M " + (if (> modelen 0) (concat (archive--fit "Mode" modelen) " ")) + (if ids (concat (archive--fit2 "Uid" "Gid" maxidlen) " ")) + (archive--fit "Size" sizelen) " " + (if ratios (concat (archive--fit "Cmp" (1+ ratiolen)) " ")) + " " + (if times (concat (archive--fit "Date&time" timelen) " ")) + " Filename\n")) + (insert dash) + (archive-summarize-files + (mapcar (lambda (desc) + (let* ((size (number-to-string + (archive--file-desc-size desc))) + (text + (concat " " + (when (> modelen 0) + (concat (archive-int-to-mode + (archive--file-desc-mode desc)) + " ")) + (when ids + (concat (archive--fit2 + (archive--file-desc-uid desc) + (archive--file-desc-gid desc) + maxidlen) " ")) + (make-string (- sizelen (length size)) ?\s) + size + " " + (when ratios + (concat (archive--file-desc-ratio desc) + "% ")) + " " + (when times + (concat (archive--file-desc-time desc) + " ")) + (archive--file-desc-int-file-name desc)))) + (archive--file-summary + text startcol (length text)))) + descs)) + (insert dash) + (insert (format (format "%%%dd %%s %%d files\n" + (+ 2 + (if (> modelen 0) (+ 2 modelen) 0) + (if ids (+ maxidlen 2) 0) + sizelen)) + totalsize + (make-string (+ (if times (+ 2 timelen) 0) + (if ratios (+ 2 ratiolen) 0) 1) + ?\s) + (length descs)))))) + (apply #'vector descs)) + ;; ------------------------------------------------------------------------- ;;; Section: Arc Archives (defun archive-arc-summarize () (let ((p 1) - (totalsize 0) - (maxlen 8) - files - visual) + files) (while (and (< (+ p 29) (point-max)) (= (get-byte p) ?\C-z) (> (get-byte (1+ p)) 0)) @@ -1475,40 +1626,15 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (modtime (archive-l-e (+ p 21) 2)) (ucsize (archive-l-e (+ p 25) 4)) (fiddle (string= efnname (upcase efnname))) - (ifnname (if fiddle (downcase efnname) efnname)) - (text (format " %8d %-11s %-8s %s" - ucsize - (archive-dosdate moddate) - (archive-dostime modtime) - ifnname))) - (setq maxlen (max maxlen fnlen) - totalsize (+ totalsize ucsize) - visual (cons (archive--file-summary - text - (- (length text) (length ifnname)) - (length text)) - visual) - files (cons (archive--file-desc + (ifnname (if fiddle (downcase efnname) efnname))) + (setq files (cons (archive--file-desc efnname ifnname nil ucsize (concat (archive-dosdate moddate) " " (archive-dostime modtime)) :pos (1- p)) files) p (+ p 29 csize)))) - (goto-char (point-min)) - (let ((dash (concat "- -------- ----------- -------- " - (make-string maxlen ?-) - "\n"))) - (insert "M Length Date Time File\n" - dash) - (archive-summarize-files (nreverse visual)) - (insert dash - (format " %8d %d file%s" - totalsize - (length files) - (if (= 1 (length files)) "" "s")) - "\n")) - (apply #'vector (nreverse files)))) + (archive--summarize-descs (nreverse files)))) (defun archive-arc-rename-entry (newname descr) (if (string-match "[:\\/]" newname) @@ -1529,10 +1655,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (defun archive-lzh-summarize (&optional start) (let ((p (or start 1)) ;; 1 for .lzh, something further on for .exe - (totalsize 0) - (maxlen 8) - files - visual) + files) (while (progn (goto-char p) ;beginning of a base header. (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-")) (let* ((hsize (get-byte p)) ;size of the base header (level 0 and 1) @@ -1543,9 +1666,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.) (hdrlvl (get-byte (+ p 20))) ;header level thsize ;total header size (base + extensions) - fnlen efnname osid fiddle ifnname width p2 + fnlen efnname osid fiddle ifnname p2 neh ;beginning of next extension header (level 1 and 2) - mode modestr uid gid text dir prname + mode uid gid dir prname gname uname modtime moddate) (if (= hdrlvl 3) (error "can't handle lzh level 3 header type")) (when (or (= hdrlvl 0) (= hdrlvl 1)) @@ -1558,26 +1681,26 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (setq neh (+ p2 3)) ;specific to level 1 header (if (= hdrlvl 2) (setq neh (+ p 24)))) ;specific to level 2 header - (if neh ;if level 1 or 2 we expect extension headers to follow + (if neh ;if level 1 or 2 we expect extension headers to follow (let* ((ehsize (archive-l-e neh 2)) ;size of the extension header (etype (get-byte (+ neh 2)))) ;extension type (while (not (= ehsize 0)) - (cond - ((= etype 1) ;file name + (cond + ((= etype 1) ;file name (let ((i (+ neh 3))) (while (< i (+ neh ehsize)) (setq efnname (concat efnname (char-to-string (get-byte i)))) (setq i (1+ i))))) - ((= etype 2) ;directory name + ((= etype 2) ;directory name (let ((i (+ neh 3))) (while (< i (+ neh ehsize)) - (setq dir (concat dir - (if (= (get-byte i) - 255) - "/" - (char-to-string - (char-after i))))) - (setq i (1+ i))))) + (setq dir (concat dir + (if (= (get-byte i) + 255) + "/" + (char-to-string + (char-after i))))) + (setq i (1+ i))))) ((= etype 80) ;Unix file permission (setq mode (archive-l-e (+ neh 3) 2))) ((= etype 81) ;UNIX file group/user ID @@ -1593,7 +1716,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (while (< i (+ neh ehsize)) (setq uname (concat uname (char-to-string (char-after i)))) (setq i (1+ i))))) - ) + ) (setq neh (+ neh ehsize)) (setq ehsize (archive-l-e neh 2)) (setq etype (get-byte (+ neh 2)))) @@ -1619,66 +1742,25 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ((= 0 osid) (string= efnname (upcase efnname))))) (setq ifnname (if fiddle (downcase efnname) efnname)) (setq prname (if dir (concat dir ifnname) ifnname)) - (setq width (if prname (string-width prname) 0)) - (setq modestr (archive-int-to-mode mode)) (setq moddate (if (= hdrlvl 2) (archive-unixdate time1 time2) ;level 2 header in UNIX format (archive-dosdate time2))) ;level 0 and 1 header in DOS format (setq modtime (if (= hdrlvl 2) (archive-unixtime time1 time2) (archive-dostime time1))) - (setq text (if archive-alternate-display - (format " %8d %5S %5S %s" - ucsize - (or uid "?") - (or gid "?") - ifnname) - (format " %10s %8d %-11s %-8s %s" - modestr - ucsize - moddate - modtime - prname))) - (setq maxlen (max maxlen width) - totalsize (+ totalsize ucsize) - visual (cons (archive--file-summary - text - (- (length text) (length prname)) - (length text)) - visual) - files (cons (archive--file-desc - prname ifnname mode ucsize - (concat moddate " " modtime) - :pos (1- p) - :uid (or uname (if uid (number-to-string uid))) - :gid (or gname (if gid (number-to-string gid)))) - files)) + (push (archive--file-desc + prname ifnname mode ucsize + (concat moddate " " modtime) + :pos (1- p) + :uid (or uname (if uid (number-to-string uid))) + :gid (or gname (if gid (number-to-string gid)))) + files) (cond ((= hdrlvl 1) (setq p (+ p hsize 2 csize))) ((or (= hdrlvl 2) (= hdrlvl 0)) (setq p (+ p thsize 2 csize)))) )) - (goto-char (point-min)) - (let ((dash (concat (if archive-alternate-display - "- -------- ----- ----- " - "- ---------- -------- ----------- -------- ") - (make-string maxlen ?-) - "\n")) - (header (if archive-alternate-display - "M Length Uid Gid File\n" - "M Filemode Length Date Time File\n")) - (sumline (if archive-alternate-display - " %8.0f %d file%s" - " %8.0f %d file%s"))) - (insert header dash) - (archive-summarize-files (nreverse visual)) - (insert dash - (format sumline - totalsize - (length files) - (if (= 1 (length files)) "" "s")) - "\n")) - (apply #'vector (nreverse files)))) + (archive--summarize-descs (nreverse files)))) (defconst archive-lzh-alternate-display t) @@ -1782,10 +1864,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (goto-char (- (point-max) (- 22 18))) (search-backward-regexp "[P]K\005\006") (let ((p (archive-l-e (+ (point) 16) 4)) - (maxlen 8) - (totalsize 0) - files - visual) + files) (when (= p -1) ;; If the offset of end-of-central-directory is -1, this is a ;; Zip64 extended ZIP file format, and we need to glean the info @@ -1826,48 +1905,18 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (logand 1 (get-byte (+ p 38)))) ?\222 0))) (t nil))) - (modestr (archive-int-to-mode mode)) (fiddle (and archive-zip-case-fiddle (memq creator '(0 2 4 5 9)) (string= (upcase efnname) efnname))) - (ifnname (if fiddle (downcase efnname) efnname)) - (width (string-width ifnname)) - (text (format " %10s %8d %-11s %-8s %s" - modestr - ucsize - (archive-dosdate moddate) - (archive-dostime modtime) - ifnname))) - (setq maxlen (max maxlen width) - totalsize (+ totalsize ucsize) - visual (cons (archive--file-summary - text - (- (length text) (length ifnname)) - (length text)) - visual) - files (cons (if isdir - nil - (archive--file-desc - efnname ifnname mode ucsize - (concat (archive-dosdate moddate) - " " (archive-dostime modtime)) - :pos (1- p))) - files) + (ifnname (if fiddle (downcase efnname) efnname))) + (setq files (cons (archive--file-desc + efnname ifnname mode ucsize + (concat (archive-dosdate moddate) + " " (archive-dostime modtime)) + :pos (1- p)) + files) p (+ p 46 fnlen exlen fclen)))) - (goto-char (point-min)) - (let ((dash (concat "- ---------- -------- ----------- -------- " - (make-string maxlen ?-) - "\n"))) - (insert "M Filemode Length Date Time File\n" - dash) - (archive-summarize-files (nreverse visual)) - (insert dash - (format " %8d %d file%s" - totalsize - (length files) - (if (= 1 (length files)) "" "s")) - "\n")) - (apply #'vector (nreverse files)))) + (archive--summarize-descs (nreverse files)))) (defun archive-zip-extract (archive name) (cond @@ -1931,10 +1980,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (defun archive-zoo-summarize () (let ((p (1+ (archive-l-e 25 4))) - (maxlen 8) - (totalsize 0) - files - visual) + files) (while (and (string= "\334\247\304\375" (buffer-substring p (+ p 4))) (> (archive-l-e (+ p 6) 4) 0)) (let* ((next (1+ (archive-l-e (+ p 6) 4))) @@ -1961,40 +2007,14 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (decode-coding-string str archive-file-name-coding-system))) (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname)))) - (ifnname (if fiddle (downcase efnname) efnname)) - (width (string-width ifnname)) - (text (format " %8d %-11s %-8s %s" - ucsize - (archive-dosdate moddate) - (archive-dostime modtime) - ifnname))) - (setq maxlen (max maxlen width) - totalsize (+ totalsize ucsize) - visual (cons (archive--file-summary - text - (- (length text) (length ifnname)) - (length text)) - visual) - files (cons (archive--file-desc + (ifnname (if fiddle (downcase efnname) efnname))) + (setq files (cons (archive--file-desc efnname ifnname nil ucsize (concat (archive-dosdate moddate) " " (archive-dostime modtime))) files) p next))) - (goto-char (point-min)) - (let ((dash (concat "- -------- ----------- -------- " - (make-string maxlen ?-) - "\n"))) - (insert "M Length Date Time File\n" - dash) - (archive-summarize-files (nreverse visual)) - (insert dash - (format " %8d %d file%s" - totalsize - (length files) - (if (= 1 (length files)) "" "s")) - "\n")) - (apply #'vector (nreverse files)))) + (archive--summarize-descs (nreverse files)))) (defun archive-zoo-extract (archive name) (archive-extract-by-stdout archive name archive-zoo-extract)) @@ -2006,17 +2026,16 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; File is used internally for `archive-rar-exe-summarize'. (unless file (setq file buffer-file-name)) (let* ((copy (file-local-copy file)) - (maxname 10) - (maxsize 5) (files ())) (with-temp-buffer - (call-process "lsar" nil t nil "-l" (or file copy)) - (if copy (delete-file copy)) + (unwind-protect + (call-process "lsar" nil t nil "-l" (or file copy)) + (if copy (delete-file copy))) (goto-char (point-min)) (re-search-forward "^\\(\s+=+\s*\\)+\n") (while (looking-at (concat "^\s+[0-9.]+\s+D?-+\s+" ; Flags "\\([0-9-]+\\)\s+" ; Size - "\\([-0-9.%]+\\)\s+" ; Ratio + "\\([-0-9.]+\\)%?\s+" ; Ratio "\\([0-9a-zA-Z]+\\)\s+" ; Mode "\\([0-9-]+\\)\s+" ; Date "\\([0-9:]+\\)\s+" ; Time @@ -2025,8 +2044,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (goto-char (match-end 0)) (let ((name (match-string 6)) (size (match-string 1))) - (if (> (length name) maxname) (setq maxname (length name))) - (if (> (length size) maxsize) (setq maxsize (length size))) (push (archive--file-desc name name nil ;; Size (string-to-number size) @@ -2034,29 +2051,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (concat (match-string 4) " " (match-string 5)) :ratio (match-string 2)) files)))) - (setq files (nreverse files)) - (goto-char (point-min)) - (let* ((format (format " %%s %%%ds %%5s %%s" maxsize)) - (sep (format format "---------- -----" (make-string maxsize ?-) - "-----" "")) - (column (length sep))) - (insert (format format " Date Time " "Size" "Ratio" "Filename") "\n") - (insert sep (make-string maxname ?-) "\n") - (archive-summarize-files - (mapcar (lambda (desc) - (let ((text - (format format - (archive--file-desc-time desc) - (archive--file-desc-size desc) - (archive--file-desc-ratio desc) - (archive--file-desc-int-file-name desc)))) - (archive--file-summary - text - column - (length text)))) - files)) - (insert sep (make-string maxname ?-) "\n") - (apply #'vector files)))) + (archive--summarize-descs (nreverse files)))) (defun archive-rar-extract (archive name) ;; unrar-free seems to have no way to extract to stdout or even to a file. @@ -2103,9 +2098,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;;; Section: 7z Archives (defun archive-7z-summarize () - (let ((maxname 10) - (maxsize 5) - (file buffer-file-name) + (let ((file buffer-file-name) (files ())) (with-temp-buffer (call-process archive-7z-program nil t nil "l" "-slt" file) @@ -2122,29 +2115,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (time (save-excursion (and (re-search-forward "^Modified = \\(.*\\)\n") (match-string 1))))) - (if (> (length name) maxname) (setq maxname (length name))) - (if (> (length size) maxsize) (setq maxsize (length size))) (push (archive--file-desc name name nil (string-to-number size) time) files)))) - (setq files (nreverse files)) - (goto-char (point-min)) - (let* ((format (format " %%%ds %%s %%s" maxsize)) - (sep (format format (make-string maxsize ?-) "-------------------" "")) - (column (length sep))) - (insert (format format "Size " "Date Time " " Filename") "\n") - (insert sep (make-string maxname ?-) "\n") - (archive-summarize-files - (mapcar (lambda (desc) - (let ((text - (format format - (archive--file-desc-size desc) - (archive--file-desc-time desc) - (archive--file-desc-int-file-name desc)))) - (archive--file-summary - text column (length text)))) - files)) - (insert sep (make-string maxname ?-) "\n") - (apply #'vector files)))) + (archive--summarize-descs (nreverse files)))) (defun archive-7z-extract (archive name) ;; 7z doesn't provide a `quiet' option to suppress non-essential @@ -2184,13 +2157,7 @@ NAME is expected to be the 16-bytes part of an ar record." (defun archive-ar-summarize () ;; File is used internally for `archive-rar-exe-summarize'. - (let* ((maxname 10) - (maxtime 16) - (maxuser 5) - (maxgroup 5) - (maxmode 10) - (maxsize 5) - (files ())) + (let* ((files ())) (goto-char (point-min)) (search-forward "!\n") (while (looking-at archive-ar-file-header-re) @@ -2210,43 +2177,10 @@ NAME is expected to be the 16-bytes part of an ar record." (setq group (substring group 0 (string-match " +\\'" group))) ;; Move to the end of the data. (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)) - (if (> (length name) maxname) (setq maxname (length name))) - (if (> (length time) maxtime) (setq maxtime (length time))) - (if (> (length user) maxuser) (setq maxuser (length user))) - (if (> (length group) maxgroup) (setq maxgroup (length group))) - (if (> (length sizestr) maxsize) (setq maxsize (length sizestr))) (push (archive--file-desc extname extname mode size time :uid user :gid group) files))) - (setq files (nreverse files)) - (goto-char (point-min)) - (let* ((format (format "%%%ds %%%ds/%%-%ds %%%ds %%%ds %%s" - maxmode maxuser maxgroup maxsize maxtime)) - (sep (format format (make-string maxmode ?-) - (make-string maxuser ?-) - (make-string maxgroup ?-) - (make-string maxsize ?-) - (make-string maxtime ?-) "")) - (column (length sep))) - (insert (format format " Mode " "User" "Group" " Size " - " Date " "Filename") - "\n") - (insert sep (make-string maxname ?-) "\n") - (archive-summarize-files - (mapcar (lambda (desc) - (let ((text - (format format - (archive-int-to-mode - (archive--file-desc-mode desc)) - (archive--file-desc-uid desc) - (archive--file-desc-gid desc) - (archive--file-desc-size desc) - (archive--file-desc-time desc) - (archive--file-desc-int-file-name desc)))) - (archive--file-summary text column (length text)))) - files)) - (insert sep (make-string maxname ?-) "\n") - (apply #'vector files)))) + (archive--summarize-descs (nreverse files)))) (defun archive-ar-extract (archive name) (let ((destbuf (current-buffer)) @@ -2266,7 +2200,8 @@ NAME is expected to be the 16-bytes part of an ar record." (if (equal name (archive-ar--name this)) (setq from (point)) ;; Move to the end of the data. - (forward-char size) (if (eq ?\n (char-after)) (forward-char 1))))) + (forward-char size) + (if (eq ?\n (char-after)) (forward-char 1))))) (when from (set-buffer-multibyte nil) (with-current-buffer destbuf commit 83f9094316de5a5a67ecf41ae93f7950dd27d569 Author: Stefan Monnier Date: Sat Apr 4 22:35:39 2020 -0400 * lisp/arc-mode.el: Remove make-(local-variable|variable-buffer-local) (archive-file-list-start, archive-file-list-end) (archive-proper-file-start, archive-file-name-indent, archive-remote) (archive-member-coding-system, archive-alternate-display) (archive-file-name-coding-system, archive-files): Use `defvar-local`. (archive-extract): Use `setq-local`. (archive-get-descr): Use `user-error` when clicking on a directory. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 2cca02665f..aae6dd684c 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -362,9 +362,9 @@ file. Archive and member name will be added." ;;; Section: Variables (defvar archive-subtype nil "Symbol describing archive type.") -(defvar archive-file-list-start nil "Position of first contents line.") -(defvar archive-file-list-end nil "Position just after last contents line.") -(defvar archive-proper-file-start nil "Position of real archive's start.") +(defvar-local archive-file-list-start nil "Position of first contents line.") +(defvar-local archive-file-list-end nil "Position just after last contents line.") +(defvar-local archive-proper-file-start nil "Position of real archive's start.") (defvar archive-read-only nil "Non-nil if the archive is read-only on disk.") (defvar-local archive-local-name nil "Name of local copy of remote archive.") (defvar archive-mode-map @@ -468,18 +468,15 @@ file. Archive and member name will be added." :help "Delete all flagged files from archive")) map) "Local keymap for archive mode listings.") -(defvar archive-file-name-indent nil "Column where file names start.") +(defvar-local archive-file-name-indent nil "Column where file names start.") -(defvar archive-remote nil "Non-nil if the archive is outside file system.") -(make-variable-buffer-local 'archive-remote) +(defvar-local archive-remote nil "Non-nil if the archive is outside file system.") (put 'archive-remote 'permanent-local t) -(defvar archive-member-coding-system nil "Coding-system of archive member.") -(make-variable-buffer-local 'archive-member-coding-system) +(defvar-local archive-member-coding-system nil "Coding-system of archive member.") -(defvar archive-alternate-display nil +(defvar-local archive-alternate-display nil "Non-nil when alternate information is shown.") -(make-variable-buffer-local 'archive-alternate-display) (put 'archive-alternate-display 'permanent-local t) (defvar archive-superior-buffer nil "In archive members, points to archive.") @@ -490,8 +487,7 @@ file. Archive and member name will be added." Its value is an `archive--file-desc'.") (put 'archive-subfile-mode 'permanent-local t) -(defvar archive-file-name-coding-system nil) -(make-variable-buffer-local 'archive-file-name-coding-system) +(defvar-local archive-file-name-coding-system nil) (put 'archive-file-name-coding-system 'permanent-local t) (cl-defstruct (archive--file-desc @@ -522,9 +518,8 @@ Its value is an `archive--file-desc'.") ;; ;; LZH has alternate display (with UID/GID i.s.o MODE/DATE/TIME -(defvar archive-files nil +(defvar-local archive-files nil "Vector of `archive--file-desc' objects.") -(make-variable-buffer-local 'archive-files) ;; ------------------------------------------------------------------------- ;;; Section: Support functions. @@ -642,7 +637,7 @@ Does not signal an error if optional argument NOERROR is non-nil." (zerop (logand 16384 mode)))) item (if (not noerror) - (error "Entry is not a regular member of the archive")))) + (user-error "Entry is not a regular member of the archive")))) (if (not noerror) (error "Line does not describe a member of the archive"))))) ;; ------------------------------------------------------------------------- @@ -708,10 +703,6 @@ archive. (run-mode-hooks (archive-name "mode-hook") 'archive-mode-hook) (use-local-map archive-mode-map)) - (make-local-variable 'archive-proper-file-start) - (make-local-variable 'archive-file-list-start) - (make-local-variable 'archive-file-list-end) - (make-local-variable 'archive-file-name-indent) (setq archive-file-name-coding-system (or file-name-coding-system default-file-name-coding-system @@ -901,6 +892,7 @@ using `make-temp-file', and the generated name is returned." (lno (archive-get-lineno)) (inhibit-read-only t)) (if unchanged nil + ;; FIXME: Use archive-resummarize? (setq archive-files nil) (erase-buffer) (insert-file-contents name) @@ -1021,8 +1013,7 @@ using `make-temp-file', and the generated name is returned." (abbreviate-file-name buffer-file-name)) ;; Set the default-directory to the dir of the superior buffer. (setq default-directory arcdir) - (make-local-variable 'archive-superior-buffer) - (setq archive-superior-buffer archive-buffer) + (setq-local archive-superior-buffer archive-buffer) (add-hook 'write-file-functions #'archive-write-file-member nil t) (setq archive-subfile-mode descr) (setq archive-file-name-coding-system file-name-coding) commit e6b5cd0edacb5663859f6a6f93d82a0a4d486e83 Author: Paul Eggert Date: Sat Apr 4 18:26:21 2020 -0700 Avoid SAFE_ALLOCA in Fstring, Funibyte_string * src/character.c (Fstring, Funibyte_string): Redo to avoid the need for a temporary array allocation and then a copying from that array to the destination. diff --git a/src/character.c b/src/character.c index d71cb3f145..a566cacb02 100644 --- a/src/character.c +++ b/src/character.c @@ -849,24 +849,22 @@ Concatenate all the argument characters and make the result a string. usage: (string &rest CHARACTERS) */) (ptrdiff_t n, Lisp_Object *args) { - ptrdiff_t i; - int c; - unsigned char *buf, *p; - Lisp_Object str; - USE_SAFE_ALLOCA; - - SAFE_NALLOCA (buf, MAX_MULTIBYTE_LENGTH, n); - p = buf; - - for (i = 0; i < n; i++) + ptrdiff_t nbytes = 0; + for (ptrdiff_t i = 0; i < n; i++) { CHECK_CHARACTER (args[i]); - c = XFIXNUM (args[i]); + nbytes += CHAR_BYTES (XFIXNUM (args[i])); + } + if (nbytes == n) + return Funibyte_string (n, args); + Lisp_Object str = make_uninit_multibyte_string (n, nbytes); + unsigned char *p = SDATA (str); + for (ptrdiff_t i = 0; i < n; i++) + { + eassume (CHARACTERP (args[i])); + int c = XFIXNUM (args[i]); p += CHAR_STRING (c, p); } - - str = make_string_from_bytes ((char *) buf, n, p - buf); - SAFE_FREE (); return str; } @@ -875,20 +873,13 @@ DEFUN ("unibyte-string", Funibyte_string, Sunibyte_string, 0, MANY, 0, usage: (unibyte-string &rest BYTES) */) (ptrdiff_t n, Lisp_Object *args) { - ptrdiff_t i; - Lisp_Object str; - USE_SAFE_ALLOCA; - unsigned char *buf = SAFE_ALLOCA (n); - unsigned char *p = buf; - - for (i = 0; i < n; i++) + Lisp_Object str = make_uninit_string (n); + unsigned char *p = SDATA (str); + for (ptrdiff_t i = 0; i < n; i++) { CHECK_RANGED_INTEGER (args[i], 0, 255); *p++ = XFIXNUM (args[i]); } - - str = make_string_from_bytes ((char *) buf, n, p - buf); - SAFE_FREE (); return str; } commit c09457e6ed85da8bdc287851a05c4e3f95a44033 Author: Stefan Monnier Date: Fri Apr 3 22:27:54 2020 -0400 * lisp/arc-mode.el (archive--file-desc): Add fields from other structs Add fields `size`, `time` (used by all backends) as well as `pos`, `ratio`, `uid`, and `gid` (used only be some backends). (archive-arc--file-desc, archive-rar--file-desc, archive-ar--file-desc) (archive-lzh--file-desc, archive-zip--file-desc, archive-7z--file-desc): Remove defstructs. (archive-arc-summarize): Record size and time in the descrs. (archive-lzh-summarize): Record size, time, uid, and gid in the descrs. (archive-zip-summarize): Record size and time in the descrs. (archive-zoo-summarize): Record size and time in the descrs. (archive-rar-summarize): Adjust to use of `archive--file-desc`. (archive-7z-summarize): Adjust to new constructor. (archive-ar-summarize): Adjust to use of `archive--file-desc`. (archive-ar-write-file-member): Remove mode-to-int hack. (archive-get-descr): Directory entries aren't regular members. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 0a7816c225..2cca02665f 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -500,18 +500,25 @@ Its value is an `archive--file-desc'.") ;; ext-file-name and int-file-name are usually `eq' ;; except when int-file-name is the downcased ;; ext-file-name. - (ext-file-name int-file-name mode))) - ext-file-name int-file-name mode) + (ext-file-name int-file-name mode size time + &key pos ratio uid gid))) + ext-file-name int-file-name + (mode nil :type integer) + (size nil :type integer) + (time nil :type string) + (ratio nil :type string) + uid gid + pos) ;; Features in formats: ;; -;; ARC: size, date, time (date and time strings internally generated) -;; LZH: size, date, time, mode, uid, gid (mode, date, time generated, ugid:int) -;; ZIP: size, date, time, mode (mode, date, time generated) -;; ZOO: size, date, time (date and time strings internally generated) -;; AR : size, date, time, mode, user, group (internally generated) -;; RAR: size, date, time, ratio (all as strings, using `lsar') -;; 7Z : size, date, time (all as strings, using `7z' or `7za') +;; ARC: size, date&time (date and time strings internally generated) +;; LZH: size, date&time, mode, uid, gid (mode, date, time generated, ugid:int) +;; ZIP: size, date&time, mode (mode, date, time generated) +;; ZOO: size, date&time (date and time strings internally generated) +;; AR : size, date&time, mode, user, group (internally generated) +;; RAR: size, date&time, ratio (all as strings, using `lsar') +;; 7Z : size, date&time (all as strings, using `7z' or `7za') ;; ;; LZH has alternate display (with UID/GID i.s.o MODE/DATE/TIME @@ -630,7 +637,9 @@ Does not signal an error if optional argument NOERROR is non-nil." (if (and (>= (point) archive-file-list-start) (< no (length archive-files))) (let ((item (aref archive-files no))) - (if (archive--file-desc-p item) + (if (and (archive--file-desc-p item) + (let ((mode (archive--file-desc-mode item))) + (zerop (logand 16384 mode)))) item (if (not noerror) (error "Entry is not a regular member of the archive")))) @@ -1453,16 +1462,10 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (interactive) (let ((inhibit-read-only t)) (undo))) + ;; ------------------------------------------------------------------------- ;;; Section: Arc Archives -(cl-defstruct (archive-arc--file-desc - (:include archive--file-desc) - (:constructor nil) - (:constructor archive-arc--file-desc - (ext-file-name int-file-name mode pos))) - pos) - (defun archive-arc-summarize () (let ((p 1) (totalsize 0) @@ -1494,8 +1497,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (- (length text) (length ifnname)) (length text)) visual) - files (cons (archive-arc--file-desc - efnname ifnname nil (1- p)) + files (cons (archive--file-desc + efnname ifnname nil ucsize + (concat (archive-dosdate moddate) + " " (archive-dostime modtime)) + :pos (1- p)) files) p (+ p 29 csize)))) (goto-char (point-min)) @@ -1524,19 +1530,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (save-excursion (widen) (goto-char (+ archive-proper-file-start 2 - (archive-arc--file-desc-pos descr))) + (archive--file-desc-pos descr))) (delete-char 13) (arc-insert-unibyte name))))) ;; ------------------------------------------------------------------------- ;;; Section: Lzh Archives -(cl-defstruct (archive-lzh--file-desc - (:include archive--file-desc) - (:constructor nil) - (:constructor archive-lzh--file-desc - (ext-file-name int-file-name mode pos))) - pos) - (defun archive-lzh-summarize (&optional start) (let ((p (or start 1)) ;; 1 for .lzh, something further on for .exe (totalsize 0) @@ -1656,8 +1655,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (- (length text) (length prname)) (length text)) visual) - files (cons (archive-lzh--file-desc - prname ifnname mode (1- p)) + files (cons (archive--file-desc + prname ifnname mode ucsize + (concat moddate " " modtime) + :pos (1- p) + :uid (or uname (if uid (number-to-string uid))) + :gid (or gname (if gid (number-to-string gid)))) files)) (cond ((= hdrlvl 1) (setq p (+ p hsize 2 csize))) @@ -1704,7 +1707,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (save-excursion (widen) (let* ((p (+ archive-proper-file-start - (archive-lzh--file-desc-pos descr))) + (archive--file-desc-pos descr))) (oldhsize (get-byte p)) (oldfnlen (get-byte (+ p 21))) (newfnlen (length newname)) @@ -1724,7 +1727,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (save-restriction (widen) (dolist (fil files) - (let* ((p (+ archive-proper-file-start (archive-lzh--file-desc-pos fil))) + (let* ((p (+ archive-proper-file-start (archive--file-desc-pos fil))) (hsize (get-byte p)) (fnlen (get-byte (+ p 21))) (p2 (+ p 22 fnlen)) @@ -1784,13 +1787,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: Zip Archives -(cl-defstruct (archive-zip--file-desc - (:include archive--file-desc) - (:constructor nil) - (:constructor archive-zip--file-desc - (ext-file-name int-file-name mode pos))) - pos) - (defun archive-zip-summarize () (goto-char (- (point-max) (- 22 18))) (search-backward-regexp "[P]K\005\006") @@ -1860,8 +1856,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." visual) files (cons (if isdir nil - (archive-zip--file-desc efnname ifnname mode - (1- p))) + (archive--file-desc + efnname ifnname mode ucsize + (concat (archive-dosdate moddate) + " " (archive-dostime modtime)) + :pos (1- p))) files) p (+ p 46 fnlen exlen fclen)))) (goto-char (point-min)) @@ -1919,7 +1918,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (widen) (dolist (fil files) (let* ((p (+ archive-proper-file-start - (archive-zip--file-desc-pos fil))) + (archive--file-desc-pos fil))) (creator (get-byte (+ p 5))) (oldmode (archive--file-desc-mode fil)) (newval (archive-calc-mode oldmode newmode)) @@ -1985,8 +1984,10 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (- (length text) (length ifnname)) (length text)) visual) - ;; FIXME: Keep size/date(/mode?) in the desc! - files (cons (archive--file-desc efnname ifnname nil) + files (cons (archive--file-desc + efnname ifnname nil ucsize + (concat (archive-dosdate moddate) + " " (archive-dostime modtime))) files) p next))) (goto-char (point-min)) @@ -2010,13 +2011,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: Rar Archives -(cl-defstruct (archive-rar--file-desc - (:include archive--file-desc) - (:constructor nil) - (:constructor archive-rar--file-desc - (ext-file-name int-file-name mode size ratio date time))) - size ratio date time) - (defun archive-rar-summarize (&optional file) ;; File is used internally for `archive-rar-exe-summarize'. (unless file (setq file buffer-file-name)) @@ -2042,28 +2036,28 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (size (match-string 1))) (if (> (length name) maxname) (setq maxname (length name))) (if (> (length size) maxsize) (setq maxsize (length size))) - (push (archive-rar--file-desc name name nil - ;; Size, Ratio. - size (match-string 2) - ;; Date, Time. - (match-string 4) (match-string 5)) + (push (archive--file-desc name name nil + ;; Size + (string-to-number size) + ;; Date&Time. + (concat (match-string 4) " " (match-string 5)) + :ratio (match-string 2)) files)))) (setq files (nreverse files)) (goto-char (point-min)) - (let* ((format (format " %%s %%s %%%ds %%5s %%s" maxsize)) - (sep (format format "----------" "-----" (make-string maxsize ?-) + (let* ((format (format " %%s %%%ds %%5s %%s" maxsize)) + (sep (format format "---------- -----" (make-string maxsize ?-) "-----" "")) (column (length sep))) - (insert (format format " Date " "Time " "Size" "Ratio" "Filename") "\n") + (insert (format format " Date Time " "Size" "Ratio" "Filename") "\n") (insert sep (make-string maxname ?-) "\n") (archive-summarize-files (mapcar (lambda (desc) (let ((text (format format - (archive-rar--file-desc-date desc) - (archive-rar--file-desc-time desc) - (archive-rar--file-desc-size desc) - (archive-rar--file-desc-ratio desc) + (archive--file-desc-time desc) + (archive--file-desc-size desc) + (archive--file-desc-ratio desc) (archive--file-desc-int-file-name desc)))) (archive--file-summary text @@ -2117,13 +2111,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; ------------------------------------------------------------------------- ;;; Section: 7z Archives -(cl-defstruct (archive-7z--file-desc - (:include archive--file-desc) - (:constructor nil) - (:constructor archive-7z--file-desc - (ext-file-name int-file-name mode time size))) - time size) - (defun archive-7z-summarize () (let ((maxname 10) (maxsize 5) @@ -2146,7 +2133,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (match-string 1))))) (if (> (length name) maxname) (setq maxname (length name))) (if (> (length size) maxsize) (setq maxsize (length size))) - (push (archive-7z--file-desc name name nil time size) + (push (archive--file-desc name name nil (string-to-number size) time) files)))) (setq files (nreverse files)) (goto-char (point-min)) @@ -2159,8 +2146,8 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (mapcar (lambda (desc) (let ((text (format format - (archive-7z--file-desc-size desc) - (archive-7z--file-desc-time desc) + (archive--file-desc-size desc) + (archive--file-desc-time desc) (archive--file-desc-int-file-name desc)))) (archive--file-summary text column (length text)))) @@ -2188,13 +2175,6 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; not the GNU nor the BSD extensions. As it turns out, this is sufficient ;; for .deb packages. -(cl-defstruct (archive-ar--file-desc - (:include archive--file-desc) - (:constructor nil) - (:constructor archive-ar--file-desc - (ext-file-name int-file-name mode time user group size))) - time user group size) - (autoload 'tar-grind-file-mode "tar-mode") (defconst archive-ar-file-header-re @@ -2217,47 +2197,45 @@ NAME is expected to be the 16-bytes part of an ar record." (maxtime 16) (maxuser 5) (maxgroup 5) - (maxmode 8) + (maxmode 10) (maxsize 5) (files ())) (goto-char (point-min)) (search-forward "!\n") (while (looking-at archive-ar-file-header-re) - (let ((name (match-string 1)) - extname - (time (string-to-number (match-string 2))) - (user (match-string 3)) - (group (match-string 4)) - (mode (string-to-number (match-string 5) 8)) - (size (string-to-number (match-string 6)))) + (let* ((name (match-string 1)) + extname + (time (string-to-number (match-string 2))) + (user (match-string 3)) + (group (match-string 4)) + (mode (string-to-number (match-string 5) 8)) + (sizestr (match-string 6)) + (size (string-to-number sizestr))) ;; Move to the beginning of the data. (goto-char (match-end 0)) (setq time (format-time-string "%Y-%m-%d %H:%M" time)) (setq extname (archive-ar--name name)) (setq user (substring user 0 (string-match " +\\'" user))) (setq group (substring group 0 (string-match " +\\'" group))) - (setq mode (archive-int-to-mode mode)) ;; Move to the end of the data. (forward-char size) (if (eq ?\n (char-after)) (forward-char 1)) - (setq size (number-to-string size)) (if (> (length name) maxname) (setq maxname (length name))) (if (> (length time) maxtime) (setq maxtime (length time))) (if (> (length user) maxuser) (setq maxuser (length user))) (if (> (length group) maxgroup) (setq maxgroup (length group))) - (if (> (length mode) maxmode) (setq maxmode (length mode))) - (if (> (length size) maxsize) (setq maxsize (length size))) - (push (archive-ar--file-desc extname extname mode - time user group size) + (if (> (length sizestr) maxsize) (setq maxsize (length sizestr))) + (push (archive--file-desc extname extname mode size time + :uid user :gid group) files))) (setq files (nreverse files)) (goto-char (point-min)) (let* ((format (format "%%%ds %%%ds/%%-%ds %%%ds %%%ds %%s" maxmode maxuser maxgroup maxsize maxtime)) (sep (format format (make-string maxmode ?-) - (make-string maxuser ?-) - (make-string maxgroup ?-) - (make-string maxsize ?-) - (make-string maxtime ?-) "")) + (make-string maxuser ?-) + (make-string maxgroup ?-) + (make-string maxsize ?-) + (make-string maxtime ?-) "")) (column (length sep))) (insert (format format " Mode " "User" "Group" " Size " " Date " "Filename") @@ -2267,11 +2245,12 @@ NAME is expected to be the 16-bytes part of an ar record." (mapcar (lambda (desc) (let ((text (format format - (archive--file-desc-mode desc) - (archive-ar--file-desc-user desc) - (archive-ar--file-desc-group desc) - (archive-ar--file-desc-size desc) - (archive-ar--file-desc-time desc) + (archive-int-to-mode + (archive--file-desc-mode desc)) + (archive--file-desc-uid desc) + (archive--file-desc-gid desc) + (archive--file-desc-size desc) + (archive--file-desc-time desc) (archive--file-desc-int-file-name desc)))) (archive--file-summary text column (length text)))) files)) @@ -2309,11 +2288,7 @@ NAME is expected to be the 16-bytes part of an ar record." (defun archive-ar-write-file-member (archive descr) (archive-*-write-file-member archive - (let ((d (copy-sequence descr))) - ;; FIXME: Crude conversion from string modes to a number. - (cl-callf (lambda (s) (if (string-match "x" s) ?\555 ?\444)) - (archive--file-desc-mode d)) - d) + descr '("ar" "r"))) commit 4b4da58e8c11f639886926018cb0feb964688a97 Author: Paul Eggert Date: Sat Apr 4 17:04:23 2020 -0700 Revert unneeded part of gcc -Og change * configure.ac (DEFINE_KEY_OPS_AS_MACROS): Undo this recent change to configure.ac; it’s not needed. diff --git a/configure.ac b/configure.ac index 4e34a1cc10..9907160482 100644 --- a/configure.ac +++ b/configure.ac @@ -938,13 +938,6 @@ if test "$ac_test_CFLAGS" != set; then esac fi -case "$GCC, $CFLAGS " in - yes,*' -Og '*) - AC_DEFINE([DEFINE_KEY_OPS_AS_MACROS], 1, - [Define to 1 if key low-level operations should be C macros - instead of inline functions.]) -esac - # gl_GCC_VERSION_IFELSE([major], [minor], [run-if-found], [run-if-not-found]) # --------------------------------------------------------------------------- # If $CPP is gcc-MAJOR.MINOR or newer, then run RUN-IF-FOUND. commit 02b06216b7eaa776e5ac58bfb1c8ff2a4d9ba3f5 Author: Paul Eggert Date: Sat Apr 4 16:57:22 2020 -0700 * lib-src/Makefile.in (LINK_CFLAGS): Remove; unused. diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 29b34d9363..a2d27eab00 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -231,8 +231,6 @@ BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \ -I${srcdir} -I${srcdir}/../src -I${srcdir}/../lib ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} -## Unused. -LINK_CFLAGS = ${BASE_CFLAGS} ${LDFLAGS} ${CFLAGS} CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS} # Configuration files for .o files to depend on. commit 15853707c8c36aff1d3cc19205971b88e04d007b Author: Paul Eggert Date: Sat Apr 4 16:56:57 2020 -0700 Default gcc -Og to inlining key ops Problem reported by Martin Rudalics in: https://lists.gnu.org/r/emacs-devel/2020-04/msg00195.html * configure.ac (DEFINE_KEY_OPS_AS_MACROS): Define if -Og. * src/Makefile.in (KEY_OPS_CFLAGS): New macro. (EMACS_CFLAGS): Use it. * src/lisp.h (DEFINE_KEY_OPS_AS_MACROS): Let the gcc command line specify it. Remove use of undocumented INLINING macro. diff --git a/configure.ac b/configure.ac index 9907160482..4e34a1cc10 100644 --- a/configure.ac +++ b/configure.ac @@ -938,6 +938,13 @@ if test "$ac_test_CFLAGS" != set; then esac fi +case "$GCC, $CFLAGS " in + yes,*' -Og '*) + AC_DEFINE([DEFINE_KEY_OPS_AS_MACROS], 1, + [Define to 1 if key low-level operations should be C macros + instead of inline functions.]) +esac + # gl_GCC_VERSION_IFELSE([major], [minor], [run-if-found], [run-if-not-found]) # --------------------------------------------------------------------------- # If $CPP is gcc-MAJOR.MINOR or newer, then run RUN-IF-FOUND. diff --git a/src/Makefile.in b/src/Makefile.in index 552dd2e50a..dfd322553b 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -377,11 +377,14 @@ endif # Flags that might be in WARN_CFLAGS but are not valid for Objective C. NON_OBJC_CFLAGS = -Wignored-attributes -Wignored-qualifiers -Wopenmp-simd +# Cajole GCC into inlining key ops even if it wouldn't normally. +KEY_OPS_CFLAGS = $(if $(filter -Og,$(CFLAGS)),-DDEFINE_KEY_OPS_AS_MACROS) + # -Demacs makes some files produce the correct version for use in Emacs. # MYCPPFLAGS is for by-hand Emacs-specific overrides, e.g., # "make MYCPPFLAGS='-DDBUS_DEBUG'". -EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ - -I$(lib) -I$(top_srcdir)/lib \ +EMACS_CFLAGS = -Demacs $(KEY_OPS_CFLAGS) $(MYCPPFLAGS) \ + -I. -I$(srcdir) -I$(lib) -I$(top_srcdir)/lib \ $(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \ $(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \ $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \ diff --git a/src/lisp.h b/src/lisp.h index f223814d8f..7fc3af992e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -411,15 +411,19 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_XTYPE(a) ((enum Lisp_Type) (XLI (a) & ~VALMASK)) #endif -/* When compiling via gcc -O0, define the key operations as macros, as - Emacs is too slow otherwise. To disable this optimization, compile - with -DINLINING=false. */ -#if (defined __NO_INLINE__ \ - && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \ - && ! (defined INLINING && ! INLINING)) -# define DEFINE_KEY_OPS_AS_MACROS true -#else -# define DEFINE_KEY_OPS_AS_MACROS false +/* When DEFINE_KEY_OPS_AS_MACROS, define key operations as macros to + cajole the compiler into inlining them; otherwise define them as + inline functions as this is cleaner and can be more efficient. + The default is true if the compiler is GCC-like and if function + inlining is disabled because the compiler is not optimizing or is + optimizing for size. Otherwise the default is false. */ +#ifndef DEFINE_KEY_OPS_AS_MACROS +# if (defined __NO_INLINE__ \ + && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__) +# define DEFINE_KEY_OPS_AS_MACROS true +# else +# define DEFINE_KEY_OPS_AS_MACROS false +# endif #endif #if DEFINE_KEY_OPS_AS_MACROS commit f71afd600aef77d3c7248ae0e94b8c55fb2c5eb2 Author: Eli Zaretskii Date: Sat Apr 4 14:15:41 2020 +0300 Support the "explore" command in gdb-mi.el * lisp/progmodes/gdb-mi.el (gdb-control-commands-regexp): Add support for "explore", "explore value", and "explore type". Allow more than one word after control commands. (gdb-gdb): Decrease gdb-control-level when we get the "(gdb)" prompt, which signals that "explore" exited. (Bug#40250) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 7fb3687391..07506834f1 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1850,7 +1850,8 @@ static char *magick[] = { "\\|def\\(i\\(ne?\\)?\\)?\\|doc\\(u\\(m\\(e\\(nt?\\)?\\)?\\)?\\)?\\|" gdb-python-guile-commands-regexp "\\|while-stepping\\|stepp\\(i\\(ng?\\)?\\)?\\|ws\\|actions" - "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)?$") + "\\|expl\\(o\\(r\\e?\\)?\\)?" + "\\)\\([[:blank:]]+\\([^[:blank:]]*\\)\\)*$") "Regexp matching GDB commands that enter a recursive reading loop. As long as GDB is in the recursive reading loop, it does not expect commands to be prefixed by \"-interpreter-exec console\".") @@ -2508,7 +2509,13 @@ file names include non-ASCII characters." gdb-filter-output) -(defun gdb-gdb (_output-field)) +(defun gdb-gdb (_output-field) + ;; This is needed because the "explore" command is not ended by the + ;; likes of "end" or "quit", but instead by a RET at the approriate + ;; place, and we know we have exited "explore" when we get the + ;; "(gdb)" prompt. + (and (> gdb-control-level 0) + (setq gdb-control-level (1- gdb-control-level)))) (defun gdb-shell (output-field) (setq gdb-filter-output