2009/03/22

Common Lisp で rgerp しようとした scratch

またそのうちちゃんとしよう。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-fad)
(require :cl-ppcre))

(setf *ed-functions*
(list (lambda (x)
(asdf:run-shell-command "emacsclient -n ~a" x))))

(defun ensure-pathname (x)
(typecase x
(pathname x)
(string
(parse-namestring
(if (char= #\~ (char x 0))
(concatenate 'string (namestring (user-homedir-pathname))
(subseq x 2))
x)))))

(defclass grep-result ()
((pathname :initarg :pathname :accessor pathname-of)
(line-number :initarg :line-number :accessor line-number-of)
(line :initarg :line :accessor line-of)
(base-dif :initarg :base-dir :accessor base-dir-of)))

(defmethod relative-path ((x grep-result))
(concatenate 'string "./"
(enough-namestring (pathname-of x) (base-dir-of x))))

(defmethod print-object ((x grep-result) stream)
(format stream "~a:~a:~a"
(relative-path x) (line-number-of x) (line-of x)))


(defun grep-file (pattern file dir)
(with-open-file (in file)
(loop for line = (read-line in nil)
for i from 1
while line
if (cl-ppcre:scan pattern line)
collect (make-instance 'grep-result
:pathname file
:line-number i
:line line
:base-dir dir))))

(defun rgrep (&optional pattern dir filter)
(unless pattern
(write-string "pattern: " *query-io*)
(setf pattern (read-line *query-io*))
(write-string "dir: " *query-io*)
(setf dir (read-line *query-io*))
(write-string "filter: " *query-io*)
(setf filter (read-line *query-io*)))
(let (result
(dir (ensure-pathname dir)))
(apply #'cl-fad:walk-directory
dir
(lambda (file)
(handler-case (setf result
(nconc result (grep-file pattern file dir)))
(error (e)
(format *error-output* "~a" e))))
(when filter
(list :test (lambda (file)
(cl-ppcre:scan filter (namestring file))))))
(format t "-*- mode: grep; default-directory: \"~a\" -*-~&"
dir)
(loop for i in result
do (format t "~a~&" i))
result))

(rgrep "defmacro|defun"
"~/letter/lisp/try/"
"\\.lisp$")

;;(ed (ensure-pathname "~/.emacs"))

2 件のコメント:

g000001 さんのコメント...

これは面白いですね!

grepで思い出したんですが、TAOにはgrepがあるんですよね(*'-')
http://www.nue.org/nue/tao-manual/tao-g.txt
便利なものはなんでも取り込むって感じで面白いです。

Yoshinori Tahara さんのコメント...

さすが TAO ですね。
「pattern には、 *, %, + 等のような正規表現」この中の % が気になります。。。独自の正規表現なんでしょうか。