xyzzy: zgrep.l

エディターに Emacs を常用するようになって久しいが、その前は xyzzy を使っていた。更にその前は WZ Editor で、社会人プログラマーになって最初のエディターが WZ だった。WZ から xyzzy へ移行した動機は省くが、移行で最後までネックになったのが Grep。

使った人にしか分からないが、WZ Grep には該当行の前後を確認できるプレビュー画面があって、大量の Grep 結果を見る際に非常に便利だった。偶に秀丸などを使う機会があると、プレビューなしでどうやって仕事ができるのか不思議に思ったくらいだ。

結局、xyzzy を使いながら WZ Grep からも離れらない状況が続き、いい加減 WZ と決別するために拡張 Lisp を自作したのだった。当時、既に WZ Grep を模倣する拡張 Lisp は存在したが、使ってみて「これじゃない」感が強くて常用には至らなかった。

以上は 10 年も前のことなので今更ではあるが、その拡張 Lisp をここに公開しておく。ファイルの最終更新日は 2004-09-07。もうコードの内容も覚えてないし、読む気も更新するつもりもないが、WZ Grep から離れられない人の気持ちは良く分かるので。

今でも、Windows で大量のファイルを Grep する必要に迫られた時には、これを使うことがある。Emacs でも作れば良いのだが、今の仕事だと無くてもそれ程には困らないので、作るまでのモチベーションがない・・・。

$XYZZY/site-lisp/zgrep.l:

;;; -*- Mode: Lisp -*-
;;;
;;; This file is NOT part of xyzzy.
;;;
;;
;; 概要
;; ======
;;
;; VZ Grep / WZ Grep のように、Grep バッファにプレビューウィンドウを付ける
;; メジャーモード。
;;
;; 設定
;; ======
;;
;; .xyzzy 又は siteinit.l に下記を記述。
;;
;;   (require "zgrep")
;;   (zgrep-default-setting)
;;
;; `zgrep-default-setting' には、次の設定が含まれている。
;;
;;   ;; SPC でプレビューウィンドウをトグル
;;   (define-key *zgrep-mode-map* #\SPC 'zgrep-toggle-preview)
;;
;;   ;; RET で該当ファイルを開く
;;   (define-key *zgrep-mode-map* #\RET 'zgrep-open)
;;
;;   ;; カーソル移動で次々にプレビューする
;;   (define-key *zgrep-mode-map* #\Up 'zgrep-previous-line)
;;   (define-key *zgrep-mode-map* #\Down 'zgrep-next-line)
;;
;; その他の設定例。
;;
;;   ;; Grep 後、自動で zgrep-mode にする
;;   (defun my-grep-hook ()
;;     (delete-other-windows)
;;     (zgrep-mode (car *minibuffer-search-string-history*)))
;;   (add-hook 'ed::*grepd-hook* 'my-grep-hook)
;;   (add-hook 'ed::*grep-hook* 'my-grep-hook)
;;
;;   ;; Grep ウィンドウ(上段)のサイズ
;;   (setq *zgrep-window-size* 10)
;;
;;   ;; リードオンリーでファイルを開く
;;   (setq *zgrep-open-read-only* t)
;;
;;   ;; Grep 文字色
;;   (setq *zgrep-foreground-color* 1)
;;   (setq *zgrep-background-color* 14)
;;   (setq *zgrep-bold* t)
;;
;;   ;; 拡張子 .grep のファイルを zgrep-mode で開く
;;   (push '("\\.grep$" . zgrep-mode) *auto-mode-alist*)
;;
;; その他
;; ======
;;
;; * ファイル全体を読み込むため、巨大なファイルのプレビューには難有り。
;; * プレビューウィンドウ中での該当行の反転は、色設定によっては見難い。
;; * Grep を C-g で中断したとき zgrep-mode にする上手い方法。
;;

(provide "zgrep")

(defvar *zgrep-mode-hook* nil)

(defvar *zgrep-mode-map* nil)
(unless *zgrep-mode-map*
  (setq *zgrep-mode-map* (make-sparse-keymap)))

(defvar *zgrep-window-size* *error-window-size*)
(defvar *zgrep-open-read-only* nil)

(defvar-local *zgrep-grep-string* nil)
(defvar *zgrep-foreground-color* 1)
(defvar *zgrep-background-color* nil)
(defvar *zgrep-bold* nil)

(defvar-local *zgrep-mode* nil)
(defconstant zgrep-mode-name "zgrep:~A")
(defconstant zgrep-preview-buffer "*grep preview*")
(defvar *zgrep-preview-filename* nil)

(defun zgrep-set-string-color (str &optional from to)
  (if (and str
	   (/= (length str) 0)
	   (or *zgrep-foreground-color*
	       *zgrep-background-color*
	       *zgrep-bold*))
      (save-excursion
	(save-restriction
	  (narrow-to-region (or from (point-min)) (or to (point-max)))
	  (goto-char (point-min))
	  (while (scan-buffer (concat "\\(" str "\\)")
			      :regexp t :no-dup t :case-fold t)
	    (set-text-attribute (match-beginning 1) (match-end 1)
				'zgrep-string
				:foreground *zgrep-foreground-color*
				:background *zgrep-background-color*
				:bold *zgrep-bold*))))))

(defun zgrep-delete-preview-buffer ()
  (let ((buf (find-buffer zgrep-preview-buffer)))
    (if buf (delete-buffer buf)))
  (setq *zgrep-preview-filename* nil))

(defun zgrep-make-preview-buffer (filename)
  (let ((old-buf (selected-buffer))
	(preview-buf (find-buffer zgrep-preview-buffer))
	(grep *zgrep-grep-string*))
    (unless (and preview-buf
		 (string= filename *zgrep-preview-filename*))
      (zgrep-delete-preview-buffer)
      (setq preview-buf (get-buffer-create zgrep-preview-buffer))
      (set-buffer preview-buf)
      (insert-file-contents filename)
      (dolist (x *auto-mode-alist*)
	(when (string-matchp (car x) filename)
	  (funcall (cdr x))))
      (zgrep-set-string-color grep)
      (set-buffer-modified-p nil)
      (setq buffer-read-only t))
    (set-buffer old-buf)
    (setq *zgrep-preview-filename* filename)
    preview-buf))

;; returns (file line body)
(defun zgrep-parse-line ()
  (save-excursion
    (let ((str (buffer-substring (progn (goto-eol) (point))
				 (progn (goto-bol) (point)))))
      (if (string-match "^\\([^:]+\\):\\([0-9]+\\):\\(.*\\)$" str)
	  (list (substring str (match-beginning 1) (match-end 1))
		(parse-integer (substring str
					  (match-beginning 2)
					  (match-end 2)))
		(substring str (match-beginning 3) (match-end 3)))))))

;; Emacs like `get-buffer-window'
(defun zgrep-get-buffer-window (buffer-or-name)
  (ignore-errors
    (get-buffer-window buffer-or-name (selected-window))))

