From: Eshel Yaron Date: Mon, 18 Mar 2024 08:06:50 +0000 (+0100) Subject: Improve default *Completions* header line format X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=467599e9c0a759580d21c900bf6c81f339488a0c;p=emacs.git Improve default *Completions* header line format --- diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 38f579e9fa6..b9668099d9c 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -630,7 +630,7 @@ If DEFAULT is nil then return empty string for empty input." ((symbolp cand) (symbol-name cand)) (t (car cand))))) (string= type (funcall get-type (assoc string bookmark-alist))))) - (concat "bookmark type " (prin1-to-string + (concat "type=" (prin1-to-string (substring-no-properties type)))))) (defvar bookmark-make-record-function 'bookmark-make-record-default diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 75c9f938344..0201164ba55 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -3212,22 +3212,23 @@ returns excludes categories that you specify instead." (get-char-code-property char 'general-category))) names))) (enable-recursive-minibuffers t) + (exclude-p (< (prefix-numeric-value current-prefix-arg) 0)) (cat-names (or (completing-read-multiple - "Restrict to category: " + (concat (if exclude-p "Exclude" "Restrict to") " category: ") (completion-table-with-metadata all-cats '((annotation-function . mule--ucs-categories-annotation))) nil t) (user-error "Specify one or more character categories"))) (cats (mapcar #'intern cat-names)) - (desc (format "in categor%s %s" (ngettext "y" "ies" (length cats)) + (desc (format "categor%s=%s" (ngettext "y" "ies" (length cats)) (mapconcat #'identity cat-names ",")))) - (if (< (prefix-numeric-value current-prefix-arg) 0) + (if exclude-p (cons (lambda (_name char) (not (memq (get-char-code-property char 'general-category) cats))) - (concat "not " desc)) + (concat "no-" desc)) (cons (lambda (_name char) (memq (get-char-code-property char 'general-category) cats)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 892a5613c79..ec2411da009 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2342,57 +2342,84 @@ completions." (defvar-local completions-sort-orders nil) (defvar-local completions-predicate nil) (defvar-local completions-exceptional-candidates nil) +(defvar-local completions-ignore-case nil) (defvar-local completions-action nil) (defvar-local completions-style nil) (defvar completions-header-count '(completions-candidates - ("count:" (:eval (file-size-human-readable (length completions-candidates) 'si)) " "))) + ("" (:eval (file-size-human-readable (length completions-candidates) 'si)) " "))) (defvar completions-header-category '(completions-category - ("category:" (:eval (symbol-name completions-category)) " "))) + ("" (:eval (symbol-name completions-category)) " "))) (defvar completions-header-order - '(completions-sort-function - ("sort:" - (:eval (concat - (when-let - ((sd (nth 4 (seq-find + '("" + (:eval + (let ((sd (or (nth 4 (seq-find (lambda (order) (eq (nth 3 order) (advice--cd*r completions-sort-function))) - completions-sort-orders)))) - (concat sd " ")) - (when (advice-function-member-p - #'reverse completions-sort-function) - "(reversed)"))) - " "))) + completions-sort-orders)) + "default")) + (rv (advice-function-member-p #'reverse completions-sort-function))) + (concat (if rv "↑" "↓") + sd + (if rv "↑" "↓")))) + " ")) (defvar completions-header-restriction - '(completions-predicate - ("filter:" - (:eval (or (completions-predicate-description - completions-predicate) - (and (symbolp completions-predicate) - (symbol-name completions-predicate)) - "none")) - " "))) + '("/" + (:eval (or (completions-predicate-description completions-predicate) + (and completions-predicate + (symbolp completions-predicate) + (not (eq completions-predicate 'always)) + (symbol-name completions-predicate)) + "all")) + "/ ")) (defvar completions-header-action '(completions-action - ("action:" (:eval (cdr completions-action)) " "))) + ("+" (:eval (cdr completions-action)) "+ "))) (defvar completions-header-style '(completions-style - ("style:" - (:eval (symbol-name completions-style)) - " "))) + ("" (:eval (symbol-name completions-style)) " "))) + +(defvar completions-header-ignore-case + `(:propertize (completions-ignore-case "a" "A") + mouse-face mode-line-highlight + help-echo "Toggle case sensitivity" + keymap + ,(let ((map (make-sparse-keymap))) + (define-key map [header-line mouse-2] + (lambda (e) + (interactive "e") + (with-current-buffer + (buffer-local-value + 'completion-reference-buffer + (window-buffer (posn-window (event-end e)))) + (minibuffer-toggle-completion-ignore-case)))) + map))) (defvar completions-header-exceptional-candidates - '(completions-exceptional-candidates "~ ")) + `(:propertize (completions-exceptional-candidates "~" "!") + mouse-face mode-line-highlight + help-echo "Toggle exceptional candidates" + keymap + ,(let ((map (make-sparse-keymap))) + (define-key map [header-line mouse-2] + (lambda (e) + (interactive "e") + (with-current-buffer + (buffer-local-value + 'completion-reference-buffer + (window-buffer (posn-window (event-end e)))) + (minibuffer-toggle-exceptional-candidates)))) + map))) (defvar completions-header-extra nil) @@ -2402,16 +2429,23 @@ completions." completions-header-restriction completions-header-action completions-header-style + completions-header-ignore-case completions-header-exceptional-candidates completions-header-extra)) (put sym 'risky-local-variable t)) (defvar completions-header-format '(" " - completions-header-count completions-header-category - completions-header-order completions-header-restriction - completions-header-action completions-header-style - completions-header-exceptional-candidates completions-header-extra) + completions-header-count + completions-header-style + completions-header-category + "%b | " + completions-header-order + completions-header-restriction + completions-header-action + completions-header-ignore-case + completions-header-exceptional-candidates + (completions-header-extra (" | " completions-header-extra))) "Header line format of the *Completions* buffer.") (defun completion--insert-strings (strings &optional group-fun) @@ -3089,6 +3123,7 @@ completions list." :action action :base-position (list (+ start base-size) end) :base-affixes (list base-prefix base-suffix) + :ignore-case completion-ignore-case :insert-choice-function (let ((cprops completion-extra-properties)) (lambda (start end choice) @@ -3189,6 +3224,7 @@ PLIST is a property list with optional extra information about COMPLETIONS." completions-sort-orders (plist-get plist :sort-orders) completions-predicate (plist-get plist :predicate) completions-exceptional-candidates (plist-get plist :exceptional-candidates) + completions-ignore-case (plist-get plist :ignore-case) completions-action (plist-get plist :action))) (run-hooks 'completion-setup-hook) (display-buffer buf @@ -4228,7 +4264,7 @@ See `read-file-name' for the meaning of the arguments." (cons (lambda (cand) (eq mode (buffer-local-value 'major-mode (get-buffer cand)))) - (format "mode %s" (capitalize name))))) + (format "mode=%s" (capitalize name))))) (defun completion-buffer-name-affixation (names) "Return completion affixations for buffer name list NAMES." @@ -5661,7 +5697,7 @@ This function is the default value of variable ((symbolp cand) (symbol-name cand)) (t (car cand))))) (string-match-p regexp string))) - (concat "matching " (prin1-to-string regexp))))) + (concat "match=" (prin1-to-string regexp))))) (defun minibuffer--add-completions-predicate (pred desc) "Restrict minibuffer completions list to candidates satisfying PRED. @@ -5715,7 +5751,7 @@ exclude matches to current input from completions list." ((symbolp cand) (symbol-name cand)) (t (car cand))))) (not (gethash key table)))) - (concat "excluding matches for " (prin1-to-string current))) + (concat "remove=" (prin1-to-string current))) (minibuffer--add-completions-predicate (lambda (cand &rest _) (let ((key (cond @@ -5723,7 +5759,7 @@ exclude matches to current input from completions list." ((symbolp cand) (symbol-name cand)) (t (car cand))))) (gethash key table))) - (concat "narrowing to " (prin1-to-string current)))))) + (concat "narrow=" (prin1-to-string current)))))) (defun minibuffer-narrow-completions-to-history (&optional exclude) "EXCLUDE or keep only members of the minibuffer history as completions. @@ -5753,7 +5789,7 @@ members of the minibuffer history list." ((symbolp cand) (symbol-name cand)) (t (car cand))))) (funcall func key hist))) - (concat (when exclude "not ") "previously used")))) + (concat "used=" (if exclude "n" "y"))))) (defun minibuffer-toggle-exceptional-candidates () "Toggle display of exceptional completion candidates."