home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / webster.el < prev    next >
Encoding:
Text File  |  1991-11-11  |  13.6 KB  |  411 lines
  1. ; Received: from dg-rtp by teton (5.4/rtp-s04)
  2. ;     id AA04130; Mon, 21 Oct 1991 01:54:11 -0400
  3. ; Received: from lucid.com by dg-rtp.dg.com (5.4/dg-rtp-proto)
  4. ;     id AA12962; Mon, 21 Oct 1991 01:54:02 -0400
  5. ; Received: from thalidomide ([192.31.212.116]) by heavens-gate.lucid.com id AA00571g; Sun, 20 Oct 91 22:53:20 PDT
  6. ; Received: by thalidomide id AA05286g; Sun, 20 Oct 91 22:54:00 PDT
  7. ; Date: Sun, 20 Oct 91 22:54:00 PDT
  8. ; X-Windows: Let it get in YOUR way.
  9. ; From: Jamie Zawinski <jwz%thalidomide@lucid.com>
  10. ; Subject: webster modes
  11. ; Content-Type: text
  12. ; Content-Length: 13262
  13. ; Status: RO
  14. ; 
  15. ; Hi.  I've made some improvements to webster.el, you might want to archive this
  16. ; version.
  17. ; 
  18. ; LCD Archive Entry:
  19. ; webster|Glasgow, Grunwald, Ram, Sill, Zawinski|jwz@lucid.com
  20. ; |Look up a word in Webster's 7th Ed.
  21. ; |91-09-14||~/interfaces/webster.el.Z|
  22.  
  23. ; 
  24. ; ---------- slice 'n' dice ----------------------------------- file: webster.el
  25. ;; Copyright (C) 1989 Free Software Foundation
  26.  
  27. ;; This file is part of GNU Emacs.
  28.  
  29. ;; GNU Emacs is distributed in the hope that it will be useful,
  30. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  31. ;; accepts responsibility to anyone for the consequences of using it
  32. ;; or for whether it serves any particular purpose or works at all,
  33. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  34. ;; License for full details.
  35.  
  36. ;; Everyone is granted permission to copy, modify and redistribute
  37. ;; GNU Emacs, but only under the conditions described in the
  38. ;; GNU Emacs General Public License.   A copy of this license is
  39. ;; supposed to have been given to you along with GNU Emacs so you
  40. ;; can know your rights and responsibilities.  It should be in a
  41. ;; file named COPYING.  Among other things, the copyright notice
  42. ;; and this notice must be preserved on all copies.
  43. ;;
  44. ;; Author Jason R. Glasgow (glasgow@cs.yale.edu)
  45. ;; Modified from telnet.el by William F. Schelter
  46. ;; But almost entirely different.
  47. ;;
  48. ;; Modified by Dirk Grunwald to maintain an open connection.
  49. ;;
  50. ;; 3/18/89 Ashwin Ram <Ram-Ashwin@yale.edu>
  51. ;; Added webster-mode.
  52. ;; Fixed documentation.
  53. ;;
  54. ;; 3/20/89 Dirk Grunwald <grunwald@flute.cs.uiuc.edu>
  55. ;; Merged Rams changes with new additions: smarter window placement,
  56. ;; correctly handles un-exposed webster windows, minor cleanups.
  57. ;; Also, ``webster-word'', akin to ``spell-word''.
  58. ;;
  59. ;; To use this, you might want to add this line to your .emacs file:
  60. ;;
  61. ;;  (autoload 'webster "webster" "look up a word in Webster's 7th edition" t)
  62. ;;
  63. ;; Then just hit M-x webster to look up a word.
  64. ;;
  65. ;; 3/21/89 Dave Sill <dsill@relay.nswc.navy.mil>
  66. ;; Removed webster-word and webster-define, adding default of current word to 
  67. ;; webster, webster-spell, and webster-endings instead.
  68. ;;
  69. ;; 1/21/91 Jamie Zawinski <jwz@lucid.com>
  70. ;; Added webster-reformat to produce better looking output.  Made it notice
  71. ;; references to other words in the definitions (all upper-case) and do
  72. ;; completion on them in the string read by meta-x webster.
  73. ;;
  74. ;; 9/14/91 Jamie Zawinski <jwz@lucid.com>
  75. ;; Improved the above.
  76.  
  77. (defvar webster-host "18.26.0.36"
  78.   "The host to use as a webster server.")
  79.  
  80. (defvar webster-port "103"
  81.   "The port to connect to. Either 103 or 2627")
  82.  
  83. (defvar webster-process nil
  84.   "The current webster process")
  85.  
  86. (defvar webster-process-name "webster"
  87.   "The current webster process")
  88.  
  89. (defvar webster-buffer nil
  90.   "The current webster process")
  91.  
  92. (defvar webster-running nil
  93.   "Used to determine when connection is established")
  94.  
  95. ;;;
  96. ;;; Initial filter for ignoring information until successfully connected
  97. ;;;
  98. (defun webster-initial-filter (proc string)
  99.   (let ((this-buffer (current-buffer)))
  100.     (set-buffer webster-buffer)
  101.     (goto-char (point-max))
  102.     (cond ((not (eq (process-status webster-process) 'run))
  103.        (setq webster-running t)
  104.        (message "Webster died"))
  105.       ((string-match "No such host" string)
  106.        (setq webster-running t)
  107.        (kill-buffer (process-buffer proc))
  108.        (error "No such host."))
  109.       ((string-match "]" string)
  110.        (setq webster-running t)
  111.        (set-process-filter proc 'webster-filter)))
  112.     (set-buffer this-buffer)))
  113.  
  114. (defvar webster-reformat t
  115.   "*Set this to t if you want the webster output to be prettied up, andfor the \\[webster] prompt to do completion across the set of words knownto be in the dictionary (words you've looked up, or which appeared in definitions as crossreferences.)")
  116.  
  117. (defun webster-filter (proc string)
  118.   (let ((this-buffer (current-buffer))
  119.     (endp nil))
  120.     (set-buffer webster-buffer)
  121.     (cond ((not (eq (process-status webster-process) 'run))
  122.        (message "Webster died"))
  123.       ((string-match "Connection closed" string)
  124.        (message "Closing webster connection...")
  125.        (kill-process proc)
  126.        (replace-regexp "Process webster killed" "" nil)
  127.        (goto-char 1)
  128.        (message "Closing webster connection...Done."))
  129.       ((string-match "SPELLING 0" string)
  130.        (insert-string "...Word not found in webster\n"))
  131.       ((string-match "SPELLING 1" string)
  132.        (insert-string "...Spelled correctly\n"))
  133.       ((let ((end-def-message (or (string-match "\200" string)
  134.                       (string-match "\0" string))))
  135.          (if end-def-message
  136.          (progn
  137.            (webster-filter
  138.             proc
  139.             (concat (substring string 0 (- end-def-message 1)) "\n\n"))
  140.            (setq endp t)
  141.            (goto-char (point-max))
  142.            t))))
  143.       (t
  144.        (goto-char (point-max))
  145.        (let ((now (point)))
  146.          (insert string)
  147.          (delete-char-in-region now (point) "\^M" " "))
  148.        (if (process-mark proc)
  149.            (set-marker (process-mark proc) (point)))))
  150.     (if endp
  151.     ;; if the webster window is visible, move the last line to the
  152.     ;; bottom of that window
  153.     (let ((webster-window (get-buffer-window webster-buffer))
  154.           (window (selected-window)))
  155.       (if webster-reformat (webster-reformat (process-mark proc)))
  156.       (if webster-window
  157.           (progn
  158.         (select-window webster-window)
  159.         (goto-char (point-max))
  160.         (recenter (1- (window-height webster-window)))
  161.         (select-window window)))))))
  162.  
  163. (defconst webster-completion-table (make-vector 511 0))
  164.  
  165. (defun webster-intern (string)
  166.   (while (string-match "\\." string)
  167.     (setq string (concat (substring string 0 (match-beginning 0))
  168.              (substring string (match-end 0)))))
  169.   (intern (downcase string) webster-completion-table))
  170.  
  171. (defun webster-reformat (end)
  172.   "Clean up the output of the webster server, and gather words for the completion table."
  173.   (if (not webster-reformat) nil
  174.     (goto-char end)
  175.     (let ((case-fold-search nil))
  176.       (re-search-backward "^[A-Z]+" nil t)
  177.       (if (not (looking-at "^DEFINITION [0-9]"))
  178.       nil
  179.     (forward-line 1)
  180.     (let ((p (point))
  181.           (indent 2))
  182.       (search-forward "\n\n" nil 0)
  183.       (narrow-to-region p (point))
  184.       (goto-char p)
  185.       (while (search-forward "\n" nil t)
  186.         (delete-char -1)
  187.         (just-one-space))
  188.       (goto-char p)
  189.       (while (not (eobp))
  190.         (cond ((looking-at " *[0-9]+\\. ")
  191.            (setq indent 5)
  192.            (delete-horizontal-space)
  193.            (insert "\n  ")
  194.            (skip-chars-forward "0-9. ")
  195.            (if (looking-at "[a-z]+")
  196.                (webster-intern
  197.             (buffer-substring (point) (match-end 0)))))
  198.           ((looking-at " *\\([0-9]+\\): *")
  199.            (let ((n (buffer-substring (match-beginning 1)
  200.                           (match-end 1))))
  201.              (delete-region (match-beginning 0) (match-end 0))
  202.              (insert "\n")
  203.              (indent-to (- 6 (length n)))
  204.              (insert n " : ")
  205.              (setq indent 9)))
  206.           ((looking-at " *\\([0-9]+\\)\\([a-z]+\\): *")
  207.            (let ((n (buffer-substring (match-beginning 1)
  208.                           (match-end 1)))
  209.              (m (buffer-substring (match-beginning 2)
  210.                           (match-end 2))))
  211.              (if (not (equal m "a")) (setq n " "))
  212.              (delete-region (match-beginning 0) (match-end 0))
  213.              (insert "\n")
  214.              (indent-to (- 6 (length n)))
  215.              (insert n "  ")
  216.              (insert m " : ")
  217.              (setq indent 12)))
  218.           ((looking-at " *\\([0-9]+\\)\\([a-z]+\\)\\([0-9]+\\): *")
  219.            (let ((n (buffer-substring (match-beginning 1)
  220.                           (match-end 1)))
  221.              (m (buffer-substring (match-beginning 2)
  222.                           (match-end 2)))
  223.              (o (buffer-substring (match-beginning 3)
  224.                           (match-end 3))))
  225.              (if (not (equal o "1")) (setq m " "))
  226.              (if (not (equal m "a")) (setq n " "))
  227.              (delete-region (match-beginning 0) (match-end 0))
  228.              (insert "\n")
  229.              (indent-to (- 6 (length n)))
  230.              (insert n "  ")
  231.              (insert m "  ")
  232.              (insert "(" o ") : ")
  233.              (setq indent 17)))
  234.           ((looking-at " *\\\\")
  235.            (setq indent 5)
  236.            (setq p (point))
  237.            (goto-char (match-end 0))
  238.            (search-forward "\\")
  239.            (if (> (current-column) fill-column)
  240.                (progn
  241.              (goto-char p)
  242.              (insert "\n")
  243.              (indent-to 18)
  244.              (search-forward "\\"))))
  245.           ((looking-at " *\\[")
  246.            (setq indent 6)
  247.            (delete-horizontal-space)
  248.            (insert "\n")
  249.            (indent-to 5)
  250.            (forward-char 1))
  251.           ((and (= (preceding-char) ?\])
  252.             (looking-at " *:"))
  253.            (delete-horizontal-space)
  254.            (setq indent 5)
  255.            (insert "\n "))
  256.           ((looking-at " *SYN *")
  257.            (delete-region (point) (match-end 0))
  258.            (insert "\n")
  259.            (delete-horizontal-space)
  260.            (insert "  ")
  261.            (setq indent 6)
  262.            (if (looking-at "syn ")
  263.                (progn (goto-char (match-end 0))
  264.                   (insert "see "))))
  265.           (t
  266.            (setq p (point))
  267.            (skip-chars-forward " ,:;-")
  268.            (if (looking-at "\\([A-Z][A-Z][A-Z]+\\)\\( [A-Z][A-Z]+\\)*")
  269.                (webster-intern
  270.             (buffer-substring (point) (match-end 0))))
  271.            (skip-chars-forward "^ \\")
  272.            (if (> (current-column) fill-column)
  273.                (progn
  274.              (goto-char p)
  275.              (insert "\n")
  276.              (delete-horizontal-space)
  277.              (indent-to indent)
  278.              (skip-chars-forward " ")
  279.              (skip-chars-forward "^ \\")
  280.              )))
  281.           )))
  282.     (goto-char (point-min))
  283.     (while (looking-at "\n") (delete-char 1))
  284.     (goto-char (point-max))
  285.     (insert "\n\n")
  286.     (widen)))))
  287.  
  288. ;; " \\(\\(slang\\|cap\\|pl\\|aj\\|av\\|n\\|v\\|vt\\|vi\\)\\(,[ \n]+\\)?\\)+\n"
  289.  
  290. ;;;
  291. ;;; delete char1 and char2 if it precedes char1
  292. ;;; used to get rid of <space><return>
  293. (defun delete-char-in-region (start end char1 char2)
  294.   (goto-char start)
  295.   (setq char2 (aref char2 0))
  296.   (while (search-forward char1 end t)
  297.     (delete-char -1)
  298.     (if (= (char-after (- (point) 1)) char2)
  299.     (delete-char -1))))
  300.  
  301. (defun webster (arg)
  302. "Look up a word in the Webster's dictionary.
  303. Open a network login connection to a webster host if necessary.
  304. Communication with host is recorded in a buffer *webster*."
  305.   (interactive (list
  306.         (let ((prompt (concat "Look up word in webster ("
  307.                       (current-word) "): "))
  308.               (completion-ignore-case t))
  309.           (downcase
  310.            (if webster-reformat
  311.                (completing-read prompt webster-completion-table
  312.                     nil nil)
  313.              (read-string prompt))))))
  314.   (if (equal "" arg) (setq arg (current-word)))
  315.   (webster-send-request "DEFINE" arg))
  316.  
  317. (defun webster-endings (arg)
  318. "Look up endings for a word in the Webster's dictionary.
  319. Open a network login connection to a webster host if necessary.
  320. Communication with host is recorded in a buffer *webster*."
  321.   (interactive (list
  322.         (read-string
  323.          (concat
  324.           "Find endings for word in webster (" (current-word) "): "))))
  325.   (if (equal "" arg) (setq arg (current-word)))
  326.   (webster-send-request "ENDINGS" arg))
  327.  
  328. (defun webster-spell (arg)
  329. "Look spelling for a word in the Webster's dictionary.
  330. Open a network login connection to a webster host if necessary.
  331. Communication with host is recorded in a buffer *webster*."
  332.   (interactive (list
  333.         (read-string
  334.          (concat
  335.           "Try to spell word in webster (" (current-word) "): "))))
  336.   (if (equal "" arg) (setq arg (current-word)))
  337.   (webster-send-request "SPELL" arg))
  338.  
  339. (defun webster-send-request (kind word)
  340.   (require 'shell)
  341.   (let
  342.       ((webster-command (concat "open " webster-host " " webster-port "\n")))
  343.     
  344.     (if (or 
  345.      (not webster-buffer)
  346.      (not webster-process)
  347.      (not (eq (process-status webster-process) 'run)))
  348.     (progn
  349.       (message
  350.        (concat "Attempting to connect to server " webster-host "..."))
  351.       (setq webster-buffer
  352.         (if (not (fboundp 'make-shell)) ;emacs19
  353.             (make-comint webster-process-name "telnet")
  354.           (make-shell webster-process-name "telnet")))
  355.       (let
  356.           ((this-buffer (current-buffer)))
  357.         (set-buffer webster-buffer)
  358.         (webster-mode)
  359.         (set-buffer this-buffer))
  360.  
  361.       (setq webster-process (get-process webster-process-name))
  362.       (set-process-filter webster-process 'webster-initial-filter)
  363.       (process-send-string  webster-process webster-command)
  364.       (setq webster-running nil);
  365.       (while (not webster-running)    ; wait for feedback
  366.         (accept-process-output))))    ;
  367.     (display-buffer webster-buffer nil)
  368.     (process-send-string webster-process (concat kind " " word "\n"))))
  369.  
  370. (defun webster-quit ()
  371.    "Close connection and quit webster-mode.  Buffer is not deleted."
  372.    (interactive)
  373.    (message "Closing connection to %s..." webster-host)
  374.    (kill-process webster-process)
  375.    (message "Closing connection to %s...done" webster-host)
  376.    (bury-buffer))
  377.  
  378. (defun webster-mode ()
  379.   "Major mode for interacting with on-line Webster's dictionary.
  380. \\{webster-mode-map}
  381. Use webster-mode-hook for customization."
  382.   (interactive)
  383.   (kill-all-local-variables)
  384.   (setq major-mode 'webster-mode)
  385.   (setq mode-name "Webster")
  386.   (use-local-map webster-mode-map)
  387.   (run-hooks 'webster-mode-hook))
  388.  
  389. (defvar webster-mode-map nil)
  390. (if webster-mode-map
  391.     nil
  392.   (setq webster-mode-map (make-sparse-keymap))
  393.   (define-key webster-mode-map "?" 'describe-mode)
  394.   (define-key webster-mode-map "d" 'webster)
  395.   (define-key webster-mode-map "e" 'webster-endings)
  396.   (define-key webster-mode-map "q" 'webster-quit)
  397.   (define-key webster-mode-map "s" 'webster-spell))
  398.  
  399. ;; Snatched from unix-apropos by Henry Kautz
  400. (defun current-word ()
  401.    "Word cursor is over, as a string."
  402.    (save-excursion
  403.       (let (beg end)
  404.      (re-search-backward "\\w" nil 2)
  405.      (re-search-backward "\\b" nil 2)
  406.      (setq beg (point))
  407.      (re-search-forward "\\w*\\b" nil 2)
  408.      (setq end (point))
  409.      (buffer-substring beg end))))
  410.  
  411.