orderless-kwd.el (8346B)
1 ;;; orderless-kwd.el --- Keyword dispatcher -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2024 Free Software Foundation, Inc. 4 5 ;; Author: Daniel Mendler <mail@daniel-mendler.de> 6 ;; Created: 2024 7 8 ;; This file is part of GNU Emacs. 9 10 ;; This program is free software: you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; Provide the `orderless-kwd-dispatch' style dispatcher, which 26 ;; recognizes input of the form `:mod:org' to filter buffers by mode 27 ;; in `switch-to-buffer' or `:on' to only display enabled minor modes 28 ;; in M-x. The list of supported keywords is configured in 29 ;; `orderless-kwd-alist'. 30 ;; 31 ;; The dispatcher can be enabled by adding it to 32 ;; `orderless-style-dispatchers': 33 ;; 34 ;; (add-to-list 'orderless-style-dispatchers #'orderless-kwd-dispatch) 35 ;; 36 ;; See the customization variables `orderless-kwd-prefix' and 37 ;; `orderless-kwd-separator' in order to configure the syntax. 38 39 ;;; Code: 40 41 (require 'orderless) 42 (eval-when-compile (require 'cl-lib)) 43 44 (defcustom orderless-kwd-prefix ?: 45 "Keyword dispatcher prefix character." 46 :type 'character 47 :group 'orderless) 48 49 (defcustom orderless-kwd-separator ":=" 50 "Keyword separator characters." 51 :type 'string 52 :group 'orderless) 53 54 (defcustom orderless-kwd-alist 55 `((ann ,#'orderless-annotation) 56 (pre ,#'orderless-literal-prefix) 57 (cat ,#'orderless-kwd-category) 58 (con ,#'orderless-kwd-content) 59 (dir ,#'orderless-kwd-directory) 60 (doc ,#'orderless-kwd-documentation) 61 (grp ,#'orderless-kwd-group) 62 (mod ,#'orderless-kwd-mode) 63 (val ,#'orderless-kwd-value) 64 (dif ,#'orderless-kwd-modified t) 65 (key ,#'orderless-kwd-key t) 66 (ro ,#'orderless-kwd-read-only t) 67 (off ,#'orderless-kwd-off t) 68 (on ,#'orderless-kwd-on t)) 69 "Keyword dispatcher alist. 70 The list associates a keyword with a matcher function and an 71 optional boolean flag. If the flag is non-nil, the matcher acts 72 as a flag and does not require input." 73 :type '(alist :key-type symbol 74 :value-type (choice (list function) (list function (const t)))) 75 :group 'orderless) 76 77 (defsubst orderless-kwd--get-buffer (str) 78 "Return buffer from candidate STR taking `multi-category' into account." 79 (when-let ((cat (get-text-property 0 'multi-category str))) 80 (setq str (and (eq (car cat) 'buffer) (cdr cat)))) 81 (and str (get-buffer str))) 82 83 (defsubst orderless-kwd--orig-buffer () 84 "Return the original buffer before miniwindow selection." 85 (or (window-buffer (minibuffer-selected-window)) (current-buffer))) 86 87 (defun orderless-kwd-category (pred regexp) 88 "Match candidate category against PRED and REGEXP." 89 (lambda (str) 90 (when-let ((cat (car (get-text-property 0 'multi-category str)))) 91 (orderless--match-p pred regexp (symbol-name cat))))) 92 93 (defun orderless-kwd-group (pred regexp) 94 "Match candidate group title against PRED and REGEXP." 95 (when-let ((fun (completion-metadata-get (orderless--metadata) 96 'group-function))) 97 (lambda (str) 98 (orderless--match-p pred regexp (funcall fun str nil))))) 99 100 (defun orderless-kwd-content (_pred regexp) 101 "Match buffer content against REGEXP." 102 (lambda (str) 103 (when-let ((buf (orderless-kwd--get-buffer str))) 104 (with-current-buffer buf 105 (save-excursion 106 (save-restriction 107 (widen) 108 (goto-char (point-min)) 109 (ignore-errors (re-search-forward regexp nil 'noerror)))))))) 110 111 (defun orderless-kwd-documentation (pred regexp) 112 "Match documentation against PRED and REGEXP." 113 (lambda (str) 114 (when-let ((sym (intern-soft str))) 115 (orderless--match-p 116 pred regexp 117 (or (ignore-errors (documentation sym)) 118 (cl-loop 119 for doc in '(variable-documentation 120 face-documentation 121 group-documentation) 122 thereis (ignore-errors (documentation-property sym doc)))))))) 123 124 (defun orderless-kwd-key (pred regexp) 125 "Match command key binding against PRED and REGEXP." 126 (let ((buf (orderless-kwd--orig-buffer))) 127 (lambda (str) 128 (when-let ((sym (intern-soft str)) 129 ((fboundp sym)) 130 (keys (with-current-buffer buf (where-is-internal sym)))) 131 (cl-loop 132 for key in keys 133 thereis (orderless--match-p pred regexp (key-description key))))))) 134 135 (defun orderless-kwd-value (pred regexp) 136 "Match variable value against PRED and REGEXP." 137 (let ((buf (orderless-kwd--orig-buffer))) 138 (lambda (str) 139 (when-let ((sym (intern-soft str)) 140 ((boundp sym))) 141 (let ((print-level 10) 142 (print-length 1000)) 143 (orderless--match-p 144 pred regexp (prin1-to-string (buffer-local-value sym buf)))))))) 145 146 (defun orderless-kwd-off (_) 147 "Match disabled minor modes." 148 (let ((buf (orderless-kwd--orig-buffer))) 149 (lambda (str) 150 (when-let ((sym (intern-soft str))) 151 (and (boundp sym) 152 (memq sym minor-mode-list) 153 (not (buffer-local-value sym buf))))))) 154 155 (defun orderless-kwd-on (_) 156 "Match enabled minor modes." 157 (let ((buf (orderless-kwd--orig-buffer))) 158 (lambda (str) 159 (when-let ((sym (intern-soft str))) 160 (and (boundp sym) 161 (memq sym minor-mode-list) 162 (buffer-local-value sym buf)))))) 163 164 (defun orderless-kwd-modified (_) 165 "Match modified buffers." 166 (lambda (str) 167 (when-let ((buf (orderless-kwd--get-buffer str))) 168 (buffer-modified-p buf)))) 169 170 (defun orderless-kwd-read-only (_) 171 "Match read-only buffers." 172 (lambda (str) 173 (when-let ((buf (orderless-kwd--get-buffer str))) 174 (buffer-local-value 'buffer-read-only buf)))) 175 176 (defun orderless-kwd-mode (pred regexp) 177 "Match buffer mode or bookmark type against PRED and REGEXP." 178 (declare-function bookmark-prop-get "bookmark") 179 (lambda (str) 180 (if-let ((buf (orderless-kwd--get-buffer str))) 181 (when-let ((mode (buffer-local-value 'major-mode buf))) 182 (or (orderless--match-p pred regexp (symbol-name mode)) 183 (orderless--match-p pred regexp 184 (format-mode-line 185 (buffer-local-value 'mode-name buf))))) 186 (when-let ((name (if-let ((cat (get-text-property 0 'multi-category str))) 187 (and (eq (car cat) 'bookmark) (cdr cat)) 188 str)) 189 (bm (assoc name (bound-and-true-p bookmark-alist))) 190 (handler (or (bookmark-prop-get bm 'handler) 191 'bookmark-default-handler)) 192 ((symbolp handler))) 193 (orderless--match-p pred regexp 194 (or (get handler 'bookmark-handler-type) 195 (symbol-name handler))))))) 196 197 (defun orderless-kwd-directory (pred regexp) 198 "Match `default-directory' against PRED and REGEXP." 199 (lambda (str) 200 (when-let ((buf (orderless-kwd--get-buffer str))) 201 (orderless--match-p pred regexp 202 (buffer-local-value 'default-directory buf))))) 203 204 ;;;###autoload 205 (defun orderless-kwd-dispatch (component _index _total) 206 "Match COMPONENT against the keywords in `orderless-kwd-alist'." 207 (when (and (not (equal component "")) 208 (= (aref component 0) orderless-kwd-prefix)) 209 (if-let ((len (length component)) 210 (pos (or (string-match-p 211 (rx-to-string `(any ,orderless-kwd-separator)) 212 component 1) 213 len)) 214 (sym (intern-soft (substring component 1 pos))) 215 (style (alist-get sym orderless-kwd-alist)) 216 ((or (< (1+ pos) len) (cadr style)))) 217 (cons (car style) (substring component (min (1+ pos) len))) 218 #'ignore))) 219 220 (provide 'orderless-kwd) 221 ;;; orderless-kwd.el ends here