1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
;;; orderless-kwd.el --- Keyword dispatcher -*- lexical-binding: t -*-
;; Copyright (C) 2024 Free Software Foundation, Inc.
;; Author: Daniel Mendler <mail@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)
(mod ,#'orderless-kwd-mode)
(con ,#'orderless-kwd-content)
(doc ,#'orderless-kwd-documentation)
(dir ,#'orderless-kwd-directory)
(cat ,#'orderless-kwd-category)
(grp ,#'orderless-kwd-group)
(val ,#'orderless-kwd-value)
(key ,#'orderless-kwd-key t)
(on ,#'orderless-kwd-on t)
(off ,#'orderless-kwd-off t)
(dif ,#'orderless-kwd-modified 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
|
