;;; This file contains the functions associated with
;;; GLOBAL-FIND. Global-find searches in all the open buffers in your
;;; emacs session and collects either all files or all lines matching
;;; a given string. By default it limits the buffers to "useful" ones
;;; - see 'skip-global-regexps. In addition, if called with a prefix
;;; argument you are prompted for a regexp that must match all buffers
;;; to be included. For instance, by entering "\.c$" you can limit the
;;; search to just C files.
;;;
;;; This is a very useful package if you are trying to understand a
;;; program or module which includes several different files.
;;;
;;; The GLOBAL-FIND command creates a buffer with sections for each
;;; file containing the given string, and a line for each
;;; instance. The following keys are active in that buffer:
;;;
;;; UP: moves to the file preceeding the current one
;;; DOWN: moves to the file after the current one
;;; LEFT: moves to the previous matching line
;;; RIGHT: moves to the next matching line
;;; ^k: If cursor is on a line match delete that line; if on a file
;;;	    header delete all lines associated with that file
;;; RETURN: Visits the file at the current line
;;; q: deletes the *global-match* buffer
;;;
;;; Besides these, the buffer is set up in outline mode, so the
;;; display of lines can be suppressed easily. For convenience the
;;; important submode keys are mapped as follows:
;;;
;;; h: hide all line information (display only file information)
;;; a: show all line information
;;; s: show line information for the current file
;;; x: hide line information for the current file
;;;
;;; And globally, the following keys are defined:
;;;
;;; ^C-^F: do the GLOBAL-FIND command. If there is a command prefix
;;;    it prompts for a regexp to test all buffers with
;;; M-C-down: go to the next occurrence in the current buffer of a 
;;;    global-find target
;;; M-C-down: go to the previous occurrence in the current buffer of a 
;;;    global-find target
;;; C-g: Jump to the GLOBAL-FIND buffer
;;;
;;; Russell Young 2004
;;; www.young-0.com
(defvar skip-global-regexps '("^\\*" "^ " "TAGS" "~$")
  "Skip buffers matching these regexps")

(defvar global-search-buffer-name "*global-search*")

(defvar *global-start-collapsed* t
  "If true, do a COLLAPSE-SUBTREES before returning")

