orderless-kwd.el (8662B)
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 (fil ,#'orderless-kwd-file) 61 (doc ,#'orderless-kwd-documentation) 62 (grp ,#'orderless-kwd-group) 63 (mod ,#'orderless-kwd-mode) 64 (val ,#'orderless-kwd-value) 65 (dif ,#'orderless-kwd-modified t) 66 (key ,#'orderless-kwd-key t) 67 (ro ,#'orderless-kwd-read-only t) 68 (off ,#'orderless-kwd-off t) 69 (on ,#'orderless-kwd-on t)) 70 "Keyword dispatcher alist. 71 The list associates a keyword with a matcher function and an 72 optional boolean flag. If the flag is non-nil, the matcher acts 73 as a flag and does not require input." 74 :type '(alist :key-type symbol 75 :value-type (choice (list function) (list function (const t)))) 76 :group 'orderless) 77 78 (defsubst orderless-kwd--get-buffer (str) 79 "Return buffer from candidate STR taking `multi-category' into account." 80 (when-let ((cat (get-text-property 0 'multi-category str))) 81 (setq str (and (eq (car cat) 'buffer) (cdr cat)))) 82 (and str (get-buffer str))) 83 84 (defsubst orderless-kwd--orig-buffer () 85 "Return the original buffer before miniwindow selection." 86 (or (window-buffer (minibuffer-selected-window)) (current-buffer))) 87 88 (defun orderless-kwd-category (pred regexp) 89 "Match candidate category against PRED and REGEXP." 90 (lambda (str) 91 (when-let ((cat (car (get-text-property 0 'multi-category str)))) 92 (orderless--match-p pred regexp (symbol-name cat))))) 93 94 (defun orderless-kwd-group (pred regexp) 95 "Match candidate group title against PRED and REGEXP." 96 (when-let ((fun (compat-call completion-metadata-get 97 (orderless--metadata) 'group-function))) 98 (lambda (str) 99 (orderless--match-p pred regexp (funcall fun str nil))))) 100 101 (defun orderless-kwd-content (_pred regexp) 102 "Match buffer content against REGEXP." 103 (lambda (str) 104 (when-let ((buf (orderless-kwd--get-buffer str))) 105 (with-current-buffer buf 106 (save-excursion 107 (save-restriction 108 (widen) 109 (goto-char (point-min)) 110 (ignore-errors (re-search-forward regexp nil 'noerror)))))))) 111 112 (defun orderless-kwd-documentation (pred regexp) 113 "Match documentation against PRED and REGEXP." 114 (lambda (str) 115 (when-let ((sym (intern-soft str))) 116 (orderless--match-p 117 pred regexp 118 (or (ignore-errors (documentation sym)) 119 (cl-loop 120 for doc in '(variable-documentation 121 face-documentation 122 group-documentation) 123 thereis (ignore-errors (documentation-property sym doc)))))))) 124 125 (defun orderless-kwd-key (pred regexp) 126 "Match command key binding against PRED and REGEXP." 127 (let ((buf (orderless-kwd--orig-buffer))) 128 (lambda (str) 129 (when-let ((sym (intern-soft str)) 130 ((fboundp sym)) 131 (keys (with-current-buffer buf (where-is-internal sym)))) 132 (cl-loop 133 for key in keys 134 thereis (orderless--match-p pred regexp (key-description key))))))) 135 136 (defun orderless-kwd-value (pred regexp) 137 "Match variable value against PRED and REGEXP." 138 (let ((buf (orderless-kwd--orig-buffer))) 139 (lambda (str) 140 (when-let ((sym (intern-soft str)) 141 ((boundp sym))) 142 (let ((print-level 10) 143 (print-length 1000)) 144 (orderless--match-p 145 pred regexp (prin1-to-string (buffer-local-value sym buf)))))))) 146 147 (defun orderless-kwd-off (_) 148 "Match disabled minor modes." 149 (let ((buf (orderless-kwd--orig-buffer))) 150 (lambda (str) 151 (when-let ((sym (intern-soft str))) 152 (and (boundp sym) 153 (memq sym minor-mode-list) 154 (not (buffer-local-value sym buf))))))) 155 156 (defun orderless-kwd-on (_) 157 "Match enabled minor modes." 158 (let ((buf (orderless-kwd--orig-buffer))) 159 (lambda (str) 160 (when-let ((sym (intern-soft str))) 161 (and (boundp sym) 162 (memq sym minor-mode-list) 163 (buffer-local-value sym buf)))))) 164 165 (defun orderless-kwd-modified (_) 166 "Match modified buffers." 167 (lambda (str) 168 (when-let ((buf (orderless-kwd--get-buffer str))) 169 (buffer-modified-p buf)))) 170 171 (defun orderless-kwd-read-only (_) 172 "Match read-only buffers." 173 (lambda (str) 174 (when-let ((buf (orderless-kwd--get-buffer str))) 175 (buffer-local-value 'buffer-read-only buf)))) 176 177 (defun orderless-kwd-mode (pred regexp) 178 "Match buffer mode or bookmark type against PRED and REGEXP." 179 (declare-function bookmark-prop-get "bookmark") 180 (lambda (str) 181 (if-let ((buf (orderless-kwd--get-buffer str))) 182 (when-let ((mode (buffer-local-value 'major-mode buf))) 183 (or (orderless--match-p pred regexp (symbol-name mode)) 184 (orderless--match-p pred regexp 185 (format-mode-line 186 (buffer-local-value 'mode-name buf))))) 187 (when-let ((name (if-let ((cat (get-text-property 0 'multi-category str))) 188 (and (eq (car cat) 'bookmark) (cdr cat)) 189 str)) 190 (bm (assoc name (bound-and-true-p bookmark-alist))) 191 (handler (or (bookmark-prop-get bm 'handler) 192 'bookmark-default-handler)) 193 ((symbolp handler))) 194 (orderless--match-p pred regexp 195 (or (get handler 'bookmark-handler-type) 196 (symbol-name handler))))))) 197 198 (defun orderless-kwd-directory (pred regexp) 199 "Match `default-directory' against PRED and REGEXP." 200 (lambda (str) 201 (when-let ((buf (orderless-kwd--get-buffer str))) 202 (orderless--match-p pred regexp 203 (buffer-local-value 'default-directory buf))))) 204 205 (defun orderless-kwd-file (pred regexp) 206 "Match `buffer-file-truename' against PRED and REGEXP." 207 (lambda (str) 208 (when-let ((buf (orderless-kwd--get-buffer str))) 209 (orderless--match-p pred regexp 210 (buffer-local-value 'buffer-file-truename buf))))) 211 212 ;;;###autoload 213 (defun orderless-kwd-dispatch (component _index _total) 214 "Match COMPONENT against the keywords in `orderless-kwd-alist'." 215 (when (and (not (equal component "")) 216 (= (aref component 0) orderless-kwd-prefix)) 217 (if-let ((len (length component)) 218 (pos (or (string-match-p 219 (rx-to-string `(any ,orderless-kwd-separator)) 220 component 1) 221 len)) 222 (sym (intern-soft (substring component 1 pos))) 223 (style (alist-get sym orderless-kwd-alist)) 224 ((or (< (1+ pos) len) (cadr style)))) 225 (cons (car style) (substring component (min (1+ pos) len))) 226 #'ignore))) 227 228 (provide 'orderless-kwd) 229 ;;; orderless-kwd.el ends here