forked from alphapapa/org-rifle
-
Notifications
You must be signed in to change notification settings - Fork 0
/
helm-org-rifle.el
1488 lines (1326 loc) · 70.9 KB
/
helm-org-rifle.el
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
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; helm-org-rifle.el --- Rifle through your Org files
;; Author: Adam Porter <adam@alphapapa.net>
;; Url: http://github.com/alphapapa/helm-org-rifle
;; Version: 1.5.0-pre
;; Package-Requires: ((emacs "24.4") (dash "2.12") (f "0.18.1") (helm "1.9.4") (s "1.10.0"))
;; Keywords: hypermedia, outlines
;;; Commentary:
;; This is my rifle. There are many like it, but this one is mine.
;; My rifle is my best friend. It is my life. I must master it as I
;; must master my life.
;; What does my rifle do? It searches rapidly through my Org files,
;; quickly bringing me the information I need to defeat the enemy.
;; This package is inspired by org-search-goto/org-search-goto-ml. It
;; searches both headings and contents of entries in Org buffers, and
;; it displays entries that match all search terms, whether the terms
;; appear in the heading, the contents, or both. Matching portions of
;; entries' contents are displayed with surrounding context to make it
;; easy to acquire your target.
;; Entries are fontified by default to match the appearance of an Org
;; buffer, and optionally the entire path can be displayed for each
;; entry, rather than just its own heading.
;;; Installation:
;;;; MELPA
;; If you installed from MELPA, your rifle is ready. Just run one of
;; the commands below.
;;;; Manual
;; Install the Helm, dash.el, f.el, and s.el packages. Then require
;; this package in your init file:
;; (require 'helm-org-rifle)
;;; Usage:
;; Run one of the rifle commands, type some words, and results will be
;; displayed, grouped by buffer. Hit "RET" to show the selected
;; entry, or <C-return> to show it in an indirect buffer.
;; Helm commands: show results in a Helm buffer
;; + `helm-org-rifle': Show results from all open Org buffers
;; + `helm-org-rifle-agenda-files': Show results from Org agenda files
;; + `helm-org-rifle-current-buffer': Show results from current buffer
;; + `helm-org-rifle-directories': Show results from selected directories; with prefix, recursively
;; + `helm-org-rifle-files': Show results from selected files
;; + `helm-org-rifle-org-directory': Show results from Org files in `org-directory'
;; Occur commands: show results in an occur-like, persistent buffer
;; + `helm-org-rifle-occur': Show results from all open Org buffers
;; + `helm-org-rifle-occur-agenda-files': Show results from Org agenda files
;; + `helm-org-rifle-occur-current-buffer': Show results from current buffer
;; + `helm-org-rifle-occur-directories': Show results from selected directories; with prefix, recursively
;; + `helm-org-rifle-occur-files': Show results from selected files
;; + `helm-org-rifle-occur-org-directory': Show results from Org files in `org-directory'
;;;; Tips
;; + Select multiple entries in the Helm buffer to display selected
;; entries in a read-only, `occur`-style buffer.
;; + Save all results in a Helm buffer to a `helm-org-rifle-occur`
;; buffer by pressing `C-s` (like `helm-grep-save-results`).
;; + Show results from certain buffers by typing the name of the
;; buffer (usually the filename).
;; + Show headings with certain to-do keywords by typing the keyword,
;; e.g. `TODO` or `DONE`.
;; + Show headings with certain priorities by typing, e.g. `#A` or
;; `[#A]`.
;; + Show headings with certain tags by searching for,
;; e.g. `:tag1:tag2:`.
;; + Negate matches with a `!`, e.g. `pepperoni !anchovies`.
;; + Sort results by timestamp or buffer-order (the default) by
;; calling commands with a universal prefix (`C-u`).
;; + Show entries in an indirect buffer by selecting that action from
;; the Helm actions list, or by pressing `<C-return>`.
;; + The keymap for `helm-org-rifle-occur` results buffers imitates
;; the `org-speed` keys, making it quicker to navigate. You can also
;; collapse and expand headings and drawers with `TAB` and `S-TAB`,
;; just like in regular Org buffers. Results buffers are marked
;; read-only so you cannot modify them by accidental keypresses.
;; + Delete the result at point in `helm-org-rifle-occur` buffers by
;; pressing `d`. This does not alter the source buffers but simply
;; removes uninteresting results from view.
;; + You can customize the `helm-org-rifle` group if you like.
;;; Credits:
;; This package is inspired by org-search-goto (specifically,
;; org-search-goto-ml). Its unofficial-official home is on
;; EmacsWiki[1] but I've mirrored it on GitHub[2]. It's a really
;; great package, and the only thing that could make it better is to
;; make it work with Helm. To avoid confusion, this package has a
;; completely different name.
;;
;; [1] https://www.emacswiki.org/emacs/org-search-goto-ml.el
;; [2] https://github.com/alphapapa/org-search-goto
;;; License:
;; 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 <http://www.gnu.org/licenses/>.
;;; Code:
;;;; Require
(require 'cl-lib)
(require 'dash)
(require 'f)
(require 'helm)
(require 'org)
(require 's)
;;;; Vars
(defconst helm-org-rifle-fontify-buffer-name " *helm-org-rifle-fontify*"
"The name of the invisible buffer used to fontify `org-mode' strings.")
(defconst helm-org-rifle-occur-results-buffer-name "*helm-org-rifle-occur*"
"The name of the results buffer for `helm-org-rifle-occur' commands.")
(defconst helm-org-rifle-tags-re (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
"Regexp used to match Org tag strings. From org.el.")
(defvar helm-org-rifle-map
(let ((new-map (copy-keymap helm-map)))
(define-key new-map (kbd "<C-return>") 'helm-org-rifle-show-entry-in-indirect-buffer-map-action)
;; FIXME: The C-s bind seems to only work when pressed twice;
;; before being pressed, it's not bound in the keymap, but after
;; pressing it once, it is, and then it works. Weird.
(define-key new-map (kbd "C-s") 'helm-org-rifle--save-results)
new-map)
"Keymap for `helm-org-rifle'.")
(defgroup helm-org-rifle nil
"Settings for `helm-org-rifle'."
:group 'helm
:link '(url-link "http://github.com/alphapapa/helm-org-rifle"))
(defcustom helm-org-rifle-after-init-hook '(helm-org-rifle-set-input-idle-delay)
"`:after-init-hook' for the Helm buffer.
If you're thinking about changing this, you probably know what you're doing."
:group 'helm-org-rifle :type 'hook)
(defcustom helm-org-rifle-always-show-entry-contents-chars 50
"When non-zero, always show this many characters of entry text, even if none of it matches query."
:group 'helm-org-rifle :type 'integer)
(defcustom helm-org-rifle-before-command-hook '(helm-org-rifle-set-sort-mode)
"Hook that runs before each helm-org-rifle command."
:group 'helm-org-rifle :type 'hook)
(defcustom helm-org-rifle-after-command-hook '(helm-org-rifle-reset-sort-mode)
"Hook that runs after each helm-org-rifle command."
:group 'helm-org-rifle :type 'hook)
(defcustom helm-org-rifle-close-unopened-file-buffers t
"Close buffers that were not already open.
After rifling through Org files that are not already open, close
the buffers if non-nil. If nil, leave the buffers open. Leaving
them open will speed up subsequent searches but clutter the
buffer list."
:group 'helm-org-rifle :type 'boolean)
(defcustom helm-org-rifle-context-characters 25
"How many characters around each matched term to display."
:group 'helm-org-rifle :type 'integer)
(defcustom helm-org-rifle-directories-recursive t
"Recurse into subdirectories by default in `helm-org-rifle-directories'.
When `helm-org-rifle-directories' is called with a prefix, this
option will be inverted."
:group 'helm-org-rifle :type 'boolean)
(defcustom helm-org-rifle-ellipsis-string "..."
"Shown between match context strings."
:group 'helm-org-rifle :type 'string)
(defcustom helm-org-rifle-ellipsis-face 'font-lock-comment-delimiter-face
"Face for ellipses between match context strings."
:group 'helm-org-rifle :type 'face)
(defcustom helm-org-rifle-directories-filename-regexp "\.org$"
"Regular expression to match Org filenames in `helm-org-rifle-directories'.
Files matching this regexp will be searched. By default, \".org\" files are matched, but you may also select to include \".org_archive\" files, or use a custom regexp."
:group 'helm-org-rifle
:type '(radio (string :tag "Normal \".org\" files" :value "\.org$")
(string :tag "Also include \".org_archive\" files" "\.org\\(_archive\\)?$")
(string :tag "Custom regexp. You know what you're doing.")))
(defcustom helm-org-rifle-fontify-headings t
"Fontify Org headings.
For large result sets this may be slow, although it doesn't seem
to be a major bottleneck."
:group 'helm-org-rifle :type 'boolean)
(defcustom helm-org-rifle-heading-contents-separator "\n"
"Separator inserted between entry's heading and contents.
Usually this should be a newline, but it may be useful to adjust
it when defining custom commands. For example, by setting this
to a non-newline value and disabling `helm-org-rifle-multiline',
each result can be displayed on a single line."
:type 'string)
(defcustom helm-org-rifle-input-idle-delay 0.05
"How long to wait to find results after the user stops typing, in seconds.
This helps prevent flickering in the Helm buffer, because the
default value for `helm-idle-input-delay' is 0.01, which runs the
search immediately after each keystroke. You can adjust this to
get results more quickly (shorter delay) or further reduce
flickering (longer delay)."
:group 'helm-org-rifle :type 'float)
(defcustom helm-org-rifle-multiline t
"Show entries on multiple lines, with the heading on the first line and a blank line between.
In most cases this should remain on, but it may be useful to
disable it when defining custom commands. Note that if this is
disabled, usually `helm-org-rifle-heading-contents-separator'
should be set to a non-newline value, e.g. a space or something
like \": \"."
:type 'boolean)
(defcustom helm-org-rifle-show-entry-function 'helm-org-rifle-show-entry-in-real-buffer
"Default function to use to show selected entries."
:group 'helm-org-rifle
:type '(radio (function :tag "Show entries in real buffers." helm-org-rifle-show-entry-in-real-buffer)
(function :tag "Show entries in indirect buffers." helm-org-rifle-show-entry-in-indirect-buffer)
(function :tag "Custom function")))
(defcustom helm-org-rifle-show-full-contents nil
"Show all of each result's contents instead of just context around each matching word."
:group 'helm-org-rifle :type 'boolean)
(defcustom helm-org-rifle-show-todo-keywords t
"Show and match against Org todo keywords."
:group 'helm-org-rifle :type 'boolean)
(defcustom helm-org-rifle-show-path nil
"Show the whole heading path instead of just the entry's heading."
:group 'helm-org-rifle :type 'boolean)
(defcustom helm-org-rifle-re-prefix
"\\(\\_<\\|[[:punct:]]\\)"
"Regexp matched immediately before each search term.
\(Customize at your peril (but it's okay to experiment here,
because you can always revert your changes).)"
:group 'helm-org-rifle :type 'regexp)
(defcustom helm-org-rifle-re-suffix
"\\(\\_>\\|[[:punct:]]\\)"
"Regexp matched immediately after each search term.
\(What, didn't you read the last warning? Oh, nevermind.)"
:group 'helm-org-rifle :type 'regexp)
(defcustom helm-org-rifle-sort-order nil
"Sort results in this order by default.
The sort order may be changed temporarily by calling a command with a universal prefix (C-u).
This is a list of functions which may be called to transform results, typically by sorting them."
;; There seems to be a bug or at least inconsistency in the Emacs
;; customize system. Setting :tag in an item in a choice or radio
;; list does not allow you to read the :tag from the choice as a
;; plist key, because the key is the second value in the list,
;; making the list not a plist at all. Also, changing the order of
;; the elements in a list item seems to break the customize dialog,
;; e.g. causing the :tag description to not be shown at all. It
;; seems like Emacs handles these as pseudo-plists, with special
;; code behind the scenes to handle plist keys that are not in
;; actual plists.
:type '(radio (const :tag "Buffer order" nil)
(function-item :tag "Latest timestamp" helm-org-rifle-transformer-sort-by-latest-timestamp)
(function :tag "Custom function")))
(defcustom helm-org-rifle-unlinkify-entry-links t
"Turn Org links in entry text into plain text so they look nicer in Helm buffers.
Just in case this is a performance issue for anyone, it can be disabled."
:type 'boolean)
(defcustom helm-org-rifle-sort-order-persist nil
"When non-nil, keep the sort order setting when it is changed by calling a command with a universal prefix."
:group 'helm-org-rifle :type 'boolean)
(defface helm-org-rifle-separator
;; FIXME: Pick better default color. Black is probably too harsh.
'((((background dark))
:background "black")
(((background light))
:foreground "black"))
"Face for `helm-org-rifle-separator', which is displayed between results.")
(defcustom helm-org-rifle-occur-kill-empty-buffer t
"Close occur results buffer after last result is deleted."
:type 'boolean)
(defvar helm-org-rifle-occur-map (let ((map (copy-keymap org-mode-map)))
(define-key map [remap org-cycle] 'helm-org-rifle-occur--org-cycle)
(define-key map [remap undo] (lambda () (interactive) (let ((inhibit-read-only t)) (undo))))
(define-key map [mouse-1] 'helm-org-rifle-occur-goto-entry)
(define-key map (kbd "<RET>") 'helm-org-rifle-occur-goto-entry)
(define-key map (kbd "d") 'helm-org-rifle-occur-delete-entry)
(define-key map (kbd "b") (lambda () (interactive) (helm-org-rifle--speed-command 'org-backward-heading-same-level)))
(define-key map (kbd "f") (lambda () (interactive) (helm-org-rifle--speed-command 'org-forward-heading-same-level)))
(define-key map (kbd "p") (lambda () (interactive) (helm-org-rifle--speed-command 'outline-previous-visible-heading)))
(define-key map (kbd "n") (lambda () (interactive) (helm-org-rifle--speed-command 'outline-next-visible-heading)))
(define-key map (kbd "u") (lambda () (interactive) (helm-org-rifle--speed-command 'outline-up-heading)))
(define-key map (kbd "o") (lambda () (interactive) (helm-org-rifle--speed-command 'org-open-at-point)))
(define-key map (kbd "c") (lambda () (interactive) (helm-org-rifle--speed-command 'org-cycle)))
(define-key map (kbd "C") (lambda () (interactive) (helm-org-rifle--speed-command 'org-shifttab)))
(define-key map (kbd "q") 'quit-window)
map)
"Keymap for helm-org-rifle-occur results buffers. Imitates org-speed keys.")
(defvar helm-org-rifle-occur-minibuffer-map (let ((map (copy-keymap minibuffer-local-map)))
(define-key map (kbd "C-g") 'helm-org-rifle-occur-cleanup-buffer)
map)
"Keymap for helm-org-rifle-occur minibuffers.")
(defvar helm-org-rifle-occur-last-input nil
"Last input given, used to avoid re-running search when input hasn't changed.")
(defvar helm-org-rifle-occur-separator
(let ((text "\n"))
(set-text-properties 0 (length text) '(helm-org-rifle-result-separator t font-lock-face helm-org-rifle-separator) text)
text)
"Propertized separator for results in occur buffers.")
(defvar helm-org-rifle-transformer nil
"Function to transform results, usually for sorting. Not intended to be user-set at this time.")
;;;; Functions
;;;;; Commands
;;;###autoload
(cl-defmacro helm-org-rifle-define-command (name args docstring &key sources (let nil) (transformer nil))
"Define interactive helm-org-rifle command, which will run the appropriate hooks.
Helm will be called with vars in LET bound."
`(cl-defun ,(intern (concat "helm-org-rifle" (when (s-present? name) (concat "-" name)))) ,args
,docstring
(interactive)
(unwind-protect
(progn
(run-hooks 'helm-org-rifle-before-command-hook)
(let* ((helm-candidate-separator " ")
,(if transformer
;; I wish there were a cleaner way to do this,
;; because if this `if' evaluates to nil, `let' will
;; try to set `nil', which causes an error. The
;; choices seem to be to a) evaluate to a list and
;; unsplice it (since unsplicing `nil' evaluates to
;; nothing), or b) return an ignored symbol when not
;; true. Option B is less ugly.
`(helm-org-rifle-transformer ,transformer)
'ignore)
,@let)
(helm :sources ,sources)))
(run-hooks 'helm-org-rifle-after-command-hook))))
;;;###autoload
(helm-org-rifle-define-command
"" ()
"This is my rifle. There are many like it, but this one is mine.
My rifle is my best friend. It is my life. I must master it as I
must master my life.
Without me, my rifle is useless. Without my rifle, I am
useless. I must fire my rifle true. I must shoot straighter than
my enemy who is trying to kill me. I must shoot him before he
shoots me. I will...
My rifle and I know that what counts in war is not the rounds we
fire, the noise of our burst, nor the smoke we make. We know that
it is the hits that count. We will hit...
My rifle is human, even as I, because it is my life. Thus, I will
learn it as a brother. I will learn its weaknesses, its strength,
its parts, its accessories, its sights and its barrel. I will
keep my rifle clean and ready, even as I am clean and ready. We
will become part of each other. We will...
Before God, I swear this creed. My rifle and I are the defenders
of my country. We are the masters of our enemy. We are the
saviors of my life.
So be it, until victory is ours and there is no enemy, but
peace!"
:sources (helm-org-rifle-get-sources-for-open-buffers))
;;;###autoload
(helm-org-rifle-define-command
"current-buffer" ()
"Rifle through the current buffer."
:sources (helm-org-rifle-get-source-for-buffer (current-buffer)))
;;;###autoload
(helm-org-rifle-define-command
"files" (&optional files)
"Rifle through FILES, where FILES is a list of paths to Org files.
If FILES is nil, prompt with `helm-read-file-name'. All FILES
are searched; they are not filtered with
`helm-org-rifle-directories-filename-regexp'."
:sources (--map (helm-org-rifle-get-source-for-file it) files)
:let ((files (helm-org-rifle--listify (or files
(helm-read-file-name "Files: " :marked-candidates t))))
(helm-candidate-separator " ")
(helm-cleanup-hook (lambda ()
;; Close new buffers if enabled
(when helm-org-rifle-close-unopened-file-buffers
(if (= 0 helm-exit-status)
;; Candidate selected; close other new buffers
(let ((candidate-source (helm-attr 'name (helm-get-current-source))))
(dolist (source (helm-get-sources))
(unless (or (equal (helm-attr 'name source)
candidate-source)
(not (helm-attr 'new-buffer source)))
(kill-buffer (helm-attr 'buffer source)))))
;; No candidates; close all new buffers
(dolist (source (helm-get-sources))
(when (helm-attr 'new-buffer source)
(kill-buffer (helm-attr 'buffer source))))))))))
;;;###autoload
(helm-org-rifle-define-command
"sort-by-latest-timestamp" ()
"Rifle through open buffers, sorted by latest timestamp."
:transformer 'helm-org-rifle-transformer-sort-by-latest-timestamp
:sources (helm-org-rifle-get-sources-for-open-buffers))
;;;###autoload
(helm-org-rifle-define-command
"current-buffer-sort-by-latest-timestamp" ()
"Rifle through the current buffer, sorted by latest timestamp."
:transformer 'helm-org-rifle-transformer-sort-by-latest-timestamp
:sources (helm-org-rifle-get-source-for-buffer (current-buffer)))
;;;###autoload
(defun helm-org-rifle-agenda-files ()
"Rifle through Org agenda files."
;; This does not need to be defined with helm-org-rifle-define-command because it calls helm-org-rifle-files which is.
(interactive)
(helm-org-rifle-files (org-agenda-files)))
;;;###autoload
(defun helm-org-rifle-directories (&optional directories toggle-recursion)
"Rifle through Org files in DIRECTORIES.
DIRECTORIES may be a string or list of strings. If DIRECTORIES
is nil, prompt with `helm-read-file-name'. With prefix or
TOGGLE-RECURSION non-nil, toggle recursion from the default.
Files in DIRECTORIES are filtered using
`helm-org-rifle-directories-filename-regexp'."
;; This does not need to be defined with helm-org-rifle-define-command because it calls helm-org-rifle-files which is.
(interactive)
(let* ((recursive (if (or toggle-recursion current-prefix-arg)
(not helm-org-rifle-directories-recursive)
helm-org-rifle-directories-recursive))
(directories (helm-org-rifle--listify
(or directories
(-select 'f-dir? (helm-read-file-name "Directories: " :marked-candidates t)))))
(files (-flatten (--map (f-files it
(lambda (file)
(s-matches? helm-org-rifle-directories-filename-regexp (f-filename file)))
recursive)
directories))))
(if files
(helm-org-rifle-files files)
(error "No org files found in directories: %s" (s-join " " directories)))))
;;;###autoload
(defun helm-org-rifle-org-directory ()
"Rifle through Org files in `org-directory'."
(interactive)
(helm-org-rifle-directories (list org-directory)))
;;;;;; Occur commands
;;;###autoload
(cl-defmacro helm-org-rifle-define-occur-command (name args docstring &key buffers files directories preface)
"Define `helm-org-rifle-occur' command to search BUFFERS."
`(defun ,(intern (concat "helm-org-rifle-occur"
(when name (concat "-" name))))
,args
,docstring
(interactive)
(unwind-protect
(progn
(run-hooks 'helm-org-rifle-before-command-hook)
(let (directories-collected files-collected buffers-collected)
;; FIXME: If anyone's reading this and can help me clean up this macro a bit, help would be appreciated.
,preface ; Maybe not necessary
,(when directories
;; Is there a nicer way to do this?
`(setq directories-collected (append directories-collected (helm-org-rifle--listify ,directories))))
(when directories-collected
(let ((recursive (if current-prefix-arg
(not helm-org-rifle-directories-recursive)
helm-org-rifle-directories-recursive)))
(setq files-collected (append files-collected
(-flatten
(--map (f-files it
(lambda (file)
(s-matches? helm-org-rifle-directories-filename-regexp
(f-filename file)))
recursive)
directories-collected))))))
,(when files
;; Is there a nicer way to do this?
`(setq files-collected (append files-collected (helm-org-rifle--listify ,files))))
(when files-collected
(setq buffers-collected (append (cl-loop for file in files-collected
collect (-if-let (buffer (org-find-base-buffer-visiting file))
buffer
(find-file-noselect file)))
buffers-collected)))
,(when buffers
;; Is there a nicer way to do this?
`(setq buffers-collected (append buffers-collected ,buffers)))
(let ((helm-org-rifle-show-full-contents t))
(helm-org-rifle-occur-begin buffers-collected))))
(run-hooks 'helm-org-rifle-after-command-hook))))
;;;###autoload
(helm-org-rifle-define-occur-command
nil ()
"Search all Org buffers, showing results in an occur-like, persistent buffer."
:buffers (--remove (string= helm-org-rifle-occur-results-buffer-name (buffer-name it))
(-select 'helm-org-rifle-buffer-visible-p
(org-buffer-list nil t))))
;;;###autoload
(helm-org-rifle-define-occur-command
"current-buffer" ()
"Search current buffer, showing results in an occur-like, persistent buffer."
:buffers (list (current-buffer)))
;;;###autoload
(helm-org-rifle-define-occur-command
"directories" (&optional directories)
"Search files in DIRECTORIES, showing results in an occur-like, persistent buffer.
Files are opened if necessary, and the resulting buffers are left open."
:directories (or directories
(helm-read-file-name "Directories: " :marked-candidates t)))
;;;###autoload
(helm-org-rifle-define-occur-command
"files" (&optional files)
"Search FILES, showing results in an occur-like, persistent buffer.
Files are opened if necessary, and the resulting buffers are left open."
:files (or files
(helm-read-file-name "Files: " :marked-candidates t)))
;;;###autoload
(helm-org-rifle-define-occur-command
"agenda-files" ()
"Search Org agenda files, showing results in an occur-like, persistent buffer.
Files are opened if necessary, and the resulting buffers are left open."
:files (org-agenda-files))
;;;###autoload
(helm-org-rifle-define-occur-command
"org-directory" ()
"Search files in `org-directory', showing results in an occur-like, persistent buffer.
Files are opened if necessary, and the resulting buffers are left open."
:directories (list org-directory))
;;;;; Sources
(defun helm-org-rifle-get-source-for-buffer (buffer)
"Return Helm source for BUFFER."
(let ((source (helm-build-sync-source (buffer-name buffer)
:after-init-hook helm-org-rifle-after-init-hook
:candidates (lambda ()
(when (s-present? helm-pattern)
(helm-org-rifle--get-candidates-in-buffer (helm-attr 'buffer) helm-pattern)))
:candidate-transformer helm-org-rifle-transformer
:match 'identity
:multiline helm-org-rifle-multiline
:volatile t
:action (helm-make-actions
"Show entry" 'helm-org-rifle--show-candidates
"Show entry in indirect buffer" 'helm-org-rifle-show-entry-in-indirect-buffer
"Show entry in real buffer" 'helm-org-rifle-show-entry-in-real-buffer)
:keymap helm-org-rifle-map)))
(helm-attrset 'buffer buffer source)
source))
(defun helm-org-rifle-get-source-for-file (file)
"Return Helm source for FILE.
If the file is not already in an open buffer, it will be opened
with `find-file-noselect'."
(let ((buffer (org-find-base-buffer-visiting file))
new-buffer source)
(unless buffer
(if (f-exists? file)
(progn
(setq buffer (find-file-noselect file))
(setq new-buffer t))
(error "File not found: %s" file)))
(setq source (helm-org-rifle-get-source-for-buffer buffer))
(helm-attrset 'new-buffer new-buffer source)
source))
(defun helm-org-rifle-get-sources-for-open-buffers ()
"Return list of sources configured for helm-org-rifle.
One source is returned for each open Org buffer."
(mapcar 'helm-org-rifle-get-source-for-buffer
(-select 'helm-org-rifle-buffer-visible-p (org-buffer-list nil t))))
;;;;; Show entries
(defun helm-org-rifle--save-results ()
"Save `helm-org-rifle' result in a `helm-org-rifle-occur' buffer.
In the spirit of `helm-grep-save-results'."
(interactive)
(helm-org-rifle--mark-all-candidates)
(helm-exit-and-execute-action 'helm-org-rifle--show-candidates))
(defun helm-org-rifle--mark-all-candidates ()
"Mark all candidates in Helm buffer.
`helm-mark-all' only marks in the current source, not all
sources, so we do it ourselves."
;; Based on `helm-mark-all'
;; FIXME: [2017-04-09 Sun 12:54] Latest Helm commit adds arg to
;; `helm-mark-all' to mark in all sources.
(with-helm-window
(let ((follow (if (helm-follow-mode-p (helm-get-current-source)) 1 -1)))
(helm-follow-mode -1) ; Disable follow so we don't jump to every candidate
(save-excursion
(goto-char (point-min))
;; Mark first candidate
(forward-line 1) ; Skip header line
(helm-mark-current-line)
(helm-make-visible-mark)
(while (ignore-errors (goto-char (next-single-property-change (point) 'helm-candidate-separator)))
;; Mark rest of candidates
(forward-line 1)
(helm-mark-current-line)
(helm-make-visible-mark)))
(helm-follow-mode follow))))
(defun helm-org-rifle--show-candidates (&optional candidates)
"Show CANDIDATES (or, if nil, all candidates marked in Helm).
If one candidate is given, the default
`helm-org-rifle-show-entry-function' will be used. If multiple
candidates, `helm-org-rifle--show-entries-as-occur' will be
used."
(let ((candidates (or (helm-org-rifle--get-marked-candidates)
candidates)))
(pcase (safe-length candidates)
(1 (helm-org-rifle-show-entry candidates))
(_ (helm-org-rifle--show-entries-as-occur candidates)))))
(defun helm-org-rifle--get-marked-candidates ()
"Return list of all marked candidates in Helm.
`helm-marked-candidates' only returns results from the current
source, so we must gather them manually."
;; Based on `helm-revive-visible-mark'
;; FIXME: [2017-04-09 Sun 11:02] Current Helm version does this with
;; an arg to `helm-marked-candidates', but this should be faster
;; since it does a lot less behind the scenes.
(with-current-buffer helm-buffer
(save-excursion
(cl-loop for o in helm-visible-mark-overlays
collect (overlay-get o 'real) into res
finally return (nreverse res)))))
(defun helm-org-rifle-show-entry (candidate)
"Show CANDIDATE using the default function."
(funcall helm-org-rifle-show-entry-function candidate))
(defun helm-org-rifle-show-entry-in-real-buffer (candidate)
"Show CANDIDATE in its real buffer."
(helm-attrset 'new-buffer nil) ; Prevent the buffer from being cleaned up
(-let (((buffer . pos) candidate))
(switch-to-buffer buffer)
(goto-char pos))
(org-show-entry))
(defun helm-org-rifle-show-entry-in-indirect-buffer (candidate)
"Show CANDIDATE in an indirect buffer."
(-let (((buffer . pos) candidate)
(original-buffer (current-buffer)))
(helm-attrset 'new-buffer nil) ; Prevent the buffer from being cleaned up
(switch-to-buffer buffer)
(goto-char pos)
(org-tree-to-indirect-buffer)
(unless (equal original-buffer (car (window-prev-buffers)))
;; The selected bookmark was in a different buffer. Put the
;; non-indirect buffer at the bottom of the prev-buffers list
;; so it won't be selected when the indirect buffer is killed.
(set-window-prev-buffers nil (append (cdr (window-prev-buffers))
(car (window-prev-buffers)))))))
(defun helm-org-rifle-show-entry-in-indirect-buffer-map-action ()
"Exit Helm buffer and call `helm-org-rifle-show-entry-in-indirect-buffer' with selected candidate."
(interactive)
(with-helm-alive-p
(helm-exit-and-execute-action 'helm-org-rifle-show-entry-in-indirect-buffer)))
;;;;; The meat
(defun helm-org-rifle--get-candidates-in-buffer (buffer input)
"Return candidates in BUFFER for INPUT.
INPUT is a string. Candidates are returned in this
format: (STRING . POSITION)
STRING begins with a fontified Org heading and optionally
includes further matching parts separated by newlines.
POSITION is the position in BUFFER where the candidate heading
begins.
This is how the sausage is made."
(with-current-buffer buffer
;; Run this in the buffer so we can get its todo-keywords (i.e. `org-todo-keywords-1')
(-let* ((buffer-name (buffer-name buffer))
((includes excludes include-tags exclude-tags todo-keywords) (helm-org-rifle--parse-input input))
(excludes-re (when excludes
;; NOTE: Excludes only match against whole words. This probably makes sense.
;; TODO: Might be worth mentioning in docs.
(rx-to-string `(seq (or ,@excludes)) t)))
(include-tags (--map (s-wrap it ":") include-tags)) ; Wrap include-tags in ":" for the regexp
(positive-re (rx-to-string `(seq (or ,@(append includes include-tags todo-keywords)))))
;; NOTE: We leave todo-keywords out of the required-positive-re-list,
;; because that is used to verify that all positive tokens
;; are matched in an entry, and we want todo-keywords to
;; match OR-wise.
(required-positive-re-list (mapcar #'regexp-quote (append includes include-tags)))
(context-re (rx-to-string `(seq (repeat 0 ,helm-org-rifle-context-characters not-newline)
(or ,@(append includes include-tags todo-keywords))
(repeat 0 ,helm-org-rifle-context-characters not-newline))
t))
;; TODO: Turn off case folding if tokens contains mixed case
(case-fold-search t)
(results nil))
(save-excursion
;; Go to first heading
(goto-char (point-min))
(when (org-before-first-heading-p)
(outline-next-heading))
;; Search for matching nodes
(cl-loop while (re-search-forward positive-re nil t)
for result = (save-excursion
(helm-org-rifle--test-entry))
when result
collect result
do (outline-next-heading))))))
(defun helm-org-rifle--test-entry ()
"Return list of entry data if entry at point matches.
This is to be called from `helm-org-rifle--get-candidates-in-buffer',
because it uses variables in its outer scope."
(-let* ((node-beg (org-entry-beginning-position))
(node-end (org-entry-end-position))
((level reduced-level todo-keyword priority-char heading tags priority) (org-heading-components))
(path (when helm-org-rifle-show-path
(org-get-outline-path)))
(priority (when priority-char
;; TODO: Is there a better way to do this? The
;; s-join leaves an extra space when there's no
;; priority.
(format "[#%c]" priority-char)))
(heading (s-trim (if helm-org-rifle-show-todo-keywords
(s-join " " (list todo-keyword priority heading))
heading)))
(matching-positions-in-node nil)
(matching-lines-in-node nil)
(matched-words-with-context nil))
;; Goto beginning of node
(goto-char node-beg)
(unless
(or ;; Check to-do keywords and excludes
(when todo-keywords
(not (member todo-keyword todo-keywords)))
(when (and exclude-tags tags)
(cl-intersection (org-split-string tags ":") exclude-tags
:test #'string=))
;; Check normal excludes
(when excludes
;; TODO: Maybe match against a heading's inherited tags, if it's not too slow.
;; FIXME: Partial excludes seem to put the partially
;; negated entry at the end of results. Not sure why.
;; Could it actually be a good feature, though?
(or (cl-loop for elem in (or path (org-get-outline-path))
thereis (string-match-p excludes-re elem))
;; FIXME: Doesn't quite match properly with
;; special chars, e.g. negating "!scratch"
;; properly excludes the "*scratch*" buffer,
;; but negating "!*scratch*" doesn't'.
(string-match excludes-re buffer-name)
(save-excursion
(re-search-forward excludes-re node-end t)))))
;; No excludes match; collect entry data
(let (matching-positions-in-node matching-lines-in-node matched-words-with-context entry)
(setq matching-positions-in-node
;; Get beginning-of-line positions for matching lines in node
(save-excursion
(cl-loop
while (re-search-forward positive-re node-end t)
collect (line-beginning-position) into result
do (end-of-line)
finally return (sort (delete-dups result) '<))))
(setq matching-lines-in-node
;; Get list of line-strings containing any token
(cl-loop with string
for pos in matching-positions-in-node
do (goto-char pos)
unless (org-at-heading-p) ; Leave headings out of list of matched lines
;; Get text of each matching line
;; (DISPLAY . REAL) format for Helm
collect (cons (buffer-substring-no-properties (line-beginning-position)
(line-end-position))
(cons buffer pos))))
;; Verify all tokens are contained in each matching node
(when (cl-loop with targets = (-non-nil (append (list buffer-name
heading
tags)
(when helm-org-rifle-show-path
path)
(mapcar 'car matching-lines-in-node)))
for re in required-positive-re-list
always (cl-loop for target in targets
thereis (s-matches? re target)))
;; All tokens match; collect and return data
(setq matched-words-with-context
(if helm-org-rifle-show-full-contents
"" ; Don't collect context
(or (cl-loop for line in (mapcar 'car matching-lines-in-node)
;; Matching entry text found
do (when helm-org-rifle-unlinkify-entry-links
(setq line (helm-org-rifle-replace-links-in-string line)))
append (cl-loop with end
for match = (string-match context-re line end)
while match
do (setq end (match-end 0))
and collect (s-trim (match-string-no-properties 0 line))))
(when (> helm-org-rifle-always-show-entry-contents-chars 0)
;; No match in entry text; add desired entry text
(list (s-truncate helm-org-rifle-always-show-entry-contents-chars
(helm-org-rifle--get-entry-text buffer node-beg)))))))
(setq heading
(if path
(if helm-org-rifle-fontify-headings
(concat (org-format-outline-path
;; Replace links in path elements with plain text, otherwise
;; they will be truncated by `org-format-outline-path' and only
;; show part of the URL. FIXME: Use org-link-display-format function
(-map 'helm-org-rifle-replace-links-in-string (append path (list heading))))
(if tags
(concat " " (helm-org-rifle-fontify-like-in-org-mode tags))
""))
;; Not fontifying
(s-join "/" (append path (list heading) tags)))
;; No path or not showing path
(if helm-org-rifle-fontify-headings
(helm-org-rifle-fontify-like-in-org-mode
(s-join " " (list (s-repeat level "*") heading (concat tags " "))))
;; Not fontifying
(s-join " " (list (s-repeat level "*") heading tags)))))
(setq entry
(if helm-org-rifle-show-full-contents
(s-join helm-org-rifle-heading-contents-separator
(list heading
(buffer-substring (save-excursion
(goto-char node-beg)
(org-end-of-meta-data)
(point))
node-end)))
;; Show context strings
(s-join helm-org-rifle-heading-contents-separator
(list heading
(s-join helm-org-rifle-ellipsis-string
matched-words-with-context)))))
;; Return list in format: text-for-display node-beg
(cons entry (cons buffer node-beg)))))))
(defun helm-org-rifle--parse-input (input)
"Return list of token types in INPUT string.
Returns (INCLUDES EXCLUDES INCLUDE-TAGS EXCLUDE-TAGS TODO-KEYWORDS)."
(let ((tags-regexp (rx bos (optional "!") (1+ ":" (1+ (char alnum "_"))) ":" eos))
includes excludes include-tags exclude-tags todo-keywords)
(dolist (token (split-string input " " t))
(pcase token
;; Tags
((pred (string-match tags-regexp))
(if (string-match "^!" token)
;; Exclude tag
(setq exclude-tags (append exclude-tags (org-split-string (cl-subseq token 1) ":")))
;; Match tag
(setq include-tags (append include-tags (org-split-string token ":")))))
;; Negation
((pred (string-match "^!")
;; Ignore bare "!"
(guard (> (length token) 1)))
(push (cl-subseq token 1) excludes))
;; TODO keyword
((guard (member token org-todo-keywords-1))
(push token todo-keywords))
;; Positive terms
(otherwise (push token includes))))
(list includes excludes include-tags exclude-tags todo-keywords)))
;;;;; Occur-style
(defun helm-org-rifle-occur--org-cycle (&optional arg)
"Cycle folding of Org entries in an occur buffer.
This folds first at boundaries defined by `helm-header' and
`helm-org-rifle-result-separator' text-properties, and then
normally, by outline headings."
(interactive)
(cl-letf (((symbol-function 'org-end-of-subtree)
'helm-org-rifle--org-end-of-subtree)
((symbol-function 'outline-next-heading)
'helm-org-rifle--outline-next-heading))
(if (text-property-any (line-beginning-position) (line-end-position) 'helm-header t)
;; On a header line; cycle all entries in this source
(let ((start (line-beginning-position))
(end (save-excursion
(while (text-property-any (line-beginning-position) (line-end-position) 'helm-header t)
(forward-line 1))
(forward-char)
(let ((char (or (next-single-property-change (point) 'helm-header nil)
(point-max))))
(when char
(goto-char char)))
(point))))
(cl-loop for char = (next-single-property-change (point) 'helm-org-rifle-result-separator nil)
while (and char
(< char end))
do (progn
(goto-char char)
(outline-next-heading)
(outline-hide-subtree))))
;; Cycle this entry normally
(org-cycle arg))))
(defun helm-org-rifle--outline-next-heading ()
"Move to the next Helm header, result separator, outline heading, or point-max, whichever is smallest.
This is intended to override `outline-next-heading' in occur
results buffers."
(interactive)
(cl-flet ((min (&rest args)
(apply 'min (-non-nil args)))
(next-outline-heading ()
;; This is basically a copy of `outline-next-heading'
(when (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
nil 'move)
(match-beginning 0))))
(cond ((or (memq 'helm-header (text-properties-at (point)))
(memq 'helm-org-rifle-result-separator (text-properties-at (point))))
;; At a source header or result separator; go to first outline heading
(goto-char (next-outline-heading)))
((org-at-heading-p)
;; At a heading; go to next header or separator or end-of-buffer
(goto-char (1- (min (next-single-property-change (point) 'helm-org-rifle-result-separator)
(next-single-property-change (point) 'helm-header)
(point-max)))))
(t
(let ((char (min (next-single-property-change (point) 'helm-org-rifle-result-separator)
(next-single-property-change (point) 'helm-header)
(next-outline-heading))))
(when char
(goto-char char)))))))
(defun helm-org-rifle--org-end-of-subtree (&optional invisible-ok to-heading)
"Goto to the end of a subtree.
This function is a copy of `org-end-of-subtree', but it respects
headers and separators."
;; This contains an exact copy of the original function, but it uses