; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         thesaurus.el
; RCS:          $Header: $
; 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 ([email protected])
;;
;; 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 "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)
     )))

You are viewing proxied material from infinitelyremote.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.