From 9a6a9b7dfd08231123d6df18a1cf86899742e932 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 5 Mar 2024 18:10:30 +0100 Subject: Add orderless-kwd.el --- orderless-kwd.el | 188 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 188 insertions(+) create mode 100644 orderless-kwd.el diff --git a/orderless-kwd.el b/orderless-kwd.el new file mode 100644 index 0000000..a2dc9be --- /dev/null +++ b/orderless-kwd.el @@ -0,0 +1,188 @@ +;;; orderless-kwd.el --- Keyword dispatcher -*- lexical-binding: t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc. + +;; Author: Daniel Mendler +;; Created: 2024 + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; Provide the `orderless-kwd-dispatch' style dispatcher, which +;; recognizes input of the form `:mode:org' to filter buffers by mode +;; in `switch-to-buffer' or `:on' to only display enabled minor modes +;; in M-x. The list of supported keywords is configured in +;; `orderless-kwd-alist'. +;; +;; The dispatcher can be enabled by adding it to +;; `orderless-style-dispatchers': +;; +;; (add-to-list 'orderless-style-dispatchers #'orderless-kwd-dispatch) +;; +;; See the customization variables `orderless-kwd-prefix' and +;; `orderless-kwd-separator' in order to configure the syntax. + +;;; Code: + +(require 'orderless) +(eval-when-compile (require 'cl-lib)) + +(defcustom orderless-kwd-prefix ?: + "Keyword dispatcher prefix character." + :type 'character + :group 'orderless) + +(defcustom orderless-kwd-separator ":=" + "Keyword separator characters." + :type 'string + :group 'orderless) + +(defcustom orderless-kwd-alist + `((ann ,#'orderless-annotation) + (pre ,#'orderless-literal-prefix) + (mode ,#'orderless-kwd-mode) + (content ,#'orderless-kwd-content) + (doc ,#'orderless-kwd-documentation) + (dir ,#'orderless-kwd-directory) + (cat ,#'orderless-kwd-category) + (group ,#'orderless-kwd-group) + (val ,#'orderless-kwd-value) + (key ,#'orderless-kwd-key t) + (on ,#'orderless-kwd-on t) + (off ,#'orderless-kwd-off t) + (mod ,#'orderless-kwd-modified t)) + "Keyword dispatcher alist." + :type '(alist :key-type symbol + :value-type (choice (list function) (list function (const t)))) + :group 'orderless) + +(defsubst orderless-kwd--buffer (str) + "Return buffer from candidate STR." + (get-buffer (or (cdr (get-text-property 0 'multi-category str)) str))) + +(defun orderless-kwd-category (pred regexp) + "Match candidate category against PRED and REGEXP." + (lambda (str) + (when-let ((cat (car (get-text-property 0 'multi-category str)))) + (orderless--match-p pred regexp (symbol-name cat))))) + +(defun orderless-kwd-group (pred regexp) + "Match candidate group title against PRED and REGEXP." + (when-let ((fun (completion-metadata-get (orderless--metadata) 'group-function))) + (lambda (str) + (orderless--match-p pred regexp (funcall fun str nil))))) + +(defun orderless-kwd-content (_pred regexp) + "Match buffer content against REGEXP." + (lambda (str) + (when-let ((buf (orderless-kwd--buffer str))) + (with-current-buffer buf + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (ignore-errors (re-search-forward regexp nil 'noerror)))))))) + +(defun orderless-kwd-documentation (pred regexp) + "Match documentation against PRED and REGEXP." + (lambda (str) + (when-let ((sym (intern-soft str))) + (orderless--match-p + pred regexp + (or (ignore-errors (documentation sym)) + (cl-loop + for doc in '(variable-documentation + face-documentation + group-documentation) + thereis (ignore-errors (documentation-property sym doc)))))))) + +(defun orderless-kwd-key (pred regexp) + "Match command key binding against PRED and REGEXP." + (lambda (str) + (when-let ((sym (intern-soft str)) + ((fboundp sym)) + (keys (where-is-internal sym))) + (cl-loop for key in keys + thereis (orderless--match-p pred regexp (key-description key)))))) + +(defun orderless-kwd-value (pred regexp) + "Match variable value against PRED and REGEXP." + (let ((buf (or (window-buffer (minibuffer-selected-window))))) + (lambda (str) + (when-let ((sym (intern-soft str)) + ((boundp sym))) + (let ((print-level 10) + (print-length 1000)) + (orderless--match-p + pred regexp (prin1-to-string (buffer-local-value sym buf)))))))) + +(defun orderless-kwd-off (_) + "Match disabled minor modes." + (let ((buf (or (window-buffer (minibuffer-selected-window))))) + (lambda (str) + (when-let ((sym (intern-soft str))) + (and (boundp sym) + (memq sym minor-mode-list) + (not (buffer-local-value sym buf))))))) + +(defun orderless-kwd-on (_) + "Match enabled minor modes." + (let ((buf (or (window-buffer (minibuffer-selected-window))))) + (lambda (str) + (when-let ((sym (intern-soft str))) + (and (boundp sym) + (memq sym minor-mode-list) + (buffer-local-value sym buf)))))) + +(defun orderless-kwd-modified (_) + "Match modified buffers." + (lambda (str) + (when-let ((buf (orderless-kwd--buffer str))) + (buffer-modified-p buf)))) + +(defun orderless-kwd-mode (pred regexp) + "Match buffer mode name against PRED and REGEXP." + (lambda (str) + (when-let ((buf (orderless-kwd--buffer str)) + (mode (buffer-local-value 'major-mode buf))) + (or (orderless--match-p pred regexp (symbol-name mode)) + (orderless--match-p pred regexp (format-mode-line + (buffer-local-value 'mode-name buf))))))) + +(defun orderless-kwd-directory (pred regexp) + "Match `default-directory' against PRED and REGEXP." + (lambda (str) + (when-let ((buf (orderless-kwd--buffer str))) + (orderless--match-p pred regexp + (buffer-local-value 'default-directory buf))))) + +;;;###autoload +(defun orderless-kwd-dispatch (component _index _total) + "Match COMPONENT against the keywords in `orderless-kwd-alist'." + (when (and (not (equal component "")) (= (aref component 0) orderless-kwd-prefix)) + (if-let ((len (length component)) + (pos (or (string-match-p (rx-to-string `(any ,orderless-kwd-separator)) + component 1) + len)) + (sym (intern-soft (substring component 1 pos))) + (style (alist-get sym orderless-kwd-alist)) + ((or (< (1+ pos) len) (cadr style)))) + (cons (car style) (substring component (min (1+ pos) len))) + #'ignore))) + +(provide 'orderless-kwd) +;;; orderless-kwd.el ends here -- cgit v1.0 From d317ab78e437ebe27f65056ac68bc379e1f56ea3 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 5 Mar 2024 18:25:17 +0100 Subject: orderless-kwd-key: Perform lookup in minibuffer-selected-window --- orderless-kwd.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/orderless-kwd.el b/orderless-kwd.el index a2dc9be..0b92ef7 100644 --- a/orderless-kwd.el +++ b/orderless-kwd.el @@ -112,12 +112,13 @@ (defun orderless-kwd-key (pred regexp) "Match command key binding against PRED and REGEXP." - (lambda (str) - (when-let ((sym (intern-soft str)) - ((fboundp sym)) - (keys (where-is-internal sym))) - (cl-loop for key in keys - thereis (orderless--match-p pred regexp (key-description key)))))) + (let ((buf (or (window-buffer (minibuffer-selected-window))))) + (lambda (str) + (when-let ((sym (intern-soft str)) + ((fboundp sym)) + (keys (with-current-buffer buf (where-is-internal sym)))) + (cl-loop for key in keys + thereis (orderless--match-p pred regexp (key-description key))))))) (defun orderless-kwd-value (pred regexp) "Match variable value against PRED and REGEXP." -- cgit v1.0 From 2f8573f3adca5cd45ea899389b31b8bb77acdd4d Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 5 Mar 2024 18:32:00 +0100 Subject: orderless-kwd--buffer: Check category=buffer --- orderless-kwd.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/orderless-kwd.el b/orderless-kwd.el index 0b92ef7..686afa1 100644 --- a/orderless-kwd.el +++ b/orderless-kwd.el @@ -72,7 +72,9 @@ (defsubst orderless-kwd--buffer (str) "Return buffer from candidate STR." - (get-buffer (or (cdr (get-text-property 0 'multi-category str)) str))) + (when-let ((cat (get-text-property 0 'multi-category str))) + (setq str (and (eq (car cat) 'buffer) (cdr cat)))) + (and str (get-buffer str))) (defun orderless-kwd-category (pred regexp) "Match candidate category against PRED and REGEXP." -- cgit v1.0 From 52b533329d39c1d4f520a47e477d7bc0242325b2 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 5 Mar 2024 18:33:22 +0100 Subject: Use window-buffer or current-buffer --- orderless-kwd.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/orderless-kwd.el b/orderless-kwd.el index 686afa1..f6c1c72 100644 --- a/orderless-kwd.el +++ b/orderless-kwd.el @@ -114,7 +114,7 @@ (defun orderless-kwd-key (pred regexp) "Match command key binding against PRED and REGEXP." - (let ((buf (or (window-buffer (minibuffer-selected-window))))) + (let ((buf (or (window-buffer (minibuffer-selected-window)) (current-buffer)))) (lambda (str) (when-let ((sym (intern-soft str)) ((fboundp sym)) @@ -124,7 +124,7 @@ (defun orderless-kwd-value (pred regexp) "Match variable value against PRED and REGEXP." - (let ((buf (or (window-buffer (minibuffer-selected-window))))) + (let ((buf (or (window-buffer (minibuffer-selected-window)) (current-buffer)))) (lambda (str) (when-let ((sym (intern-soft str)) ((boundp sym))) @@ -135,7 +135,7 @@ (defun orderless-kwd-off (_) "Match disabled minor modes." - (let ((buf (or (window-buffer (minibuffer-selected-window))))) + (let ((buf (or (window-buffer (minibuffer-selected-window)) (current-buffer)))) (lambda (str) (when-let ((sym (intern-soft str))) (and (boundp sym) @@ -144,7 +144,7 @@ (defun orderless-kwd-on (_) "Match enabled minor modes." - (let ((buf (or (window-buffer (minibuffer-selected-window))))) + (let ((buf (or (window-buffer (minibuffer-selected-window)) (current-buffer)))) (lambda (str) (when-let ((sym (intern-soft str))) (and (boundp sym) -- cgit v1.0 From e015ac24ef6ad89615590df924d5c4c853bb7c11 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 5 Mar 2024 18:38:03 +0100 Subject: Add orderless-kwd--orig-buffer helper --- orderless-kwd.el | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/orderless-kwd.el b/orderless-kwd.el index f6c1c72..312a0ba 100644 --- a/orderless-kwd.el +++ b/orderless-kwd.el @@ -70,12 +70,16 @@ :value-type (choice (list function) (list function (const t)))) :group 'orderless) -(defsubst orderless-kwd--buffer (str) - "Return buffer from candidate STR." +(defsubst orderless-kwd--get-buffer (str) + "Return buffer from candidate STR taking `multi-category' into account." (when-let ((cat (get-text-property 0 'multi-category str))) (setq str (and (eq (car cat) 'buffer) (cdr cat)))) (and str (get-buffer str))) +(defsubst orderless-kwd--orig-buffer () + "Return the original buffer before miniwindow selection." + (or (window-buffer (minibuffer-selected-window)) (current-buffer))) + (defun orderless-kwd-category (pred regexp) "Match candidate category against PRED and REGEXP." (lambda (str) @@ -91,7 +95,7 @@ (defun orderless-kwd-content (_pred regexp) "Match buffer content against REGEXP." (lambda (str) - (when-let ((buf (orderless-kwd--buffer str))) + (when-let ((buf (orderless-kwd--get-buffer str))) (with-current-buffer buf (save-excursion (save-restriction @@ -114,7 +118,7 @@ (defun orderless-kwd-key (pred regexp) "Match command key binding against PRED and REGEXP." - (let ((buf (or (window-buffer (minibuffer-selected-window)) (current-buffer)))) + (let ((buf (orderless-kwd--orig-buffer))) (lambda (str) (when-let ((sym (intern-soft str)) ((fboundp sym)) @@ -124,7 +128,7 @@ (defun orderless-kwd-value (pred regexp) "Match variable value against PRED and REGEXP." - (let ((buf (or (window-buffer (minibuffer-selected-window)) (current-buffer)))) + (let ((buf (orderless-kwd--orig-buffer))) (lambda (str) (when-let ((sym (intern-soft str)) ((boundp sym))) @@ -135,7 +139,7 @@ (defun orderless-kwd-off (_) "Match disabled minor modes." - (let ((buf (or (window-buffer (minibuffer-selected-window)) (current-buffer)))) + (let ((buf (orderless-kwd--orig-buffer))) (lambda (str) (when-let ((sym (intern-soft str))) (and (boundp sym) @@ -144,7 +148,7 @@ (defun orderless-kwd-on (_) "Match enabled minor modes." - (let ((buf (or (window-buffer (minibuffer-selected-window)) (current-buffer)))) + (let ((buf (orderless-kwd--orig-buffer))) (lambda (str) (when-let ((sym (intern-soft str))) (and (boundp sym) @@ -154,13 +158,13 @@ (defun orderless-kwd-modified (_) "Match modified buffers." (lambda (str) - (when-let ((buf (orderless-kwd--buffer str))) + (when-let ((buf (orderless-kwd--get-buffer str))) (buffer-modified-p buf)))) (defun orderless-kwd-mode (pred regexp) "Match buffer mode name against PRED and REGEXP." (lambda (str) - (when-let ((buf (orderless-kwd--buffer str)) + (when-let ((buf (orderless-kwd--get-buffer str)) (mode (buffer-local-value 'major-mode buf))) (or (orderless--match-p pred regexp (symbol-name mode)) (orderless--match-p pred regexp (format-mode-line @@ -169,7 +173,7 @@ (defun orderless-kwd-directory (pred regexp) "Match `default-directory' against PRED and REGEXP." (lambda (str) - (when-let ((buf (orderless-kwd--buffer str))) + (when-let ((buf (orderless-kwd--get-buffer str))) (orderless--match-p pred regexp (buffer-local-value 'default-directory buf))))) -- cgit v1.0 From a020db0a840ba0a1db01eba8168974c416fb548d Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 5 Mar 2024 18:47:45 +0100 Subject: orderless-kwd-alist: Expand docstring --- orderless-kwd.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/orderless-kwd.el b/orderless-kwd.el index 312a0ba..ac8df33 100644 --- a/orderless-kwd.el +++ b/orderless-kwd.el @@ -65,7 +65,10 @@ (on ,#'orderless-kwd-on t) (off ,#'orderless-kwd-off t) (mod ,#'orderless-kwd-modified t)) - "Keyword dispatcher alist." + "Keyword dispatcher alist. +The list associates a keyword with a matcher function and an +optional boolean flag. If the flag is non-nil, the matcher acts +as a flag and does not require input." :type '(alist :key-type symbol :value-type (choice (list function) (list function (const t)))) :group 'orderless) -- cgit v1.0 From f8153f78edbf02d2bfe6190041deff24ee15cec0 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 5 Mar 2024 19:52:16 +0100 Subject: orderless-kwd-alist: Shorten keywords --- orderless-kwd.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/orderless-kwd.el b/orderless-kwd.el index ac8df33..6eeb4f6 100644 --- a/orderless-kwd.el +++ b/orderless-kwd.el @@ -23,7 +23,7 @@ ;;; Commentary: ;; Provide the `orderless-kwd-dispatch' style dispatcher, which -;; recognizes input of the form `:mode:org' to filter buffers by mode +;; recognizes input of the form `:mod:org' to filter buffers by mode ;; in `switch-to-buffer' or `:on' to only display enabled minor modes ;; in M-x. The list of supported keywords is configured in ;; `orderless-kwd-alist'. @@ -52,19 +52,19 @@ :group 'orderless) (defcustom orderless-kwd-alist - `((ann ,#'orderless-annotation) - (pre ,#'orderless-literal-prefix) - (mode ,#'orderless-kwd-mode) - (content ,#'orderless-kwd-content) - (doc ,#'orderless-kwd-documentation) - (dir ,#'orderless-kwd-directory) - (cat ,#'orderless-kwd-category) - (group ,#'orderless-kwd-group) - (val ,#'orderless-kwd-value) - (key ,#'orderless-kwd-key t) - (on ,#'orderless-kwd-on t) - (off ,#'orderless-kwd-off t) - (mod ,#'orderless-kwd-modified t)) + `((ann ,#'orderless-annotation) + (pre ,#'orderless-literal-prefix) + (mod ,#'orderless-kwd-mode) + (con ,#'orderless-kwd-content) + (doc ,#'orderless-kwd-documentation) + (dir ,#'orderless-kwd-directory) + (cat ,#'orderless-kwd-category) + (grp ,#'orderless-kwd-group) + (val ,#'orderless-kwd-value) + (key ,#'orderless-kwd-key t) + (on ,#'orderless-kwd-on t) + (off ,#'orderless-kwd-off t) + (dif ,#'orderless-kwd-modified t)) "Keyword dispatcher alist. The list associates a keyword with a matcher function and an optional boolean flag. If the flag is non-nil, the matcher acts -- cgit v1.0 From 234c0397bcb976cf64026e9c4d385d5b214c562a Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 5 Mar 2024 19:53:15 +0100 Subject: orderless-kwd-alist: Sort list --- orderless-kwd.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/orderless-kwd.el b/orderless-kwd.el index 6eeb4f6..9d94b8b 100644 --- a/orderless-kwd.el +++ b/orderless-kwd.el @@ -54,17 +54,17 @@ (defcustom orderless-kwd-alist `((ann ,#'orderless-annotation) (pre ,#'orderless-literal-prefix) - (mod ,#'orderless-kwd-mode) + (cat ,#'orderless-kwd-category) (con ,#'orderless-kwd-content) - (doc ,#'orderless-kwd-documentation) (dir ,#'orderless-kwd-directory) - (cat ,#'orderless-kwd-category) + (doc ,#'orderless-kwd-documentation) (grp ,#'orderless-kwd-group) + (mod ,#'orderless-kwd-mode) (val ,#'orderless-kwd-value) + (dif ,#'orderless-kwd-modified t) (key ,#'orderless-kwd-key t) - (on ,#'orderless-kwd-on t) (off ,#'orderless-kwd-off t) - (dif ,#'orderless-kwd-modified t)) + (on ,#'orderless-kwd-on t)) "Keyword dispatcher alist. The list associates a keyword with a matcher function and an optional boolean flag. If the flag is non-nil, the matcher acts -- cgit v1.0 From 66953e9fd23d9d9d6f5c931d41b8eb41dac6dd8d Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 5 Mar 2024 19:55:17 +0100 Subject: orderless-kwd: Shorten lines --- orderless-kwd.el | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/orderless-kwd.el b/orderless-kwd.el index 9d94b8b..8560d9b 100644 --- a/orderless-kwd.el +++ b/orderless-kwd.el @@ -91,7 +91,8 @@ as a flag and does not require input." (defun orderless-kwd-group (pred regexp) "Match candidate group title against PRED and REGEXP." - (when-let ((fun (completion-metadata-get (orderless--metadata) 'group-function))) + (when-let ((fun (completion-metadata-get (orderless--metadata) + 'group-function))) (lambda (str) (orderless--match-p pred regexp (funcall fun str nil))))) @@ -126,8 +127,9 @@ as a flag and does not require input." (when-let ((sym (intern-soft str)) ((fboundp sym)) (keys (with-current-buffer buf (where-is-internal sym)))) - (cl-loop for key in keys - thereis (orderless--match-p pred regexp (key-description key))))))) + (cl-loop + for key in keys + thereis (orderless--match-p pred regexp (key-description key))))))) (defun orderless-kwd-value (pred regexp) "Match variable value against PRED and REGEXP." @@ -170,8 +172,9 @@ as a flag and does not require input." (when-let ((buf (orderless-kwd--get-buffer str)) (mode (buffer-local-value 'major-mode buf))) (or (orderless--match-p pred regexp (symbol-name mode)) - (orderless--match-p pred regexp (format-mode-line - (buffer-local-value 'mode-name buf))))))) + (orderless--match-p + pred regexp + (format-mode-line (buffer-local-value 'mode-name buf))))))) (defun orderless-kwd-directory (pred regexp) "Match `default-directory' against PRED and REGEXP." @@ -183,10 +186,12 @@ as a flag and does not require input." ;;;###autoload (defun orderless-kwd-dispatch (component _index _total) "Match COMPONENT against the keywords in `orderless-kwd-alist'." - (when (and (not (equal component "")) (= (aref component 0) orderless-kwd-prefix)) + (when (and (not (equal component "")) + (= (aref component 0) orderless-kwd-prefix)) (if-let ((len (length component)) - (pos (or (string-match-p (rx-to-string `(any ,orderless-kwd-separator)) - component 1) + (pos (or (string-match-p + (rx-to-string `(any ,orderless-kwd-separator)) + component 1) len)) (sym (intern-soft (substring component 1 pos))) (style (alist-get sym orderless-kwd-alist)) -- cgit v1.0