28
28
29
29
; ;; Code:
30
30
31
- ; ;;; Requirements
31
+ ( eval-and-compile
32
32
33
- (require 'org )
33
+ (eval-when-compile
34
+ ; ; Require these when compiling, but not necessarily on load.
35
+ (require 'org )
34
36
35
- (require 'org-ql )
36
- (require 'org-ql-search )
37
-
38
- ; ; (require 'helm)
39
- ; ; (require 'helm-org)
37
+ (require 'org-ql )
38
+ (require 'org-ql-search ))
40
39
41
40
; ;;; Compatibility
42
41
43
- ; ; Declare Helm functions since Helm may not be installed.
44
- (declare-function helm " ext:helm" )
45
- (declare-function helm-run-after-exit " ext:helm" )
46
- (declare-function helm-window " ext:helm-lib" )
47
- (declare-function helm-buffer-get " ext:helm-lib" )
48
- (declare-function helm-make-source " ext:helm-source" )
49
- (declare-function helm-org-goto-marker " ext:helm-org" )
42
+ ; ; Declare Helm functions since Helm may not be installed.
43
+ (declare-function helm " ext:helm" )
44
+ (declare-function helm-run-after-exit " ext:helm" )
45
+ (declare-function helm-window " ext:helm-lib" )
46
+ (declare-function helm-buffer-get " ext:helm-lib" )
47
+ (declare-function helm-make-source " ext:helm-source" )
48
+ (declare-function helm-org-goto-marker " ext:helm-org" )
49
+
50
+ ; ; Silence byte-compiler about variables.
51
+ (defvar helm-map )
52
+ (defvar helm-pattern )
53
+ (defvar helm-input-idle-delay )
54
+
55
+ (when (require 'helm nil 'noerror )
50
56
51
- ; ; Silence byte-compiler about variables.
52
- (defvar helm-map )
53
- (defvar helm-pattern )
54
- (defvar helm-input-idle-delay )
57
+ ; ; Requirements.
58
+ (require 'helm-org )
55
59
56
60
; ;;; Variables
57
61
58
- (defvar helm-org-ql-map
59
- (let ((map (make-sparse-keymap ))
60
- (mappings '(
61
- " C-x C-s" helm-org-ql-save
62
- )))
63
- (cl-loop for (key fn) on mappings by #'cddr
64
- do (define-key map (kbd key) fn))
65
- (make-composed-keymap map helm-map))
66
- " Keymap for `helm-org-ql' sessions.
62
+ (defvar helm-org-ql-map
63
+ (let ((map (make-sparse-keymap ))
64
+ (mappings '(" C-x C-s" helm-org-ql-save)))
65
+ (cl-loop for (key fn) on mappings by #'cddr
66
+ do (define-key map (kbd key) fn))
67
+ (make-composed-keymap map helm-map))
68
+ " Keymap for `helm-org-ql' sessions.
67
69
Based on `helm-map' ." )
68
70
69
- (defvar helm-source-org-ql-views
70
- (helm-make-source " Org QL Views" 'helm-source-sync
71
- :candidates (lambda ()
72
- (->> org-ql-views
73
- (-map #'car )
74
- (-sort #'string< )))
75
- :action (list (cons " Show view" #'org-ql-view )))
76
- " Helm source for `org-ql-views' ." )
71
+ (defvar helm-source-org-ql-views
72
+ (helm-make-source " Org QL Views" 'helm-source-sync
73
+ :candidates (lambda ()
74
+ (->> org-ql-views
75
+ (-map #'car )
76
+ (-sort #'string< )))
77
+ :action (list (cons " Show view" #'org-ql-view )))
78
+ " Helm source for `org-ql-views' ." )
77
79
78
- (defvar-local helm-org-ql-buffers-files nil
79
- " Used for `helm-org-ql-save' ." )
80
+ (defvar-local helm-org-ql-buffers-files nil
81
+ " Used for `helm-org-ql-save' ." )
80
82
81
83
; ;;; Customization
82
84
83
- (defgroup helm-org-ql nil
84
- " Options for `helm-org-ql' ."
85
- :group 'org-ql )
85
+ (defgroup helm-org-ql nil
86
+ " Options for `helm-org-ql' ."
87
+ :group 'org-ql )
86
88
87
- (defcustom helm-org-ql-reverse-paths t
88
- " Whether to reverse Org outline paths in `helm-org-ql' results."
89
- :type 'boolean )
89
+ (defcustom helm-org-ql-reverse-paths t
90
+ " Whether to reverse Org outline paths in `helm-org-ql' results."
91
+ :type 'boolean )
90
92
91
- (defcustom helm-org-ql-input-idle-delay 0.25
92
- " Seconds to wait after typing stops before running query."
93
- :type 'number )
93
+ (defcustom helm-org-ql-input-idle-delay 0.25
94
+ " Seconds to wait after typing stops before running query."
95
+ :type 'number )
94
96
95
- (defcustom helm-org-ql-actions
96
- (list (cons " Show heading in source buffer" 'helm-org-ql-show-marker )
97
- (cons " Show heading in indirect buffer" 'helm-org-ql-show-marker-indirect ))
98
- " Alist of actions for `helm-org-ql' commands."
99
- :type '(alist :key-type (string :tag " Description" )
100
- :value-type (function :tag " Command" )))
97
+ (defcustom helm-org-ql-actions
98
+ (list (cons " Show heading in source buffer" 'helm-org-ql-show-marker )
99
+ (cons " Show heading in indirect buffer" 'helm-org-ql-show-marker-indirect ))
100
+ " Alist of actions for `helm-org-ql' commands."
101
+ :type '(alist :key-type (string :tag " Description" )
102
+ :value-type (function :tag " Command" )))
101
103
102
104
; ;;; Commands
103
105
104
106
;;;### autoload
105
- (cl-defun helm-org-ql (buffers-files
106
- &key (boolean 'and ) (name " helm-org-ql" ))
107
- " Display results in BUFFERS-FILES for an `org-ql' non-sexp query using Helm.
107
+ (cl-defun helm-org-ql (buffers-files
108
+ &key (boolean 'and ) (name " helm-org-ql" ))
109
+ " Display results in BUFFERS-FILES for an `org-ql' non-sexp query using Helm.
108
110
Interactively, search the current buffer. Note that this command
109
111
only accepts non-sexp, \" plain\" queries.
110
112
@@ -131,99 +133,99 @@ However, quoted strings remain quoted, so this input:
131
133
Is transformed into this query:
132
134
133
135
(and \" something else\" (tags \" funny\" ))"
134
- (interactive (list (current-buffer )))
135
- (let ((boolean (if current-prefix-arg 'or boolean))
136
- (helm-input-idle-delay helm-org-ql-input-idle-delay))
137
- (helm :prompt (format " Query (boolean %s ): " (-> boolean symbol-name upcase))
138
- :sources (helm-org-ql-source buffers-files :name name))))
136
+ (interactive (list (current-buffer )))
137
+ (let ((boolean (if current-prefix-arg 'or boolean))
138
+ (helm-input-idle-delay helm-org-ql-input-idle-delay))
139
+ (helm :prompt (format " Query (boolean %s ): " (-> boolean symbol-name upcase))
140
+ :sources (helm-org-ql-source buffers-files :name name))))
139
141
140
142
;;;### autoload
141
- (defun helm-org-ql-agenda-files ()
142
- " Search agenda files with `helm-org-ql' , which see."
143
- (interactive )
144
- (helm-org-ql (org-agenda-files ) :name " Org Agenda Files" ))
143
+ (defun helm-org-ql-agenda-files ()
144
+ " Search agenda files with `helm-org-ql' , which see."
145
+ (interactive )
146
+ (helm-org-ql (org-agenda-files ) :name " Org Agenda Files" ))
145
147
146
148
;;;### autoload
147
- (defun helm-org-ql-org-directory ()
148
- " Search Org files in `org-directory' with `helm-org-ql' ."
149
- (interactive )
150
- (helm-org-ql (org-ql-search-directories-files)
151
- :name " Org Directory Files" ))
152
-
153
- (defun helm-org-ql-show-marker (marker )
154
- " Show heading at MARKER."
155
- (interactive )
156
- ; ; This function is necessary because `helm-org-goto-marker' calls
157
- ; ; `re-search-backward' to go backward to the start of a heading,
158
- ; ; which, when the marker is already at the desired heading, causes
159
- ; ; it to go to the previous heading. I don't know why it does that.
160
- (switch-to-buffer (marker-buffer marker))
161
- (goto-char marker)
162
- (org-show-entry ))
163
-
164
- (defun helm-org-ql-show-marker-indirect (marker )
165
- " Show heading at MARKER with `org-tree-to-indirect-buffer' ."
166
- (interactive )
167
- (helm-org-ql-show-marker marker)
168
- (org-tree-to-indirect-buffer ))
169
-
170
- (defun helm-org-ql-save ()
171
- " Show `helm-org-ql' search in an `org-ql-search' buffer."
172
- (interactive )
173
- (let ((buffers-files (with-current-buffer (helm-buffer-get)
174
- helm-org-ql-buffers-files))
175
- (query (org-ql--plain-query helm-pattern)))
176
- (helm-run-after-exit #'org-ql-search buffers-files query)))
149
+ (defun helm-org-ql-org-directory ()
150
+ " Search Org files in `org-directory' with `helm-org-ql' ."
151
+ (interactive )
152
+ (helm-org-ql (org-ql-search-directories-files)
153
+ :name " Org Directory Files" ))
154
+
155
+ (defun helm-org-ql-show-marker (marker )
156
+ " Show heading at MARKER."
157
+ (interactive )
158
+ ; ; This function is necessary because `helm-org-goto-marker' calls
159
+ ; ; `re-search-backward' to go backward to the start of a heading,
160
+ ; ; which, when the marker is already at the desired heading, causes
161
+ ; ; it to go to the previous heading. I don't know why it does that.
162
+ (switch-to-buffer (marker-buffer marker))
163
+ (goto-char marker)
164
+ (org-show-entry ))
165
+
166
+ (defun helm-org-ql-show-marker-indirect (marker )
167
+ " Show heading at MARKER with `org-tree-to-indirect-buffer' ."
168
+ (interactive )
169
+ (helm-org-ql-show-marker marker)
170
+ (org-tree-to-indirect-buffer ))
171
+
172
+ (defun helm-org-ql-save ()
173
+ " Show `helm-org-ql' search in an `org-ql-search' buffer."
174
+ (interactive )
175
+ (let ((buffers-files (with-current-buffer (helm-buffer-get)
176
+ helm-org-ql-buffers-files))
177
+ (query (org-ql--plain-query helm-pattern)))
178
+ (helm-run-after-exit #'org-ql-search buffers-files query)))
177
179
178
180
;;;### autoload
179
- (defun helm-org-ql-views ()
180
- " Show an `org-ql' view selected with Helm."
181
- (interactive )
182
- (helm :sources helm-source-org-ql-views))
181
+ (defun helm-org-ql-views ()
182
+ " Show an `org-ql' view selected with Helm."
183
+ (interactive )
184
+ (helm :sources helm-source-org-ql-views))
183
185
184
186
; ;;; Functions
185
187
186
- (cl-defun helm-org-ql-source (buffers-files &key (name " helm-org-ql" ))
187
- " Return Helm source named NAME that searches BUFFERS-FILES with `helm-org-ql' ."
188
- ; ; Expansion of `helm-build-sync-source' macro.
189
- (helm-make-source name 'helm-source-sync
190
- :candidates (lambda ()
191
- (let* ((query (org-ql--plain-query helm-pattern))
192
- (window-width (window-width (helm-window))))
193
- (when query
194
- (with-current-buffer (helm-buffer-get)
195
- (setq helm-org-ql-buffers-files buffers-files))
196
- (ignore-errors
197
- ; ; Ignore errors that might be caused by partially typed queries.
198
- (org-ql-select buffers-files query
199
- :action `(helm-org-ql--heading , window-width ))))))
200
- :match #'identity
201
- :fuzzy-match nil
202
- :multimatch nil
203
- :nohighlight t
204
- :volatile t
205
- :keymap helm-org-ql-map
206
- :action helm-org-ql-actions))
207
-
208
- (defun helm-org-ql--heading (window-width )
209
- " Return string for Helm for heading at point.
188
+ (cl-defun helm-org-ql-source (buffers-files &key (name " helm-org-ql" ))
189
+ " Return Helm source named NAME that searches BUFFERS-FILES with `helm-org-ql' ."
190
+ ; ; Expansion of `helm-build-sync-source' macro.
191
+ (helm-make-source name 'helm-source-sync
192
+ :candidates (lambda ()
193
+ (let* ((query (org-ql--plain-query helm-pattern))
194
+ (window-width (window-width (helm-window))))
195
+ (when query
196
+ (with-current-buffer (helm-buffer-get)
197
+ (setq helm-org-ql-buffers-files buffers-files))
198
+ (ignore-errors
199
+ ; ; Ignore errors that might be caused by partially typed queries.
200
+ (org-ql-select buffers-files query
201
+ :action `(helm-org-ql--heading , window-width ))))))
202
+ :match #'identity
203
+ :fuzzy-match nil
204
+ :multimatch nil
205
+ :nohighlight t
206
+ :volatile t
207
+ :keymap helm-org-ql-map
208
+ :action helm-org-ql-actions))
209
+
210
+ (defun helm-org-ql--heading (window-width )
211
+ " Return string for Helm for heading at point.
210
212
WINDOW-WIDTH should be the width of the Helm window."
211
- (font-lock-ensure (point-at-bol ) (point-at-eol ))
212
- ; ; TODO: It would be better to avoid calculating the prefix and width
213
- ; ; at each heading, but there's no easy way to do that once in each
214
- ; ; buffer, unless we manually called `org-ql' in each buffer, which
215
- ; ; I'd prefer not to do. Maybe I should add a feature to `org-ql' to
216
- ; ; call a setup function in a buffer before running queries.
217
- (let* ((prefix (concat (buffer-name ) " :" ))
218
- (width (- window-width (length prefix)))
219
- (heading (org-get-heading t ))
220
- (path (-> (org-get-outline-path )
221
- (org-format-outline-path width nil " " )
222
- (org-split-string " " )))
223
- (path (if helm-org-ql-reverse-paths
224
- (concat heading " \\ " (s-join " \\ " (nreverse path)))
225
- (concat (s-join " /" path) " /" heading))))
226
- (cons (concat prefix path) (point-marker ))))
213
+ (font-lock-ensure (point-at-bol ) (point-at-eol ))
214
+ ; ; TODO: It would be better to avoid calculating the prefix and width
215
+ ; ; at each heading, but there's no easy way to do that once in each
216
+ ; ; buffer, unless we manually called `org-ql' in each buffer, which
217
+ ; ; I'd prefer not to do. Maybe I should add a feature to `org-ql' to
218
+ ; ; call a setup function in a buffer before running queries.
219
+ (let* ((prefix (concat (buffer-name ) " :" ))
220
+ (width (- window-width (length prefix)))
221
+ (heading (org-get-heading t ))
222
+ (path (-> (org-get-outline-path )
223
+ (org-format-outline-path width nil " " )
224
+ (org-split-string " " )))
225
+ (path (if helm-org-ql-reverse-paths
226
+ (concat heading " \\ " (s-join " \\ " (nreverse path)))
227
+ (concat (s-join " /" path) " /" heading))))
228
+ (cons (concat prefix path) (point-marker )) ))))
227
229
228
230
; ;;; Footer
229
231
0 commit comments