commit 66ad6564a22e013b3f4091ba851b7a115b5970a4 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Sun Apr 24 05:44:07 2022 +0000 * lisp/term/haiku-win.el (x-colors): Also update with system colors. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index dddad544fa..c83e0a5c3d 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -98,6 +98,9 @@ for more details on the structure of the associations.") "B_LINK_VISITED_COLOR" "B_LINK_ACTIVE_COLOR" "B_STATUS_BAR_COLOR" "B_SUCCESS_COLOR" "B_FAILURE_COLOR"]) +;; Also update `x-colors' to take that into account. +(setq x-colors (append haiku-allowed-ui-colors x-colors)) + (defun haiku-selection-bounds (value) "Return bounds of selection value VALUE. The return value is a list (BEG END BUF) if VALUE is a cons of commit e2d870016cb3981baef128cabe849fdb63127541 Author: Po Lu Date: Sun Apr 24 05:37:22 2022 +0000 Allow looking up window system colors on Haiku * lisp/help-fns.el (help-fns--editable-variable): Fix describing variables which don't have symbol values. * lisp/term/haiku-win.el (haiku-allowed-ui-colors): Set list of allowed UI colors. * src/haiku_support.cc (be_get_ui_color): New function. * src/haiku_support.h: Update prototypes. * src/haikufns.c (haiku_get_color): Look for defined UI color. (syms_of_haikufns): New defvar `haiku-allowed-ui-colors'. * src/haikuterm.c (haiku_term_init): Fix coding style. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 0e46ca1c55..12a4ecf2f3 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1303,8 +1303,8 @@ it is displayed along with the global value." (defun help-fns--editable-variable (start end variable value buffer) (when (and (readablep value) - (not (boundp value)) - (not (fboundp value)) + (not (and (symbolp value) (boundp value))) + (not (and (symbolp value) (fboundp value))) help-enable-variable-value-editing) (add-text-properties start end diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 955947fe6a..dddad544fa 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -46,6 +46,7 @@ (defvar haiku-initialized) (defvar haiku-signal-invalid-refs) (defvar haiku-drag-track-function) +(defvar haiku-allowed-ui-colors) (defvar haiku-dnd-selection-value nil "The local value of the special `XdndSelection' selection.") @@ -74,6 +75,29 @@ content that is being put into the selection by `gui-set-selection'. See the doc string of `haiku-drag-message' for more details on the structure of the associations.") +;; This list has to be set correctly, otherwise Emacs will crash upon +;; encountering an invalid color. +(setq haiku-allowed-ui-colors + ["B_PANEL_BACKGROUND_COLOR" "B_MENU_BACKGROUND_COLOR" + "B_WINDOW_TAB_COLOR" "B_KEYBOARD_NAVIGATION_COLOR" + "B_DESKTOP_COLOR" "B_MENU_SELECTED_BACKGROUND_COLOR" + "B_MENU_ITEM_TEXT_COLOR" "B_MENU_SELECTED_ITEM_TEXT_COLOR" + "B_MENU_SELECTED_BORDER_COLOR" "B_PANEL_TEXT_COLOR" + "B_DOCUMENT_BACKGROUND_COLOR" "B_DOCUMENT_TEXT_COLOR" + "B_CONTROL_BACKGROUND_COLOR" "B_CONTROL_TEXT_COLOR" + "B_CONTROL_BORDER_COLOR" "B_CONTROL_HIGHLIGHT_COLOR" + "B_NAVIGATION_PULSE_COLOR" "B_SHINE_COLOR" + "B_SHADOW_COLOR" "B_TOOLTIP_BACKGROUND_COLOR" + "B_TOOLTIP_TEXT_COLOR" "B_WINDOW_TEXT_COLOR" + "B_WINDOW_INACTIVE_TAB_COLOR" "B_WINDOW_INACTIVE_TEXT_COLOR" + "B_WINDOW_BORDER_COLOR" "B_WINDOW_INACTIVE_BORDER_COLOR" + "B_CONTROL_MARK_COLOR" "B_LIST_BACKGROUND_COLOR" + "B_LIST_SELECTED_BACKGROUND_COLOR" "B_LIST_ITEM_TEXT_COLOR" + "B_LIST_SELECTED_ITEM_TEXT_COLOR" "B_SCROLL_BAR_THUMB_COLOR" + "B_LINK_TEXT_COLOR" "B_LINK_HOVER_COLOR" + "B_LINK_VISITED_COLOR" "B_LINK_ACTIVE_COLOR" + "B_STATUS_BAR_COLOR" "B_SUCCESS_COLOR" "B_FAILURE_COLOR"]) + (defun haiku-selection-bounds (value) "Return bounds of selection value VALUE. The return value is a list (BEG END BUF) if VALUE is a cons of diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 2ec536729f..eb9379f17d 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -4323,3 +4323,21 @@ BWindow_set_z_group (void *window, enum haiku_z_group z_group) w->UnlockLooper (); } } + +int +be_get_ui_color (const char *name, uint32_t *color) +{ + color_which which; + rgb_color rgb; + + which = which_ui_color (name); + + if (which == B_NO_COLOR) + return 1; + + rgb = ui_color (which); + *color = (rgb.blue | rgb.green << 8 + | rgb.red << 16 | 255 << 24); + + return 0; +} diff --git a/src/haiku_support.h b/src/haiku_support.h index 3f071f2b09..3337df5551 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -639,6 +639,7 @@ extern int be_get_display_screens (void); extern bool be_use_subpixel_antialiasing (void); extern const char *be_find_setting (const char *); extern haiku_font_family_or_style *be_list_font_families (size_t *); +extern int be_get_ui_color (const char *, uint32 *); extern void BMessage_delete (void *); @@ -648,7 +649,6 @@ extern bool be_drag_message (void *, void *, bool, void (*) (void), extern bool be_drag_and_drop_in_progress (void); extern bool be_replay_menu_bar_event (void *, struct haiku_menu_bar_click_event *); - #ifdef __cplusplus } diff --git a/src/haikufns.c b/src/haikufns.c index 979a47d766..4f4979fe09 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -253,7 +253,10 @@ haiku_get_color (const char *name, Emacs_Color *color) { unsigned short r16, g16, b16; Lisp_Object tem, col; - int32 clr; + int32 clr, rc; + uint32_t ui_color; + ptrdiff_t size, i; + Lisp_Object string; if (parse_color_spec (name, &r16, &g16, &b16)) { @@ -283,11 +286,34 @@ haiku_get_color (const char *name, Emacs_Color *color) return 0; } } - unblock_input (); } - return 1; + rc = 1; + if (VECTORP (Vhaiku_allowed_ui_colors)) + { + size = ASIZE (Vhaiku_allowed_ui_colors); + + for (i = 0; i < size; ++i) + { + string = AREF (Vhaiku_allowed_ui_colors, i); + + block_input (); + if (STRINGP (string) && !strcmp (SSDATA (string), name)) + rc = be_get_ui_color (name, &ui_color); + unblock_input (); + } + } + + if (!rc) + { + color->pixel = ui_color; + color->red = RED_FROM_ULONG (ui_color) * 257; + color->green = GREEN_FROM_ULONG (ui_color) * 257; + color->blue = BLUE_FROM_ULONG (ui_color) * 257; + } + + return rc; } static struct haiku_display_info * @@ -2742,6 +2768,12 @@ syms_of_haikufns (void) doc: /* SKIP: real doc in xfns.c. */); Vx_cursor_fore_pixel = Qnil; + DEFVAR_LISP ("haiku-allowed-ui-colors", Vhaiku_allowed_ui_colors, + doc: /* Vector of UI colors that Emacs can look up from the system. +If this is set up incorrectly, Emacs can crash when encoutering an +invalid color. */); + Vhaiku_allowed_ui_colors = Qnil; + #ifdef USE_BE_CAIRO DEFVAR_LISP ("cairo-version-string", Vcairo_version_string, doc: /* Version info for cairo. */); diff --git a/src/haikuterm.c b/src/haikuterm.c index 12db1a6f4f..f81efbdcbb 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3964,21 +3964,19 @@ haiku_term_init (void) color_file = Fexpand_file_name (build_string ("rgb.txt"), Fsymbol_value (intern ("data-directory"))); - color_map = Fx_load_color_file (color_file); + if (NILP (color_map)) fatal ("Could not read %s.\n", SDATA (color_file)); dpyinfo->color_map = color_map; - dpyinfo->display = BApplication_setup (); - - BScreen_res (&dpyinfo->resx, &dpyinfo->resy); - dpyinfo->next = x_display_list; dpyinfo->n_planes = be_get_display_planes (); x_display_list = dpyinfo; + BScreen_res (&dpyinfo->resx, &dpyinfo->resy); + terminal = haiku_create_terminal (dpyinfo); if (current_kboard == initial_kboard) current_kboard = terminal->kboard; commit ddbf2e8ab79ddc4464cc5bda6b28ff80867a3582 Author: Po Lu Date: Sun Apr 24 02:55:19 2022 +0000 Fix disabling double buffering on Haiku * src/haikufns.c (haiku_set_inhibit_double_buffering): Garbage frame correctly after changing double buffering. * src/haikuterm.c (haiku_calculate_relief_colors) (haiku_draw_relief_rect, haiku_draw_underwave): Clean up coding style. diff --git a/src/haikufns.c b/src/haikufns.c index 14644be22b..979a47d766 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1749,17 +1749,14 @@ haiku_set_inhibit_double_buffering (struct frame *f, { #ifndef USE_BE_CAIRO if (NILP (new_value)) - { #endif - EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f)); - - if (!NILP (old_value)) - expose_frame (f, 0, 0, 0, 0); + EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f)); #ifndef USE_BE_CAIRO - } else EmacsView_disable_double_buffering (FRAME_HAIKU_VIEW (f)); #endif + + SET_FRAME_GARBAGED (f); } unblock_input (); } diff --git a/src/haikuterm.c b/src/haikuterm.c index 4f671cddd0..12db1a6f4f 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -621,18 +621,17 @@ haiku_calculate_relief_colors (struct glyph_string *s, uint32_t *rgbout_w, uint32_t *rgbout_b) { struct face *face = s->face; + double h, cs, l; + uint32_t rgbin; prepare_face_for_display (s->f, s->face); - - uint32_t rgbin = face->use_box_color_for_shadows_p - ? face->box_color : face->background; + rgbin = (face->use_box_color_for_shadows_p + ? face->box_color : face->background); if (s->hl == DRAW_CURSOR) rgbin = FRAME_CURSOR_COLOR (s->f).pixel; - double h, cs, l; rgb_color_hsl (rgbin, &h, &cs, &l); - hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 0.6), rgbout_b); hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.2), rgbout_w); } @@ -640,16 +639,16 @@ haiku_calculate_relief_colors (struct glyph_string *s, uint32_t *rgbout_w, static void haiku_draw_relief_rect (struct glyph_string *s, int left_x, int top_y, int right_x, int bottom_y, - int hwidth, int vwidth, bool raised_p, bool top_p, bool bot_p, - bool left_p, bool right_p, + int hwidth, int vwidth, bool raised_p, bool top_p, + bool bot_p, bool left_p, bool right_p, struct haiku_rect *clip_rect, bool fancy_p) { - uint32_t color_white; - uint32_t color_black; + uint32_t color_white, color_black; + void *view; haiku_calculate_relief_colors (s, &color_white, &color_black); - void *view = FRAME_HAIKU_VIEW (s->f); + view = FRAME_HAIKU_VIEW (s->f); BView_SetHighColor (view, raised_p ? color_white : color_black); if (clip_rect) { @@ -726,15 +725,14 @@ haiku_draw_underwave (struct glyph_string *s, int width, int x) { int wave_height = 3, wave_length = 2; int y, dx, dy, odd, xmax; + float ax, ay, bx, by; + void *view = FRAME_HAIKU_VIEW (s->f); + dx = wave_length; dy = wave_height - 1; y = s->ybase - wave_height + 3; - - float ax, ay, bx, by; xmax = x + width; - void *view = FRAME_HAIKU_VIEW (s->f); - BView_StartClip (view); haiku_clip_to_string (s); BView_ClipToRect (view, x, y, width, wave_height); commit 9b6580ccb73e6cb71a89099bb7062689cbed9e20 Author: Po Lu Date: Sun Apr 24 08:44:18 2022 +0800 Speed up color cache lookup on X * src/xterm.c (x_hash_string_ignore_case): New function. (x_parse_color): Turn color cache into a hash table. (x_term_init): Allocate color cache. (x_delete_display): Free color cache correctly. * src/xterm.h (struct x_display_info): Turn color cache into a hash table and add appropriate fields. diff --git a/src/xterm.c b/src/xterm.c index 8b813210b7..4661f731cd 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -617,6 +617,8 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include + #include "character.h" #include "coding.h" #include "composite.h" @@ -6829,6 +6831,21 @@ x_query_frame_background_color (struct frame *f, XColor *bgcolor) x_query_colors (f, bgcolor, 1); } +static unsigned int +x_hash_string_ignore_case (const char *string) +{ + unsigned int i; + + i = 3323198485ul; + for (; *string; ++string) + { + i ^= c_tolower (*string); + i *= 0x5bd1e995; + i ^= i >> 15; + } + return i; +} + /* On frame F, translate the color name to RGB values. Use cached information, if possible. @@ -6841,12 +6858,18 @@ Status x_parse_color (struct frame *f, const char *color_name, XColor *color) { + unsigned short r, g, b; + Display *dpy = FRAME_X_DISPLAY (f); + Colormap cmap = FRAME_X_COLORMAP (f); + struct x_display_info *dpyinfo; + struct color_name_cache_entry *cache_entry; + unsigned int hash, idx; + /* Don't pass #RGB strings directly to XParseColor, because that follows the X convention of zero-extending each channel value: #f00 means #f00000. We want the convention of scaling channel values, so #f00 means #ff0000, just as it does for HTML, SVG, and CSS. */ - unsigned short r, g, b; if (parse_color_spec (color_name, &r, &g, &b)) { color->red = r; @@ -6855,13 +6878,14 @@ x_parse_color (struct frame *f, const char *color_name, return 1; } - Display *dpy = FRAME_X_DISPLAY (f); - Colormap cmap = FRAME_X_COLORMAP (f); - struct color_name_cache_entry *cache_entry; - for (cache_entry = FRAME_DISPLAY_INFO (f)->color_names; cache_entry; - cache_entry = cache_entry->next) + dpyinfo = FRAME_DISPLAY_INFO (f); + hash = x_hash_string_ignore_case (color_name); + idx = hash % dpyinfo->color_names_size; + + for (cache_entry = FRAME_DISPLAY_INFO (f)->color_names[idx]; + cache_entry; cache_entry = cache_entry->next) { - if (!xstrcasecmp(cache_entry->name, color_name)) + if (!xstrcasecmp (cache_entry->name, color_name)) { *color = cache_entry->rgb; return 1; @@ -6879,8 +6903,8 @@ x_parse_color (struct frame *f, const char *color_name, cache_entry = xzalloc (sizeof *cache_entry); cache_entry->rgb = *color; cache_entry->name = xstrdup (color_name); - cache_entry->next = FRAME_DISPLAY_INFO (f)->color_names; - FRAME_DISPLAY_INFO (f)->color_names = cache_entry; + cache_entry->next = FRAME_DISPLAY_INFO (f)->color_names[idx]; + FRAME_DISPLAY_INFO (f)->color_names[idx] = cache_entry; return 1; } @@ -22936,6 +22960,10 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->smallest_font_height = 1; dpyinfo->smallest_char_width = 1; + dpyinfo->color_names_size = 256; + dpyinfo->color_names = xzalloc (dpyinfo->color_names_size + * sizeof *dpyinfo->color_names); + /* Set the name of the terminal. */ terminal->name = xlispstrdup (display_name); @@ -23709,6 +23737,7 @@ x_delete_display (struct x_display_info *dpyinfo) { struct terminal *t; struct color_name_cache_entry *color_entry, *next_color_entry; + int i; /* Close all frames and delete the generic struct terminal for this X display. */ @@ -23741,15 +23770,19 @@ x_delete_display (struct x_display_info *dpyinfo) tail->next = tail->next->next; } - for (color_entry = dpyinfo->color_names; - color_entry; - color_entry = next_color_entry) + for (i = 0; i < dpyinfo->color_names_size; ++i) { - next_color_entry = color_entry->next; - xfree (color_entry->name); - xfree (color_entry); + for (color_entry = dpyinfo->color_names[i]; + color_entry; color_entry = next_color_entry) + { + next_color_entry = color_entry->next; + + xfree (color_entry->name); + xfree (color_entry); + } } + xfree (dpyinfo->color_names); xfree (dpyinfo->x_id_name); xfree (dpyinfo->x_dnd_atoms); xfree (dpyinfo->color_cells); diff --git a/src/xterm.h b/src/xterm.h index 5d2b397874..37dfa57947 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -509,7 +509,10 @@ struct x_display_info #endif /* A cache mapping color names to RGB values. */ - struct color_name_cache_entry *color_names; + struct color_name_cache_entry **color_names; + + /* The size of that hash table. */ + int color_names_size; /* If non-null, a cache of the colors in the color map. Don't use this directly, call x_color_cells instead. */ commit 9c346270f9848c5abf3c40def48ad1f65758763a Author: Alan Mackenzie Date: Sat Apr 23 20:02:49 2022 +0000 CC Mode: New alignment function c-lineup-argcont-+ This fixes bug #21409. * lisp/progmodes/cc-align.el (c-lineup-argcont-1): New function, mainly extracted from c-lineup-argcont. (c-lineup-argcont): Refactored to use the new function above. (c-lineup-argcont-+): New function. * doc/misc/cc-mode.texi (Operator Line-Up): Add a new piece for c-lineup-argcont-+. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 8b36d1afd7..1f12c30b1f 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -6278,6 +6278,32 @@ expressions for the operands. @comment ------------------------------------------------------------ +@defun c-lineup-argcont-+ +@findex lineup-argcont-+ (c-) +Indent a continued argument @code{c-basic-offset} spaces from the +start of the first argument at the current level of nesting on a +previous line. + +@example +@group +foo (xyz, uvw, aaa + bbb + ccc + + ddd + eee + fff); <- c-lineup-argcont-+ + <--> c-basic-offset +@end group +@end example + +Only continuation lines like this are touched, @code{nil} being +returned on lines which are the start of an argument. + +Within a gcc @code{asm} block, @code{:} is recognized as an argument +separator, but of course only between operand specifications, not in the +expressions for the operands. + +@workswith @code{arglist-cont}, @code{arglist-cont-nonempty}. +@end defun + +@comment ------------------------------------------------------------ + @defun c-lineup-arglist-operators @findex lineup-arglist-operators @r{(c-)} Line up lines starting with an infix operator under the open paren. diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 8298d5fef0..e14f5b9058 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -202,6 +202,58 @@ Works with: arglist-cont-nonempty, arglist-close." (skip-chars-forward " \t")) (vector (current-column))))))) +(defun c-lineup-argcont-1 (elem) + ;; Move to the start of the current arg and return non-nil, otherwise + ;; return nil. + (beginning-of-line) + + (when (eq (car elem) 'arglist-cont-nonempty) + ;; Our argument list might not be the innermost one. If it + ;; isn't, go back to the first position in it. We do this by + ;; stepping back over open parens until we get to the open paren + ;; of our argument list. + (let ((open-paren (c-langelem-2nd-pos c-syntactic-element)) + (paren-state (c-parse-state))) + (while (not (eq (car paren-state) open-paren)) + (unless (consp (car paren-state)) ;; ignore matched braces + (goto-char (car paren-state))) + (setq paren-state (cdr paren-state))))) + + (let ((start (point)) c) + + (when (bolp) + ;; Previous line ending in a comma means we're the start of an + ;; argument. This should quickly catch most cases not for us. + ;; This case is only applicable if we're the innermost arglist. + (c-backward-syntactic-ws) + (setq c (char-before))) + + (unless (eq c ?,) + ;; In a gcc asm, ":" on the previous line means the start of an + ;; argument. And lines starting with ":" are not for us, don't + ;; want them to indent to the preceding operand. + (let ((gcc-asm (save-excursion + (goto-char start) + (c-in-gcc-asm-p)))) + (unless (and gcc-asm + (or (eq c ?:) + (save-excursion + (goto-char start) + (looking-at "[ \t]*:")))) + + (c-lineup-argcont-scan (if gcc-asm ?:)) + t))))) + +(defun c-lineup-argcont-scan (&optional other-match) + ;; Find the start of an argument, for `c-lineup-argcont'. + (when (zerop (c-backward-token-2 1 t)) + (let ((c (char-after))) + (if (or (eq c ?,) (eq c other-match)) + (progn + (forward-char) + (c-forward-syntactic-ws)) + (c-lineup-argcont-scan other-match))))) + ;; Contributed by Kevin Ryde . (defun c-lineup-argcont (elem) "Line up a continued argument. @@ -217,56 +269,30 @@ but of course only between operand specifications, not in the expressions for the operands. Works with: arglist-cont, arglist-cont-nonempty." - (save-excursion - (beginning-of-line) + (when (c-lineup-argcont-1 elem) + (vector (current-column))))) - (when (eq (car elem) 'arglist-cont-nonempty) - ;; Our argument list might not be the innermost one. If it - ;; isn't, go back to the last position in it. We do this by - ;; stepping back over open parens until we get to the open paren - ;; of our argument list. - (let ((open-paren (c-langelem-2nd-pos c-syntactic-element)) - (paren-state (c-parse-state))) - (while (not (eq (car paren-state) open-paren)) - (unless (consp (car paren-state)) ;; ignore matched braces - (goto-char (car paren-state))) - (setq paren-state (cdr paren-state))))) - - (let ((start (point)) c) - - (when (bolp) - ;; Previous line ending in a comma means we're the start of an - ;; argument. This should quickly catch most cases not for us. - ;; This case is only applicable if we're the innermost arglist. - (c-backward-syntactic-ws) - (setq c (char-before))) - - (unless (eq c ?,) - ;; In a gcc asm, ":" on the previous line means the start of an - ;; argument. And lines starting with ":" are not for us, don't - ;; want them to indent to the preceding operand. - (let ((gcc-asm (save-excursion - (goto-char start) - (c-in-gcc-asm-p)))) - (unless (and gcc-asm - (or (eq c ?:) - (save-excursion - (goto-char start) - (looking-at "[ \t]*:")))) - - (c-lineup-argcont-scan (if gcc-asm ?:)) - (vector (current-column)))))))) +(defun c-lineup-argcont-+ (langelem) + "Indent an argument continuation `c-basic-offset' in from the first argument. -(defun c-lineup-argcont-scan (&optional other-match) - ;; Find the start of an argument, for `c-lineup-argcont'. - (when (zerop (c-backward-token-2 1 t)) - (let ((c (char-after))) - (if (or (eq c ?,) (eq c other-match)) - (progn - (forward-char) - (c-forward-syntactic-ws)) - (c-lineup-argcont-scan other-match))))) +This first argument is that on a previous line at the same level of nesting. + +foo (xyz, uvw, aaa + bbb + ccc + + ddd + eee + fff); <- c-lineup-argcont-+ + <--> c-basic-offset + +Only continuation lines like this are touched, nil being returned +on lines which are the start of an argument. + +Works with: arglist-cont, arglist-cont-nonempty." + (save-excursion + (when (c-lineup-argcont-1 langelem) ; Check we've got a continued argument... + ;; ... but ignore the position found. + (goto-char (c-langelem-2nd-pos c-syntactic-element)) + (forward-char) + (c-forward-syntactic-ws) + (vector (+ (current-column) c-basic-offset))))) (defun c-lineup-arglist-intro-after-paren (_langelem) "Line up a line to just after the open paren of the surrounding paren commit 37934b953cff711e6ae926815c60db5bb7d49636 Author: Lars Ingebrigtsen Date: Sat Apr 23 19:31:07 2022 +0200 NEWS copy editing diff --git a/etc/NEWS b/etc/NEWS index f7d81335cc..4dd56e005e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -106,7 +106,7 @@ If you start an executable script with #!/usr/bin/emacs -x -Emac will start without reading any init files (like with --quick), +Emacs will start without reading any init files (like with --quick), and then execute the rest of the script file as Emacs Lisp. When it reaches the end of the script, Emacs will exit with an exit code from the value of the final form. commit fc00ecfce8852b0326c16d8a9f0ef2186e563435 Author: Lars Ingebrigtsen Date: Sat Apr 23 18:37:27 2022 +0200 Fix elc.gz loading test some more diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 1633f3b34c..7d17fbde67 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1844,6 +1844,7 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil." (should (documentation 'zot)) (byte-compile-file el) + (fmakunbound 'foo) (should (load (concat pref ".elc") t)) (should (fboundp 'foo)) (should (documentation 'foo)) @@ -1851,6 +1852,7 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil." (should (documentation 'zot)) (dired-compress-file (concat pref ".elc")) + (fmakunbound 'foo) (should (load (concat pref ".elc.gz") t)) (should (fboundp 'foo)) ;; This fails due to bug#12598. commit e00edf20e7d13277781712c5bbcec7b34f3a829e Author: Lars Ingebrigtsen Date: Sat Apr 23 18:14:26 2022 +0200 Add a failing test case for bug#12598 Author: diff --git a/test/lisp/files-resources/compile-utf8.el b/test/lisp/files-resources/compile-utf8.el new file mode 100644 index 0000000000..ea67626365 --- /dev/null +++ b/test/lisp/files-resources/compile-utf8.el @@ -0,0 +1,11 @@ +(defun zot () + "Yes." + nil) + +(defun foo () + "Yés." + nil) + +(defun bar () + "Nó." + nil) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 34c002be27..1633f3b34c 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1829,5 +1829,34 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil." (find-file (ert-resource-file "file-mode-prop-line")) (should (eq major-mode 'text-mode))) +(ert-deftest files-load-elc-gz-file () + :expected-result :failed + (skip-unless (executable-find "gzip")) + (ert-with-temp-directory dir + (let* ((pref (expand-file-name "compile-utf8" dir)) + (el (concat pref ".el"))) + (copy-file (ert-resource-file "compile-utf8.el") el) + (push dir load-path) + (should (load pref t)) + (should (fboundp 'foo)) + (should (documentation 'foo)) + (should (documentation 'bar)) + (should (documentation 'zot)) + + (byte-compile-file el) + (should (load (concat pref ".elc") t)) + (should (fboundp 'foo)) + (should (documentation 'foo)) + (should (documentation 'bar)) + (should (documentation 'zot)) + + (dired-compress-file (concat pref ".elc")) + (should (load (concat pref ".elc.gz") t)) + (should (fboundp 'foo)) + ;; This fails due to bug#12598. + (should (documentation 'foo)) + (should (documentation 'bar)) + (should (documentation 'zot))))) + (provide 'files-tests) ;;; files-tests.el ends here commit 164a7ebdbc7a28bdfb684101f9bbe3b1e67b825b Author: Juri Linkov Date: Sat Apr 23 17:17:15 2022 +0200 Allow not clearing the echo area * doc/lispref/display.texi (Displaying Messages): Document it. * lisp/minibuffer.el (clear-minibuffer-message): Return nil. * src/xdisp.c (clear_message): Respect the dont-clear-message value. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 2bd0a81fad..0dd8451479 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -336,7 +336,10 @@ functions call it with no arguments when their argument message is Usually this function is called when the next input event arrives after displaying an echo-area message. The function is expected to clear the message displayed by its counterpart function specified by -@code{set-message-function}. +@code{set-message-function}, but doesn't have to. If the function +wants the echo area to remain uncleared, it should return the symbol +@code{dont-clear-message}; any other value will result in the echo +area being cleared. The default value is the function that clears the message displayed in an active minibuffer. diff --git a/etc/NEWS b/etc/NEWS index 57bcef36f1..f7d81335cc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1462,6 +1462,11 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** The return value of 'clear-message-function' is not ignored anymore. +If the function returns 'dont-clear-message', then the message is not +cleared, with the assumption that the function cleared it itself. + +++ ** The local variable section now supports defining fallback modes. This was previously only available when using a property line (i.e., diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index d52084afc3..ef71b4e6be 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -864,7 +864,11 @@ Intended to be called via `clear-message-function'." (setq minibuffer-message-timer nil)) (when (overlayp minibuffer-message-overlay) (delete-overlay minibuffer-message-overlay) - (setq minibuffer-message-overlay nil)))) + (setq minibuffer-message-overlay nil))) + + ;; Return nil telling the caller that the message + ;; should be also handled by the caller. + nil) (setq clear-message-function 'clear-minibuffer-message) diff --git a/src/xdisp.c b/src/xdisp.c index a3a4338eb4..dccff9f2ea 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12681,18 +12681,23 @@ set_message_1 (void *a1, Lisp_Object string) void clear_message (bool current_p, bool last_displayed_p) { + Lisp_Object preserve = Qnil; + if (current_p) { - echo_area_buffer[0] = Qnil; - message_cleared_p = true; - if (FUNCTIONP (Vclear_message_function)) { specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); - safe_call (1, Vclear_message_function); + preserve = safe_call (1, Vclear_message_function); unbind_to (count, Qnil); } + + if (!EQ (preserve, Qdont_clear_message)) + { + echo_area_buffer[0] = Qnil; + message_cleared_p = true; + } } if (last_displayed_p) @@ -36557,12 +36562,20 @@ message displayed by this function), and `command-error-function' (which controls how error messages are displayed). */); Vset_message_function = Qnil; + DEFSYM (Qdont_clear_message, "dont-clear-message"); DEFVAR_LISP ("clear-message-function", Vclear_message_function, doc: /* If non-nil, function to clear echo-area messages. Usually this function is called when the next input event arrives. -The function is called without arguments. It is expected to clear the -message displayed by its counterpart function specified by -`set-message-function'. */); +It is expected to clear the message displayed by its counterpart +function specified by `set-message-function'. + +The function is called without arguments. + +If this function returns a value that isn't `dont-clear-message', the +message is cleared from the echo area as usual. If this function +returns `dont-clear-message', this means that the message was already +handled, and the original message text will not be cleared from the +echo area. */); Vclear_message_function = Qnil; DEFVAR_LISP ("redisplay--all-windows-cause", Vredisplay__all_windows_cause, commit 655b39bd4b8977cdcaa063d51b6651d2ab177f54 Author: Lars Ingebrigtsen Date: Sat Apr 23 17:01:46 2022 +0200 Don't have help-fns--editable-variable override link buttons * lisp/help-fns.el (help-fns--editable-variable): Don't override link buttons (bug#40774). diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 72d773403f..0e46ca1c55 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1302,7 +1302,10 @@ it is displayed along with the global value." (buffer-string)))))))) (defun help-fns--editable-variable (start end variable value buffer) - (when (and (readablep value) help-enable-variable-value-editing) + (when (and (readablep value) + (not (boundp value)) + (not (fboundp value)) + help-enable-variable-value-editing) (add-text-properties start end (list 'help-echo "`e' to edit the value" commit ceaa609523d1c33ea76b9e2aecf48eb50b8963e5 Author: Eli Zaretskii Date: Sat Apr 23 17:15:27 2022 +0300 ; Improve doc strings of completion primitives * src/minibuf.c (Ftry_completion, Fall_completions): Clarify the doc strings. diff --git a/src/minibuf.c b/src/minibuf.c index 90450c51d7..dacfd1255b 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1568,44 +1568,47 @@ match_regexps (Lisp_Object string, Lisp_Object regexps, } DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0, - doc: /* Return common substring of all completions of STRING in COLLECTION. + doc: /* Return longest common substring of all completions of STRING in COLLECTION. + Test each possible completion specified by COLLECTION to see if it begins with STRING. The possible completions may be strings or symbols. Symbols are converted to strings before testing, -see `symbol-name'. +by using `symbol-name'. -All that match STRING are compared together; the longest initial sequence -common to all these matches is the return value. -If there is no match at all, the return value is nil. -For a unique match which is exact, the return value is t. +If no possible completions match, the function returns nil; if +there's just one exact match, it returns t; otherwise it returns +the longest initial substring common to all possible completions +that begin with STRING. If COLLECTION is an alist, the keys (cars of elements) are the possible completions. If an element is not a cons cell, then the -element itself is the possible completion. -If COLLECTION is a hash-table, all the keys that are strings or symbols -are the possible completions. +element itself is a possible completion. +If COLLECTION is a hash-table, all the keys that are either strings +or symbols are the possible completions. If COLLECTION is an obarray, the names of all symbols in the obarray are the possible completions. COLLECTION can also be a function to do the completion itself. -It receives three arguments: the values STRING, PREDICATE and nil. +It receives three arguments: STRING, PREDICATE and nil. Whatever it returns becomes the value of `try-completion'. -If optional third argument PREDICATE is non-nil, it is used to test -each possible match. +If optional third argument PREDICATE is non-nil, it must be a function +of one or two arguments, and is used to test each possible completion. +A possible completion is accepted only if PREDICATE returns non-nil. -The match is a candidate only if PREDICATE returns non-nil. +The argument given to PREDICATE is either a string or a cons cell (whose +car is a string) from the alist, or a symbol from the obarray. +If COLLECTION is a hash-table, PREDICATE is called with two arguments: +the string key and the associated value. -The argument given to PREDICATE is the alist element or the symbol -from the obarray. If COLLECTION is a hash-table, predicate is called -with two arguments: the key and the value. Additionally to this -predicate, `completion-regexp-list' is used to further constrain the -set of candidates. +To be acceptable, a possible completion must also match all the regexps +in `completion-regexp-list' (unless COLLECTION is a function, in +which case that function should itself handle `completion-regexp-list'). -The result value when `completion-ignore-case' is non-nil will be a -string that matches (when ignoring case) COLLECTION, but no guarantee -is made about the case of the result value beyond the whole result -coming from the user input, or coming from one of the candidates. */) +If `completion-ignore-case' is non-nil, possible completions are matched +while ignoring letter-case, but no guarantee is made about the letter-case +of the return value, except that it comes either from the user's input +or from one of the possible completions. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { @@ -1815,11 +1818,13 @@ coming from the user input, or coming from one of the candidates. */) } DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0, - doc: /* Search for partial matches to STRING in COLLECTION. -Test each of the possible completions specified by COLLECTION + doc: /* Search for partial matches of STRING in COLLECTION. + +Test each possible completion specified by COLLECTION to see if it begins with STRING. The possible completions may be strings or symbols. Symbols are converted to strings before testing, -see `symbol-name'. +by using `symbol-name'. + The value is a list of all the possible completions that match STRING. If COLLECTION is an alist, the keys (cars of elements) are the @@ -1831,17 +1836,21 @@ If COLLECTION is an obarray, the names of all symbols in the obarray are the possible completions. COLLECTION can also be a function to do the completion itself. -It receives three arguments: the values STRING, PREDICATE and t. +It receives three arguments: STRING, PREDICATE and t. Whatever it returns becomes the value of `all-completions'. -If optional third argument PREDICATE is non-nil, -it is used to test each possible match. -The match is a candidate only if PREDICATE returns non-nil. -The argument given to PREDICATE is the alist element -or the symbol from the obarray. If COLLECTION is a hash-table, -predicate is called with two arguments: the key and the value. -Additionally to this predicate, `completion-regexp-list' -is used to further constrain the set of candidates. +If optional third argument PREDICATE is non-nil, it must be a function +of one or two arguments, and is used to test each possible completion. +A possible completion is accepted only if PREDICATE returns non-nil. + +The argument given to PREDICATE is either a string or a cons cell (whose +car is a string) from the alist, or a symbol from the obarray. +If COLLECTION is a hash-table, PREDICATE is called with two arguments: +the string key and the associated value. + +To be acceptable, a possible completion must also match all the regexps +in `completion-regexp-list' (unless COLLECTION is a function, in +which case that function should itself handle `completion-regexp-list'). An obsolete optional fourth argument HIDE-SPACES is still accepted for backward compatibility. If non-nil, strings in COLLECTION that start commit b4b0db72d672eda8c7df0baada2bda2667dc9ad5 Author: Lars Ingebrigtsen Date: Sat Apr 23 15:16:41 2022 +0200 Mention the case of the result in the try-completion doc string * src/minibuf.c (Ftry_completion): Mention the case of the results (bug#39484). diff --git a/src/minibuf.c b/src/minibuf.c index 97a6ec6901..90450c51d7 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1573,6 +1573,7 @@ Test each possible completion specified by COLLECTION to see if it begins with STRING. The possible completions may be strings or symbols. Symbols are converted to strings before testing, see `symbol-name'. + All that match STRING are compared together; the longest initial sequence common to all these matches is the return value. If there is no match at all, the return value is nil. @@ -1590,14 +1591,21 @@ COLLECTION can also be a function to do the completion itself. It receives three arguments: the values STRING, PREDICATE and nil. Whatever it returns becomes the value of `try-completion'. -If optional third argument PREDICATE is non-nil, -it is used to test each possible match. +If optional third argument PREDICATE is non-nil, it is used to test +each possible match. + The match is a candidate only if PREDICATE returns non-nil. -The argument given to PREDICATE is the alist element -or the symbol from the obarray. If COLLECTION is a hash-table, -predicate is called with two arguments: the key and the value. -Additionally to this predicate, `completion-regexp-list' -is used to further constrain the set of candidates. */) + +The argument given to PREDICATE is the alist element or the symbol +from the obarray. If COLLECTION is a hash-table, predicate is called +with two arguments: the key and the value. Additionally to this +predicate, `completion-regexp-list' is used to further constrain the +set of candidates. + +The result value when `completion-ignore-case' is non-nil will be a +string that matches (when ignoring case) COLLECTION, but no guarantee +is made about the case of the result value beyond the whole result +coming from the user input, or coming from one of the candidates. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { commit 5bc5e565761fe40941ecc76ee6c28f01387f0980 Author: Lars Ingebrigtsen Date: Sat Apr 23 14:52:45 2022 +0200 Make elisp-flymake-byte-compile clean up on failures * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile): Clean up no matter what the exit status of the process is (bug#55056). diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 8cae680634..33f6902491 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -2083,7 +2083,7 @@ current buffer state and calls REPORT-FN when done." :connection-type 'pipe :sentinel (lambda (proc _event) - (when (eq (process-status proc) 'exit) + (unless (process-live-p proc) (unwind-protect (cond ((not (and (buffer-live-p source-buffer) commit 2c0a01ee389944d95034ef673ff0255d99ef4b80 Author: Lars Ingebrigtsen Date: Sat Apr 23 14:47:55 2022 +0200 Don't make a header if the user hasn't specified columns in vtable * lisp/emacs-lisp/vtable.el (vtable): (make-vtable): Store whether the user has specified the columns. (vtable-insert): Don't insert a header line or a header if the user hasn't specified the columns (bug#55075). diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 7148844b63..61265c97c2 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -68,7 +68,8 @@ (row-colors :initarg :row-colors :accessor vtable-row-colors) (-cached-colors :initform nil) (-cache :initform (make-hash-table :test #'equal)) - (-cached-keymap :initform nil)) + (-cached-keymap :initform nil) + (-has-column-spec :initform nil)) "An object to hold the data for a table.") (defvar-keymap vtable-map @@ -106,29 +107,11 @@ be inserted. See info node `(vtable)Top' for vtable documentation." (when objects-function (setq objects (funcall objects-function))) - ;; Auto-generate the columns. - (unless columns - (unless objects - (error "Can't auto-generate columns; no objects")) - (setf columns (make-list (length (car objects)) ""))) - (setq columns (mapcar (lambda (column) - (cond - ;; We just have the name (as a string). - ((stringp column) - (make-vtable-column :name column)) - ;; A plist of keywords/values. - ((listp column) - (apply #'make-vtable-column column)) - ;; A full `vtable-column' object. - (t - column))) - columns)) ;; We'll be altering the list, so create a copy. (setq objects (copy-sequence objects)) (let ((table (make-instance 'vtable - :columns columns :objects objects :objects-function objects-function :getter getter @@ -143,6 +126,26 @@ See info node `(vtable)Top' for vtable documentation." :row-colors row-colors :column-colors column-colors :ellipsis ellipsis))) + ;; Store whether the user has specified columns or not. + (setf (slot-value table '-has-column-spec) (not (not columns))) + ;; Auto-generate the columns. + (unless columns + (unless objects + (error "Can't auto-generate columns; no objects")) + (setq columns (make-list (length (car objects)) ""))) + (setf (vtable-columns table) + (mapcar (lambda (column) + (cond + ;; We just have the name (as a string). + ((stringp column) + (make-vtable-column :name column)) + ;; A plist of keywords/values. + ((listp column) + (apply #'make-vtable-column column)) + ;; A full `vtable-column' object. + (t + column))) + columns)) ;; Compute missing column data. (setf (vtable-columns table) (vtable--compute-columns table)) ;; Compute the colors. @@ -446,17 +449,20 @@ This also updates the displayed table." ;; correctly if Emacs is open on two different screens (or the ;; user resizes the frame). (widths (nth 1 (vtable--ensure-cache table)))) - (if (vtable-use-header-line table) - (vtable--set-header-line table widths spacer) - ;; Insert the header line directly into the buffer, and put a - ;; keymap to be able to sort the columns there (by clicking on - ;; them). - (vtable--insert-header-line table widths spacer) - (add-text-properties start (point) - (list 'keymap vtable-header-line-map - 'rear-nonsticky t - 'vtable table)) - (setq start (point))) + ;; Don't insert any header or header line if the user hasn't + ;; specified the columns. + (when (slot-value table '-has-column-spec) + (if (vtable-use-header-line table) + (vtable--set-header-line table widths spacer) + ;; Insert the header line directly into the buffer, and put a + ;; keymap to be able to sort the columns there (by clicking on + ;; them). + (vtable--insert-header-line table widths spacer) + (add-text-properties start (point) + (list 'keymap vtable-header-line-map + 'rear-nonsticky t + 'vtable table)) + (setq start (point)))) (vtable--sort table) ;; Insert the data. (let ((line-number 0)) commit ca5fb2b922581505ad96d7e03c2a7bba17adb8e8 Author: Filipp Gunbin Date: Sat Apr 23 14:29:45 2022 +0200 Fix prompts in sql-get-login again * lisp/progmodes/sql.el (sql-get-login-ext): Use prompt-def everywhere. (sql-get-login): Revert previous fix (bug#52546). diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 13fba0c705..18b0274fbf 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3216,7 +3216,7 @@ For both `:file' and `:completion', there can also be a (cond ((plist-member plist :file) (let ((file-name - (read-file-name prompt + (read-file-name prompt-def (file-name-directory last-value) default (if (plist-member plist :must-match) @@ -3246,7 +3246,7 @@ For both `:file' and `:completion', there can also be a default)) ((plist-get plist :number) - (read-number prompt (or default last-value 0))) + (read-number (concat prompt ": ") (or default last-value 0))) (t (read-string prompt-def last-value history-var default)))))) @@ -3318,7 +3318,7 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (sql-get-login-ext 'sql-server "Server" 'sql-server-history plist)) ('database - (sql-get-login-ext 'sql-database "Database: " + (sql-get-login-ext 'sql-database "Database" 'sql-database-history plist)) ('port commit daf82f61bbca8efc6f3a055a6be4469f6ab4ce97 Author: Lars Ingebrigtsen Date: Sat Apr 23 14:12:57 2022 +0200 Regenerated ldefs-boot.el diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 77f6b980ac..93e8e14d1f 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -5062,6 +5062,9 @@ Increment PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the incremented value of PLACE. +If X is specified, it should be an expression that should +evaluate to a number. + \(fn PLACE &optional X)" nil t) (defvar cl-old-struct-compat-mode nil "\ @@ -5394,7 +5397,7 @@ Generate .elc files in addition to the .eln files. Force the produced .eln to be outputted in the eln system directory (the last entry in `native-comp-eln-load-path') unless `native-compile-target-directory' is non-nil. If the environment -variable 'NATIVE_DISABLED' is set, only byte compile." nil nil) +variable \"NATIVE_DISABLED\" is set, only byte compile." nil nil) (autoload 'native-compile-async "comp" "\ Compile FILES asynchronously. @@ -8009,8 +8012,11 @@ The directory name must be absolute, but need not be fully expanded.") (autoload 'dired "dired" "\ \"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it. -Optional second argument SWITCHES specifies the `ls' options used. -\(Interactively, use a prefix argument to be able to specify SWITCHES.) +Optional second argument SWITCHES specifies the options to be used +when invoking `insert-directory-program', usually `ls', which produces +the listing of the directory files and their attributes. +Interactively, a prefix argument will cause the command to prompt +for SWITCHES. If DIRNAME is a string, Dired displays a list of files in DIRNAME (which may also have shell wildcards appended to select certain files). @@ -11061,7 +11067,7 @@ Example usage: (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate - '(\"/home/bandali/my-cert.key\" + \\='(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\")) \(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE)" t nil) @@ -16392,7 +16398,8 @@ gives the window that lists the options.") (autoload 'help-mode "help-mode" "\ Major mode for viewing help text and navigating references in it. -Entry to this mode runs the normal hook `help-mode-hook'. +Also see the `help-enable-editing' variable. + Commands: \\{help-mode-map} @@ -19101,10 +19108,12 @@ Give an empty topic name to go to the Index node itself. \(fn TOPIC)" t nil) (autoload 'info-apropos "info" "\ -Grovel indices of all known Info files on your system for STRING. -Build a menu of the possible matches. +Search indices of all known Info files on your system for STRING. +If REGEXP (interactively, the prefix), use a regexp match. -\(fn STRING)" t nil) +Display a menu of the possible matches. + +\(fn STRING &optional REGEXP)" t nil) (autoload 'info-finder "info" "\ Display descriptions of the keywords in the Finder virtual manual. @@ -21651,7 +21660,7 @@ Command to parse command line mailto: links. This is meant to be used for MIME handlers: Setting the handler for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\" will then start up Emacs ready to compose mail. For emacsclient use - emacsclient -e '(message-mailto \"%u\")' + emacsclient -e \\='(message-mailto \"%u\")' \(fn &optional URL)" t nil) @@ -22324,7 +22333,7 @@ Major mode for the mixal asm language. ;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mm-encode.el -(define-obsolete-function-alias 'mm-default-file-encoding #'mm-default-file-type "future") +(define-obsolete-function-alias 'mm-default-file-encoding #'mm-default-file-type "28.1") (autoload 'mm-default-file-type "mm-encode" "\ Return a default content type for FILE. @@ -24672,7 +24681,7 @@ is active. \(fn &optional TODO-ONLY STRING EDIT-AT)" t nil) (autoload 'org-todo-list "org-agenda" "\ -Show all (not done) TODO entries from all agenda file in a single list. +Show all (not done) TODO entries from all agenda files in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using `\\[universal-argument]', you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in @@ -24733,7 +24742,7 @@ Set restriction lock for agenda to current subtree or file. When in a restricted subtree, remove it. The restriction will span over the entire file if TYPE is `file', -or if type is '(4), or if the cursor is before the first headline +or if type is \\='(4), or if the cursor is before the first headline in the file. Otherwise, only apply the restriction to the current subtree. @@ -25551,7 +25560,7 @@ PATTERNS are normal `pcase' patterns, and VALUES are expression. Evaluation happens sequentially as in `setq' (not in parallel). -An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)])) +An example: (pcase-setq \\=`((,a) [(,b)]) \\='((1) [(2)])) VAL is presumed to match PAT. Failure to match may signal an error or go undetected, binding variables to arbitrary values, such as nil. @@ -27976,7 +27985,7 @@ to a file, and killing a buffer is counted as \"operating\" on the file. If instead you want to prioritize files that appear in buffers you switch to a lot, you can say something like the following: - (add-hook 'buffer-list-update-hook 'recentf-track-opened-file) + (add-hook \\='buffer-list-update-hook #\\='recentf-track-opened-file) This is a global minor mode. If called interactively, toggle the `Recentf mode' mode. If the prefix argument is positive, enable @@ -35627,7 +35636,7 @@ It must be supported by libarchive(3).") Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'")) (defun tramp-archive-autoload-file-name-handler (operation &rest args) "\ -Load Tramp archive file name handler, and perform OPERATION." (defvar tramp-archive-autoload) (when tramp-archive-enabled (let ((default-directory temporary-file-directory) (tramp-archive-autoload t)) (apply #'tramp-autoload-file-name-handler operation args)))) +Load Tramp archive file name handler, and perform OPERATION." (defvar tramp-archive-autoload) (let ((default-directory temporary-file-directory) (tramp-archive-autoload tramp-archive-enabled)) (apply #'tramp-autoload-file-name-handler operation args))) (defun tramp-register-archive-file-name-handler nil "\ Add archive file name handler to `file-name-handler-alist'." (when (and tramp-archive-enabled (not (rassq #'tramp-archive-file-name-handler file-name-handler-alist))) (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))) @@ -39807,6 +39816,65 @@ Default bookmark handler for Woman buffers. (register-definition-prefixes "woman" '("WoMan-" "menu-bar-manuals-menu" "set-woman-file-regexp" "woman")) +;;;*** + +;;;### (autoloads nil "word-wrap-mode" "textmodes/word-wrap-mode.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from textmodes/word-wrap-mode.el + +(autoload 'word-wrap-whitespace-mode "word-wrap-mode" "\ +Allow `word-wrap' to fold on all breaking whitespace characters. + +The characters to break on are defined by `word-wrap-whitespace-characters'. + +This is a minor mode. If called interactively, toggle the +`Word-Wrap-Whitespace mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `word-wrap-whitespace-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +\(fn &optional ARG)" t nil) + +(put 'global-word-wrap-whitespace-mode 'globalized-minor-mode t) + +(defvar global-word-wrap-whitespace-mode nil "\ +Non-nil if Global Word-Wrap-Whitespace mode is enabled. +See the `global-word-wrap-whitespace-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `global-word-wrap-whitespace-mode'.") + +(custom-autoload 'global-word-wrap-whitespace-mode "word-wrap-mode" nil) + +(autoload 'global-word-wrap-whitespace-mode "word-wrap-mode" "\ +Toggle Word-Wrap-Whitespace mode in all buffers. +With prefix ARG, enable Global Word-Wrap-Whitespace mode if ARG is +positive; otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +Word-Wrap-Whitespace mode is enabled in all buffers where +`word-wrap-whitespace-mode' would do it. + +See `word-wrap-whitespace-mode' for more information on +Word-Wrap-Whitespace mode. + +\(fn &optional ARG)" t nil) + +(register-definition-prefixes "word-wrap-mode" '("word-wrap-whitespace-characters")) + ;;;*** ;;;### (autoloads nil "x-dnd" "x-dnd.el" (0 0 0 0)) @@ -40222,14 +40290,14 @@ Zone out, completely." t nil) ;;;;;; "erc/erc-stamp.el" "erc/erc-status-sidebar.el" "erc/erc-track.el" ;;;;;; "erc/erc-truncate.el" "erc/erc-xdcc.el" "eshell/em-alias.el" ;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-cmpl.el" -;;;;;; "eshell/em-dirs.el" "eshell/em-glob.el" "eshell/em-hist.el" -;;;;;; "eshell/em-ls.el" "eshell/em-pred.el" "eshell/em-prompt.el" -;;;;;; "eshell/em-rebind.el" "eshell/em-script.el" "eshell/em-smart.el" -;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el" -;;;;;; "eshell/em-xtra.el" "eshell/esh-groups.el" "faces.el" "files.el" -;;;;;; "finder-inf.el" "font-core.el" "font-lock.el" "format.el" -;;;;;; "frame.el" "help.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" -;;;;;; "international/characters.el" "international/charprop.el" +;;;;;; "eshell/em-dirs.el" "eshell/em-elecslash.el" "eshell/em-glob.el" +;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "eshell/em-pred.el" +;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el" +;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-tramp.el" +;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "eshell/esh-groups.el" +;;;;;; "faces.el" "files.el" "finder-inf.el" "font-core.el" "font-lock.el" +;;;;;; "format.el" "frame.el" "help.el" "hfy-cmap.el" "ibuf-ext.el" +;;;;;; "indent.el" "international/characters.el" "international/charprop.el" ;;;;;; "international/charscript.el" "international/cp51932.el" ;;;;;; "international/emoji-labels.el" "international/emoji-zwj.el" ;;;;;; "international/eucjp-ms.el" "international/idna-mapping.el" commit c789430331948e76b38091aa95bb9a9602a08289 Author: Lars Ingebrigtsen Date: Sat Apr 23 14:12:18 2022 +0200 Add new minor mode word-wrap-whitespace-mode * doc/emacs/display.texi (Visual Line Mode): Document it. * lisp/textmodes/word-wrap-mode.el: New minor mode. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 534bf5881e..2ac0dca622 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1899,12 +1899,22 @@ logical lines, so having a fringe indicator for each wrapped line would be visually distracting. You can change this by customizing the variable @code{visual-line-fringe-indicators}. +@vindex word-wrap-whitespace-mode + By default, Emacs only breaks lines after whitespace characters like +@key{SPC} and @key{TAB}, but does not break after whitespace +characters like @key{EN QUAD}. Emacs provides a minor mode called +@code{word-wrap-whitespace-mode} that switches on word wrapping in the +current mode, and sets up which characters to wrap lines on based on +the @code{word-wrap-whitespace-characters} user option. There's also +a globalized version of that mode called +@code{global-word-wrap-whitespace-mode}. + @vindex word-wrap-by-category @findex modify-category-entry @findex char-category-set @findex category-set-mnemonics - By default, Emacs only breaks lines after whitespace characters. -That produces incorrect results when CJK and Latin text are mixed + Only breaking after whitespace character produces incorrect +results when CJK and Latin text are mixed together (because CJK characters don't use whitespace to separate words). You can customize the option @code{word-wrap-by-category} to allow Emacs to break lines after any character with @samp{|} category diff --git a/etc/NEWS b/etc/NEWS index c0b9ce654e..57bcef36f1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -642,6 +642,11 @@ script that was used in ancient South Asia. A new input method, * Changes in Specialized Modes and Packages in Emacs 29.1 ++++ +** New minor mode 'word-wrap-whitespace-mode' for extending 'word-wrap'. +This mode switches 'word-wrap' on, and breaks on all the whitespace +characters instead of just SPC and TAB. + --- ** New mode, 'emacs-news-mode', for editing the NEWS file. This mode adds some highlighting, fixes the 'M-q' command, and has diff --git a/lisp/textmodes/word-wrap-mode.el b/lisp/textmodes/word-wrap-mode.el new file mode 100644 index 0000000000..78823c4f13 --- /dev/null +++ b/lisp/textmodes/word-wrap-mode.el @@ -0,0 +1,91 @@ +;;; word-wrap-mode.el --- minor mode for `word-wrap' tweaks -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +;; The list below lists all characters that have a general-category of +;; Zs, but with the ones we don't want to add here commented out. +(defcustom word-wrap-whitespace-characters + '(;;?\N{SPACE} + ;;?\N{NO-BREAK SPACE} + ?\N{OGHAM SPACE MARK} + ?\N{EN QUAD} + ?\N{EM QUAD} + ?\N{EN SPACE} + ?\N{EM SPACE} + ?\N{THREE-PER-EM SPACE} + ?\N{FOUR-PER-EM SPACE} + ?\N{SIX-PER-EM SPACE} + ?\N{FIGURE SPACE} + ?\N{PUNCTUATION SPACE} + ?\N{THIN SPACE} + ?\N{HAIR SPACE} + ;;?\N{NARROW NO-BREAK SPACE} + ?\N{MEDIUM MATHEMATICAL SPACE} + ?\N{IDEOGRAPHIC SPACE} + ;; Not in the Zs category: + ?\N{ZERO WIDTH SPACE}) + "Characters that `word-wrap-whitespace-mode' should add to `word-wrap'." + :version "29.1" + :type '(repeat char) + :group 'display) + +(defvar word-wrap-mode--previous-state) + +;;;###autoload +(define-minor-mode word-wrap-whitespace-mode + "Allow `word-wrap' to fold on all breaking whitespace characters. +The characters to break on are defined by `word-wrap-whitespace-characters'." + :group 'display + (if word-wrap-whitespace-mode + (progn + (setq-local word-wrap-mode--previous-state + (list (category-table) + (local-variable-p 'word-wrap-by-category) + word-wrap-by-category + (local-variable-p 'word-wrap) + word-wrap)) + (set-category-table (copy-category-table)) + (dolist (char word-wrap-whitespace-characters) + (modify-category-entry char ?|)) + (setq-local word-wrap-by-category t + word-wrap t)) + (pcase-let ((`(,table ,lby-cat ,by-cat + ,lwrap ,wrap) + word-wrap-mode--previous-state)) + (if lby-cat + (setq-local word-wrap-by-category by-cat) + (kill-local-variable 'word-wrap-by-category)) + (if lwrap + (setq-local word-wrap wrap) + (kill-local-variable 'word-wrap)) + (set-category-table table)))) + +;;;###autoload +(define-globalized-minor-mode global-word-wrap-whitespace-mode + word-wrap-whitespace-mode word-wrap-whitespace-mode + :group 'display) + +(provide 'word-wrap-mode) + +;;; word-wrap-mode.el ends here commit 759d337b0d05f3164bf90dd980a079cd412f9de1 Author: Po Lu Date: Sat Apr 23 19:34:46 2022 +0800 Fix key navigation of Lucid menus on XI2 * src/xmenu.c (popup_get_selection): Fix cookie claiming of input extension events. (Fx_menu_bar_open_internal): Use right timestamps on XI2. * src/xterm.c (handle_one_xevent): Dispatch XI2 key events via Xt when popup is active. diff --git a/src/xmenu.c b/src/xmenu.c index 94cd9dab69..316dacee5b 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -365,16 +365,16 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, && event.xgeneric.display == dpyinfo->display && event.xgeneric.extension == dpyinfo->xi2_opcode) { + if (!event.xcookie.data + && XGetEventData (dpyinfo->display, &event.xcookie)) + cookie_claimed_p = true; + if (event.xcookie.data) { switch (event.xgeneric.evtype) { case XI_ButtonRelease: { - if (!event.xcookie.data - && XGetEventData (dpyinfo->display, &event.xcookie)) - cookie_claimed_p = true; - xev = (XIDeviceEvent *) event.xcookie.data; device = xi_device_from_id (dpyinfo, xev->deviceid); @@ -424,10 +424,6 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, { KeySym keysym; - if (!event.xcookie.data - && XGetEventData (dpyinfo->display, &event.xcookie)) - cookie_claimed_p = true; - xev = (XIDeviceEvent *) event.xcookie.data; copy.xkey.type = KeyPress; @@ -473,6 +469,9 @@ DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_i { XEvent ev; struct frame *f = decode_window_system_frame (frame); +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); +#endif Widget menubar; block_input (); @@ -485,12 +484,44 @@ DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_i Window child; bool error_p = false; +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + /* Clear the XI2 grab so Motif or lwlib can set a core grab. + Otherwise some versions of Motif will emit a warning and hang, + and lwlib will fail to destroy the menu window. */ + + if (dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) + { + for (int i = 0; i < dpyinfo->num_devices; ++i) + { + /* The keyboard grab matters too, in this specific + case. */ +#ifndef USE_LUCID + if (dpyinfo->devices[i].grab) +#endif + { + XIUngrabDevice (dpyinfo->display, + dpyinfo->devices[i].device_id, + CurrentTime); + dpyinfo->devices[i].grab = 0; + } + } + } +#endif + x_catch_errors (FRAME_X_DISPLAY (f)); memset (&ev, 0, sizeof ev); ev.xbutton.display = FRAME_X_DISPLAY (f); ev.xbutton.window = XtWindow (menubar); ev.xbutton.root = FRAME_DISPLAY_INFO (f)->root_window; +#ifndef HAVE_XINPUT2 ev.xbutton.time = XtLastTimestampProcessed (FRAME_X_DISPLAY (f)); +#else + ev.xbutton.time = ((dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_KeyPress)) + ? dpyinfo->last_user_time + : XtLastTimestampProcessed (dpyinfo->display)); +#endif ev.xbutton.button = Button1; ev.xbutton.x = ev.xbutton.y = FRAME_MENUBAR_HEIGHT (f) / 2; ev.xbutton.same_screen = True; diff --git a/src/xterm.c b/src/xterm.c index 1b1074b2f4..8b813210b7 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13833,10 +13833,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent configureEvent; XEvent next_event; Lisp_Object coding; -#if defined USE_MOTIF && defined HAVE_XINPUT2 - /* Some XInput 2 events are important for Motif menu bars to work - correctly, so they must be translated into core events before - being passed to XtDispatchEvent. */ +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + /* Some XInput 2 events are important for Motif and Lucid menu bars + to work correctly, so they must be translated into core events + before being passed to XtDispatchEvent. */ bool use_copy = false; XEvent copy; #elif defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 @@ -17746,7 +17746,41 @@ handle_one_xevent (struct x_display_info *dpyinfo, #if defined (USE_X_TOOLKIT) || defined (USE_GTK) /* Dispatch XI_KeyPress events when in menu. */ if (popup_activated ()) - goto XI_OTHER; + { +#ifdef USE_LUCID + /* This makes key navigation work inside menus. */ + use_copy = true; + copy.xkey.type = KeyPress; + copy.xkey.serial = xev->serial; + copy.xkey.send_event = xev->send_event; + copy.xkey.display = dpyinfo->display; + copy.xkey.window = xev->event; + copy.xkey.root = xev->root; + copy.xkey.subwindow = xev->child; + copy.xkey.time = xev->time; + copy.xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14)) + | (xev->group.effective << 13)); + + copy.xkey.x = lrint (xev->event_x); + copy.xkey.y = lrint (xev->event_y); + copy.xkey.x_root = lrint (xev->root_x); + copy.xkey.y_root = lrint (xev->root_y); + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xkey.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xkey.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xkey.state |= Button3Mask; + } + + copy.xkey.keycode = xev->detail; + copy.xkey.same_screen = True; +#endif + goto XI_OTHER; + } #endif x_display_set_last_user_time (dpyinfo, xev->time); @@ -18193,7 +18227,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif case XI_KeyRelease: -#if defined HAVE_X_I18N || defined USE_GTK +#if defined HAVE_X_I18N || defined USE_GTK || defined USE_LUCID { XKeyPressedEvent xkey; @@ -18229,14 +18263,31 @@ handle_one_xevent (struct x_display_info *dpyinfo, xkey.keycode = xev->detail; xkey.same_screen = True; +#ifdef USE_LUCID + if (!popup_activated ()) + { +#endif #ifdef HAVE_X_I18N - if (x_filter_event (dpyinfo, (XEvent *) &xkey)) - *finish = X_EVENT_DROP; -#else - f = x_any_window_to_frame (xkey->event); + if (x_filter_event (dpyinfo, (XEvent *) &xkey)) + *finish = X_EVENT_DROP; +#elif defined USE_GTK + f = x_any_window_to_frame (xkey->event); - if (f && xg_filter_key (f, event)) - *finish = X_EVENT_DROP; + if (f && xg_filter_key (f, event)) + *finish = X_EVENT_DROP; +#endif +#ifdef USE_LUCID + } + else + { + /* FIXME: the Lucid menu bar pops down upon any key + release event, so we don't dispatch these events + at all, which doesn't seem to be the right + solution. + + use_copy = true; + copy.xkey = xkey; */ + } #endif } #endif @@ -19009,12 +19060,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, { /* Ignore some obviously bogus ConfigureNotify events that other clients have been known to send Emacs. - (bug#54051)*/ + (bug#54051) */ if (event->type != ConfigureNotify || (event->xconfigure.width != 0 && event->xconfigure.height != 0)) { -#if defined USE_MOTIF && defined HAVE_XINPUT2 +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 XtDispatchEvent (use_copy ? © : (XEvent *) event); #else XtDispatchEvent ((XEvent *) event);