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"))