Path: utzoo!utgpu!utstat!jarvis.csri.toronto.edu!mailrus!bbn!gateway!RELAY.NSWC.NAVY.MIL!dsill
From: dsill@RELAY.NSWC.NAVY.MIL
Newsgroups: comp.emacs
Subject: webster
Message-ID: <37469@bbn.COM>
Date: 20 Mar 89 18:04:24 GMT
Sender: news@bbn.COM
Organization: BBN news/mail gateway
Lines: 237

Well, since there seems to be a flurry of webster enhancement, I guess
I'll add my own small addition.

I've made it so the word you're sitting on when you call webster is
the default word to be defined, spelled, or ended.

================
;; Copyright (C) 1989 Free Software Foundation

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;
;; Author Jason R. Glasgow (glasgow@cs.yale.edu)
;; Modified from telnet.el by William F. Schelter
;;
;; Modified by Dirk Grunwald to maintain an open connect
;; But almost entirely different
;;
;; 3/18/89 Ashwin Ram <Ram-Ashwin@yale.edu>
;; Added webster-mode.
;; Fixed documentation.
;; 
;; 3/20/89 Dave Sill <dsill@relay.nswc.navy.mil>
;; Added current-word as default to define/spell/end.
;;
;; To use this, you might want to add this line to your .emacs file:
;;
;;  (autoload 'webster "webster" "look up a word in Webster's 7th edition" t)
;;
;; Then just hit M-x webster to look up a word.
;;

(defvar webster-host "128.197.2.40"
  "Host that is a webster server (Boston U). Try also 26.0.0.73, which is sri-nic")
(defvar webster-port "103"
  "The port to connect to. Either 103 or 2627")

(defvar webster-request "DEFINE SPELLING ENDINGS"
  "The type of request to use.  Try DEFINE SPELLING ENDINGS")

(defvar webster-process nil
  "The current webster process")

(defvar webster-start-delay 1
  "Seconds to delay before talking to webster server")

(defvar webster-running nil
  "Used to determine when connection is established")

;;;
;;; Initial filter for ignoring information until successfully connected
;;;
(defun webster-initial-filter (proc string)
  (cond
   ((not (eq (process-status webster-process) 'run))
    (progn
      (setq webster-running t)
      (message "webster died")))

   ((string-match "No such host" string)
    (progn
      (setq webster-running t)
      (kill-buffer (process-buffer proc))
      (error "No such host.")))

   ((string-match "]" string)
    (progn
      (setq webster-running t)
      (set-process-filter proc 'webster-filter)))))

(defun webster-filter (proc string)
  (let
      ((closed-message (string-match "Connection closed" string))
       (end-def-message (or (string-match "\200" string) (string-match "\0" string))))
    (cond

     ((not (eq (process-status webster-process) 'run))
      (message "Webster died"))

     (closed-message
      (progn
	(message "Closing webster connection...")
	(kill-process proc)
	(save-excursion
	  (set-buffer (process-buffer proc))
	  (replace-regexp "Process webster killed" "" nil)
	  (goto-char 1))
	(message "Done.")))
     
     ((string-match "SPELLING 0" string)
      (message "Word not found in webster"))
     
     ((string-match "SPELLING 1" string)
      (message "Spelled correctly"))

     (end-def-message
      (progn
	(webster-filter proc (concat (substring string 0 (- end-def-message 1)) "\n\n"))
	(goto-char (point-max))
	(recenter -1)))

     (t (save-excursion
	  (set-buffer (process-buffer proc))
	  (goto-char (point-max))
	  (let ((now (point)))
	    (insert string)
	    (delete-char-in-region now (point) ?\^m ?\ ))
	  (if (process-mark proc)
	      (set-marker (process-mark proc) (point))))))))

;;;
;;; delete char1 and char2 if it precedes char1
;;; used to get rid of <space><return>
(defun delete-char-in-region (start end char1 char2)
  (goto-char start)
  (while (search-forward (char-to-string char1) end t)
    (backward-delete-char 1)
    (if (equal (char-after (- (point) 1)) char2)
	(backward-delete-char 1))))

(defun webster (arg)
  "Look up a word in the Webster's dictionary.
Open a network login connection to a webster host if necessary.
Communication with host is recorded in a buffer *webster*.
The process will end after a \200 is sent."
  (interactive (list
		(read-string
		 (concat "Look up word in webster (" (current-word) "): "))))
  (if (equal "" arg) (setq arg (current-word)))
  (webster-send-request "DEFINE" arg))

(defun webster-endings (arg)
  "Look up endings for a word in the Webster's dictionary.
Open a network login connection to a webster host if necessary.
Communication with host is recorded in a buffer *webster*."
  (interactive (list
		(read-string
		 (concat
		  "Find endings for word in webster (" (current-word) "): "))))
  (if (equal "" arg) (setq arg (current-word)))
  (webster-send-request "ENDINGS" arg))

(defun webster-spell (arg)
  "Look up the spelling for a word in the Webster's dictionary.
Open a network login connection to a webster host if necessary.
Communication with host is recorded in a buffer *webster*."
  (interactive (list
		(read-string
		 (concat "Spell word in webster (" (current-word) "): "))))
  (if (equal "" arg) (setq arg (current-word)))
  (webster-send-request "SPELL" arg))

(defun webster-send-request (kind word)
  (require 'shell)
  (let ((name "webster")
	(webster-command (concat "open " webster-host " " webster-port "\n")))

    (cond ((not (eq (get-buffer-window (concat "*" name "*")) nil))
	   (select-window (get-buffer-window (concat "*" name "*"))))
	  ((one-window-p)
	   (split-window-vertically)
	   (other-window 1)))
    (if (or (not webster-process)
	    (not (eq (process-status webster-process) 'run)))
	(progn
	  (switch-to-buffer (make-shell name "telnet"))
          (webster-mode)
          (sit-for 0)
	  (message "Connecting to %s..." webster-host)
	  (setq webster-process (get-process name))
	  (set-process-filter webster-process 'webster-initial-filter)
	  (process-send-string  webster-process webster-command)
	  ;
	  ; wait for feedback before sending query
	  ;
	  (setq webster-running nil)
	  (while (not webster-running)
            (sit-for 1)
	    (accept-process-output))
	  (message "Connecting to %s...done" webster-host)))
    (process-send-string webster-process (concat kind " " word "\n"))))

; Buffer is buried but not deleted since user may want the info in the buffer.
(defun webster-quit ()
   "Close connection and quit webster-mode."
   (interactive)
   (message "Closing connection to %s..." webster-host)
   (kill-process webster-process)
   (message "Closing connection to %s...done" webster-host)
   (bury-buffer))

(defun webster-mode ()
  "Major mode for interacting with on-line Webster's dictionary.
\\{webster-mode-map}
Use webster-mode-hook for customization."
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'webster-mode)
  (setq mode-name "Webster")
  (use-local-map webster-mode-map)
  (run-hooks 'webster-mode-hook))

(defvar webster-mode-map nil)
(if webster-mode-map
    nil
  (setq webster-mode-map (make-sparse-keymap))
  (define-key webster-mode-map "?" 'describe-mode)
  (define-key webster-mode-map "d" 'webster)
  (define-key webster-mode-map "e" 'webster-endings)
  (define-key webster-mode-map "q" 'webster-quit)
  (define-key webster-mode-map "s" 'webster-spell))

;; Snatched from unix-apropos by Henry Kautz
(defun current-word ()
   "Word cursor is over, as a string."
   (save-excursion
      (let (beg end)
	 (re-search-backward "\\w" nil 2)
	 (re-search-backward "\\b" nil 2)
	 (setq beg (point))
	 (re-search-forward "\\w*\\b" nil 2)
	 (setq end (point))
	 (buffer-substring beg end))))