;;;        Grope, a GUI grope
;;;               or
;;;           etags-lite
;;; (great search! less overhead!)

(require 'dired-faces)

(defvar grope-program "grep")

;; Optimized for GNU grep 2.4.2, YMMV
(defvar grope-insensitive-flag "--ignore-case")
(defvar grope-line-number-flag "--line-number")
(defvar grope-invert-flag "--invert-match")

(defvar grope-default-flags
  (list grope-line-number-flag
	"--directories=skip"
	"--with-filename"
	))

(defconst grope-buffer-name "*Grope Output*")
(defconst grope-matches-regexp "^\\([^:]+\\)+:\\([0-9]+\\):\\(.*\\)$")

(defvar grope-keymap (make-sparse-keymap 'grope-keymap))
(define-key grope-keymap [q] 'grope-quit)
(define-key grope-keymap [button2] 'grope-goto)
(define-key grope-keymap [return] 'grope-goto)


(defun grope-buffer ()
  (let ((gb (get-buffer grope-buffer-name)))
    (if gb
	(save-excursion
	  (set-buffer gb)
	  (setq buffer-read-only nil)
	  gb)
      (let ((gb (get-buffer-create grope-buffer-name)))
	(use-local-map grope-keymap gb)
	gb))))


(defun grope-quit ()
  (interactive)
  (kill-buffer nil))


(defun grope-goto ()
  (interactive)
  (let* ((where last-input-event)
	 (here (extent-at (if (button-release-event-p where)
			      (event-closest-point where)
			    (point))
			  (current-buffer)
			  'grope-to-file))
	 (file (extent-property here 'grope-to-file))
	 (line (extent-property here 'grope-to-line))
	 (buffer (find-file-noselect file)))
    (save-excursion
      (set-buffer buffer)
      (goto-char (point-min))
      (forward-line (- line 1)))
    (switch-to-buffer buffer)))
	 

(defun grope-do-grep (regexp files nocase invert)
  (let ((buffer (grope-buffer))
	(args (append grope-default-flags
		      (and nocase grope-insensitive-flag)
		      (and invert grope-invert-flag)
		      (list regexp)
		      files)))
    (erase-buffer buffer)
    (message "groping: %s" args)
    (list (apply 'call-process grope-program nil buffer nil args)
	  buffer)
    ))


(defun grope-grope-grep (status buffer)
  (and (eq status 0)
       (save-excursion
	 (set-buffer buffer)
	 (goto-char (point-min))
	 (let ((matches nil))
	   (while (re-search-forward grope-matches-regexp nil t)
	     (let ((file (match-string 1))
		   (line (read (match-string 2)))
		   (text (match-string 3)))
	       (message "match: %s, %s, %s" file line text)
	       (setq matches (cons (list file line text)
				   matches))))
	   (nreverse matches)))))


(defun grope-show-match (root file line text)
  (let* ((root-loc (string-match root file ))
	 (shown-name (if (eq 0 root-loc) (substring file (match-end 0)) file))
	 (start (point)))
    (insert (format "%s: %s" shown-name text))
    (message "showing match: %s, %s, %s" file line text)
    (let ((match-extent (make-extent start (point))))
      (insert "\n")
      (set-extent-properties match-extent
			     `(pointer  ,nontext-pointer-glyph
			       duplicable  ,nil
			       keymap ,grope-keymap
			       highlight t
			       grope-to-line ,line
			       grope-to-file ,file)))
    ))
    
  

(defun grope-build-buffer (matches buffer)
  (let ((root (file-name-directory (buffer-file-name))))
    (save-excursion
      (set-buffer buffer)
      (erase-buffer buffer)
      (mapcar (lambda (m) (apply 'grope-show-match root m)) matches)
      (goto-char (point-min))
      (set-buffer-modified-p nil)
      (toggle-read-only)
      )))


(defun grope-expand-files (root text)
  (with-temp-buffer
    (insert text)
    (insert " ")
    (goto-char (point-min))
    (let ((all-files nil))
      (while (re-search-forward "[ \t\n]+" nil t)
	(save-restriction
	  (narrow-to-region (point-min) (match-beginning 0))
	  (let ((orig-pattern
		 (buffer-substring (point-min)
				   (match-beginning 0))))
	    (save-match-data
	      (goto-char (point-min))
	      ; convert glob to regex, still need to do {xx,yy}
	      (catch 'eob
		(while (re-search-forward "[.* ]\\|$" nil t)
		  (goto-char (match-beginning 0))
		  (cond ((looking-at "\\.") (insert "\\"))
			((looking-at "\\*") (insert "."))
			((looking-at " ") (insert "$"))
			((looking-at "$") (insert "$")))
		  (and (equal (point) (point-max)) (throw 'eob nil))
		  (forward-char 1)
		  )))
	    (message "expanding: %S" (buffer-substring))
	    (let ((files (directory-files root
					  t
					  (buffer-substring)
					  nil
					  t)))
	      (setq all-files (append (or files (list orig-pattern)))))))
	(goto-char (match-end 0)))
      all-files)))


(defun grope-gui (regexp glob &optional flags)
  (interactive "sregexp: \nsfile(s): \np")
  (let* ((buffer (grope-buffer))
	(root (file-name-directory (buffer-file-name)))
	(matches (apply 'grope-grope-grep
			(grope-do-grep regexp
				       (grope-expand-files root glob)
				       nil nil))))
    (grope-build-buffer matches buffer)
    (switch-to-buffer-other-window buffer)
    ))


(provide 'grope)