1 ;;; ioccur.el --- Incremental occur
3 ;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
5 ;; Author: Thierry Volpiatto <thierry dot volpiatto at gmail dot com>
6 ;; X-URL: http://mercurial.intuxication.org/hg/ioccur
8 ;; Compatibility: GNU Emacs >=22.3
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 3, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
25 ;; Add this file to your `load-path', BYTE-COMPILE it and
26 ;; add (require 'ioccur) in your .emacs.
28 ;; Start with (C-u) M-x ioccur
30 ;; (C-u) M-x ioccur-find-buffer-matching
32 ;; Do C-h f ioccur or ioccur-find-buffer-matching for more info.
36 ;; This package provides the command M-x ioccur, which is similar to
37 ;; M-x occur, except that it is incremental.
39 ;; You can jump and quit to an occurrence, or jump and save the search
40 ;; buffer (ioccur-buffer) for further use. You can toggle literal and
41 ;; regexp searching while running. It is auto documented both in
42 ;; mode-line and tooltip. It has its own history, `ioccur-history',
43 ;; which is a real ring.
45 ;; To save `ioccur-history' via the Desktop package, add this to your
46 ;; init file (see (info "(emacs) Saving Emacs Sessions") for details):
48 ;; (add-to-list 'desktop-globals-to-save 'ioccur-history)
52 (eval-when-compile (require 'cl))
54 (eval-when-compile (require 'wdired))
56 (defvar ioccur-mode-map
57 (let ((map (make-sparse-keymap)))
58 (define-key map (kbd "q") 'ioccur-quit)
59 (define-key map (kbd "RET") 'ioccur-jump-and-quit)
60 (define-key map (kbd "<left>") 'ioccur-jump-and-quit)
61 (define-key map (kbd "<right>") 'ioccur-jump-without-quit)
62 (define-key map (kbd "C-z") 'ioccur-jump-without-quit)
63 (define-key map (kbd "<C-down>") 'ioccur-scroll-down)
64 (define-key map (kbd "<C-up>") 'ioccur-scroll-up)
65 (define-key map (kbd "C-v") 'ioccur-scroll-other-window-up)
66 (define-key map (kbd "M-v") 'ioccur-scroll-other-window-down)
67 (define-key map (kbd "<down>") 'ioccur-next-line)
68 (define-key map (kbd "<up>") 'ioccur-precedent-line)
69 (define-key map (kbd "C-n") 'ioccur-next-line)
70 (define-key map (kbd "C-p") 'ioccur-precedent-line)
71 (define-key map (kbd "R") 'ioccur-restart)
72 (define-key map (kbd "C-|") 'ioccur-split-window)
73 (define-key map (kbd "M-<") 'ioccur-beginning-of-buffer)
74 (define-key map (kbd "M->") 'ioccur-end-of-buffer)
76 "Keymap used for ioccur commands.")
80 "Mode that provide incremental searching in buffer."
85 (defcustom ioccur-search-delay 0.5
86 "During incremental searching, display is updated all these seconds."
90 (defcustom ioccur-search-prompt "Pattern: "
91 "Prompt used for `ioccur-occur'."
95 (defcustom ioccur-mode-line-string
97 " RET:Exit,C-g:Quit,C-j/left:Jump&quit,C-z/right:Jump,\
98 C-k/x:Kill(as sexp),M-p/n:Hist,C/M-v:Scroll,C-down/up:Follow,C-w:Yank tap"
100 " RET:Exit,C-g:Quit,C-j:Jump&quit,C-z:Jump,C-k/x:Kill(as sexp),\
101 S-/Tab:Hist,C-v/t:Scroll,C-d/u:Follow,C-w:Yank tap")
103 "Minimal documentation of `ioccur' commands displayed in mode-line.
104 Set it to nil to remove doc in mode-line."
108 (defcustom ioccur-length-line 80
109 "Length of the line displayed in ioccur buffer.
110 When set to nil lines displayed in `ioccur-buffer' will not be modified.
111 See `ioccur-truncate-line'."
115 (defcustom ioccur-max-length-history 100
116 "Maximum number of element stored in `ioccur-history'."
120 (defcustom ioccur-buffer-completion-use-ido nil
121 "Use ido to choose buffers in `ioccur-find-buffer-matching'."
125 (defcustom ioccur-default-search-function 're-search-forward
126 "Default search function.
127 Use here one of `re-search-forward' or `search-forward'."
131 (defcustom ioccur-highlight-match-p t
132 "Highlight matchs in `ioccur-buffer' when non--nil."
136 (defcustom ioccur-fontify-buffer-p nil
137 "Fontify `ioccur-current-buffer' when non--nil.
138 This allow to have syntactic coloration in `ioccur-buffer' but
139 it slow down the start of ioccur at first time on large buffers."
143 (defvar ioccur-read-char-or-event-skip-read-key nil
144 "Force not using `read-key' to read input in minibuffer even if bounded.
145 Set it to non--nil if menu disapear or if keys are echoing in minibuffer.")
148 (defface ioccur-overlay-face
149 '((t (:background "Green4" :underline t)))
150 "Face for highlight line in ioccur buffer."
151 :group 'ioccur-faces)
153 (defface ioccur-match-overlay-face
154 '((t (:background "Indianred4" :underline t)))
155 "Face for highlight line in matched buffer."
156 :group 'ioccur-faces)
158 (defface ioccur-title-face
159 '((t (:background "Dodgerblue4")))
160 "Face for highlight incremental buffer title."
161 :group 'ioccur-faces)
163 (defface ioccur-regexp-face
164 '((t (:background "DeepSkyBlue" :underline t)))
165 "Face for highlight found regexp in `ioccur-buffer'."
166 :group 'ioccur-faces)
168 (defface ioccur-match-face
169 '((t (:background "DeepSkyBlue")))
170 "Face for highlight matches in `ioccur-buffer'."
171 :group 'ioccur-faces)
173 (defface ioccur-num-line-face
174 '((t (:foreground "OrangeRed")))
175 "Face for highlight number line in ioccur buffer."
176 :group 'ioccur-faces)
178 (defface ioccur-invalid-regexp
179 '((t (:foreground "Goldenrod")))
180 "Face for highlight wrong regexp message in ioccur buffer."
181 :group 'ioccur-faces)
183 (defface ioccur-cursor
184 '((t (:foreground "green")))
185 "Face for cursor color in minibuffer."
186 :group 'ioccur-faces)
188 ;;; Internal variables.
189 ;; String entered in prompt.
190 (defvar ioccur-pattern "")
192 (defvar ioccur-search-timer nil)
194 (defvar ioccur-quit-flag nil)
195 ;; The buffer we search in.
196 (defvar ioccur-current-buffer nil)
197 ;; The overlay in `ioccur-buffer'.
198 (defvar ioccur-occur-overlay nil)
199 (make-variable-buffer-local 'ioccur-occur-overlay)
200 ;; Signal we quit and kill `ioccur-buffer'.
201 (defvar ioccur-exit-and-quit-p nil)
202 ;; A list to store history.
203 (defvar ioccur-history nil)
204 ;; The overlay in `ioccur-current-buffer'.
205 (defvar ioccur-match-overlay nil)
206 ;; Number of occurences found.
207 (defvar ioccur-count-occurences 0)
208 ;;The buffer where we send results.
209 (defvar ioccur-buffer nil)
210 (make-variable-buffer-local 'ioccur-buffer)
211 ;; True when jumping to a founded occurence.
212 (defvar ioccur-success nil)
213 ;; Search function actually in use.
214 (defvar ioccur-search-function ioccur-default-search-function)
215 ;; Message to send when ioccur exit
216 (defvar ioccur-message nil)
217 ;; Store last window-configuration
218 (defvar ioccur-last-window-configuration nil)
221 (define-derived-mode ioccur-mode
223 "Major mode to search occurences of regexp in current buffer.
227 (if ioccur-mode-line-string
228 (setq mode-line-format
229 '(" " mode-line-buffer-identification " "
230 (line-number-mode "%l") " "
231 ioccur-mode-line-string "-%-"))
232 (kill-local-variable 'mode-line-format)))
234 (defsubst* ioccur-position (item seq &key (test 'eq))
235 "A simple replacement of CL `position'."
236 (loop for i in seq for index from 0
237 when (funcall test i item) return index))
240 (unless (fboundp 'window-system)
241 (defun window-system (&optional arg)
245 (defmacro ioccur-iter-list (list-obj)
246 "Return an iterator from list LIST-OBJ."
247 `(lexical-let ((lis ,list-obj))
249 (let ((elm (car lis)))
253 (defun ioccur-iter-next (iterator)
254 "Return next elm of ITERATOR."
257 (defun ioccur-iter-circular (seq)
258 "Infinite iteration on SEQ."
259 (lexical-let ((it (ioccur-iter-list seq))
262 (let ((elm (ioccur-iter-next it)))
264 (progn (setq it (ioccur-iter-list lis))
265 (ioccur-iter-next it)))))))
267 (defun ioccur-butlast (seq pos)
268 "Return SEQ from index 0 to POS."
269 (butlast seq (- (length seq) pos)))
271 (defun* ioccur-sub-prec-circular (seq elm &key (test 'eq))
272 "Infinite reverse iteration of SEQ starting at ELM."
273 (lexical-let* ((rev-seq (reverse seq))
274 (pos (ioccur-position elm rev-seq :test test))
275 (sub (append (nthcdr (1+ pos) rev-seq)
276 (ioccur-butlast rev-seq pos)))
277 (iterator (ioccur-iter-list sub)))
279 (let ((elm (ioccur-iter-next iterator)))
281 (progn (setq iterator (ioccur-iter-list sub))
282 (ioccur-iter-next iterator)))))))
284 (defun* ioccur-sub-next-circular (seq elm &key (test 'eq))
285 "Infinite iteration of SEQ starting at ELM."
286 (lexical-let* ((pos (ioccur-position elm seq :test test))
287 (sub (append (nthcdr (1+ pos) seq)
288 (ioccur-butlast seq pos)))
289 (iterator (ioccur-iter-list sub)))
291 (let ((elm (ioccur-iter-next iterator)))
293 (setq iterator (ioccur-iter-list sub))
294 (ioccur-iter-next iterator)))))))
296 (defun ioccur-print-results (regexp)
297 "Print in `ioccur-buffer' lines matching REGEXP in `ioccur-current-buffer'."
298 (setq ioccur-count-occurences 0)
299 (with-current-buffer ioccur-current-buffer
301 (goto-char (point-min))
304 ;; We need to read also C-g from here
305 ;; Because when loop is started `ioccur-read-search-input'
306 ;; will read key only when loop is finished
307 ;; and we have no chance to exit loop.
308 when quit-flag do (setq ioccur-quit-flag t) and return nil
310 when (funcall ioccur-search-function regexp (point-at-eol) t)
311 do (ioccur-print-line
312 (buffer-substring (point-at-bol) (point-at-eol))
313 count (match-string 0) regexp)
314 do (forward-line 1)))))
317 (defun ioccur-print-match (str &optional all)
318 "Highlight in string STR all occurences matching `ioccur-pattern'.
319 If ALL is non--nil highlight the whole string STR."
323 (goto-char (point-min))
326 (point) (point-at-eol)
327 '(face ioccur-match-face))
328 (while (and (funcall ioccur-search-function ioccur-pattern nil t)
329 ;; Don't try to highlight line with a length <= 0.
330 (> (- (match-end 0) (match-beginning 0)) 0))
332 (match-beginning 0) (match-end 0)
333 '(face ioccur-match-face))))
337 (defun ioccur-print-line (line nline match regexp)
338 "Prepare and insert a matched LINE at line number NLINE in `ioccur-buffer'."
339 (with-current-buffer ioccur-buffer
340 (let* ((lineno (int-to-string (1+ nline)))
341 (whole-line-matched (string= match line))
342 (hightline (if ioccur-highlight-match-p
347 (trunc-line (ioccur-truncate-line hightline)))
348 (incf ioccur-count-occurences)
349 (insert " " (propertize lineno 'face 'ioccur-num-line-face
351 ":" trunc-line "\n"))))
353 (defun* ioccur-truncate-line (line &optional (columns ioccur-length-line))
354 "Remove indentation in LINE and truncate modified LINE of num COLUMNS.
355 COLUMNS default value is `ioccur-length-line'.
356 If COLUMNS is nil return original indented LINE.
357 If COLUMNS is 0 only remove indentation in LINE.
358 So just set `ioccur-length-line' to nil if you don't want lines truncated."
359 (let ((old-line line))
360 (when (string-match "^[[:blank:]]*" line)
361 ;; Remove tab and spaces at beginning of LINE.
362 (setq line (replace-match "" nil nil line)))
363 (if (and columns (> columns 0) (> (length line) columns))
364 (substring line 0 columns)
365 (if columns line old-line))))
367 (defun ioccur-buffer-contain (buffer regexp)
368 "Return BUFFER if it contain an occurence of REGEXP."
369 (with-current-buffer buffer
371 (goto-char (point-min))
372 (when (re-search-forward regexp nil t) buffer))))
374 (defun ioccur-list-buffers-matching (buffer-match regexp buffer-list)
375 "Collect all buffers in BUFFER-LIST whose names match BUFFER-MATCH and \
376 contain lines matching REGEXP."
378 with ini-buf-list = (loop for buf in buffer-list
379 unless (rassq buf dired-buffers)
381 for buf in ini-buf-list
382 for bname = (buffer-name buf)
383 when (and (string-match buffer-match bname)
384 (ioccur-buffer-contain buf regexp))
387 (defun ioccur-list-buffers-containing (regexp buffer-list)
388 "Collect all buffers in BUFFER-LIST containing lines matching REGEXP."
389 (loop with buf-list = (loop for i in buffer-list
390 when (buffer-file-name (get-buffer i))
393 when (ioccur-buffer-contain buf regexp)
394 collect (buffer-name buf)))
396 (defun* ioccur-find-buffer-matching1 (regexp
399 (buffer-list (buffer-list)))
400 "Find all buffers containing a text matching REGEXP \
401 and connect `ioccur' to the selected one.
403 If MATCH-BUF-NAME is non--nil search is performed only in buffers
404 with name matching specified expression (prompt).
406 Hitting C-g in a `ioccur' session will return to completion list.
407 Hitting C-g in the completion list will jump back to initial buffer.
409 The buffer completion list is provided by one of:
410 `ido-completing-read', `completing-read'
411 depending on which `ioccur-buffer-completion-use-ido' you have choosen."
412 ;; Remove doublons maybe added by minibuffer in `ioccur-history'.
414 (loop with hist for i in ioccur-history
415 when (not (member i hist)) collect i into hist
416 finally return hist))
418 (let ((prompt (format "Search (%s) in Buffer: " regexp))
419 (win-conf (current-window-configuration))
420 (buf-list (if match-buf-name
421 (ioccur-list-buffers-matching
422 (read-string "In Buffer names matching: ")
424 (ioccur-list-buffers-containing regexp buffer-list))))
428 (let ((buf (if (and ido-mode
429 (eq ioccur-buffer-completion-use-ido 'ido))
430 (ido-completing-read prompt buf-list nil t)
431 (completing-read prompt buf-list nil t))))
434 (switch-to-buffer buf)
436 ;; Exit if we jump to this `ioccur-current-buffer',
437 ;; otherwise, if C-g is hitten,
438 ;; go back to buffer completion list.
439 (unless ioccur-success
441 ;; C-g hit in buffer completion restore window config.
442 (unless ioccur-success
443 (set-window-configuration win-conf))))))
448 (defun ioccur-find-buffer-matching (regexp)
449 "Find all buffers containing a text matching REGEXP.
450 See `ioccur-find-buffer-matching1'."
451 (interactive (list (let ((savehist-save-minibuffer-history nil))
452 (read-from-minibuffer "Search for Pattern: "
453 nil nil nil '(ioccur-history . 0)
454 (thing-at-point 'symbol)))))
455 (ioccur-find-buffer-matching1 regexp current-prefix-arg))
459 (defun ioccur-dired (regexp)
460 (interactive (list (let ((savehist-save-minibuffer-history nil))
461 (read-from-minibuffer "Search for Pattern: "
462 nil nil nil '(ioccur-history . 0)
463 (thing-at-point 'symbol)))))
464 (let ((buf-list (loop for f in (dired-get-marked-files)
465 do (find-file-noselect f)
466 unless (file-directory-p f)
467 collect (get-buffer (file-name-nondirectory f)))))
468 (ioccur-find-buffer-matching1 regexp nil buf-list)))
471 (defun ioccur-restart ()
472 "Restart `ioccur' from `ioccur-buffer'.
473 `ioccur-buffer' is erased and a new search is started."
475 (when (eq major-mode 'ioccur-mode)
476 (pop-to-buffer ioccur-current-buffer)
477 (kill-buffer ioccur-buffer)
478 (set-window-configuration ioccur-last-window-configuration)
482 (defun ioccur-quit ()
483 "Quit `ioccur-buffer'."
485 (let ((pos (with-current-buffer ioccur-current-buffer (point))))
486 (when ioccur-match-overlay
487 (delete-overlay ioccur-match-overlay))
489 (set-window-configuration ioccur-last-window-configuration)
490 (pop-to-buffer ioccur-current-buffer)
493 (defun ioccur-goto-line (lineno)
494 "Goto LINENO without modifying outline visibility if needed."
495 (flet ((gotoline (numline)
496 (goto-char (point-min)) (forward-line (1- numline))))
497 (if (or (eq major-mode 'org-mode)
504 (defun ioccur-forward-line (n)
505 "Forward N lines but empty one's."
508 (forward-line n) (forward-line 0)
509 (when (looking-at "^\\s-[0-9]+:")
510 (forward-line 0) (setq pos (point))))
511 (when pos (goto-char pos) (ioccur-color-current-line))))
514 (defun ioccur-next-line ()
515 "Goto next line if it is not an empty line."
517 (ioccur-forward-line 1))
520 (defun ioccur-precedent-line ()
521 "Goto precedent line if it is not an empty line."
523 (ioccur-forward-line -1))
526 (defun ioccur-beginning-of-buffer ()
527 "Goto beginning of `ioccur-buffer'."
529 (when (looking-at "^\\s-[0-9]+:")
530 (goto-char (point-min))
531 (re-search-forward "^\\s-[0-9]+:" nil t)
533 (ioccur-color-current-line)))
536 (defun ioccur-end-of-buffer ()
537 "Go to end of `ioccur-buffer'."
539 (when (looking-at "^\\s-[0-9]+:")
540 (goto-char (point-max))
542 (ioccur-color-current-line)))
544 (defun ioccur-jump (&optional win-conf)
545 "Jump to line in other buffer and put an overlay on it.
546 Move point to first occurence of `ioccur-pattern'."
547 (let* ((line (buffer-substring (point-at-bol) (point-at-eol)))
548 (pos (string-to-number line))
549 (back-search-fn (if (eq ioccur-search-function 're-search-forward)
550 're-search-backward 'search-backward)))
551 (unless (string= line "")
553 (set-window-configuration win-conf)
554 (pop-to-buffer ioccur-current-buffer))
555 (ioccur-goto-line pos)
557 ;; Go to beginning of first occurence in this line
558 ;; of what match `ioccur-pattern'.
559 (when (funcall ioccur-search-function
560 ioccur-pattern (point-at-eol) t)
561 (goto-char (match-beginning 0)))
562 (ioccur-color-matched-line))))
565 (defun ioccur-jump-and-quit ()
566 "Jump to line in other buffer and quit search buffer."
568 (when (ioccur-jump ioccur-last-window-configuration)
570 (when ioccur-match-overlay
571 (delete-overlay ioccur-match-overlay))))
574 (defun ioccur-jump-without-quit (&optional mark)
575 "Jump to line in `ioccur-current-buffer' without quitting."
577 (when (ioccur-jump ioccur-last-window-configuration)
578 (and mark (set-marker (mark-marker) (point))
579 (push-mark (point) 'nomsg))
580 (switch-to-buffer-other-window ioccur-buffer t)))
583 (defun ioccur-scroll-other-window-down ()
584 "Scroll other window down."
586 (let ((other-window-scroll-buffer ioccur-current-buffer))
587 (scroll-other-window 1)))
590 (defun ioccur-scroll-other-window-up ()
591 "Scroll other window up."
593 (let ((other-window-scroll-buffer ioccur-current-buffer))
594 (scroll-other-window -1)))
596 (defun ioccur-scroll (n)
597 "Scroll `ioccur-buffer' and `ioccur-current-buffer' simultaneously."
598 (ioccur-forward-line n)
599 (ioccur-color-current-line)
600 (and (ioccur-jump ioccur-last-window-configuration)
601 (switch-to-buffer-other-window ioccur-buffer t)))
604 (defun ioccur-scroll-down ()
605 "Scroll down `ioccur-buffer' and `ioccur-current-buffer' simultaneously."
610 (defun ioccur-scroll-up ()
611 "Scroll up `ioccur-buffer' and `ioccur-current-buffer' simultaneously."
616 (defun ioccur-split-window ()
617 "Toggle split window, vertically or horizontally."
619 (with-current-buffer ioccur-current-buffer
620 (let ((old-size (window-height)))
623 (select-window (if (= (window-height) old-size)
624 (split-window-vertically)
625 (split-window-horizontally)))
626 (get-buffer ioccur-buffer)))))
628 (defun ioccur-read-char-or-event (prompt)
629 "Replace `read-key' when not available using PROMPT."
630 (if (and (fboundp 'read-key)
631 (not ioccur-read-char-or-event-skip-read-key))
633 (let* ((chr (condition-case nil (read-char prompt) (error nil)))
634 (evt (unless chr (read-event prompt))))
637 (defun ioccur-read-search-input (initial-input start-point)
638 "Read each keyboard input and add it to `ioccur-pattern'.
639 INITIAL-INPUT is a string given as default input, generally thing at point.
640 START-POINT is the point where we start searching in buffer."
641 (let* ((prompt (propertize ioccur-search-prompt
642 'face 'minibuffer-prompt))
643 (inhibit-quit (or (eq system-type 'windows-nt)
644 (not (fboundp 'read-key))
645 ioccur-read-char-or-event-skip-read-key))
649 (cur-hist-elm (car ioccur-history))
650 (start-hist nil) ; Flag to notify if cycling history started.
653 (unless (string= initial-input "")
654 (loop for char across initial-input do (push char tmp-list)))
655 (setq ioccur-pattern initial-input)
656 ;; Cycle history function.
658 (flet ((cycle-hist (arg)
659 ;; ARG can be positive or negative depending we call M-p or M-n.
662 ;; Cycle history will start at second call,
663 ;; at first call just use the car of hist ring.
664 ;; We build a new iterator based on a sublist
665 ;; starting at the current element of history.
666 ;; This is a circular iterator. (no end)
667 (if start-hist ; At first call, start-hist is nil.
670 ;; M-p (move from left to right in hist ring).
671 (unless it-prec ; Don't rebuild iterator if exists.
672 (setq it-prec (ioccur-sub-next-circular
674 cur-hist-elm :test 'equal))
675 (setq it-next nil)) ; Kill forward iterator.
676 ;; M-n (move from right to left in hist ring).
677 (unless it-next ; Don't rebuild iterator if exists.
678 (setq it-next (ioccur-sub-prec-circular
680 cur-hist-elm :test 'equal))
681 (setq it-prec nil))) ; kill backward iterator.
682 (let ((it (or it-prec it-next)))
683 (setq cur-hist-elm (ioccur-iter-next it))
685 (loop for char across cur-hist-elm
686 do (push char tmp-list))
687 (setq ioccur-pattern cur-hist-elm)))
688 ;; First call use car of history ring.
690 (loop for char across cur-hist-elm
691 do (push char tmp-list))
692 (setq ioccur-pattern cur-hist-elm)
693 (setq start-hist t)))
694 (message "No history available.") (sit-for 2) t))
695 ;; Insert INITIAL-INPUT.
697 (insert-initial-input ()
698 (unless (string= initial-input "")
699 (loop for char across initial-input
700 do (push char (nthcdr index tmp-list)))))
701 ;; Maybe start timer.
704 (unless ioccur-search-timer
705 (ioccur-start-timer)))
709 (when ioccur-search-timer
710 (ioccur-cancel-search)))
714 (with-current-buffer ioccur-current-buffer
715 (goto-char start-point)
716 (setq yank-point start-point))
717 (kill-new (substring str (- (length tmp-list) index)))
718 (setq tmp-list (nthcdr index tmp-list)))
719 ;; Add cursor in minibuffer
721 (set-cursor (str pos)
722 (setq pos (min index (1- (length tmp-list))))
723 (when (not (string= str ""))
724 (let* ((real-index (- (1- (length tmp-list)) pos))
725 (cur-str (substring str real-index (1+ real-index))))
726 (concat (substring str 0 real-index)
727 (propertize cur-str 'display
728 (if (= index (length tmp-list))
730 (propertize "|" 'face 'ioccur-cursor)
734 (propertize "|" 'face 'ioccur-cursor))))
735 (substring str (1+ real-index)))))))
737 ;; Start incremental loop.
738 (while (let ((char (ioccur-read-char-or-event
739 (concat prompt (set-cursor ioccur-pattern index)))))
742 ((not (?\M-p ?\M-n ?\t C-tab)) ; Reset history
743 (setq start-hist nil)
744 (setq cur-hist-elm (car ioccur-history)) t)
745 ((down ?\C-n) ; Next line.
746 (stop-timer) (ioccur-next-line)
747 (ioccur-color-current-line) t)
748 ((up ?\C-p) ; Precedent line.
749 (stop-timer) (ioccur-precedent-line)
750 (ioccur-color-current-line) t)
751 (?\M-< ; Beginning of buffer.
752 (when (ioccur-beginning-of-buffer)
754 (?\M-> ; End of buffer.
755 (when (ioccur-end-of-buffer)
757 ((?\C-d C-down) ; Scroll both windows down.
758 (stop-timer) (ioccur-scroll-down) t)
759 ((?\C-u C-up) ; Scroll both windows up.
760 (stop-timer) (ioccur-scroll-up) t)
761 (?\r ; RET break and exit code.
763 (?\d ; Delete backward with DEL.
765 (with-current-buffer ioccur-current-buffer
766 (goto-char start-point)
767 (setq yank-point start-point))
768 (with-no-warnings (pop (nthcdr index tmp-list)))
770 (?\C-g ; Quit and restore buffers.
771 (setq ioccur-quit-flag t) nil)
772 ((right ?\C-z) ; Persistent action.
773 (ioccur-jump-without-quit) t)
774 ((?\C- ) ; Persistent action save mark.
775 (ioccur-jump-without-quit t) t)
776 ((left ?\C-j) ; Jump and kill search buffer.
777 (setq ioccur-exit-and-quit-p t) nil)
778 ((next ?\C-v) ; Scroll down.
779 (ioccur-scroll-other-window-down) t)
780 ((?\C-t ?\M-v prior) ; Scroll up.
781 (ioccur-scroll-other-window-up) t)
782 (?\C-s ; Toggle split window.
783 (ioccur-split-window) t)
784 ((?\C-: ?\C-l) ; Toggle regexp/litteral search.
786 (if (eq ioccur-search-function 're-search-forward)
787 (setq ioccur-search-function 'search-forward)
788 (setq ioccur-search-function 're-search-forward)) t)
791 (kill ioccur-pattern) (setq index 0) t)
792 ((?\M-k ?\C-x) ; Kill input as sexp.
794 (let ((sexp (prin1-to-string ioccur-pattern)))
796 (setq ioccur-quit-flag t)
797 (setq ioccur-message (format "Killed: %s" sexp)))
799 (?\C-y ; Yank from `kill-ring'.
800 (setq initial-input (car kill-ring))
801 (insert-initial-input) t)
802 (?\C-w ; Yank stuff at point.
804 (with-current-buffer ioccur-current-buffer
805 ;; Start to initial point if C-w have never been hit.
806 (unless yank-point (setq yank-point start-point))
807 ;; After a search `ioccur-print-results' have put point
808 ;; to point-max, so reset position.
809 (when yank-point (goto-char yank-point))
810 (let ((pmax (point-at-eol))
811 (eoword (save-excursion (forward-word 1) (point))))
812 ;; Don't yank further than eol.
813 (unless (> eoword pmax)
815 (setq initial-input (buffer-substring-no-properties
817 (setq yank-point (point)) ; End of last forward-word
818 (insert-initial-input)))) t)
819 ((?\t ?\M-p) ; Precedent history elm.
823 ((backtab ?\M-n) ; Next history elm.
827 (?\C-q ; quoted-insert.
829 (let ((char (with-temp-buffer
830 (call-interactively 'quoted-insert)
832 (push (string-to-char char) tmp-list))
835 ;; Movements in minibuffer
836 (?\C-b ; backward-char.
837 (setq index (min (1+ index) (length tmp-list))) t)
838 (?\C-f ; forward-char.
839 (setq index (max (1- index) 0)) t)
841 (setq index (length tmp-list)) t)
844 (t ; Store character.
846 (if (characterp char)
847 (push char (nthcdr index tmp-list))
848 (setq unread-command-events
849 (nconc (mapcar 'identity
850 (this-single-command-raw-keys))
851 unread-command-events))
853 (setq ioccur-pattern (apply 'string (reverse tmp-list)))))))
855 (defun ioccur-print-buffer (regexp)
856 "Pretty Print results matching REGEXP in `ioccur-buffer'."
857 (unless (window-system) (setq tooltip-use-echo-area t) (tooltip-mode 1))
858 (let* ((cur-method (if (eq ioccur-search-function 're-search-forward)
862 "* Ioccur %s searching %s"
865 "* (`C-:' to Toggle Method, Mouse over for help.)"
866 "* (`C-l' to Toggle Method.)"))
867 'face 'ioccur-title-face
870 C-n or <down> Next line.\n
871 C-p or <up> Precedent line.\n
872 C-v and M-v/C-t Scroll up and down.\n
873 C-z or <right> Jump without quitting loop.\n
874 C-TAB Jump without quitting and save to mark-ring.\n
875 C-j or <left> Jump and kill `ioccur-buffer'.\n
876 RET Exit keeping `ioccur-buffer'.\n
877 DEL Remove last character entered.\n
878 C-k Kill current input.\n
879 C-a/e/b/f Movements in minibuffer.\n
880 M-k/C-x Kill current input as sexp.\n
881 C-w Yank stuff at point.\n
882 C-g Quit and restore buffer.\n
883 C-s Toggle split window.\n
884 C-:/l Toggle regexp/litteral search.\n
885 C-down or C-u Follow in other buffer.\n
886 C-up/d or C-d Follow in other buffer.\n
887 M-<, M-> Beginning and end of buffer.\n
888 M-p/n or tab/S-tab History."))
890 (if (string= regexp "")
891 (progn (erase-buffer) (insert title "\n\n"))
894 (ioccur-print-results regexp)
895 (error (setq wrong-regexp t)))
896 (goto-char (point-min))
900 (propertize "Invalid Regexp: "
901 'face 'ioccur-invalid-regexp)
902 (format "No match for `%s'" regexp) "\n\n")
904 (propertize (format "Found %s occurences matching "
905 ioccur-count-occurences)
907 (propertize regexp 'face 'ioccur-regexp-face)
909 (format " in %s" ioccur-current-buffer)
910 'face 'underline) "\n\n")
911 (ioccur-color-current-line)))))
913 (defun ioccur-start-timer ()
914 "Start ioccur incremental timer."
915 (setq ioccur-search-timer
917 ioccur-search-delay 'repeat
922 (defun ioccur-send-message ()
923 "Send message defined in `ioccur-message'."
924 (message ioccur-message))
927 (defun ioccur (&optional initial-input)
928 "Incremental search of lines in current buffer matching input.
929 With a prefix arg search symbol at point (INITIAL-INPUT).
931 While you are incremental searching, commands provided are:
933 C-n or <down> next line.
934 C-p or <up> precedent line.
935 C-v and M-v scroll up and down.
936 C-z or <right> jump without quitting loop.
937 C-j or <left> jump and kill `ioccur-buffer'.
938 RET exit keeping `ioccur-buffer'.
939 DEL remove last character entered.
940 C-k Kill current input from cursor to eol.
941 C-a/e/b/f Movements in minibuffer.
942 M-k Kill current input as sexp.
943 C-w Yank stuff at point.
944 C-g quit and restore buffer.
945 C-s Toggle split window.
946 C-: Toggle regexp/litteral search.
947 C-down Follow in other buffer.
948 C-up Follow in other buffer.
949 M-p/n Precedent and next `ioccur-history' element.
950 M-<, M-> Beginning and end of buffer.
952 Unlike minibuffer history, cycling in ioccur history have no end:
954 M-p ,-->A B C D E F G H I---,
956 `---I H G F E D C B A<--'
958 M-n ,-->I H G F E D C B A---,
960 `---A B C D E F G H I<--'
963 Special NOTE for terms:
964 =======================
965 tab/S-tab are bound to history.
966 C-d/u are for following in other buffer.
967 Use C-t to Scroll up.
969 When you quit incremental search with RET, see `ioccur-mode'
970 for commands provided in the `ioccur-buffer'."
973 (setq ioccur-exit-and-quit-p nil)
974 (setq ioccur-success nil)
975 (setq ioccur-current-buffer (buffer-name (current-buffer)))
976 (when ioccur-fontify-buffer-p
977 (message "Fontifying buffer...Please wait it could be long.")
978 (jit-lock-fontify-now) (message nil))
979 (setq ioccur-buffer (concat "*ioccur-" ioccur-current-buffer "*"))
980 (setq ioccur-last-window-configuration (current-window-configuration))
981 (if (and (not initial-input)
982 (get-buffer ioccur-buffer)
983 (not (get-buffer-window ioccur-buffer)))
984 ;; An hidden `ioccur-buffer' exists jump to it and reuse it.
985 (switch-to-buffer-other-window ioccur-buffer t)
986 ;; `ioccur-buffer' doesn't exists or is visible, start searching
987 ;; Creating a new `ioccur-buffer' or reusing the visible one after
989 (let* ((init-str (if initial-input
990 (if (stringp initial-input)
991 initial-input (thing-at-point 'symbol))
993 (len (length init-str))
995 (inhibit-read-only t)
996 (cur-mode (with-current-buffer ioccur-current-buffer
999 ;; If current `major-mode' is wdired
1001 (when (eq major-mode 'wdired-mode)
1002 (wdired-change-to-dired-mode)))))
1004 (set-text-properties 0 len nil init-str)
1005 (setq str-no-prop init-str)
1006 (pop-to-buffer (get-buffer-create ioccur-buffer))
1009 ;; Start incremental search.
1011 (ioccur-start-timer)
1012 (ioccur-read-search-input str-no-prop curpos))
1013 ;; At this point incremental search loop is exited.
1015 (ioccur-cancel-search)
1016 (kill-local-variable 'mode-line-format)
1017 (when (equal (buffer-substring (point-at-bol) (point-at-eol)) "")
1018 (setq ioccur-quit-flag t))
1019 (cond (ioccur-quit-flag ; C-g hit or empty `ioccur-buffer'.
1020 (kill-buffer ioccur-buffer)
1021 (pop-to-buffer ioccur-current-buffer)
1022 (when ioccur-match-overlay
1023 (delete-overlay ioccur-match-overlay))
1024 (set-window-configuration ioccur-last-window-configuration)
1026 (ioccur-send-message)
1027 ;; If `ioccur-message' is non--nil, thats mean we exit
1028 ;; with a specific action other than `C-g',
1029 ;; e.g kill-as-sexp, so we save history.
1030 (when ioccur-message (ioccur-save-history)))
1031 (ioccur-exit-and-quit-p ; Jump and kill `ioccur-buffer'.
1032 (ioccur-jump-and-quit)
1033 (kill-buffer ioccur-buffer)
1034 (ioccur-send-message) (ioccur-save-history))
1035 (t ; Jump keeping `ioccur-buffer'.
1037 (pop-to-buffer ioccur-buffer)
1038 (setq buffer-read-only t)
1039 (ioccur-save-history)))
1040 ;; Maybe reenable `wdired-mode'.
1041 (when (eq cur-mode 'wdired-mode) (wdired-change-to-wdired-mode))
1042 (setq ioccur-count-occurences 0)
1043 (setq ioccur-quit-flag nil)
1044 (setq ioccur-message nil)
1045 (setq ioccur-search-function ioccur-default-search-function)))))))
1047 (defun ioccur-save-history ()
1048 "Save last ioccur element found in `ioccur-history'."
1049 (unless (string= ioccur-pattern "")
1050 (setq ioccur-history
1051 (cons ioccur-pattern (delete ioccur-pattern ioccur-history)))
1052 (when (> (length ioccur-history) ioccur-max-length-history)
1053 (setq ioccur-history (delete (car (last ioccur-history))
1055 (setq ioccur-success t)))
1057 (defun ioccur-cancel-search ()
1058 "Cancel timer used for ioccur searching."
1059 (when ioccur-search-timer
1060 (cancel-timer ioccur-search-timer)
1061 (setq ioccur-search-timer nil)))
1063 (defun ioccur-color-current-line ()
1064 "Highlight and underline current line in `ioccur-buffer'."
1065 (if ioccur-occur-overlay
1066 (move-overlay ioccur-occur-overlay
1067 (point-at-bol) (1+ (point-at-eol)) ioccur-buffer)
1068 (setq ioccur-occur-overlay
1069 (make-overlay (point-at-bol) (1+ (point-at-eol)) ioccur-buffer)))
1070 (overlay-put ioccur-occur-overlay 'face 'ioccur-overlay-face))
1072 (defun ioccur-color-matched-line ()
1073 "Highlight and underline current position \
1074 of matched line in `ioccur-current-buffer'."
1075 (if ioccur-match-overlay
1076 (move-overlay ioccur-match-overlay
1077 (point-at-bol) (1+ (point-at-eol)))
1078 (setq ioccur-match-overlay
1079 (make-overlay (point-at-bol) (1+ (point-at-eol)))))
1080 (overlay-put ioccur-match-overlay 'face 'ioccur-match-overlay-face))
1085 ;;; ioccur.el ends here