(make-variable-buffer-local '*global-matches*)
(make-variable-buffer-local '*global-match-string*)


(defun g-get-args (prefix) 
  (let* ((default (symbol-at-point))
		 (def-string (if default (format "%s" default) ""))
		 (string (read-from-minibuffer (concat "All occurrences of (default: " def-string "): ")))
		 (limit (if prefix (read-from-minibuffer "Limited to: (regexp) ") "")))
;    (and (equal string "")
;		 (error "Search string cannot be empty"))
    (list (if (equal string "") def-string string) limit)))

(defun good-buffer (b limit)
  "checks if a given buffer is 'interesting' to the GLOBAL-FIND command
This can be overridden with FLET to supply more specialized restrictions"
  (let* ((char0 (substring (buffer-name b) 0 1))
		 (file (buffer-file-name b)))
    (and file 
		 (notany (lambda (x) (string-match x file)) skip-global-regexps)
		 (string-match (or limit "") file)
		 b)))
			  
(defun nonblank (str) 
  (and str (not (equal str ""))))

(defun global-find (string &optional limit) 
  "Finds all occurrences of a given string in currently visited buffers
It opens up a buffer in outline mode that shows all files with matches, and expands
to show all matches. You can jump to each file or the line on each file by hitting 
return on the line giving that file or line.

Also, the commands M-C-up and M-C-down cycle through the most recent matches in 
each buffer"
  (interactive (g-get-args current-prefix-arg))
  (let* ((buffers (delete* nil (mapcar (lambda (x) (good-buffer x limit)) (buffer-list))))
		 (results (if (nonblank string) (delete* nil (mapcar (lambda (x) (look-for string x)) buffers))
					(delete* nil (mapcar 
								  (lambda (x) (list x (if (file-writable-p (buffer-file-name x)) "*" "%"))) 
								  buffers))))
		 )
	(if (not results) (message (format "No matches for '%s'%s" string (if (nonblank limit) (concat " in '" limit "'") "")))
	  (get-global-search-buffer)
	  (insert (format "Matches for %s %s\n     %s buffers match out of %s candidates%s\n\n"
					  string (if (nonblank limit) (concat "in buffers matching " limit) "")
					  (length results) (length buffers)
					  (if (nonblank limit) (format " matching '%s'" limit) "")))
	  (mapcar 'make-entry results)
	  (set-buffer global-search-buffer-name)
	  (goto-char 0)
	  (g-next-file)
	  (if *global-start-collapsed* (hide-sublevels 1))
	  )))

(defun make-entry (result) 
  "Enters the file name and all matching lines for a buffer for the GLOBAL-FIND command"
  (let ((buffer (car result))
		(writable (second result))
		(locs (third result)))
	(insert (format "\n-------------------------------------------------
Buffer %s %s (%s)\n"
					(buffer-name buffer) writable (length locs)))
	(mapcar (lambda (x) (g-do-one x buffer)) locs)))

(defun g-do-one (locs buffer) 
  "Enters a single instance of a match for the GLOBAL-FIND command"
  (let ((line (car locs))
		(loc (cdr locs)))
	(insert (format "\n   %s %s\n" line (line-at loc buffer)))))

(defun line-at (point &optional buffer) 
  "gets the line containing a given file position in a given buffer
BUFFER defaults to the currently selected  buffer"
  (save-excursion
	(if buffer (set-buffer buffer))
	(goto-char point)
	(beginning-of-line)
	(let ((start (point)))
	  (end-of-line)
	  (buffer-substring start (point)))))

(defun get-global-search-buffer ()
  "Switches to the Global Search buffer, creating it if necessary"
  (switch-to-buffer (get-buffer-create global-search-buffer-name))
  (use-local-map (setup-global-search-map))
  (outline-minor-mode 1)
  (setq outline-regexp "Buffer ")
  (erase-buffer))

(defun look-for (string buffer) 
  "Used by GLOBAL-FIND, this finds all occurrences of STRING in BUFFER
The return is nil if there are no occurrences, or a list of buffer, % or *
depending on whether the file visited by BUFFER is writable, and a list of
'(x . y) where X is the line number of a match and Y is the point position 
of the same match."
  (if buffer
	  (save-excursion
		(set-buffer buffer)
		(let ((results ())
			  (loc (point)))
		  (end-of-buffer)
		  (while (re-search-backward string nil t)
			(setq results (cons (cons (count-lines 1 (point)) (point)) results)))
		  (goto-char loc)
 		  (when results
			(setq *global-matches* results
				  *global-match-string* string)
			(list buffer (if (file-writable-p (buffer-file-name)) "*" "%") results))
		  )
		)
	)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Set up stuff for the mode and global keys
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(global-set-key '[?\C-c?\C-f] 'global-find)
(global-set-key '[?\C-c?g] 'g-show-global-buffer)
(global-set-key [\C-\M-up] 'g-prev-match)
(global-set-key [\C-\M-down] 'g-next-match)

(defun setup-global-search-map ()
  (let ((map (copy-keymap (current-global-map))))
    (suppress-keymap map t)
    (define-key map "q" 'bury-buffer)
    (define-key map '[return] 'g-move-to)
    (define-key map [up] 'g-prev-file)
    (define-key map [down] 'g-next-file)
    (define-key map "x" 'hide-subtree)
    (define-key map "s" 'show-subtree)
    (define-key map "a" 'show-all)
    (define-key map "h" 'hide-sublevels)
    (define-key map "r" 'rename-global-buffer)
	(define-key map '[?\C-k] 'g-kill-lines)
	(define-key map [left] 'g-prev-line)
	(define-key map [right] 'g-next-line)
	map
	))

(defun rename-global-buffer (name) 
  (interactive "Mnew buffer name: ")
  (if (> (length name) 1)
	  (rename-buffer name)))

(defun g-show-global-buffer ()
  "Jumps to the global search buffer"
  (interactive)
  (switch-to-buffer global-search-buffer-name))

(defun g-move-to ()
  "In the global search buffer, jump to the file on the given line"
  (interactive)
  (beginning-of-line)
  (let ((point (point))
		(line "0")
		file (line "0"))
    (if (looking-at " *\\([0-9]+\\)")
		(setq line (match-string 1)))
    (forward-line)
    (g-prev-file)
    (if (looking-at "Buffer \\(.+\\) [\\*%] ([0-9]+)$")
		(setq file (match-string 1)))
    (goto-char point)
    (switch-to-buffer (match-string 1))
    (goto-line (string-to-number line))))

(defun g-next-file ()
  "In the global search buffer, move to the next file containing matches"
  (interactive)
  (if (= 0 (forward-line 1))
      (if (not (re-search-forward "^Buffer" nil t))
	  (forward-line -1)))
  (beginning-of-line))

(defun g-prev-file ()
  "In the global search buffer, move to the previous file containing matches"
  (interactive)
  (beginning-of-line)
  (re-search-backward "^Buffer" nil t)
  (beginning-of-line))

(defun g-next-line ()
  "In the global search buffer, move to the next line giving a match"
  (interactive)
  (if (= 0 (forward-line 1))
      (if (not (re-search-forward "^   [1-9]" nil t))
	  (forward-line -1)))
  (beginning-of-line))

(defun g-prev-line ()
  "In the global search buffer, move to the previous line giving a match"
  (interactive)
  (beginning-of-line)
  (re-search-backward "^   [1-9]" nil t))

;;; for the ^K command
(defun g-kill-lines ()
  "In the global search buffer, kill the current line, and if it is a buffer name also kill all associated lines"
  (interactive)
  (beginning-of-line)
  (if (looking-at "^   [0-9]") (g-kill-line)
    (if (looking-at "^Buffer ") (g-kill-file)
      (g-next-line))))	; in case not on expected line

(defun g-kill-line () 
  (kill-line 2)
  (beginning-of-line 0)
  (g-next-line)
)

(defun g-kill-file-only ()
  (interactive)
  (if (looking-at "^Buffer ")
      (kill-line 1)
    (re-search-forward "Buffer " nil t)
    (beginning-of-line)))

(defun g-kill-file ()
  (re-search-backward "^----")
  (let* ((start (point))
	 (more (progn (forward-char) (re-search-forward "^---" nil t))))
    (if more (beginning-of-line) (end-of-buffer))
    (kill-region start (point))
    (if more (forward-line) (g-prev-file))))

;;; Following are for the forward and backward arrows in matched buffers

(defun g-next-match ()
  "Jump to the next occurrence of a match found by the GLOBAL-FIND command"
  (interactive)
  (let ((x *global-matches*)
		(count 1)
		(start (point))
		(ok nil))
	(while (and x (>= (point) (cdar x)))
	  (setq x (cdr x)
			count (1+ count)))
	(if x (progn (goto-char (cdar x))
				 (setq ok (looking-at *global-match-string*))))
	(if ok 
		(message (format "%s of %s occurrences of '%s'" count (length *global-matches*) *global-match-string*))
	  (g-next-match-2 start x))))

(defun g-next-match-2 (start x)
  (goto-char (1+ start))
  (if (not (re-search-forward *global-match-string* nil t))
	  (progn (backward-char)
			 (if x	(message (format "Buffer changed, cannot find another instance of '%s'" *global-match-string*))
			   (message "No more instances")))
	(goto-char (match-beginning 0))
	(message (format "buffer changed, found next instance of '%s'" *global-match-string*))))


(defun g-prev-match ()
  "Jump to the previous occurrence of a match found by the GLOBAL-FIND command"
  (interactive)
  (let ((x *global-matches*)
		(count 0)
		(start (point))
		(prev nil))
	(while (and x (> (point) (cdar x)))
	  (setq	prev (car x)
			x (cdr x)
			count (1+ count)))
	(if (or (not prev) (< (point) (cdr prev))) (message (concat "No more occurrences of '" *global-match-string* "'"))
	  (goto-char (cdr prev))
	  (if (looking-at *global-match-string*)
		  (message (format "%s of %s occurrences of '%s'" count (length *global-matches*) *global-match-string*))
		(if (re-search-backward *global-match-string* nil t)
			(message "Buffer changed, found preceding occurrence")
		  (message "no more occurrences"))))))

(provide 'global-find)