; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         glimpse.el
; RCS:          $Header: /users/darrylo/.repository/mh-e/glimpse.el,v 1.1 1998/07/23 22:31:58 darrylo Exp $
; Description:  Very low-level interface to glimpse
; Author:       Darryl Okahata
; Created:      Tue Jun 23 18:29:46 1998
; Modified:     Thu Jul 16 14:35:51 1998 (Darryl Okahata) darrylo@sr.hp.com
; Language:     Emacs-Lisp
; Package:      N/A
; Status:       Experimental
;
; (C) Copyright 1998, Hewlett-Packard, all rights reserved.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defvar glimpse-cmd "glimpse"
  "The name of the glimpse executable.
Exists for completeness.  The vast majority of users have no reason to
change this.")


(defvar glimpse-indent-prefix "   "
  "If output reformatting is being done, this is the indent prefix for each line.")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Variables past this point are glimpse.el internal variables.
;; Do not change anything past this point.
;;

(defvar glimpse-reformat-files nil
  "Non-nil if the glimpse output should be reformatted to be more
human-readable.")
(make-variable-buffer-local 'glimpse-reformat-files)


(defvar glimpse-window-config nil
  "The window configuration before the glimpse search was done.")
(make-variable-buffer-local 'glimpse-window-config)


(defvar glimpse-search-start-hooks nil
  "Hook to run when the glimpse-search function is called.
WARNING: do not set this hook directly.  Instead, pass the desired hook
function to the `glimpse-search' function.")
(make-variable-buffer-local 'glimpse-search-start-hooks)


(defvar glimpse-search-attempt-hooks nil
  "Hook to run each time the glimpse program is run.
This is different from `glimpse-search-start-hooks' in that
`glimpse-search-start-hooks' are called once when `glimpse-search' is
initially called, but this hook is called each time glimpse is run.
Note that glimpse can be run multiple times when `glimpse-search' is
called.
WARNING: do not set this hook directly.  Instead, pass the desired hook
function to the `glimpse-search' function.")
(make-variable-buffer-local 'glimpse-search-attempt-hooks)


(defvar glimpse-new-file-hooks nil
  "Hook to run when a new matching file is encountered.
If glimpse finds matches, glimpse will output a line with a filename.
This hook is called whenever a \"new\" filename (one not already seen)
is encountered.")
(make-variable-buffer-local 'glimpse-new-file-hooks)


(defvar glimpse-output-offset-hooks nil
  "Hook to call for each line that glimpse outputs.")
(make-variable-buffer-local 'glimpse-output-offset-hooks)


(defvar glimpse-search-done-hooks nil
  "Hook to call when all glimpse searches have completed.")
(make-variable-buffer-local 'glimpse-search-done-hooks)


(defvar glimpse-current-index-directory nil
  "The current glimpse index directory.
Hooks can query this variable for the name of the glimpse index directory.")
(make-variable-buffer-local 'glimpse-current-index-directory)


(defvar glimpse-last-file nil
  "Filename contained in the previous line output by glimpse.
Used to tell when a new file is encountered, so that the
`glimpse-new-file-hooks' can be called.")
(make-variable-buffer-local 'glimpse-last-file)


(defvar glimpse-process nil
  "The glimpse process being used.")
(make-variable-buffer-local 'glimpse-process)


(defvar glimpse-process-args nil
  "Additional arguments passed to the glimpse process.")
(make-variable-buffer-local 'glimpse-process-args)


(defvar glimpse-output nil
  "Output received from the glimpse process.
This variable is used to reassemble lines from the glimpse process (XEmacs
does not guarantee that whole lines are passed to process filters).")
(make-variable-buffer-local 'glimpse-output)


(defvar glimpse-strip-regexp nil
  "A regular expression used to trim glimpse filenames.")
(make-variable-buffer-local 'glimpse-strip-regexp)


(defvar glimpse-stripped-directory nil
  "The directory stripped from glimpse filenames.
Hooks can query this variable to examine the stripped directory.")
(make-variable-buffer-local 'glimpse-stripped-directory)


(defvar glimpse-search-directories nil
  "The list of remaining glimpse index directories to search.")
(make-variable-buffer-local 'glimpse-search-directories)


(defun glimpse-process-filter (process output)
  "The main glimpse process filter."
  (let ( (old-buffer (current-buffer)) )
;    (display-buffer (process-buffer process))
    (unwind-protect
	(progn
	  (set-buffer (process-buffer process))
	  ;; Make buffer-read-only nil
	  (let (buffer-read-only line file moving
				 new-file-hook-point offset-hook-point)
	    (setq moving (= (point) (process-mark process)))
	    (save-excursion
	      (goto-char (process-mark process))
	      ;; Get the output thus far ...
	      (if glimpse-output
		  (setq glimpse-output (concat glimpse-output output))
		(setq glimpse-output output))
	      ;; Slice and dice it into lines.
	      ;; While there are whole lines left ...
	      (while (and glimpse-output
			  (string-match "\\([^\n]+\n\\)\\(\\(.\\|\n\\)*\\)"
					glimpse-output))
		(setq new-file-hook-point		nil
		      offset-hook-point			nil
		      file				nil
		      glimpse-stripped-directory	nil
		      )
		;; Get a line
		(setq line (substring glimpse-output
				      (match-beginning 1) (match-end 1)))
		(setq glimpse-output (substring glimpse-output
						(match-beginning 2)
						(match-end 2)))
		(if (= (length glimpse-output) 0)
		    (setq glimpse-output nil))
		;; If we are supposed to strip off the first part of a line ...
		(if glimpse-strip-regexp
		    (progn
		      (if (string-match glimpse-strip-regexp line)
			  (progn
			    (setq glimpse-stripped-directory
				  (substring line
					     (match-beginning 1)
					     (match-end 1))
				  line (substring line
						  (match-beginning 2)
						  (match-end 2)))
			    ))
		      ))
		;; This should always match (a filename followed by a colon
		;; followed by the rest of the line).
		(if (string-match "^\\([^:\n]+\\): \\(.*\n\\)" line)
		    (progn
		      (setq file (substring line
					    (match-beginning 1) (match-end 1)))
		      (setq line (substring line
					    (match-beginning 2) (match-end 2)))
		      ;; If we are to reformat the output to make it look
		      ;; pretty ...
		      (if glimpse-reformat-files
			  (progn
			    ;; If the current file is the same as the previous
			    ;; one ...
			    (if (and glimpse-last-file
				     (string= file glimpse-last-file))
				(progn
				  ;; ... setup for calling the new-line
				  ;; hook ...
				  (setq offset-hook-point (point))
				  ;; ... and insert the line, with the
				  ;; appropriate indentation.
				  (insert glimpse-indent-prefix line)
				  )
			      (progn
				;; The current file is different.

				;; Insert a separating blank line if
				;; necessary.
				(if glimpse-last-file
				    (insert "\n"))
				;; Setup for calling the new-file hook
				(setq new-file-hook-point (point))
				;; Insert the file name
				(insert file ":\n")
				;; followed by the line (sans file name),
				;; with the appropriate indentation.
				(insert glimpse-indent-prefix line)
				;; Setup for calling the new-line hook.
				(setq offset-hook-point (point))
				))
			    )
			(progn
			  ;; Raw glimpse output.
			  ;; Setup for calling both the new-file hook and
			  ;; the new-line hook.
			  (setq new-file-hook-point (point))
			  (setq offset-hook-point new-file-hook-point)
			  ;; Just insert the line.
			  (insert line)
			  ))
		      (setq glimpse-last-file file)
		      ;; If we're supposed to call the new-file hook ...
		      (if (and new-file-hook-point glimpse-new-file-hooks)
			  (progn;; do so
			    (set-marker (process-mark process) (point))
			    (goto-char new-file-hook-point)
			    (let (buffer-read-only)
			      (run-hooks 'glimpse-new-file-hooks))
			    (goto-char (process-mark process))
			    ))
		      ;; If we're supposed to call the new-line hook ...
		      (if (and offset-hook-point glimpse-output-offset-hooks)
			  (progn;; do so
			    (set-marker (process-mark process) (point))
			    (goto-char offset-hook-point)
			    (let (buffer-read-only)
			      (run-hooks 'glimpse-output-offset-hooks))
			    (goto-char (process-mark process))
			    ))
		      )
		  (progn
		    (insert line)
		    ))
		)
	      (set-marker (process-mark process) (point))
	      )
	    (if moving
		(goto-char (process-mark process)))
	    (set-buffer-modified-p nil)
	    ))
      (set-buffer old-buffer))
    ))


(defun glimpse-process-sentinel (process event)
  "The glimpse process sentinel.
This either starts the next glimpse search (if there are more glimpse
index directories to search), or calls the `glimpse-search-done-hooks'."
  (let (buffer)
    (save-excursion
      (setq buffer (process-buffer process))
      (set-buffer buffer)
      (delete-process process)
      (setq glimpse-process nil
	    glimpse-current-index-directory nil)
      (if glimpse-search-directories
	  (progn
	    (glimpse-search-internal (car glimpse-search-directories) buffer)
	    (setq glimpse-search-directories (cdr glimpse-search-directories))
	    )
	(progn
	  (goto-char (point-max))
	  (let (buffer-read-only)
	    (run-hooks 'glimpse-search-done-hooks))
	  (set-buffer-modified-p nil)
	  ))
      )))


(defun glimpse-kill-process ()
  "Kill the current glimpse search process."
  (interactive)
  (progn
    (if glimpse-process
	(progn
	  (kill-process glimpse-process)
	  (setq glimpse-search-directories nil)
	  )
      (error "No glimpse search in progress"))
    ))


(defun glimpse-hide-buffer ()
  "Hide the current glimpse search buffer"
  (interactive)
  (let ()
    (bury-buffer (current-buffer))
    (if glimpse-window-config
	(set-window-configuration glimpse-window-config))
    ))


(defun glimpse-search-internal (directory buffer)
  "Start a new glimpse search.
Used internally."
  (let ()
    (setq glimpse-output nil)
    (setq glimpse-current-index-directory directory)
    (let (buffer-read-only)
      (run-hooks 'glimpse-search-attempt-hooks))
    (setq glimpse-process (apply 'start-process "glimpse" buffer
				 glimpse-cmd
				 "-H" directory
				 glimpse-process-args
				 ))
    (set-process-filter glimpse-process 'glimpse-process-filter)
    (set-process-sentinel glimpse-process 'glimpse-process-sentinel)
    (set-marker (process-mark glimpse-process) (point-max))
    (process-kill-without-query glimpse-process)
    ))


(defun glimpse-search (directory words outbuf &optional
				 number-errors partial-words words-whole-file
				 case-sensitive limits no-erase-outbuf
				 glimpseserver
				 strip-prefix reformat-files 
				 search-start-hooks
				 search-attempt-hooks
				 file-hooks
				 output-offsets-hooks
				 search-done-hooks
				 )
  "Main function to perform an asynchronous glimpse search.
This is a monstrous, low-level function that initiates a glimpse search.
All functionality is provided by callbacks.  Note that calling this function
only initiates a glimpse search; all of the work is done by callbacks
called from the idle loop (or when `accept-process-output' is called).

Required arguments:

    directory -- The name of the directory containing the glimpse index
		files.  This can be a list, in which case multiple glimpse
		searches are made, once for each index directory.

    words -- The word(s) to search.  This is a string that contains words
		separated either by spaces or by a semicolon.

    outbuf -- The buffer in which the glimpse output is to be inserted.
		This buffer is erased before the output is inserted,
		unless `no-erase-outbuf' is non-nil.  Note that this
		buffer has all local variables killed, and that the
		buffer-modified flag is always cleared.

Optional arguments:

    number-errors -- The maximum number of allowed spelling errors (0-8)
		for each word.  The default is zero (for convenience, `nil'
		is equivalent to zero).

    partial-words -- If non-nil, allow partial-word matches.  If `nil'
		(the default), words must match exactly.

    words-whole-file -- If non-nil, the words are allowed to occur anywhere
		within a file, and not just on the same line.  If `nil'
		(the default) all of the words must occur on the same line.

    case-sensitive -- If non-nil, searches are case-sensitive; if `nil'
		(the default), searches are case-insensitive.  Note that
		this is backwards from the glimpse default (searches are
		case-sensitive).

    limits -- Search limits (a string) for the glimpse search.
		This can be `nil', in which case there will be no
		limits.  If search limits are to be used, this is the
		search limits, as a string, for the \"-L\" option to
		glimpse.  This string must be one of the forms:

		    x
		    x:y
		    x:y:x

		From the glimpse manpage (edited):

		    If one number (\"x\") is given, it is a limit on the
		    total number of matches.  Glimpse outputs only the
		    first x matches.  If two numbers are given (x:y), then
		    y is an added limit on the total number of files.  If
		    three numbers are given (x:y:z), then z is an added
		    limit on the number of matches per file.  If any of
		    the x, y, or z is set to 0, it means to ignore it (in
		    other words 0 = infinity in this case); for example,
		    0:10 will output all matches to the first 10 files
		    that contain a match.  This option is particularly
		    useful for servers that needs to limit the amount of
		    output provided to clients.

    no-erase-outbuf -- If non-nil, don't erase the output buffer before
		initiating a glimpse search.

    glimpseserver -- If non-nil, connect to a glimpseserver to do the
		searching.  If this is also a number, this is the port
		number of the server to use.

    strip-prefix -- If specified (a string), this is the directory prefix to
		strip off glimpse output.  This is useful for
		stripping off a common directory name from filenames
		output by glimpse.

    reformat-files -- If non-nil, the output from glimpse will be
		reformatted to make it more human readable:

		* The leading filename will be stripped from each line.

		* The filename will be displayed once for each group
		  of matches, and will be displayed on a line by
		  itself, followed by a colon.  The filename will also
		  not be indented.

		* Matches will be displayed indented by
		  `glimpse-indent-prefix'.

    search-start-hooks -- An hook to call once, just before the
		glimpse searches begin.  This hook can be useful for
		displaying a message in the buffer or modeline, or for
		initializing variables needed by the following hooks.

    search-attempt-hooks -- An hook that is called just before each
		invocation of glimpse.

		Note that `search-start-hooks' is called once, but
		`search-attempt-hooks' is called for each invocation
		of glimpse.  This hook is generally used to setup
		variables needed by the following hooks.

    file-hooks -- An hook that is called each time a new file is
		referenced in the glimpse output.  When this hook is
		called, `outbuf' is the current buffer, and `point' is
		at the beginning of the line, pointing to the new
		filename (caution: note that the filename is followed
		by a colon).

		This hook can reference the `glimpse-last-file' and
		`glimpse-stripped-directory' (if `strip-prefix' is
		used) variables.

		This hook is useful for highlighting the filename.

    output-offsets-hooks -- An hook that is called each time glimpse
		outputs a match line.  When this hook is called,
		`outbuf' is the current buffer, and `point' is at the
		beginning of the line.  Note that the line includes
		`glimpse-indent-prefix' if `reformat-files' is
		non-nil.

		This hook can reference the `glimpse-last-file' and
		`glimpse-stripped-directory' (if `strip-prefix' is
		used) variables.

    search-done-hooks -- An hook that is called when all glimpse
		searches have been completed.  This hook can be useful
		for displaying a message in the buffer or modeline.

"
  (let ()
    (save-excursion
      (setq outbuf (get-buffer-create outbuf))
      (set-buffer outbuf)
      (buffer-disable-undo outbuf)
      (setq glimpse-window-config (current-window-configuration))
      (if glimpse-process
	  (error "Glimpse search still in progress!"))
      (if (not no-erase-outbuf)
	  (let (buffer-read-only)
	    (erase-buffer)
	    (set-buffer-modified-p nil)
	    ))
      (kill-all-local-variables)
      (local-set-key "\C-c\C-c" 'glimpse-kill-process)
      (local-set-key "q" 'glimpse-hide-buffer)
      (local-set-key "e" 'glimpse-hide-buffer)
      (local-set-key "x" 'glimpse-hide-buffer)
      (setq glimpse-reformat-files		reformat-files
	    glimpse-last-file			nil
	    glimpse-search-start-hooks		search-start-hooks
	    glimpse-search-attempt-hooks	search-attempt-hooks
	    glimpse-new-file-hooks		file-hooks
	    glimpse-output-offset-hooks 	output-offsets-hooks
	    glimpse-search-done-hooks		search-done-hooks)
      (if strip-prefix
	  (setq glimpse-strip-regexp
		(concat "^\\(" (regexp-quote
			     (file-name-as-directory strip-prefix))
			"\\)\\(.+\n\\)"))
	(setq glimpse-strip-regexp nil))
      (while (string-match "[ \t]+" words)
	(setq words (replace-match ";" nil t words)))
      (while (string-match ";;+" words)
	(setq words (replace-match ";" nil t words)))
      (setq glimpse-process-args (list "-y" words))
      (if (stringp number-errors)
	  (setq number-errors (string-to-int number-errors)))
      (if (and (numberp number-errors)
	       (>= number-errors 1)
	       (<= number-errors 8))
	  (setq glimpse-process-args (cons (format "-%d" number-errors)
					   glimpse-process-args)))
      (if (not partial-words)
	  (setq glimpse-process-args (cons "-w" glimpse-process-args)))
      (if words-whole-file
	  (setq glimpse-process-args (cons "-W" glimpse-process-args))) 
      (if (not case-sensitive)
	  (setq glimpse-process-args (cons "-i" glimpse-process-args)))
      (if output-offsets-hooks
	  (setq glimpse-process-args (cons "-q" glimpse-process-args)))
      (if glimpseserver
	  (progn
	    (cond
	     ( (numberp glimpseserver)
	       (setq glimpse-process-args
		     (cons "-K" (cons (int-to-string glimpseserver)
				      glimpse-process-args))))
	     ( (stringp glimpseserver)
	       (setq glimpse-process-args
		     (cons "-K" (cons glimpseserver
				      glimpse-process-args))))
	     )
	    (setq glimpse-process-args (cons "-C" glimpse-process-args))
	    ))
      (if limits
	  (setq glimpse-process-args (cons "-L" (cons limits
						      glimpse-process-args))))

      (goto-char (point-max))
      (let (buffer-read-only)
	(run-hooks 'glimpse-search-start-hooks))
      (set-buffer-modified-p nil)

      (if (listp directory)
	  (progn
	    (setq glimpse-search-directories (cdr directory))
	    (glimpse-search-internal (car directory) outbuf)
	    )
	(progn
	  (glimpse-search-internal directory outbuf)
	  ))
      glimpse-process
      )))


(provide 'glimpse)
