Hi all, version 1.1 of ioccur.el is available at http://mercurial.intuxication.org/hg/ioccur
hg clone will give you the default version. I attach file here anyway for commodity. -- Thierry Volpiatto Gpg key: http://pgp.mit.edu/
ioccur.el
Description: application/emacs-lisp
-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 ;;; ioccur.el --- Incremental occur. ;; Author: Thierry Volpiatto <thierry dot volpiatto at gmail dot com> ;; Copyright (C) 2010 Thierry Volpiatto, all rights reserved. ;; Compatibility: GNU Emacs 23.1+ ;; X-URL: http://mercurial.intuxication.org/hg/ioccur ;; This file is not part of GNU Emacs. ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 3, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth ;; Floor, Boston, MA 02110-1301, USA. ;;; Install: ;; ------- ;; Add this file to your `load-path', BYTE-COMPILE it and ;; add (require 'ioccur) in your .emacs. ;; Start with M-x ioccur ;;; Code: (require 'derived) (eval-when-compile (require 'cl)) (defvar ioccur-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "q") 'ioccur-quit) (define-key map (kbd "RET") 'ioccur-jump-and-quit) (define-key map (kbd "<left>") 'ioccur-jump-and-quit) (define-key map (kbd "<right>") 'ioccur-jump-without-quit) (define-key map (kbd "C-z") 'ioccur-jump-without-quit) (define-key map (kbd "<C-down>") 'ioccur-scroll-down) (define-key map (kbd "<C-up>") 'ioccur-scroll-up) (define-key map (kbd "C-v") 'ioccur-scroll-other-window-up) (define-key map (kbd "M-v") 'ioccur-scroll-other-window-down) (define-key map (kbd "<down>") 'ioccur-next-line) (define-key map (kbd "<up>") 'ioccur-precedent-line) (define-key map (kbd "C-n") 'ioccur-next-line) (define-key map (kbd "C-p") 'ioccur-precedent-line) map) "Keymap used for ioccur commands.") (defgroup ioccur nil "Mode that provide incremental searching in buffer." :prefix "ioccur-" :group 'text) ;;; User variables. (defcustom ioccur-search-delay 0.5 "*During incremental searching, display is updated all these seconds." :group 'ioccur :type 'integer) (defcustom ioccur-search-prompt "Pattern: " "*Prompt used for `ioccur-occur'." :group 'ioccur :type 'string) (defcustom ioccur-mode-line-string (if (window-system) " RET:Exit, C-g:Quit, C-k:Kill, C-z:Jump, C-j:Jump&quit, C-n/p:Next/Prec-line, M-p/n:Hist, C/M-v:Scroll, C-down/up:Follow, C-w:Yank tap" " RET:Exit, C-g:Quit, C-k:Kill, C-z:Jump, C-j:Jump&quit, C-n/p:Next/Prec-line, Tab/S-tab:Hist, C-v/t:Scroll, C-d/u:Follow, C-w:Yank tap") "*Documentation of `ioccur' prompt displayed in mode-line. Set it to nil to remove doc in mode-line." :group 'ioccur :type 'string) (defcustom ioccur-length-line 80 "*Length of the line displayed in ioccur buffer." :group 'ioccur :type 'integer) (defcustom ioccur-max-length-history 100 "*Maximum number of element stored in `ioccur-history'." :group 'ioccur :type 'integer) ;;; Faces. (defface ioccur-overlay-face '((t (:background "Green4" :underline t))) "Face for highlight line in ioccur buffer." :group 'ioccur-faces) (defface ioccur-match-overlay-face '((t (:background "Indianred4" :underline t))) "Face for highlight line in matched buffer." :group 'ioccur-faces) (defface ioccur-title-face '((t (:background "Dodgerblue4"))) "Face for highlight incremental buffer title." :group 'ioccur-faces) (defface ioccur-regexp-face '((t (:background "DeepSkyBlue" :underline t))) "Face for highlight found regexp in incremental buffer." :group 'ioccur-faces) (defface ioccur-num-line-face '((t (:foreground "OrangeRed"))) "Face for highlight number line in ioccur buffer." :group 'ioccur-faces) ;;; Internal variables. (defvar ioccur-search-pattern "") (defvar ioccur-search-timer nil) (defvar ioccur-quit-flag nil) (defvar ioccur-current-buffer nil) (defvar ioccur-occur-overlay nil) (defvar ioccur-exit-and-quit-p nil) (defvar ioccur-history nil) (defvar ioccur-match-overlay nil) (defvar ioccur-count-occurences 0) (define-derived-mode ioccur-mode text-mode "ioccur" "Major mode to search occurences of regexp in current buffer. Special commands: \\{ioccur-mode-map}" (if ioccur-mode-line-string (setq mode-line-format '(" " mode-line-buffer-identification " " (line-number-mode "%l") " " ioccur-mode-line-string "-%-")) (kill-local-variable 'mode-line-format))) (defsubst* ioccur-position (item seq &key (test 'eq)) "A simple replacement of CL `position'." (loop for i in seq for index from 0 when (funcall test i item) return index)) ;;; Iterators. (defmacro ioccur-iter-list (list-obj) "Return an iterator from list LIST-OBJ." `(lexical-let ((lis ,list-obj)) (lambda () (let ((elm (car lis))) (setq lis (cdr lis)) elm)))) (defun ioccur-iter-next (iterator) "Return next elm of ITERATOR." (funcall iterator)) (defun ioccur-iter-circular (seq) "Infinite iteration on SEQ." (lexical-let ((it (ioccur-iter-list seq)) (lis seq)) (lambda () (let ((elm (ioccur-iter-next it))) (or elm (progn (setq it (ioccur-iter-list lis)) (ioccur-iter-next it))))))) (defun ioccur-butlast (seq pos) "Return SEQ from index 0 to POS." (butlast seq (- (length seq) pos))) (defun* ioccur-sub-prec-circular (seq elm &key (test 'eq)) "Infinite reverse iteration of SEQ starting at ELM." (lexical-let* ((rev-seq (reverse seq)) (pos (ioccur-position elm rev-seq :test test)) (sub (append (nthcdr (1+ pos) rev-seq) (ioccur-butlast rev-seq pos))) (iterator (ioccur-iter-list sub))) (lambda () (let ((elm (ioccur-iter-next iterator))) (or elm (progn (setq iterator (ioccur-iter-list sub)) (ioccur-iter-next iterator))))))) (defun* ioccur-sub-next-circular (seq elm &key (test 'eq)) "Infinite iteration of SEQ starting at ELM." (lexical-let* ((pos (ioccur-position elm seq :test test)) (sub (append (nthcdr (1+ pos) seq) (ioccur-butlast seq pos))) (iterator (ioccur-iter-list sub))) (lambda () (let ((elm (ioccur-iter-next iterator))) (or elm (progn (setq iterator (ioccur-iter-list sub)) (ioccur-iter-next iterator))))))) (defsubst* ioccur-find-readlines (bfile regexp &key (insert-fn 'buffer)) "Return an alist of all the (numline line) matching REGEXP." (let ((count 0) (fn (case insert-fn ('file 'insert-file-contents) ('buffer 'insert-buffer-substring)))) (with-temp-buffer (funcall fn bfile) ; call insert function (goto-char (point-min)) (loop with lines-list = (split-string (buffer-string) "\n") for i in lines-list when (string-match regexp i) collect (list count (replace-regexp-in-string "\n" "" i)) into lis do (incf count) finally return lis)))) (defun* ioccur-print-buffer (regex buffer &key (lline ioccur-length-line)) "Print matched lines in ioccur buffer." (setq ioccur-count-occurences 0) (let ((matched-lines (ioccur-find-readlines buffer regex))) (when matched-lines (dolist (i matched-lines) ; Each element is of the form '(key value) (let* ((ltp (second i)) (replace-reg (if (string-match "^\t" ltp) "\\(^\t*\\)" "\\(^ *\\)")) (new-ltp (replace-regexp-in-string replace-reg "" ltp)) (line-to-print new-ltp)) (incf ioccur-count-occurences) (insert (concat " " (propertize (int-to-string (+ (first i) 1)) 'face 'ioccur-num-line-face 'help-echo line-to-print) ":" (if (> (length line-to-print) lline) (substring line-to-print 0 lline) line-to-print) "\n"))))))) (defun ioccur-quit () "Quit and kill ioccur buffer." (interactive) (when ioccur-match-overlay (delete-overlay ioccur-match-overlay)) (quit-window t) (other-window 1) (delete-other-windows)) (defun ioccur-goto-line (numline) "Non--interactive version of `goto-line.'" (goto-char (point-min)) (forward-line (1- numline))) (defun ioccur-forward-line (n) "Forward line only if it is not an empty line." (let (pos) (save-excursion (forward-line n) (forward-line 0) (when (looking-at "^ [0-9]+") (forward-line 0) (setq pos (point)))) (when pos (goto-char pos) (ioccur-color-current-line)))) ;;;###autoload (defun ioccur-next-line () "Goto next line if it is not an empty line." (interactive) (ioccur-forward-line 1)) ;;;###autoload (defun ioccur-precedent-line () "Goto precedent line if it is not an empty line." (interactive) (ioccur-forward-line -1)) (defun ioccur-jump () "Jump to line in other buffer and put an overlay on it." (let ((line (buffer-substring (point-at-bol) (point-at-eol))) pos) (unless (or (string= line "") (string= line "Ioccur")) (when (string-match "[0-9]+" line) (setq pos (string-to-number (match-string 0 line)))) (pop-to-buffer ioccur-current-buffer) (ioccur-goto-line pos) (ioccur-color-matched-line)))) ;;;###autoload (defun ioccur-jump-and-quit () "Jump to line in other buffer and quit search buffer." (interactive) (when (ioccur-jump) (delete-other-windows) (sit-for 0.3) (when ioccur-match-overlay (delete-overlay ioccur-match-overlay)))) (defun ioccur-jump-without-quit () "Jump to line in `ioccur-current-buffer' without quiting." (interactive) (ioccur-jump) (other-window 1)) (defun ioccur-scroll-other-window-down () "Scroll other window down." (interactive) (scroll-other-window 1)) (defun ioccur-scroll-other-window-up () "Scroll other window up." (interactive) (scroll-other-window -1)) (defun ioccur-scroll (n) "Scroll other buffer and move overlay accordingly." (ioccur-forward-line n) (ioccur-color-current-line) (when (ioccur-jump) (other-window 1))) ;;;###autoload (defun ioccur-scroll-down () "Scroll other buffer down." (interactive) (ioccur-scroll 1)) ;;;###autoload (defun ioccur-scroll-up () "Scroll other buffer up." (interactive) (ioccur-scroll -1)) ;;;###autoload (defun ioccur-split-window () "Toggle split window, vertically or horizontally." (interactive) (with-current-buffer ioccur-current-buffer (let ((old-size (window-height))) (delete-window) (set-window-buffer (select-window (if (= (window-height) old-size) (split-window-vertically) (split-window-horizontally))) (get-buffer "*ioccur*"))))) (defun ioccur-read-char-or-event (prompt) "Replace `read-key' when not available." (if (fboundp 'read-key) (read-key prompt) (let* ((chr (condition-case nil (read-char prompt) (error nil))) (evt (unless chr (read-event prompt)))) (or chr evt)))) (defun ioccur-read-search-input (initial-input start-point) "Read each keyboard input and add it to `ioccur-search-pattern'." (let* ((prompt (propertize ioccur-search-prompt 'face 'minibuffer-prompt)) (inhibit-quit (not (fboundp 'read-key))) (tmp-list ()) (it-prec nil) (it-next nil) (cur-hist-elm (car ioccur-history)) (start-hist nil) ; Flag to notify if cycling history started. (old-yank-point start-point) yank-point) (unless (string= initial-input "") (loop for char across initial-input do (push char tmp-list))) (setq ioccur-search-pattern initial-input) ;; Cycle history function. ;; (flet ((cycle-hist (arg) (if ioccur-history (progn ;; Cycle history will start at second call, ;; at first call just use the car of hist ring. ;; We build a new iterator based on a sublist ;; starting at the current element of history. ;; This is a circular iterator. (no end) (if start-hist ; At first call start-hist is nil. (progn (if (< arg 0) ;; M-p (move from left to right in hist ring). (unless it-prec ; Don't rebuild iterator if exists. (setq it-prec (ioccur-sub-next-circular ioccur-history cur-hist-elm :test 'equal)) (setq it-next nil)) ; Kill forward iterator. ;; M-n (move from right to left in hist ring). (unless it-next ; Don't rebuild iterator if exists. (setq it-next (ioccur-sub-prec-circular ioccur-history cur-hist-elm :test 'equal)) (setq it-prec nil))) ; kill backward iterator. (let ((it (or it-prec it-next))) (setq cur-hist-elm (ioccur-iter-next it)) (setq tmp-list nil) (loop for char across cur-hist-elm do (push char tmp-list)) (setq ioccur-search-pattern cur-hist-elm))) ;; First call use car of history ring. (setq tmp-list nil) (loop for char across cur-hist-elm do (push char tmp-list)) (setq ioccur-search-pattern cur-hist-elm) (setq start-hist t))) (message "No history available.") (sit-for 2) t)) ;; Maybe start timer. ;; (start-timer () (unless ioccur-search-timer (ioccur-start-timer))) ;; Maybe stop timer. ;; (stop-timer () (when ioccur-search-timer (ioccur-cancel-search)))) ;; Start incremental loop. (while (let ((char (ioccur-read-char-or-event (concat prompt ioccur-search-pattern)))) (case char ((not (?\M-p ?\M-n ?\t C-tab)) ; Reset history (setq start-hist nil) (setq cur-hist-elm (car ioccur-history)) t) ((down ?\C-n) ; Next line. (stop-timer) (ioccur-next-line) (ioccur-color-current-line) t) ((up ?\C-p) ; Precedent line. (stop-timer) (ioccur-precedent-line) (ioccur-color-current-line) t) ((?\C-d C-down) ; Scroll both windows down. (stop-timer) (ioccur-scroll-down) t) ((?\C-u C-up) ; Scroll both windows up. (stop-timer) (ioccur-scroll-up) t) (?\r ; RET break and exit code. (message nil) nil) (?\d ; Delete backward with DEL. (start-timer) (with-current-buffer ioccur-current-buffer (goto-char old-yank-point) (setq yank-point old-yank-point)) (pop tmp-list) t) (?\C-g ; Quit and restore buffers. (setq ioccur-quit-flag t) nil) ((or right ?\C-z) ; Persistent action. (ioccur-jump-without-quit) t) ((left ?\C-j) ; Jump to candidate and kill search buffer. (setq ioccur-exit-and-quit-p t) nil) (?\C-v ; Scroll down. (ioccur-scroll-other-window-down) t) ((?\C-t ?\M-v) ; Scroll up. (ioccur-scroll-other-window-up) t) (?\C-| ; Toggle split window. (ioccur-split-window) t) (?\C-k ; Kill input. (start-timer) (with-current-buffer ioccur-current-buffer (goto-char old-yank-point) (setq yank-point old-yank-point)) (kill-new ioccur-search-pattern) (setq tmp-list ()) t) (?\C-y ; Yank from `kill-ring'. (setq initial-input (car kill-ring)) (unless (string= initial-input "") (loop for char across initial-input do (push char tmp-list))) (setq ioccur-search-pattern initial-input) t) (?\C-w ; Yank stuff at point. (start-timer) (with-current-buffer ioccur-current-buffer (unless old-yank-point (setq old-yank-point (point))) (setq yank-point (point)) (forward-word 1) (setq initial-input (buffer-substring yank-point (point)))) (unless (string= initial-input "") (loop for char across initial-input do (push char tmp-list))) (setq ioccur-search-pattern initial-input) t) ((?\t ?\M-p) ; Precedent history elm. (start-timer) (cycle-hist -1)) ((backtab ?\M-n) ; Next history elm. (start-timer) (cycle-hist 1)) (t ; Store character. (start-timer) (if (characterp char) (push char tmp-list) (setq unread-command-events (nconc (mapcar 'identity (this-single-command-raw-keys)) unread-command-events)) nil)))) (setq ioccur-search-pattern (apply 'string (reverse tmp-list))))))) (defun ioccur-update-buffer (regexp buffer-name) "Print all lines matching REGEXP in current buffer to buffer BUFFER-NAME." (let ((title (propertize "Ioccur" 'face 'ioccur-title-face))) (if (string= regexp "") (progn (erase-buffer) (insert (concat title "\n\n"))) (erase-buffer) (ioccur-print-buffer regexp buffer-name :lline ioccur-length-line) (goto-char (point-min)) (insert (concat title "\n\n" (propertize (format "Found %s occurences of " ioccur-count-occurences) 'face 'underline) (propertize regexp 'face 'ioccur-regexp-face) (propertize (format " in %s" buffer-name) 'face 'underline) "\n\n")) (ioccur-color-current-line)))) (defun ioccur-start-timer () "Start ioccur incremental timer." (setq ioccur-search-timer (run-with-idle-timer ioccur-search-delay 'repeat #'(lambda () (ioccur-update-buffer ioccur-search-pattern ioccur-current-buffer))))) ;;;###autoload (defun ioccur (&optional initial-input) "Incremental search of lines in current buffer matching input. With a prefix arg search symbol at point (INITIAL-INPUT). While you are incremental searching, commands provided are: C-n or <down> next line. C-p or <up> precedent line. C-v and M-v scroll up and down. C-z or <right> jump without quitting loop. C-j or <left> jump and exit search buffer. RET exit but don't quit search buffer. DEL remove last character entered. C-k Kill current input. C-w Yank stuff at point. C-g quit and restore buffer. C-down Follow in other buffer. C-up Follow in other buffer. M-p/n Precedent and next `ioccur-history' element: M-p ,-->A B C D E F G H I---, | | `---I H G F E D C B A<--' M-n ,-->I H G F E D C B A---, | | `---A B C D E F G H I<--' Special NOTE for terms: ======================= tab/S-tab are bound to history. C-d/u are for following in other buffer. Use C-t to Scroll up. When you quit incremental search with RET, see `ioccur-mode' for commands provided in the search buffer." (interactive "P") (setq ioccur-exit-and-quit-p nil) (setq ioccur-current-buffer (buffer-name (current-buffer))) (with-current-buffer ioccur-current-buffer (jit-lock-fontify-now)) (let* ((init-str (if initial-input (thing-at-point 'symbol) "")) (len (length init-str)) (curpos (point)) str-no-prop) (set-text-properties 0 len nil init-str) (setq str-no-prop init-str) (pop-to-buffer (get-buffer-create "*ioccur*")) (ioccur-mode) (unwind-protect ;; Start incremental search. (progn (ioccur-start-timer) (ioccur-read-search-input str-no-prop curpos)) ;; At this point incremental search loop is exited. (progn (ioccur-cancel-search) (kill-local-variable 'mode-line-format) (when (equal (buffer-substring (point-at-bol) (point-at-eol)) "") (setq ioccur-quit-flag t)) (if ioccur-quit-flag ; C-g (progn (kill-buffer "*ioccur*") (switch-to-buffer ioccur-current-buffer) (when ioccur-match-overlay (delete-overlay ioccur-match-overlay)) (delete-other-windows) (goto-char curpos) (message nil)) (if ioccur-exit-and-quit-p (progn (ioccur-jump-and-quit) (kill-buffer "*ioccur*") (message nil)) (ioccur-jump) (other-window 1)) ;; Push elm in history if not already there or empty. (unless (or (member ioccur-search-pattern ioccur-history) (string= ioccur-search-pattern "")) (push ioccur-search-pattern ioccur-history)) ;; If elm already exists in history ring push it on top of stack. (let ((pos-hist-elm (ioccur-position ioccur-search-pattern ioccur-history :test 'equal))) (unless (string= (car ioccur-history) ioccur-search-pattern) (push (pop (nthcdr pos-hist-elm ioccur-history)) ioccur-history))) (when (> (length ioccur-history) ioccur-max-length-history) (setq ioccur-history (delete (car (last ioccur-history)) ioccur-history)))) (setq ioccur-count-occurences 0) (setq ioccur-quit-flag nil))))) (defun ioccur-cancel-search () "Cancel timer used for ioccur searching." (when ioccur-search-timer (cancel-timer ioccur-search-timer) (setq ioccur-search-timer nil))) (defun ioccur-color-current-line () "Highlight and underline current line in ioccur buffer." (if ioccur-occur-overlay (move-overlay ioccur-occur-overlay (point-at-bol) (1+ (point-at-eol))) (setq ioccur-occur-overlay (make-overlay (point-at-bol) (1+ (point-at-eol))))) (overlay-put ioccur-occur-overlay 'face 'ioccur-overlay-face)) (defun ioccur-color-matched-line () "Highlight and underline current position on matched line in current-buffer." (if ioccur-match-overlay (move-overlay ioccur-match-overlay (point-at-bol) (1+ (point-at-eol))) (setq ioccur-match-overlay (make-overlay (point-at-bol) (1+ (point-at-eol))))) (overlay-put ioccur-match-overlay 'face 'ioccur-match-overlay-face)) ;;; Provide (provide 'ioccur) ;;; ioccur.el ends here. -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iEYEARECAAYFAkuw+lYACgkQKNF/U1nymZfpngCgpVdN0yvQBG8ZpZbidTVFprAo j30AnRIVXHvWDd9F5QdYlNdAm7394zm7 =KAlz -----END PGP SIGNATURE-----
_______________________________________________ gnu-emacs-sources mailing list [email protected] http://lists.gnu.org/mailman/listinfo/gnu-emacs-sources
