ugrep ver0.26

;;; -*- Mode: Lisp; Package: EDITOR -*-
;;; ugrep.l
;;; ver0.26
;;; 正規表現とサブディレクトリ検索の組み込み
;;; サブディレクトリ検索+fgrepの際に難あり

(provide "ugrep")

(in-package "editor")

(export '(ugrep
	  ugrep-dialog
	  ugrep-split-window
	  exec-ugrep
	  scan-ugrepfile
	  scan-ugrepfileR
	  highlight-search-word
	  view-all-list
	  *ugrep-mode-hook*
	  *search-ugrepdialog-template* *ugrep-search-word* *ugrep-mode-map*))

(defvar *ugrep-search-word* nil)
(defvar *ugrep-search-dir* nil)
(defvar *ugrep-mode-hook* nil)
(defvar *ugrep-list* nil)
(defvar *ugrep-view* nil)
(define-history-variable *ugrep-subdir* nil)
(define-history-variable *ugrep-regexp* nil)

;; ダイアログテンプレート

(defvar *search-ugrepdialog-template*
  '(dialog 0 0 271 95
    (:caption "UGrep")
    (:font 9 "MS Pゴシック")
    (:control
     (:static nil "パターン(&P):" #x50020000 7 10 42 8)
     (:combobox pat nil #x50210042 51 8 157 96)
		 (:static nil "フォルダ(&D):" #x50020000 7 27 42 8)
		 (:combobox dir nil #x50210042 51 25 157 96)
     (:button IDOK "検索(&S)" #x50010001 214 7 50 14)
     (:button IDCANCEL "キャンセル" #x50010000 214 24 50 14)
     (:button subdir "SubDir" #x50010003 214 58 50 14)
     (:button regexp "正規表現" #x50010003 214 75 50 14)
     (:button ref "参照(&R)..." #x50010000 214 41 50 14))))

;; ダイアログ

(defun ugrep-dialog ()
  (interactive)
  (setq *ugrep-search-dir* (pop si:*command-line-args*))
  (multiple-value-bind (result data)
      (dialog-box *search-ugrepdialog-template*
		  (list (cons 'dir *ugrep-search-dir*)
			(cons 'subdir *ugrep-subdir*)
			(cons 'regexp *ugrep-regexp*))
		  `(list (ref :related dir :directory-name-dialog (:title "参照"))))
    (setq *ugrep-search-word* (cdr (assoc 'pat data)))
    (setq *ugrep-search-dir* (cdr (assoc 'dir data)))
    (setq *ugrep-subdir* (cdr (assoc 'subdir data)))
    (setq *ugrep-regexp* (cdr (assoc 'regexp data)))
    )
  )



;; ウィンドウの分割とバッファの表示

(defun ugrep-split-window (file list-buffer)
  (interactive)
  (delete-other-windows)
  (setq *ugrep-list* (switch-to-buffer list-buffer))
  (insert-file-contents file)
  (split-window -25 nil)
  (set-buffer-fold-width nil)
  (setq need-not-save t))

;; grepの引数


(defun grep-cmd (key dir  &optional subdir regexp)
  (let ((sub-c (if subdir
		    "-r"
		  nil))
	(reg-mode (if regexp
		    "-E"
		    "-F")))
    (if subdir
	(concat " " sub-c " " reg-mode " " key " " dir)
      (concat " " reg-mode " " key " " dir "/*"))))
;; 外部コマンドの実行


(defun exec-ugrep (command arg tmp-file)
  (call-process (concat command arg) :output tmp-file :show :hide :wait t))



;; 検索語のハイライト表示


(defun highlight-search-word ()
  (interactive)
    (delete-text-attributes 'search-word)
  (save-excursion
    (goto-char (point-min))
    (while (scan-buffer *ugrep-search-word* :regexp t :no-dup nil :case-fold t :tail t)
      (set-text-attribute (point) (- (point) (length *ugrep-search-word*))  'search-word :bold t :foreground 4 )
      (goto-eol)
      )
    )
)

;; 行頭のファイルパスを取得

(defvar *file-path* nil)
(defun get-path ()
  (interactive)
    (save-excursion
      (goto-eol)
      (let* ((line (buffer-substring (point) (progn (goto-bol)(point))))
	     (splits (split-string line #\:)))
	(setq *file-path* (concat (car splits) ":" (cadr splits))))))

;; ファイルパスが存在するかどうかで分岐

(defvar *ugrep-old-pathname* nil)
(defun ugrep-open-file ()
  (interactive)
  (get-path)
  (cond ((equal *file-path* *ugrep-old-pathname*)
	   (progn (other-window)
	     (set-buffer *ugrep-view*)
	     (scan-buffer *ugrep-search-word* :no-dup t :tail t)
	     (other-window)
	     (message "~A は同じ" *ugrep-old-pathname*)))
	  ((file-exist-p *file-path*) 
	   (progn (other-window)
	     (switch-to-buffer *ugrep-view*)
	     (erase-buffer(selected-buffer))
	     (insert-file-contents *file-path*)
	     (highlight-search-word)
	     (scan-buffer *ugrep-search-word* :no-dup t)
	     (setq need-not-save t)
	     (setq *ugrep-old-pathname* *file-path*)
	     (message "~A " *ugrep-old-pathname*)
	     (other-window)))
	(t (message "~A はファイルなのか?" *file-path*))))


;; 次のファイルを開く

(defun ugrep-open-file-next ()
  (interactive)
  (unless (equal (window-buffer (selected-window)) *ugrep-list*)
    (other-window))
  (next-line)
  (ugrep-open-file))

(defun ugrep-open-file-this ()
  (interactive)
  (unless (equal (window-buffer (selected-window)) *ugrep-list*)
    (other-window))
  (ugrep-open-file))

;; 連結表示

(defun split-path (line)
  (setq splits (split-string line #\:))
  (concat (car splits) ":" (cadr splits)))

(defvar *filename-list* nil)

(defun make-filename-list (file)
  (with-open-file (in file :direction :input)
    (let ((word-list (make-list 0))
	word)
      (while (setq word (read-line in nil))
	(setq word (split-path word))
	(unless (equal word (car word-list))
	  (setq word-list (cons word word-list))))
      (setq *filename-list* word-list))))

(defun insert-list (file-list)
    (dolist (x file-list)
      (insert-file x)))


(defun view-all-list ()
  (interactive)
  (unless (equal (window-buffer (selected-window)) *ugrep-list*)
    (other-window))
  (let ((tmp-file (make-temp-file-name)))
    (write-file tmp-file)
    (make-filename-list tmp-file)
    (other-window)
    (switch-to-buffer "all-list-view")
    (insert-list *filename-list*)
    (delete-file tmp-file))
  (set-buffer-fold-width nil)
  (setq need-not-save t))

;; 検索
	  
(defun scan-ugrepfile ()
  (interactive)
  (unless (equal (buffer-name (selected-buffer)) (buffer-name *ugrep-view*))
    (other-window))
  (scan-buffer *ugrep-search-word* :reverse t :no-dup t)
  )
(defun scan-ugrepfileR ()
  (interactive)
  (unless (equal (buffer-name (selected-buffer)) (buffer-name *ugrep-view*))
    (other-window))
  (scan-buffer *ugrep-search-word* :reverse t :no-dup t)
  )


;; 本体

(defun ugrep ()
  (interactive)
  (ugrep-dialog)
  (let ((command "grep.exe")
	(key *ugrep-search-word*)
	(dir *ugrep-search-dir*)
	(tmp-file (make-temp-file-name))
	(buffer1 "view-list")
	(buffer2 "view-file"))
    (setq arg (grep-cmd key dir *ugrep-subdir* *ugrep-regexp*))
    (exec-ugrep command arg tmp-file)
    (message "~A" arg)
    (ugrep-split-window tmp-file buffer1)
    (switch-to-buffer buffer1)
    (ugrep-mode)
    (setq *ugrep-view* (switch-to-buffer buffer2))
    (ugrep-mode)
    (delete-file tmp-file))
  )

;; キーマップ

(defun ugrep-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq buffer-mode 'ugrep-mode)
  (setq mode-name "Ugrep")
  (use-keymap *ugrep-mode-map*)
  (make-local-variable 'need-not-save)
  (setq need-not-save t)
  (make-local-variable 'auto-save)
  (setq auto-save nil)
  (run-hooks '*ugrep-mode-hook*))

(defvar *ugrep-mode-map* nil)
  (unless *ugrep-mode-map*
    (setq *ugrep-mode-map* (make-sparse-keymap))
    (define-key *ugrep-mode-map* #\F10 'ugrep-open-file-this)
    (define-key *ugrep-mode-map* #\F11 'ugrep-open-file-next)
    (define-key *ugrep-mode-map* #\F3 'scan-ugrepfile)
    (define-key *ugrep-mode-map* #\S-F3 'scan-ugrepfileR)
    (define-key *ugrep-mode-map* #\@ 'view-all-list))