-
Notifications
You must be signed in to change notification settings - Fork 11
/
hmoccur.el
243 lines (222 loc) · 8.52 KB
/
hmoccur.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
;;; hmoccur.el --- Multi-buffer or multi-file regexp occurrence location. -*- lexical-binding: t; -*-
;;
;; Author: Markus Freericks <Mfx@cs.tu-berlin.de> / Bob Weiner
;;
;; Orig-Date: 1-Aug-91
;; Last-Mod: 17-Jan-24 at 23:57:46 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;; Commentary:
;;
;; Modified by Bob Weiner to allow selection of a set of files within a
;; single directory to search. By default, {M-x moccur RET} searches
;; current buffers with files attached.
;;
;; Date: 1 Aug 91 15:47:27 GMT
;; From: mfx@cs.tu-berlin.de (Markus Freericks)
;; Subject: moccur - multibuffer occurences
;;
;; While editing some dozen or so files, i had the dire need for
;; something like 'occur' that can cope with multiple buffers. This has
;; probably been done before; but still, here is my try at it. It seems
;; to be very useful.
;;
;; How to use it: simple say
;; M-x moccur <regexp>
;; moccur then searches through *all buffers* currently existing that are
;; bound to files and displays the occurences in a buffer that runs in
;; Moccur-mode. Change to that buffer, scroll around, and say C-c C-c
;; to jump to the occurrence. Quite simple.
;;
;; Incompatibilites to Occur mode:
;; a) it browses through *all* buffers that have a file name
;; associated with them; those may or may not include the current
;; buffer. Especially, while standard occur works
;; on 'all lines following point', Moccur does not.
;; b) there is no support for the 'NLINE' argument.
;;
;; Usage:
;; moccur <regexp> shows all occurences of <regexp> in all buffers
;; currently existing that refer to files.
;; the occurences are displayed in a buffer running in Moccur mode;
;; C-c C-c gets you to the occurence
;;; Code:
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(declare-function hpath:display-buffer "hpath")
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
(defconst moccur-source-prefix "@loc> "
"String prefix for lines indicating the source of the matches.
It should not contain any characters needing regular expression quoting.
This expression should be followed immediately by a buffer or file name
indicating the source of any of its Hyperbole buttons.")
;;; ************************************************************************
;;; Public functions
;;; ************************************************************************
(defun moccur (regexp &optional file-regexp no-fold-search)
"Show all lines of all buffers containing a match for REGEXP.
With optional FILE-REGEXP (a pattern which matches to files in a
single directory), search matching files rather than current
buffers. The lines are shown in a buffer named *Moccur* which
serves as a menu to find any of the occurrences in this buffer.
With optional NO-FOLD-SEARCH non-nil do case sensitive search.
\\{moccur-mode-map}"
(interactive "sRegexp to find occurrences of: \nsFiles to search (default current file buffers): ")
(if (equal file-regexp "") (setq file-regexp nil))
(let* ((buffers (if file-regexp (directory-files
(expand-file-name
(or (file-name-directory
file-regexp)
"."))
'full (file-name-nondirectory file-regexp))
(buffer-list)))
(occbuf (get-buffer-create "*Moccur*"))
(matches 0)
(firstmatch t))
(set-buffer occbuf)
(setq buffer-read-only nil)
(widen)
(erase-buffer)
(insert "Lines matching '" regexp "':\n\n")
(let ((currbuf) (currfile) (kill-buf)
;; Disable syntax highlighting of new buffers created by this command.
(font-lock-global-modes))
(while buffers
(setq currbuf (car buffers)
currfile (if (stringp currbuf) currbuf)
kill-buf (and currfile (not (get-file-buffer currfile)))
buffers (cdr buffers))
(if currfile
(setq currbuf (find-file-noselect currfile))
(setq currfile (buffer-file-name currbuf)))
(if (or (not currfile) (not currbuf))
nil
(set-buffer currbuf)
(let ((case-fold-search (not no-fold-search)))
(save-excursion
(goto-char (point-min))
(setq firstmatch t)
(while (re-search-forward regexp nil t)
(setq matches (+ matches 1))
(let* ((linenum (count-lines (point-min)(point)))
(tag (format "\n%5d:" linenum)))
(set-buffer occbuf)
(if firstmatch
(progn
(insert moccur-source-prefix currfile "\n")
(setq firstmatch nil)))
(insert tag)
(set-buffer currbuf)
(forward-word -1) ;; needed if match goes to eoline
(beginning-of-line)
(let ((beg (point)))
(end-of-line)
(append-to-buffer occbuf beg (point)))
(forward-line 1)))))
(with-current-buffer occbuf
(if (not firstmatch) (insert "\n\n"))
(if kill-buf (kill-buffer currbuf))))))
(if (> matches 0)
(progn
(set-buffer occbuf)
(moccur-mode)
(if (fboundp 'outline-minor-mode)
(and (progn (goto-char 1)
(search-forward "\C-m" nil t))
(outline-minor-mode 1)))
(goto-char (point-min))
(pop-to-buffer occbuf)
(message "%d matches." matches)
t)
(message "No matches.")
nil)))
(defun moccur-to ()
"Go to the line where this occurrence was found."
(interactive)
(let* ((result (moccur-noselect))
(buffer (car result))
(lineno (cadr result))
(occur-match (car (cddr result))))
(when result
(message "Selection <%s> line %d." occur-match lineno)
(hpath:display-buffer buffer)
(goto-char (point-min))
(forward-line (1- lineno)))))
(defalias 'moccur-mode-goto-occurrence 'moccur-to)
(defun moccur-mode-display-occurrence ()
"Display in another window the occurrence the current line describes."
(interactive)
(let* ((result (moccur-noselect))
(buffer (car result))
(lineno (cadr result)))
(when result
;; This is the way to set point in the proper window.
(save-selected-window
(hpath:display-buffer buffer)
(goto-char (point-min))
(forward-line (1- lineno))))))
;;; ************************************************************************
;;; Private functions
;;; ************************************************************************
(put 'moccur-mode 'mode-class 'special)
(define-derived-mode moccur-mode special-mode "Moccur"
"Major mode for output from \\[moccur].
\\<moccur-mode-map>Move point to one of the items in this buffer, then use
\\[moccur-to] to go to the occurrence on the current line.
\\[moccur-mode-display-occurrence] displays but does not select the occurrence.
\\{moccur-mode-map}"
(kill-all-local-variables)
(use-local-map moccur-mode-map)
(setq major-mode 'moccur-mode)
(setq mode-name "Moccur"))
(defun moccur-noselect ()
"Return match data for the current moccur buffer line.
Match data is returned as a list (destination-buffer line-number
occur-match-text). Signal an error if not on a valid occurrence
line."
(if (not (eq major-mode 'moccur-mode))
(error "'moccur-to' must be called within a moccur buffer")
(let (beg file-path lineno dstbuf occur-match)
(save-excursion
(beginning-of-line)
(setq beg (point))
(end-of-line)
(setq occur-match (buffer-substring beg (point)))
(if (string-match "^[ ]*[0-9]+:" occur-match)
(progn
(setq lineno (string-to-number (substring
occur-match 0 (match-end 0))))
(if (re-search-backward
(concat "^" moccur-source-prefix
"\"?\\([^\" \n\r]+\\)\"?") nil t)
(progn
(setq file-path (buffer-substring
(match-beginning 1) (match-end 1))
dstbuf (find-file-noselect file-path))
(if (not dstbuf)
(message
"moccur-to: file '%s' is not readable" file-path)))
(error "No moccur header line for file")))
(error "Not an moccur occurrence line")))
(if (and dstbuf lineno)
(list dstbuf lineno occur-match)))))
;;; ************************************************************************
;;; Private variables
;;; ************************************************************************
(defvar moccur-mode-map nil)
(unless moccur-mode-map
(setq moccur-mode-map (make-sparse-keymap))
(define-key moccur-mode-map "\C-c\C-c" 'moccur-to)
(define-key moccur-mode-map "\C-o" 'moccur-mode-display-occurrence)
(define-key moccur-mode-map " " 'moccur-to)
(define-key moccur-mode-map "\C-m" 'moccur-to))
(provide 'hmoccur)
;;; hmoccur.el ends here