(defun zgrep-preview-p ()
  (zgrep-get-buffer-window zgrep-preview-buffer))

(defun zgrep-preview ()
  (interactive)
  (let ((parsed (zgrep-parse-line)))
    (when (and parsed
	       (file-exist-p (nth 0 parsed)))
      (let ((preview-buf (zgrep-make-preview-buffer (nth 0 parsed))))
	(delete-other-windows)
	(split-window *zgrep-window-size*)
	(other-window)
	(set-buffer preview-buf)
	(goto-line (nth 1 parsed))
	(reverse-region (progn (goto-eol) (point))
			(progn (goto-bol) (point)))
	(refresh-screen)
	(recenter)
	(other-window)
	(recenter)))))

(defun zgrep-toggle-preview ()
  (interactive)
  (if (zgrep-preview-p)
      (progn
	(delete-other-windows)
	;;(zgrep-delete-preview-buffer)
	)
    (zgrep-preview)))

(defun zgrep-find-file (filename)
  (let ((old-buffer (get-file-buffer filename)))
    (if old-buffer
	(progn
	  (ed::find-file-verify old-buffer filename nil nil nil nil)
	  (set-buffer old-buffer))
      (if *zgrep-open-read-only*
	  (find-file-read-only filename)
	(find-file filename)))))

(defun zgrep-open ()
  (interactive)
  (let ((parsed (zgrep-parse-line)))
    (when (and parsed
	       (file-exist-p (nth 0 parsed)))
      ;;(zgrep-delete-preview-buffer)
      (zgrep-find-file (nth 0 parsed))
      (delete-other-windows)
      (goto-line (nth 1 parsed))
      (refresh-screen)
      (recenter))))

(defun zgrep-set-grep-string (grep)
  (interactive "sGrep string (Regexp): ")
  (setq *zgrep-grep-string* grep)
  (zgrep-set-string-color grep))

(defun zgrep-next-line-internal (n)
  (ed::next-line-1 n #'forward-virtual-line #'goto-virtual-column))

(defun zgrep-next-line (&optional (n 1))
  (interactive)
  (let ((old-line (current-line-number)))
    (zgrep-next-line-internal n)
    (when (and (/= old-line (current-line-number))
	       (zgrep-preview-p))
      (zgrep-preview))))

(defun zgrep-previous-line (&optional (n 1))
  (interactive)
  (zgrep-next-line (- n)))

(defun zgrep-mode-toggle ()
  (interactive)
  (if *zgrep-mode*
      (progn
	(setq mode-name (format nil zgrep-mode-name "off"))
	(use-keymap (make-sparse-keymap))
	(local-set-key '(#\C-c #\C-c) 'zgrep-mode-toggle))
    (progn
      (setq mode-name (format nil zgrep-mode-name "on"))
      (use-keymap *zgrep-mode-map*)))
  (setq *zgrep-mode* (null *zgrep-mode*)))

(defun zgrep-mode (&optional grep)
  (interactive)
  (kill-all-local-variables)
  (setq buffer-mode 'zgrep-mode)
  (zgrep-mode-toggle)
  (setq *zgrep-grep-string* grep)
  (run-hooks '*zgrep-mode-hook*))

(defun zgrep-default-setting ()
  (define-key *zgrep-mode-map* #\SPC 'zgrep-toggle-preview)
  (define-key *zgrep-mode-map* #\RET 'zgrep-open)
  (define-key *zgrep-mode-map* #\Up 'zgrep-previous-line)
  (define-key *zgrep-mode-map* #\Down 'zgrep-next-line)
  (define-key *zgrep-mode-map* #\S 'zgrep-set-grep-string)
  (define-key *zgrep-mode-map* #\R 'rename-buffer)
  (define-key *zgrep-mode-map* '(#\C-c #\C-c) 'zgrep-mode-toggle))