branch: externals/orderless
commit 62b0b6dc57d7c9957d4e8d3e1c6d6a421e8f3055
Merge: 19d873b5ef 66953e9fd2
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: GitHub <nore...@github.com>
Merge pull request #169 from minad/add-kwd
Add orderless-kwd.el
---
orderless-kwd.el | 203 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 203 insertions(+)
diff --git a/orderless-kwd.el b/orderless-kwd.el
new file mode 100644
index 0000000000..8560d9bded
--- /dev/null
+++ b/orderless-kwd.el
@@ -0,0 +1,203 @@
+;;; 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 `: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'.
+;;
+;; 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)
+ (cat ,#'orderless-kwd-category)
+ (con ,#'orderless-kwd-content)
+ (dir ,#'orderless-kwd-directory)
+ (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)
+ (off ,#'orderless-kwd-off 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
+as a flag and does not require input."
+ :type '(alist :key-type symbol
+ :value-type (choice (list function) (list function (const t))))
+ :group 'orderless)
+
+(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)
+ (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--get-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."
+ (let ((buf (orderless-kwd--orig-buffer)))
+ (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."
+ (let ((buf (orderless-kwd--orig-buffer)))
+ (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 (orderless-kwd--orig-buffer)))
+ (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 (orderless-kwd--orig-buffer)))
+ (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--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--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)))))))
+
+(defun orderless-kwd-directory (pred regexp)
+ "Match `default-directory' against PRED and REGEXP."
+ (lambda (str)
+ (when-let ((buf (orderless-kwd--get-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
