]> git.eshelyaron.com Git - emacs.git/commitdiff
Improve default *Completions* header line format
authorEshel Yaron <me@eshelyaron.com>
Mon, 18 Mar 2024 08:06:50 +0000 (09:06 +0100)
committerEshel Yaron <me@eshelyaron.com>
Mon, 18 Mar 2024 08:06:50 +0000 (09:06 +0100)
lisp/bookmark.el
lisp/international/mule-cmds.el
lisp/minibuffer.el

index 38f579e9fa64910b321a15dee2dc13014e8a134b..b9668099d9ca985331c190924aa7e3fc38e59afb 100644 (file)
@@ -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
index 75c9f9383446eabd86952c25bd3dc1db8aeea411..0201164ba5530d469648035a98095d2d2e9879e5 100644 (file)
@@ -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 "no" desc))
+         (concat "no-" desc))
       (cons
        (lambda (_name char)
          (memq (get-char-code-property char 'general-category) cats))
index 892a5613c7996865a50129d8fc705313920918a4..ec2411da0090dbfc8111eac7e42d1d26eb0c5580 100644 (file)
@@ -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."