commit ee0e259e5d52749999be329afa9c764a8aff0531 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Tue Dec 29 08:38:17 2020 +0100 Add some tests for align.el diff --git a/test/lisp/align-resources/align-post.c b/test/lisp/align-resources/align-post.c new file mode 100644 index 0000000000..157e1d6242 --- /dev/null +++ b/test/lisp/align-resources/align-post.c @@ -0,0 +1,3 @@ +int +main (int argc, + char *argv[]); diff --git a/test/lisp/align-resources/align-post.java b/test/lisp/align-resources/align-post.java new file mode 100644 index 0000000000..e0ea8e727f --- /dev/null +++ b/test/lisp/align-resources/align-post.java @@ -0,0 +1,9 @@ +class X +{ + String field1; + String[] field2; + int field3; + int[] field4; + X field5; + X[] field6; +} diff --git a/test/lisp/align-resources/align-pre.c b/test/lisp/align-resources/align-pre.c new file mode 100644 index 0000000000..b1774181a4 --- /dev/null +++ b/test/lisp/align-resources/align-pre.c @@ -0,0 +1,3 @@ +int +main (int argc, + char *argv[]); diff --git a/test/lisp/align-resources/align-pre.java b/test/lisp/align-resources/align-pre.java new file mode 100644 index 0000000000..fe7a87a939 --- /dev/null +++ b/test/lisp/align-resources/align-pre.java @@ -0,0 +1,9 @@ +class X +{ + String field1; + String[] field2; + int field3; + int[] field4; + X field5; + X[] field6; +} diff --git a/test/lisp/align-tests.el b/test/lisp/align-tests.el new file mode 100644 index 0000000000..b66ebb8b84 --- /dev/null +++ b/test/lisp/align-tests.el @@ -0,0 +1,47 @@ +;;; align-tests.el --- Test suite for aligns -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2020 Free Software Foundation, Inc. + +;; 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: + +(require 'ert) +(require 'ert-x) +(require 'align) + +(defun test-align-compare (file function) + (should (equal + (with-temp-buffer + (insert-file-contents (ert-resource-file (format file "pre"))) + (funcall function) + (align (point-min) (point-max)) + (buffer-substring-no-properties (point-min) (point-max))) + (with-temp-buffer + (insert-file-contents (ert-resource-file (format file "post"))) + (buffer-string))))) + +(ert-deftest align-java () + (test-align-compare "align-%s.java" #'java-mode)) + +(ert-deftest align-c () + (test-align-compare "align-%s.c" #'c-mode)) + +(provide 'align-tests) + +;;; align-tests.el ends here commit 1fc011c07578168ce25f7db2271f58cb02f540a3 Author: Glenn Morris Date: Mon Dec 28 21:36:47 2020 -0800 * src/xdisp.c (display_mode_line): I guess FALSE should be false. diff --git a/src/xdisp.c b/src/xdisp.c index 72256cddd3..7ad6b1b189 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -25467,7 +25467,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) { Lisp_Object mode_string = Fformat_mode_line (format, Qnil, Qnil, Qnil); if (EQ (Vmode_line_compact, Qlong) - && window_body_width (XWINDOW (selected_window), FALSE) >= + && window_body_width (XWINDOW (selected_window), false) >= SCHARS (mode_string)) { /* The window is wide enough; just display the mode line we commit 6481da6b90bcbccbd334f060ac2a4aafaea83df3 Author: Lars Ingebrigtsen Date: Tue Dec 29 06:07:44 2020 +0100 Revert the previous display_string change * src/xdisp.c (display_string): Revert adding the additional ignore_text_properties parameter -- it was already covered by the other mix of parameters. diff --git a/src/xdisp.c b/src/xdisp.c index 4c4d349ee5..72256cddd3 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1115,7 +1115,7 @@ static void pint2str (register char *, register int, register ptrdiff_t); static int display_string (const char *, Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t, struct it *, int, int, int, - int, bool); + int); static void compute_line_metrics (struct it *); static void run_redisplay_end_trigger_hook (struct it *); static bool get_overlay_strings (struct it *, ptrdiff_t); @@ -13155,13 +13155,12 @@ display_tab_bar (struct window *w) if (it.current_x < it.last_visible_x) display_string (NULL, string, Qnil, 0, 0, &it, - SCHARS (string), 0, 0, STRING_MULTIBYTE (string), - TRUE); + SCHARS (string), 0, 0, STRING_MULTIBYTE (string)); } /* Fill out the line with spaces. */ if (it.current_x < it.last_visible_x) - display_string ("", Qnil, Qnil, 0, 0, &it, -1, 0, 0, -1, TRUE); + display_string ("", Qnil, Qnil, 0, 0, &it, -1, 0, 0, -1); /* Compute the total height of the lines. */ compute_line_metrics (&it); @@ -25138,13 +25137,12 @@ display_menu_bar (struct window *w) /* Display the item, pad with one space. */ if (it.current_x < it.last_visible_x) display_string (NULL, string, Qnil, 0, 0, &it, - SCHARS (string) + 1, 0, 0, STRING_MULTIBYTE (string), - TRUE); + SCHARS (string) + 1, 0, 0, STRING_MULTIBYTE (string)); } /* Fill out the line with spaces. */ if (it.current_x < it.last_visible_x) - display_string ("", Qnil, Qnil, 0, 0, &it, -1, 0, 0, -1, TRUE); + display_string ("", Qnil, Qnil, 0, 0, &it, -1, 0, 0, -1); /* Compute the total height of the lines. */ compute_line_metrics (&it); @@ -25248,22 +25246,21 @@ display_tty_menu_item (const char *item_text, int width, int face_id, it.paragraph_embedding = L2R; /* Pad with a space on the left. */ - display_string (" ", Qnil, Qnil, 0, 0, &it, 1, 0, FRAME_COLS (f) - 1, -1, - TRUE); + display_string (" ", Qnil, Qnil, 0, 0, &it, 1, 0, FRAME_COLS (f) - 1, -1); width--; /* Display the menu item, pad with spaces to WIDTH. */ if (submenu) { display_string (item_text, Qnil, Qnil, 0, 0, &it, - item_len, 0, FRAME_COLS (f) - 1, -1, TRUE); + item_len, 0, FRAME_COLS (f) - 1, -1); width -= item_len; /* Indicate with " >" that there's a submenu. */ display_string (" >", Qnil, Qnil, 0, 0, &it, width, 0, - FRAME_COLS (f) - 1, -1, TRUE); + FRAME_COLS (f) - 1, -1); } else display_string (item_text, Qnil, Qnil, 0, 0, &it, - width, 0, FRAME_COLS (f) - 1, -1, TRUE); + width, 0, FRAME_COLS (f) - 1, -1); row->used[TEXT_AREA] = max (saved_used, row->used[TEXT_AREA]); row->truncated_on_right_p = saved_truncated; @@ -25475,9 +25472,9 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) { /* The window is wide enough; just display the mode line we just computed. */ - display_string (SSDATA (mode_string), mode_string, Qnil, + display_string (NULL, mode_string, Qnil, 0, 0, &it, 0, 0, 0, - STRING_MULTIBYTE (mode_string), FALSE); + STRING_MULTIBYTE (mode_string)); } else { @@ -25494,7 +25491,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) Fsubstring (mode_string, make_fixnum (start), make_fixnum (i - 1)), Qnil, 0, 0, &it, 0, 0, 0, - STRING_MULTIBYTE (mode_string), FALSE); + STRING_MULTIBYTE (mode_string)); /* Skip past the rest of the space characters. */ while (c == ' ' && i < SCHARS (mode_string)) c = fetch_string_char_advance (mode_string, &i, &i_byte); @@ -25509,7 +25506,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) Fsubstring (mode_string, make_fixnum (start), make_fixnum (i - 1)), Qnil, 0, 0, &it, 0, 0, 0, - STRING_MULTIBYTE (mode_string), FALSE); + STRING_MULTIBYTE (mode_string)); } } pop_kboard (); @@ -25517,7 +25514,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) unbind_to (count, Qnil); /* Fill up with spaces. */ - display_string (" ", Qnil, Qnil, 0, 0, &it, 10000, -1, -1, 0, TRUE); + display_string (" ", Qnil, Qnil, 0, 0, &it, 10000, -1, -1, 0); compute_line_metrics (&it); it.glyph_row->full_width_p = true; @@ -25721,7 +25718,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, break; case MODE_LINE_DISPLAY: n += display_string (NULL, elt, Qnil, 0, 0, it, - 0, prec, 0, STRING_MULTIBYTE (elt), TRUE); + 0, prec, 0, STRING_MULTIBYTE (elt)); break; } @@ -25783,7 +25780,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, nchars = string_byte_to_char (elt, offset) - charpos; n += display_string (NULL, elt, Qnil, 0, charpos, it, 0, nchars, 0, - STRING_MULTIBYTE (elt), TRUE); + STRING_MULTIBYTE (elt)); } break; } @@ -25855,7 +25852,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, nwritten = display_string (spec, string, elt, charpos, 0, it, field, prec, 0, - multibyte, TRUE); + multibyte); /* Assign to the glyphs written above the string where the `%x' came from, position @@ -26062,7 +26059,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, break; case MODE_LINE_DISPLAY: n += display_string ("", Qnil, Qnil, 0, 0, it, field_width - n, - 0, 0, 0, TRUE); + 0, 0, 0); break; } } @@ -27132,8 +27129,7 @@ display_count_lines (ptrdiff_t start_byte, static int display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_string, ptrdiff_t face_string_pos, ptrdiff_t start, struct it *it, - int field_width, int precision, int max_x, int multibyte, - bool ignore_text_properties) + int field_width, int precision, int max_x, int multibyte) { int hpos_at_start = it->hpos; int saved_face_id = it->face_id; @@ -27145,7 +27141,7 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st reseat_to_string (it, NILP (lisp_string) ? string : NULL, lisp_string, start, precision, field_width, multibyte); - if (string && STRINGP (lisp_string) && ignore_text_properties) + if (string && STRINGP (lisp_string)) /* LISP_STRING is the one returned by decode_mode_spec. We should ignore its text properties. */ it->stop_charpos = it->end_charpos; commit 88c96962cfd56f213ef88b506b510a42d21a2fe6 Author: Lars Ingebrigtsen Date: Tue Dec 29 05:59:42 2020 +0100 Fix compact mode line text properties * src/xdisp.c (display_mode_line): Display the compact mode correctly (with text properties) (bug#45520). diff --git a/src/xdisp.c b/src/xdisp.c index f7b87dcce1..4c4d349ee5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -25473,30 +25473,43 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) && window_body_width (XWINDOW (selected_window), FALSE) >= SCHARS (mode_string)) { + /* The window is wide enough; just display the mode line we + just computed. */ display_string (SSDATA (mode_string), mode_string, Qnil, 0, 0, &it, 0, 0, 0, STRING_MULTIBYTE (mode_string), FALSE); } else { - char *string = xmalloc (SBYTES (mode_string) + 1), - *ostring = SSDATA (mode_string); - char *s = string, prev = 0; + /* Compress the mode line. */ + ptrdiff_t i = 0, i_byte = 0, start = 0; + int prev = 0; - /* Copy over the data from the mode line string, but ignore - repeating spaces. This should be safe even for multibyte - strings, since this is UTF-8. */ - for (int i = 0; i < SBYTES (mode_string); i++) + while (i < SCHARS (mode_string)) { - char c = ostring[i]; - if (!(c == ' ' && prev == ' ')) - prev = *s++ = c; + int c = fetch_string_char_advance (mode_string, &i, &i_byte); + if (c == ' ' && prev == ' ') + { + display_string (NULL, + Fsubstring (mode_string, make_fixnum (start), + make_fixnum (i - 1)), + Qnil, 0, 0, &it, 0, 0, 0, + STRING_MULTIBYTE (mode_string), FALSE); + /* Skip past the rest of the space characters. */ + while (c == ' ' && i < SCHARS (mode_string)) + c = fetch_string_char_advance (mode_string, &i, &i_byte); + start = i - 1; + } + prev = c; } - *s = 0; - display_string (string, Qnil, Qnil, 0, 0, &it, 0, 0, 0, - STRING_MULTIBYTE (mode_string), TRUE); - xfree (string); + /* Display the final bit. */ + if (start < i) + display_string (NULL, + Fsubstring (mode_string, make_fixnum (start), + make_fixnum (i - 1)), + Qnil, 0, 0, &it, 0, 0, 0, + STRING_MULTIBYTE (mode_string), FALSE); } } pop_kboard (); commit 03bab768bee56377677b5ff0e49c4cd03972a01a Author: Lars Ingebrigtsen Date: Tue Dec 29 05:16:25 2020 +0100 Add a parameter to display_string to allow not ignoring text props * src/xdisp.c (display_string): Add a parameter to allow not ignoring text properties (bug#45520). Adjust callers throughout xdisp.c. diff --git a/src/xdisp.c b/src/xdisp.c index 6606e49e42..f7b87dcce1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1114,7 +1114,8 @@ static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t, static void pint2str (register char *, register int, register ptrdiff_t); static int display_string (const char *, Lisp_Object, Lisp_Object, - ptrdiff_t, ptrdiff_t, struct it *, int, int, int, int); + ptrdiff_t, ptrdiff_t, struct it *, int, int, int, + int, bool); static void compute_line_metrics (struct it *); static void run_redisplay_end_trigger_hook (struct it *); static bool get_overlay_strings (struct it *, ptrdiff_t); @@ -13154,12 +13155,13 @@ display_tab_bar (struct window *w) if (it.current_x < it.last_visible_x) display_string (NULL, string, Qnil, 0, 0, &it, - SCHARS (string), 0, 0, STRING_MULTIBYTE (string)); + SCHARS (string), 0, 0, STRING_MULTIBYTE (string), + TRUE); } /* Fill out the line with spaces. */ if (it.current_x < it.last_visible_x) - display_string ("", Qnil, Qnil, 0, 0, &it, -1, 0, 0, -1); + display_string ("", Qnil, Qnil, 0, 0, &it, -1, 0, 0, -1, TRUE); /* Compute the total height of the lines. */ compute_line_metrics (&it); @@ -25136,12 +25138,13 @@ display_menu_bar (struct window *w) /* Display the item, pad with one space. */ if (it.current_x < it.last_visible_x) display_string (NULL, string, Qnil, 0, 0, &it, - SCHARS (string) + 1, 0, 0, STRING_MULTIBYTE (string)); + SCHARS (string) + 1, 0, 0, STRING_MULTIBYTE (string), + TRUE); } /* Fill out the line with spaces. */ if (it.current_x < it.last_visible_x) - display_string ("", Qnil, Qnil, 0, 0, &it, -1, 0, 0, -1); + display_string ("", Qnil, Qnil, 0, 0, &it, -1, 0, 0, -1, TRUE); /* Compute the total height of the lines. */ compute_line_metrics (&it); @@ -25245,21 +25248,22 @@ display_tty_menu_item (const char *item_text, int width, int face_id, it.paragraph_embedding = L2R; /* Pad with a space on the left. */ - display_string (" ", Qnil, Qnil, 0, 0, &it, 1, 0, FRAME_COLS (f) - 1, -1); + display_string (" ", Qnil, Qnil, 0, 0, &it, 1, 0, FRAME_COLS (f) - 1, -1, + TRUE); width--; /* Display the menu item, pad with spaces to WIDTH. */ if (submenu) { display_string (item_text, Qnil, Qnil, 0, 0, &it, - item_len, 0, FRAME_COLS (f) - 1, -1); + item_len, 0, FRAME_COLS (f) - 1, -1, TRUE); width -= item_len; /* Indicate with " >" that there's a submenu. */ display_string (" >", Qnil, Qnil, 0, 0, &it, width, 0, - FRAME_COLS (f) - 1, -1); + FRAME_COLS (f) - 1, -1, TRUE); } else display_string (item_text, Qnil, Qnil, 0, 0, &it, - width, 0, FRAME_COLS (f) - 1, -1); + width, 0, FRAME_COLS (f) - 1, -1, TRUE); row->used[TEXT_AREA] = max (saved_used, row->used[TEXT_AREA]); row->truncated_on_right_p = saved_truncated; @@ -25469,8 +25473,9 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) && window_body_width (XWINDOW (selected_window), FALSE) >= SCHARS (mode_string)) { - display_string (SSDATA (mode_string), Qnil, Qnil, 0, 0, &it, 0, 0, 0, - STRING_MULTIBYTE (mode_string)); + display_string (SSDATA (mode_string), mode_string, Qnil, + 0, 0, &it, 0, 0, 0, + STRING_MULTIBYTE (mode_string), FALSE); } else { @@ -25490,7 +25495,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) *s = 0; display_string (string, Qnil, Qnil, 0, 0, &it, 0, 0, 0, - STRING_MULTIBYTE (mode_string)); + STRING_MULTIBYTE (mode_string), TRUE); xfree (string); } } @@ -25499,7 +25504,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) unbind_to (count, Qnil); /* Fill up with spaces. */ - display_string (" ", Qnil, Qnil, 0, 0, &it, 10000, -1, -1, 0); + display_string (" ", Qnil, Qnil, 0, 0, &it, 10000, -1, -1, 0, TRUE); compute_line_metrics (&it); it.glyph_row->full_width_p = true; @@ -25703,7 +25708,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, break; case MODE_LINE_DISPLAY: n += display_string (NULL, elt, Qnil, 0, 0, it, - 0, prec, 0, STRING_MULTIBYTE (elt)); + 0, prec, 0, STRING_MULTIBYTE (elt), TRUE); break; } @@ -25765,7 +25770,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, nchars = string_byte_to_char (elt, offset) - charpos; n += display_string (NULL, elt, Qnil, 0, charpos, it, 0, nchars, 0, - STRING_MULTIBYTE (elt)); + STRING_MULTIBYTE (elt), TRUE); } break; } @@ -25837,7 +25842,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, nwritten = display_string (spec, string, elt, charpos, 0, it, field, prec, 0, - multibyte); + multibyte, TRUE); /* Assign to the glyphs written above the string where the `%x' came from, position @@ -26044,7 +26049,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, break; case MODE_LINE_DISPLAY: n += display_string ("", Qnil, Qnil, 0, 0, it, field_width - n, - 0, 0, 0); + 0, 0, 0, TRUE); break; } } @@ -27114,7 +27119,8 @@ display_count_lines (ptrdiff_t start_byte, static int display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_string, ptrdiff_t face_string_pos, ptrdiff_t start, struct it *it, - int field_width, int precision, int max_x, int multibyte) + int field_width, int precision, int max_x, int multibyte, + bool ignore_text_properties) { int hpos_at_start = it->hpos; int saved_face_id = it->face_id; @@ -27125,7 +27131,8 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st with index START. */ reseat_to_string (it, NILP (lisp_string) ? string : NULL, lisp_string, start, precision, field_width, multibyte); - if (string && STRINGP (lisp_string)) + + if (string && STRINGP (lisp_string) && ignore_text_properties) /* LISP_STRING is the one returned by decode_mode_spec. We should ignore its text properties. */ it->stop_charpos = it->end_charpos; commit a66f0d3bd3486b7253f482b7169b0de2d0d49c79 Author: Lars Ingebrigtsen Date: Tue Dec 29 04:53:03 2020 +0100 Introduce new variable mode-line-compact * doc/lispref/modes.texi (Mode Line Basics): Document it (bug#34476). * src/xdisp.c (display_mode_line): Use it. (syms_of_xdisp): New variable mode-line-compact. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 675aeec8a5..40edc90a6a 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1930,6 +1930,15 @@ This function also forces an update of the menu bar and frame title. color using the face @code{mode-line}. Other windows' mode lines appear in the face @code{mode-line-inactive} instead. @xref{Faces}. +@vindex mode-line-compact + Some modes put a lot of data in the mode line, pushing elements at +the end of the mode line off to the right. Emacs can ``compress'' the +mode line if the @code{mode-line-compact} variable is non-@code{nil} +by turning stretches of spaces into a single space. If this variable +is @code{long}, this is only done when the mode line is wider than the +currently selected window. This variable can be buffer-local to only +compress mode-lines in certain buffers. + @node Mode Line Data @subsection The Data Structure of the Mode Line @cindex mode line construct diff --git a/etc/NEWS b/etc/NEWS index 6348c1d8ee..a5247a9aea 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1614,6 +1614,12 @@ the column number format (when 'column-number-mode' is on), and 'mode-line-position-column-line-format' is the combined format (when both modes are on). ++++ +*** New user option 'mode-line-compact'. +If non-nil, repeating spaces are compressed into a single space. If +'long', this is only done when the mode line is longer than the +current window width (in characters). + +++ *** New command 'submit-emacs-patch'. This works like 'report-emacs-bug', but is more geared towards sending diff --git a/src/xdisp.c b/src/xdisp.c index b5adee5105..6606e49e42 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -25451,14 +25451,49 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) format_mode_line_unwind_data (NULL, NULL, Qnil, false)); - mode_line_target = MODE_LINE_DISPLAY; - /* Temporarily make frame's keyboard the current kboard so that kboard-local variables in the mode_line_format will get the right values. */ push_kboard (FRAME_KBOARD (it.f)); record_unwind_save_match_data (); - display_mode_element (&it, 0, 0, 0, format, Qnil, false); + + if (NILP (Vmode_line_compact)) + { + mode_line_target = MODE_LINE_DISPLAY; + display_mode_element (&it, 0, 0, 0, format, Qnil, false); + } + else + { + Lisp_Object mode_string = Fformat_mode_line (format, Qnil, Qnil, Qnil); + if (EQ (Vmode_line_compact, Qlong) + && window_body_width (XWINDOW (selected_window), FALSE) >= + SCHARS (mode_string)) + { + display_string (SSDATA (mode_string), Qnil, Qnil, 0, 0, &it, 0, 0, 0, + STRING_MULTIBYTE (mode_string)); + } + else + { + char *string = xmalloc (SBYTES (mode_string) + 1), + *ostring = SSDATA (mode_string); + char *s = string, prev = 0; + + /* Copy over the data from the mode line string, but ignore + repeating spaces. This should be safe even for multibyte + strings, since this is UTF-8. */ + for (int i = 0; i < SBYTES (mode_string); i++) + { + char c = ostring[i]; + if (!(c == ' ' && prev == ' ')) + prev = *s++ = c; + } + *s = 0; + + display_string (string, Qnil, Qnil, 0, 0, &it, 0, 0, 0, + STRING_MULTIBYTE (mode_string)); + xfree (string); + } + } pop_kboard (); unbind_to (count, Qnil); @@ -34805,6 +34840,14 @@ wide as that tab on the display. */); The face used for trailing whitespace is `trailing-whitespace'. */); Vshow_trailing_whitespace = Qnil; + DEFVAR_LISP ("mode-line-compact", Vmode_line_compact, + doc: /* Non-nil means that mode lines should be compact. +This means that repeating spaces will be replaced with a single space. +If this variable is `long', only mode lines that are wider than the +currently selected window are compressed. */); + Vmode_line_compact = Qnil; + DEFSYM (Qlong, "long"); + DEFVAR_LISP ("nobreak-char-display", Vnobreak_char_display, doc: /* Control highlighting of non-ASCII space and hyphen chars. If the value is t, Emacs highlights non-ASCII chars which have the commit 37049ee78c4576d340781179317e6cbaaf73b6c3 Author: Lars Ingebrigtsen Date: Tue Dec 29 03:10:00 2020 +0100 Allow the flymake mode line indicator to be customized * doc/misc/flymake.texi (Customizable variables): Mention it. * lisp/progmodes/flymake.el (flymake-mode-line-indicator-format): New variable (bug#33740). (flymake--mode-line-format): Use it. diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 8f2954bdf4..b8744f0323 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -213,6 +213,9 @@ This section summarizes customization variables used for the configuration of the Flymake user interface. @vtable @code +@item flymake-mode-line-indicator-format +Format to use for the Flymake mode line indicator. + @item flymake-no-changes-timeout If any changes are made to the buffer, syntax check is automatically started after this many seconds, unless the user makes another change, diff --git a/etc/NEWS b/etc/NEWS index cd4006170d..6348c1d8ee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1732,6 +1732,11 @@ height of lines or width of chars. When non-nil, use a new xwidget webkit session after bookmark jump. Otherwise, it will use 'xwidget-webkit-last-session'. +** Flymake mode + ++++ +*** New user option 'flymake-mode-line-indicator-format'. + ** Flyspell mode +++ diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 40bb90d0f1..e78d5d32ff 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1190,6 +1190,16 @@ default) no filter is applied." (put 'flymake--mode-line-format 'risky-local-variable t) +(defcustom flymake-mode-line-indicator-format " Flymake%s[%e %w %n]" + "Format to use for the Flymake mode line indicator. +The following format characters can be used: + +%s: The status. +%e: The number of errors. +%w: The number of warnings. +%n: The number of notes." + :version "28.1" + :type 'string) (defun flymake--mode-line-format () "Produce a pretty minor mode indicator." @@ -1207,102 +1217,97 @@ default) no filter is applied." diags-by-type))) (flymake--backend-state-diags state))) flymake--backend-state) - `((:propertize " Flymake" - mouse-face mode-line-highlight - help-echo - ,(concat (format "%s known backends\n" (length known)) - (format "%s running\n" (length running)) - (format "%s disabled\n" (length disabled)) - "mouse-1: Display minor mode menu\n" - "mouse-2: Show help for minor mode") - keymap - ,(let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] - flymake-menu) - (define-key map [mode-line mouse-2] - (lambda () - (interactive) - (describe-function 'flymake-mode))) - map)) - ,@(pcase-let ((`(,ind ,face ,explain) - (cond ((null known) - '("?" nil "No known backends")) - (some-waiting - `("Wait" compilation-mode-line-run - ,(format "Waiting for %s running backend(s)" - (length some-waiting)))) - (all-disabled - '("!" compilation-mode-line-run - "All backends disabled")) - (t - '(nil nil nil))))) - (when ind - `((":" - (:propertize ,ind - face ,face - help-echo ,explain - keymap - ,(let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] - 'flymake-switch-to-log-buffer) - map)))))) - ,@(unless (or all-disabled - (null known)) - (cl-loop - with types = (hash-table-keys diags-by-type) - with _augmented = (cl-loop for extra in '(:error :warning) - do (cl-pushnew extra types - :key #'flymake--severity)) - for type in (cl-sort types #'> :key #'flymake--severity) - for diags = (gethash type diags-by-type) - for face = (flymake--lookup-type-property type - 'mode-line-face - 'compilation-error) - when (or diags - (cond ((eq flymake-suppress-zero-counters t) - nil) - (flymake-suppress-zero-counters - (>= (flymake--severity type) - (warning-numeric-level - flymake-suppress-zero-counters))) - (t t))) - collect `(:propertize - ,(format "%d" (length diags)) - face ,face - mouse-face mode-line-highlight - keymap - ,(let ((map (make-sparse-keymap)) - (type type)) - (define-key map (vector 'mode-line - mouse-wheel-down-event) - (lambda (event) - (interactive "e") - (with-selected-window (posn-window (event-start event)) - (flymake-goto-prev-error 1 (list type) t)))) - (define-key map (vector 'mode-line - mouse-wheel-up-event) - (lambda (event) - (interactive "e") - (with-selected-window (posn-window (event-start event)) - (flymake-goto-next-error 1 (list type) t)))) - map) - help-echo - ,(concat (format "%s diagnostics of type %s\n" - (propertize (format "%d" - (length diags)) - 'face face) - (propertize (format "%s" type) - 'face face)) - (format "%s/%s: previous/next of this type" - mouse-wheel-down-event - mouse-wheel-up-event))) - into forms - finally return - `((:propertize "[") - ,@(cl-loop for (a . rest) on forms by #'cdr - collect a when rest collect - '(:propertize " ")) - (:propertize "]"))))))) + (format-spec + (propertize + flymake-mode-line-indicator-format + 'mouse-face 'mode-line-highlight + 'help-echo (concat (format "%s known backends\n" (length known)) + (format "%s running\n" (length running)) + (format "%s disabled\n" (length disabled)) + "mouse-1: Display minor mode menu\n" + "mouse-2: Show help for minor mode") + 'keymap (let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] + flymake-menu) + (define-key map [mode-line mouse-2] + (lambda () + (interactive) + (describe-function 'flymake-mode))) + map)) + (cons + (cons + ?s (pcase-let ((`(,ind ,face ,explain) + (cond ((null known) + '("?" nil "No known backends")) + (some-waiting + `("Wait" compilation-mode-line-run + ,(format "Waiting for %s running backend(s)" + (length some-waiting)))) + (all-disabled + '("!" compilation-mode-line-run + "All backends disabled")) + (t + '(nil nil nil))))) + (if (not ind) + "" + (concat + ":" (propertize ind + 'face face + 'help-echo explain + 'keymap (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + 'flymake-switch-to-log-buffer) + map)))))) + (cl-loop + with types = (hash-table-keys diags-by-type) + with _augmented = (cl-loop for extra in '(:error :warning) + do (cl-pushnew extra types + :key #'flymake--severity)) + for type in (cl-sort types #'> :key #'flymake--severity) + for diags = (gethash type diags-by-type) + for face = (flymake--lookup-type-property + type 'mode-line-face 'compilation-error) + when (or diags + (cond ((eq flymake-suppress-zero-counters t) + nil) + (flymake-suppress-zero-counters + (>= (flymake--severity type) + (warning-numeric-level + flymake-suppress-zero-counters))) + (t t))) + collect (cons + (elt (format "%s" type) 1) + (propertize + (format "%d" (length diags)) + 'face face + 'mouse-face 'mode-line-highlight + 'keymap + (let ((map (make-sparse-keymap)) + (type type)) + (define-key map (vector 'mode-line + mouse-wheel-down-event) + (lambda (event) + (interactive "e") + (with-selected-window (posn-window (event-start event)) + (flymake-goto-prev-error 1 (list type) t)))) + (define-key map (vector 'mode-line + mouse-wheel-up-event) + (lambda (event) + (interactive "e") + (with-selected-window (posn-window (event-start event)) + (flymake-goto-next-error 1 (list type) t)))) + map) + 'help-echo + (concat (format "%s diagnostics of type %s\n" + (propertize (format "%d" + (length diags)) + 'face face) + (propertize (format "%s" type) + 'face face)) + (format "%s/%s: previous/next of this type" + mouse-wheel-down-event + mouse-wheel-up-event)))))) + nil t))) ;;; Diagnostics buffer commit 40d16332597d3aa564c9950ae1831faf6867c71a Author: Lars Ingebrigtsen Date: Tue Dec 29 03:04:51 2020 +0100 Add a SPLIT parameter to `format-spec' * doc/lispref/strings.texi (Custom Format Strings): Document it. * lisp/format-spec.el (format-spec): Add an optional parameter to return a list of strings (bug#33740). diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index a31e71d526..4ac5057454 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -1216,7 +1216,7 @@ The function @code{format-spec} described in this section performs a similar function to @code{format}, except it operates on format control strings that use arbitrary specification characters. -@defun format-spec template spec-alist &optional ignore-missing +@defun format-spec template spec-alist &optional ignore-missing split This function returns a string produced from the format string @var{template} according to conversions specified in @var{spec-alist}, which is an alist (@pxref{Association Lists}) of the form @@ -1258,6 +1258,16 @@ any; if it is @code{delete}, those format specifications are removed from the output; any other non-@code{nil} value is handled like @code{ignore}, but any occurrences of @samp{%%} are also left verbatim in the output. + +If the optional argument @var{split} is non-@code{nil}, instead of +returning a single string, @code{format-spec} will split the result +into a list of strings, based on where the substitutions were +performed. For instance: + +@example +(format-spec "foo %b bar" '((?b . "zot")) nil t) + @result{} ("foo " "zot" " bar") +@end example @end defun The syntax of format specifications accepted by @code{format-spec} is diff --git a/etc/NEWS b/etc/NEWS index f8282696e4..cd4006170d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2179,6 +2179,11 @@ In order for the two functions to behave more consistently, length, and also supports format specifications that include a truncating precision field, such as "%.2a". ++++ +** 'format-spec' now takes an optional SPLIT parameter. +If non-nil, 'format-spec' will split the resulting string into a list +of strings, based on where the format specs (and expansions) were. + --- ** New function 'color-values-from-color-spec'. This can be used to parse RGB color specs in several formats and diff --git a/lisp/format-spec.el b/lisp/format-spec.el index 6af79a4416..3abcd5183a 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -25,7 +25,7 @@ ;;; Code: ;;;###autoload -(defun format-spec (format specification &optional ignore-missing) +(defun format-spec (format specification &optional ignore-missing split) "Return a string based on FORMAT and SPECIFICATION. FORMAT is a string containing `format'-like specs like \"su - %u %k\". SPECIFICATION is an alist mapping format specification characters @@ -68,50 +68,65 @@ error; if it is the symbol `ignore', leave those %-specs verbatim in the result, including their text properties, if any; if it is the symbol `delete', remove those %-specs from the result; otherwise do the same as for the symbol `ignore', but also leave -any occurrences of \"%%\" in FORMAT verbatim in the result." +any occurrences of \"%%\" in FORMAT verbatim in the result. + +If SPLIT, instead of returning a single string, a list of strings +is returned, where each format spec is its own element." (with-temp-buffer - (insert format) - (goto-char (point-min)) - (while (search-forward "%" nil t) - (cond - ;; Quoted percent sign. - ((= (following-char) ?%) - (when (memq ignore-missing '(nil ignore delete)) - (delete-char 1))) - ;; Valid format spec. - ((looking-at (rx (? (group (+ (in " 0<>^_-")))) - (? (group (+ digit))) - (? (group ?. (+ digit))) - (group alpha))) - (let* ((beg (point)) - (end (match-end 0)) - (flags (match-string 1)) - (width (match-string 2)) - (trunc (match-string 3)) - (char (string-to-char (match-string 4))) - (text (assq char specification))) - (cond (text - ;; Handle flags. - (setq text (format-spec--do-flags - (format "%s" (cdr text)) - (format-spec--parse-flags flags) - (and width (string-to-number width)) - (and trunc (car (read-from-string trunc 1))))) - ;; Insert first, to preserve text properties. - (insert-and-inherit text) - ;; Delete the specifier body. - (delete-region (point) (+ end (length text))) - ;; Delete the percent sign. - (delete-region (1- beg) beg)) - ((eq ignore-missing 'delete) - ;; Delete the whole format spec. - (delete-region (1- beg) end)) - ((not ignore-missing) - (error "Invalid format character: `%%%c'" char))))) - ;; Signal an error on bogus format strings. - ((not ignore-missing) - (error "Invalid format string")))) - (buffer-string))) + (let ((split-start (point-min)) + (split-result nil)) + (insert format) + (goto-char (point-min)) + (while (search-forward "%" nil t) + (cond + ;; Quoted percent sign. + ((= (following-char) ?%) + (when (memq ignore-missing '(nil ignore delete)) + (delete-char 1))) + ;; Valid format spec. + ((looking-at (rx (? (group (+ (in " 0<>^_-")))) + (? (group (+ digit))) + (? (group ?. (+ digit))) + (group alpha))) + (let* ((beg (point)) + (end (match-end 0)) + (flags (match-string 1)) + (width (match-string 2)) + (trunc (match-string 3)) + (char (string-to-char (match-string 4))) + (text (assq char specification))) + (when (and split + (not (= (1- beg) split-start))) + (push (buffer-substring split-start (1- beg)) split-result)) + (cond (text + ;; Handle flags. + (setq text (format-spec--do-flags + (format "%s" (cdr text)) + (format-spec--parse-flags flags) + (and width (string-to-number width)) + (and trunc (car (read-from-string trunc 1))))) + ;; Insert first, to preserve text properties. + (insert-and-inherit text) + ;; Delete the specifier body. + (delete-region (point) (+ end (length text))) + ;; Delete the percent sign. + (delete-region (1- beg) beg)) + ((eq ignore-missing 'delete) + ;; Delete the whole format spec. + (delete-region (1- beg) end)) + ((not ignore-missing) + (error "Invalid format character: `%%%c'" char))) + (when split + (push (buffer-substring (1- beg) (point)) split-result) + (setq split-start (point))))) + ;; Signal an error on bogus format strings. + ((not ignore-missing) + (error "Invalid format string")))) + (if (not split) + (buffer-string) + (unless (= split-start (point-max)) + (push (buffer-substring split-start (point-max)) split-result)) + (nreverse split-result))))) (defun format-spec--do-flags (str flags width trunc) "Return STR formatted according to FLAGS, WIDTH, and TRUNC. diff --git a/test/lisp/format-spec-tests.el b/test/lisp/format-spec-tests.el index 11882217af..cced862333 100644 --- a/test/lisp/format-spec-tests.el +++ b/test/lisp/format-spec-tests.el @@ -178,4 +178,14 @@ (should (equal (format-spec "foo %>4b zot" '((?b . "longbar"))) "foo long zot"))) +(ert-deftest format-spec-split () + (should (equal (format-spec "foo %b bar" '((?b . "zot")) nil t) + '("foo " "zot" " bar"))) + (should (equal (format-spec "%b bar" '((?b . "zot")) nil t) + '("zot" " bar"))) + (should (equal (format-spec "%b" '((?b . "zot")) nil t) + '("zot"))) + (should (equal (format-spec "foo %b" '((?b . "zot")) nil t) + '("foo " "zot")))) + ;;; format-spec-tests.el ends here commit 3334dd904157e7b3787f5d32f30b3c31585d047c Author: Basil L. Contovounesios Date: Tue Dec 29 01:19:07 2020 +0000 Reword a long docstring in cc-langs.el * lisp/progmodes/cc-langs.el (c-vsemi-status-unknown-p-fn): Reword docstring to fit within 80 columns and silence the corresponding byte-compiler warning (bug#44858). diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 9b13cedc98..b10a085552 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -581,12 +581,14 @@ don't have EOL terminated statements. " (c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn)) (c-lang-defconst c-vsemi-status-unknown-p-fn - "Contains a function \"are we unsure whether there is a virtual semicolon on this line?\". -The (admittedly kludgy) purpose of such a function is to prevent an infinite -recursion in c-beginning-of-statement-1 when point starts at a `while' token. -The function MUST NOT UNDER ANY CIRCUMSTANCES call c-beginning-of-statement-1, -even indirectly. This variable contains nil for languages which don't have -EOL terminated statements." + "Contains a predicate regarding the presence of virtual semicolons. +More precisely, the function answers the question, \"are we unsure whether a +virtual semicolon exists on this line?\". The (admittedly kludgy) purpose of +such a function is to prevent an infinite recursion in +`c-beginning-of-statement-1' when point starts at a `while' token. The function +MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', even +indirectly. This variable contains nil for languages which don't have EOL +terminated statements." t nil (c c++ objc) 'c-macro-vsemi-status-unknown-p awk 'c-awk-vsemi-status-unknown-p) commit b9359d4183a1a6923122d3aa12b922ab89693354 Author: Lars Ingebrigtsen Date: Tue Dec 29 02:19:03 2020 +0100 Add a reference between the Strings node and Search/Replace * doc/lispref/strings.texi (Creating Strings): Mention string-replace/replace-regexp-in-string (bug#45516). diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 1e5f52ddfd..a31e71d526 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -120,7 +120,10 @@ character (i.e., an integer), @code{nil} otherwise. @cindex string creation The following functions create strings, either from scratch, or by -putting strings together, or by taking them apart. +putting strings together, or by taking them apart. (For functions that +create strings based on searching the contents of other strings (like +@code{string-replace} and @code{replace-regexp-in-string}), see +@ref{Search and Replace}.) @defun make-string count character &optional multibyte This function returns a string made up of @var{count} repetitions of commit 92406b02c6b1ff25102e49f78b0f46a9b143e21b Author: Lars Ingebrigtsen Date: Tue Dec 29 02:01:57 2020 +0100 Allow mixing attributes and comments in the diary file * lisp/calendar/diary-lib.el (diary-face-attrs): The attributes don't have to be at the end of the line -- there may be ##warntime or other comments (bug#19965). diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index bf1e8ebf9d..c41f19dd0f 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -73,18 +73,18 @@ are holidays." ;; follows: the first line matching "^# [tag:value]" defines the value ;; for that particular tag. (defcustom diary-face-attrs - '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string) - (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string) - (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol) - (" *\\[height:\\([.0-9]+\\)\\]$" 1 :height int) - (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol) - (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol) - (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil) - (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil) - (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil) - (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil) - (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string) - (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string) + '((" *\\[foreground:\\([-a-z]+\\)\\] *" 1 :foreground string) + (" *\\[background:\\([-a-z]+\\)\\] *" 1 :background string) + (" *\\[width:\\([-a-z]+\\)\\] *" 1 :width symbol) + (" *\\[height:\\([.0-9]+\\)\\] *" 1 :height int) + (" *\\[weight:\\([-a-z]+\\)\\] *" 1 :weight symbol) + (" *\\[slant:\\([-a-z]+\\)\\] *" 1 :slant symbol) + (" *\\[underline:\\([-a-z]+\\)\\] *" 1 :underline stringtnil) + (" *\\[overline:\\([-a-z]+\\)\\] *" 1 :overline stringtnil) + (" *\\[strike-through:\\([-a-z]+\\)\\] *" 1 :strike-through stringtnil) + (" *\\[inverse-video:\\([-a-z]+\\)\\] *" 1 :inverse-video tnil) + (" *\\[face:\\([-0-9a-z]+\\)\\] *" 1 :face string) + (" *\\[font:\\([-a-z0-9]+\\)\\] *" 1 :font string) ;; Unsupported. ;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box) ;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple) commit d199a4640f53673a3bba79ab82cf819009e65e8f Author: João Távora Date: Mon Dec 28 09:20:17 2020 +0000 Robustify completion match scoring for optimized patterns Fixes: bug#42149 The function completion-pcm--hilit-commonality, which propertizes and scores a previously confirmed match, expected its PATTERN argument to match the strings of COMPLETIONS entirely (i.e. up to the string's very end). But sometimes the ending wildcard, represented by the 'any' atom in PATTERN, is optimized away by completion-pcm--optimize-pattern. Although this is mostly benign in terms of highlighting commonality, it leads to incorrect score values. In this change, we ensure that completion-pcm--hilit-commonality is aware of this exception and isn't affected by it. We also document the function a bit better and simplify its workings. Originally reported by Dario Gjorgjevski * lisp/minibuffer.el (completion-pcm--hilit-commonality): Simplify. Add docstring. * lisp/minibuffer.el (completion-pcm--hilit-commonality): Add docstring diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index c8c106c336..dc37c5f447 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3245,6 +3245,13 @@ than the latter (which has two \"holes\" and three one-letter-long matches).") (defun completion-pcm--hilit-commonality (pattern completions) + "Show where and how well PATTERN matches COMPLETIONS. +PATTERN, a list of symbols and strings as seen +`completion-pcm--merge-completions', is assumed to match every +string in COMPLETIONS. Return a deep copy of COMPLETIONS where +each string is propertized with `completion-score', a number +between 0 and 1, and with faces `completions-common-part', +`completions-first-difference' in the relevant segments." (when completions (let* ((re (completion-pcm--pattern->regex pattern 'group)) (point-idx (completion-pcm--pattern-point-idx pattern)) @@ -3256,12 +3263,12 @@ one-letter-long matches).") (unless (string-match re str) (error "Internal error: %s does not match %s" re str)) (let* ((pos (if point-idx (match-beginning point-idx) (match-end 0))) - (md (match-data)) - (start (pop md)) - (end (pop md)) - (len (length str)) - ;; To understand how this works, consider these bad - ;; ascii(tm) diagrams showing how the pattern "foo" + (match-end (match-end 0)) + (md (cddr (match-data))) + (from 0) + (end (length str)) + ;; To understand how this works, consider these simple + ;; ascii diagrams showing how the pattern "foo" ;; flex-matches "fabrobazo", "fbarbazoo" and ;; "barfoobaz": @@ -3297,9 +3304,12 @@ one-letter-long matches).") (score-numerator 0) (score-denominator 0) (last-b 0) - (update-score + (update-score-and-face (lambda (a b) - "Update score variables given match range (A B)." + "Update score and face given match range (A B)." + (add-face-text-property a b + 'completions-common-part + nil str) (setq score-numerator (+ score-numerator (- b a))) (unless (or (= a last-b) @@ -3313,19 +3323,15 @@ one-letter-long matches).") flex-score-match-tightness))))) (setq last-b b)))) - (funcall update-score start start) (while md - (funcall update-score start (car md)) - (add-face-text-property - start (pop md) - 'completions-common-part - nil str) - (setq start (pop md))) - (funcall update-score len len) - (add-face-text-property - start end - 'completions-common-part - nil str) + (funcall update-score-and-face from (pop md)) + (setq from (pop md))) + ;; If `pattern' doesn't have an explicit trailing any, the + ;; regex `re' won't produce match data representing the + ;; region after the match. We need to account to account + ;; for that extra bit of match (bug#42149). + (unless (= from match-end) + (funcall update-score-and-face from match-end)) (if (> (length str) pos) (add-face-text-property pos (1+ pos) @@ -3334,7 +3340,7 @@ one-letter-long matches).") (unless (zerop (length str)) (put-text-property 0 1 'completion-score - (/ score-numerator (* len (1+ score-denominator)) 1.0) str))) + (/ score-numerator (* end (1+ score-denominator)) 1.0) str))) str) completions)))) commit d180a41dbb8e4e8d94d30a023c2d86d92c73c4f1 Author: Alan Mackenzie Date: Mon Dec 28 20:42:25 2020 +0000 CC Mode: Add newish AWK Mode facilities, as used in gawk-4. * lisp/progmodes/cc-awk.el (c-awk-font-lock-invalid-namespace-separators): New function. (c-awk-context-expand-fl-region): New function. (awk-font-lock-keywords): Enhance handling of function declarations to include :: tokens. Fontify new system variable names FPAT, FUNCTAB, PREC, ROUNDMODE, SYNTAB. Fontify new keywords BEGINFILE and ENDFILE. Fontify new system functions asorti, dcngettext, isarray, patsplit, typeof. Fontify the new directives @include, @load, @namespace. Call c-awk-font-lock-invalid-namespace-separators as a matcher. * lisp/progmodes/cc-fonts.el (top level): No longer require 'cc-awk. * lisp/progmodes/cc-langs.el (c-before-context-fontification-functions): Give AWK the value c-awk-context-expand-fl-region rather than nil. * lisp/progmodes/cc-mode.el (top level): Declare awk-mode-syntax-table as a variable. diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 52e6da6f4a..841c3a4bb6 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -49,9 +49,11 @@ (load "cc-bytecomp" nil t))) (cc-require 'cc-defs) +(cc-require-when-compile 'cc-langs) +(cc-require-when-compile 'cc-fonts) +(cc-require 'cc-engine) ;; Silence the byte compiler. -(cc-bytecomp-defvar font-lock-mode) ; Checked with boundp before use. (cc-bytecomp-defvar c-new-BEG) (cc-bytecomp-defvar c-new-END) @@ -649,6 +651,46 @@ ;; several lines back. The elisp "advice" feature is used on these functions ;; to allow this. +(defun c-awk-font-lock-invalid-namespace-separators (limit) + ;; This function will be called from font-lock for a region bounded by POINT + ;; and LIMIT, as though it were to identify a keyword for + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; Fontification". + ;; + ;; This function gives invalid GAWK namepace separators (::) + ;; font-lock-warning-face. "Invalid" here means there are spaces, etc., + ;; around a separator, or there are more than one of them in an identifier. + ;; Invalid separators inside function declaration parentheses are handled + ;; elsewhere. + (while (and + (< (point) limit) + (c-syntactic-re-search-forward + (eval-when-compile + (concat "\\([^" (c-lang-const c-symbol-chars awk) "]::\\)" + "\\|" + ;; "\\(::[^" (c-lang-const c-symbol-start awk) "]\\)" + "\\(::[^" c-alpha "_" "]\\)" + "\\|" + "\\(::[" (c-lang-const c-symbol-chars awk) "]*::\\)")) + limit 'bound)) + (cond + ((match-beginning 1) ; " ::" + (c-put-font-lock-face (1+ (match-beginning 1)) (match-end 1) + 'font-lock-warning-face) + (goto-char (- (match-end 1) 2))) + ((match-beginning 2) ; ":: " + (c-put-font-lock-face (match-beginning 2) (1- (match-end 2)) + 'font-lock-warning-face) + (goto-char (1- (match-end 2)))) + (t ; "::foo::" + (c-put-font-lock-face (match-beginning 3) (+ 2 (match-beginning 3)) + 'font-lock-warning-face) + (c-put-font-lock-face (- (match-end 3) 2) (match-end 3) + 'font-lock-warning-face) + (goto-char (- (match-end 3) 2))))) + nil) + (defun c-awk-beginning-of-logical-line (&optional pos) ;; Go back to the start of the (apparent) current line (or the start of the ;; line containing POS), returning the buffer position of that point. I.e., @@ -900,6 +942,13 @@ (goto-char c-new-BEG) (c-awk-set-syntax-table-properties c-new-END))) +(defun c-awk-context-expand-fl-region (beg end) + ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of the + ;; logical line BEG is on, and NEW-END is the beginning of the line after + ;; the end of the logical line that END is on. + (cons (save-excursion (c-awk-beginning-of-logical-line beg)) + (c-awk-beyond-logical-line end))) + ;; Awk regexps written with help from Peter Galbraith ;; . ;; Take GNU Emacs's 'words out of the following regexp-opts. They don't work @@ -907,18 +956,34 @@ (defconst awk-font-lock-keywords (eval-when-compile (list - ;; Function names. - '("^\\s *\\(func\\(tion\\)?\\)\\>\\s *\\(\\sw+\\)?" - (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) - ;; + ;; Function declarations. + `(,(c-make-font-lock-search-function + "^\\s *\\(func\\(tion\\)?\\)\\s +\\(\\(\\sw+\\(::\\sw+\\)?\\)\\s *\\)?\\(([^()]*)\\)?" + '(1 font-lock-keyword-face t) + ;; We can't use LAXMATCH in `c-make-font-lock-search-function', so.... + '((when (match-beginning 4) + (c-put-font-lock-face + (match-beginning 4) (match-end 4) font-lock-function-name-face) + nil)) + ;; Put warning face on any use of :: inside the parens. + '((when (match-beginning 6) + (goto-char (1+ (match-beginning 6))) + (let ((end (1- (match-end 6)))) + (while (and (< (point) end) + (c-syntactic-re-search-forward "::" end t)) + (c-put-font-lock-face (- (point) 2) (point) + 'font-lock-warning-face))) + nil)))) + ;; Variable names. (cons (concat "\\<" (regexp-opt '("ARGC" "ARGIND" "ARGV" "BINMODE" "CONVFMT" "ENVIRON" - "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR" "FS" "IGNORECASE" - "LINT" "NF" "NR" "OFMT" "OFS" "ORS" "PROCINFO" "RLENGTH" - "RS" "RSTART" "RT" "SUBSEP" "TEXTDOMAIN") t) "\\>") + "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR" "FPAT" "FS" "FUNCTAB" + "IGNORECASE" "LINT" "NF" "NR" "OFMT" "OFS" "ORS" "PREC" + "PROCINFO" "RLENGTH" "ROUNDMODE" "RS" "RSTART" "RT" "SUBSEP" + "SYNTAB" "TEXTDOMAIN") t) "\\>") 'font-lock-variable-name-face) ;; Special file names. (acm, 2002/7/22) @@ -949,7 +1014,8 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\ ;; Keywords. (concat "\\<" (regexp-opt - '("BEGIN" "END" "break" "case" "continue" "default" "delete" + '("BEGIN" "BEGINFILE" "END" "ENDFILE" + "break" "case" "continue" "default" "delete" "do" "else" "exit" "for" "getline" "if" "in" "next" "nextfile" "return" "switch" "while") t) "\\>") @@ -959,16 +1025,20 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\ ,(concat "\\<" (regexp-opt - '("adump" "and" "asort" "atan2" "bindtextdomain" "close" - "compl" "cos" "dcgettext" "exp" "extension" "fflush" - "gensub" "gsub" "index" "int" "length" "log" "lshift" - "match" "mktime" "or" "print" "printf" "rand" "rshift" + '("adump" "and" "asort" "asorti" "atan2" "bindtextdomain" "close" + "compl" "cos" "dcgettext" "dcngettext" "exp" "extension" "fflush" + "gensub" "gsub" "index" "int" "isarray" "length" "log" "lshift" + "match" "mktime" "or" "patsplit" "print" "printf" "rand" "rshift" "sin" "split" "sprintf" "sqrt" "srand" "stopme" "strftime" "strtonum" "sub" "substr" "system" - "systime" "tolower" "toupper" "xor") t) + "systime" "tolower" "toupper" "typeof" "xor") + t) "\\>") 0 c-preprocessor-face-name)) + ;; Directives + '("@\\(include\\|load\\|namespace\\)\\>" 0 c-preprocessor-face-name) + ;; gawk debugging keywords. (acm, 2002/7/21) ;; (Removed, 2003/6/6. These functions are now fontified as built-ins) ;; (list (concat "\\<" (regexp-opt '("adump" "stopme") t) "\\>") @@ -980,6 +1050,9 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\ c-awk-escaped-nls*-with-space* "(") (0 'font-lock-warning-face)) + ;; Double :: tokens, or the same with space(s) around them. + #'c-awk-font-lock-invalid-namespace-separators + ;; Space after \ in what looks like an escaped newline. 2002/5/31 '("\\\\\\s +$" 0 font-lock-warning-face t) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index e403c49e39..94e087f38e 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -76,9 +76,6 @@ (cc-require-when-compile 'cc-langs) (cc-require 'cc-vars) (cc-require 'cc-engine) -(cc-require-when-compile 'cc-awk) ; Change from cc-require, 2003/6/18 to -;; prevent cc-awk being loaded when it's not needed. There is now a (require -;; 'cc-awk) in (defun awk-mode ..). ;; Avoid repeated loading through the eval-after-load directive in ;; cc-mode.el. diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 4d1aeaa5cb..9b13cedc98 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -549,7 +549,7 @@ parameters (point-min), (point-max) and .") (c-lang-defconst c-before-context-fontification-functions t 'c-context-expand-fl-region - awk nil) + awk 'c-awk-context-expand-fl-region) ;; For documentation see the following c-lang-defvar of the same name. ;; The value here may be a list of functions or a single function. (c-lang-defvar c-before-context-fontification-functions diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index f6d36f5670..2f1885e5b6 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -113,6 +113,7 @@ ;; Silence the compiler. (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs (cc-bytecomp-defun run-mode-hooks) ; Emacs 21.1 +(cc-bytecomp-defvar awk-mode-syntax-table) ;; We set this variable during mode init, yet we don't require ;; font-lock. commit c7fdf8688388f137dbfab2f372fa33c24241b83a Author: Stefan Monnier Date: Mon Dec 28 14:58:39 2020 -0500 * lisp/minibuffer.el: Avoid consecutive `any` in completion patterns (completion-pcm--optimize-pattern): Turn multiple consecutive occurrences of `any` into just a single one. Suggested by Dario Gjorgjevski . diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 7d05f7704e..c8c106c336 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3159,7 +3159,8 @@ or a symbol, see `completion-pcm--merge-completions'." (let ((n '())) (while p (pcase p - (`(,(or 'any 'any-delim) point . ,rest) (setq p `(point . ,rest))) + (`(,(or 'any 'any-delim) ,(or 'any 'point) . ,rest) + (setq p (cdr p))) ;; This is not just a performance improvement: it turns a ;; terminating `point' into an implicit `any', which affects ;; the final position of point (because `point' gets turned commit 81969482e23b1c046354d9d860e548259f118b4e Author: Glenn Morris Date: Mon Dec 28 11:03:30 2020 -0800 Fix package tests for tetris no longer existing as a package * test/lisp/emacs-lisp/package-tests.el (package-test-list-filter-by-name, package-test-list-clear-filter): Use ansi-color instead of tetris, which no longer has a version:. diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 23267545f8..92e593328c 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -405,9 +405,9 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-list-filter-by-name () "Ensure package list is filtered correctly by package name." (with-package-menu-test () - (package-menu-filter-by-name "tetris") + (package-menu-filter-by-name "ansi-color") (goto-char (point-min)) - (should (re-search-forward "^\\s-+tetris" nil t)) + (should (re-search-forward "^\\s-+ansi-color" nil t)) (should (= (count-lines (point-min) (point-max)) 1)))) (ert-deftest package-test-list-filter-by-status () @@ -463,7 +463,7 @@ Must called from within a `tar-mode' buffer." "Ensure package list filter is cleared correctly." (with-package-menu-test (let ((num-packages (count-lines (point-min) (point-max)))) - (package-menu-filter-by-name "tetris") + (package-menu-filter-by-name "ansi-color") (should (= (count-lines (point-min) (point-max)) 1)) (package-menu-clear-filter) (should (= (count-lines (point-min) (point-max)) num-packages))))) commit 16458631d49a19bd496a45517264059383e18c18 Author: Alan Third Date: Mon Dec 28 15:02:39 2020 +0000 Fix crash in NS menu code * src/nsmenu.m (ns_update_menubar): Don't assume that the top level menus are correct when populating the submenus. (free_frame_menubar): Clear the menu. ([EmacsMenu removeAllItems]): Actually remove all menu items. diff --git a/src/nsmenu.m b/src/nsmenu.m index 3f0cd0c6ed..23699627b1 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -65,11 +65,22 @@ /* Supposed to discard menubar and free storage. Since we share the menubar among frames and update its context for the focused window, - there is nothing to do here. */ + we do not discard the menu. We do, however, want to remove any + existing menu items. */ void free_frame_menubar (struct frame *f) { - return; + id menu = [NSApp mainMenu]; + for (int i = [menu numberOfItems] - 1 ; i >= 0; i--) + { + NSMenuItem *item = [menu itemAtIndex:i]; + NSString *title = [item title]; + + if ([ns_app_name isEqualToString:title]) + continue; + + [menu removeItemAtIndex:i]; + } } @@ -108,7 +119,7 @@ NSTRACE ("ns_update_menubar"); - if (f != SELECTED_FRAME ()) + if (f != SELECTED_FRAME () || FRAME_EXTERNAL_MENU_BAR (f) == 0) return; XSETFRAME (Vmenu_updating_frame, f); /*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */ @@ -317,57 +328,44 @@ } /* Now, update the NS menu. */ - if (deep_p) - { - /* This path is typically used when a menu has been clicked. I - think Apple expect us to only update that one menu, however - to update one we need to do the hard work of parsing the - whole tree, so we may as well update them all. */ -#ifdef NS_IMPL_COCOA - int i = 1; -#else - int i = 0; -#endif - for (wv = first_wv->contents; wv; wv = wv->next) - { - /* The contents of wv should match the top level menu. */ - EmacsMenu *submenu = (EmacsMenu*)[[menu itemAtIndex:i++] submenu]; + i = 0; - [submenu fillWithWidgetValue: wv->contents]; - } + /* Make sure we skip the "application" menu, which is always the + first entry in our top-level menu. */ + if (i < [menu numberOfItems]) + { + NSString *title = [[menu itemAtIndex:i] title]; + if ([ns_app_name isEqualToString:title]) + i += 1; } - else + + for (wv = first_wv->contents; wv; wv = wv->next) { - /* Make sure we skip the "application" menu, which is always the - first entry in our top-level menu. */ -#ifdef NS_IMPL_COCOA - int i = 1; -#else - int i = 0; -#endif - for (wv = first_wv->contents; wv; wv = wv->next) - { - if (i < [menu numberOfItems]) - { - NSString *titleStr = [NSString stringWithUTF8String: wv->name]; - NSMenuItem *item = [menu itemAtIndex:i]; - EmacsMenu *submenu = (EmacsMenu*)[item submenu]; + EmacsMenu *submenu; - [item setTitle:titleStr]; - [submenu setTitle:titleStr]; - [submenu removeAllItems]; - } - else - [menu addSubmenuWithTitle: wv->name]; + if (i < [menu numberOfItems]) + { + NSString *titleStr = [NSString stringWithUTF8String: wv->name]; + NSMenuItem *item = [menu itemAtIndex:i]; + submenu = (EmacsMenu*)[item submenu]; - i += 1; + [item setTitle:titleStr]; + [submenu setTitle:titleStr]; + [submenu removeAllItems]; } + else + submenu = [menu addSubmenuWithTitle: wv->name]; - while (i < [menu numberOfItems]) - { - /* Remove any extra items. */ - [menu removeItemAtIndex:i]; - } + if (deep_p) + [submenu fillWithWidgetValue: wv->contents]; + + i += 1; + } + + while (i < [menu numberOfItems]) + { + /* Remove any extra items. */ + [menu removeItemAtIndex:i]; } @@ -541,14 +539,7 @@ -(void)removeAllItems int n; for (n = [self numberOfItems]-1; n >= 0; n--) - { - NSMenuItem *item = [self itemAtIndex: n]; - NSString *title = [item title]; - if ([ns_app_name isEqualToString: title] - && ![item isSeparatorItem]) - continue; - [self removeItemAtIndex: n]; - } + [self removeItemAtIndex: n]; #endif needsUpdate = YES;