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