branch: externals/orderless
commit 9a6a9b7dfd08231123d6df18a1cf86899742e932
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@daniel-mendler.de>
Add orderless-kwd.el
---
orderless-kwd.el | 188 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 188 insertions(+)
diff --git a/orderless-kwd.el b/orderless-kwd.el
new file mode 100644
index 0000000000..a2dc9bef3b
--- /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 <m...@daniel-mendler.de>
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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
