; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         thesaurus.el
; RCS:          $Header: /afs/sipb.mit.edu/project/sipbsrc/src/Roget/RCS/thesaurus.el,v 1.1 1992/04/07 19:20:45 ckclark Exp ckclark $
; Description:  Thesaurus access functions
; Author:       Darryl Okahata
; Created:      Wed Dec 18 15:44:57 1991
; Modified:     Wed Dec 18 16:59:29 1991 (Darryl Okahata) darrylo@hpsrdmo
; Language:     Emacs-Lisp
; Package:      N/A
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; *******************************************************
;; ***** THIS IS AN ALPHA TEST VERSION (Version 0.1) *****
;; *******************************************************
;;
;; thesaurus.el -- Trivial interface routines for the Perl-based
;; thesaurus access routines.
;; Copyright (C) 1991 Darryl Okahata (darrylo@sr.hp.com)
;; 
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
;; 
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This file must be used with the Perl programs that access the
;; thesaurus.
;;
;; Here are the main interactive functions:
;;
;; thesaurus-lookup-word
;;	This function will prompt for a word to look up, and all entries
;;	that begin with this word will be displayed.  To display the
;;	entry that contains only this word, specify a prefix.
;;
;; thesaurus-lookup-word-in-text
;;	This function will extract the word under the cursor and run
;;	`thesaurus-lookup-word' upon it.  A prefix can be specified to
;;	force the display of only the entry that contains this word.
;;
;; thesaurus-show-words
;;	This function will prompt for a word and will display all words
;;	in the thesaurus that begin with this word.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defvar thesaurus-program "/mit/sipb/lib/perl/th"
  "This is the name of the program that extracts data from the thesaurus.
Some sites may have to give a full path name here.")


(defconst thesaurus-scratch-buffer-name "*thesaurus*"
  "This is the name of the buffer in which the thesaurus output is
displayed.")


(defun thesaurus-extract-word ()
  "From the current buffer, extract and return the word under the cursor."
  (let (start word)
    (save-excursion
      (forward-char 1)
      (backward-word 1)
      (setq start (point))
      (forward-char 1)
      (if (not (re-search-forward "\\b"))
	  (error "Can't find end of word"))
      (buffer-substring start (point))
      )))


(defun thesaurus-lookup-word (word exact)
  "Look up the word WORD in the thesaurus.
The results will be displayed in the buffer given by
`thesaurus-scratch-buffer-name'.  If EXACT is nil, all entries that
begin with WORD will be displayed.  If EXACT is non-nil, only the entry
that contains WORD will be displayed.
"
  (interactive "sWord to lookup? \nP")
  (let ((thesaurus-buffer (get-buffer-create thesaurus-scratch-buffer-name)))
    (display-buffer thesaurus-buffer)
    (save-excursion
      (buffer-flush-undo (set-buffer thesaurus-buffer))
      (erase-buffer)
      (if exact
	  (start-process "thesaurus" thesaurus-buffer thesaurus-program
			 "-W" word)
	  (start-process "thesaurus" thesaurus-buffer thesaurus-program
			 "-V" word)
	  )
      )))


(defun thesaurus-lookup-word-in-text (exact)
  "Like `thesaurus-lookup-word', but uses the word under the cursor."
  (interactive "P")
  (thesaurus-lookup-word (thesaurus-extract-word) exact))


(defun thesaurus-show-words (word)
  "List all words in the thesaurus that begin with WORD."
  (interactive "sWord or partial word to lookup? ")
  (let ((thesaurus-buffer (get-buffer-create thesaurus-scratch-buffer-name)))
    (display-buffer thesaurus-buffer)
    (save-excursion
      (buffer-flush-undo (set-buffer thesaurus-buffer))
      (erase-buffer)
      (insert "***** Words matching \"" word "\":\n\n")
      (start-process "thesaurus" thesaurus-buffer thesaurus-program
		     "-w" word)
      )))