forked from jyp/boon
-
Notifications
You must be signed in to change notification settings - Fork 0
/
boon-search.el
128 lines (108 loc) · 4.67 KB
/
boon-search.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
;;; boon-search.el --- An Ergonomic Command Mode -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
(require 'boon-utils)
(defvar-local boon-regexp nil "Current regexp search. Use boon-set-search-regexp to set this variable.")
(defvar-local boon-search-success t "Last search was successful or non-existent.")
(defun boon-set-search-regexp (regexp)
"Set boon-regexp to REGEXP and manage highlighting."
(when boon-regexp (hi-lock-unface-buffer boon-regexp))
(setq boon-search-success t)
(setq boon-regexp regexp)
(boon-highlight-regexp))
(defun boon-qsearch (forward)
"Search the current boon-regexp, in the direction specified (as FORWARD).
Point is set at the beginning of the match. Moreover, highlight
the regexp."
(when (not boon-regexp)
(error "Search string not set"))
(boon-highlight-regexp)
(save-excursion ;; so that we don't move the point if an exception is thrown
(goto-char (if boon-search-success
(if forward (1+ (point)) (1- (point)))
(message "Wrapping around")
(if forward (point-min) (point-max))))
(setq boon-search-success nil)
(let ((case-fold-search nil)) ;; because hi-lock is case-sensitive
(if forward (re-search-forward boon-regexp) (re-search-backward boon-regexp)))
;; If search fails an exception is thrown and this won't be set.
(setq boon-search-success t))
(goto-char (match-beginning 0)))
(defun boon-qsearch-next ()
"Search the next occurence of the current search regexp."
(interactive)
(boon-qsearch t))
(defun boon-qsearch-previous ()
"Search the previous occurence of the current search regexp."
(interactive)
(boon-qsearch nil))
(defun boon-qsearch-next-at-point ()
"Search the next occurence of the current string at point and select the match."
(interactive)
(boon-set-search-string (boon-stuff-at-point))
(boon-qsearch t)
(deactivate-mark))
(defun boon-qsearch-previous-at-point ()
"Search the previous occurence of the current string at point and select the match."
(interactive)
(boon-set-search-string (boon-stuff-at-point))
(boon-qsearch nil)
(deactivate-mark))
(defun boon-set-search-string (string)
"Set the search regexp by providing a string so match (as STRING)."
(interactive "M")
(boon-set-search-regexp (cond ((if (and (eq isearch-case-fold-search t)
search-upper-case)
(isearch-no-upper-case-p
string isearch-regexp)
isearch-case-fold-search)
;; Turn isearch-string into a case-insensitive
;; regexp.
(mapconcat
(lambda (c)
(let ((s (string c)))
(if (string-match "[[:alpha:]]" s)
(format "[%s%s]" (upcase s) (downcase s))
(regexp-quote s))))
string ""))
(t (regexp-quote string)))))
(defun boon-case-fold-regex (regex)
"Make REGEX case-insensitive, depending on `case-fold-search'.
This is an extremely bugged first draft."
(if (not case-fold-search) regex
(replace-regexp-in-string
"[[:alpha:]]"
(lambda (m) (format "[%s%s]"
(upcase (match-string 0 m))
(match-string 0 m)))
regex)))
(defun boon-highlight-regexp ()
"Make sure boon-regexp is highlighted."
(interactive)
(hi-lock-face-buffer boon-regexp))
(defun boon-navigate (forward)
"Go to the next item of interest, FORWARD or backwards."
(cond
((and (bound-and-true-p multiple-cursors-mode) (> (mc/num-cursors) 1))
(if forward (mc/cycle-forward) (mc/cycle-backward)))
((and boon-regexp
(bound-and-true-p hi-lock-interactive-patterns)
(equal boon-regexp (car (car hi-lock-interactive-patterns))))
(boon-qsearch forward))
(t (next-error (if forward 1 -1)))))
(defun boon-navigate-forward ()
"Go to the next item of interest."
(interactive)
(boon-navigate t))
(defun boon-navigate-backward ()
"Go to the next item of interest."
(interactive)
(boon-navigate nil))
(defadvice isearch-exit (after boon-isearch-set-search activate compile)
"After isearch, highlight the search term and set it as boon current regexp."
(boon-set-search-string isearch-string))
(defadvice swiper--action (after boon-swiper-set-search activate compile)
"After swiper, highlight the search term and set it as boon current regexp."
(boon-set-search-regexp (boon-case-fold-regex (car regexp-search-ring))))
(provide 'boon-search)
;;; boon-search.el ends here