Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
marvel
GitHub Repository: marvel/qnf
Path: blob/master/elisp/color-moccur.el
987 views
1
;;; color-moccur.el --- multi-buffer occur (grep) mode
2
;; -*- Mode: Emacs-Lisp -*-
3
4
;; $Id: color-moccur.el,v 2.71 2010-05-06 13:40:54 Akihisa Exp $
5
6
;; This program is free software; you can redistribute it and/or
7
;; modify it under the terms of the GNU General Public License as
8
;; published by the Free Software Foundation; either version 3, or (at
9
;; your option) any later version.
10
11
;; This program is distributed in the hope that it will be useful, but
12
;; WITHOUT ANY WARRANTY; without even the implied warranty of
13
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14
;; General Public License for more details.
15
16
;; You should have received a copy of the GNU General Public License
17
;; along with GNU Emacs; see the file COPYING. If not, write to the
18
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19
;; Boston, MA 02110-1301, USA.
20
21
;;;; for hi-lock
22
;; Hi-lock: (("^;;; .*" (0 (quote hi-black-hb) t)))
23
;; Hi-lock: (("^;;;; .*" (0 (quote hi-black-b) t)))
24
;; Hi-lock: (("make-variable-buffer-\\(local\\)" (0 font-lock-keyword-face)(1 'italic append)))
25
;; Hi-lock: end
26
27
;;; Commentary:
28
;; If this program doesn't run, I might change the program for the
29
;; worse. So please send mail to [email protected] .
30
31
;; This elisp is the extention of moccur.el.
32
;; Thanks to the authors for writing moccur.el
33
34
;; With color-moccur, you can search a regexp in all buffers. And you
35
;; can search files like grep(-find) without grep (and find) command.
36
37
;;; Motivation
38
;; moccur is a major mode modelled after the 'Occur' mode of the
39
;; standard distribution. It is quite nice to use when you need to
40
;; work with a lot of buffers.
41
;;
42
;; Incompatibilites to Occur mode:
43
;; a) it browses through *all* buffers that have a file name
44
;; associated with them; those may or may not include the current
45
;; buffer. Especially, while standard occur works
46
;; on 'all lines following point', Moccur does not.
47
;; b) there is no support for the 'NLINE' argument.
48
49
;;; Install:
50
;; Put this file into load-path'ed directory, and byte compile it if
51
;; desired. And put the following expression into your ~/.emacs.
52
;;
53
;; (require 'color-moccur)
54
55
;; The latest version of this program can be downloaded from
56
;; http://www.bookshelf.jp/elc/color-moccur.el
57
58
;; moccur-edit.el
59
;; With this packege, you can edit *moccur* buffer and apply
60
;; the changes to the files.
61
;; You can get moccur-edit.el at
62
;; http://www.bookshelf.jp/elc/moccur-edit.el
63
64
;;; Functions
65
;; moccur, dmoccur, dired-do-moccur, Buffer-menu-moccur,
66
;; grep-buffers, search-buffers, occur-by-moccur
67
;; isearch-moccur
68
;; moccur-grep, moccur-grep-find
69
70
;;; usage:moccur
71
;; moccur <regexp> shows all occurrences of <regexp> in all buffers
72
;; currently existing that refer to files.
73
;; The occurrences are displayed in a buffer running in Moccur mode;
74
;;;; keybind
75
;; C-c C-c or RET gets you to the occurrence
76
;; q : quit
77
;; <up>, n, j : next matches
78
;; <down>, p, k : previous matches
79
;; b :scroll-down in matched buffer
80
;; SPC : scroll-up in matched buffer
81
;; M-v :scroll-down in moccur buffer
82
;; C-v : scroll-up in moccur buffer
83
;; < : M-< in matched buffer
84
;; > : M-> in matched buffer
85
;; t : toggle whether a searched buffer is displayed to other window.
86
;; r : re-search in only matched buffers.
87
;; d,C-k : kill-line
88
;; M-x moccur-flush-lines : flush-lines for moccur
89
;; M-x moccur-keep-lines : keep-lines for moccur
90
;; / : undo (maybe doesn't work)
91
;; s : run moccur by matched bufffer only.
92
;; u : run moccur by prev condition
93
94
;;; usage:moccur-grep, moccur-grep-find
95
;; moccur-grep <regexp> shows all occurrences of <regexp> in files of current directory
96
;; moccur-grep-find <regexp> shows all occurrences of <regexp>
97
;; in files of current directory recursively.
98
;;
99
;;;; Variables of M-x moccur-grep(-find)
100
;; dmoccur-exclusion-mask : if filename matches the regular
101
;; expression, dmoccur/moccur-grep *doesn't* open the file.
102
;;
103
;; dmoccur-maximum-size: Maximum size (kB) of a buffer for dmoccur and
104
;; moccur-grep(-find).
105
;;
106
;; moccur-following-mode-toggle :
107
;; If this value is t, cursor motion in the moccur buffer causes
108
;; automatic display of the corresponding buffer location.
109
;;
110
;; moccur-grep-following-mode-toggle :
111
;; If this value is t, cursor motion in the moccur-grep buffer causes
112
;; automatic display of the corresponding source code location.
113
;;
114
;; moccur-grep-default-word-near-point :
115
;; If this value is t, moccur-grep(-find) command get a word near the
116
;; point as default regexp string
117
;;
118
;; moccur-grep-default-mask :
119
;; example in .emacs: (setq-default moccur-grep-default-mask ".el")
120
;; File-mask string used for default in moccur-grep and moccur-grep-find
121
;; Run moccur-grep, and chose directory, in minibuffer, following text is displayed
122
;; Input Regexp and FileMask: .el
123
124
;;; usage:isearch-moccur
125
;; isearch and M-o
126
;; Run `moccur' with current isearch string.
127
;; isearch and M-O
128
;; Run `moccur' with current isearch string in all buffers.
129
130
;;; usage:M-x occur-by-moccur
131
;; suearch current buffer by moccur
132
133
;;; usage:Buffer-menu-moccur
134
;; `Buffer-menu-moccur' command searches buffers marked in
135
;; buffer-menu or ibuffer.
136
137
;;; usage:dired-do-moccur
138
;; Search through all marked files in dired buffer.
139
140
;;; usage:search-buffers <regexp>
141
;; junk tool. To search all buffers, type in
142
;; a few descriptive words like "setq gnus" hit the 'enter' key.
143
;; This program only returns web pages that contain all the words in
144
;; your query. And Type RET in the result buffer to call moccur.
145
146
;;; usage:grep-buffers <regexp>
147
;; Run grep on all visited files.
148
149
;;; usage:M-x dmoccur
150
;; dmoccur opens files under current directory, and searches your
151
;; regular expression by moccur.
152
153
;;;; Variables of M-x dmoccur
154
;; dmoccur-mask : if filename matches the regular expression, dmoccur
155
;; opens the file.
156
;; dmoccur-exclusion-mask : if filename matches the regular
157
;; expression, dmoccur/moccur-grep *doesn't* open the file.
158
;; dmoccur-maximum-size : Only buffers less than this can be opend.
159
160
;;;; C-u M-x dmoccur
161
;; Probably you will search same directory many times. So dmoccur has
162
;; your favorite directory list. And if you input a name, dmoccur can
163
;; search files under a directory.
164
165
;;;; variable:dmoccur-mask
166
;; dmoccur-mask is masks for searched file. defult is (".*").
167
168
;;;; variable:dmoccur-maximum-size
169
;; Maximum size (kB) of a searched buffer by dmoccur.
170
171
;;;; variable:dmoccur-exclusion-mask
172
;; dmoccur-exclusion-mask is masks for *not* searched file by dmoccur and moccur-grep(-find).
173
174
;;;; Variables of C-u M-x dmoccur
175
;; dmoccur-list : Your favorite directory list. This valiable is used
176
;; as bellow.
177
178
;; (setq dmoccur-list
179
;; '(
180
;; ;;name directory mask option
181
;; ("dir" default-directory (".*") dir)
182
;; ("config" "~/mylisp/" ("\\.js" "\\.el$") nil)
183
;; ("multi" (("~/mylisp/")
184
;; ("~/lisp/")) ("\\.js" "\\.el$") nil)
185
;; ("emacs" "d:/unix/emacs/" (".*") sub)
186
;; ))
187
188
;; name : Input your favorite name
189
;; directory : Directory you'd like to search
190
;; mask : list of file-mask (regular expression).
191
;; option : usually option is nil. If option is "dir", you can select
192
;; directory like find-file. If option is "sub", you can select sub
193
;; directory.
194
195
;; Moreover you can also customize dmoccur-list as bellow.
196
;; (setq dmoccur-list
197
;; '(
198
;; ;; multi-directory can be setted if option is nil
199
;; ("soft"
200
;; (
201
;; ("~/www/soft/")
202
;; ("~/mylisp/")
203
;; )
204
;; ("\\.texi$") nil)
205
;;
206
;; ;; In ~/mylisp, dmoccur search files recursively.
207
;; ;; and dmoccur search files in ~/user.
208
;; ("test-recursive"
209
;; (("~/mylisp" t)
210
;; ("~/user"))
211
;; (".*") nil)
212
;;
213
;; ;; In ~/mylisp, dmoccur search files recursively
214
;; ;; but if (string-match ".+.txt" filename)
215
;; ;; or (string-match ".+.el" filename) is t,
216
;; ;; the file is *not* searched.
217
;; ("ignore-txt"
218
;; (("~/mylisp" t (".+.txt" ".+.el"))
219
;; ("~/user"))
220
;; (".*") nil)
221
;;
222
;; ;; if option is dir (or sub),
223
;; ;; you can set single directory only.
224
;; ("dir-recursive" ((default-directory t)) (".*") dir)
225
;; ))
226
227
;;; variables
228
;;;; moccur-split-word
229
;; non-nil means to input word splited by space. You can search
230
;; "defun color-moccur (regexp)" by "defun regexp" or "regexp defun".
231
;; You don't need to input complicated regexp.
232
;; And you can search "defun" in buffers whose name match "moccur".
233
234
;;;; dmoccur-use-list
235
;; if non-nill, M-x dmoccur is equal to C-u M-x dmoccur.
236
237
;;;; dmoccur-use-project
238
;; dmoccur need a name of dmoccur-list. If dmoccur-use-project is nil,
239
;; you have to type a name every time. If dmoccur-use-project is
240
;; non-nil and you searched current buffer by a name of dmoccur,
241
;; dmoccur use the name.
242
243
;;;; moccur-use-ee
244
;; non-nil means to display a result by ee.
245
;; ee: http://www.jurta.org/emacs/ee/
246
;; if you use allout.el, it's not displayed by ee.
247
248
;;; sample settings
249
;; (load "color-moccur")
250
;; (setq *moccur-buffer-name-exclusion-list*
251
;; '(".+TAGS.+" "*Completions*" "*Messages*"
252
;; "newsrc.eld" ".bbdb"))
253
;; (setq moccur-split-word t)
254
;; (setq dmoccur-use-list t)
255
;; (setq dmoccur-use-project t)
256
;; (setq dmoccur-list
257
;; '(
258
;; ("dir" default-directory (".*") dir)
259
;; ("soft" "~/www/soft/" ("\\.texi$") nil)
260
;; ("config" "~/mylisp/" ("\\.js" "\\.el$") nil)
261
;; ("1.99" "d:/unix/Meadow2/1.99a6/" (".*") sub)
262
;; ))
263
;; (global-set-key "\C-x\C-o" 'occur-by-moccur)
264
;; (define-key Buffer-menu-mode-map "O" 'Buffer-menu-moccur)
265
;; (define-key dired-mode-map "O" 'dired-do-moccur)
266
;; (global-set-key "\C-c\C-x\C-o" 'moccur)
267
;; (global-set-key "\M-f" 'grep-buffers)
268
;; (global-set-key "\C-c\C-o" 'search-buffers)
269
270
;;; Furthermore
271
;;;; Function for regexp
272
;; (moccur-set-regexp)
273
;; function to set up regexp.
274
;; if moccur-split-word is non-nil,
275
;; *moccur-regexp-list* is list of regexp.
276
;; ex. "defun search" -> moccur-regexp-list = '("defun" "search")
277
;; "^[ ]+( search" -> moccur-regexp-list = '("^[ ]+(" "search")
278
279
;;;; Search Function
280
;; (moccur-search-line <regexp>) : my original function.
281
;; basically (re-search-forward regexp nil t) (default)
282
;; If moccur-split-word is non-nil,
283
;; regexp for *moccur-search-line* is created by *moccur-set-regexp*
284
;; and *moccur-search-line* returns lines that include all of your search terms.
285
;; ex. (moccur-search-line "moccur defun line") matches
286
;; (defun moccur-search-line
287
;; and
288
;; (defun test () (moccur-search-line regexp))
289
290
;; (moccur-search-buffer (&optional regexp currbuf name))
291
;; Search <regexp> in <currbuf>, and output result.
292
;; Special feature
293
;; if moccur-split-word is non-nil, first word is special.
294
;; if first word is ";", that is, "; function",
295
;; moccur-search-buffer returns lines that is comment.
296
;; "! function" -> return lines that is function.
297
;; "" string" -> return lines that is string.
298
;; "/ comment" -> return lines that is comment.
299
300
;; moccur-set-regexp
301
;; convert regexp for moccur.
302
303
;; if moccur-use-keyword is non-nil and
304
;; keyword of moccur-search-keyword-alist is in regexp,
305
;; convert keyword to <regexp>
306
;; ex. "url" -> "[fht]*ttp://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+"
307
308
;;; Idea and Todo
309
310
;; if you have idea or function you want,
311
;; please mail to [email protected]
312
;;
313
;; Document
314
;; --> Add doc-string :)
315
;; --> defvar to defcustom
316
;;
317
;; Search
318
;; --> speed up
319
;; --> restrict ee
320
;; --> ee is slow, if count of matches is large
321
;; --> moccur stop, if result is large
322
;; --> search word
323
;; --> use history like \1 (latest word)
324
;; --> multiline search
325
;;
326
;; Buffers
327
;; --> M-x dmoccur M-x moccur : many buffers are displayed
328
;; --> I'd like to make variable to select buffers to search.
329
;; --> e.g. if current buffer is emacs-lisp-mode,
330
;; buffers which is emacs-lisp-mode are searched in moccur.
331
;;
332
;; Usability
333
;; --> in moccur buffer, I have to type "lllllll" or "C-u 7 l".
334
;; I'd like to change to displayed buffer like iswitch.
335
;; --> matched buffer list
336
;; --> add keybind (e.g. mouse...)
337
;;
338
;; moccur buffer
339
;; --> Add sort method (now alphabetic order of buffer-name)
340
;; --> probably
341
;; buffers with same major-mode have relations...
342
;; files in same directory have relations
343
;; same extention?
344
;;
345
;; Bug
346
;; --> with ee, can't undo step by step
347
;;
348
;; dmoccur
349
;; --> very difficult
350
;; --> Add dired-d:/home/memo/, when I searched in a directory.
351
;; --> customize buffer-menu.
352
;; with many buffers, buffer-menu overflow.
353
354
;;; History:
355
356
;; 2010/05/06
357
;; Add user variable (moccur-following-mode-toggle)
358
359
;; 2010/04/14
360
;; Bug fix
361
;; I changed next-line to forward-line in moccur-prev and moccur-next
362
363
;; 2010/02/23
364
;; Bug fix.
365
;; line 2199
366
;; (cdr (reverse inputs))) -> (reverse (cdr (reverse inputs))))
367
;; Thanks for patch!
368
369
;; 2008/7/27
370
;; Bug fix.
371
;; Add wheel mouse keybind.
372
373
;; 2008/7/25
374
;; Turned (back) on the key binding "t" to "moccur-toggle-view" command in moccur-grep-mode
375
;; Command "moccur-narrow-down" now also works in moccur-grep-mode.
376
;; Thanks Mr. Lin. Your changes are great.
377
378
;; 2007/12/22
379
;; Add command "g" (moccur-search-update) in *moccur* buffer
380
;; Abd bug fix (Thanks Mr. Lin)
381
382
;; 2007/12/16
383
;; Add command "u" (moccur-search-undo) in *moccur* buffer
384
;; Update regexp (Thanks Mr. Lin)
385
386
;; 2007/09/05
387
;; Remove obsolete function
388
389
;; 2005/11/16
390
;; Add option:moccur-grep-following-mode-toggle
391
392
;; 2004/09/23
393
;; Bug fix
394
395
;; 2004/04/30
396
;; Add moccur-grep and moccur-grep-find
397
398
;; 2004/01/13
399
;; defvar -> defcustom
400
401
;; 2004/01/05
402
;; Add moccur-search-keyword-alist
403
404
;; 2003/12/24
405
;; changed value of *moccur-buffer-name-exclusion-list*
406
;; New functions:isearch-moccur-all ("M-O" isearch-mode-map)
407
;; Add moccur-kill-buffer-after-goto
408
409
;; 2003/12/17
410
;; Bug fix: moccur-prev didn't move the cursor to another buffer.
411
;; Bug fix: if moccur-split-word is nil, special-word was used.
412
413
;; 2003/12/16
414
;; Update: moccur-color-view
415
;; Update: search-buffers-mode
416
;; RET: changed search-buffers-goto to search-buffers-call-moccur
417
418
;; 2003/12/15
419
;; Bug fix: moccur-split-string
420
421
;; 2003/12/12
422
;; dmoccur-list: can set file-name instead of directory
423
;; sample
424
;; (setq dmoccur-list
425
;; '(
426
;; ("memo" (("~/clmemo.txt") ;; filename
427
;; ("~/memo/" t) ;; directory
428
;; ) (".*") nil nil)
429
;; ))
430
;; Removed internal variable, moccur-regexp
431
432
;; New variable: moccur-special-word-list
433
;; if moccur-split-word is t, first word is special.
434
435
;; Example:
436
;; List lines matching regexp: ; moccur
437
;; This regexp matches comment only.
438
439
;; List lines matching regexp: " moccur
440
;; This regexp matches string only like "moccur"
441
442
;; List lines matching regexp: ! moccur
443
;; This regexp matches function only like defun moccur.
444
445
;; 2003/11/30
446
;; New functions:occur-by-moccur,isearch-moccur
447
448
;; 2003/11/28
449
;; Bug fix: if moccur-split-word is t, when "[" is searched, error
450
451
;; 2003/11/26
452
;; Bug fix: set kill-buffer-after-dired-do-moccur to t and run
453
;; dired-do-moccur. After that, if you run moccur, buffers were killed.
454
;; New function:
455
;; In dired buffer, if a directory is marked and you run
456
;; dired-do-moccur, you can search files in the directory.
457
458
;; 2003/11/25
459
;; Upgrade many functions. But I can't remember changes :)
460
461
;; 2003/06/13
462
;; Matsushita Akihisa <[email protected]> improved moccur.
463
;; Add dmoccur, dired-do-moccur, Buffer-menu-moccur, and so on.
464
465
;; 2002 or 2003
466
;; color-moccur 1.0 was released to the net
467
468
;; moccur 1.0 was released to the net on August 1st, 1991
469
;; [email protected] (Craig Steury) provided the exclusion list
470
;; facility, which was changed to to regexps and enhanced with a
471
;; inclusion list.
472
473
;;; Code:
474
(eval-when-compile (require 'cl))
475
476
(defgroup color-moccur nil
477
"Customize color-moccur"
478
:group 'matching)
479
480
;;; variables
481
;;;; user variables
482
(defface moccur-face
483
'((((class color)
484
(background dark))
485
(:background "light grey" :bold t :foreground "Black"))
486
(((class color)
487
(background light))
488
(:background "light cyan" :bold t))
489
(t
490
()))
491
"*Face used by moccur to show the text that matches."
492
:group 'color-moccur
493
)
494
495
(defface moccur-current-line-face
496
'((((class color)
497
(background dark))
498
(:underline t))
499
(((class color)
500
(background light))
501
(:underline t))
502
(t
503
()))
504
"*Face used by moccur."
505
:group 'color-moccur
506
)
507
508
(defcustom moccur-kill-moccur-buffer nil
509
"*Non-nil means to kill *Moccur* buffer automatically when you exit *Moccur* buffer."
510
:group 'color-moccur
511
:type 'boolean
512
)
513
514
(defcustom moccur-use-migemo nil
515
"*Non-nil means to use migemo (for Japanese). migemo.el is required."
516
:group 'color-moccur
517
:type 'boolean
518
)
519
520
(defcustom moccur-split-word nil
521
"*Non-nil means means to input word splited by space.
522
You can search \"defun color-moccur (regexp)\" by \"defun regexp\" or
523
\"regexp defun\". You don't need to input complicated regexp. But
524
you can not input regexp including space.."
525
:group 'color-moccur
526
:type 'boolean
527
)
528
529
(defcustom color-moccur-default-ime-status t
530
"*Non-nil means to inherit ime status."
531
:group 'color-moccur
532
:type 'boolean
533
)
534
535
(defcustom *moccur-buffer-name-exclusion-list*
536
'("TAGS" "*Completions*" "*Messages*" "^[ ].+")
537
"Contains a list of regexps which don't search by moccur.
538
Matching buffers are *not* searched for occurrences. Per default, the
539
TAGS file is excluded."
540
:group 'color-moccur
541
:type '(repeat regexp)
542
)
543
544
(defcustom *moccur-buffer-name-inclusion-list* '("[^ ].*")
545
"Contains a list of regexps. *Only* matching buffers are searched.
546
Per default, this var contains only a \".*\" catchall-regexp."
547
:group 'color-moccur
548
:type '(repeat regexp)
549
)
550
551
(defcustom dmoccur-mask '(".*")
552
"Mask for dmoccur."
553
:group 'color-moccur
554
:type '(repeat regexp)
555
)
556
557
(defcustom dmoccur-maximum-size nil
558
"*Maximum size (kB) of a buffer for dmoccur and moccur-grep(-find)."
559
:group 'color-moccur
560
:type '(choice
561
number
562
(const :tag "infinite" nil))
563
)
564
565
(defcustom dmoccur-exclusion-mask
566
'( ;; binary
567
"\\.elc$" "\\.exe$" "\\.dll$" "\\.lib$" "\\.lzh$"
568
"\\.zip$" "\\.deb$" "\\.gz$" "\\.pdf$" "\\.tar$"
569
"\\.gz$" "\\.7z$" "\\.o$" "\\.a$" "\\.mod$"
570
"\\.nc$" "\\.obj$" "\\.ai$" "\\.fla$" "\\.swf$"
571
"\\.dvi$" "\\.pdf$" "\\.bz2$" "\\.tgz$" "\\.cab$"
572
"\\.sea$" "\\.bin$" "\\.fon$" "\\.fnt$" "\\.scr$"
573
"\\.tmp$" "\\.wrl$" "\\.Z$"
574
;; sound & movie
575
"\\.aif$" "\\.aiff$" "\\.mp3$" "\\.wma$" "\\.mpg$"
576
"\\.mpeg$" "\\.aac$" "\\.mid$" "\\.au$" "\\.avi$" "\\.dcr$"
577
"\\.dir$" "\\.dxr$" "\\.midi$" "\\.mov$" "\\.ra$" "\\.ram$"
578
"\\.vdo$" "\\.wav$"
579
;; Microsoft
580
"\\.doc$" "\\.xls$" "\\.ppt$" "\\.mdb$" "\\.adp$"
581
"\\.wri$"
582
;; image
583
"\\.jpg$" "\\.gif$" "\\.tiff$" "\\.tif$" "\\.bmp$"
584
"\\.png$" "\\.pbm$" "\\.jpeg$" "\\.xpm$" "\\.pbm$"
585
"\\.ico$" "\\.eps$" "\\.psd$"
586
;;etc
587
"/TAGS$"
588
;; backup file
589
"\\~$"
590
;; version control
591
"\\.svn/.+" "CVS/.+" "\\.git/.+"
592
)
593
"*List of file extensions which are excepted to search by dmoccur and moccur-grep(-find)."
594
:group 'color-moccur
595
:type '(repeat regexp)
596
)
597
598
(defcustom dmoccur-use-list nil
599
"Non-nil means to use your favorite directory list."
600
:group 'color-moccur
601
:type 'boolean
602
)
603
604
(defcustom dmoccur-use-project nil
605
"Non-nil means to use your favorite directory list."
606
:group 'color-moccur
607
:type 'boolean
608
)
609
610
(defcustom moccur-use-ee nil
611
"Non-nil means to use ee. However, this feature doesn't work now"
612
:group 'color-moccur
613
:type 'boolean
614
)
615
616
(defcustom kill-buffer-after-dired-do-moccur nil
617
"Non-nil means to kill buffer after dired do moccur."
618
:group 'color-moccur
619
:type 'boolean
620
)
621
622
(defcustom dmoccur-list
623
'(
624
;; name directory mask option
625
;; option = nil , dir , sub
626
("dir" default-directory (".*") dir)
627
("lisp" "~/mylisp/" ("\\.el" "\\.*texi") nil))
628
"*List of directory which are searched by dmoccur."
629
:group 'color-moccur
630
:type '(repeat
631
(list (string :tag "Name")
632
(choice
633
(directory :tag "Directory")
634
(file :tag "Filename")
635
(symbol :tag "Variable")
636
(repeat :tag "Advanced setting"
637
(list
638
(choice
639
(directory :tag "Directory")
640
(symbol :tag "Variable"))
641
(boolean :tag "Recursively" nil)
642
(repeat :tag "File Mask"
643
(regexp :tag "File Mask not to search")))))
644
(repeat :tag "File Mask" :default nil
645
(regexp :tag "File Mask" ".*"))
646
(choice :tag "Option" :default nil
647
(const :tag "Default" nil)
648
(const :tag "Directory" dir)
649
(const :tag "Subdirectory" sub))
650
(choice :tag "Control Migemo and Split" :default nil
651
(const :tag "Default" nil)
652
(list (boolean :tag "Use Migemo" nil)
653
(boolean :tag "Split Regexp" nil)))
654
(choice :tag "Default regexp" :default nil
655
(const :tag "Empty" nil)
656
(string :tag "Regexp" "")
657
(symbol :tag "Function to make regexp")))))
658
659
(defcustom moccur-maximum-displayed-with-color 500
660
"Max number that is displayed with color."
661
:group 'color-moccur
662
:type 'number
663
)
664
665
(defcustom dmoccur-recursive-search nil
666
"Non-nil means to search files recursively."
667
:group 'color-moccur
668
:type 'boolean
669
)
670
671
(defcustom moccur-buffer-sort-method 'moccur-filepath-string<
672
"Function to sort buffers."
673
:group 'color-moccur
674
:type 'symbol
675
)
676
677
(defcustom moccur-special-word-list
678
'(
679
(";"
680
moccur-face-initialization
681
moccur-comment-check)
682
("/"
683
moccur-face-initialization
684
moccur-comment-check)
685
("\""
686
moccur-face-initialization
687
moccur-string-check)
688
("!"
689
moccur-face-initialization
690
moccur-function-check)
691
(t ;; default
692
moccur-default-initial-function
693
moccur-default-check-function
694
)
695
)
696
"Special-word function-to-initialize function-to-check."
697
:group 'color-moccur
698
:type '(repeat
699
(list (choice (string :tag "Keyword")
700
(const :tag "Default" t))
701
(symbol :tag "Function to initialize")
702
(symbol :tag "Function to check")
703
)))
704
705
(defcustom moccur-kill-buffer-after-goto nil
706
"Non-nil means to kill *moccur* buffer after goto-occurrence."
707
:group 'color-moccur
708
:type 'boolean
709
)
710
711
(defcustom moccur-search-keyword-alist
712
'(("url" . "[fht]*ttp://[-_.!~*'()a-zA-Z0-9;/?:@&=+$,%#]+")
713
("mail" . "[^][<>@ \n]+@[-_!~*'()a-zA-Z0-9?@&=+$,%#]+\\.[-_.!~*'()a-zA-Z0-9?@&=+$,%#]+"))
714
"*Alist of KEYWORD and REGEXP."
715
:group 'color-moccur
716
:type '(repeat
717
(cons (string :tag "Keyword")
718
(regexp :tag "Regexp"))))
719
720
(defcustom moccur-use-keyword nil
721
"Non-nil means to use moccur-search-keyword-alist."
722
:group 'color-moccur
723
:type 'boolean
724
)
725
726
(defcustom moccur-use-xdoc2txt
727
(if
728
(and
729
(locate-library "xdoc2txt.exe" nil exec-path)
730
(if (file-name-extension shell-file-name)
731
(locate-library shell-file-name nil exec-path)
732
(locate-library (concat shell-file-name ".exe") nil exec-path)))
733
t
734
nil)
735
"Non-nil means to use xdoc2txt.
736
xdoc2txt is Windows software to convert Word/Excel/PDF etc to Text file.
737
http://www31.ocn.ne.jp/~h_ishida/xdoc2txt.html (Japanese site)"
738
:group 'color-moccur
739
:type 'boolean
740
)
741
742
(defcustom moccur-grep-xdoc2txt-maximum-size 1000
743
"*Maximum size (kB) of a buffer for xdoc2txt."
744
:group 'color-moccur
745
:type 'number
746
)
747
748
(defcustom moccur-grep-xdoc2txt-exts '(
749
"\\.rtf" "\\.doc" "\\.xls" "\\.ppt"
750
"\\.jaw" "\\.jtw" "\\.jbw" "\\.juw"
751
"\\.jfw" "\\.jvw" "\\.jtd" "\\.jtt"
752
"\\.oas" "\\.oa2" "\\.oa3" "\\.bun"
753
"\\.wj2" "\\.wj3" "\\.wk3" "\\.wk4"
754
"\\.123" "\\.wri" "\\.pdf" "\\.mht")
755
"*List of file extensions which are handled by xdoc2txt."
756
:type '(repeat string)
757
:group 'Meadow-Memo)
758
759
(defcustom moccur-following-mode-toggle t
760
"When t, cursor motion in the moccur buffer causes
761
automatic display of the corresponding buffer location."
762
:group 'color-moccur
763
:type 'boolean)
764
765
(defcustom moccur-grep-following-mode-toggle t
766
"When t, cursor motion in the moccur-grep buffer causes
767
automatic display of the corresponding source code location."
768
:group 'color-moccur
769
:type 'boolean)
770
771
(defcustom moccur-grep-default-word-near-point nil
772
"When t, get a word near the point as default regexp string"
773
:group 'color-moccur
774
:type 'boolean)
775
776
(defvar moccur-grep-default-mask nil
777
"File-mask string used for default in moccur-grep and moccur-grep-find")
778
(make-variable-buffer-local 'moccur-grep-default-mask)
779
780
;;; Internal variables
781
;;;; moccur
782
(defvar moccur-buffer-heading-regexp "^[-+ ]*Buffer: \\([^\r\n]+\\) File: \\([^\r\n]+\\)$"
783
"Regexp for matching buffer heading line in moccur-mode buffer.")
784
(defvar moccur-grep-buffer-heading-regexp "^[-+ ]*Buffer: File (grep): \\([^\r\n]+\\)$"
785
"Regexp for matching buffer heading line in moccur-grep-mode buffer.")
786
(defvar moccur-line-number-regexp "^[ ]*\\([0-9]+\\) "
787
"Regexp for matching line numbers in moccur buffer.")
788
(defvar regexp nil)
789
(defvar moccur-list nil)
790
(defvar moccur-overlays nil)
791
(make-variable-buffer-local 'moccur-overlays)
792
(defvar moccur-current-line-overlays nil)
793
(defvar moccur-regexp-color "")
794
(defvar moccur-regexp-list nil)
795
(defvar moccur-file-name-regexp nil)
796
(defvar moccur-regexp-input "")
797
(defvar moccur-buffer-name "")
798
(defvar moccur-buffer-match-count nil)
799
(defvar moccur-before-buffer-name "")
800
(defvar moccur-line nil)
801
(defvar buffer-menu-moccur nil)
802
(defvar moccur-view-other-window t)
803
(make-variable-buffer-local 'moccur-view-other-window)
804
(defvar moccur-view-other-window-nobuf t)
805
(make-variable-buffer-local 'moccur-view-other-window-nobuf)
806
(defvar moccur-current-buffer nil)
807
(defvar moccur-buffer-position nil)
808
(make-variable-buffer-local 'moccur-buffer-position)
809
(defvar moccur-buffers nil)
810
(defvar moccur-match-buffers nil)
811
(defvar moccur-buffers-before-moccur nil)
812
(defvar moccur-matches nil)
813
(defvar moccur-mocur-buffer nil)
814
(defvar moccur-last-command nil)
815
(defvar moccur-windows-conf nil)
816
(defvar moccur-special-word nil)
817
(defvar moccur-fontlock-buffer nil)
818
(make-variable-buffer-local 'moccur-fontlock-buffer)
819
;;;; dmoccur
820
(defvar dmoccur-mask-internal nil)
821
(defvar dmoccur-history nil)
822
(defvar dmoccur-list-history nil)
823
(defvar dmoccur-buffer-project nil)
824
(make-variable-buffer-local 'dmoccur-buffer-project)
825
(defvar dmoccur-project-name nil)
826
(defvar dmoccur-project-list nil)
827
(defvar dmoccur-recursive-ignore-dir nil)
828
;;;; moccur-grep
829
(defvar moccur-grep-buffer-list nil)
830
(make-variable-buffer-local 'moccur-grep-buffer-list)
831
(defvar moccur-xdoc2txt-buffers nil)
832
(make-variable-buffer-local 'moccur-xdoc2txt-buffers)
833
(defvar moccur-run-meadow-onwin
834
(and
835
;; run win32
836
(and
837
(null
838
(or (equal system-type 'gnu/linux)
839
(equal system-type 'usg-unix-v)))
840
(or (equal system-type 'windows-nt)
841
(equal system-type 'ms-dos)))
842
;; meadow
843
(featurep 'meadow)))
844
(defvar moccur-grep-search-file-pos nil)
845
846
;;; For All Emacs
847
(defmacro string> (a b) (list 'not (list 'or (list 'string= a b)
848
(list 'string< a b))))
849
(autoload 'migemo-get-pattern "migemo" "migemo-get-pattern" nil)
850
851
;;; For xemacs
852
(unless (fboundp 'match-string-no-properties)
853
(defalias 'match-string-no-properties 'match-string))
854
(when (and (boundp 'running-xemacs) running-xemacs)
855
(require 'overlay)
856
(if (not (functionp 'line-beginning-position))
857
(fset 'line-beginning-position 'point-at-bol))
858
(if (not (functionp 'line-end-position))
859
(fset 'line-end-position 'point-at-eol)))
860
861
;;; moccur and other packages
862
;;;; moccur + isearch
863
(defun isearch-moccur ()
864
"Invoke `moccur' from isearch within `current-buffer'."
865
(interactive)
866
(let ((case-fold-search isearch-case-fold-search) (isearch-buffer (current-buffer)))
867
(isearch-exit)
868
(moccur-setup)
869
(moccur-search
870
(if isearch-regexp
871
isearch-string
872
(regexp-quote isearch-string))
873
t
874
(list isearch-buffer))))
875
876
(defun isearch-moccur-all ()
877
"Invoke `moccur' from isearch in all buffers."
878
(interactive)
879
(let ((case-fold-search isearch-case-fold-search)
880
(buffers (moccur-filter-buffers (buffer-list))))
881
;; sort
882
(setq buffers (sort buffers moccur-buffer-sort-method))
883
(isearch-exit)
884
(moccur-setup)
885
(moccur-search
886
(if isearch-regexp
887
isearch-string
888
(regexp-quote isearch-string))
889
t
890
buffers)))
891
892
(define-key isearch-mode-map (kbd "M-o") 'isearch-moccur)
893
(define-key isearch-mode-map (kbd "M-O") 'isearch-moccur-all)
894
895
;;;; occur
896
(defun occur-by-moccur (regexp arg)
897
"Use this instead of occur.
898
Argument REGEXP regexp.
899
Argument ARG whether buffers which is not related to files are searched."
900
(interactive (list (moccur-regexp-read-from-minibuf)
901
current-prefix-arg))
902
(moccur-setup)
903
904
(setq moccur-regexp-input regexp)
905
906
(let ((buffers (list (current-buffer))))
907
(moccur-search regexp t buffers)))
908
909
;;; moccur:function
910
;;;; utility
911
(defun moccur-filepath-string< (buf1 buf2)
912
"String< by function `buffer-file-name'.
913
Argument BUF1 BUFFER.
914
Argument BUF2 BUFFER."
915
(if (and (buffer-file-name buf1)
916
(buffer-file-name buf2))
917
(string< (buffer-file-name buf1) (buffer-file-name buf2))
918
(if (buffer-file-name buf1)
919
buf1
920
(if (buffer-file-name buf2)
921
buf2
922
(string< (buffer-name buf1) (buffer-name buf2))))))
923
924
(defun moccur-buffer-string< (buf1 buf2)
925
"String< by `buffer-name'.
926
Argument BUF1 BUFFER.
927
Argument BUF2 BUFFER."
928
(string< (buffer-name buf1) (buffer-name buf2)))
929
930
(defun moccur-buffer-string> (buf1 buf2)
931
"String> by `buffer-name'.
932
Argument BUF1 BUFFER.
933
Argument BUF2 BUFFER."
934
(string> (buffer-name buf1) (buffer-name buf2)))
935
936
(defun moccur-buffer-in-list-p (buffer-name buffer-name-regexps)
937
"Return t, if BUFFER-NAME match BUFFER-NAME-REGEXPS (list)."
938
(cond ((null buffer-name-regexps) nil)
939
((eq (string-match (car buffer-name-regexps) buffer-name)
940
0) t)
941
(t (moccur-buffer-in-list-p
942
buffer-name (cdr buffer-name-regexps)))))
943
944
(defun moccur-filter-buffers (buffer-list)
945
"Return BUFFER-LIST which is filtered by some variables."
946
(let ((moccur-buffers nil))
947
(while buffer-list
948
(if (and (moccur-buffer-in-list-p
949
(buffer-name (car buffer-list))
950
*moccur-buffer-name-inclusion-list*)
951
(not (moccur-buffer-in-list-p
952
(buffer-name (car buffer-list))
953
*moccur-buffer-name-exclusion-list*)))
954
(setq moccur-buffers
955
(cons (car buffer-list)
956
moccur-buffers)))
957
(setq buffer-list (cdr buffer-list)))
958
moccur-buffers))
959
960
(defun moccur-kill-buffer-func ()
961
(when (get-buffer "*Moccur*") ;; there ought to be just one of these
962
(let ((cur-buffer (current-buffer)))
963
(save-excursion
964
(set-buffer "*Moccur*")
965
;; remove current buffer from moccur-grep-buffer-list so it won't get killed in
966
;; moccur-grep-sync-kill-buffers
967
(setq moccur-grep-buffer-list (remq cur-buffer moccur-grep-buffer-list))))
968
(kill-buffer "*Moccur*"))
969
(if (get-buffer "*ee-outline*/*Moccur*")
970
(kill-buffer "*ee-outline*/*Moccur*")))
971
972
(defun moccur-kill-buffer (arg)
973
"Kill buffers related moccur."
974
(if arg
975
(moccur-kill-buffer-func)
976
(if moccur-kill-moccur-buffer
977
(moccur-kill-buffer-func)
978
(bury-buffer))))
979
980
(defun moccur-bury-buffer ()
981
"Kill buffers related moccur."
982
(if (get-buffer "*Moccur*") ;; there ought to be just one of these
983
(bury-buffer (get-buffer "*Moccur*")))
984
(if (get-buffer "*ee-outline*/*Moccur*")
985
(bury-buffer (get-buffer "*ee-outline*/*Moccur*"))))
986
987
(autoload 'ee-outline "ee-autoloads" nil t)
988
(defun moccur-setup ()
989
"Initialization of moccur."
990
;;(setq moccur-last-command 'moccur)
991
(if moccur-use-migemo
992
(require 'migemo))
993
(if moccur-use-ee
994
(require 'ee-autoloads))
995
(if (string= "*Moccur*"
996
(buffer-name (current-buffer)))
997
(moccur-quit))
998
(moccur-kill-buffer t)
999
(setq moccur-current-buffer (current-buffer))
1000
(setq moccur-windows-conf (current-window-configuration)))
1001
1002
(defun moccur-insert-heading(moccur-regexp-input)
1003
"Insert the 'Lines matching' heading in *Moccur* buffer, with the user input regexp
1004
displayed in font-lock-variable-name-face face."
1005
(let (pt)
1006
(setq pt (point))
1007
(insert "Lines matching")
1008
(when moccur-split-word
1009
(insert " (split words)"))
1010
(insert ": ")
1011
(put-text-property pt (point) 'face 'font-lock-keyword-face)
1012
(setq pt (point))
1013
(insert moccur-regexp-input "\n")
1014
(put-text-property pt (point) 'face 'font-lock-variable-name-face)))
1015
1016
(defun moccur-file-size< (filename maxsize)
1017
(if
1018
(or
1019
(not maxsize)
1020
(> (* 1000 maxsize)
1021
(nth 7 (file-attributes filename))))
1022
t
1023
nil))
1024
1025
;;;; color and overlay
1026
(defun moccur-remove-overlays-on-all-buffers (&optional beg end length)
1027
"Remove all overlays in all buffers.
1028
Optional argument BEG
1029
the positions of the beginning of the range of changed text
1030
Optional argument END
1031
the positions of the end of the range of changed text
1032
Optional argument LENGTH
1033
the length in bytes of the pre-change text replaced by that range."
1034
(interactive "p")
1035
(if moccur-current-line-overlays
1036
(progn
1037
(delete-overlay moccur-current-line-overlays)
1038
(setq moccur-current-line-overlays nil)))
1039
(save-excursion
1040
(let (ov buf (buflist (buffer-list)))
1041
(while buflist
1042
(setq buf (car buflist))
1043
(setq buflist (cdr buflist))
1044
(when (and buf
1045
(buffer-live-p buf))
1046
(set-buffer buf)
1047
(when (not (memq major-mode '(moccur-mode moccur-grep-mode)))
1048
(while moccur-overlays
1049
(delete-overlay (car moccur-overlays))
1050
(setq moccur-overlays (cdr moccur-overlays))))
1051
(remove-hook 'after-change-functions
1052
'moccur-remove-overlays-on-all-buffers)
1053
(when moccur-buffer-position
1054
(goto-char moccur-buffer-position)
1055
(setq moccur-buffer-position nil)))))))
1056
1057
(defun moccur-buffer-hide-region (start end)
1058
(let ((o (make-overlay start end)))
1059
(overlay-put o 'invisible 'moccur)
1060
(overlay-put o 'isearch-open-invisible
1061
'outline-isearch-open-invisible)))
1062
1063
(defun moccur-buffer-color ()
1064
"Put overlays in *moccur* buffer."
1065
(let ((ov) (count 0))
1066
(save-excursion
1067
(goto-char (point-min))
1068
(while (and (re-search-forward moccur-line-number-regexp nil t)
1069
(or (not moccur-maximum-displayed-with-color)
1070
(< count moccur-maximum-displayed-with-color)))
1071
(progn
1072
(save-restriction
1073
(narrow-to-region (point) (line-end-position))
1074
(while (re-search-forward moccur-regexp-color nil t)
1075
(setq count (+ count 1))
1076
(setq ov (make-overlay (match-beginning 0)
1077
(match-end 0)))
1078
(overlay-put ov 'face 'moccur-face)
1079
(overlay-put ov 'priority 0)
1080
(setq moccur-overlays (cons ov moccur-overlays))))
1081
(when (> (+ 6 (save-excursion (end-of-line) (current-column)))
1082
(if (and (boundp 'running-xemacs) running-xemacs)
1083
(frame-width)
1084
(frame-width)))
1085
(save-excursion
1086
(beginning-of-line)
1087
(re-search-forward moccur-line-number-regexp (line-end-position) t)
1088
(save-restriction
1089
(narrow-to-region (point) (line-end-position))
1090
(let ((end-pt (point)) (st (point)) (match-end-pt nil))
1091
(while (re-search-forward moccur-regexp-color (line-end-position) t)
1092
(setq st (match-beginning 0))
1093
(setq match-end-pt (match-end 0))
1094
(cond
1095
((and
1096
(> (length (buffer-substring-no-properties
1097
end-pt st))
1098
10)
1099
(< end-pt (- st 5)))
1100
(moccur-buffer-hide-region end-pt (- st 5))
1101
(setq end-pt (+ 5 match-end-pt)))
1102
(t
1103
(setq end-pt (+ 5 match-end-pt))
1104
(goto-char end-pt)
1105
)))
1106
(end-of-line)
1107
(if (and
1108
(> (line-end-position) end-pt)
1109
(> (length (buffer-substring-no-properties
1110
end-pt (line-end-position)))
1111
10))
1112
(moccur-buffer-hide-region end-pt (- (line-end-position) 5)))))))
1113
)))))
1114
1115
(defun moccur-color-view ()
1116
"Put overlays to matched texts."
1117
(let ((ov) (count 0))
1118
(if (and moccur-buffer-name
1119
(get-buffer moccur-buffer-name))
1120
(progn
1121
(set-buffer (get-buffer moccur-buffer-name))
1122
(when moccur-current-line-overlays
1123
(delete-overlay moccur-current-line-overlays)
1124
(setq moccur-current-line-overlays nil))
1125
1126
(save-excursion
1127
(goto-char (point-min))
1128
(moccur-special-word-call-initialize-function)
1129
(while (and
1130
(moccur-search-line (car moccur-regexp-list))
1131
(or (not moccur-maximum-displayed-with-color)
1132
(< count moccur-maximum-displayed-with-color)))
1133
(when (moccur-special-word-call-check-function)
1134
(beginning-of-line)
1135
(while (and
1136
(re-search-forward
1137
moccur-regexp-color (line-end-position) t)
1138
(or (not moccur-maximum-displayed-with-color)
1139
(< count moccur-maximum-displayed-with-color)))
1140
(progn
1141
(setq count (+ count 1))
1142
(setq ov (make-overlay (match-beginning 0)
1143
(match-end 0)))
1144
(overlay-put ov 'face 'moccur-face)
1145
(overlay-put ov 'priority 0)
1146
(setq moccur-overlays (cons ov moccur-overlays)))))))
1147
(set-buffer moccur-mocur-buffer)))))
1148
1149
(defun moccur-color-current-line ()
1150
"Underline where the cursor is."
1151
(if (not moccur-current-line-overlays)
1152
(setq moccur-current-line-overlays
1153
(make-overlay
1154
(line-beginning-position) (1+ (line-end-position))))
1155
(move-overlay moccur-current-line-overlays
1156
(line-beginning-position) (1+ (line-end-position))))
1157
(overlay-put moccur-current-line-overlays
1158
'face 'moccur-current-line-face))
1159
1160
;;;; display other window
1161
(defun moccur-get-info ()
1162
"Gets buffer name and line."
1163
(setq moccur-view-other-window-nobuf t)
1164
(setq moccur-buffer-name nil)
1165
(let ((end-pt) (start-pt) (file nil) (buffer nil) (str nil) (buf nil)
1166
(buflst (buffer-list)))
1167
;;for moccur-grep
1168
(when moccur-grep-following-mode-toggle
1169
(save-window-excursion
1170
(save-excursion
1171
(moccur-grep-goto)
1172
(setq buf (current-buffer))))
1173
(if (or
1174
(memq buf buflst)
1175
(memq buf moccur-grep-buffer-list))
1176
()
1177
(setq moccur-grep-buffer-list
1178
(cons buf moccur-grep-buffer-list))))
1179
;;for moccur-grep end
1180
(save-excursion
1181
(end-of-line)
1182
(if (re-search-backward
1183
"^[-+ ]*Buffer:[ ]*\\([^\r\n]*\\) File\\([^:/\r\n]*\\):[ ]*\\([^\r\n]+\\)$" nil t)
1184
(progn
1185
(setq start-pt (point))
1186
(setq buffer
1187
(match-string-no-properties 1))
1188
(setq str (match-string-no-properties 2))
1189
(setq file (match-string-no-properties 3))
1190
(cond
1191
((string-match "grep" str)
1192
(if (moccur-grep-xdoc2txt-p file)
1193
(setq moccur-buffer-name (moccur-grep-binary-file-view file))
1194
(if (get-file-buffer file)
1195
(setq moccur-buffer-name
1196
(buffer-name
1197
(get-file-buffer file))))))
1198
(t
1199
(setq moccur-buffer-name buffer))))
1200
(setq start-pt (point-min))))
1201
1202
(save-excursion
1203
(end-of-line)
1204
(if (re-search-forward
1205
"^[-+ ]*Buffer: " nil t)
1206
(progn
1207
(beginning-of-line)
1208
(setq end-pt (point)))
1209
(setq end-pt (point-max))))
1210
1211
(save-excursion
1212
(setq moccur-buffer-match-count 0)
1213
(goto-char start-pt)
1214
(while (re-search-forward moccur-line-number-regexp end-pt t)
1215
(setq moccur-buffer-match-count (+ 1 moccur-buffer-match-count))))
1216
1217
(save-excursion
1218
(end-of-line)
1219
(if (re-search-backward moccur-line-number-regexp (line-beginning-position) t)
1220
(setq moccur-line (buffer-substring
1221
(match-beginning 1)
1222
(match-end 1)))
1223
(setq moccur-line "1")))
1224
(if (and moccur-buffer-name
1225
(get-buffer moccur-buffer-name)
1226
(buffer-live-p (get-buffer moccur-buffer-name)))
1227
()
1228
(setq moccur-view-other-window-nobuf nil))))
1229
1230
(defun moccur-color-check-view ()
1231
"If a matched buffer exists, the buffer is displayed."
1232
(if (and moccur-buffer-name
1233
(get-buffer moccur-buffer-name))
1234
(progn
1235
(set-buffer (get-buffer moccur-buffer-name))
1236
(if moccur-overlays
1237
()
1238
(moccur-color-view))
1239
(set-buffer moccur-mocur-buffer))))
1240
1241
(defun moccur-view-file ()
1242
"Display the matched buffer to other window."
1243
(if (string= moccur-before-buffer-name moccur-buffer-name)
1244
(moccur-color-check-view)
1245
(if moccur-current-line-overlays
1246
(progn
1247
(delete-overlay moccur-current-line-overlays)
1248
(setq moccur-overlays nil)))
1249
(moccur-color-view))
1250
1251
(switch-to-buffer-other-window
1252
(get-buffer moccur-buffer-name))
1253
(goto-line (string-to-number moccur-line))
1254
(if (re-search-forward moccur-regexp-color (line-end-position) t)
1255
()
1256
(goto-line (string-to-number moccur-line)))
1257
1258
;; color
1259
(moccur-color-current-line)
1260
1261
(setq moccur-before-buffer-name moccur-buffer-name)
1262
(switch-to-buffer-other-window moccur-mocur-buffer))
1263
1264
(defun moccur-scroll-file (arg)
1265
"Scroll up the matched buffer.
1266
If ARG is non-nil, scroll down the buffer."
1267
(switch-to-buffer-other-window
1268
(get-buffer moccur-buffer-name))
1269
(condition-case nil
1270
(if arg
1271
(scroll-down)
1272
(scroll-up))
1273
(error
1274
nil))
1275
1276
;; color
1277
(moccur-color-current-line)
1278
1279
(setq moccur-before-buffer-name moccur-buffer-name)
1280
(switch-to-buffer-other-window moccur-mocur-buffer))
1281
1282
(defun moccur-internal-beginning-of-buffer (arg)
1283
"Begging-of-buffer in the matched buffer.
1284
Argument ARG If non-nil, `end-of-buffer'."
1285
(switch-to-buffer-other-window
1286
(get-buffer moccur-buffer-name))
1287
(condition-case nil
1288
(if arg
1289
(goto-char (point-max))
1290
(goto-char (point-min)))
1291
(error
1292
nil))
1293
1294
;; color
1295
(moccur-color-current-line)
1296
1297
(setq moccur-before-buffer-name moccur-buffer-name)
1298
(switch-to-buffer-other-window moccur-mocur-buffer))
1299
1300
;;;; minibuffer
1301
(defvar dmoccur-default-word nil)
1302
(defun moccur-set-default-word ()
1303
"Set default word to regexp."
1304
(cond
1305
((and dmoccur-project-name
1306
(nth 5 (assoc (car dmoccur-project-name) dmoccur-list)))
1307
(setq dmoccur-default-word
1308
(if (nth 5 (assoc (car dmoccur-project-name) dmoccur-list))
1309
(nth 5 (assoc (car dmoccur-project-name) dmoccur-list))
1310
""))
1311
(if (stringp dmoccur-default-word)
1312
dmoccur-default-word
1313
(condition-case err
1314
(funcall dmoccur-default-word)
1315
(error
1316
""))))
1317
((and
1318
(or (and (boundp 'mark-active) mark-active)
1319
(and (fboundp 'region-exists-p) (region-exists-p)))
1320
(< (- (region-end) (region-beginning)) 50))
1321
(buffer-substring-no-properties
1322
(region-beginning) (region-end)))
1323
((> (length (thing-at-point 'symbol)) 0)
1324
(thing-at-point 'symbol))
1325
((> (length (thing-at-point 'word)) 0)
1326
(thing-at-point 'word))
1327
(t
1328
(if (and regexp-history (stringp (car regexp-history)))
1329
(car regexp-history)
1330
""))))
1331
1332
(defun moccur-regexp-read-from-minibuf ()
1333
"Read regexp from minibuffer."
1334
(let (default input lst (search-lst nil) dmoccur-default-word)
1335
(setq default (moccur-set-default-word))
1336
(setq input
1337
(read-from-minibuffer
1338
"List lines matching regexp: "
1339
;;(format "List lines matching regexp (default `%s'): "
1340
;; default)
1341
(cons default 0) ;; initial string
1342
nil nil
1343
'regexp-history
1344
(if (and (boundp 'running-xemacs) running-xemacs)
1345
nil
1346
default)
1347
(if (and (boundp 'running-xemacs) running-xemacs)
1348
default
1349
color-moccur-default-ime-status)))
1350
(when (and (equal input "") default)
1351
(setq input default)
1352
(setq regexp-history (cons input regexp-history)))
1353
(when moccur-split-word
1354
(setq lst (moccur-split-string input))
1355
(while lst
1356
(if (string-match "^b:" (car lst))
1357
()
1358
(setq search-lst (cons (car lst) search-lst)))
1359
(setq lst (cdr lst)))
1360
(if (= 0 (length search-lst))
1361
(error "Input search string")))
1362
input))
1363
1364
;;;; search function
1365
(defun moccur-search-line (regexp)
1366
"Corresponding to re-search-line.
1367
Argument REGEXP REGEXP to search."
1368
(let ((lst moccur-regexp-list)
1369
(split-match 0))
1370
;; if return nil, moccur search next buffer
1371
(cond
1372
((and moccur-split-word lst)
1373
;; search method for split-word
1374
(while (and (not (= (length moccur-regexp-list) split-match))
1375
(re-search-forward regexp nil t))
1376
(setq lst moccur-regexp-list)
1377
(setq split-match 0)
1378
(while lst
1379
(save-excursion
1380
(beginning-of-line)
1381
(if (re-search-forward (car lst) (line-end-position) t)
1382
(setq split-match (+ split-match 1)))
1383
(setq lst (cdr lst)))))
1384
(if (= (length moccur-regexp-list) split-match)
1385
t
1386
nil))
1387
(t
1388
;; defualt
1389
(re-search-forward regexp nil t)))))
1390
1391
(make-variable-buffer-local 'moccur-buffer-position)
1392
(defun moccur-search-buffer (&optional regexp currbuf name)
1393
"Search REGEXP in CURRBUF.
1394
If NAME exists, `moccur-search-buffer' works as grep."
1395
(let ((match-str nil) fname)
1396
(set-buffer currbuf)
1397
(setq moccur-buffer-position (point))
1398
1399
;;(make-local-hook 'after-change-functions)
1400
;;(remove-hook 'after-change-functions 'moccur-remove-overlays)
1401
(add-hook 'after-change-functions 'moccur-remove-overlays-on-all-buffers nil t)
1402
1403
(goto-char (point-min))
1404
1405
(moccur-special-word-call-initialize-function)
1406
1407
(while (moccur-search-line regexp)
1408
(when (moccur-special-word-call-check-function)
1409
(setq moccur-matches (+ moccur-matches 1))
1410
(let* ((linenum (count-lines
1411
(save-restriction (widen) (point-min)) (point)))
1412
(tag (format "\n%5d " linenum)))
1413
(put-text-property 0 (length tag) 'face 'font-lock-constant-face tag)
1414
(setq
1415
match-str
1416
(cons
1417
(concat tag
1418
(buffer-substring
1419
(line-beginning-position) (line-end-position)))
1420
match-str))
1421
(forward-line nil))))
1422
(setq match-str (reverse match-str))
1423
(save-excursion
1424
(set-buffer moccur-mocur-buffer)
1425
(if (not match-str)
1426
nil
1427
(let (pt)
1428
(cond
1429
(name
1430
(setq pt (point))
1431
(insert "Buffer: File (grep): ")
1432
(put-text-property pt (point) 'face 'font-lock-keyword-face)
1433
(setq pt (point))
1434
(insert name "\n")
1435
(put-text-property pt (point) 'face 'font-lock-variable-name-face))
1436
(t
1437
(if (buffer-file-name currbuf)
1438
(setq fname (buffer-file-name currbuf))
1439
(setq fname "Not file"))
1440
(setq pt (point))
1441
(insert "Buffer: ")
1442
(put-text-property pt (point) 'face 'font-lock-keyword-face)
1443
(setq pt (point))
1444
(insert (buffer-name currbuf))
1445
(put-text-property pt (point) 'face 'font-lock-variable-name-face)
1446
(setq pt (point))
1447
(insert " File: ")
1448
(put-text-property pt (point) 'face 'font-lock-keyword-face)
1449
(setq pt (point))
1450
(insert fname "\n")
1451
(put-text-property pt (point) 'face 'font-lock-variable-name-face))))
1452
1453
(while match-str
1454
(insert (car match-str))
1455
(setq match-str (cdr match-str)))
1456
(insert "\n\n")
1457
t))))
1458
1459
(defvar moccur-searched-list nil)
1460
(defun moccur-search (regexp arg buffers)
1461
"Search REGEXP in BUFFERS (list).
1462
If ARG is non-nil, also search buffer that doesn't have file name"
1463
1464
(when (or
1465
(not regexp)
1466
(string= regexp ""))
1467
(error "No search word specified!"))
1468
;; initialize
1469
(let ((lst
1470
(list
1471
regexp arg buffers)))
1472
(if (equal lst (car moccur-searched-list))
1473
()
1474
(setq moccur-searched-list
1475
(cons
1476
(list
1477
regexp arg buffers)
1478
moccur-searched-list))))
1479
1480
(setq moccur-special-word nil)
1481
(moccur-set-regexp)
1482
(moccur-set-regexp-for-color)
1483
1484
;; variable reset
1485
(setq dmoccur-project-name nil)
1486
(setq moccur-matches 0)
1487
(setq moccur-match-buffers nil)
1488
(setq moccur-regexp-input regexp)
1489
(if (string= (car regexp-history) moccur-regexp-input)
1490
()
1491
(setq regexp-history
1492
(cons moccur-regexp-input regexp-history)))
1493
1494
(save-excursion
1495
(setq moccur-mocur-buffer (generate-new-buffer "*Moccur*"))
1496
(set-buffer moccur-mocur-buffer)
1497
(moccur-insert-heading moccur-regexp-input)
1498
(setq moccur-buffers buffers)
1499
1500
;; search all buffers
1501
(while buffers
1502
(if (and
1503
(car buffers)
1504
(buffer-live-p (car buffers))
1505
;; if b:regexp exists,
1506
(if (and moccur-file-name-regexp
1507
moccur-split-word)
1508
(string-match moccur-file-name-regexp
1509
(buffer-name (car buffers)))
1510
t))
1511
(if (and (not arg)
1512
(not (buffer-file-name (car buffers))))
1513
(setq buffers (cdr buffers))
1514
(if (moccur-search-buffer (car moccur-regexp-list) (car buffers))
1515
(setq moccur-match-buffers
1516
(cons (car buffers) moccur-match-buffers)))
1517
(setq buffers (cdr buffers)))
1518
;; illegal buffer
1519
(setq buffers (cdr buffers))))
1520
(if (> moccur-matches 0)
1521
(save-excursion
1522
(set-buffer moccur-mocur-buffer)
1523
(delete-other-windows)
1524
(moccur-mode)
1525
;; highlight Moccur buffer
1526
(moccur-buffer-color)
1527
(setq buffer-undo-list nil)
1528
1529
(moccur-ee-start)
1530
(setq buffer-undo-list nil)
1531
1532
;; move cursor to the first matching text
1533
(set-buffer moccur-mocur-buffer)
1534
1535
(goto-char (point-min))
1536
(forward-line 2)
1537
1538
(beginning-of-line)
1539
(re-search-forward moccur-line-number-regexp nil t)
1540
(re-search-forward (car moccur-regexp-list) nil t)
1541
1542
(moccur-get-info)
1543
1544
(setq moccur-before-buffer-name moccur-buffer-name)
1545
(moccur-color-view)
1546
1547
;; preview file
1548
(moccur-view-file)
1549
(pop-to-buffer moccur-mocur-buffer)
1550
(message "%d matches" moccur-matches)
1551
t)
1552
(message "no matches")
1553
(setq moccur-searched-list
1554
(cdr moccur-searched-list))
1555
(moccur-kill-buffer t)
1556
(moccur-remove-overlays-on-all-buffers)
1557
nil)))
1558
1559
(defun moccur-search-undo ()
1560
(interactive)
1561
(moccur-setup)
1562
(setq moccur-last-command 'moccur-search-undo)
1563
(unless (nth 1 moccur-searched-list)
1564
(error "No undo information"))
1565
(setq moccur-searched-list (cdr moccur-searched-list))
1566
(let ((buffers (car (cdr (cdr (car moccur-searched-list)))))
1567
(regexp (car (car moccur-searched-list)))
1568
(arg (car (cdr (car moccur-searched-list)))))
1569
;; sort
1570
(setq buffers (sort buffers moccur-buffer-sort-method))
1571
(moccur-search regexp arg buffers)))
1572
1573
(defun moccur-search-update ()
1574
(interactive)
1575
(moccur-setup)
1576
(setq moccur-last-command 'moccur-search-update)
1577
(let ((buffers (car (cdr (cdr (car moccur-searched-list)))))
1578
(regexp (car (car moccur-searched-list)))
1579
(arg (car (cdr (car moccur-searched-list)))))
1580
;; sort
1581
(setq buffers (sort buffers moccur-buffer-sort-method))
1582
(moccur-search regexp arg buffers)))
1583
1584
;;;; search word
1585
(defun moccur-split-string (string &optional separators)
1586
"Splits STRING into substrings where there are matches for SEPARATORS.
1587
Each match for SEPARATORS is a splitting point.
1588
The substrings between the splitting points are made into a list
1589
which is returned.
1590
If SEPARATORS is absent, it defaults to \"[ ]+\".
1591
1592
But if substring is invalid regexp, this function doesn't split into
1593
substrings.
1594
1595
Example:
1596
moccur split string -> '(\"moccur\" \"split\" \"string\")
1597
moccur [a-z ]+ search -> '(\"moccur\" \"[a-z ]+\" \"search\")"
1598
1599
;; strip whitespace from end of string
1600
(setq string
1601
(substring
1602
string
1603
0
1604
(string-match "[ ]+$" string)))
1605
(while (string-match "^[ ]+" string)
1606
(setq string
1607
(substring
1608
string
1609
1)))
1610
(let* ((rexp (or separators "[ ]+"))
1611
(lst (split-string string rexp))
1612
(new-lst nil)
1613
(current-regexp nil)
1614
(regexp-p nil)
1615
(regexp nil))
1616
1617
(when (and
1618
moccur-split-word
1619
(assoc (car lst) moccur-special-word-list)
1620
(> (length lst) 1))
1621
(setq moccur-regexp-list (cdr moccur-regexp-list))
1622
(setq moccur-special-word (car lst))
1623
(setq lst (cdr lst)))
1624
1625
(while lst
1626
(setq current-regexp (concat
1627
regexp
1628
(if regexp
1629
" ")
1630
(car lst)))
1631
(setq regexp nil)
1632
(setq lst (cdr lst))
1633
(setq regexp-p t)
1634
(condition-case err
1635
(string-match current-regexp "test")
1636
(error
1637
(setq regexp-p nil)))
1638
1639
(cond
1640
((and moccur-use-keyword
1641
regexp-p
1642
(assoc current-regexp moccur-search-keyword-alist))
1643
(setq new-lst
1644
(cons
1645
(cdr (assoc current-regexp moccur-search-keyword-alist))
1646
new-lst)))
1647
(regexp-p
1648
(setq new-lst (cons current-regexp new-lst)))
1649
(t
1650
(setq regexp (concat current-regexp
1651
(if regexp " ") regexp)))))
1652
1653
(if regexp
1654
(setq new-lst
1655
(append new-lst
1656
(mapcar '(lambda (string)
1657
(if (and moccur-use-keyword
1658
(assoc string moccur-search-keyword-alist))
1659
(cdr (assoc string moccur-search-keyword-alist))
1660
(regexp-quote string)))
1661
(split-string regexp)))))
1662
(if (and
1663
(not new-lst)
1664
(not regexp))
1665
(error "Invalid regexp"))
1666
1667
(setq new-lst (reverse new-lst))
1668
1669
new-lst))
1670
1671
(defun moccur-word-split (regexp &optional norestrict)
1672
"Splits REGEXP into substrings."
1673
(setq moccur-file-name-regexp nil)
1674
(let ((lst (moccur-split-string regexp))
1675
(regexp-list nil))
1676
1677
(while lst
1678
(if (and (not norestrict)
1679
moccur-split-word (string-match "^b:" (car lst)))
1680
(setq moccur-file-name-regexp
1681
(cons (substring (car lst) 2) moccur-file-name-regexp))
1682
(setq regexp-list
1683
(cons
1684
(if moccur-use-migemo
1685
(cond
1686
((string-match "^r:" (car lst))
1687
(substring (car lst) 2))
1688
((not (string= (car lst) (regexp-quote (car lst))))
1689
(car lst))
1690
(t
1691
(migemo-get-pattern (car lst))))
1692
(car lst))
1693
regexp-list)))
1694
(setq lst (cdr lst)))
1695
1696
(if (and moccur-split-word moccur-file-name-regexp)
1697
(progn
1698
(setq lst moccur-file-name-regexp)
1699
(setq moccur-file-name-regexp (concat "\\(" (car lst)))
1700
(setq lst (cdr lst))
1701
(while lst
1702
(setq moccur-file-name-regexp
1703
(concat moccur-file-name-regexp
1704
"\\|"
1705
(car lst)))
1706
(setq lst (cdr lst)))
1707
(setq moccur-file-name-regexp
1708
(concat moccur-file-name-regexp "\\)"))))
1709
regexp-list))
1710
1711
(defun moccur-set-regexp ()
1712
"Set `moccur-regexp-list' and `moccur-file-name-regexp' from user regexp."
1713
(setq moccur-regexp-list nil)
1714
(setq moccur-file-name-regexp nil)
1715
1716
(if moccur-split-word
1717
(setq moccur-regexp-list (moccur-word-split regexp))
1718
(if moccur-use-migemo
1719
(cond
1720
((string-match "^r:" regexp)
1721
(setq moccur-regexp-list (list (substring regexp 2))))
1722
((not (string= regexp (regexp-quote regexp)))
1723
(setq moccur-regexp-list (list regexp)))
1724
(t
1725
(setq moccur-regexp-list (list (migemo-get-pattern regexp)))))
1726
(setq moccur-regexp-list (list regexp)))))
1727
1728
(defun moccur-set-regexp-for-color ()
1729
"Make regexp for coloring up."
1730
(let ((list (cdr moccur-regexp-list)))
1731
(if moccur-split-word
1732
(progn
1733
(setq moccur-regexp-color (concat
1734
"\\(" (car moccur-regexp-list)))
1735
(while list
1736
(setq moccur-regexp-color
1737
(concat moccur-regexp-color
1738
"\\|"
1739
(car list)))
1740
(setq list (cdr list)))
1741
(setq moccur-regexp-color
1742
(concat moccur-regexp-color "\\)")))
1743
(setq moccur-regexp-color (car moccur-regexp-list)))))
1744
1745
;;;; moccur special word
1746
;;;;; basic functions
1747
(defun moccur-special-word-call-initialize-function ()
1748
"Initialize function for special word function."
1749
(cond
1750
((and moccur-split-word
1751
moccur-special-word)
1752
(if (nth 1 (assoc moccur-special-word moccur-special-word-list))
1753
(funcall
1754
(nth 1 (assoc moccur-special-word moccur-special-word-list)))))
1755
(t
1756
(if (nth 1 (assoc t moccur-special-word-list))
1757
(funcall
1758
(nth 1 (assoc t moccur-special-word-list)))))))
1759
1760
(defun moccur-special-word-call-check-function ()
1761
"Function to check whether the matched text is acceptable."
1762
(cond
1763
((and moccur-split-word
1764
moccur-special-word)
1765
(or
1766
(and (assoc moccur-special-word moccur-special-word-list)
1767
(nth 2 (assoc moccur-special-word moccur-special-word-list))
1768
(funcall
1769
(nth 2 (assoc moccur-special-word moccur-special-word-list))))
1770
(not
1771
(assoc moccur-special-word moccur-special-word-list))
1772
(not
1773
(nth 2 (assoc moccur-special-word moccur-special-word-list)))))
1774
(t
1775
(if (nth 2 (assoc t moccur-special-word-list))
1776
(funcall
1777
(nth 2 (assoc t moccur-special-word-list)))
1778
t))))
1779
1780
;;;;; functions
1781
(defun moccur-face-check (facename)
1782
"Check whether the face of current point is FACENAME."
1783
(let ((face
1784
(save-excursion
1785
(forward-char -1)
1786
(get-text-property (point) 'face))))
1787
(cond
1788
((listp face)
1789
(memq facename face))
1790
(t
1791
(string=
1792
facename face)))))
1793
1794
(make-variable-buffer-local 'moccur-fontlock-buffer)
1795
(defun moccur-face-initialization ()
1796
"Call 'font-lock-default-fontify-buffer'."
1797
(let ((font-lock-support-mode 'fast-lock-mode))
1798
(if moccur-fontlock-buffer
1799
()
1800
(setq moccur-fontlock-buffer t)
1801
(font-lock-default-fontify-buffer))))
1802
1803
(defun moccur-default-initial-function ()
1804
())
1805
1806
(defun moccur-default-check-function ()
1807
t)
1808
1809
(defun moccur-comment-check ()
1810
(moccur-face-check 'font-lock-comment-face))
1811
1812
(defun moccur-string-check ()
1813
(moccur-face-check 'font-lock-string-face))
1814
1815
(defun moccur-function-check ()
1816
(cond
1817
((string= major-mode 'texinfo-mode)
1818
(moccur-face-check 'texinfo-heading-face))
1819
((string= major-mode 'change-log-mode)
1820
(moccur-face-check 'change-log-file-face))
1821
((string= major-mode 'outline-mode)
1822
(if (save-excursion
1823
(re-search-backward
1824
(concat "^" outline-regexp) (line-beginning-position) t))
1825
t
1826
nil))
1827
(t
1828
(or
1829
(moccur-face-check 'font-lock-function-name-face)
1830
(moccur-face-check 'font-lock-variable-name-face))
1831
)))
1832
1833
;;;; ee
1834
(defun moccur-ee-start ()
1835
(let ((str (buffer-substring-no-properties
1836
(line-beginning-position) (line-end-position))))
1837
(when (and (not (featurep 'allout))
1838
moccur-use-ee
1839
(buffer-live-p (get-buffer "*Moccur*")))
1840
(if (buffer-live-p (get-buffer "*ee-outline*/*Moccur*"))
1841
(kill-buffer (get-buffer "*ee-outline*/*Moccur*")))
1842
1843
(switch-to-buffer (get-buffer "*Moccur*"))
1844
(ee-outline)
1845
(re-search-forward (regexp-quote str) nil t)
1846
(moccur-mode t)
1847
;;(use-local-map moccur-mode-map)
1848
(setq moccur-mocur-buffer (current-buffer))
1849
;; highlight Moccur buffer
1850
(moccur-buffer-color))))
1851
1852
(defun moccur-switch-buffer (buf)
1853
(interactive)
1854
(when (and moccur-use-ee (not (featurep 'allout)))
1855
(if (string= 'normal buf)
1856
(if (get-buffer "*Moccur*")
1857
(switch-to-buffer (get-buffer "*Moccur*")))
1858
(if (get-buffer "*ee-outline*/*Moccur*")
1859
(switch-to-buffer (get-buffer "*ee-outline*/*Moccur*"))))))
1860
1861
;;;; interactive
1862
(defun moccur (regexp arg)
1863
"Show all lines of all buffers containing a match for REGEXP.
1864
The lines are shown in a buffer named *Moccur*.
1865
It serves as a menu to find any of the occurrences in this buffer.
1866
\\[describe-mode] in that buffer will explain how."
1867
(interactive (list (moccur-regexp-read-from-minibuf)
1868
current-prefix-arg))
1869
1870
(moccur-setup)
1871
(setq moccur-last-command 'moccur)
1872
1873
(let ((buffers (moccur-filter-buffers (buffer-list))))
1874
;; sort
1875
(setq buffers (sort buffers moccur-buffer-sort-method))
1876
(moccur-search regexp arg buffers)))
1877
1878
(defun moccur-grep-correspond-ext-p (filename list)
1879
(let ((ret nil))
1880
(while list
1881
(when (string-match (car list) filename)
1882
(setq ret t))
1883
(setq list (cdr list)))
1884
ret))
1885
1886
;;; moccur-grep
1887
(defun moccur-grep-xdoc2txt-p (filename)
1888
(if (and
1889
moccur-run-meadow-onwin
1890
moccur-use-xdoc2txt
1891
(moccur-grep-correspond-ext-p
1892
filename moccur-grep-xdoc2txt-exts))
1893
t
1894
nil))
1895
1896
(defun moccur-search-file-p (filename)
1897
(and
1898
(file-readable-p filename)
1899
(or
1900
(and
1901
(not moccur-grep-xdoc2txt-maximum-size)
1902
(moccur-file-size< filename moccur-grep-xdoc2txt-maximum-size)
1903
(moccur-grep-xdoc2txt-p filename))
1904
(and
1905
(moccur-file-size< filename dmoccur-maximum-size)
1906
(not (dmoccur-in-list-p filename
1907
dmoccur-exclusion-mask))))))
1908
1909
(defun moccur-search-files-init (regexp files)
1910
(setq moccur-special-word nil)
1911
(moccur-set-regexp)
1912
(moccur-set-regexp-for-color)
1913
1914
(setq moccur-matches 0)
1915
(setq moccur-regexp-input regexp)
1916
(if (string= (car regexp-history) moccur-regexp-input)
1917
()
1918
(setq regexp-history
1919
(cons moccur-regexp-input regexp-history))))
1920
1921
(defun moccur-files-insert-xdoc2txt-file (filename)
1922
(let ((fn (concat
1923
(expand-file-name
1924
(make-temp-name "xdoc2")
1925
temporary-file-directory)
1926
"."
1927
(file-name-extension filename)))
1928
(str nil)
1929
(coding-system-for-write 'binary)
1930
(coding-system-for-read 'binary))
1931
(set-buffer-file-coding-system 'euc-japan)
1932
(copy-file filename fn t)
1933
(insert
1934
(shell-command-to-string
1935
(concat
1936
"cd " (file-name-directory fn) ";"
1937
"xdoc2txt" " -e " (file-name-nondirectory fn))))
1938
(delete-file fn)
1939
(decode-coding-region (point-min) (point-max)
1940
'euc-jp)
1941
(goto-char (point-min))
1942
(while (re-search-forward "\r" nil t)
1943
(delete-region (match-beginning 0)
1944
(match-end 0)))
1945
(goto-char (point-min))
1946
(while (re-search-forward "\\([\n ]+\\)\n[ ]*\n" nil t)
1947
(delete-region (match-beginning 1)
1948
(match-end 1)))
1949
(goto-char (point-min))))
1950
1951
(defun moccur-search-all-files (files)
1952
(let ((total (length files))
1953
(num 0))
1954
(condition-case err
1955
(while files
1956
(setq num (+ num 1))
1957
(with-temp-buffer
1958
(when
1959
(or
1960
(string= moccur-last-command 'moccur-grep)
1961
(and
1962
(not (string= moccur-last-command 'moccur-grep))
1963
(moccur-search-file-p (car files))))
1964
(message "Searching %d/%d (%d matches) : %s ..."
1965
num total moccur-matches
1966
(file-relative-name (car files) default-directory))
1967
(condition-case err
1968
(cond
1969
((moccur-grep-correspond-ext-p
1970
(car files) moccur-grep-xdoc2txt-exts)
1971
(moccur-files-insert-xdoc2txt-file (car files)))
1972
(t
1973
(if moccur-grep-search-file-pos
1974
(insert-file-contents (car files) nil 0 moccur-grep-search-file-pos)
1975
(insert-file-contents (car files)))))
1976
(error
1977
())))
1978
(widen)
1979
(moccur-search-buffer (car moccur-regexp-list) (current-buffer)
1980
(car files)))
1981
(setq files (cdr files)))
1982
(quit
1983
()))))
1984
1985
(defun moccur-search-files (regexp files)
1986
"Search REGEXP in FILES (list)."
1987
1988
;; initialize
1989
(moccur-search-files-init regexp files)
1990
1991
(save-excursion
1992
(setq moccur-mocur-buffer (generate-new-buffer "*Moccur*"))
1993
(set-buffer moccur-mocur-buffer)
1994
(moccur-insert-heading moccur-regexp-input)
1995
1996
;; search all buffers
1997
(moccur-search-all-files files)
1998
(message "Searching done!")
1999
(if (> moccur-matches 0)
2000
(progn
2001
(set-buffer moccur-mocur-buffer)
2002
(delete-other-windows)
2003
(moccur-grep-mode)
2004
;; highlight Moccur buffer
2005
(moccur-buffer-color)
2006
(setq buffer-undo-list nil)
2007
2008
;; move cursor to the first matching text
2009
(set-buffer moccur-mocur-buffer)
2010
;;(setq moccur-view-other-window nil)
2011
2012
(pop-to-buffer moccur-mocur-buffer)
2013
(goto-char (point-min))
2014
2015
(make-local-variable 'moccur-xdoc2txt-buffers)
2016
(setq moccur-xdoc2txt-buffers nil)
2017
2018
(message "%d matches" moccur-matches)
2019
t)
2020
(message "no matches")
2021
(moccur-kill-buffer t)
2022
(moccur-remove-overlays-on-all-buffers)
2023
nil)))
2024
2025
(defun moccur-grep-binary-file-view (file)
2026
(cond
2027
((and (rassoc file moccur-xdoc2txt-buffers)
2028
(car (rassoc file moccur-xdoc2txt-buffers))
2029
(buffer-live-p (get-buffer (car (rassoc file moccur-xdoc2txt-buffers)))))
2030
(car (rassoc file moccur-xdoc2txt-buffers)))
2031
(t
2032
(save-current-buffer
2033
(let ((dummy-buff (generate-new-buffer
2034
(concat "xdoc2txt:"
2035
(file-name-nondirectory
2036
file))))
2037
(coding-system-for-write 'binary)
2038
(coding-system-for-read 'binary))
2039
(set-buffer dummy-buff)
2040
(let ((fn (concat
2041
(expand-file-name
2042
(make-temp-name "xdoc2")
2043
temporary-file-directory)
2044
"."
2045
(file-name-extension file)))
2046
(str nil)
2047
)
2048
(set-buffer-file-coding-system 'euc-japan)
2049
2050
(copy-file file fn t)
2051
(insert
2052
(shell-command-to-string
2053
(concat
2054
"cd " (file-name-directory fn) ";"
2055
"xdoc2txt" " -e " (file-name-nondirectory fn))))
2056
(decode-coding-region (point-min) (point-max)
2057
'euc-jp)
2058
(goto-char (point-min))
2059
(while (re-search-forward "\r" nil t)
2060
(delete-region (match-beginning 0)
2061
(match-end 0)))
2062
(goto-char (point-min))
2063
(while (re-search-forward "\\([\n ]+\\)\n[ ]*\n" nil t)
2064
(delete-region (match-beginning 1)
2065
(match-end 1)))
2066
(delete-file fn)
2067
)
2068
(setq buffer-read-only t)
2069
(goto-char (point-min))
2070
(view-mode t)
2071
(buffer-name dummy-buff)
2072
)))))
2073
2074
(defun moccur-grep-sync-kill-buffers ()
2075
(let (buf)
2076
(when moccur-grep-buffer-list
2077
(while moccur-grep-buffer-list
2078
(setq buf (car moccur-grep-buffer-list))
2079
(setq moccur-grep-buffer-list
2080
(cdr moccur-grep-buffer-list))
2081
(if (and (buffer-live-p buf)
2082
(not (buffer-modified-p buf)))
2083
(kill-buffer buf)))
2084
(delete-other-windows))))
2085
2086
(add-hook 'kill-buffer-hook
2087
'(lambda ()
2088
(if (string= major-mode 'moccur-grep-mode)
2089
(moccur-grep-sync-kill-buffers))))
2090
2091
(defun moccur-grep-goto ()
2092
(interactive)
2093
(let (file line str buf)
2094
(save-excursion
2095
(if (re-search-backward moccur-grep-buffer-heading-regexp nil t)
2096
(setq file
2097
(buffer-substring-no-properties
2098
(match-beginning 1)
2099
(match-end 1)))))
2100
(save-excursion
2101
(end-of-line)
2102
(if (re-search-backward moccur-line-number-regexp nil t)
2103
(setq line
2104
(string-to-number
2105
(buffer-substring-no-properties
2106
(match-beginning 1)
2107
(match-end 1))))))
2108
(when (and file line)
2109
(cond
2110
((moccur-grep-xdoc2txt-p file)
2111
(setq buf (moccur-grep-binary-file-view file))
2112
(when (not (assoc buf moccur-xdoc2txt-buffers))
2113
(setq moccur-xdoc2txt-buffers
2114
(cons
2115
(cons buf file)
2116
moccur-xdoc2txt-buffers)))
2117
(switch-to-buffer-other-window buf))
2118
(t
2119
(find-file-other-window file)))
2120
(widen)
2121
(goto-line line))))
2122
2123
(defun moccur-grep-read-directory ()
2124
(let ((dir default-directory))
2125
(setq dir
2126
(if (and (boundp 'running-xemacs) running-xemacs)
2127
(read-directory-name "Directory: " dir)
2128
(read-file-name "Directory: " nil nil t)))
2129
(if (and (file-exists-p dir)
2130
(file-directory-p dir))
2131
(setq dir (file-name-as-directory dir))
2132
(setq dir (file-name-as-directory (file-name-directory dir)))
2133
(if (and (file-exists-p dir)
2134
(file-directory-p dir))
2135
()
2136
(error (format "No such directory %s" dir))
2137
(sleep-for 1)
2138
(setq dir nil)))
2139
dir))
2140
2141
(defun moccur-grep-read-regexp (&optional mask)
2142
(let (regexp input (wd nil) (init nil) (pt 1))
2143
(when moccur-grep-default-word-near-point
2144
;; get a word near the point as default regexp string
2145
(setq wd (thing-at-point 'symbol))
2146
(set-text-properties 0 (length wd) nil wd)
2147
;; put point to the end of default word
2148
(setq pt (1+ (length wd))))
2149
(setq init (cons (concat wd " " mask) pt))
2150
(setq input
2151
(read-from-minibuffer "Input Regexp and FileMask: " init))
2152
(moccur-split-string input " ")))
2153
2154
(defun moccur-grep (dir inputs)
2155
(interactive
2156
(list (moccur-grep-read-directory)
2157
(moccur-grep-read-regexp moccur-grep-default-mask)))
2158
(moccur-setup)
2159
(setq moccur-last-command 'moccur-grep)
2160
2161
(let (regexps mask files)
2162
(setq regexps
2163
(mapconcat 'concat
2164
(if (= 1 (length inputs))
2165
inputs
2166
(reverse (cdr (reverse inputs))))
2167
" "))
2168
(setq mask
2169
(if (= 1 (length inputs))
2170
"."
2171
(car (reverse inputs))))
2172
(setq files (directory-files dir t mask))
2173
(let (list)
2174
(dolist (elt files)
2175
(cond
2176
((file-directory-p elt)
2177
())
2178
(t
2179
(push elt list))))
2180
(setq files (reverse list)))
2181
(moccur-search-files regexps files)
2182
))
2183
2184
(defun moccur-grep-find-subdir (dir mask)
2185
(let ((files (cdr (cdr (directory-files dir t)))) (list) (plist))
2186
(if (not (moccur-search-file-p dir))
2187
(setq list nil)
2188
(dolist (elt files)
2189
(cond
2190
((and
2191
(not (string-match "^[.]+$" (file-name-nondirectory elt)))
2192
(file-directory-p elt))
2193
(setq list (append (moccur-grep-find-subdir elt mask) list)))
2194
((string-match "^[.]+$" (file-name-nondirectory elt))
2195
())
2196
((string-match mask (file-name-nondirectory elt))
2197
(push elt list))
2198
(t ()))
2199
(if (not (eq list plist))
2200
(message "Listing %s ..." (file-name-directory elt)))
2201
(setq plist list)))
2202
list))
2203
2204
(defun moccur-grep-find (dir inputs)
2205
(interactive
2206
(list (moccur-grep-read-directory)
2207
(moccur-grep-read-regexp moccur-grep-default-mask)))
2208
(moccur-setup)
2209
(setq moccur-last-command 'moccur-grep-find)
2210
2211
(let (regexps
2212
mask (files nil)
2213
;;(default-directory dir)
2214
)
2215
(setq regexps
2216
(mapconcat 'concat
2217
(if (= 1 (length inputs))
2218
inputs
2219
(reverse (cdr (reverse inputs))))
2220
" "))
2221
(setq mask
2222
(if (= 1 (length inputs))
2223
"."
2224
(car (reverse inputs))))
2225
(message "Listing files...")
2226
(cond
2227
((listp dir)
2228
(while dir
2229
(cond
2230
((file-directory-p (car dir))
2231
(setq files (append
2232
(reverse (moccur-grep-find-subdir (car dir) mask))
2233
files)))
2234
(t
2235
(setq files (cons
2236
(car dir)
2237
files))))
2238
(setq dir (cdr dir))))
2239
(t
2240
(setq files (reverse (moccur-grep-find-subdir dir mask)))))
2241
(message "Listing files done!")
2242
(moccur-search-files regexps files)
2243
))
2244
2245
;;; dmoccur
2246
;;;; utility
2247
(defun dmoccur-in-list-p (dir-name dir-name-regexps)
2248
(let ((case-fold-search t))
2249
(cond ((null dir-name-regexps) nil)
2250
((string-match (car dir-name-regexps) dir-name) t)
2251
(t (dmoccur-in-list-p dir-name (cdr dir-name-regexps))))))
2252
2253
(defun moccur-add-files-to-search-list (files dir &optional norest recursive)
2254
(let ((buffers nil) (file-regexps dmoccur-recursive-ignore-dir)
2255
(file-ignore nil)
2256
file-name buf-name (cbuf (current-buffer))
2257
(enable-local-eval t))
2258
(while files
2259
(setq file-ignore nil)
2260
(setq file-regexps dmoccur-recursive-ignore-dir)
2261
(setq buf-name nil)
2262
(setq file-name (expand-file-name (car files) dir))
2263
2264
(while file-regexps
2265
(if (string-match (car file-regexps) file-name)
2266
(setq file-ignore t))
2267
(setq file-regexps (cdr file-regexps)))
2268
(when (not file-ignore)
2269
(if (file-directory-p file-name)
2270
(cond
2271
((string= 'dired recursive)
2272
(setq buffers
2273
(append
2274
(moccur-add-files-to-search-list
2275
(directory-files file-name) file-name norest nil)
2276
buffers)))
2277
((and recursive
2278
(not (string= (expand-file-name "." dir)
2279
file-name))
2280
(not (string= (expand-file-name ".." dir)
2281
file-name)))
2282
(setq buffers
2283
(append
2284
(moccur-add-files-to-search-list
2285
(directory-files file-name) file-name norest recursive)
2286
buffers)))
2287
(t
2288
nil))
2289
(if (and
2290
(file-readable-p file-name)
2291
(or norest
2292
(and
2293
(moccur-file-size< file-name dmoccur-maximum-size)
2294
(dmoccur-in-list-p file-name dmoccur-mask-internal)
2295
(not (dmoccur-in-list-p file-name
2296
dmoccur-exclusion-mask)))))
2297
(progn
2298
(if (get-file-buffer file-name)
2299
(setq buf-name (get-file-buffer file-name))
2300
(setq buf-name (find-file-noselect file-name)))
2301
(if (cdr file-name-history)
2302
(setq file-name-history (cdr file-name-history)))
2303
(save-current-buffer
2304
(set-buffer buf-name)
2305
(setq dmoccur-buffer-project dmoccur-project-name))
2306
(if buf-name
2307
(setq buffers (cons buf-name buffers)))))))
2308
(setq files (cdr files)))
2309
buffers))
2310
2311
(defun moccur-add-directory-to-search-list (dir)
2312
(setq dmoccur-recursive-ignore-dir nil)
2313
(let ((buffers nil))
2314
(if (listp dir)
2315
(progn
2316
(let ((recursive nil) (cdir nil))
2317
(while dir
2318
(setq cdir (eval (car (car dir))))
2319
(setq dmoccur-recursive-ignore-dir
2320
(nth 2 (car dir)))
2321
(setq recursive
2322
(nth 1 (car dir)))
2323
(setq buffers
2324
(append
2325
(if (file-directory-p cdir)
2326
(moccur-add-files-to-search-list
2327
(directory-files cdir) cdir nil recursive)
2328
(moccur-add-files-to-search-list
2329
(list cdir) (file-name-directory cdir) t))
2330
buffers))
2331
(setq dir (cdr dir)))))
2332
(let ((files (directory-files dir)))
2333
(setq buffers
2334
(moccur-add-files-to-search-list
2335
files dir nil dmoccur-recursive-search))))
2336
(let (list)
2337
(dolist (elt buffers)
2338
(unless (member elt list)
2339
(push elt list)))
2340
(setq buffers list))
2341
buffers))
2342
2343
;;;; minibuffer
2344
(defun dmoccur-read-directory-from-minibuf (default)
2345
(let ((dir nil))
2346
(while (not dir)
2347
(setq dir
2348
(if (and (boundp 'running-xemacs) running-xemacs)
2349
(read-directory-name "Directory: " default)
2350
(read-file-name "Directory: " default nil t)))
2351
;;(read-file-name "Directory: " nil nil t default)))
2352
(if (and (file-exists-p dir)
2353
(file-directory-p dir))
2354
(setq dir (file-name-as-directory dir))
2355
(setq dir (file-name-as-directory (file-name-directory dir)))
2356
(if (and (file-exists-p dir)
2357
(file-directory-p dir))
2358
()
2359
(message "No such directory %s" dir)
2360
(sleep-for 1)
2361
(setq dir nil))))
2362
dir))
2363
2364
(defun dmoccur-read-project-name-from-minibuf (arg)
2365
(let (input-name)
2366
(if (and dmoccur-buffer-project
2367
dmoccur-use-project
2368
(or
2369
(and
2370
(not arg)
2371
dmoccur-use-list)
2372
(and
2373
arg
2374
(not dmoccur-use-list))))
2375
(setq input-name (car dmoccur-buffer-project))
2376
(setq input-name
2377
(completing-read
2378
(concat
2379
"dmoccur name "
2380
(when (car dmoccur-list-history)
2381
(format "(default %s)"
2382
(car dmoccur-list-history)))
2383
" : ")
2384
(let (list)
2385
(dolist (elt (append
2386
dmoccur-project-list
2387
dmoccur-list))
2388
(unless (assoc (car elt) list)
2389
(push elt list)))
2390
list)
2391
nil nil nil 'dmoccur-list-history
2392
(if (car dmoccur-list-history)
2393
(car dmoccur-list-history)
2394
nil))))
2395
input-name))
2396
2397
(defun dmoccur-set-sub-directory (name dir)
2398
(let ((lst nil)
2399
(subdir
2400
(if (listp dir)
2401
(eval (nth 0 (car dir)))
2402
(eval dir))))
2403
(setq lst (mapcar '(lambda (file)
2404
(if (and (not (string-match "\\.+$" file))
2405
(file-directory-p file))
2406
(file-name-nondirectory file)))
2407
(directory-files
2408
subdir t)))
2409
(setq lst (delq nil lst))
2410
2411
(if (and dmoccur-buffer-project
2412
dmoccur-use-project)
2413
(setq subdir (car (cdr dmoccur-buffer-project)))
2414
(setq subdir (concat
2415
(file-name-as-directory subdir)
2416
(completing-read
2417
"dmoccur sub directory : "
2418
(mapcar 'list lst)
2419
nil t)
2420
"/")))
2421
(if (listp dir)
2422
(list (cons subdir (nthcdr 1 (car dir))))
2423
subdir)))
2424
2425
(defun dmoccur-set-project (arg)
2426
(setq dmoccur-project-name nil)
2427
(let (input-name name lst dir)
2428
(setq input-name (dmoccur-read-project-name-from-minibuf arg))
2429
2430
(if (assoc input-name dmoccur-project-list)
2431
(setq name (nth 1 (assoc input-name dmoccur-project-list)))
2432
(setq name input-name))
2433
(cond
2434
((assoc name dmoccur-list)
2435
;; default directory
2436
(setq dir
2437
(if (listp (nth 1 (assoc name dmoccur-list)))
2438
(condition-case err
2439
(eval (nth 1 (assoc name dmoccur-list)))
2440
(error
2441
(nth 1 (assoc name dmoccur-list))))
2442
(file-name-as-directory
2443
(eval (nth 1 (assoc name dmoccur-list))))))
2444
2445
;; 'sub option
2446
(if (string= 'sub (nth 3 (assoc name dmoccur-list)))
2447
(if (and (listp dir)
2448
(not (= (length dir) 1)))
2449
(error "Multiple directory exists!")
2450
(setq dir
2451
(dmoccur-set-sub-directory name dir))))
2452
2453
;; if buffer-project exists, use it
2454
(if (and dmoccur-buffer-project
2455
dmoccur-use-project)
2456
()
2457
(if (string= 'dir (nth 3 (assoc name dmoccur-list)))
2458
(if (and (listp dir)
2459
(not (= (length dir) 1)))
2460
(error "Multiple directory exists!")
2461
(if (listp dir)
2462
(setq dir
2463
(list
2464
(cons
2465
(dmoccur-read-directory-from-minibuf
2466
(eval (car (car dir)))) (cdr (car dir)))))
2467
(setq dir (dmoccur-read-directory-from-minibuf dir))))))
2468
2469
;; set current project
2470
(setq dmoccur-project-name
2471
(if (listp dir)
2472
(cons name dir)
2473
(cons name (cons dir dmoccur-project-name))))
2474
2475
;; mask
2476
(setq dmoccur-mask-internal (nth 2 (assoc name dmoccur-list))))
2477
2478
((assoc input-name dmoccur-project-list)
2479
(if (and (string= name input-name)
2480
(string-match "^dmoccur" name))
2481
(setq name "dmoccur"))
2482
(if (or (string= 'dir (nth 3 (assoc name dmoccur-list)))
2483
(string= 'sub (nth 3 (assoc name dmoccur-list)))
2484
(string= name "dmoccur"))
2485
(setq dir
2486
(substring input-name
2487
(progn
2488
(string-match (concat name "-") input-name)
2489
(match-end 0))))
2490
(setq dir (nth 1 (assoc name dmoccur-project-list))))
2491
(setq dmoccur-project-name (cons name dir)))
2492
(t
2493
(setq dmoccur-list-history (cdr dmoccur-list-history))
2494
(error "Input correct name!")))
2495
dir))
2496
2497
(defun dmoccur-read-from-minibuf (arg)
2498
(let ((dir nil))
2499
(if (or arg
2500
dmoccur-use-list)
2501
(setq dir (dmoccur-set-project arg))
2502
(setq dir default-directory)
2503
(setq dmoccur-mask-internal dmoccur-mask)
2504
(setq dir (dmoccur-read-directory-from-minibuf dir)))
2505
dir))
2506
2507
;;;; interactive
2508
(defun dmoccur (dir regexp arg)
2509
"Show all lines of all buffers containing a match for REGEXP.
2510
The lines are shown in a buffer named *Moccur*.
2511
It serves as a menu to find any of the occurrences in this buffer.
2512
\\[describe-mode] in that buffer will explain how."
2513
(interactive (list (dmoccur-read-from-minibuf current-prefix-arg)
2514
(moccur-regexp-read-from-minibuf)
2515
current-prefix-arg))
2516
(moccur-setup)
2517
2518
(setq moccur-last-command 'dmoccur)
2519
(let* ((list-name (if (car dmoccur-project-name)
2520
(car dmoccur-project-name) "dmoccur"))
2521
(buffers
2522
(moccur-add-directory-to-search-list dir))
2523
(name
2524
(list
2525
(if (and
2526
(or dmoccur-use-list arg)
2527
(or
2528
(not (or (string= 'dir
2529
(nth 3 (assoc list-name dmoccur-list)))
2530
(string= 'sub
2531
(nth 3 (assoc list-name dmoccur-list)))))
2532
(assoc list-name dmoccur-project-list)))
2533
list-name
2534
(concat list-name "-"
2535
(if (listp dir) (expand-file-name (car (car dir)))
2536
(expand-file-name dir))))
2537
list-name)))
2538
;; sort
2539
(setq buffers (sort buffers moccur-buffer-sort-method))
2540
2541
(if (assoc (car name) dmoccur-project-list)
2542
(progn
2543
(let* ((lst (assoc (car name) dmoccur-project-list))
2544
(old-buffers (nthcdr 2 lst)))
2545
(setq dmoccur-project-list (delete lst dmoccur-project-list))
2546
(setq name
2547
(append name
2548
(let ((list nil))
2549
(dolist (elt (append
2550
old-buffers
2551
buffers))
2552
(unless (memq elt list)
2553
(push elt list)))
2554
list)))))
2555
(setq name
2556
(append name
2557
buffers)))
2558
2559
(setq dmoccur-project-list
2560
(cons
2561
name
2562
dmoccur-project-list))
2563
2564
(if (nth 4 (assoc list-name dmoccur-list))
2565
(let* ((conf (if (nth 4 (assoc list-name dmoccur-list))
2566
(nth 4 (assoc list-name dmoccur-list))
2567
nil))
2568
(moccur-use-migemo (car conf))
2569
(moccur-split-word (car (cdr conf))))
2570
(moccur-search regexp arg buffers))
2571
(moccur-search regexp arg buffers))))
2572
2573
(defun clean-dmoccur-buffers ()
2574
(interactive)
2575
(let (name buffers lst)
2576
(setq name (completing-read
2577
(concat
2578
"dmoccur name "
2579
" : ")
2580
dmoccur-project-list))
2581
2582
(setq buffers (nthcdr 2 (assoc name dmoccur-project-list)))
2583
(setq lst (list
2584
(nth 1 (assoc name dmoccur-project-list))))
2585
(setq lst (append (list name) lst))
2586
(setq lst (append lst buffers))
2587
2588
(setq dmoccur-project-list (delete lst dmoccur-project-list))
2589
(while buffers
2590
(if (and (car buffers)
2591
(buffer-live-p (car buffers))
2592
(get-buffer (car buffers))
2593
(not (buffer-modified-p (car buffers))))
2594
(kill-buffer (car buffers)))
2595
(setq buffers (cdr buffers)))))
2596
2597
;;; call moccur
2598
;;;; dired
2599
(defun dired-do-moccur-by-moccur (regexp arg)
2600
(let ((buffers (moccur-add-files-to-search-list
2601
(funcall (cond ((fboundp 'dired-get-marked-files) ; GNU Emacs
2602
'dired-get-marked-files)
2603
((fboundp 'dired-mark-get-files) ; XEmacs
2604
'dired-mark-get-files))
2605
t nil) default-directory t 'dired))
2606
(buff nil))
2607
(moccur-search regexp arg buffers)
2608
(setq moccur-last-command 'dired-do-moccur)
2609
(when kill-buffer-after-dired-do-moccur
2610
(while buffers
2611
(setq buff (car buffers))
2612
(if (memq buff moccur-match-buffers)
2613
()
2614
(if (memq buff moccur-buffers-before-moccur)
2615
(delq buff buffers)
2616
(kill-buffer buff)))
2617
(setq buffers (cdr buffers))))))
2618
2619
(defun dired-do-moccur-by-mgrep (regexp arg)
2620
(let* ((files (funcall (cond ((fboundp 'dired-get-marked-files) ; GNU Emacs
2621
'dired-get-marked-files)
2622
((fboundp 'dired-mark-get-files) ; XEmacs
2623
'dired-mark-get-files))
2624
t nil))
2625
(buff nil))
2626
(moccur-grep-find files
2627
(moccur-split-string
2628
(concat regexp " .") " "))
2629
(setq moccur-last-command 'dired-do-moccur)))
2630
2631
(defun dired-do-moccur (regexp arg)
2632
"Show all lines of all buffers containing a match for REGEXP.
2633
The lines are shown in a buffer named *Moccur*.
2634
It serves as a menu to find any of the occurrences in this buffer.
2635
\\[describe-mode] in that buffer will explain how."
2636
(interactive (list (moccur-regexp-read-from-minibuf)
2637
current-prefix-arg))
2638
(moccur-setup)
2639
(setq moccur-buffers-before-moccur (buffer-list))
2640
(if arg
2641
(dired-do-moccur-by-moccur regexp arg)
2642
(dired-do-moccur-by-mgrep regexp arg)))
2643
2644
;;;; kill-buffer when moccur-quit
2645
(defadvice moccur-quit (before moccur-quit-kill-buffers activate)
2646
(let ((buffers moccur-match-buffers)
2647
(buff nil)
2648
(mocc-window (selected-window))
2649
(mocc-buffer (window-buffer (selected-window))))
2650
(while moccur-xdoc2txt-buffers
2651
(when (buffer-live-p
2652
(get-buffer (car (car moccur-xdoc2txt-buffers))))
2653
(kill-buffer (car (car moccur-xdoc2txt-buffers))))
2654
(setq moccur-xdoc2txt-buffers (cdr moccur-xdoc2txt-buffers)))
2655
(while buffers
2656
(setq buff (car buffers))
2657
(when (and (eq moccur-last-command 'dired-do-moccur)
2658
kill-buffer-after-dired-do-moccur
2659
(buffer-live-p buff)
2660
(buffer-name buff))
2661
(select-window (next-window mocc-window))
2662
(set-window-buffer (selected-window) buff)
2663
(if (and (buffer-file-name buff)
2664
(buffer-modified-p buff)
2665
(y-or-n-p (concat "Buffer "
2666
(buffer-name buff)
2667
" modified. Save it? ")))
2668
(save-buffer)
2669
(set-buffer-modified-p nil)) ;; mark as not modified
2670
(display-buffer mocc-buffer)
2671
(select-window mocc-window)
2672
(if (memq buff moccur-buffers-before-moccur)
2673
(delq buff buffers)
2674
(kill-buffer buff)))
2675
(setq buffers (cdr buffers))))
2676
nil)
2677
2678
;;;; Buffer-menu-moccur
2679
(defun Buffer-menu-moccur (regexp arg)
2680
(interactive (list (moccur-regexp-read-from-minibuf)
2681
current-prefix-arg))
2682
(setq arg 1)
2683
(moccur-kill-buffer t)
2684
(setq moccur-last-command 'buffer-menu-moccur)
2685
(let ((marked-buffer) (marked-files))
2686
(goto-char (point-min))
2687
(while (search-forward "\n>" nil t)
2688
(setq marked-buffer (Buffer-menu-buffer t))
2689
(setq marked-files (cons marked-buffer marked-files)))
2690
(moccur-search regexp arg marked-files)))
2691
2692
(unless (featurep 'ibuffer)
2693
(defun ibuffer-map-marked-lines (func))
2694
(defun ibuffer-do-occur (regexp &optional nlines)))
2695
(defadvice ibuffer-do-occur
2696
(around ibuffer-menu-moccur activate)
2697
(interactive (list (moccur-regexp-read-from-minibuf)
2698
current-prefix-arg))
2699
(setq moccur-last-command 'buffer-menu-moccur)
2700
(let (arg (regexp (ad-get-arg 0)))
2701
(setq arg 1)
2702
(moccur-kill-buffer t)
2703
(let ((marked-buffers nil))
2704
(ibuffer-map-marked-lines
2705
#'(lambda (buf mark beg end)
2706
(push buf marked-buffers)))
2707
(ibuffer-unmark-all 62)
2708
(moccur-search regexp arg marked-buffers))))
2709
2710
;;; moccur mode
2711
;;;; keybind
2712
(defvar moccur-mode-map ())
2713
(defun moccur-set-key ()
2714
(let ((map (make-sparse-keymap)))
2715
(define-key map "e" 'moccur-toggle-buffer)
2716
(define-key map "\C-c\C-c" 'moccur-mode-goto-occurrence)
2717
(define-key map "\C-m" 'moccur-mode-goto-occurrence)
2718
(define-key map "d" 'moccur-kill-line)
2719
(define-key map "\C-k" 'moccur-kill-line)
2720
(define-key map "\M-d" 'moccur-mode-kill-file)
2721
(define-key map "/" 'moccur-mode-undo)
2722
;;(define-key map "f" 'moccur-flush-lines) ;; M-x
2723
;;(define-key map "" 'moccur-keep-lines) ;; M-x
2724
(define-key map "q" 'moccur-quit)
2725
(define-key map "n" 'moccur-next)
2726
(define-key map "p" 'moccur-prev)
2727
(define-key map "j" 'moccur-next)
2728
(define-key map "k" 'moccur-prev)
2729
(define-key map '[wheel-down] 'moccur-next)
2730
(define-key map '[wheel-up] 'moccur-prev)
2731
(define-key map "s" 'moccur-narrow-down)
2732
(define-key map "u" 'moccur-search-undo)
2733
(define-key map "g" 'moccur-search-update)
2734
(define-key map '[down] 'moccur-next)
2735
(define-key map '[up] 'moccur-prev)
2736
(define-key map "t" 'moccur-toggle-view)
2737
(define-key map "b" 'moccur-file-scroll-down)
2738
(define-key map " " 'moccur-file-scroll-up)
2739
;; (define-key map "b" 'moccur-scroll-down)
2740
;; (define-key map " " 'moccur-scroll-up)
2741
(define-key map "\M-v" 'moccur-scroll-down)
2742
(define-key map "\C-v" 'moccur-scroll-up)
2743
(define-key map "h" 'moccur-next-file)
2744
(define-key map "l" 'moccur-prev-file)
2745
(define-key map "\M-n" 'moccur-next-file)
2746
(define-key map "\M-p" 'moccur-prev-file)
2747
(define-key map '[M-wheel-down] 'moccur-next-file)
2748
(define-key map '[M-wheel-up] 'moccur-prev-file)
2749
2750
(define-key map '[down-mouse-1] 'moccur-mouse-select1)
2751
2752
(define-key map "<" 'moccur-file-beginning-of-buffer)
2753
(define-key map ">" 'moccur-file-end-of-buffer)
2754
2755
(condition-case nil
2756
(progn
2757
(require 'moccur-edit)
2758
(define-key map "r" 'moccur-edit-mode-in)
2759
(define-key map "\C-x\C-q" 'moccur-edit-mode-in)
2760
(define-key map "\C-c\C-i" 'moccur-edit-mode-in))
2761
(error
2762
nil))
2763
map))
2764
2765
(if moccur-mode-map
2766
()
2767
(setq moccur-mode-map (make-sparse-keymap))
2768
(setq moccur-mode-map (moccur-set-key)))
2769
2770
(defvar moccur-ee-mode-map ())
2771
(defun moccur-set-key-ee ()
2772
(let ((map (make-sparse-keymap)))
2773
(setq map (moccur-set-key))
2774
;; Expansion visibility
2775
(define-key map "+" 'ee-view-expansion-show)
2776
(define-key map "-" 'ee-view-expansion-hide)
2777
(define-key map "=" 'ee-view-expansion-show)
2778
;; on some keyboards "=" is on same key as "+", but typed w/o shift
2779
(define-key map "*" 'ee-view-expansion-show-subtree)
2780
;;(define-key map "/" 'ee-view-expansion-hide-subtree)
2781
;; Help
2782
(define-key map "?" 'describe-mode)
2783
;;(define-key map "r"
2784
;; (lambda () (interactive) (message "%S" (ee-view-record-get))))
2785
;;(define-key map "\C-c\C-hr"
2786
;; (lambda () (interactive) (message "%S" (ee-view-record-get))))
2787
;; Buffer
2788
(define-key map "g" 'ee-view-buffer-revert)
2789
(define-key map "\C-x\C-s" 'ee-data-file-save)
2790
;; outline-like key bindings
2791
(define-key map "\C-c\C-n" 'ee-view-expansion-next-visible)
2792
(define-key map "\C-c\C-p" 'ee-view-expansion-prev-visible)
2793
(define-key map "\C-c\C-f" 'ee-view-expansion-next-same-level)
2794
(define-key map "\C-c\C-b" 'ee-view-expansion-prev-same-level)
2795
(define-key map "\C-c\C-u" 'ee-view-expansion-up)
2796
(define-key map "\C-c\C-i" 'ee-view-expansion-show-children)
2797
(define-key map "\C-c\C-s" 'ee-view-expansion-show-subtree)
2798
(define-key map "\C-c\C-d" 'ee-view-expansion-hide-subtree)
2799
(define-key map "\C-c\C-t" 'ee-view-expansion-hide-body)
2800
(define-key map "\C-c\C-a" 'ee-view-expansion-show-all)
2801
(define-key map "\C-c\C-l" 'ee-view-expansion-hide-leaves)
2802
(define-key map "\C-c\C-k" 'ee-view-expansion-show-branches)
2803
(define-key map "\C-c\C-q" 'ee-view-expansion-hide-sublevels)
2804
(define-key map "\C-c\C-o" 'ee-view-expansion-hide-other)
2805
;; dired-like key bindings
2806
(define-key map "$" 'ee-view-expansion-show-or-hide)
2807
;; (define-key map ">" 'ee-view-expansion-next)
2808
;; (define-key map "<" 'ee-view-expansion-prev)
2809
(define-key map "^" 'ee-view-expansion-up)
2810
(define-key map [(meta ?o)] 'ee-view-filter-omit)
2811
(define-key map [down-mouse-1] 'ee-mouse-navigation)
2812
(define-key map [right] 'ee-view-expansion-show-or-next)
2813
(define-key map [left] 'ee-view-expansion-hide-or-up-or-prev)
2814
(define-key map [(meta up)] 'ee-view-expansion-prev-sibling)
2815
(define-key map [(meta down)] 'ee-view-expansion-next-sibling)
2816
(define-key map [(meta right)] 'ee-view-expansion-up)
2817
(define-key map [(meta left)] 'ee-view-expansion-down)
2818
(define-key map [(control ?+)] 'ee-view-expansion-show-all)
2819
(define-key map [(control ?-)] 'ee-view-expansion-hide-all)
2820
map))
2821
2822
(if moccur-ee-mode-map
2823
()
2824
(setq moccur-ee-mode-map (make-sparse-keymap))
2825
(setq moccur-ee-mode-map (moccur-set-key-ee)))
2826
2827
;;;; utility
2828
(defun moccur-outline-level ()
2829
(if (looking-at "\\(^Buffer: \\)")
2830
0
2831
(if (looking-at "\\(^[ ]*[0-9]+ \\)")
2832
1)))
2833
2834
;;;; re-search function
2835
(defun moccur-narrow-down-get-targets (target-regexp target-type)
2836
(let ((case-fold-search t)
2837
(targets nil) target-name)
2838
(save-excursion
2839
(set-buffer (get-buffer "*Moccur*"))
2840
(goto-char (point-min))
2841
(while (re-search-forward target-regexp nil t)
2842
(setq target-name (buffer-substring-no-properties
2843
(match-beginning 1)
2844
(match-end 1)))
2845
(if (equal target-type 'file)
2846
(setq targets (cons target-name targets))
2847
(if (get-buffer target-name)
2848
(setq targets (cons
2849
(get-buffer target-name) targets)))))
2850
targets)))
2851
2852
(defun moccur-narrow-down-get-buffers()
2853
(moccur-narrow-down-get-targets moccur-buffer-heading-regexp 'buffer))
2854
2855
(defun moccur-narrow-down-get-files()
2856
(moccur-narrow-down-get-targets moccur-grep-buffer-heading-regexp 'file))
2857
2858
;;;; functions
2859
(defun moccur-narrow-down (regexp arg)
2860
"Show all lines of all buffers containing a match for REGEXP.
2861
The lines are shown in a buffer named *Moccur*.
2862
It serves as a menu to find any of the occurrences in this buffer.
2863
\\[describe-mode] in that buffer will explain how."
2864
(interactive (list (moccur-regexp-read-from-minibuf)
2865
current-prefix-arg))
2866
2867
(setq moccur-mocur-buffer (current-buffer))
2868
(setq moccur-last-command 'moccur-narrow-down)
2869
(if (equal major-mode 'moccur-grep-mode)
2870
(let ((files (reverse (moccur-narrow-down-get-files))))
2871
(moccur-setup)
2872
(moccur-search-files regexp files))
2873
(let ((buffers (reverse (moccur-narrow-down-get-buffers))))
2874
(moccur-setup)
2875
(moccur-search regexp arg buffers))))
2876
2877
(defun moccur-mode-goto-occurrence ()
2878
"Go to the line this occurrence was found in, in the buffer it was found in."
2879
(interactive)
2880
;; (if (not (and moccur-view-other-window
2881
;; moccur-view-other-window-nobuf))
2882
;; (moccur-view-file)
2883
(setq moccur-mocur-buffer (current-buffer))
2884
(if (not (eq major-mode 'moccur-mode))
2885
(error "This is no moccur buffer")
2886
(let ((beg nil)
2887
(line nil)
2888
(lineno nil)
2889
(dstbuf nil))
2890
(moccur-remove-overlays-on-all-buffers)
2891
(save-excursion
2892
(beginning-of-line 1)
2893
(setq beg (point))
2894
(end-of-line 1)
2895
(setq line (buffer-substring beg (point)))
2896
(if (or (string-match "^[ ]*[0-9]* " line)
2897
(string-match "^[-+ ]*Buffer: " line))
2898
(progn
2899
(if (string-match "^[-+ ]*Buffer: " line)
2900
(setq lineno nil)
2901
(setq lineno (car (read-from-string line))))
2902
(if (re-search-backward "^[-+ ]*Buffer: ")
2903
(progn
2904
(search-forward "Buffer: ")
2905
(setq beg (point))
2906
(search-forward " File:")
2907
(setq line (buffer-substring beg (- (point) 6)))
2908
(setq dstbuf (get-buffer line))
2909
(if (not dstbuf)
2910
(message "buffer: <%s> doesn't exist anymore" line)))
2911
(error "What did you do with the header?!")))
2912
(error "This is no occurrence line!")))
2913
(if dstbuf
2914
(progn
2915
(if lineno
2916
(message "selecting <%s> line %d" line lineno)
2917
(message "selecting <%s>" line))
2918
(pop-to-buffer dstbuf)
2919
(if lineno
2920
(goto-line lineno))
2921
(if moccur-kill-buffer-after-goto
2922
(moccur-kill-buffer nil))
2923
(delete-other-windows))))))
2924
2925
(defun moccur-toggle-buffer ()
2926
(interactive)
2927
(when (and moccur-use-ee (not (featurep 'allout)))
2928
(let ((str
2929
(progn
2930
(save-excursion
2931
(if (and (not (and (boundp 'running-xemacs) running-xemacs))
2932
transient-mark-mode mark-active)
2933
(goto-char (region-beginning)))
2934
(beginning-of-line)
2935
(re-search-forward "[^-+ ]" nil t)
2936
(regexp-quote
2937
(buffer-substring-no-properties
2938
(- (point) 1) (line-end-position)))))))
2939
(if (string-match "ee" (buffer-name (current-buffer)))
2940
(if (buffer-live-p (get-buffer "*Moccur*"))
2941
(switch-to-buffer (get-buffer "*Moccur*")))
2942
(if (buffer-live-p (get-buffer "*ee-outline*/*Moccur*"))
2943
(switch-to-buffer (get-buffer "*ee-outline*/*Moccur*"))))
2944
(goto-char (point-min))
2945
(condition-case err
2946
(re-search-forward str)
2947
(error
2948
nil))
2949
)))
2950
2951
(defun moccur-mouse-select1 (e)
2952
(interactive "e")
2953
(mouse-set-point e)
2954
(save-excursion
2955
(beginning-of-line)
2956
(moccur-next 0)))
2957
2958
(defun moccur-mouse-goto-occurrence (e)
2959
(interactive "e")
2960
(mouse-set-point e)
2961
(save-excursion
2962
(beginning-of-line)
2963
(moccur-mode-goto-occurrence)))
2964
2965
(defun moccur-next (arg)
2966
(interactive "p")
2967
(setq moccur-mocur-buffer (current-buffer))
2968
(if arg
2969
(forward-line arg)
2970
(forward-line 1))
2971
(beginning-of-line)
2972
2973
(if (and moccur-use-ee (not (featurep 'allout))
2974
(let (end)
2975
(save-excursion
2976
(if (re-search-backward "^\\([-+ ]*\\)Buffer:" nil t)
2977
(if (string-match "+"
2978
(buffer-substring-no-properties
2979
(match-beginning 1) (match-end 1)))
2980
t
2981
nil)
2982
t))))
2983
(progn
2984
(re-search-forward "^\\([-+ ]*\\)Buffer:" nil t)
2985
(beginning-of-line))
2986
(when (re-search-forward moccur-line-number-regexp nil t)
2987
(save-restriction
2988
(narrow-to-region (point) (line-end-position))
2989
(re-search-forward (car moccur-regexp-list) nil t))))
2990
(moccur-get-info)
2991
(if (and moccur-view-other-window
2992
moccur-view-other-window-nobuf
2993
moccur-following-mode-toggle)
2994
(moccur-view-file)))
2995
2996
(defun moccur-prev (arg)
2997
(interactive "p")
2998
(setq moccur-mocur-buffer (current-buffer))
2999
(if arg
3000
(forward-line (* -1 arg))
3001
(forward-line -1))
3002
(end-of-line)
3003
3004
(if (and moccur-use-ee
3005
(not (featurep 'allout))
3006
(let (end)
3007
(save-excursion
3008
(if (re-search-backward "^\\([-+ ]*\\)Buffer:" nil t)
3009
(if (string-match "+"
3010
(buffer-substring-no-properties
3011
(match-beginning 1) (match-end 1)))
3012
t
3013
nil)
3014
nil))))
3015
(re-search-backward "^\\([-+ ]*\\)Buffer:" nil t)
3016
(end-of-line)
3017
(if (re-search-backward moccur-line-number-regexp nil t)
3018
(save-restriction
3019
(re-search-forward moccur-line-number-regexp nil t)
3020
(narrow-to-region (point) (line-end-position))
3021
(re-search-forward (car moccur-regexp-list) nil t))
3022
(beginning-of-line)))
3023
(moccur-get-info)
3024
(if (and moccur-view-other-window
3025
moccur-view-other-window-nobuf
3026
moccur-following-mode-toggle)
3027
(moccur-view-file)))
3028
3029
(defun moccur-file-scroll-up ()
3030
(interactive)
3031
(setq moccur-mocur-buffer (current-buffer))
3032
(moccur-get-info)
3033
(if (and moccur-view-other-window
3034
moccur-view-other-window-nobuf)
3035
(moccur-scroll-file nil)))
3036
3037
(defun moccur-file-scroll-down ()
3038
(interactive)
3039
(setq moccur-mocur-buffer (current-buffer))
3040
(moccur-get-info)
3041
(if (and moccur-view-other-window
3042
moccur-view-other-window-nobuf)
3043
(moccur-scroll-file t)))
3044
3045
(defun moccur-file-beginning-of-buffer ()
3046
(interactive)
3047
(setq moccur-mocur-buffer (current-buffer))
3048
(moccur-get-info)
3049
(if (and moccur-view-other-window
3050
moccur-view-other-window-nobuf)
3051
(moccur-internal-beginning-of-buffer nil)))
3052
3053
(defun moccur-file-end-of-buffer ()
3054
(interactive)
3055
(setq moccur-mocur-buffer (current-buffer))
3056
(moccur-get-info)
3057
(if (and moccur-view-other-window
3058
moccur-view-other-window-nobuf)
3059
(moccur-internal-beginning-of-buffer t)))
3060
3061
(defun moccur-scroll-up ()
3062
(interactive)
3063
(scroll-up)
3064
(if (boundp 'forward-visible-line)
3065
(forward-visible-line -1)
3066
(forward-line -1))
3067
(end-of-line)
3068
(moccur-next 1))
3069
3070
(defun moccur-scroll-down ()
3071
(interactive)
3072
(scroll-down)
3073
(if (boundp 'forward-visible-line)
3074
(forward-visible-line 1)
3075
(forward-line 1))
3076
(beginning-of-line)
3077
(moccur-prev 1))
3078
3079
(defun moccur-next-file ()
3080
(interactive)
3081
(if (re-search-forward "^[-+ ]*Buffer: " nil t)
3082
(moccur-next 1)
3083
(goto-char (point-min))
3084
(moccur-next 1)))
3085
3086
(defun moccur-prev-file ()
3087
(interactive)
3088
(if (re-search-backward "^[-+ ]*Buffer: " nil t 2)
3089
(moccur-next 1)
3090
(goto-char (point-max))
3091
(if (re-search-backward "^[-+ ]*Buffer: " nil t)
3092
(moccur-next 1))))
3093
3094
(defun moccur-mode-kill-file-internal ()
3095
(let ((start-pt (progn
3096
(re-search-backward "^[-+ ]*Buffer: " nil t)
3097
(line-beginning-position)))
3098
(end-pt nil))
3099
3100
(forward-line 1)
3101
(if (re-search-forward moccur-buffer-heading-regexp nil t)
3102
(setq end-pt (line-beginning-position))
3103
(setq end-pt (point-max)))
3104
(delete-region start-pt end-pt)))
3105
3106
(defun moccur-mode-kill-line-internal ()
3107
(delete-region (line-beginning-position)
3108
(+ (line-end-position) 1))
3109
3110
(moccur-get-info)
3111
(when (= 0 moccur-buffer-match-count)
3112
(moccur-mode-kill-file)))
3113
3114
(defun moccur-mode-start-ee-switch-before-buffer (ee line)
3115
(moccur-ee-start)
3116
3117
(if (and ee
3118
(string-match "ee" (buffer-name (current-buffer))))
3119
(moccur-switch-buffer 'ee)
3120
(moccur-switch-buffer 'normal))
3121
(goto-line line))
3122
3123
(defun moccur-mode-kill-ee ()
3124
(when (and (string-match "ee" (buffer-name (current-buffer)))
3125
(buffer-live-p (get-buffer "*ee-outline*/*Moccur*")))
3126
(kill-buffer (get-buffer "*ee-outline*/*Moccur*"))))
3127
3128
(defun moccur-kill-line ()
3129
(interactive)
3130
(let* ((line (progn (end-of-line) (count-lines 1 (point))))
3131
(moccur-current-ee
3132
(if (string-match "ee" (buffer-name (current-buffer)))
3133
t
3134
nil))
3135
(str
3136
(regexp-quote
3137
(progn
3138
(save-excursion
3139
(beginning-of-line)
3140
(re-search-forward "[^ ]" (line-end-position) t)
3141
(buffer-substring-no-properties
3142
(- (point) 1) (line-end-position)))))))
3143
3144
(moccur-mode-kill-ee)
3145
(moccur-switch-buffer 'normal)
3146
(goto-char (point-min))
3147
(if (string-match "^[+-]" str)
3148
(setq str (substring str 2)))
3149
(let ((buffer-read-only nil)
3150
(inhibit-read-only nil))
3151
(when (re-search-forward str nil t)
3152
(line-beginning-position)
3153
(cond
3154
((string-match "^[ ]*$" str)
3155
())
3156
((string-match moccur-buffer-heading-regexp str)
3157
(moccur-mode-kill-file-internal))
3158
3159
((string-match moccur-line-number-regexp str)
3160
(moccur-mode-kill-line-internal))
3161
(t
3162
()))))
3163
3164
;; highlight but slow..., so comment...
3165
;;(moccur-buffer-color)
3166
(moccur-mode-start-ee-switch-before-buffer moccur-current-ee line)))
3167
3168
(defun moccur-mode-kill-file ()
3169
(interactive)
3170
(let* ((line (progn (end-of-line) (count-lines 1 (point))))
3171
(moccur-current-ee
3172
(if (string-match "ee" (buffer-name (current-buffer)))
3173
t
3174
nil))
3175
(str
3176
(regexp-quote
3177
(progn
3178
(save-excursion
3179
(end-of-line)
3180
(re-search-backward "^[-+ ]*Buffer: " nil t)
3181
(buffer-substring-no-properties
3182
(point) (line-end-position)))))))
3183
3184
(moccur-mode-kill-ee)
3185
(moccur-switch-buffer 'normal)
3186
(goto-char (point-min))
3187
(if (string-match "^[+-]" str)
3188
(setq str (substring str 2)))
3189
(let ((buffer-read-only nil)
3190
(inhibit-read-only nil))
3191
(when (re-search-forward (regexp-quote str) nil t)
3192
(line-beginning-position)
3193
(moccur-mode-kill-file-internal)))
3194
3195
;; highlight but slow..., so comment...
3196
;;(moccur-buffer-color)
3197
3198
(moccur-mode-start-ee-switch-before-buffer moccur-current-ee line)))
3199
3200
(defun moccur-mode-undo ()
3201
(interactive)
3202
(let* ((line (progn (end-of-line) (count-lines 1 (point))))
3203
(moccur-current-ee
3204
(if (string-match "ee" (buffer-name (current-buffer)))
3205
t
3206
nil))
3207
(str
3208
(regexp-quote
3209
(progn
3210
(save-excursion
3211
(end-of-line)
3212
(re-search-backward "^[-+ ]*Buffer: " nil t)
3213
(buffer-substring-no-properties
3214
(point) (line-end-position)))))))
3215
3216
(moccur-mode-kill-ee)
3217
(moccur-switch-buffer 'normal)
3218
(if (string-match "^[+-]" str)
3219
(setq str (substring str 2)))
3220
(let ((buffer-read-only nil)
3221
(inhibit-read-only nil))
3222
(condition-case err
3223
(undo)
3224
(error
3225
()))
3226
(goto-char (point-min))
3227
(re-search-forward (regexp-quote str) nil t))
3228
3229
;; highlight but slow..., so comment...
3230
;;(moccur-buffer-color)
3231
3232
(moccur-mode-start-ee-switch-before-buffer moccur-current-ee line)))
3233
3234
(defun moccur-flush-lines ()
3235
(interactive)
3236
(let ((str
3237
(progn
3238
(save-excursion
3239
(if (and (not (and (boundp 'running-xemacs) running-xemacs))
3240
transient-mark-mode mark-active)
3241
(goto-char (region-beginning)))
3242
(beginning-of-line)
3243
(re-search-forward "[^ ]" nil t)
3244
(regexp-quote
3245
(buffer-substring-no-properties
3246
(- (point) 1) (line-end-position))))))
3247
(rend-str (if (and (not (and (boundp 'running-xemacs) running-xemacs))
3248
transient-mark-mode mark-active)
3249
(progn
3250
(save-excursion
3251
(goto-char (region-end))
3252
(beginning-of-line)
3253
(re-search-forward "[^ ]" (line-end-position) t)
3254
(regexp-quote
3255
(buffer-substring-no-properties
3256
(- (point) 1) (line-end-position)))))
3257
nil))
3258
(line (progn (save-excursion (end-of-line) (count-lines 1 (point)))))
3259
(moccur-current-ee
3260
(if (string-match "ee" (buffer-name (current-buffer)))
3261
t
3262
nil))
3263
(regexp
3264
(read-from-minibuffer
3265
"Flush lines (containing match for regexp): " nil nil nil
3266
'regexp-history nil t)))
3267
3268
(moccur-mode-kill-ee)
3269
(moccur-switch-buffer 'normal)
3270
3271
(goto-char (point-min))
3272
(if (string-match "^[+-]" str)
3273
(setq str (substring str 2)))
3274
(if (and rend-str
3275
(string-match "^[+-]" rend-str))
3276
(setq rend-str (substring rend-str 2)))
3277
3278
(re-search-forward (regexp-quote str) nil t)
3279
(beginning-of-line)
3280
(let (rstart rend
3281
(buffer-read-only nil)
3282
(inhibit-read-only nil))
3283
(setq rstart (point))
3284
(if rend-str
3285
(setq rend (copy-marker
3286
(save-excursion
3287
(goto-char (point-min))
3288
(re-search-forward (regexp-quote rend-str) nil t)
3289
(end-of-line)
3290
(point))))
3291
(setq rend (point-max-marker)))
3292
(goto-char rstart)
3293
(let ((case-fold-search case-fold-search))
3294
(save-excursion
3295
(while (and (< (point) rend)
3296
(re-search-forward regexp rend t))
3297
(goto-char (line-beginning-position))
3298
(unless (re-search-forward
3299
moccur-buffer-heading-regexp (line-end-position) t)
3300
(line-beginning-position)
3301
(moccur-mode-kill-line-internal))))))
3302
(moccur-mode-start-ee-switch-before-buffer moccur-current-ee line)))
3303
3304
(defun moccur-keep-lines ()
3305
(interactive)
3306
(let ((str
3307
(progn
3308
(save-excursion
3309
(if (and (not (and (boundp 'running-xemacs) running-xemacs))
3310
transient-mark-mode mark-active)
3311
(goto-char (region-beginning)))
3312
(beginning-of-line)
3313
(re-search-forward "[^ ]" nil t)
3314
(regexp-quote
3315
(buffer-substring-no-properties
3316
(- (point) 1) (line-end-position))))))
3317
(rend-str (if (and (not (and (boundp 'running-xemacs) running-xemacs))
3318
transient-mark-mode mark-active)
3319
(progn
3320
(save-excursion
3321
(goto-char (region-end))
3322
(beginning-of-line)
3323
(re-search-forward "[^ ]" (line-end-position) t)
3324
(regexp-quote
3325
(buffer-substring-no-properties
3326
(- (point) 1) (line-end-position)))))
3327
nil))
3328
(line (progn (save-excursion (end-of-line) (count-lines 1 (point)))))
3329
(moccur-current-ee
3330
(if (string-match "ee" (buffer-name (current-buffer)))
3331
t
3332
nil))
3333
(regexp (read-from-minibuffer
3334
"Flush lines (containing match for regexp): " nil nil nil
3335
'regexp-history nil t)))
3336
3337
(moccur-mode-kill-ee)
3338
(moccur-switch-buffer 'normal)
3339
3340
(goto-char (point-min))
3341
(if (string-match "^[+-]" str)
3342
(setq str (substring str 2)))
3343
(if (and rend-str
3344
(string-match "^[+-]" rend-str))
3345
(setq rend-str (substring rend-str 2)))
3346
3347
(re-search-forward (regexp-quote str) nil t)
3348
(beginning-of-line)
3349
(let (rstart rend
3350
(buffer-read-only nil)
3351
(inhibit-read-only nil))
3352
(setq rstart (point))
3353
(if rend-str
3354
(setq rend (copy-marker
3355
(save-excursion
3356
(goto-char (point-min))
3357
(re-search-forward (regexp-quote rend-str) nil t)
3358
(end-of-line)
3359
(point))))
3360
(setq rend (point-max-marker)))
3361
(goto-char rstart)
3362
(let ((case-fold-search case-fold-search))
3363
(save-excursion
3364
(while (< (point) rend)
3365
(goto-char (beginning-of-line))
3366
(unless (or (string=
3367
(buffer-substring-no-properties
3368
(line-beginning-position) (line-end-position)) "")
3369
(save-excursion
3370
(re-search-forward regexp (line-end-position) t)))
3371
(unless
3372
(re-search-forward
3373
moccur-buffer-heading-regexp (line-end-position) t)
3374
(beginning-of-line)
3375
(moccur-mode-kill-line-internal)
3376
(forward-line -1)))
3377
(forward-line 1)))))
3378
(moccur-mode-start-ee-switch-before-buffer moccur-current-ee line)))
3379
3380
(defun moccur-quit ()
3381
(interactive)
3382
(while moccur-xdoc2txt-buffers
3383
(when (buffer-live-p
3384
(car (car moccur-xdoc2txt-buffers)))
3385
(kill-buffer (car (car moccur-xdoc2txt-buffers))))
3386
(setq moccur-xdoc2txt-buffers (cdr moccur-xdoc2txt-buffers)))
3387
(setq buffer-menu-moccur nil)
3388
(moccur-kill-buffer nil)
3389
3390
(when (buffer-live-p moccur-current-buffer)
3391
(switch-to-buffer moccur-current-buffer)
3392
(when moccur-windows-conf
3393
(set-window-configuration moccur-windows-conf)))
3394
3395
;; this is needed as "save-excursion" is used in
3396
;; "moccur-remove-overlays-on-all-buffers", so we have to make sure the point in current
3397
;; buffer is already restored before calling "moccur-remove-overlays-on-all-buffers"
3398
(when moccur-buffer-position
3399
(goto-char moccur-buffer-position)
3400
(setq moccur-buffer-position nil))
3401
3402
(moccur-remove-overlays-on-all-buffers))
3403
3404
(defun moccur-toggle-view ()
3405
(interactive)
3406
(setq moccur-view-other-window (not moccur-view-other-window)))
3407
3408
;;;; body
3409
(defun moccur-mode (&optional ee)
3410
"Major mode for output from \\[moccur].
3411
Move point to one of the occurrences in this buffer,
3412
then use \\[moccur-mode-goto-occurrence] to move to the buffer and
3413
line where it was found.
3414
\\{occur-mode-map}"
3415
(kill-all-local-variables)
3416
(setq buffer-read-only t)
3417
(setq major-mode 'moccur-mode)
3418
(setq mode-name "Moccur")
3419
(if ee
3420
(progn
3421
(setq mode-name "Moccur-ee")
3422
(use-local-map moccur-ee-mode-map)
3423
(setq moccur-ee-mode-map (moccur-set-key-ee)))
3424
(use-local-map moccur-mode-map)
3425
(setq moccur-mode-map (moccur-set-key)))
3426
(make-local-variable 'line-move-ignore-invisible)
3427
(setq line-move-ignore-invisible t)
3428
(if (not (and (boundp 'running-xemacs) running-xemacs))
3429
(add-to-invisibility-spec '(moccur . t)))
3430
(make-local-variable 'outline-regexp)
3431
(setq outline-regexp "\\(^Buffer: \\|^[ ]*[0-9]+ \\)")
3432
(make-local-variable 'outline-level)
3433
(setq outline-level 'moccur-outline-level))
3434
3435
(defun moccur-grep-mode ()
3436
"Major mode for output from \\[moccur-grep].
3437
Move point to one of the occurrences in this buffer,
3438
then use \\[moccur-grep-goto] to move to the buffer and
3439
line where it was found.
3440
\\{occur-mode-map}"
3441
(kill-all-local-variables)
3442
(setq buffer-read-only t)
3443
(setq major-mode 'moccur-grep-mode)
3444
(setq mode-name "Moccur-grep")
3445
(use-local-map moccur-mode-map)
3446
(setq moccur-mode-map (moccur-set-key))
3447
;; Commented out by <WL> (who should we disable moccur-toggle-view here?)
3448
;; (local-unset-key "t")
3449
(local-set-key "\C-m" 'moccur-grep-goto)
3450
(local-set-key "\C-c\C-c" 'moccur-grep-goto)
3451
(make-local-variable 'line-move-ignore-invisible)
3452
(setq line-move-ignore-invisible t)
3453
(if (not (and (boundp 'running-xemacs) running-xemacs))
3454
(add-to-invisibility-spec '(moccur . t)))
3455
3456
(turn-on-font-lock)
3457
3458
(make-local-variable 'outline-regexp)
3459
(setq outline-regexp "\\(^Buffer: File (grep): \\)")
3460
(make-local-variable 'outline-level)
3461
(setq outline-level 'moccur-outline-level))
3462
3463
;;; grep-buffers
3464
;;(require 'compile)
3465
(defun grep-buffers ()
3466
"*Run `grep` PROGRAM to match EXPRESSION (with optional OPTIONS) \
3467
on all visited files."
3468
(interactive)
3469
(save-excursion
3470
(let* ((regexp (read-from-minibuffer "grep all-buffer : "))
3471
(buffers (moccur-filter-buffers (buffer-list)))
3472
com)
3473
(setq com (concat
3474
grep-command "\"" regexp "\" "))
3475
(while buffers
3476
(if (not (buffer-file-name (car buffers)))
3477
(setq buffers (cdr buffers))
3478
(let ((currfile (buffer-file-name (car buffers))))
3479
(setq buffers (cdr buffers))
3480
(setq com (concat
3481
com " "
3482
currfile)))))
3483
(grep com))))
3484
3485
;;; junk:search-buffers
3486
;;;; variables
3487
(defface search-buffers-face
3488
'((((class color)
3489
(background dark))
3490
(:background "SkyBlue" :bold t :foreground "Black"))
3491
(((class color)
3492
(background light))
3493
(:background "ForestGreen" :bold t))
3494
(t
3495
()))
3496
"face."
3497
:group 'color-moccur
3498
)
3499
3500
(defface search-buffers-header-face
3501
'((((class color)
3502
(background dark))
3503
(:background "gray20" :bold t :foreground "azure3"))
3504
(((class color)
3505
(background light))
3506
(:background "ForestGreen" :bold t))
3507
(t
3508
()))
3509
"face."
3510
:group 'color-moccur
3511
)
3512
3513
;;;; read minibuffer
3514
(defun search-buffers-regexp-read-from-minibuf ()
3515
(let (default input)
3516
(setq default
3517
(if (thing-at-point 'word)
3518
(thing-at-point 'word)
3519
(car regexp-history)))
3520
(setq input
3521
(read-from-minibuffer
3522
(if default
3523
(format "Search buffers regexp (default `%s'): "
3524
default)
3525
"Search buffers regexp: ")
3526
nil nil nil
3527
'regexp-history default
3528
color-moccur-default-ime-status))
3529
(if (and (equal input "") default)
3530
(setq input default))
3531
input))
3532
3533
;;;; body
3534
(defvar search-buffers-current-buffer nil)
3535
(defvar search-buffers-windows-conf nil)
3536
(defvar search-buffers-regexp-list nil)
3537
(defvar search-buffers-regexp nil)
3538
(defvar search-buffers-regexp-for-moccur nil)
3539
3540
(defun search-buffers (regexp arg)
3541
"*Search string of all buffers."
3542
(interactive (list (search-buffers-regexp-read-from-minibuf)
3543
current-prefix-arg))
3544
(setq search-buffers-current-buffer (current-buffer))
3545
(setq search-buffers-windows-conf (current-window-configuration))
3546
(save-excursion
3547
(if (get-buffer "*Search*") ; there ought to be just one of these
3548
(kill-buffer (get-buffer "*Search*")))
3549
(let* ((buffers (moccur-filter-buffers (buffer-list)))
3550
(occbuf (generate-new-buffer "*Search*"))
3551
(regexp-lst nil) str cur-lst match
3552
match-text beg end lst)
3553
3554
(setq buffers (sort buffers moccur-buffer-sort-method))
3555
3556
(set-buffer occbuf)
3557
(insert "Search " regexp "\n")
3558
3559
(setq str regexp)
3560
(setq search-buffers-regexp regexp)
3561
(setq search-buffers-regexp-list (moccur-word-split regexp t))
3562
(setq regexp-lst search-buffers-regexp-list)
3563
(search-buffers-set-regexp-for-moccur)
3564
(setq lst nil)
3565
3566
(while buffers
3567
(if (and (not arg) (not (buffer-file-name (car buffers))))
3568
(setq buffers (cdr buffers))
3569
(let ((currbuf (car buffers)))
3570
(setq cur-lst regexp-lst)
3571
(setq buffers (cdr buffers))
3572
(set-buffer currbuf)
3573
(setq match t)
3574
(setq match-text nil)
3575
(save-excursion
3576
(while (and cur-lst match)
3577
(goto-char (point-min))
3578
(setq regexp (car cur-lst))
3579
(setq cur-lst (cdr cur-lst))
3580
(if (re-search-forward regexp nil t)
3581
(progn
3582
(if (> (- (match-beginning 0) 30) 0)
3583
(setq beg (- (match-beginning 0) 30))
3584
(setq beg 1))
3585
(if (< (+ 30 (match-end 0)) (point-max))
3586
(setq end (+ 30 (match-end 0)))
3587
(setq end (point-max)))
3588
(setq match-text
3589
(cons
3590
(buffer-substring beg end)
3591
match-text)))
3592
(setq match nil))))
3593
(if match
3594
(progn
3595
(let* ((linenum (count-lines (point-min)(point)))
3596
(tag (format "\n%3d " linenum))
3597
fname)
3598
(save-excursion
3599
(set-buffer occbuf)
3600
(if (buffer-file-name currbuf)
3601
(setq fname (buffer-file-name currbuf))
3602
(setq fname "Not file"))
3603
(insert (concat "Buffer: " (buffer-name currbuf)
3604
" File: " fname "\n"))
3605
(while match-text
3606
(insert (car match-text))
3607
(setq match-text (cdr match-text))
3608
(insert " ... \n"))
3609
(goto-char (point-max))
3610
(insert "\n\n"))))))))
3611
(switch-to-buffer occbuf)
3612
(goto-char (point-min))
3613
(search-buffers-color regexp-lst)
3614
(setq buffer-read-only t)
3615
(search-buffers-view-mode 1)
3616
(search-buffers-next))))
3617
3618
;;;; mode
3619
(defvar search-buffers-view-mode nil
3620
"*Non-nil means in an search-buffers-view-mode.")
3621
(make-variable-buffer-local 'search-buffers-view-mode)
3622
(defvar search-buffers-view-mode-map nil "")
3623
3624
(setq search-buffers-view-mode-map nil)
3625
3626
(or search-buffers-view-mode-map
3627
(let ((map (make-sparse-keymap)))
3628
(define-key map " "
3629
(function search-buffers-scroll-up))
3630
(define-key map "b"
3631
(function search-buffers-scroll-down))
3632
(define-key map "q"
3633
(function search-buffers-exit))
3634
(define-key map "\C-m"
3635
(function search-buffers-call-moccur))
3636
;;(function search-buffers-goto))
3637
(define-key map "p"
3638
(function search-buffers-prev))
3639
(define-key map "n"
3640
(function search-buffers-next))
3641
(define-key map "k"
3642
(function search-buffers-prev))
3643
(define-key map "j"
3644
(function search-buffers-next))
3645
(define-key map '[up]
3646
(function search-buffers-prev))
3647
(define-key map '[down]
3648
(function search-buffers-next))
3649
(setq search-buffers-view-mode-map map)))
3650
3651
(when (boundp 'minor-mode-map-alist)
3652
(or (assq 'search-buffers-view-mode-map minor-mode-map-alist)
3653
(setq minor-mode-map-alist
3654
(cons (cons 'search-buffers-view-mode
3655
search-buffers-view-mode-map)
3656
minor-mode-map-alist))))
3657
3658
(defun search-buffers-view-mode (&optional arg)
3659
(interactive "P")
3660
(setq search-buffers-view-mode
3661
(if (null arg)
3662
(not search-buffers-view-mode)
3663
(> (prefix-numeric-value arg) 0))))
3664
3665
;;;; function of mode
3666
(defun search-buffers-exit ()
3667
(interactive)
3668
(kill-buffer (get-buffer "*Search*"))
3669
(switch-to-buffer search-buffers-current-buffer)
3670
(set-window-configuration search-buffers-windows-conf))
3671
3672
(defun search-buffers-set-regexp-for-moccur ()
3673
"Make regexp for coloring up."
3674
(let ((list (cdr search-buffers-regexp-list)))
3675
(if moccur-split-word
3676
(progn
3677
(setq search-buffers-regexp-for-moccur
3678
(concat
3679
"\\(" (car search-buffers-regexp-list)))
3680
(while list
3681
(setq search-buffers-regexp-for-moccur
3682
(concat search-buffers-regexp-for-moccur
3683
"\\|"
3684
(car list)))
3685
(setq list (cdr list)))
3686
(setq search-buffers-regexp-for-moccur
3687
(concat search-buffers-regexp-for-moccur "\\)")))
3688
(setq search-buffers-regexp-for-moccur
3689
(car search-buffers-regexp-list)))))
3690
3691
(defun search-buffers-call-moccur ()
3692
(interactive)
3693
(let (bufname
3694
(windows-conf (current-window-configuration))
3695
(pos (point)))
3696
(save-excursion
3697
(end-of-line)
3698
(if (re-search-backward moccur-buffer-heading-regexp nil t)
3699
(setq bufname (buffer-substring
3700
(match-beginning 1)
3701
(match-end 1)))
3702
(if (re-search-forward moccur-buffer-heading-regexp nil t)
3703
(setq bufname (buffer-substring
3704
(match-beginning 1)
3705
(match-end 1))))))
3706
(switch-to-buffer (get-buffer bufname))
3707
(occur-by-moccur search-buffers-regexp-for-moccur t)
3708
(set-buffer (get-buffer bufname))
3709
(setq moccur-current-buffer (get-buffer "*Search*"))
3710
(setq moccur-windows-conf windows-conf)))
3711
3712
(defun search-buffers-goto ()
3713
(interactive)
3714
(let (bufname)
3715
(save-excursion
3716
(beginning-of-line)
3717
(if (re-search-forward moccur-buffer-heading-regexp nil t)
3718
(setq bufname (buffer-substring
3719
(match-beginning 1)
3720
(match-end 1)))
3721
(if (re-search-backward moccur-buffer-heading-regexp nil t)
3722
(setq bufname (buffer-substring
3723
(match-beginning 1)
3724
(match-end 1)))))
3725
(switch-to-buffer (get-buffer bufname))
3726
(delete-other-windows))))
3727
3728
(defun search-buffers-next ()
3729
(interactive)
3730
(let (bufname)
3731
(end-of-line)
3732
(if (re-search-forward moccur-buffer-heading-regexp nil t)
3733
(progn
3734
(switch-to-buffer-other-window
3735
(get-buffer (buffer-substring-no-properties
3736
(match-beginning 1) (match-end 1))))
3737
(switch-to-buffer-other-window (get-buffer "*Search*"))
3738
(beginning-of-line)))
3739
(recenter)))
3740
3741
(defun search-buffers-prev ()
3742
(interactive)
3743
(let (bufname)
3744
(beginning-of-line)
3745
(if (re-search-backward moccur-buffer-heading-regexp nil t)
3746
(progn
3747
(switch-to-buffer-other-window
3748
(get-buffer (buffer-substring-no-properties
3749
(match-beginning 1) (match-end 1))))
3750
(switch-to-buffer-other-window (get-buffer "*Search*"))
3751
(beginning-of-line)))))
3752
3753
(defun search-buffers-scroll-up ()
3754
(interactive)
3755
(let (bufname)
3756
(scroll-up)
3757
(end-of-line)
3758
(if (re-search-forward moccur-buffer-heading-regexp nil t)
3759
(progn
3760
(switch-to-buffer-other-window
3761
(get-buffer (buffer-substring-no-properties
3762
(match-beginning 1) (match-end 1))))
3763
(switch-to-buffer-other-window (get-buffer "*Search*"))
3764
(beginning-of-line)))))
3765
3766
(defun search-buffers-scroll-down ()
3767
(interactive)
3768
(let (bufname)
3769
(scroll-down)
3770
(beginning-of-line)
3771
(if (re-search-backward moccur-buffer-heading-regexp nil t)
3772
(progn
3773
(switch-to-buffer-other-window
3774
(get-buffer (buffer-substring-no-properties
3775
(match-beginning 1) (match-end 1))))
3776
(switch-to-buffer-other-window (get-buffer "*Search*"))
3777
(beginning-of-line)))))
3778
3779
;;; color
3780
(defun search-buffers-color (regexp-lst)
3781
(save-excursion
3782
(let (ov lst)
3783
(setq lst regexp-lst)
3784
(while lst
3785
(goto-char (point-min))
3786
(while (re-search-forward
3787
(car lst) nil t)
3788
(progn
3789
(setq ov (make-overlay (match-beginning 0)
3790
(match-end 0)))
3791
(overlay-put ov 'face 'search-buffers-face)
3792
(overlay-put ov 'priority 0)))
3793
(setq lst (cdr lst)))
3794
3795
(goto-char (point-min))
3796
(while (re-search-forward
3797
"^Buffer: " nil t)
3798
(progn
3799
(setq ov (make-overlay (match-beginning 0)
3800
(line-end-position)))
3801
(overlay-put ov 'face 'search-buffers-header-face)
3802
(overlay-put ov 'priority 0))))))
3803
3804
(provide 'color-moccur)
3805
;;; end
3806
;;; color-moccur.el ends here
3807
3808