; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         glimpse-mh-e.el
; RCS:          $Header: /users/darrylo/.repository/mh-e/glimpse-mh-e.el,v 1.1 1998/07/23 22:31:58 darrylo Exp $
; Description:  MH-E interface to glimpse
;		Uses glimpse.el.
; Author:       Darryl Okahata
; Created:      Tue Jun 23 17:10:41 1998
; Modified:     Wed Jul 22 21:17:47 1998 (Darryl Okahata) darrylo@sr.hp.com
; Language:     Emacs-Lisp
; Package:      N/A
; Status:       Experimental
;
; (C) Copyright 1998, Hewlett-Packard, all rights reserved.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This is an experimental MH-E interface to glimpse.
;;
;; Currently, there is no code in this module for creating the glimpse
;; indices for the MH mail folders.  However, a shell script and a
;; perl script is provided to create the index.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(require 'glimpse)
(require 'mh-e)


(defvar glimpse-mh-glimpseserver nil
  "Non-nil, if a glimpseserver is to be used.
This can also be a number or a string representing a number, in which case
this is the port number of the glimpseserver to use.")


(defvar glimpse-mh-search-limits "0:100:25"
  "Search limits 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.
")


(defvar glimpse-mh-display-search-progress 'modeline
  "Method for displaying the name of the current folder being
searched.  Must be one of `nil', `buffer', `modeline', or `both'.  If
`buffer', the search progress is constantly displayed near the
beginning of the search buffer.  If `modeline', the search progress is
displayed in the modeline.  If `both', the search progress is
displayed in both the buffer and the modeline.  Setting this to `nil'
suppresses the search progress, and is useful for slow modem
connections or for when many small folders are searched.")


(defvar glimpse-mh-index-directory-prefix (progn
					    (if (not mh-user-path)
						(mh-find-path))
					    (concat 
					     (file-name-as-directory mh-user-path)
					     ".glimpse")
					    )
  "The glimpse index directory prefix.
This is the pathname to the top-level glimpse index directory.  For
example, if the mh mail path is \"/home/jdoe/Mail/\", which includes
folders like \"/home/jdoe/Mail/inbox/\" and \"/home/jdoe/Mail/drafts/\",
the top-level glimpse index directory is typically
\"/home/jdoe/Mail/.glimpse/\" (for compatibility with exmh).  Below this
directory, the glimpse indices for the various folders are stored (in
directories like \"/home/jdoe/Mail/.glimpse/inbox/\" and
\"/home/jdoe/Mail/.glimpse/drafts/\".")


(defvar glimpse-mh-do-sanity-checks t
  "Do extra sanity checks, for novice users, if non-nil.")


(defvar glimpse-mh-header-bytes 4096
  "The number of bytes to read when when searching a message's header.
Typically used for locating the subject of a message.  This many bytes
is read from the beginning of a message, when searching for message
header lines (e.g., \"From:\", \"To:\", etc.).  This is used to limit
the number of bytes read, as some messages can be many megabytes in
length.")

(defvar glimpse-mh-outbuf "*glimpse-mh*"
  "Buffer in which to display the search results.")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; End of user-settable variables.
;;
;; Internal glimpse-mh-e variables.  Not user settable.
;;
;; Do not change anything below this point.
;;


(defvar glimpse-mh-index-directory-regexp
  (concat "^"
	  (regexp-quote (file-name-as-directory
			 glimpse-mh-index-directory-prefix))
	  "\\(.+\\)")
  "Regexp to extract a folder name, given an glimpse index directory.")


(defvar glimpse-mh-status-marker nil
  "Marker used to update search status in the search results buffer.")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun glimpse-mh-search-done-callback ()
  (let ()
    ;; Display something in the search results buffer, to tell the user that
    ;; the search is done.
    (insert "\n----- Search Complete -----\n")

    ;; If the user wants status display ...
    (if glimpse-mh-display-search-progress
	(save-excursion

	  ;; Display status in the buffer, if the user requests it ...
	  (if (and glimpse-mh-status-marker
		   (or (eq glimpse-mh-display-search-progress 'buffer)
		       (eq glimpse-mh-display-search-progress t)))
	      (progn
		(goto-char glimpse-mh-status-marker)
		(end-of-line)
		(delete-region glimpse-mh-status-marker (point))
		(insert "Status: Search complete.")
		(setq glimpse-mh-status-marker nil)
		))

	  ;; Display status in the modeline, if the user requests it ...
	  (if (or (eq glimpse-mh-display-search-progress 'modeline)
		  (eq glimpse-mh-display-search-progress t))
	      (progn
		(setq modeline-process ": Search complete")
		))
	  ))
    ))


(defvar glimpse-mh-search-keymap
  (let ((m (make-sparse-keymap)))
    (set-keymap-name m 'glimpse-mh-search-keymap)
    (if (string-match "XEmacs" emacs-version)
	(progn
	  (define-key m 'button2 'glimpse-mh-show-message-event)
	  (define-key m 'button3 'glimpse-mh-show-message-event)
	  (define-key m [return] 'glimpse-mh-show-message-key)
	  ))
    m)
  "The keymap used for the highlighted messages in the results buffer.")


(defun glimpse-mh-show-message (folder msgnum)
  "Given a folder and message number, display that message to the user."
  (progn
    ;; This causes Rube Goldbergian flashing light display, but this
    ;; code is easy to write.
    (mh-visit-folder (concat "+" folder))
    (mh-goto-msg msgnum)
    (mh-show-msg msgnum)
    ))


(defun glimpse-mh-show-message-key ()
  (interactive)
  (let* ( (extent (extent-at (point) (current-buffer) 'glimpse-mh-e))
	  (folder (extent-property extent 'glimpse-mh-e-folder))
	  (msgnum (extent-property extent 'glimpse-mh-e-msgnum))
	 )
    (glimpse-mh-show-message folder msgnum)
    ))


(defun glimpse-mh-show-message-event (event)
  (interactive "e")
  (let* ( (ep (event-point event))
	  (buffer (window-buffer (event-window event)))
	  (extent (extent-at ep buffer 'glimpse-mh-e))
	  (folder (extent-property extent 'glimpse-mh-e-folder))
	  (msgnum (extent-property extent 'glimpse-mh-e-msgnum))
	  )
    (glimpse-mh-show-message folder msgnum)
    ))


(defun glimpse-mh-next-folder-callback ()
  "Called when glimpse searches a new glimpse index directory.
Here, we use it to update the display of the current folder being searched."
  (let (folder)
    ;; If the user wants to see ongoing status ...
    (if (and glimpse-mh-display-search-progress
	     ;; Extract the folder name, from the current glimpse index
	     ;; directory.
	     (string-match glimpse-mh-index-directory-regexp
			   glimpse-current-index-directory))
	(save-excursion
	  ;; Get the folder name
	  (setq folder (substring glimpse-current-index-directory
				  (match-beginning 1) (match-end 1)))

	  ;; Update the buffer, if desired.
	  (if (and glimpse-mh-status-marker
		   (or (eq glimpse-mh-display-search-progress 'buffer)
		       (eq glimpse-mh-display-search-progress t)))
	      (progn
		(goto-char glimpse-mh-status-marker)
		(end-of-line)
		(delete-region glimpse-mh-status-marker (point))
		(insert (format "Status: Searching folder: %s" folder))
		))

	  ;; Update the modeline, if desired.
	  (if (or (eq glimpse-mh-display-search-progress 'modeline)
		  (eq glimpse-mh-display-search-progress t))
	      (progn
		(setq modeline-process (concat ": " folder))
		))
	  ))
    ))


(defun glimpse-mh-new-file-callback ()
  "Called whenever glimpse detects a search result that refers to a new file.
Basically, when glimpse outputs a search result, this callback is called
whenever the search result refers to a file that is different from the
previous search result.  Here, this function is used to extract the subject
from the referenced message, and insert the subject next to the file name."
  (let ()
    ;; Mark the folder/message number so that it becomes a
    ;; clickable/highlighted area.
    (if (looking-at "\\(.+\\)[/\\]\\([^/\\\n]+\\)[ \t]*:")
	(let (folder msgnum b e extent)
	  (setq b (match-beginning 1)
		e (match-end 2)
		folder (buffer-substring (match-beginning 1)
					 (match-end 1))
		msgnum (string-to-int
			(buffer-substring (match-beginning 2)
					  (match-end 2)))
		)
	  (setq extent (make-extent b e))
	  (set-extent-face extent 'bold)
	  (set-extent-property extent 'highlight t)
	  (set-extent-property extent 'glimpse-mh-e t)
	  (set-extent-property extent 'glimpse-mh-e-folder folder)
	  (set-extent-property extent 'glimpse-mh-e-msgnum msgnum)
	  (set-extent-property extent 'keymap glimpse-mh-search-keymap)
	  ))

    ;; Extract the subject from the folder/message, and add it to the
    ;; search results buffer.
    (if glimpse-stripped-directory
	(let (file subject (tmpbuf " *gtmp*"))
	  (setq file (concat (file-name-as-directory
			      glimpse-stripped-directory)
			     glimpse-last-file))
	  (setq tmpbuf (get-buffer-create tmpbuf))
	  (save-excursion
	    (set-buffer tmpbuf)
	    (let ( (case-fold-search t) )
	      (buffer-disable-undo tmpbuf)
	      (setq buffer-read-only nil)
	      (erase-buffer)
	      (insert-file-contents file nil 0 glimpse-mh-header-bytes t)
	      (goto-char (point-min))
	      (if (re-search-forward "^Subject:[ \t]+\\(.+\\)" nil t)
		  (setq subject (concat " \""
					(buffer-substring (match-beginning 1)
							  (match-end 1))
					"\""))
		(setq subject " (No subject)"))
	      ))
	  (if subject
	      (progn
		(end-of-line)
		(insert subject)
		))
	  ))
    ))


(defun glimpse-mh-get-subfolders (top-folder)
  "Given an MH folder name, return a list of subfolders, if any.
The original MH folder name is included in the returned list.
The list is sorted."
  (let ( (regexp (concat "^" (regexp-quote top-folder) "\\b"))
	 (folders mh-folder-list) folder subfolders)
    (while folders
      (setq folder (car (car folders)))
      (if (string-match regexp folder)
	  (progn
	    (setq subfolders (cons folder subfolders))
	    ))
      (setq folders (cdr folders))
      )
    (sort subfolders 'string<)
    ))


(defun glimpse-mh-prompt-for-search-info (verbose)
  ""
  (let (folders folder search-string ans flist f
		case-sensitive match-partial-words
		max-errors (words-whole-file t) )
    (setq glimpse-mh-index-directory-prefix
	  (file-name-as-directory glimpse-mh-index-directory-prefix))
    (while (and (setq search-string (read-from-minibuffer "Search string? "))
		(string-equal search-string ""))
      )
    (if (string-match "[ \t;]" search-string)
	(setq words-whole-file
	      (not (y-or-n-p "All words must occur on the same line? "))))
    (if verbose
	(progn
	  (setq match-partial-words (y-or-n-p "Match whole words? "))
	  (let (done)
	    (while (not done)
	      (setq max-errors (read-from-minibuffer
				"Maximum number of errors (0-8) [0]? "))
	      (if (or (string-equal max-errors "")
		      (and (stringp max-errors)
			   (>= (setq max-errors (string-to-int max-errors)) 0)
			   (<= max-errors 8)))
		  (setq done t))
	      ))
	  (setq case-sensitive (not (y-or-n-p "Case insensitive? ")))
	  ))
    (if (not (y-or-n-p "Search all folders? "))
	(progn
	  ;; No -- search selected folders
	  (setq f (mh-prompt-for-folder "Folder to search"
					mh-current-folder nil))
	  (setq flist (glimpse-mh-get-subfolders f))
	  (if (> (length flist) 1)
	      (progn
		(if (not (y-or-n-p (format "Search subfolders of '%s'? "
					   f)))
		    (setq flist (list f)))
		))
	  )
      (progn
	;; Yes -- search all folders
	(setq flist (mapcar 'car mh-folder-list))
	))
    (while flist
      (setq f (car flist))
      (if (string-match "^\\+\\(.+\\)$" f)
	  (setq f (substring f (match-beginning 1) (match-end 1))))
      (setq folder (concat glimpse-mh-index-directory-prefix f))
      (if (and glimpse-mh-do-sanity-checks
	       (not (file-directory-p folder)))
	  (progn
	    (if (not (file-exists-p folder))
		(progn
		  (display-warning 'glimpse-mh-e
				   (format
				    "Glimpse index database directory:
     %s
does not exist.  This is usually caused by not running the shell script
that indexes the MH mail folders.  If it is intentional that this
index directory not exist, you can suppress this particular message by
creating a zero-length file of the above name, or you can add
`glimpse-mh-e' to `display-warning-suppressed-classes' to suppress all
glimpse-mh-e warning messages."
				    folder))
		  )
	      ;; do nothing if `folder' exists as a file, as this
	      ;; indicates that this folder is supposed to be
	      ;; suppressed, without warning messages.
	      )
	    )
	(progn
	  (setq folders (cons folder folders))
	  ))
      (setq flist (cdr flist))
      )
    (setq folders (sort folders 'string<))
    (if verbose
	(list folders search-string words-whole-file case-sensitive
	      match-partial-words max-errors)
      (list folders search-string words-whole-file))
    ))


(defun glimpse-mh-setup-output-buffer ()
  ""
  (progn
    (pop-to-buffer (get-buffer-create glimpse-mh-outbuf))
    (let (buffer-read-only)
      (if glimpse-process
	  (error "Glimpse search still in progress!"))
      (erase-buffer)
      (set-buffer-modified-p nil)
      (insert (format "----- Glimpse Search for '%s' -----\n\n" strings))
      (if (or (eq glimpse-mh-display-search-progress 'buffer)
	      (eq glimpse-mh-display-search-progress t))
	  (progn
	    (setq glimpse-mh-status-marker (point-marker))
	    (insert "\n\n")
	    ))
      (if glimpse-mh-search-limits
	  (progn
	    (insert (format "(Note: search limits are in effect (\"%s\") -- see the variable
`glimpse-mh-search-limits' for details.)

" glimpse-mh-search-limits))
	    ))
      )
    (setq buffer-read-only t)
    ))


