commit 7527c941f7a8a71a729e8008aaf370d9c771c397 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Tue May 24 13:50:07 2022 +0800 Fix use of wrong event structure handling XI_Enter events * src/xterm.c (handle_one_xevent): Use `enter' instead of `xev' to set the mouse click timeout. diff --git a/src/xterm.c b/src/xterm.c index f86ec0fad3..9edec9dbeb 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -17505,7 +17505,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (f && x_mouse_click_focus_ignore_position) { - ignore_next_mouse_click_timeout = xev->time + 200; + ignore_next_mouse_click_timeout = enter->time + 200; mouse_click_timeout_display = dpyinfo; } commit 06671a70a459ba02be9bca47a05874863cd4a5d1 Author: Po Lu Date: Tue May 24 10:55:36 2022 +0800 * src/nsmenu.m (ns_menu_show): Use SAFE_ALLOCA. diff --git a/src/nsmenu.m b/src/nsmenu.m index 2219d6cf99..028d19f597 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -879,37 +879,35 @@ - (NSRect)confinementRectForMenu:(NSMenu *)menu EmacsMenu *pmenu; NSPoint p; Lisp_Object tem; - specpdl_ref specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count; widget_value *wv, *first_wv = 0; + widget_value *save_wv = 0, *prev_wv = 0; + widget_value **submenu_stack; + int submenu_depth = 0; + int first_pane = 1; + int i; bool keymaps = (menuflags & MENU_KEYMAPS); + USE_SAFE_ALLOCA; + NSTRACE ("ns_menu_show"); block_input (); p.x = x; p.y = y; - /* Don't GC due to a mysterious bug. */ - inhibit_garbage_collection (); - /* now parse stage 2 as in ns_update_menubar */ wv = make_widget_value ("contextmenu", NULL, true, Qnil); wv->button_type = BUTTON_TYPE_NONE; first_wv = wv; -#if 0 - /* FIXME: a couple of one-line differences prevent reuse. */ - wv = digest_single_submenu (0, menu_items_used, 0); -#else - { - widget_value *save_wv = 0, *prev_wv = 0; - widget_value **submenu_stack - = alloca (menu_items_used * sizeof *submenu_stack); - /* Lisp_Object *subprefix_stack - = alloca (menu_items_used * sizeof *subprefix_stack); */ - int submenu_depth = 0; - int first_pane = 1; - int i; + submenu_stack + = SAFE_ALLOCA (menu_items_used * sizeof *submenu_stack); + + specpdl_count = SPECPDL_INDEX (); + + /* Don't GC due to a mysterious bug. */ + inhibit_garbage_collection (); /* Loop over all panes and items, filling in the tree. */ i = 0; @@ -1039,8 +1037,6 @@ - (NSRect)confinementRectForMenu:(NSMenu *)menu i += MENU_ITEMS_ITEM_LENGTH; } } - } -#endif if (!NILP (title)) { @@ -1075,6 +1071,8 @@ - (NSRect)confinementRectForMenu:(NSMenu *)menu [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; unbind_to (specpdl_count, Qnil); unblock_input (); + + SAFE_FREE (); return tem; } commit cd355038d9451c37cc2081ad35ac13383d993351 Author: Po Lu Date: Tue May 24 02:09:59 2022 +0000 Minor fixes to cursor color handling on Haiku * src/haikufns.c (haiku_decode_color): New function. (haiku_set_foreground_color, haiku_set_background_color) (haiku_set_cursor_color, haiku_set_mouse_color): Use that function to decode colors instead. Also set cursor GC foreground when setting background color. * src/haikuterm.c (haiku_merge_cursor_foreground): Fix color equality test. diff --git a/src/haikufns.c b/src/haikufns.c index 7b1abb5cdc..a08b43879e 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -613,28 +613,33 @@ unwind_create_tip_frame (Lisp_Object frame) tip_frame = Qnil; } -static void -haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +static unsigned long +haiku_decode_color (struct frame *f, Lisp_Object color_name) { - struct haiku_output *output = FRAME_OUTPUT_DATA (f); - unsigned long old_fg; + Emacs_Color cdef; - Emacs_Color color; + CHECK_STRING (color_name); - if (haiku_get_color (SSDATA (arg), &color)) - { - store_frame_param (f, Qforeground_color, oldval); - unblock_input (); - error ("Bad color"); - } + if (!haiku_get_color (SSDATA (color_name), &cdef)) + return cdef.pixel; + signal_error ("Undefined color", color_name); +} + +static void +haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + struct haiku_output *output; + unsigned long fg, old_fg; + + fg = haiku_decode_color (f, arg); old_fg = FRAME_FOREGROUND_PIXEL (f); - FRAME_FOREGROUND_PIXEL (f) = color.pixel; + FRAME_FOREGROUND_PIXEL (f) = fg; + output = FRAME_OUTPUT_DATA (f); if (FRAME_HAIKU_WINDOW (f)) { - block_input (); if (output->cursor_color.pixel == old_fg) { output->cursor_color.pixel = old_fg; @@ -643,8 +648,6 @@ haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval output->cursor_color.blue = BLUE_FROM_ULONG (old_fg); } - unblock_input (); - update_face_from_frame_parameter (f, Qforeground_color, arg); if (FRAME_VISIBLE_P (f)) @@ -1487,76 +1490,51 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute) void haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - Emacs_Color color; - struct face *defface; + unsigned long background; - CHECK_STRING (arg); + background = haiku_decode_color (f, arg); - block_input (); - if (haiku_get_color (SSDATA (arg), &color)) - { - store_frame_param (f, Qbackground_color, oldval); - unblock_input (); - error ("Bad color"); - } - - FRAME_OUTPUT_DATA (f)->cursor_fg = color.pixel; - FRAME_BACKGROUND_PIXEL (f) = color.pixel; + FRAME_OUTPUT_DATA (f)->cursor_fg = background; + FRAME_BACKGROUND_PIXEL (f) = background; if (FRAME_HAIKU_VIEW (f)) { BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); - BView_SetViewColor (FRAME_HAIKU_VIEW (f), color.pixel); + BView_SetViewColor (FRAME_HAIKU_VIEW (f), background); BView_draw_unlock (FRAME_HAIKU_VIEW (f)); - defface = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID); - if (defface) - { - defface->background = color.pixel; - update_face_from_frame_parameter (f, Qbackground_color, arg); - clear_frame (f); - } - } + FRAME_OUTPUT_DATA (f)->cursor_fg = background; + update_face_from_frame_parameter (f, Qbackground_color, arg); - if (FRAME_VISIBLE_P (f)) - SET_FRAME_GARBAGED (f); - unblock_input (); + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + } } void haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - Emacs_Color color, fore_pixel; + unsigned long fore_pixel, pixel; - CHECK_STRING (arg); - block_input (); - - if (haiku_get_color (SSDATA (arg), &color)) - { - store_frame_param (f, Qcursor_color, oldval); - unblock_input (); - error ("Bad color"); - } - - FRAME_CURSOR_COLOR (f) = color; + pixel = haiku_decode_color (f, arg); - if (STRINGP (Vx_cursor_fore_pixel)) + if (!NILP (Vx_cursor_fore_pixel)) { - if (haiku_get_color (SSDATA (Vx_cursor_fore_pixel), - &fore_pixel)) - error ("Bad color %s", SSDATA (Vx_cursor_fore_pixel)); - FRAME_OUTPUT_DATA (f)->cursor_fg = fore_pixel.pixel; + fore_pixel = haiku_decode_color (f, Vx_cursor_fore_pixel); + FRAME_OUTPUT_DATA (f)->cursor_fg = fore_pixel; } else FRAME_OUTPUT_DATA (f)->cursor_fg = FRAME_BACKGROUND_PIXEL (f); + haiku_query_color (pixel, &FRAME_CURSOR_COLOR (f)); + if (FRAME_VISIBLE_P (f)) { - gui_update_cursor (f, 0); - gui_update_cursor (f, 1); + gui_update_cursor (f, false); + gui_update_cursor (f, true); } + update_face_from_frame_parameter (f, Qcursor_color, arg); - unblock_input (); } void @@ -2066,7 +2044,7 @@ haiku_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) rc = haiku_get_color (SSDATA (arg), &color); if (color_specified_p && rc) - signal_error ("Invalid color", arg); + signal_error ("Undefined color", arg); output = FRAME_OUTPUT_DATA (f); diff --git a/src/haikuterm.c b/src/haikuterm.c index 59fbb9ad82..a487556218 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -4476,7 +4476,7 @@ haiku_merge_cursor_foreground (struct glyph_string *s, foreground = s->face->foreground; if (background == s->face->background - || foreground == s->face->foreground) + && foreground == s->face->foreground) { background = s->face->foreground; foreground = s->face->background; commit 689be0bdd5ba0a619fd97c435f75d43c15b164e2 Author: Po Lu Date: Tue May 24 08:30:51 2022 +0800 Only send fallback MONITORS_CHANGED_EVENT when dimensions really changed * src/xterm.c (handle_one_xevent): Test that root window configure width and height are not the same as the previously recorded ones. diff --git a/src/xterm.c b/src/xterm.c index dc1daaf6e1..f86ec0fad3 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -16657,13 +16657,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* Catch screen size changes even if RandR is not available on the client. GTK does this internally. */ - inev.ie.kind = MONITORS_CHANGED_EVENT; - XSETTERMINAL (inev.ie.arg, dpyinfo->terminal); + if (configureEvent.xconfigure.width != dpyinfo->screen_width + || configureEvent.xconfigure.height != dpyinfo->screen_height) + { + inev.ie.kind = MONITORS_CHANGED_EVENT; + XSETTERMINAL (inev.ie.arg, dpyinfo->terminal); - /* Store this event now since inev.ie.type could be set to - MOVE_FRAME_EVENT later. */ - kbd_buffer_store_event (&inev.ie); - inev.ie.kind = NO_EVENT; + /* Store this event now since inev.ie.type could be set to + MOVE_FRAME_EVENT later. */ + kbd_buffer_store_event (&inev.ie); + inev.ie.kind = NO_EVENT; + } #endif dpyinfo->screen_width = configureEvent.xconfigure.width; commit 8c4498e62ed58ac94cc627d2ab085f2b17abc090 Author: Eli Zaretskii Date: Mon May 23 19:26:18 2022 +0300 Avoid compiler warnings on macOS (bug#55595) * configure.ac: Don't use -Wunknown-pragmas with Clang. * src/comp.c (load_comp_unit): Avoid Clang compilation warning. diff --git a/configure.ac b/configure.ac index 1d2d1f190b..ed8ec890ac 100644 --- a/configure.ac +++ b/configure.ac @@ -1084,6 +1084,7 @@ AS_IF([test $gl_gcc_warnings = no], if test "$emacs_cv_clang" = yes; then nw="$nw -Wdouble-promotion" + nm="$nm -Wunknown-pragmas" fi # This causes too much noise in the MinGW build. diff --git a/src/comp.c b/src/comp.c index b01106c906..2b9808aba6 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5342,7 +5342,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, are necessary exclusively during the first load. Once these are collected we don't have to maintain them in the heap forever. */ - Lisp_Object volatile data_ephemeral_vec; + Lisp_Object volatile data_ephemeral_vec = Qnil; /* In case another load of the same CU is active on the stack all ephemeral data is hold by that frame. Re-writing 'data_ephemeral_vec' would be not only a waste of cycles but commit 5a1a67a2562fab77856b48a38d89713d7f2c96d7 Author: Mattias Engdegård Date: Mon May 23 16:34:29 2022 +0200 Less wrong printed circular list tail index (bug#55395) When printing a circular list and `print-circle` is nil, use a somewhat more meaningful ". #N" tail index. The previous method for calculating that index was based on Floyd circularity detection being used so it had been broken ever since the change to Brent's algorithm. The new index is correct with respect to the start of the list itself which is what it used to be before being completely broken. It does not take into account the nesting depth of the list context. * src/print.c (struct print_stack_entry, print_object): Keep track of the tortoise index (which is cheap) instead of trying to derive it from the printed element index. * test/src/print-tests.el (print-test-rho, print-circular): New test. diff --git a/src/print.c b/src/print.c index d3808fd0e4..9968c2aef8 100644 --- a/src/print.c +++ b/src/print.c @@ -2033,13 +2033,14 @@ struct print_stack_entry struct { Lisp_Object last; /* cons whose car was just printed */ - intmax_t idx; /* index of next element */ - intmax_t maxlen; /* max length (from Vprint_length) */ - /* State for Brent cycle detection. See FOR_EACH_TAIL_INTERNAL - in lisp.h for more details. */ + intmax_t maxlen; /* max number of elements left to print */ + /* State for Brent cycle detection. See + Brent RP. BIT. 1980;20(2):176-184. doi:10.1007/BF01933190 + https://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf */ Lisp_Object tortoise; /* slow pointer */ ptrdiff_t n; /* tortoise step countdown */ ptrdiff_t m; /* tortoise step period */ + ptrdiff_t tortoise_idx; /* index of tortoise */ } list; struct @@ -2421,10 +2422,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) .type = PE_list, .u.list.last = obj, .u.list.maxlen = print_length, - .u.list.idx = 1, .u.list.tortoise = obj, .u.list.n = 2, .u.list.m = 2, + .u.list.tortoise_idx = 0, }); /* print the car */ obj = XCAR (obj); @@ -2588,17 +2589,15 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) obj = next; e->type = PE_rbrac; goto print_obj; - } - } + } + } /* list continues: print " " ELEM ... */ printchar (' ', printcharfun); - /* FIXME: We wouldn't need to keep track of idx if we - count down maxlen instead, and maintain a separate - tortoise index if required. */ - if (e->u.list.idx >= e->u.list.maxlen) + --e->u.list.maxlen; + if (e->u.list.maxlen <= 0) { print_c_string ("...)", printcharfun); --prstack.sp; @@ -2607,22 +2606,21 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } e->u.list.last = next; - e->u.list.idx++; e->u.list.n--; if (e->u.list.n == 0) { /* Double tortoise update period and teleport it. */ + e->u.list.tortoise_idx += e->u.list.m; e->u.list.m <<= 1; e->u.list.n = e->u.list.m; e->u.list.tortoise = next; } else if (BASE_EQ (next, e->u.list.tortoise)) { - /* FIXME: This #N tail index is bug-compatible with - previous implementations but actually nonsense; + /* FIXME: This #N tail index is somewhat ambiguous; see bug#55395. */ int len = sprintf (buf, ". #%" PRIdMAX ")", - (e->u.list.idx >> 1) - 1); + e->u.list.tortoise_idx); strout (buf, len, len, printcharfun); --prstack.sp; --print_depth; diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 1b28fd19ee..6ff7e99783 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -484,5 +484,51 @@ otherwise, use a different charset." (apply #'concat suffix)))) (should (equal (prin1-to-string x) expected)))))) +(defun print-test-rho (lead loop) + "A circular iota list with LEAD elements followed by LOOP in circle." + (let ((l (number-sequence 1 (+ lead loop)))) + (setcdr (nthcdr (+ lead loop -1) l) (nthcdr lead l)) + l)) + +(ert-deftest print-circular () + ;; Check printing of rho-shaped circular lists such as (1 2 3 4 5 4 5 4 . #6) + ;; when `print-circle' is nil. The exact output may differ since the number + ;; of elements printed of the looping part can vary depending on when the + ;; circularity was detected. + (dotimes (lead 7) + (ert-info ((prin1-to-string lead) :prefix "lead: ") + (dolist (loop (number-sequence 1 7)) + (ert-info ((prin1-to-string loop) :prefix "loop: ") + (let* ((rho (print-test-rho lead loop)) + (print-circle nil) + (str (prin1-to-string rho))) + (should (string-match (rx "(" + (group (+ (+ digit) " ")) + ". #" (group (+ digit)) ")") + str)) + (let* ((g1 (match-string 1 str)) + (g2 (match-string 2 str)) + (numbers (mapcar #'string-to-number (split-string g1))) + (loopback-index (string-to-number g2))) + ;; Split the numbers in the lead and loop part. + (should (< lead (length numbers))) + (should (<= lead loopback-index)) + (should (< loopback-index (length numbers))) + (let ((lead-part (butlast numbers (- (length numbers) lead))) + (loop-part (nthcdr lead numbers))) + ;; The lead part must match exactly. + (should (equal lead-part (number-sequence 1 lead))) + ;; The loop part is at least LOOP long: make sure it matches. + (should (>= (length loop-part) loop)) + (let ((expected-loop-part + (mapcar (lambda (x) (+ lead 1 (% x loop))) + (number-sequence 0 (1- (length loop-part)))))) + (should (equal loop-part expected-loop-part)) + ;; The loopback index must match the length of the + ;; loop part. + (should (equal (% (- (length numbers) loopback-index) loop) + 0))))))))))) + + (provide 'print-tests) ;;; print-tests.el ends here commit b3e4526f21749305b7f6b3f4a18e0df7cd0044a4 Author: Eli Zaretskii Date: Mon May 23 16:54:17 2022 +0300 * src/w32menu.c (w32_menu_show): Use SAFE_ALLOCA. (Bug#55068) diff --git a/src/w32menu.c b/src/w32menu.c index 5cd6c3310e..b10239d5cc 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -556,10 +556,8 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, HMENU menu; POINT pos; widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; - widget_value **submenu_stack - = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); - Lisp_Object *subprefix_stack - = (Lisp_Object *) alloca (menu_items_used * word_size); + widget_value **submenu_stack; + Lisp_Object *subprefix_stack; int submenu_depth = 0; bool first_pane; @@ -574,6 +572,11 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, return Qnil; } + USE_SAFE_ALLOCA; + + submenu_stack = SAFE_ALLOCA (menu_items_used * sizeof (widget_value *)); + subprefix_stack = SAFE_ALLOCA (menu_items_used * word_size); + block_input (); /* Create a tree of widget_value objects @@ -816,6 +819,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, entry = Fcons (subprefix_stack[j], entry); } unblock_input (); + SAFE_FREE (); return entry; } i += MENU_ITEMS_ITEM_LENGTH; @@ -830,6 +834,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, } unblock_input (); + SAFE_FREE (); return Qnil; } commit aab560f0c1955bae57cc35a71be95b5bfa2ab525 Author: Eli Zaretskii Date: Mon May 23 16:32:47 2022 +0300 Fix saveplace.el when desktop.el restores non-ASCII buffers * lisp/saveplace.el (load-save-place-alist-from-file): Bind 'coding-system-for-read' to nil, so that the 'coding:' cookie in the save-place file takes effect. (Bug#55592) diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 4d13ad3959..a23454b0bb 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -290,7 +290,11 @@ may have changed) back to `save-place-alist'." ;; adding hooks to it. (with-current-buffer (get-buffer-create " *Saved Places*") (delete-region (point-min) (point-max)) - (insert-file-contents file) + ;; Make sure our 'coding:' cookie in the save-place + ;; file will take effect, in case the caller binds + ;; coding-system-for-read. + (let (coding-system-for-read) + (insert-file-contents file)) (goto-char (point-min)) (setq save-place-alist (with-demoted-errors "Error reading save-place-file: %S" commit 6ac6919f74c2de91b2eb03de3aab326dcd3c5273 Author: Tino Calancha Date: Mon May 23 14:51:08 2022 +0200 zap-to-char: Fix interactive specification * lisp/simple.el (zap-to-char): Include t in the list. diff --git a/lisp/simple.el b/lisp/simple.el index 6906675f68..fb1bf3fa74 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6352,8 +6352,8 @@ If called interactively, do a case sensitive search if CHAR is an upper-case character." (interactive (list (prefix-numeric-value current-prefix-arg) (read-char-from-minibuffer "Zap to char: " - nil 'read-char-history)) - t) + nil 'read-char-history) + t)) ;; Avoid "obsolete" warnings for translation-table-for-input. (with-no-warnings (if (char-table-p translation-table-for-input) commit 1799e5d35a537bf722de251fd7d60a1d8cbb32e6 Author: Po Lu Date: Mon May 23 12:50:27 2022 +0000 Adapt last change to Haiku as well * src/haikumenu.c (digest_menu_items, haiku_menu_show): Use SAFE_ALLOCA for various temporary buffers. diff --git a/src/haikumenu.c b/src/haikumenu.c index 57fc7fd7c3..5729bed4a9 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -35,26 +35,35 @@ int popup_activated_p = 0; static void digest_menu_items (void *first_menu, int start, int menu_items_used, - int mbar_p) + bool is_menu_bar) { void **menus, **panes; - ssize_t menu_len = (menu_items_used + 1 - start) * sizeof *menus; - ssize_t pane_len = (menu_items_used + 1 - start) * sizeof *panes; + ssize_t menu_len; + ssize_t pane_len; + int i, menu_depth; + void *menu, *window, *view; + Lisp_Object pane_name, prefix; + const char *pane_string; + Lisp_Object item_name, enable, descrip, def, selected, help; - menus = alloca (menu_len); - panes = alloca (pane_len); + USE_SAFE_ALLOCA; - int i = start, menu_depth = 0; + menu_len = (menu_items_used + 1 - start) * sizeof *menus; + pane_len = (menu_items_used + 1 - start) * sizeof *panes; + menu = first_menu; + i = start; + menu_depth = 0; + + menus = SAFE_ALLOCA (menu_len); + panes = SAFE_ALLOCA (pane_len); memset (menus, 0, menu_len); memset (panes, 0, pane_len); - - void *menu = first_menu; - menus[0] = first_menu; - void *window = NULL; - void *view = NULL; + window = NULL; + view = NULL; + if (FRAMEP (Vmenu_updating_frame) && FRAME_LIVE_P (XFRAME (Vmenu_updating_frame)) && FRAME_HAIKU_P (XFRAME (Vmenu_updating_frame))) @@ -83,9 +92,6 @@ digest_menu_items (void *first_menu, int start, int menu_items_used, i += 1; else if (EQ (AREF (menu_items, i), Qt)) { - Lisp_Object pane_name, prefix; - const char *pane_string; - if (menu_items_n_panes == 1) { i += MENU_ITEMS_PANE_LENGTH; @@ -116,7 +122,6 @@ digest_menu_items (void *first_menu, int start, int menu_items_used, } else { - Lisp_Object item_name, enable, descrip, def, selected, help; item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); @@ -144,7 +149,7 @@ digest_menu_items (void *first_menu, int start, int menu_items_used, menu = BMenu_new_submenu (menu, SSDATA (item_name), !NILP (enable)); else if (NILP (def) && menu_separator_name_p (SSDATA (item_name))) BMenu_add_separator (menu); - else if (!mbar_p) + else if (!is_menu_bar) { if (!use_system_tooltips || NILP (Fsymbol_value (Qtooltip_mode))) BMenu_add_item (menu, SSDATA (item_name), @@ -178,6 +183,8 @@ digest_menu_items (void *first_menu, int start, int menu_items_used, if (view) BView_draw_unlock (view); + + SAFE_FREE (); } static Lisp_Object @@ -376,12 +383,18 @@ Lisp_Object haiku_menu_show (struct frame *f, int x, int y, int menuflags, Lisp_Object title, const char **error_name) { - int i = 0, submenu_depth = 0; - void *view = FRAME_HAIKU_VIEW (f); - void *menu; + int i, submenu_depth, j; + void *view, *menu; + Lisp_Object *subprefix_stack; + Lisp_Object prefix, entry; - Lisp_Object *subprefix_stack = - alloca (menu_items_used * sizeof (Lisp_Object)); + USE_SAFE_ALLOCA; + + view = FRAME_HAIKU_VIEW (f); + i = 0; + submenu_depth = 0; + subprefix_stack + = SAFE_ALLOCA (menu_items_used * sizeof (Lisp_Object)); eassert (FRAME_HAIKU_P (f)); @@ -390,6 +403,8 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) { *error_name = "Empty menu"; + + SAFE_FREE (); return Qnil; } @@ -417,8 +432,6 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, if (menu_item_selection) { - Lisp_Object prefix, entry; - prefix = entry = Qnil; i = 0; while (i < menu_items_used) @@ -452,8 +465,6 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, { if (menuflags & MENU_KEYMAPS) { - int j; - entry = list1 (entry); if (!NILP (prefix)) entry = Fcons (prefix, entry); @@ -464,6 +475,8 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, block_input (); BPopUpMenu_delete (menu); unblock_input (); + + SAFE_FREE (); return entry; } i += MENU_ITEMS_ITEM_LENGTH; @@ -480,6 +493,8 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, block_input (); BPopUpMenu_delete (menu); unblock_input (); + + SAFE_FREE (); return Qnil; } commit cec2ef73a6ac0062f428d219afd139a7e42c4734 Author: Po Lu Date: Mon May 23 20:31:18 2022 +0800 Fix stack overflows with large popup menus * src/xmenu.c (x_menu_show): Allocate various stacks with SAFE_ALLOCA. diff --git a/src/xmenu.c b/src/xmenu.c index aaf53569a7..e9601981ed 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1894,13 +1894,19 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, { int i; widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; - widget_value **submenu_stack - = alloca (menu_items_used * sizeof *submenu_stack); - Lisp_Object *subprefix_stack - = alloca (menu_items_used * sizeof *subprefix_stack); + widget_value **submenu_stack; + Lisp_Object *subprefix_stack; int submenu_depth = 0; + specpdl_ref specpdl_count; - specpdl_ref specpdl_count = SPECPDL_INDEX (); + USE_SAFE_ALLOCA; + + submenu_stack = SAFE_ALLOCA (menu_items_used + * sizeof *submenu_stack); + subprefix_stack = SAFE_ALLOCA (menu_items_used + * sizeof *subprefix_stack); + + specpdl_count = SPECPDL_INDEX (); eassert (FRAME_X_P (f)); @@ -1909,6 +1915,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) { *error_name = "Empty menu"; + SAFE_FREE (); return Qnil; } @@ -2141,6 +2148,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, entry = Fcons (subprefix_stack[j], entry); } unblock_input (); + + SAFE_FREE (); return entry; } i += MENU_ITEMS_ITEM_LENGTH; @@ -2155,6 +2164,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, } unblock_input (); + + SAFE_FREE (); return Qnil; } commit ca6899a0efb3ec4ca945fe8412d59e57bc0afa7d Author: Po Lu Date: Mon May 23 20:15:43 2022 +0800 Fix default child-frame-border-width on PGTK * src/pgtkfns.c (Fx_create_frame): Make default `child-frame-border-width' nil. (bug#55588) diff --git a/src/pgtkfns.c b/src/pgtkfns.c index b26709d90c..35e3c10589 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -1437,8 +1437,7 @@ This function is an internal primitive--use `make-frame' instead. */ ) } - gui_default_parameter (f, parms, Qchild_frame_border_width, - make_fixnum (0), + gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil, "childFrameBorderWidth", "childFrameBorderWidth", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), commit 250b728284ecfb7eeb477020e631e183908992d0 Author: Lars Ingebrigtsen Date: Mon May 23 13:56:03 2022 +0200 Improve command-error-function discoverability * lisp/subr.el (error, user-error): Point to command-error-function. * src/keyboard.c (syms_of_keyboard): Add an example (bug#40750). diff --git a/lisp/subr.el b/lisp/subr.el index 0fc1156d40..137e298cd8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -441,7 +441,10 @@ To signal with MESSAGE without interpreting format characters like `%', `\\=`' and `\\='', use (error \"%s\" MESSAGE). In Emacs, the convention is that error messages start with a capital letter but *do not* end with a period. Please follow this convention -for the sake of consistency." +for the sake of consistency. + +To alter the look of the displayed error messages, you can use +the `command-error-function' variable." (declare (advertised-calling-convention (string &rest args) "23.1")) (signal 'error (list (apply #'format-message args)))) @@ -457,7 +460,10 @@ To signal with MESSAGE without interpreting format characters like `%', `\\=`' and `\\='', use (user-error \"%s\" MESSAGE). In Emacs, the convention is that error messages start with a capital letter but *do not* end with a period. Please follow this convention -for the sake of consistency." +for the sake of consistency. + +To alter the look of the displayed error messages, you can use +the `command-error-function' variable." (signal 'user-error (list (apply #'format-message format args)))) (defun define-error (name message &optional parent) diff --git a/src/keyboard.c b/src/keyboard.c index a2322f1b49..274c7b3fa8 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12863,6 +12863,14 @@ Called with three arguments: - the context (a string which normally goes at the start of the message), - the Lisp function within which the error was signaled. +For instance, to make error messages stand out more in the echo area, +you could say something like: + + (setq command-error-function + (lambda (data _ _) + (message "%s" (propertize (error-message-string data) + \\='face \\='error)))) + Also see `set-message-function' (which controls how non-error messages are displayed). */); Vcommand_error_function = intern ("command-error-default-function"); commit a3fce23e3b01fca9cf06205a0b18c86bdcde76a3 Author: समीर सिंह Sameer Singh Date: Mon May 23 00:24:14 2022 +0530 Add support for the Hanunoo script (bug#55581) * lisp/language/philippine.el ("Hanunoo"): New language environment. Add composition rules for Hanunoo. Add sample text and input method. * lisp/international/fontset.el (script-representative-chars) (setup-default-fontset): Support Hanunoo. * lisp/leim/quail/philippine.el ("hanunoo"): New input method. * etc/HELLO: Add a Hanunoo greeting. * etc/NEWS: Announce the new language environment and its input method. diff --git a/etc/HELLO b/etc/HELLO index 2c4377388c..b87dae90b2 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -57,6 +57,7 @@ Greek (ελληνικά) Γειά σας Greek, ancient (ἑλληνική) Οὖλέ τε καὶ μέγα χαῖρε Gujarati (ગુજરાતી) નમસ્તે Gurmukhi (ਗੁਰਮੁਖੀ) ਸਤ ਸ੍ਰੀ ਅਕਾਲ +Hanunoo (ᜱᜨᜳᜨᜳᜢ) ᜫᜬᜧ᜴ ᜣᜭᜯᜥ᜴ ᜰᜲᜭᜥ᜴ Hebrew (עִבְרִית) שָׁלוֹם Hindi (हिन्दी) प्रणाम / पाय लागू Hungarian (magyar) Szép jó napot! diff --git a/etc/NEWS b/etc/NEWS index 032450b6ee..9794807441 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -819,6 +819,7 @@ corresponding language environments are: **** Syloti Nagri script and language environment **** Modi script and language environment **** Baybayin script and Tagalog language environment +**** Hanunoo script and language environment --- *** The "Oriya" language environment was renamed to "Odia". diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 1fcad765a1..08a0101a5e 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -183,6 +183,7 @@ (ogham #x168F) (runic #x16A0) (tagalog #x1700) + (hanunoo #x1720) (khmer #x1780) (mongolian #x1826) (tai-le #x1950) @@ -750,6 +751,7 @@ ogham runic tagalog + hanunoo symbol braille yi diff --git a/lisp/language/philippine.el b/lisp/language/philippine.el index 28c4616af9..2a4b17a1c7 100644 --- a/lisp/language/philippine.el +++ b/lisp/language/philippine.el @@ -37,6 +37,15 @@ Tagalog language using the Baybayin script is supported in this language environment."))) +(set-language-info-alist + "Hanunoo" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (input-method . "hanunoo") + (sample-text . "Hanunoo (ᜱᜨᜳᜨᜳᜢ) ᜫᜬᜧ᜴ ᜣᜭᜯᜥ᜴ ᜰᜲᜭᜥ᜴") + (documentation . "\ +Philippine Language Hanunoo is supported in this language environment."))) + ;; Tagalog composition rules (let ((akshara "[\x1700-\x1711\x171F]") (vowel "[\x1712\x1713]") @@ -55,5 +64,16 @@ this language environment."))) (concat akshara pamudpod vowel "?") 1 'font-shape-gstring)))) +;; Hanunoo composition rules +(let ((akshara "[\x1720-\x1731]") + (vowel "[\x1732\x1733]") + (pamudpod "\x1734")) + (set-char-table-range composition-function-table + '(#x1734 . #x1734) + (list (vector + ;; Akshara pamudpod syllables + (concat akshara pamudpod vowel "?") + 1 'font-shape-gstring)))) + (provide 'philippine) ;;; philippine.el ends here diff --git a/lisp/leim/quail/philippine.el b/lisp/leim/quail/philippine.el index 8d8db8be5e..b9dcccea28 100644 --- a/lisp/leim/quail/philippine.el +++ b/lisp/leim/quail/philippine.el @@ -62,5 +62,35 @@ ("N" ?ᜅ) ("m" ?ᜋ)) +(quail-define-package + "hanunoo" "Hanunoo" "ᜱ" nil "Hanunoo phonetic input method." + nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("q" ?₱) + ("w" ?ᜯ) + ("r" ?ᜭ) + ("t" ?ᜦ) + ("y" ?ᜬ) + ("u" ?ᜳ) + ("U" ?ᜢ) + ("i" ?ᜲ) + ("I" ?ᜡ) + ("p" ?ᜩ) + ("a" ?ᜠ) + ("s" ?ᜰ) + ("d" ?ᜧ) + ("f" ?᜴) + ("g" ?ᜤ) + ("h" ?ᜱ) + ("j" ?᜵) + ("J" ?᜶) + ("k" ?ᜣ) + ("l" ?ᜮ) + ("b" ?ᜪ) + ("n" ?ᜨ) + ("N" ?ᜥ) + ("m" ?ᜫ)) + (provide 'philippine) ;;; philippine.el ends here commit e5d76634a2159bc2ae6d1af859b736b834f63f30 Author: Lars Ingebrigtsen Date: Mon May 23 13:08:17 2022 +0200 Make remapped keys work in set-transient-map * lisp/subr.el (set-transient-map): Make remapped keys work in transient maps (bug#40096). diff --git a/lisp/subr.el b/lisp/subr.el index 6538d79050..0fc1156d40 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6043,6 +6043,10 @@ to deactivate this transient map, regardless of KEEP-PRED." t) ((eq t keep-pred) (let ((mc (lookup-key map (this-command-keys-vector)))) + ;; We may have a remapped command, so chase + ;; down that. + (when (and mc (symbolp mc)) + (setq mc (or (command-remapping mc nil map) mc))) ;; If the key is unbound `this-command` is ;; nil and so is `mc`. (and mc (eq this-command mc)))) commit 7ff88efc0276677e955c93be4442e8b70f8d647f Author: Po Lu Date: Mon May 23 18:31:11 2022 +0800 Fix coding style of recent change * src/emacs.c (main): Fix coding style by putting the = operator on the right row. diff --git a/src/emacs.c b/src/emacs.c index fed525f8bf..a9126e7be8 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1422,7 +1422,9 @@ main (int argc, char **argv) skip_args = 0; if (argmatch (argv, argc, "-version", "--version", 3, NULL, &skip_args)) { + Lisp_Object rversion, rbranch, rtime; const char *version, *copyright; + if (initialized) { Lisp_Object tem, tem2; @@ -1450,21 +1452,22 @@ main (int argc, char **argv) copyright = emacs_copyright; } printf ("%s %s\n", PACKAGE_NAME, version); - { - Lisp_Object rversion = - Fsymbol_value (intern_c_string ("emacs-repository-version")); - Lisp_Object rbranch = - Fsymbol_value (intern_c_string ("emacs-repository-branch")); - Lisp_Object rtime = - Fsymbol_value (intern_c_string ("emacs-build-time")); - if (!NILP (rversion) && !NILP (rbranch) && !NILP (rtime)) - printf ("Development version %s on %s branch; build date %s.\n", - SSDATA (Fsubstring (rversion, make_fixnum (0), - make_fixnum (12))), - SSDATA (rbranch), - SSDATA (Fformat_time_string (build_string ("%Y-%m-%d"), - rtime, Qnil))); - } + + rversion + = Fsymbol_value (intern_c_string ("emacs-repository-version")); + rbranch + = Fsymbol_value (intern_c_string ("emacs-repository-branch")); + rtime + = Fsymbol_value (intern_c_string ("emacs-build-time")); + + if (!NILP (rversion) && !NILP (rbranch) && !NILP (rtime)) + printf ("Development version %s on %s branch; build date %s.\n", + SSDATA (Fsubstring (rversion, make_fixnum (0), + make_fixnum (12))), + SSDATA (rbranch), + SSDATA (Fformat_time_string (build_string ("%Y-%m-%d"), + rtime, Qnil))); + printf (("%s\n" "%s comes with ABSOLUTELY NO WARRANTY.\n" "You may redistribute copies of %s\n" commit caec741c00f907264524fafb5ba058063c898b92 Author: Po Lu Date: Mon May 23 10:23:43 2022 +0000 Implement monitor change functions on Haiku * src/haiku_io.c (haiku_len): Handle new event type. * src/haiku_support.cc (class EmacsScreenChangeMonitor): New class. (class Emacs, Emacs): Create new screen change monitor. (DispatchMessage): Update fullscreen state if the screen changed. (SetFullscreen): Don't punt if fullscreen mode is identical. * src/haiku_support.h (enum haiku_event_type): New event `SCREEN_CHANGE_EVENT'. (struct haiku_screen_changed_event): New struct. * src/haikuterm.c (haiku_read_socket): Handle new event. diff --git a/src/haiku_io.c b/src/haiku_io.c index 5d0031ef71..d345527685 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -105,6 +105,8 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_menu_bar_left_event); case SCROLL_BAR_PART_EVENT: return sizeof (struct haiku_scroll_bar_part_event); + case SCREEN_CHANGED_EVENT: + return sizeof (struct haiku_screen_changed_event); } emacs_abort (); diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 8b2015b37b..977728b5e3 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -524,13 +524,68 @@ get_zoom_rect (BWindow *window) return frame; } +/* Invisible window used to get B_SCREEN_CHANGED events. */ +class EmacsScreenChangeMonitor : public BWindow +{ + BRect previous_screen_frame; + +public: + EmacsScreenChangeMonitor (void) : BWindow (BRect (-100, -100, 0, 0), "", + B_NO_BORDER_WINDOW_LOOK, + B_FLOATING_ALL_WINDOW_FEEL, + B_AVOID_FRONT | B_AVOID_FOCUS) + { + BScreen screen (this); + + if (!screen.IsValid ()) + return; + + previous_screen_frame = screen.Frame (); + + /* Immediately show this window upon creation. It will end up + hidden since there are no windows in its subset. */ + Show (); + + if (!LockLooper ()) + return; + + Hide (); + UnlockLooper (); + } + + void + DispatchMessage (BMessage *msg, BHandler *handler) + { + struct haiku_screen_changed_event rq; + BRect frame; + + if (msg->what == B_SCREEN_CHANGED) + { + if (msg->FindInt64 ("when", &rq.when) != B_OK) + rq.when = 0; + + if (msg->FindRect ("frame", &frame) != B_OK + || frame != previous_screen_frame) + { + haiku_write (SCREEN_CHANGED_EVENT, &rq); + + if (frame.IsValid ()) + previous_screen_frame = frame; + } + } + + BWindow::DispatchMessage (msg, handler); + } +}; + class Emacs : public BApplication { public: BMessage settings; bool settings_valid_p = false; + EmacsScreenChangeMonitor *monitor; - Emacs () : BApplication ("application/x-vnd.GNU-emacs") + Emacs (void) : BApplication ("application/x-vnd.GNU-emacs") { BPath settings_path; @@ -546,6 +601,15 @@ class Emacs : public BApplication return; settings_valid_p = true; + monitor = new EmacsScreenChangeMonitor; + } + + ~Emacs (void) + { + if (monitor->LockLooper ()) + monitor->Quit (); + else + delete monitor; } void @@ -999,6 +1063,13 @@ class EmacsWindow : public BWindow } else if (msg->what == SEND_MOVE_FRAME_EVENT) FrameMoved (Frame ().LeftTop ()); + else if (msg->what == B_SCREEN_CHANGED) + { + if (fullscreen_mode != FULLSCREEN_MODE_NONE) + SetFullscreen (fullscreen_mode); + + BWindow::DispatchMessage (msg, handler); + } else BWindow::DispatchMessage (msg, handler); } @@ -1243,9 +1314,6 @@ class EmacsWindow : public BWindow { BRect zoom_rect, frame; - if (fullscreen_mode == mode) - return; - frame = ClearFullscreen (mode); switch (mode) diff --git a/src/haiku_support.h b/src/haiku_support.h index dbb12c24aa..9597c24c5d 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -112,9 +112,15 @@ enum haiku_event_type DRAG_AND_DROP_EVENT, APP_QUIT_REQUESTED_EVENT, DUMMY_EVENT, - MENU_BAR_LEFT + SCREEN_CHANGED_EVENT, + MENU_BAR_LEFT, }; +struct haiku_screen_changed_event +{ + bigtime_t when; +}; + struct haiku_quit_requested_event { void *window; diff --git a/src/haikuterm.c b/src/haikuterm.c index 628ef2b026..59fbb9ad82 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3899,6 +3899,15 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) BMessage_delete (b->message); break; } + case SCREEN_CHANGED_EVENT: + { + struct haiku_screen_changed_event *b = buf; + + inev.kind = MONITORS_CHANGED_EVENT; + XSETTERMINAL (inev.arg, x_display_list->terminal); + inev.timestamp = b->when / 1000; + break; + } case APP_QUIT_REQUESTED_EVENT: inev.kind = SAVE_SESSION_EVENT; inev.arg = Qt; commit 4b15b88e714f39ca6926f17b36a1302959b69643 Author: Lars Ingebrigtsen Date: Mon May 23 12:17:25 2022 +0200 Make `d' in Dired skip dot files * lisp/dired.el (dired-mark): Skip dot files (bug#38729). This makes `C-u 10 d' (etc) consistent with marking the next ten lines with the mouse and then hitting `d'. diff --git a/etc/NEWS b/etc/NEWS index c146b746cf..032450b6ee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -136,6 +136,14 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 +--- +** The 'd' command in Dired now more consistently skip dot files. +In previous Emacs versions, commands like `C-u 10 d' would put the "D" +mark on the next ten files, no matter whether they were dot files +(i.e., "." and "..") or not, while marking the next ten lines with the +mouse (in 'transient-mark-mode') and then hitting 'd' would skip dot +files. These now work equivalently. + --- ** Isearch in "*Help*" and "*info*" now char-folds quote characters by default. This means that you can say 'C-s `foo' (GRAVE ACCENT) if the buffer diff --git a/lisp/dired.el b/lisp/dired.el index 89fbd52aa6..fbf26dbce7 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3957,7 +3957,11 @@ this subdir." (let ((inhibit-read-only t)) (dired-repeat-over-lines (prefix-numeric-value arg) - (lambda () (delete-char 1) (insert dired-marker-char))))))) + (lambda () + (when (or (not (looking-at-p dired-re-dot)) + (not (equal dired-marker-char dired-del-marker))) + (delete-char 1) + (insert dired-marker-char)))))))) (defun dired-unmark (arg &optional interactive) "Unmark the file at point in the Dired buffer. commit a9b393c77350cc177952008707781dd97341a83a Author: Lars Ingebrigtsen Date: Mon May 23 11:58:22 2022 +0200 Include development data in --version output * src/emacs.c (main): Include development into in --version output (bug#38657). diff --git a/src/emacs.c b/src/emacs.c index 056cebb04d..fed525f8bf 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1449,14 +1449,29 @@ main (int argc, char **argv) version = emacs_version; copyright = emacs_copyright; } - printf (("%s %s\n" - "%s\n" + printf ("%s %s\n", PACKAGE_NAME, version); + { + Lisp_Object rversion = + Fsymbol_value (intern_c_string ("emacs-repository-version")); + Lisp_Object rbranch = + Fsymbol_value (intern_c_string ("emacs-repository-branch")); + Lisp_Object rtime = + Fsymbol_value (intern_c_string ("emacs-build-time")); + if (!NILP (rversion) && !NILP (rbranch) && !NILP (rtime)) + printf ("Development version %s on %s branch; build date %s.\n", + SSDATA (Fsubstring (rversion, make_fixnum (0), + make_fixnum (12))), + SSDATA (rbranch), + SSDATA (Fformat_time_string (build_string ("%Y-%m-%d"), + rtime, Qnil))); + } + printf (("%s\n" "%s comes with ABSOLUTELY NO WARRANTY.\n" "You may redistribute copies of %s\n" "under the terms of the GNU General Public License.\n" "For more information about these matters, " "see the file named COPYING.\n"), - PACKAGE_NAME, version, copyright, PACKAGE_NAME, PACKAGE_NAME); + copyright, PACKAGE_NAME, PACKAGE_NAME); exit (0); } commit 4766fe1daf9f1b3f711d3fe453840487601cce81 Author: Juri Linkov Date: Mon May 23 10:48:15 2022 +0300 * lisp/tab-bar.el (switch-to-buffer-other-tab): Use pop-to-buffer (bug#55582). Replace display-buffer with pop-to-buffer that sets the current buffer explicitly. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 42c4b822bc..ddab71c52c 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -2320,9 +2320,9 @@ Interactively, prompt for the buffer to switch to." (declare (advertised-calling-convention (buffer-or-name) "28.1")) (interactive (list (read-buffer-to-switch "Switch to buffer in other tab: "))) - (display-buffer (window-normalize-buffer-to-switch-to buffer-or-name) - '((display-buffer-in-tab) - (inhibit-same-window . nil)))) + (pop-to-buffer (window-normalize-buffer-to-switch-to buffer-or-name) + '((display-buffer-in-tab) + (inhibit-same-window . nil)))) (defun find-file-other-tab (filename &optional wildcards) "Edit file FILENAME, in another tab. commit 1cfb89dc79b76923c1c93cb44e3e4836b6a8c2bf Author: Lars Ingebrigtsen Date: Mon May 23 09:45:35 2022 +0200 Allow extending 'save-some-buffers' * lisp/abbrev.el (abbrev--possibly-save): Separated out from `save-some-buffers'. (save-some-buffers-functions): Add to the save function. * lisp/files.el (save-some-buffers-functions): New variable. (save-some-buffers): Use it. (save-buffers-kill-emacs): Also use it to see if we have something to save (bug#55579). diff --git a/etc/NEWS b/etc/NEWS index 80e867135e..c146b746cf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1859,6 +1859,12 @@ functions. * Lisp Changes in Emacs 29.1 +** 'save-some-buffers' can now be extended to save other things. +Traditionally, 'save-some-buffers' saved buffers, and also saved +abbrevs. This has been generalized via the +'save-some-buffers-functions', and packages can now register things to +be saved. + ** Themes --- diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 214f7435d9..3ee972869b 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -1197,6 +1197,28 @@ This mode is for editing abbrevs in a buffer prepared by `edit-abbrevs', which see." :interactive nil) +(defun abbrev--possibly-save (query &optional arg) + ;; Query mode. + (if (eq query 'query) + (and save-abbrevs abbrevs-changed) + ;; Maybe save abbrevs, and record whether we either saved them or + ;; asked to. + (and save-abbrevs + abbrevs-changed + (progn + (if (or arg + (eq save-abbrevs 'silently) + (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) + (progn + (write-abbrev-file nil) + nil) + ;; Don't keep bothering user if they say no. + (setq abbrevs-changed nil) + ;; Inhibit message in `save-some-buffers'. + t))))) + +(add-hook 'save-some-buffers-functions #'abbrev--possibly-save) + (provide 'abbrev) ;;; abbrev.el ends here diff --git a/lisp/files.el b/lisp/files.el index 2b0dc54db8..2aef4d9230 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5849,7 +5849,18 @@ See `save-some-buffers' for PRED values." (funcall pred)))) buffer)) (buffer-list)))) - (delq nil buffers))) + (delq nil buffers))) + +(defvar save-some-buffers-functions nil + "Functions to be run by `save-some-buffers' after saving the buffers. +The functions can be called in two \"modes\", depending on the +first argument. If the first argument is `query', then the +function should return non-nil if there is something to be +saved (but it should not actually save anything). + +If the first argument is something else, then the function should +save according to the value of the second argument, which is the +ARG argument from `save-some-buffers'.") (defun save-some-buffers (&optional arg pred) "Save some modified file-visiting buffers. Asks user about each one. @@ -5875,7 +5886,10 @@ should return non-nil if that buffer should be considered. PRED defaults to the value of `save-some-buffers-default-predicate'. See `save-some-buffers-action-alist' if you want to -change the additional actions you can take on files." +change the additional actions you can take on files. + +The functions in `save-some-buffers-functions' will be called +after saving the buffers." (interactive "P") (unless pred (setq pred @@ -5891,7 +5905,7 @@ change the additional actions you can take on files." (lambda (buffer) (setq switched-buffer buffer))) queried autosaved-buffers - files-done abbrevs-done) + files-done inhibit-message) (unwind-protect (save-window-excursion (dolist (buffer (buffer-list)) @@ -5939,19 +5953,10 @@ change the additional actions you can take on files." (files--buffers-needing-to-be-saved pred) '("buffer" "buffers" "save") save-some-buffers-action-alist)) - ;; Maybe to save abbrevs, and record whether - ;; we either saved them or asked to. - (and save-abbrevs abbrevs-changed - (progn - (if (or arg - (eq save-abbrevs 'silently) - (y-or-n-p (format "Save abbrevs in %s? " - abbrev-file-name))) - (write-abbrev-file nil)) - ;; Don't keep bothering user if he says no. - (setq abbrevs-changed nil) - (setq abbrevs-done t))) - (or queried (> files-done 0) abbrevs-done + ;; Allow other things to be saved at this time, like abbrevs. + (dolist (func save-some-buffers-functions) + (setq inhibit-message (or (funcall func nil arg) inhibit-message))) + (or queried (> files-done 0) inhibit-message (cond ((null autosaved-buffers) (when (called-interactively-p 'any) @@ -7779,7 +7784,11 @@ If RESTART, restart Emacs after killing the current Emacs process." (interactive "P") ;; Don't use save-some-buffers-default-predicate, because we want ;; to ask about all the buffers before killing Emacs. - (when (files--buffers-needing-to-be-saved t) + (when (or (files--buffers-needing-to-be-saved t) + (catch 'need-save + (dolist (func save-some-buffers-functions) + (when (funcall func 'query) + (throw 'need-save t))))) (if (use-dialog-box-p) (pcase (x-popup-dialog t `("Unsaved Buffers"