commit 92464bd9b7437c776ddcf7169d9f577ad6f89c86 (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Fri May 21 09:43:04 2021 +0200 Rearrange nativecomp tests for EMBA * test/infra/Dockerfile.emba (emacs-native-comp-speed0): Add recipe. * test/infra/gitlab-ci.yml (stages): New stages native-comp-images and native-comp. (build-native-bootstrap-speed0): Simplify. (build-native-bootstrap-speed1, build-native-bootstrap-speed2): Deactivate temporarily. diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba index 19c83a8016..9f03482c3f 100644 --- a/test/infra/Dockerfile.emba +++ b/test/infra/Dockerfile.emba @@ -70,3 +70,18 @@ RUN ./autogen.sh autoconf RUN ./configure --with-ns RUN make bootstrap RUN make -j4 + +FROM emacs-base as emacs-native-comp-speed0 + +RUN apt-get update && \ + apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 libgccjit-6-dev \ + && rm -rf /var/lib/apt/lists/* + +ARG make_bootstrap_params="" + +COPY . /checkout +WORKDIR /checkout +RUN ./autogen.sh autoconf +RUN ./configure --with-nativecomp +RUN make bootstrap -j2 NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 0)"' +RUN make -j4 diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 4023437e59..7914a2c10e 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -188,6 +188,8 @@ stages: - normal - platform-images - platforms + - native-comp-images + - native-comp - slow prep-image-base: @@ -209,18 +211,6 @@ test-fast-inotify: target: emacs-inotify make_params: "-C test check" -build-image-filenotify-gio: - stage: platform-images - extends: [.job-template, .build-template, .filenotify-gio-template] - variables: - target: emacs-filenotify-gio - -build-image-gnustep: - stage: platform-images - extends: [.job-template, .build-template, .gnustep-template] - variables: - target: emacs-gnustep - test-lisp-inotify: stage: normal extends: [.job-template, .test-template] @@ -235,6 +225,18 @@ test-lisp-net-inotify: target: emacs-inotify make_params: "-C test check-lisp-net" +build-image-filenotify-gio: + stage: platform-images + extends: [.job-template, .build-template, .filenotify-gio-template] + variables: + target: emacs-filenotify-gio + +build-image-gnustep: + stage: platform-images + extends: [.job-template, .build-template, .gnustep-template] + variables: + target: emacs-gnustep + test-filenotify-gio: # This tests file monitor libraries gfilemonitor and gio. stage: platforms @@ -244,38 +246,6 @@ test-filenotify-gio: target: emacs-filenotify-gio make_params: "-k -C test autorevert-tests.log filenotify-tests.log" -build-native-bootstrap-speed0: - # Test a full native bootstrap - # Run for now only speed 0 to limit memory usage and compilation time. - stage: slow - # Uncomment the following to run it only when scheduled. - # only: - # - schedules - script: - - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev - - ./autogen.sh autoconf - - ./configure --with-nativecomp - - make bootstrap NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 0)"' -j2 - timeout: 8 hours - -build-native-bootstrap-speed1: - stage: slow - script: - - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev - - ./autogen.sh autoconf - - ./configure --with-nativecomp - - make bootstrap BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 1)"' - timeout: 8 hours - -build-native-bootstrap-speed2: - stage: slow - script: - - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev - - ./autogen.sh autoconf - - ./configure --with-nativecomp - - make bootstrap - timeout: 8 hours - test-gnustep: # This tests the GNUstep build process stage: platforms @@ -285,6 +255,45 @@ test-gnustep: target: emacs-gnustep make_params: install +build-native-bootstrap-speed0: + stage: native-comp-images + extends: [.job-template, .build-template] + variables: + target: emacs-native-comp-speed0 + timeout: 8 hours + +# build-native-bootstrap-speed0: +# # Test a full native bootstrap +# # Run for now only speed 0 to limit memory usage and compilation time. +# stage: native-comp-images +# # Uncomment the following to run it only when scheduled. +# # only: +# # - schedules +# script: +# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev +# - ./autogen.sh autoconf +# - ./configure --with-nativecomp +# - make bootstrap NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 0)"' -j2 +# timeout: 8 hours + +# build-native-bootstrap-speed1: +# stage: native-comp-images +# script: +# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev +# - ./autogen.sh autoconf +# - ./configure --with-nativecomp +# - make bootstrap BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 1)"' +# timeout: 8 hours + +# build-native-bootstrap-speed2: +# stage: native-comp-images +# script: +# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev +# - ./autogen.sh autoconf +# - ./configure --with-nativecomp +# - make bootstrap +# timeout: 8 hours + test-all-inotify: # This tests also file monitor libraries inotify and inotifywatch. stage: slow commit 3f207753a06453ab97d1a28ede89eb56cf425092 Author: Andrea Corallo Date: Fri May 21 08:44:55 2021 +0200 * Fix ahead-of-time native compilation for out-of-tree builds (bug#48497) * src/comp.c (Fcomp_el_to_eln_rel_filename): Expand 'PATH_DUMPLOADSEARCH' while computing 'loadsearch_re_list'. diff --git a/src/comp.c b/src/comp.c index c0445050b7..340ed85038 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4056,7 +4056,8 @@ DEFUN ("comp-el-to-eln-rel-filename", Fcomp_el_to_eln_rel_filename, Lisp_Object sys_re = concat2 (build_string ("\\`[[:ascii:]]+"), Fregexp_quote (build_string ("/" PATH_REL_LOADSEARCH "/"))); - Lisp_Object dump_load_search = build_string (PATH_DUMPLOADSEARCH "/"); + Lisp_Object dump_load_search = + Fexpand_file_name (build_string (PATH_DUMPLOADSEARCH "/"), Qnil); #ifdef WINDOWSNT dump_load_search = Fw32_long_file_name (dump_load_search); #endif commit 8349f8294c3853299ad94779c25ee9fad6806b80 Author: Tassilo Horn Date: Thu May 20 21:30:10 2021 +0200 ; Improve new bug-reference manual section diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index ed6fed63d2..d385e88ce3 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3081,6 +3081,8 @@ project's issue tracker. @code{bug-reference-prog-mode} is a variant of @code{bug-reference-mode} which highlights bug references only inside source code comments and strings. +@vindex bug-reference-bug-regexp +@vindex bug-reference-url-format For its working, bug reference mode needs to know the syntax of bug references (@code{bug-reference-bug-regexp}), and the URL of the tracker where bug reports can be looked up @@ -3090,8 +3092,8 @@ different from project to project, it makes sense to specify them in For example, let's assume in our project, we usually write references to bug reports as bug#1234, or Bug-1234 and that this bug's page on -the issue tracker is https://project.org/issues/1234, then these local -variables section would do. +the issue tracker is @url{https://project.org/issues/1234}, then +these local variables section would do. @smallexample ;; Local Variables: @@ -3101,7 +3103,7 @@ variables section would do. @end smallexample The string captured by the second regexp group in -(@code{bug-reference-bug-regexp}) is used to replace the @code{%s} +@code{bug-reference-bug-regexp} is used to replace the @code{%s} template in the @code{bug-reference-url-format}. Note that @code{bug-reference-url-format} may also be a function in @@ -3109,13 +3111,17 @@ order to cater for more complex scenarios, e.g., when the part before the actual bug number has to be used to distinguish between issues and merge requests where each of them has a different URL. + +@heading Integration with the debbugs package + @findex debbugs-browse-mode -If your project is located on the server -@url{https://debbugs.gnu.org}, you can browse bugs in Emacs using the -@code{debbugs} package, which can be downloaded via the Package Menu -(@pxref{Packages}). This package adds the minor mode -@code{debbugs-browse-mode}, which is activated on top of -@code{bug-reference-mode} and @code{bug-reference-prog-mode} by +If your project's issues are tracked on the server +@url{https://debbugs.gnu.org}, you can browse and reply to reports +directly in Emacs using the @code{debbugs} package, which can be +downloaded via the Package Menu (@pxref{Packages}). This package adds +the minor mode @code{debbugs-browse-mode}, which can be activated on +top of @code{bug-reference-mode} and @code{bug-reference-prog-mode} as +follows: @smallexample (add-hook 'bug-reference-mode-hook 'debbugs-browse-mode) commit e0ebce5ce2ba76779a5a74dcffba60b83cf9df2f Author: Juri Linkov Date: Thu May 20 21:37:04 2021 +0300 * lisp/help.el (describe-bindings-outline): New defcustom (bug#45147). (describe-bindings): Use describe-bindings-outline. (describe-bindings-internal): Remove function obsolete since 24.4. diff --git a/etc/NEWS b/etc/NEWS index 0bdb79e3a9..693d0c0026 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1052,6 +1052,11 @@ commands and is globally bound to `C-h x'. +++ *** New command 'describe-keymap' describes keybindings in a keymap. +--- +*** New user option 'describe-bindings-outline'. +It enables outlines in the output buffer of `describe-bindings' that +can provide a better overview in a long list of available bindings. + --- *** New keybinding 'C-h R' prompts for a manual to display and displays it. diff --git a/lisp/help.el b/lisp/help.el index babaf4adc7..1bb1b30772 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -561,6 +561,12 @@ To record all your input, use `open-dribble-file'." 'font-lock-face 'help-key-binding 'face 'help-key-binding)) +(defcustom describe-bindings-outline nil + "Non-nil enables outlines in the output buffer of `describe-bindings'." + :type 'boolean + :group 'help + :version "28.1") + (defun describe-bindings (&optional prefix buffer) "Display a buffer showing a list of all defined keys, and their definitions. The keys are displayed in order of precedence. @@ -578,23 +584,26 @@ or a buffer name." ;; Be aware that `describe-buffer-bindings' puts its output into ;; the current buffer. (with-current-buffer (help-buffer) - (describe-buffer-bindings buffer prefix)))) - -(defun describe-bindings-internal (&optional menus prefix) - "Show a list of all defined keys, and their definitions. -We put that list in a buffer, and display the buffer. - -The optional argument MENUS, if non-nil, says to mention menu bindings. -\(Ordinarily these are omitted from the output.) -The optional argument PREFIX, if non-nil, should be a key sequence; -then we display only bindings that start with that prefix." - (declare (obsolete describe-buffer-bindings "24.4")) - (let ((buf (current-buffer))) - (with-help-window (help-buffer) - ;; Be aware that `describe-buffer-bindings' puts its output into - ;; the current buffer. - (with-current-buffer (help-buffer) - (describe-buffer-bindings buf prefix menus))))) + (describe-buffer-bindings buffer prefix) + + (when describe-bindings-outline + (setq-local outline-regexp ".*:$") + (setq-local outline-heading-end-regexp ":\n") + (setq-local outline-level (lambda () 1)) + (setq-local outline-minor-mode-cycle t + outline-minor-mode-highlight t) + (outline-minor-mode 1) + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (insert (substitute-command-keys + (concat "\\Type " + "\\[outline-cycle] or \\[outline-cycle-buffer] " + "on headings to cycle their visibility.\n\n"))) + ;; Hide the longest body + (when (and (re-search-forward "Key translations" nil t) + (fboundp 'outline-cycle)) + (outline-cycle)))))))) (defun where-is (definition &optional insert) "Print message listing key sequences that invoke the command DEFINITION. commit 9be9d1f94ed6506f5b9659dfb40e5b5d8cdb3310 Author: Juri Linkov Date: Thu May 20 21:23:01 2021 +0300 * lisp/vc/diff-mode.el (diff-hunk-text): Handle better "\ No newline at end". diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 2c72c45f4b..4118a2ea06 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1771,7 +1771,14 @@ char-offset in TEXT." (goto-char (point-min)) (while (not (eobp)) (if (memq (char-after) kill-chars) - (delete-region (point) (progn (forward-line 1) (point))) + (delete-region + ;; Check for "\ No newline at end of file" + (if (and (eq (char-after) ?\\) + (save-excursion + (forward-line 1) (eobp))) + (1- (point)) + (point)) + (progn (forward-line 1) (point))) (delete-char num-pfx-chars) (forward-line 1))))) commit ef7a6eec20a59b338e18aea4f8a805dcfc8dfc96 Author: Juri Linkov Date: Thu May 20 21:02:27 2021 +0300 Fix off-by-one inconsistency of 'M-y C-y' (bug#48478). * lisp/simple.el (read-from-kill-ring): Increment kill-ring-yank-pointer by 1. (yank-from-kill-ring): Don't increment kill-ring-yank-pointer by 1. diff --git a/lisp/simple.el b/lisp/simple.el index 5e3172326f..f139555dd3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5734,7 +5734,7 @@ PROMPT is a string to prompt with." (complete-with-action action completions string pred))) nil nil nil (if history-pos - (cons 'read-from-kill-ring-history history-pos) + (cons 'read-from-kill-ring-history (1+ history-pos)) 'read-from-kill-ring-history))))) (defcustom yank-from-kill-ring-rotate t @@ -5773,7 +5773,7 @@ When called from Lisp, insert STRING like `insert-for-yank' does." (when yank-from-kill-ring-rotate (let ((pos (seq-position kill-ring string))) (setq kill-ring-yank-pointer - (or (and pos (nthcdr (1+ pos) kill-ring)) + (or (and pos (nthcdr pos kill-ring)) kill-ring)))) (if (consp arg) ;; Swap point and mark like in `yank' and `yank-pop'. commit 1866e66a73083fa5466b040d2cc44ca73da891e9 Author: Juri Linkov Date: Thu May 20 20:51:32 2021 +0300 * lisp/international/mule-cmds.el: Use group-function in read-char-by-name. (mule--ucs-names-group): Simplify for using by group-function. (read-char-by-name-group): Remove defcustom obsoleted by completions-group. (read-char-by-name): Mention completions-group and completions-group-sort in docstring. Use group-function when completions-group is non-nil. https://lists.gnu.org/archive/html/emacs-devel/2021-05/msg00791.html diff --git a/etc/NEWS b/etc/NEWS index 32d7c4fe18..0bdb79e3a9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1090,12 +1090,11 @@ so e.g. like 'C-x 8 [' inserts a left single quotation mark, 'C-x \ [' does the same. --- -*** New user options 'read-char-by-name-sort' and 'read-char-by-name-group'. -'read-char-by-name-sort' defines the sorting order of characters for -completion of 'C-x 8 RET TAB' and can be customized to sort them -by codepoints instead of character names by default. The 't' value of -'read-char-by-name-group' groups the characters for completion of -'C-x 8 RET TAB' by Unicode blocks. +*** New user option 'read-char-by-name-sort'. +It defines the sorting order of characters for completion of 'C-x 8 RET TAB' +and can be customized to sort them by codepoints instead of character names. +Additionally, you can group characters by Unicode blocks after customizing +'completions-group' and 'completions-group-sort'. --- *** Improved language transliteration in Malayalam input methods. @@ -2767,6 +2766,10 @@ It accepts a list of completions and should return a list where each element is a list with three elements: a completion, a prefix string, and a suffix string. ++++ +** New completion function 'group-function' for grouping candidates. +It takes two arguments: a completion candidate and a 'transform' flag. + +++ ** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'. If you bind 'help-form' to a non-nil value while calling these functions, diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 7f8d98b7ce..432ca295d6 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -3104,35 +3104,11 @@ on encoding." (list name (concat (if char (list char) " ") "\t") ""))) names)) -(defun mule--ucs-names-group (names) - (let* ((codes-and-names - (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names)) - (grouped - (seq-group-by - (lambda (code-name) - (let ((script (aref char-script-table (car code-name)))) - (if script (symbol-name script) "ungrouped"))) - codes-and-names)) - names-with-header header) - (dolist (group (sort grouped (lambda (a b) (string< (car a) (car b))))) - (setq header t) - (dolist (code-name (cdr group)) - (push (list - (cdr code-name) - (concat - (if header - (progn - (setq header nil) - (concat "\n" (propertize - (format "* %s\n" (car group)) - 'face 'header-line))) - "") - ;; prefix - (if (car code-name) (format "%c" (car code-name)) " ") "\t") - ;; suffix - "") - names-with-header))) - (nreverse names-with-header))) +(defun mule--ucs-names-group (name transform) + (if transform + name + (let ((script (aref char-script-table (gethash name ucs-names)))) + (if script (symbol-name script) "ungrouped")))) (defun char-from-name (string &optional ignore-case) "Return a character as a number from its Unicode name STRING. @@ -3164,14 +3140,6 @@ Defines the sorting order either by character names or their codepoints." :group 'mule :version "28.1") -(defcustom read-char-by-name-group nil - "How to group characters for `read-char-by-name' completion. -When t, split characters to sections of Unicode blocks -sorted alphabetically." - :type 'boolean - :group 'mule - :version "28.1") - (defun read-char-by-name (prompt) "Read a character by its Unicode name or hex number string. Display PROMPT and read a string that represents a character by its @@ -3185,8 +3153,9 @@ preceded by an asterisk `*' and use completion, it will show all the characters whose names include that substring, not necessarily at the beginning of the name. -The options `read-char-by-name-sort' and `read-char-by-name-group' -define the sorting order of completion characters and how to group them. +The options `read-char-by-name-sort', `completions-group', and +`completions-group-sort' define the sorting order of completion characters, +whether to group them, and how to sort groups. Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal number like \"2A10\", or a number in hash notation (e.g., @@ -3204,11 +3173,12 @@ as names, not numbers." `(metadata (display-sort-function . ,(when (eq read-char-by-name-sort 'code) - #'mule--ucs-names-sort-by-code)) + #'mule--ucs-names-sort-by-code)) (affixation-function - . ,(if read-char-by-name-group - #'mule--ucs-names-group - #'mule--ucs-names-affixation)) + . ,#'mule--ucs-names-affixation) + (group-function + . ,(when completions-group + #'mule--ucs-names-group)) (category . unicode-name)) (complete-with-action action (ucs-names) string pred))))) (char commit cb8b994217ed958ae6d5076ab1747ea6fb43a8dc Author: Daniel Mendler Date: Tue May 11 09:08:05 2021 +0200 (minibuffer-completion-help): Add group sorting Sort the groups as returned by the `group-function` of the completion table depending on the value of the customizable variable `completions-group-sort`. By default `completions-group-sort` is set to nil. The variable can be set to the symbol `alphabetical` in order to configure alphabetical sorting. Furthermore, a custom sorting function can be used as value of `completions-group-sort`. * lisp/minibuffer.el (completions-group-sort): New variable. (minibuffer--group-by): Add SORT-FUN argument. (minibuffer-completion-help): Pass `completions-group-sort` to `minibuffer--group-by`. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 35ae4b8bcb..e04f1040b3 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1147,10 +1147,22 @@ completion candidates than this number." (defcustom completions-group nil "Enable grouping of completion candidates in the *Completions* buffer. -See also `completions-group-format'." +See also `completions-group-format' and `completions-group-sort'." :type 'boolean :version "28.1") +(defcustom completions-group-sort nil + "Sort groups in the *Completions* buffer. + +The value can either be nil to disable sorting, `alphabetical' for +alphabetical sorting or a custom sorting function. The sorting +function takes and returns an alist of groups, where each element is a +pair of a group title string and a list of group candidate strings." + :type '(choice (const :tag "No sorting" nil) + (const :tag "Alphabetical sorting" alphabetical) + function) + :version "28.1") + (defcustom completions-group-format (concat (propertize " " 'face 'completions-group-separator) @@ -1434,16 +1446,21 @@ Remove completion BASE prefix string from history elements." (substring c base-size))) hist))))) -(defun minibuffer--group-by (fun elems) - "Group ELEMS by FUN." +(defun minibuffer--group-by (group-fun sort-fun elems) + "Group ELEMS by GROUP-FUN and sort groups by SORT-FUN." (let ((groups)) (dolist (cand elems) - (let* ((key (funcall fun cand nil)) + (let* ((key (funcall group-fun cand nil)) (group (assoc key groups))) (if group (setcdr group (cons cand (cdr group))) (push (list key cand) groups)))) - (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups)))) + (setq groups (nreverse groups) + groups (mapc (lambda (x) + (setcdr x (nreverse (cdr x)))) + groups) + groups (funcall sort-fun groups)) + (mapcan #'cdr groups))) (defun completion-all-sorted-completions (&optional start end) (or completion-all-sorted-completions @@ -2216,7 +2233,17 @@ variables.") ;; `group-function'. (when group-fun (setq completions - (minibuffer--group-by group-fun completions))) + (minibuffer--group-by + group-fun + (pcase completions-group-sort + ('nil #'identity) + ('alphabetical + (lambda (groups) + (sort groups + (lambda (x y) + (string< (car x) (car y)))))) + (_ completions-group-sort)) + completions))) (cond (aff-fun commit 836d69bc60b3be349c658e9cc78f60d7e7730fd9 Author: Daniel Mendler Date: Sun May 2 16:19:42 2021 +0200 (completion--insert-vertical): Separate groups completely Insert the candidates vertically within the groups, but keep the groups separate using the full width group separators. * minibuffer.el (completion--insert-vertical): Adjust grouping. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 35bb12ffcd..35ae4b8bcb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1869,66 +1869,54 @@ Runs of equal candidate strings are eliminated. GROUP-FUN is a (defun completion--insert-vertical (strings group-fun _length _wwidth colwidth columns) - (let ((column 0) - (rows (/ (length strings) columns)) - (row 0) - (last-title nil) - (last-string nil) - (start-point (point)) - (next 0) (pos 0)) - (dolist (str strings) - (unless (equal last-string str) ; Remove (consecutive) duplicates. - (setq last-string str) - (when (> row rows) - (goto-char start-point) - (setq row 0 column (+ column colwidth))) - (when group-fun - (let ((title (funcall group-fun (if (consp str) (car str) str) nil))) - (unless (equal title last-title) - (setq last-title title) - (when title - ;; Align before title insertion - (when (> column 0) - (end-of-line) - (while (> (current-column) column) - (if (eobp) - (insert "\n") - (forward-line 1) - (end-of-line))) - (insert " \t") - (set-text-properties (1- (point)) (point) - `(display (space :align-to ,column)))) - (let* ((fmt completions-group-format) - (len (length fmt))) - ;; Adjust display space for columns - (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right)) - (setq fmt (substring fmt)) - (put-text-property (- len 1) len - 'display - `(space :align-to ,(+ colwidth column -1)) - fmt)) - (insert (format fmt title))) - ;; Align after title insertion - (if (> column 0) - (forward-line) - (insert "\n")))))) - ;; Align before candidate insertion - (when (> column 0) - (end-of-line) - (while (> (current-column) column) - (if (eobp) - (insert "\n") - (forward-line 1) - (end-of-line))) - (insert " \t") - (set-text-properties (1- (point)) (point) - `(display (space :align-to ,column)))) - (completion--insert str group-fun) - ;; Align after candidate insertion - (if (> column 0) - (forward-line) - (insert "\n")) - (setq row (1+ row)))))) + (while strings + (let ((group nil) + (column 0) + (row 0) + (rows) + (last-string nil)) + (if group-fun + (let* ((str (car strings)) + (title (funcall group-fun (if (consp str) (car str) str) nil))) + (while (and strings + (equal title (funcall group-fun + (if (consp (car strings)) + (car (car strings)) + (car strings)) + nil))) + (push (car strings) group) + (pop strings)) + (setq group (nreverse group))) + (setq group strings + strings nil)) + (setq rows (/ (length group) columns)) + (when group-fun + (let* ((str (car group)) + (title (funcall group-fun (if (consp str) (car str) str) nil))) + (when title + (goto-char (point-max)) + (insert (format completions-group-format title) "\n")))) + (dolist (str group) + (unless (equal last-string str) ; Remove (consecutive) duplicates. + (setq last-string str) + (when (> row rows) + (forward-line (- -1 rows)) + (setq row 0 column (+ column colwidth))) + (when (> column 0) + (end-of-line) + (while (> (current-column) column) + (if (eobp) + (insert "\n") + (forward-line 1) + (end-of-line))) + (insert " \t") + (set-text-properties (1- (point)) (point) + `(display (space :align-to ,column)))) + (completion--insert str group-fun) + (if (> column 0) + (forward-line) + (insert "\n")) + (setq row (1+ row))))))) (defun completion--insert-one-column (strings group-fun &rest _) (let ((last-title nil) (last-string nil)) commit cacfd0321a52b6bcbf5a910a5481e243aae0bc3a Author: Daniel Mendler Date: Sun May 2 15:50:08 2021 +0200 (minibuffer-completion-help): Do not check `completions-group` centrally The guard variable `completions-group` should be checked in each completion table individually. The guard variable `completions-detailed` variable is used in the same way. * minibuffer.el (minibuffer-completion-help): Remove check of `completions-group`. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 8790ce403d..35bb12ffcd 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2182,8 +2182,7 @@ variables.") (plist-get completion-extra-properties :affixation-function))) (sort-fun (completion-metadata-get all-md 'display-sort-function)) - (group-fun (and completions-group - (completion-metadata-get all-md 'group-function))) + (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new ;; window, mark it as softly-dedicated, so bury-buffer in commit de168b70b105730b1a3ce79aeb0b0c70d9460300 Author: Daniel Mendler Date: Fri Apr 30 08:40:59 2021 +0200 (completion--insert-strings): Split function; Full group title support Split `completion--insert-strings` into a function per completions format in order to increase readability and extensibility. This change eases the addition of more formats. Add support for group titles to the vertical and horizontal formatting functions. * minibuffer.el (completion--insert): Add new function. (completion--insert-vertical, completion--insert-horizontal, completion--insert-one-column): Extract function from `completion--insert-strings`. Use new function `completion--insert`. (completion--insert-strings): Use new insertion functions. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ba9de7df04..8790ce403d 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1791,21 +1791,17 @@ or appended to completions." :type 'boolean :version "28.1") -;; TODO: Split up this function in one function per `completions-format'. -;; TODO: Add group title support for horizontal and vertical format. (defun completion--insert-strings (strings &optional group-fun) "Insert a list of STRINGS into the current buffer. -Uses columns to keep the listing readable but compact. It also -eliminates runs of equal strings. GROUP-FUN is a `group-function' -used for grouping the completion." +The candidate strings are inserted into the buffer depending on the +completions format as specified by the variable `completions-format'. +Runs of equal candidate strings are eliminated. GROUP-FUN is a +`group-function' used for grouping the completion candidates." (when (consp strings) - ;; FIXME: Currently grouping is enabled only for the 'one-column format. - (unless (eq completions-format 'one-column) - (setq group-fun nil)) (let* ((length (apply #'max (mapcar (lambda (s) (if (consp s) - (apply #'+ (mapcar #'string-width s)) + (apply #'+ (mapcar #'string-width s)) (string-width s))) strings))) (window (get-buffer-window (current-buffer) 0)) @@ -1816,126 +1812,170 @@ used for grouping the completion." ;; Don't allocate more columns than we can fill. ;; Windows can't show less than 3 lines anyway. (max 1 (/ (length strings) 2)))) - (colwidth (/ wwidth columns)) - (column 0) - (last-title nil) - (rows (/ (length strings) columns)) - (row 0) - (first t) - (laststring nil)) + (colwidth (/ wwidth columns))) (unless (or tab-stop-list (null completion-tab-width) (zerop (mod colwidth completion-tab-width))) ;; Align to tab positions for the case ;; when the caller uses tabs inside prefix. (setq colwidth (- colwidth (mod colwidth completion-tab-width)))) - ;; The insertion should be "sensible" no matter what choices were made - ;; for the parameters above. - (dolist (str strings) - ;; Add group titles. + (funcall (intern (format "completion--insert-%s" completions-format)) + strings group-fun length wwidth colwidth columns)))) + +(defun completion--insert-horizontal (strings group-fun + length wwidth + colwidth _columns) + (let ((column 0) + (first t) + (last-title nil) + (last-string nil)) + (dolist (str strings) + (unless (equal last-string str) ; Remove (consecutive) duplicates. + (setq last-string str) (when group-fun (let ((title (funcall group-fun (if (consp str) (car str) str) nil))) (unless (equal title last-title) + (setq last-title title) (when title - (insert (format completions-group-format title) "\n")) - (setq last-title title)))) - (unless (equal laststring str) ; Remove (consecutive) duplicates. - (setq laststring str) + (insert (if first "" "\n") (format completions-group-format title) "\n") + (setq column 0 + first t))))) + (unless first ;; FIXME: `string-width' doesn't pay attention to ;; `display' properties. - (let ((length (if (consp str) - (apply #'+ (mapcar #'string-width str)) - (string-width str)))) - (cond - ((eq completions-format 'one-column) - ;; Nothing special - ) - ((eq completions-format 'vertical) - ;; Vertical format - (when (> row rows) - (forward-line (- -1 rows)) - (setq row 0 column (+ column colwidth))) - (when (> column 0) - (end-of-line) - (while (> (current-column) column) - (if (eobp) - (insert "\n") - (forward-line 1) - (end-of-line))) - (insert " \t") - (set-text-properties (1- (point)) (point) - `(display (space :align-to ,column))))) - (t - ;; Horizontal format - (unless first - (if (< wwidth (+ (max colwidth length) column)) - ;; No space for `str' at point, move to next line. - (progn (insert "\n") (setq column 0)) - (insert " \t") - ;; Leave the space unpropertized so that in the case we're - ;; already past the goal column, there is still - ;; a space displayed. - (set-text-properties (1- (point)) (point) - ;; We can set tab-width using - ;; completion-tab-width, but - ;; the caller can prefer using - ;; \t to align prefixes. - `(display (space :align-to ,column))) - nil)))) - (setq first nil) - (if (not (consp str)) - (add-text-properties - (point) - (progn - (insert - (if group-fun - (funcall group-fun str 'transform) - str)) - (point)) - `(mouse-face highlight completion--string ,str)) - ;; If `str' is a list that has 2 elements, - ;; then the second element is a suffix annotation. - ;; If `str' has 3 elements, then the second element - ;; is a prefix, and the third element is a suffix. - (let* ((prefix (when (nth 2 str) (nth 1 str))) - (suffix (or (nth 2 str) (nth 1 str)))) - (when prefix - (let ((beg (point)) - (end (progn (insert prefix) (point)))) - (put-text-property beg end 'mouse-face nil))) - (add-text-properties - (point) - (progn - (insert - (if group-fun - (funcall group-fun (car str) 'transform) - (car str))) - (point)) - `(mouse-face highlight completion--string ,(car str))) - (let ((beg (point)) - (end (progn (insert suffix) (point)))) - (put-text-property beg end 'mouse-face nil) - ;; Put the predefined face only when suffix - ;; is added via annotation-function without prefix, - ;; and when the caller doesn't use own face. - (unless (or prefix (text-property-not-all - 0 (length suffix) 'face nil suffix)) - (font-lock-prepend-text-property - beg end 'face 'completions-annotations))))) - (cond - ((eq completions-format 'one-column) - (insert "\n")) - ((eq completions-format 'vertical) - ;; Vertical format - (if (> column 0) - (forward-line) - (insert "\n")) - (setq row (1+ row))) - (t - ;; Horizontal format - ;; Next column to align to. - (setq column (+ column - ;; Round up to a whole number of columns. - (* colwidth (ceiling length colwidth)))))))))))) + (if (< wwidth (+ column (max colwidth + (if (consp str) + (apply #'+ (mapcar #'string-width str)) + (string-width str))))) + ;; No space for `str' at point, move to next line. + (progn (insert "\n") (setq column 0)) + (insert " \t") + ;; Leave the space unpropertized so that in the case we're + ;; already past the goal column, there is still + ;; a space displayed. + (set-text-properties (1- (point)) (point) + ;; We can set tab-width using + ;; completion-tab-width, but + ;; the caller can prefer using + ;; \t to align prefixes. + `(display (space :align-to ,column))) + nil)) + (setq first nil) + (completion--insert str group-fun) + ;; Next column to align to. + (setq column (+ column + ;; Round up to a whole number of columns. + (* colwidth (ceiling length colwidth)))))))) + +(defun completion--insert-vertical (strings group-fun + _length _wwidth + colwidth columns) + (let ((column 0) + (rows (/ (length strings) columns)) + (row 0) + (last-title nil) + (last-string nil) + (start-point (point)) + (next 0) (pos 0)) + (dolist (str strings) + (unless (equal last-string str) ; Remove (consecutive) duplicates. + (setq last-string str) + (when (> row rows) + (goto-char start-point) + (setq row 0 column (+ column colwidth))) + (when group-fun + (let ((title (funcall group-fun (if (consp str) (car str) str) nil))) + (unless (equal title last-title) + (setq last-title title) + (when title + ;; Align before title insertion + (when (> column 0) + (end-of-line) + (while (> (current-column) column) + (if (eobp) + (insert "\n") + (forward-line 1) + (end-of-line))) + (insert " \t") + (set-text-properties (1- (point)) (point) + `(display (space :align-to ,column)))) + (let* ((fmt completions-group-format) + (len (length fmt))) + ;; Adjust display space for columns + (when (equal (get-text-property (- len 1) 'display fmt) '(space :align-to right)) + (setq fmt (substring fmt)) + (put-text-property (- len 1) len + 'display + `(space :align-to ,(+ colwidth column -1)) + fmt)) + (insert (format fmt title))) + ;; Align after title insertion + (if (> column 0) + (forward-line) + (insert "\n")))))) + ;; Align before candidate insertion + (when (> column 0) + (end-of-line) + (while (> (current-column) column) + (if (eobp) + (insert "\n") + (forward-line 1) + (end-of-line))) + (insert " \t") + (set-text-properties (1- (point)) (point) + `(display (space :align-to ,column)))) + (completion--insert str group-fun) + ;; Align after candidate insertion + (if (> column 0) + (forward-line) + (insert "\n")) + (setq row (1+ row)))))) + +(defun completion--insert-one-column (strings group-fun &rest _) + (let ((last-title nil) (last-string nil)) + (dolist (str strings) + (unless (equal last-string str) ; Remove (consecutive) duplicates. + (setq last-string str) + (when group-fun + (let ((title (funcall group-fun (if (consp str) (car str) str) nil))) + (unless (equal title last-title) + (setq last-title title) + (when title + (insert (format completions-group-format title) "\n"))))) + (completion--insert str group-fun) + (insert "\n"))))) + +(defun completion--insert (str group-fun) + (if (not (consp str)) + (add-text-properties + (point) + (progn + (insert + (if group-fun + (funcall group-fun str 'transform) + str)) + (point)) + `(mouse-face highlight completion--string ,str)) + ;; If `str' is a list that has 2 elements, + ;; then the second element is a suffix annotation. + ;; If `str' has 3 elements, then the second element + ;; is a prefix, and the third element is a suffix. + (let* ((prefix (when (nth 2 str) (nth 1 str))) + (suffix (or (nth 2 str) (nth 1 str)))) + (when prefix + (let ((beg (point)) + (end (progn (insert prefix) (point)))) + (put-text-property beg end 'mouse-face nil))) + (completion--insert (car str) group-fun) + (let ((beg (point)) + (end (progn (insert suffix) (point)))) + (put-text-property beg end 'mouse-face nil) + ;; Put the predefined face only when suffix + ;; is added via annotation-function without prefix, + ;; and when the caller doesn't use own face. + (unless (or prefix (text-property-not-all + 0 (length suffix) 'face nil suffix)) + (font-lock-prepend-text-property + beg end 'face 'completions-annotations)))))) (defvar completion-setup-hook nil "Normal hook run at the end of setting up a completion list buffer. commit 443d9efc9524be6aff5d9703b81a821b3bb12f35 Author: Daniel Mendler Date: Sun Apr 25 13:07:29 2021 +0200 (completing-read): Add `group-function` to the completion metadata A completion table can specify a `group-function` in its metadata. The group function takes two arguments, a completion candidate and a transform argument. The group function is used to group the candidates after sorting and to enhance the completion UI with group titles. If the transform argument is nil, the function must return the title of the group to which the completion candidate belongs. The function may also return nil if the candidate does not belong to a group. If the transform argument is non-nil, the function must return the transformed candidate. For example, the transformation allows to remove a redundant part of the candidate, which is then displayed in the title. The grouping functionality is guarded by the customizable variable `completions-group` and turned off by default for the *Completions* buffer. The specific form of the `group-function` has been chosen in order to allow allocation-free grouping. This is important for completion UIs, which continously update the displayed set of candidates (Icomplete, Vertico, Ivy, etc.). Only when the transform argument is non-nil the candidate transformation is performed, which may involve a string allocation as done in the function `xref--completing-read-group`. The function `xref-show-definitions-completing-read` makes use of the `group-function`, by moving the file name prefix to the title. If grouping is enabled, the *Completions* are displayed as "linenum:summary" instead of "file:linenum:summary". This way the *Completions* buffer resembles the *Occur* buffer. * doc/lispref/minibuf.texi: Add documentation. * lisp/minibuffer.el (completion-metadata): Describe the `group-function` in the docstring. (completions-group): Add guard variable, off by default. (completions-group-format): Add variable defining the format string for the group titles. (completions-group-title): Add face used by `completions-group-format` for the group titles. (completions-group-separator): Add face used by `completions-group-format` for the group separator lines. (minibuffer--group-by): New grouping function. (minibuffer-completion-help): Use it. (display-completion-list): Add optional GROUP-FUN argument. (completion--insert-strings): Add optional GROUP-FUN argument. Insert group titles if `completions-format` is `one-column`. Transform each candidate with the GROUP-FUN. Attach the untransformed candidate to the property `completion--string`. * lisp/simple.el (choose-completion): Retrieve the untransformed completion candidate from the property `completion--string`. * lisp/progmodes/xref.el: (xref--completing-read-group): New grouping function. (xref-show-definitions-completing-read): Use it. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 145eee8f06..196dd99076 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1943,6 +1943,16 @@ the completion string in the @file{*Completions*} buffer, and a suffix displayed after the completion string. This function takes priority over @code{annotation-function}. +@item group-function +The value should be a function for grouping the completion candidates. +The function must take two arguments, @var{completion}, which is a +completion candidate and @var{transform}, which is a boolean flag. If +@var{transform} is @code{nil}, the function must return the group +title of the group to which the candidate belongs. The returned title +can also be @code{nil}. Otherwise the function must return the +transformed candidate. The transformation can for example remove a +redundant prefix, which is displayed in the group title. + @item display-sort-function The value should be a function for sorting completions. The function should take one argument, a list of completion strings, and return a diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index d6a6f9aa37..ba9de7df04 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -126,6 +126,13 @@ This metadata is an alist. Currently understood keys are: three-element lists: completion, its prefix and suffix. This function takes priority over `annotation-function' when both are provided, so only this function is used. +- `group-function': function for grouping the completion candidates. + Takes two arguments: a completion candidate (COMPLETION) and a + boolean flag (TRANSFORM). If TRANSFORM is nil, the function + returns the group title of the group to which the candidate + belongs. The returned title may be nil. Otherwise the function + returns the transformed candidate. The transformation can remove a + redundant prefix, which is displayed in the group title. - `display-sort-function': function to sort entries in *Completions*. Takes one argument (COMPLETIONS) and should return a new list of completions. Can operate destructively. @@ -1138,6 +1145,32 @@ completion candidates than this number." :version "24.1" :type completion--cycling-threshold-type) +(defcustom completions-group nil + "Enable grouping of completion candidates in the *Completions* buffer. +See also `completions-group-format'." + :type 'boolean + :version "28.1") + +(defcustom completions-group-format + (concat + (propertize " " 'face 'completions-group-separator) + (propertize " %s " 'face 'completions-group-title) + (propertize " " 'face 'completions-group-separator + 'display '(space :align-to right))) + "Format string used for the group title." + :type 'string + :version "28.1") + +(defface completions-group-title + '((t :inherit shadow :slant italic)) + "Face used for the title text of the candidate group headlines." + :version "28.1") + +(defface completions-group-separator + '((t :inherit shadow :strike-through t)) + "Face used for the separator lines between the candidate groups." + :version "28.1") + (defun completion--cycle-threshold (metadata) (let* ((cat (completion-metadata-get metadata 'category)) (over (completion--category-override cat 'cycle))) @@ -1401,6 +1434,17 @@ Remove completion BASE prefix string from history elements." (substring c base-size))) hist))))) +(defun minibuffer--group-by (fun elems) + "Group ELEMS by FUN." + (let ((groups)) + (dolist (cand elems) + (let* ((key (funcall fun cand nil)) + (group (assoc key groups))) + (if group + (setcdr group (cons cand (cdr group))) + (push (list key cand) groups)))) + (mapcan (lambda (x) (nreverse (cdr x))) (nreverse groups)))) + (defun completion-all-sorted-completions (&optional start end) (or completion-all-sorted-completions (let* ((start (or start (minibuffer-prompt-end))) @@ -1747,11 +1791,17 @@ or appended to completions." :type 'boolean :version "28.1") -(defun completion--insert-strings (strings) +;; TODO: Split up this function in one function per `completions-format'. +;; TODO: Add group title support for horizontal and vertical format. +(defun completion--insert-strings (strings &optional group-fun) "Insert a list of STRINGS into the current buffer. -Uses columns to keep the listing readable but compact. -It also eliminates runs of equal strings." +Uses columns to keep the listing readable but compact. It also +eliminates runs of equal strings. GROUP-FUN is a `group-function' +used for grouping the completion." (when (consp strings) + ;; FIXME: Currently grouping is enabled only for the 'one-column format. + (unless (eq completions-format 'one-column) + (setq group-fun nil)) (let* ((length (apply #'max (mapcar (lambda (s) (if (consp s) @@ -1768,6 +1818,7 @@ It also eliminates runs of equal strings." (max 1 (/ (length strings) 2)))) (colwidth (/ wwidth columns)) (column 0) + (last-title nil) (rows (/ (length strings) columns)) (row 0) (first t) @@ -1780,6 +1831,13 @@ It also eliminates runs of equal strings." ;; The insertion should be "sensible" no matter what choices were made ;; for the parameters above. (dolist (str strings) + ;; Add group titles. + (when group-fun + (let ((title (funcall group-fun (if (consp str) (car str) str) nil))) + (unless (equal title last-title) + (when title + (insert (format completions-group-format title) "\n")) + (setq last-title title)))) (unless (equal laststring str) ; Remove (consecutive) duplicates. (setq laststring str) ;; FIXME: `string-width' doesn't pay attention to @@ -1825,8 +1883,15 @@ It also eliminates runs of equal strings." nil)))) (setq first nil) (if (not (consp str)) - (put-text-property (point) (progn (insert str) (point)) - 'mouse-face 'highlight) + (add-text-properties + (point) + (progn + (insert + (if group-fun + (funcall group-fun str 'transform) + str)) + (point)) + `(mouse-face highlight completion--string ,str)) ;; If `str' is a list that has 2 elements, ;; then the second element is a suffix annotation. ;; If `str' has 3 elements, then the second element @@ -1837,8 +1902,15 @@ It also eliminates runs of equal strings." (let ((beg (point)) (end (progn (insert prefix) (point)))) (put-text-property beg end 'mouse-face nil))) - (put-text-property (point) (progn (insert (car str)) (point)) - 'mouse-face 'highlight) + (add-text-properties + (point) + (progn + (insert + (if group-fun + (funcall group-fun (car str) 'transform) + (car str))) + (point)) + `(mouse-face highlight completion--string ,(car str))) (let ((beg (point)) (end (progn (insert suffix) (point)))) (put-text-property beg end 'mouse-face nil) @@ -1923,7 +1995,7 @@ and with BASE-SIZE appended as the last element." completions) base-size)))) -(defun display-completion-list (completions &optional common-substring) +(defun display-completion-list (completions &optional common-substring group-fun) "Display the list of completions, COMPLETIONS, using `standard-output'. Each element may be just a symbol or string or may be a list of two strings to be printed as if concatenated. @@ -1933,7 +2005,9 @@ alternative, the second serves as annotation. The actual completion alternatives, as inserted, are given `mouse-face' properties of `highlight'. At the end, this runs the normal hook `completion-setup-hook'. -It can find the completion buffer in `standard-output'." +It can find the completion buffer in `standard-output'. +GROUP-FUN is a `group-function' used for grouping the completion +candidates." (declare (advertised-calling-convention (completions) "24.4")) (if common-substring (setq completions (completion-hilit-commonality @@ -1946,7 +2020,7 @@ It can find the completion buffer in `standard-output'." (let ((standard-output (current-buffer)) (completion-setup-hook nil)) (with-suppressed-warnings ((callargs display-completion-list)) - (display-completion-list completions common-substring))) + (display-completion-list completions common-substring group-fun))) (princ (buffer-string))) (with-current-buffer standard-output @@ -1954,7 +2028,7 @@ It can find the completion buffer in `standard-output'." (if (null completions) (insert "There are no possible completions of what you have typed.") (insert "Possible completions are:\n") - (completion--insert-strings completions)))) + (completion--insert-strings completions group-fun)))) (run-hooks 'completion-setup-hook) nil) @@ -2067,6 +2141,9 @@ variables.") (aff-fun (or (completion-metadata-get all-md 'affixation-function) (plist-get completion-extra-properties :affixation-function))) + (sort-fun (completion-metadata-get all-md 'display-sort-function)) + (group-fun (and completions-group + (completion-metadata-get all-md 'group-function))) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new ;; window, mark it as softly-dedicated, so bury-buffer in @@ -2098,15 +2175,22 @@ variables.") ;; Remove the base-size tail because `sort' requires a properly ;; nil-terminated list. (when last (setcdr last nil)) - (setq completions - ;; FIXME: This function is for the output of all-completions, - ;; not completion-all-completions. Often it's the same, but - ;; not always. - (let ((sort-fun (completion-metadata-get - all-md 'display-sort-function))) - (if sort-fun - (funcall sort-fun completions) - (sort completions 'string-lessp)))) + + ;; Sort first using the `display-sort-function'. + ;; FIXME: This function is for the output of + ;; all-completions, not + ;; completion-all-completions. Often it's the + ;; same, but not always. + (setq completions (if sort-fun + (funcall sort-fun completions) + (sort completions 'string-lessp))) + + ;; After sorting, group the candidates using the + ;; `group-function'. + (when group-fun + (setq completions + (minibuffer--group-by group-fun completions))) + (cond (aff-fun (setq completions @@ -2152,7 +2236,7 @@ variables.") (if (eq (car bounds) (length result)) 'exact 'finished))))))) - (display-completion-list completions))))) + (display-completion-list completions nil group-fun))))) nil))) nil)) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 180c0e0aaa..d307c31df8 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1088,6 +1088,12 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'." (define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom #'xref-show-definitions-buffer-at-bottom "28.1") +(defun xref--completing-read-group (cand transform) + "Return group title of candidate CAND or TRANSFORM the candidate." + (if transform + (substring cand (1+ (next-single-property-change 0 'xref--group cand))) + (get-text-property 0 'xref--group cand))) + (defun xref-show-definitions-completing-read (fetcher alist) "Let the user choose the target definition with completion. @@ -1116,10 +1122,12 @@ between them by typing in the minibuffer with completion." (format #("%d:" 0 2 (face xref-line-number)) line) "")) + (group-prefix + (substring group group-prefix-length)) (group-fmt - (propertize - (substring group group-prefix-length) - 'face 'xref-file-header)) + (propertize group-prefix + 'face 'xref-file-header + 'xref--group group-prefix)) (candidate (format "%s:%s%s" group-fmt line-fmt summary))) (push (cons candidate xref) xref-alist-with-line-info))))) @@ -1131,7 +1139,9 @@ between them by typing in the minibuffer with completion." (lambda (string pred action) (cond ((eq action 'metadata) - '(metadata . ((category . xref-location)))) + `(metadata + . ((category . xref-location) + (group-function . ,#'xref--completing-read-group)))) (t (complete-with-action action collection string pred))))) (def (caar collection))) diff --git a/lisp/simple.el b/lisp/simple.el index 8697eed9e3..5e3172326f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8932,18 +8932,17 @@ If EVENT, use EVENT's position to determine the starting position." (choice (save-excursion (goto-char (posn-point (event-start event))) - (let (beg end) + (let (beg) (cond ((and (not (eobp)) (get-text-property (point) 'mouse-face)) - (setq end (point) beg (1+ (point)))) + (setq beg (1+ (point)))) ((and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) - (setq end (1- (point)) beg (point))) + (setq beg (point))) (t (error "No completion here"))) (setq beg (previous-single-property-change beg 'mouse-face)) - (setq end (or (next-single-property-change end 'mouse-face) - (point-max))) - (buffer-substring-no-properties beg end))))) + (substring-no-properties + (get-text-property beg 'completion--string)))))) (unless (buffer-live-p buffer) (error "Destination buffer is dead")) commit 72ec24d4808c763d8d1fd4ae45b315b9a4b4011b Author: Michael Albinus Date: Thu May 20 14:33:43 2021 +0200 * doc/emacs/maintaining.texi (Bug Reference): Add debbugs-browse-mode. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index dc24cfb449..ed6fed63d2 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3108,3 +3108,16 @@ Note that @code{bug-reference-url-format} may also be a function in order to cater for more complex scenarios, e.g., when the part before the actual bug number has to be used to distinguish between issues and merge requests where each of them has a different URL. + +@findex debbugs-browse-mode +If your project is located on the server +@url{https://debbugs.gnu.org}, you can browse bugs in Emacs using the +@code{debbugs} package, which can be downloaded via the Package Menu +(@pxref{Packages}). This package adds the minor mode +@code{debbugs-browse-mode}, which is activated on top of +@code{bug-reference-mode} and @code{bug-reference-prog-mode} by + +@smallexample +(add-hook 'bug-reference-mode-hook 'debbugs-browse-mode) +(add-hook 'bug-reference-prog-mode-hook 'debbugs-browse-mode) +@end smallexample commit ae3ec0860aa60517791acbd8adf1349ee30763f0 Author: Eli Zaretskii Date: Thu May 20 13:02:29 2021 +0300 Improve documentation of 'etags' tests * test/manual/etags/README: New file. (Bug#46055) * test/README: Mention separate README files for tests in the 'manual' subdirectory diff --git a/test/README b/test/README index a348074aba..0c8d5a409b 100644 --- a/test/README +++ b/test/README @@ -7,6 +7,9 @@ Emacs's functionality. Please help add tests! See the file file-organization.org for the details of the directory structure and file-naming conventions. +For tests in the manual/ subdirectory, look there for separate README +files, or look for instructions in the test files themselves. + Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See (info "(ert)") or https://www.gnu.org/software/emacs/manual/html_node/ert/ for more information on writing and running tests. diff --git a/test/manual/etags/README b/test/manual/etags/README new file mode 100644 index 0000000000..7bce861030 --- /dev/null +++ b/test/manual/etags/README @@ -0,0 +1,60 @@ +This directory contains the test suite for the 'etags' and 'ctags' +programs. + +The input files, which include source files in various languages +supported by the programs, are in the *-src/ directories (e.g., c-src +for C sources, ada-src for Ada, tex-src for TeX, etc.). + +The expected results are slightly different for each of the 7 commands +(see below) run by the test suite, and are on files ETAGS.good_N +(where N is between 1 and 6) and CTAGS.good. + +To run the tests, say + + make check + +in this directory. This should run the programs 7 times with various +command line switches, and should not show any differences between the +produced file ETAGS/CTAGS and the corresponding expected results. Any +diffs shown by the 'diff' utility should be examined for potential +regressions in 'etags' or 'ctags'. + +In some cases, diffs should be expected. These include: + + . adding new input files in the *-src/ directories + . routine changes in the existing input files, such as the yearly + update of copyright years, spelling changes, etc. + . adding new features to etags.c + +When the diffs are expected, they should be examined to make sure +there are no regressions. To do so, compare the line numbers and byte +offsets shown in the new ETAGS/CTAGS files against the up-to-date +input files, and make sure the new values match, whereas the old one +don't. Also make sure there no new or missing entries in the +ETAGS/CTAGS files as compared with the expected results. (When new +input files are added, there obviously will be new entries -- these +should be compared to the input files to verify correctness.) + +Once the differences are deemed to be justified, i.e. you decide that +the new ETAGS/CTAGS file should become the new expected result, you +should copy the ETAGS/CTAGS files produced by the test run to the +corresponding "good" files, one by one. Like this: + + $ make check + $ cp ETAGS ETAGS.good_1 + $ make check + $ cp ETAGS ETAGS.good_2 + $ make check + $ cp ETAGS ETAGS.good_3 + ... + $ make check + $ cp ETAGS ETAGS.good_6 + $ make check + $ cp CTAGS CTAGS.good + +This uses the fact that "make check" will stop after the first +failure, i.e. after the first time 'diff' reports any diffs, and then +the ETAGS/CTAGS file from the last invocation is available for +becoming the new expected-result file. Alternatively, you can see the +name of the expected-result file which needs to be updated in the +output of the 'diff' utility. commit 8b44740a6aee6254a60243df6ef3dd80ce3f3a36 Author: Eli Zaretskii Date: Thu May 20 12:01:40 2021 +0300 Fix arg-out-of-range errors in 'line-number-at-pos' * src/fns.c (Fline_number_at_pos): Pass character position to args_out_of_range. Suggested by Andreas Schwab . Call args_out_of_range_3 to show both ends of the accessible portion. diff --git a/src/fns.c b/src/fns.c index e244268573..40ade57800 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5919,7 +5919,7 @@ from the absolute start of the buffer, disregarding the narrowing. */) /* Check that POSITION is in the accessible range of the buffer. */ if (pos < BEGV || pos > ZV) - args_out_of_range (make_int (start), make_int (ZV)); + args_out_of_range_3 (make_int (pos), make_int (BEGV), make_int (ZV)); return make_int (count_lines (start, CHAR_TO_BYTE (pos)) + 1); } commit 328efb47d04e3aa996bb8cd387d01c1a66ec29f5 Author: Eli Zaretskii Date: Thu May 20 11:44:54 2021 +0300 Make sure gmalloc's hybrid_free preserves errno * src/gmalloc.c (hybrid_free_1): New function, with the body of the previous 'hybrid_free'. (hybrid_free): Call 'hybrid_free_1' while preserving the value of 'errno'. Suggested by Paul Eggert . diff --git a/src/gmalloc.c b/src/gmalloc.c index dedd25fa22..55ae7365d9 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -1726,8 +1726,8 @@ hybrid_calloc (size_t nmemb, size_t size) return gcalloc (nmemb, size); } -void -hybrid_free (void *ptr) +static void +hybrid_free_1 (void *ptr) { if (allocated_via_gmalloc (ptr)) gfree (ptr); @@ -1735,6 +1735,24 @@ hybrid_free (void *ptr) free (ptr); } +void +hybrid_free (void *ptr) +{ + /* Stolen from Gnulib, to make sure we preserve errno. */ +#if defined __GNUC__ && !defined __clang__ + int err[2]; + err[0] = errno; + err[1] = errno; + errno = 0; + hybrid_free_1 (ptr); + errno = err[errno == 0]; +#else + int err = errno; + hybrid_free_1 (ptr); + errno = err; +#endif +} + #if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN void * hybrid_aligned_alloc (size_t alignment, size_t size)