;;; color-occur.el ;; -*- Mode: Emacs-Lisp -*- ;; $Id: color-occur.el,v 2.4 2007/12/25 15:54:32 akihisa Exp $ ;; Author: Matsushita Akihisa ;; Keywords: occur highlight convenience ;; 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 GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; color-occur highlight occur buffer and file buffer. Furthermore ;; color-occur show the matching line of file buffer in other window. ;;; Install: ;; Put this file into load-path'ed directory, and byte compile it if ;; desired. And put the following expression into your ~/.emacs. ;; ;; (require 'color-occur) ;; The latest version of this program can be downloaded from ;; http://www.bookshelf.jp/elc/color-occur.el ;; Usage: ;; occur shows all occurrences of in current buffers ;; C-c C-c or RET gets you to the occurrence ;; q : quit ;; , n : next matches ;; , p : previous matches ;; Other related Elisp ;; http://www.bookshelf.jp/elc/color-moccur.el ;; http://www.bookshelf.jp/elc/moccur-edit.el ;;; History: ;; color-occur 1.0 was released to the net on 12/01/2002 ;;; Code: (defgroup color-occur nil "Customize color-occur" :group 'matching) (defcustom color-occur-kill-occur-buffer nil "*Non-nil means to kill *Occur* buffer automatically when you exit *Occur* buffer." :group 'color-ooccur :type 'boolean ) (defface color-occur-face '((((class color) (background dark)) (:background "SkyBlue" :bold t :foreground "Black")) (((class color) (background light)) (:background "ForestGreen" :bold t)) (t ())) "Face used for list-matching-lines-face" :group 'color-occur ) (setq list-matching-lines-face 'color-occur-face) ;;; Internal variables (defvar before-occur-use-migemo nil) (defvar before-occur-point nil) (defvar before-occur-buffer nil) (defvar before-occur-word "") (defvar color-occur-overlays nil) (defvar color-occur-underline-overlays nil) (defvar occur-buffer nil) (make-variable-buffer-local 'occur-buffer) (define-key occur-mode-map '[up] 'color-occur-prev) (define-key occur-mode-map '[down] 'color-occur-next) (define-key occur-mode-map "\M-n" 'color-occur-next) (define-key occur-mode-map "\M-p" 'color-occur-prev) (define-key occur-mode-map "\C-v" 'color-occur-scroll-up) (define-key occur-mode-map "\M-v" 'color-occur-scroll-down) (define-key occur-mode-map "n" 'color-occur-next) (define-key occur-mode-map "p" 'color-occur-prev) (define-key occur-mode-map "j" 'color-occur-next) (define-key occur-mode-map "k" 'color-occur-prev) (define-key occur-mode-map "q" 'color-occur-exit) (define-key occur-mode-map " " 'color-occur-scroll-up) (define-key occur-mode-map "b" 'color-occur-scroll-down) (define-key occur-mode-map "\C-m" 'color-occur-mode-goto-occurrence) (define-key occur-mode-map "\C-c\C-c" 'color-occur-mode-goto-occurrence) (defun color-occur-color () "*Highlight the file buffer" (let ((ov)) (save-excursion (if before-occur-word (progn (goto-char (point-min)) (while (re-search-forward before-occur-word nil t) (progn (setq ov (make-overlay (match-beginning 0) (match-end 0))) (overlay-put ov 'face 'color-occur-face) (overlay-put ov 'priority 0) (setq color-occur-overlays (cons ov color-occur-overlays)))) (make-local-hook 'after-change-functions) (remove-hook 'after-change-functions 'color-occur-remove-overlays) ;;(add-hook 'after-change-functions 'color-occur-remove-overlays) ))))) (defun color-occur-remove-overlays (&optional beg end length) (interactive) (if color-occur-underline-overlays (progn (delete-overlay color-occur-underline-overlays) (setq color-occur-underline-overlays nil))) (if (and beg end (= beg end)) () (while color-occur-overlays (delete-overlay (car color-occur-overlays)) (setq color-occur-overlays (cdr color-occur-overlays))))) (defadvice occur (before save-excursion activate) (setq before-occur-buffer (current-buffer)) (setq before-occur-point (point)) (if before-occur-use-migemo (setq before-occur-word (migemo-get-pattern regexp)) (setq before-occur-word regexp)) (color-occur-color)) (defadvice occur (after color-occur-color activate) (if (get-buffer "*Occur*") (set-buffer (get-buffer "*Occur*"))) (setq occur-buffer before-occur-buffer) (if (boundp 'fm-working) (setq fm-working nil)) (color-occur-color)) (defadvice occur (after setq-last activate) (if (and (not (string= (buffer-name (current-buffer)) "Occur")) (get-buffer "*Occur*")) (switch-to-buffer-other-window (get-buffer "*Occur*")))) (defadvice occur-mode-goto-occurrence (after pop-to-buffer activate) (if (featurep 'xemacs) (bury-buffer (get-buffer "*Occur*")) (color-occur-remove-overlays) (if color-occur-kill-occur-buffer (kill-buffer (get-buffer "*Occur*")) (bury-buffer (get-buffer "*Occur*")))) ;; (switch-to-buffer before-occur-buffer) (delete-other-windows)) (defun color-occur-mode-goto-occurrence () (interactive) (occur-mode-goto-occurrence) (if (featurep 'xemacs) (progn (color-occur-remove-overlays) (if color-occur-kill-occur-buffer (kill-buffer (get-buffer "*Occur*")) (bury-buffer (get-buffer "*Occur*")))))) (defun color-occur-exit () "*Exit occur buffer" (interactive) (if color-occur-kill-occur-buffer (kill-buffer (get-buffer "*Occur*")) (bury-buffer (get-buffer "*Occur*"))) (switch-to-buffer before-occur-buffer) (goto-char before-occur-point) (color-occur-remove-overlays) (delete-other-windows) ) (if (featurep 'xemacs) (progn (defun occur-mode-find-occurrence (line) (switch-to-buffer-other-window before-occur-buffer) (goto-line line) (switch-to-buffer-other-window (get-buffer "*Occur*"))) (defun color-occur-next (&optional n) "Move to the Nth (default 1) next match in the *Occur* buffer." (interactive "p") (if (not n) (setq n 1)) (forward-line n) (save-excursion (end-of-line) (if (re-search-backward "^[ ]*\\([0-9]+\\):" nil t) (setq line (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))))) (occur-mode-find-occurrence line) (if (not color-occur-underline-overlays) (setq color-occur-underline-overlays (make-overlay (line-beginning-position) (1+ (line-end-position)))) (move-overlay color-occur-underline-overlays (line-beginning-position) (1+ (line-end-position)))) (overlay-put color-occur-underline-overlays 'face 'underline) ;;(switch-to-buffer-other-window (get-buffer "*Occur*")) ) (defun color-occur-prev (&optional n) "Move to the Nth (default 1) next match in the *Occur* buffer." (interactive "p") (if (not n) (setq n 1)) (color-occur-next (- n)) )) (defun color-occur-next (&optional n) "Move to the Nth (default 1) next match in the *Occur* buffer." (interactive "p") (if (not n) (setq n 1)) (let ((r) (line nil) pos) (while (> n 0) (if (get-text-property (point) 'occur-target) (forward-char 1)) (setq r (next-single-property-change (point) 'occur-target)) (if r (progn (goto-char r) (save-excursion (if (re-search-backward "^[ ]*\\([0-9]+\\):" nil t) (setq line (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))))) (setq pos (condition-case err (occur-mode-find-occurrence) (error nil))) (if pos (pop-to-buffer (marker-buffer pos)) (pop-to-buffer occur-buffer)) (when pos (goto-char (marker-position pos)) (if (not color-occur-underline-overlays) (setq color-occur-underline-overlays (make-overlay (line-beginning-position) (1+ (line-end-position)) (marker-buffer pos))) (move-overlay color-occur-underline-overlays (line-beginning-position) (1+ (line-end-position)) (marker-buffer pos))) (overlay-put color-occur-underline-overlays 'face 'underline)) (switch-to-buffer-other-window (get-buffer "*Occur*")) ) (message "no more matches") (forward-line 1)) (setq n (1- n))) )) (defun color-occur-prev (&optional n) "Move to the Nth (default 1) previous match in the *Occur* buffer." (interactive "p") (if (not n) (setq n 1)) (let ((r)) (while (> n 0) (setq r (get-text-property (point) 'occur-target)) (if r (forward-char -1)) (setq r (previous-single-property-change (point) 'occur-target)) (if r (progn (goto-char (- r 1)) (save-excursion (end-of-line) (if (re-search-backward "^[ ]*\\([0-9]+\\):" nil t) (setq line (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))))) (setq pos (condition-case err (occur-mode-find-occurrence) (error nil))) (if pos (pop-to-buffer (marker-buffer pos)) (pop-to-buffer occur-buffer)) (when pos (goto-char (marker-position pos)) (if (not color-occur-underline-overlays) (setq color-occur-underline-overlays (make-overlay (line-beginning-position) (1+ (line-end-position)) (marker-buffer pos))) (move-overlay color-occur-underline-overlays (line-beginning-position) (1+ (line-end-position)) (marker-buffer pos))) (overlay-put color-occur-underline-overlays 'face 'underline)) (switch-to-buffer-other-window (get-buffer "*Occur*")) ) (message "no earlier matches") (forward-line -1)) (setq n (1- n)))))) (defun color-occur-scroll-down () (interactive) (scroll-down) (forward-line 1) (color-occur-prev)) (defun color-occur-scroll-up () (interactive) (scroll-up) (forward-line 1) (color-occur-prev)) (provide 'color-occur) ;;; $Log: color-occur.el,v $ ;;; Revision 2.4 2007/12/25 15:54:32 akihisa ;;; *** empty log message *** ;;; ;;; Revision 2.3 2007/11/04 13:37:15 akihisa ;;; *** empty log message *** ;;; ;;; Revision 2.2 2005/05/14 03:05:59 akihisa ;;; for multi-occur ;;; ;;; Revision 2.1 2005/02/18 11:08:15 akihisa ;;; *** empty log message *** ;;; ;;; Revision 2.0 2004/08/10 02:00:29 akihisa ;;; update version ;;; ;;; Revision 1.1.1.1 2004/08/10 01:48:09 akihisa ;;; plisp ;;; ;;; Revision 1.23 2004/06/28 13:40:09 akihisa ;;; *** empty log message *** ;;; ;;; Revision 1.22 2003/10/04 08:33:10 akihisa ;;; *** empty log message *** ;;; ;;; Revision 1.1.1.1 2003/10/04 08:12:05 akihisa ;;; myelisp ;;; ;;; Revision 1.21 2003/06/20 11:22:13 akihisa ;;; *** empty log message *** ;;; ;;; Revision 1.20 2003/06/17 14:45:33 akihisa ;;; C ;;; ;;; Revision 1.19 2003/06/13 12:37:54 akihisa ;;; *** empty log message *** ;;; ;;; color-occur.el ends here