(defun glimpse-mh-search (folders strings words-whole-file)
  "Perform a \"basic\" glimpse search on one or more MH folders."
  (interactive (glimpse-mh-prompt-for-search-info nil))
  (let (case-sensitive match-partial-words)
    (glimpse-mh-setup-output-buffer)
    (glimpse-search folders strings glimpse-mh-outbuf
		    0 match-partial-words
		    words-whole-file case-sensitive glimpse-mh-search-limits t
		    glimpse-mh-glimpseserver
		    mh-user-path t
		    nil 'glimpse-mh-next-folder-callback
		    'glimpse-mh-new-file-callback nil
		    'glimpse-mh-search-done-callback)
    (setq mode-name "MH search")
    ))


(defun glimpse-mh-search-verbose (folders strings words-whole-file 
					  case-sensitive match-partial-words
					  max-errors)
  "Perform a \"verbose\" glimpse search on one or more MH folders.
More questions are asked on how to perform the search."
  (interactive (glimpse-mh-prompt-for-search-info t))
  (let ()
    (glimpse-mh-setup-output-buffer)
    (glimpse-search folders strings glimpse-mh-outbuf
		    max-errors match-partial-words
		    words-whole-file case-sensitive glimpse-mh-search-limits t
		    glimpse-mh-glimpseserver
		    mh-user-path t
		    nil 'glimpse-mh-next-folder-callback
		    'glimpse-mh-new-file-callback nil
		    'glimpse-mh-search-done-callback)
    ))


(provide 'glimpse-mh-e)
