home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / packages / webster-ucb.el < prev    next >
Encoding:
Text File  |  1995-03-05  |  45.8 KB  |  1,451 lines
  1. ;;; -*- Mode:Emacs-Lisp -*-
  2.  
  3. ;;; Yet Another Webster Protocol.
  4. ;;; This one is for talking to the kind of Webster server of which 
  5. ;;; pasteur.Berkeley.EDU port 1964 is an instance (the "edjames" protocol).
  6. ;;;
  7. ;;; The interface and much of the process-handling code in this file were
  8. ;;; lifted from the Webster client by Jason Glasgow that talks to the kind
  9. ;;; of Webster server of which mintaka.lcs.mit.edu port 103 is an instance.
  10. ;;;
  11. ;;; 13 nov 90  Jamie Zawinski <jwz@lucid.com>  created
  12. ;;; 14 sep 91  Jamie Zawinski <jwz@lucid.com>  hacked on some more
  13. ;;; 19 feb 91  Jamie Zawinski <jwz@lucid.com>  added Lucid Emacs font support
  14. ;;; 15 apr 92  Jamie Zawinski <jwz@lucid.com>  added mouse support
  15. ;;; 29 aug 92  Jamie Zawinski <jwz@lucid.com>  added 8-bit output
  16. ;;;  6 nov 92  Jamie Zawinski <jwz@lucid.com>  hack hack
  17. ;;; 31 dec 92  Jamie Zawinski <jwz@lucid.com>  made it guess the root word
  18. ;;; 17 mar 93  Jamie Zawinski <jwz@lucid.com>  more hacking, more gnashing
  19. ;;; 31 jul 93  Jamie Zawinski <jwz@lucid.com>  variable height fonts in 19.8
  20.  
  21. ;; TODO:
  22. ;; 
  23. ;; vinculum has a "3 character overbar" code.  Really need to figure out
  24. ;; some way to hack overbars...  Background pixmap?  Need to know line
  25. ;; height in pixels to do that.  
  26. ;;
  27. ;; I don't event know what half of these special characters are supposed
  28. ;; to look like.  Like the "s," in the Turkish root of "chouse"...
  29. ;;
  30. ;; We could fake some of these chars (like upside-down-e) by including bitmaps
  31. ;; in this file, and using extent-begin-glpyhs.  Except that right now glyphs
  32. ;; have to come from files, not from '(w h "string") form, so that'll have to
  33. ;; be fixed first.  We could also just create an X font...
  34. ;;
  35. ;; note that googol says "10100" instead of "10(\bI100)\bI
  36.  
  37. (defvar webster-host "westerhost" "*The host with the webster server")
  38. (defvar webster-port "webster" "*The port on which the webster server listens")
  39.  
  40. (defvar webster-running nil "Used to determine when connection is established")
  41. (defvar webster-state "closed" "for the modeline")
  42. (defvar webster-process nil "The current webster process")
  43. (defvar webster-process-name "webster" "The current webster process")
  44. (defvar webster-buffer nil "The current webster process")
  45.  
  46. (defvar webster-start-mark nil)
  47.  
  48. (defvar webster-fontify (string-match "XEmacs" emacs-version)
  49.   "*Set to t to use the XEmacs/Lucid Emacs font-change mechanism.")
  50.  
  51. (defvar webster-iso8859/1 (string-match "XEmacs" emacs-version)
  52.   "*Set to t to print certain special characters using ISO-8859/1 codes.")
  53.  
  54. (defconst webster-completion-table (make-vector 511 0))
  55.  
  56. (cond ((fboundp 'make-face)
  57.        (or (find-face 'webster)
  58.        (face-differs-from-default-p (make-face 'webster))
  59.        (copy-face 'default 'webster))
  60.        (or (find-face 'webster-bold)
  61.        (face-differs-from-default-p (make-face 'webster-bold))
  62.        (progn
  63.          (copy-face 'webster 'webster-bold)
  64.          (make-face-bold 'webster-bold)))
  65.        (or (find-face 'webster-italic)
  66.        (face-differs-from-default-p (make-face 'webster-italic))
  67.        (progn
  68.          (copy-face 'webster 'webster-italic)
  69.          (make-face-italic 'webster-italic)))
  70.        (or (find-face 'webster-bold-italic)
  71.        (face-differs-from-default-p (make-face 'webster-bold-italic))
  72.        (progn
  73.          (copy-face 'webster 'webster-bold-italic)
  74.          (make-face-bold-italic 'webster-bold-italic)))
  75.        (or (find-face 'webster-underline)
  76.        (face-differs-from-default-p (make-face 'webster-underline))
  77.        (progn
  78.          (copy-face 'webster 'webster-underline)
  79.          (set-face-underline-p 'webster-underline t)))
  80.        (or (find-face 'webster-small)
  81.        (face-differs-from-default-p (make-face 'webster-small))
  82.        (progn
  83.          (copy-face 'webster-bold 'webster-small)
  84.          (and (fboundp 'make-face-smaller)    ; XEmacs 19.8+
  85.           (make-face-smaller 'webster-small))))
  86.        (or (find-face 'webster-subscript)
  87.        (face-differs-from-default-p (make-face 'webster-subscript))
  88.        (progn
  89.          (copy-face 'webster-italic 'webster-subscript)
  90.          (if (fboundp 'make-face-smaller)    ; XEmacs 19.8+
  91.          (and (make-face-smaller 'webster-subscript)
  92.               (make-face-smaller 'webster-subscript))
  93.            (set-face-underline-p 'webster-subscript t))))
  94.        (or (find-face 'webster-superscript)
  95.        (face-differs-from-default-p (make-face 'webster-superscript))
  96.        ;; #### need some way to raise baseline...
  97.        (copy-face 'webster-subscript 'webster-superscript))
  98.        ))
  99.  
  100. (defun webster-fontify (start end face &optional highlight)
  101.   (let ((os start)
  102.     (count 0)
  103.     e)
  104.     (save-excursion
  105.       (goto-char start)
  106.       ;; this mess is so we don't fontify the spaces between the words, so that
  107.       ;; when the lines are wrapped, the stuff at the beginning of the line
  108.       ;; doesn't go in the font of the split word.  Kludge kludge.
  109.       (while (prog1
  110.          (/= (point) end)
  111.            (skip-chars-forward " \t")
  112.            (setq start (point))
  113.            (re-search-forward "[ \t]" (1+ end) 'go)
  114.            (forward-char -1))
  115.     (setq e (make-extent start (point) (current-buffer)))
  116.     (set-extent-face e face)
  117.     (setq count (1+ count))))
  118.     (if highlight
  119.     (set-extent-property
  120.      ;; use the same extent if we didn't have to split it.
  121.      (if (= count 1) e (make-extent os end (current-buffer)))
  122.      'highlight t))
  123.     ))
  124.  
  125. (defconst webster-umlauts
  126.   '((?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
  127.     (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?u . ?\374)
  128.     (?y . ?\377)))
  129.  
  130. (defconst webster-graves
  131.   '((?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
  132.     (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)))
  133.  
  134. (defconst webster-acutes
  135.   '((?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
  136.     (?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
  137.     (?u . ?\372) (?y . ?\375)))
  138.  
  139. ;;;
  140. ;;; Initial filter for ignoring information until successfully connected
  141. ;;;
  142. (defun webster-initial-filter (proc string)
  143.   (let ((this-buffer (current-buffer)))
  144.     ;; don't use save-excursion so that point moves in webster-buffer
  145.     (set-buffer webster-buffer)
  146.     (goto-char (point-max))
  147.     (setq webster-state "closed")
  148.     (cond ((not (eq (process-status webster-process) 'run))
  149.        (setq webster-running t)
  150.        (message "Webster died"))
  151.       ((string-match "No such host" string)
  152.        (setq webster-running t)
  153.        (kill-buffer (process-buffer proc))
  154.        (error "No such host."))
  155.       ((string-match "]" string)
  156.        (setq webster-running t)
  157.        (setq webster-state "opening")
  158.        (set-process-filter proc 'webster-filter)))
  159.     (set-buffer this-buffer)))
  160.  
  161.  
  162. (defun webster-filter (proc string)
  163.   (let ((this-buffer (current-buffer))
  164.     (endp nil))
  165.     (set-buffer webster-buffer)
  166.     (widen)
  167.     (goto-char (point-max))
  168.     (cond ((not (eq (process-status webster-process) 'run))
  169.        (setq webster-state (format "%s" (process-status webster-process)))
  170.        (set-marker webster-start-mark (point-max))
  171.        (message "Webster died"))
  172.       ((string-match "Connection closed" string)
  173.        (message "Closing webster connection...")
  174.        (kill-process proc)
  175.        (setq webster-state "closed")
  176.        (replace-regexp "Process webster killed" "" nil)
  177.        (set-marker webster-start-mark (point-max))
  178.        (message "Closing webster connection...Done."))
  179.       ((let ((end-def-message (string-match "\n\\.\r?\n" string)))
  180.          (if end-def-message
  181.          (progn
  182.            (webster-filter 
  183.             proc
  184.             (concat (substring string 0 (- end-def-message 1)) "\n\n"))
  185.            (setq endp t)
  186.            (setq webster-state "ready")
  187.            t))))
  188.       (t
  189.        (setq webster-state "working")
  190.        (if (string-match "^[45][0-9][0-9]" string)
  191.            (setq webster-state "ready"
  192.              endp t))
  193.        (widen)
  194.        (let ((now (point)))
  195.          (goto-char (point-max))
  196.          (insert string)
  197.          (save-excursion
  198.            (goto-char now)
  199.            (while (search-forward "\r" nil t)
  200.          (delete-char -1))))
  201.        (if (process-mark proc)
  202.            (set-marker (process-mark proc) (point)))
  203.        (narrow-to-region (point-min) webster-start-mark)
  204.        ))
  205.     (if endp
  206.     ;; if the *webster* window is visible, move the last line to the
  207.     ;; bottom of that window
  208.     (let ((webster-window (get-buffer-window webster-buffer))
  209.           (window (selected-window))
  210.           error p)
  211.       (set-buffer webster-buffer)
  212.       (widen)
  213.       (goto-char (point-min))
  214.       (narrow-to-region webster-start-mark (point-max))
  215.       (let ((buffer-undo-list t))
  216.         (if (looking-at "WORD \"\\([^\"\n]*\\)\"\\(\n403 [^\n]+\\)\n")
  217.         (progn
  218.           (downcase-word 1)
  219.           (setq error
  220.             (buffer-substring (match-beginning 1) (match-end 1)))
  221.           (goto-char (match-beginning 2))
  222.           (delete-region (match-beginning 2) (match-end 2))
  223.           (insert " not found")
  224.           (setq error (webster-guess-root error))
  225.           (if error
  226.               (insert "; trying \"" error "\"...")
  227.             (insert "."))
  228.           )
  229.           (webster-convert)))
  230.       (widen)
  231.       (setq p (marker-position webster-start-mark))
  232.       (goto-char (point-max))
  233.       (or (bobp)
  234.           (save-excursion (forward-line -1) (looking-at "-"))
  235.           (insert "\n--------------------\n"))
  236.       (set-marker webster-start-mark (point-max))
  237.       (goto-char p)
  238.       (if webster-window
  239.           (progn
  240.         (select-window webster-window)
  241.         (goto-char p)
  242.         (recenter 3)
  243.         (select-window window)))
  244.       (if error (webster error))))))
  245.  
  246. (defun webster-guess-root (word)
  247.   (let ((case-fold-search t))
  248.     (cond ((null word) nil)
  249.       ((string-match "[ \t\n]" word)
  250.        nil)
  251.       ((string-match "[^aeiou]ing\\'" word)
  252.        (concat (substring word 0 (+ 1 (match-beginning 0))) "e"))
  253.       ((string-match "[a-z]ing\\'" word)
  254.        (substring word 0 (+ 1 (match-beginning 0))))
  255.       ((string-match "ies\\'" word)
  256.        (concat (substring word 0 (match-beginning 0)) "y"))
  257.       ((string-match "ied\\'" word)
  258.        (concat (substring word 0 (match-beginning 0)) "y"))
  259.       ((and (string-match "[^aeiouy][^aeiouy]ed\\'" word)
  260.         (= (aref word (match-beginning 0))
  261.            (aref word (1+ (match-beginning 0)))))
  262.        (substring word 0 (+ 1 (match-beginning 0))))
  263.       ((string-match "[a-z]ed\\'" word)
  264.        (substring word 0 (+ 2 (match-beginning 0))))
  265.       ((string-match "[aeiouy]lly\\'" word)
  266.        (substring word 0 (+ 2 (match-beginning 0))))
  267.       ((string-match "[^l]ly\\'" word)
  268.        (substring word 0 (+ 1 (match-beginning 0))))
  269. ;      ((string-match "es\\'" word)
  270. ;       (substring word 0 (match-beginning 0)))
  271. ;      ((string-match "[^e]s\\'" word)
  272. ;       (substring word 0 (+ 1 (match-beginning 0))))
  273.       ((string-match "s\\'" word)
  274.        (substring word 0 (match-beginning 0)))
  275.       ((string-match "...ed\\'" word)
  276.        (substring word (1- (match-end 0))))
  277.       (t nil))))
  278.  
  279.  
  280. ;;;###don't autoload
  281. (defun webster (arg)
  282.   "Look up a word in the Webster's dictionary.
  283. Open a network login connection to a webster host if necessary.
  284. Communication with host is recorded in a buffer *webster*."
  285.   (interactive (list
  286.         (let ((prompt (concat "Look up word in webster ("
  287.                       (current-word) "): "))
  288.               (completion-ignore-case t))
  289.           (downcase
  290.            (completing-read prompt webster-completion-table
  291.                     nil nil)))))
  292.   (if (equal "" arg) (setq arg (current-word)))
  293.   (message "looking up %s..." (upcase arg))
  294.   (webster-send-request "WORD" (prin1-to-string arg)))
  295.  
  296. ;;;###don't autoload
  297. (defun webster-endings (arg)
  298.   "Look up endings for a word in the Webster's dictionary.
  299. Open a network login connection to a webster host if necessary.
  300. Communication with host is recorded in a buffer *webster*."
  301.   (interactive (list
  302.         (read-string
  303.          (concat
  304.           "Find endings for word in webster (" (current-word) "): "))))
  305.   (if (equal "" arg) (setq arg (current-word)))
  306.   (webster-send-request "PREFIX" arg)
  307.   (webster-send-request "LIST" ""))
  308.  
  309. ;;;###don't autoload
  310. (defun webster-spell (arg)
  311.   "Look spelling for a word in the Webster's dictionary.
  312. Open a network login connection to a webster host if necessary.
  313. Communication with host is recorded in a buffer *webster*."
  314.   (interactive (list
  315.         (read-string
  316.          (concat
  317.           "Try to spell word in webster (" (current-word) "): "))))
  318.   (if (equal "" arg) (setq arg (current-word)))
  319.   (webster-send-request "EXACT" arg)
  320.   (webster-send-request "LIST" arg))
  321.  
  322.  
  323. (defun webster-send-request (kind word)
  324.   (require 'shell)
  325.   (let ((webster-command (concat "open " webster-host " " webster-port "\n")))
  326.     (if (or (not webster-buffer)
  327.         (not (buffer-name webster-buffer))
  328.         (not webster-process)
  329.         (not (eq (process-status webster-process) 'run)))
  330.     (progn
  331.       (message
  332.        (concat "Attempting to connect to server " webster-host "..."))
  333.       (setq webster-buffer
  334.         (if (not (fboundp 'make-shell)) ;emacs19
  335.             (make-comint webster-process-name "telnet")
  336.           (make-shell webster-process-name "telnet")))
  337.       (set-buffer webster-buffer)
  338.       (webster-mode)
  339.       (setq webster-process (get-process webster-process-name))
  340.       (process-kill-without-query webster-process)
  341.       (set-process-filter webster-process 'webster-initial-filter)
  342.       (process-send-string  webster-process webster-command)
  343.       (setq webster-running nil)
  344.       (while (not webster-running)    ; wait for feedback
  345.         (accept-process-output webster-process))
  346.       (message
  347.        (concat "Attempting to connect to server " webster-host
  348.            "... Connected."))
  349.       ))
  350.     (display-buffer webster-buffer nil)
  351.     (process-send-string webster-process (concat kind " " word "\n"))))
  352.  
  353. (defun webster-quit ()
  354.   "Close connection and quit webster-mode.  Buffer is not deleted."
  355.   (interactive)
  356.   (message "Closing connection to %s..." webster-host)
  357.   (kill-process webster-process)
  358.   (message "Closing connection to %s...done" webster-host)
  359.   (setq webster-state "closed")
  360.   (if (eq (current-buffer) webster-buffer)
  361.       (bury-buffer)))
  362.  
  363.  
  364. (defun webster-xref-data (event &optional selection-only)
  365.   (let* ((buffer (event-buffer event))
  366.      (extent (if buffer (extent-at (event-point event) buffer 'highlight)))
  367.      text)
  368.     (cond ((and extent (not selection-only))
  369.        (setq text (save-excursion
  370.             (set-buffer buffer)
  371.             (buffer-substring
  372.              (extent-start-position extent)
  373.              (extent-end-position extent)))))
  374.       ((x-selection-owner-p) ; the selection is in this emacs process.
  375.        (setq text (x-get-selection))
  376.        (if (string-match "[\n\r]" text)
  377.            (setq text nil))))
  378.     (if (null text)
  379.     nil
  380.       (while (string-match "\\." text)
  381.     (setq text (concat (substring text 0 (match-beginning 0))
  382.                (substring text (match-end 0)))))
  383.       (webster-unISO text)
  384.       text)))
  385.  
  386. (defun webster-xref-word (event)
  387.   "Define the highlighted word under the mouse.
  388. Words which are known to have definitions are highlighted when the mouse
  389. moves over them.  You may define any word by selecting it with the left
  390. mouse button and then clicking middle."
  391.   (interactive "e")
  392.   (webster (or (webster-xref-data event)
  393.            (error "click on a highlighted word to define"))))
  394.  
  395. (defvar webster-menu
  396.   '("Webster"
  397.     ["Define Word..." webster t]
  398.     ["List Words Beginning With..." webster-endings t]
  399.     ["Check Spelling Of..." webster-spell t]
  400.     "----"
  401.     ["Quit Webster" webster-quit t]
  402.     ))
  403.  
  404. (defun webster-menu (event)
  405.   (interactive "e")
  406.   (let ((text1 (webster-xref-data event nil))
  407.     (text2 (webster-xref-data event t)))
  408.     (if (equal text1 text2) (setq text2 nil))
  409.     (let ((popup-menu-titles t))
  410.       (popup-menu
  411.        (nconc (list (car webster-menu))
  412.           (if text1 (list (vector (format "Define %s" (upcase text1))
  413.                       (list 'webster text1) t)))
  414.           (if text2 (list (vector (format "Define %s" (upcase text2))
  415.                       (list 'webster text2) t)))
  416.           (cdr webster-menu))))))
  417.  
  418.  
  419. (defvar webster-mode-map nil)
  420. (if webster-mode-map
  421.     nil
  422.   (setq webster-mode-map (make-sparse-keymap))
  423.   (define-key webster-mode-map "?" 'describe-mode)
  424.   (define-key webster-mode-map "d" 'webster)
  425.   (define-key webster-mode-map "e" 'webster-endings)
  426.   (define-key webster-mode-map "q" 'webster-quit)
  427.   (define-key webster-mode-map "s" 'webster-spell)
  428.   (cond ((string-match "XEmacs" emacs-version)
  429.      (define-key webster-mode-map 'button2 'webster-xref-word)
  430.      (define-key webster-mode-map 'button3 'webster-menu)))
  431.   )
  432.  
  433. (defun webster-mode ()
  434.   "Major mode for interacting with on-line Webster's dictionary.
  435. \\{webster-mode-map}
  436. Use webster-mode-hook for customization."
  437.   (interactive)
  438.   (kill-all-local-variables)
  439.   (setq major-mode 'webster-mode)
  440.   (setq mode-name "Webster")
  441.   (use-local-map webster-mode-map)
  442.   (setq mode-line-process '(" " webster-state))
  443.   (make-local-variable 'kill-buffer-hook)
  444.   (if (not (string= (buffer-name (current-buffer)) "*webster*"))
  445.       (setq kill-buffer-hook '(lambda ()
  446.                 (if (get-buffer "*webster*")
  447.                     (kill-buffer "*webster*")))))
  448.   (set (make-local-variable 'webster-start-mark)
  449.        (set-marker (make-marker) (point-max)))
  450.   (set (make-local-variable 'page-delimiter) "^-")
  451.   (if webster-iso8859/1 (setq ctl-arrow 'iso-8859/1))
  452.   (run-hooks 'webster-mode-hook))
  453.  
  454. ;; now in simple.el
  455. ;(defun current-word ()
  456. ;   "Word cursor is over, as a string."
  457. ;   (save-excursion
  458. ;      (let (beg end)
  459. ;     (re-search-backward "\\w" nil 2)
  460. ;     (re-search-backward "\\b" nil 2)
  461. ;     (setq beg (point))
  462. ;     (re-search-forward "\\w*\\b" nil 2)
  463. ;     (setq end (point))
  464. ;     (buffer-substring beg end))))
  465.  
  466. (defun webster-intern (string)
  467.   (intern (webster-strip-crud (webster-unISO (downcase string)))
  468.       webster-completion-table))
  469.  
  470. (defun webster-unISO (text)
  471.   ;; turn the ISO chars into the closest ASCII equiv (how they are indexed)
  472.   (while (string-match "\347" text) (aset text (match-beginning 0) ?c))
  473.   (while (string-match "\307" text) (aset text (match-beginning 0) ?C))
  474.   (while (string-match "\335" text) (aset text (match-beginning 0) ?Y))
  475.   (while (string-match "[\375\377]" text) (aset text (match-beginning 0) ?y))
  476.   (while (string-match "[\300-\305]" text) (aset text (match-beginning 0) ?A))
  477.   (while (string-match "[\310-\313]" text) (aset text (match-beginning 0) ?E))
  478.   (while (string-match "[\314-\317]" text) (aset text (match-beginning 0) ?I))
  479.   (while (string-match "[\322-\326]" text) (aset text (match-beginning 0) ?O))
  480.   (while (string-match "[\331-\334]" text) (aset text (match-beginning 0) ?U))
  481.   (while (string-match "[\340-\345]" text) (aset text (match-beginning 0) ?a))
  482.   (while (string-match "[\350-\353]" text) (aset text (match-beginning 0) ?e))
  483.   (while (string-match "[\354-\357]" text) (aset text (match-beginning 0) ?i))
  484.   (while (string-match "[\362-\366]" text) (aset text (match-beginning 0) ?o))
  485.   (while (string-match "[\371-\374]" text) (aset text (match-beginning 0) ?u))
  486.   text)
  487.  
  488. (defun webster-strip-crud (text)
  489.   (while (string-match ".\b" text)
  490.     (setq text (concat (substring text 0 (match-beginning 0))
  491.                (substring text (match-end 0)))))
  492.   text)
  493.  
  494.  
  495. (defun webster-textify-region (start end &optional nointern)
  496.   (save-excursion
  497.     (goto-char (1- end))
  498.     (if (looking-at "[^\n]\n") (setq end (1+ end)))
  499.     (save-restriction
  500.      (let ((case-fold-search nil))
  501.       (narrow-to-region start end)
  502.       ;; translate silly "special character" codes into something we can use.
  503.       ;; we need to do this before nuking the recursive backspace codes.
  504.       ;;
  505.       ;; Note that mostly these are used as modifiers, like "h(\bQsub-dot)\bQ"
  506.       ;; meaning h with a dot under it.  We don't handle any of that...
  507.       ;;
  508.       (goto-char (point-min))
  509.       (while (re-search-forward "(\bQ[-a-z0-9*$ ]+)\bQ" nil t)
  510.     (goto-char (match-beginning 0))
  511.     (let ((s (point))
  512.           (e (match-end 0)))
  513.       (forward-char 3)
  514.       (if (cond
  515.            ((looking-at "circumflex")    (insert ?^)    t)
  516.            ((looking-at "brace")        (insert ?\{)    t)
  517.            ((looking-at "tilda")        (insert ?\~)    t)
  518.            ((looking-at "prime")        (insert ?\')    t)
  519.            ((looking-at "accent grave")    (insert ?\`)    t)
  520.            ((looking-at "accent acute")    (insert ?\264)    t)
  521.            ((looking-at "sub-diaeresis")    (insert ?\250)    t)
  522.            ((looking-at "macron")        (insert ?\257)    t)
  523.            ((looking-at "a-e")         (insert ?\346)    t)
  524.            ((looking-at "curly-N")        (insert ?\361)    t)
  525.            ((looking-at "sub-macron")    (insert ?\367)    t)
  526.            ((looking-at "slash-o")        (insert ?\370)    t)
  527.            ((looking-at "cidilla")        (insert ?\371)    t)
  528.            ((looking-at "sup-circle")    (insert ?\372)    t)
  529.            ((looking-at "macron-tilda")    (insert ?\373)    t)
  530.            ((looking-at "hachek")        (insert ?\374)    t)
  531.            ((looking-at "sub-breve")    (insert ?\375)    t)
  532.            ((looking-at "breve")        (insert ?\376)    t)
  533.            ((looking-at "sub-dot")        (insert ?\377)    t)
  534.            ((looking-at "double-bar-\\$")    (insert ?$)    t)
  535.            ;; talk about your special-purpose characters...
  536.            ((looking-at "10\\*10\\*100")
  537.         (delete-region s e)
  538.         (insert "10^10^100")
  539.         nil)
  540.            ((looking-at "plus squareroot -1")
  541.         (delete-region s e)
  542.         (insert "sqrt(-1)")
  543.         nil)
  544.            ;; We don't handle these yet:
  545.            ;; aleph ayin beth breve c-bar check daleth double-arrows
  546.            ;; double-half-arrows double-hyphen edh fermata-up fermata-down
  547.            ;; fist flat-sign g-sub-macron gimel hachek he heth kaph lamed
  548.            ;; mem natural-sign nun parallel pe presa prime qoph radical
  549.            ;; radical-sign resh sadhe samekh shin sin slur-down spade
  550.            ;; stacked-commas tau teth thorn triple-bond waw yod yogh
  551.            ;; zayin "* * *" sadhe(final) "3 character overbar"
  552.            (t nil))
  553.           (progn
  554.         (delete-region s (+ s 3))
  555.         (delete-region (+ s 1) (- e 2))))))
  556.       
  557.       ;; nuke silly recursive backspace codes
  558.       (goto-char (point-min))
  559.       (while (search-forward "|\bB" nil t)
  560.     (goto-char (point-min))
  561.     (save-excursion
  562.       (while (search-forward "|\bB" nil t)
  563.         (delete-char -3)
  564.         (insert "\b"))))
  565.       ;; convert @ to ~
  566.       (goto-char (point-min))
  567.       (while (search-forward "@" nil t)
  568.     (delete-char -1) (insert "~")
  569.     (if webster-fontify
  570.         (webster-fontify (- (point) 1) (point) 'webster-bold-italic)))
  571.       ;; now convert lots of other magic codes...
  572.       (goto-char (point-min))
  573.       (while (search-forward "\b" nil t)
  574.     (delete-char -1)
  575.     (forward-char -1)
  576.     (cond
  577.  
  578.      ((looking-at "([MXYAIJ]")
  579.       ;; start smallcaps/italic/bold/super/sub/subitalic
  580.       (looking-at "([MXYAIJ]\\([^\)]*\\))")
  581.       (let ((start (match-beginning 1))
  582.         (end (match-end 1)))
  583.         (and (not nointern) (looking-at "(M")
  584.          (webster-intern (buffer-substring start end)))
  585.         (if webster-fontify
  586.         (let ((c (char-after (1- start))))
  587.           (webster-fontify start end
  588.                    (cond ((= ?M c) 'webster-small)
  589.                      ((= ?X c) 'webster-italic)
  590.                      ((= ?Y c) 'webster-bold)
  591.                      ((= ?A c) 'webster-superscript)
  592.                      ((= ?I c) 'webster-subscript)
  593.                      ((= ?J c) 'webster-subscript)
  594.                      )
  595.                    (= ?M c))))))
  596.  
  597.      ;; #### dubious
  598.      ((looking-at "([BGR]")    ; start greek/APL/symbol
  599.       (and webster-fontify
  600.            (looking-at "(\\(.\\)[^\)]*)\^H\\1")
  601.            (let ((c (char-after (1- (match-beginning 1)))))
  602.          (webster-fontify
  603.           (match-beginning 0) (match-end 0) 'webster-small))))
  604.  
  605.      ((looking-at ")[ABGIJMRXY]")    ; end font-shift
  606.       nil)
  607.  
  608.      ((looking-at "<(\\|(<")
  609.       (insert (if webster-iso8859/1 ?\253 "<<"))
  610.       (if webster-fontify
  611.           (let ((p (point))
  612.             (e (and (save-excursion (search-forward ")\b>" nil t))
  613.                 (match-beginning 0))))
  614.         (if e
  615.             (webster-fontify p e 'webster-italic)))))
  616.  
  617.      ((looking-at ")>\\|>)")
  618.       (insert  (if webster-iso8859/1 ?\273 ">>")))
  619.  
  620.      ;; #### dubious
  621.      ((looking-at "[a-z\346][-._]")    ; lineover,dotover/under,over/underbar
  622.       (insert (following-char))
  623.       (if webster-fontify
  624.           (webster-fontify (- (point) 1) (point) 'webster-underline)))
  625.  
  626.      ((looking-at "[a-zA-Z]:")    ; umlaut
  627.       (let (c)
  628.         (if (and webster-iso8859/1
  629.              (setq c (cdr (assq (following-char) webster-umlauts))))
  630.         (insert c)
  631.           (insert (following-char))
  632.           (insert (if webster-iso8859/1 ?\250 ?:)))))
  633.  
  634.      ((looking-at "[\"~][a-zA-Z]")    ; umlaut
  635.       (let (c)
  636.         (delete-char 1)
  637.         (if (and webster-iso8859/1
  638.              (setq c (cdr (assq (following-char) webster-umlauts))))
  639.         (insert c)
  640.           (insert (following-char))
  641.           (insert (if webster-iso8859/1 ?\250 ?:)))
  642.         (insert " ")
  643.         (forward-char -1)))
  644.  
  645.      ((looking-at "[a-zA-Z]\)")    ; grave
  646.       (let (c)
  647.         (if (and webster-iso8859/1
  648.              (setq c (cdr (assq (following-char) webster-graves))))
  649.         (insert c)
  650.           (insert (following-char))
  651.           (insert "`"))))
  652.  
  653.      ((looking-at ">[a-zA-Z]")    ; grave
  654.       (let (c)
  655.         (delete-char 1)
  656.         (if (and webster-iso8859/1
  657.              (setq c (cdr (assq (following-char) webster-graves))))
  658.         (insert c)
  659.           (insert (following-char))
  660.           (insert "`"))
  661.         (insert " ")
  662.         (forward-char -1)))
  663.  
  664.      ((looking-at "[a-zES]\(")    ; acute
  665.       (let (c)
  666.         (if (and webster-iso8859/1
  667.              (setq c (cdr (assq (following-char) webster-acutes))))
  668.         (insert c)
  669.           (insert (following-char))
  670.           (insert (if webster-iso8859/1 ?\264 ?\')))))
  671.  
  672.      ((looking-at "<[a-zA-Z]")    ; acute
  673.       (let (c)
  674.         (delete-char 1)
  675.         (if (and webster-iso8859/1
  676.              (setq c (cdr (assq (following-char) webster-acutes))))
  677.         (insert c)
  678.           (insert (following-char))
  679.           (insert (if webster-iso8859/1 ?\264 ?\')))
  680.         (insert " ")
  681.         (forward-char -1)))
  682.  
  683.      ((looking-at ";[Cc]")        ; ccedilla
  684.       (delete-char 1)
  685.       (if webster-iso8859/1
  686.           (progn
  687.         (insert (if (= (following-char) ?C) ?\307 ?\347))
  688.         (insert ? ) (forward-char -1))
  689.         (forward-char 1)
  690.         (insert ?\,)))
  691.  
  692.      ((looking-at "|S")        ; section
  693.       (insert (if webster-iso8859/1 ?\247 "SS")))
  694.  
  695.      ((looking-at "|q")        ; paragraph
  696.       (insert (if webster-iso8859/1 ?\266 "PP")))
  697.  
  698.      ((looking-at "*o")        ; centerdot
  699.       (insert (if webster-iso8859/1 ?\267 ?\*)))
  700.  
  701.      ((looking-at "+=")        ; plusminus
  702.       (insert (if webster-iso8859/1 ?\261 "+/-")))
  703.  
  704.      ((looking-at "-:")        ; division
  705.       (insert (if webster-iso8859/1 ?\367 "+/-")))
  706.  
  707.      ((looking-at "-[xX]")        ; multiplication
  708.       (insert (if webster-iso8859/1 ?\327 "+/-")))
  709.  
  710.      ((looking-at "-m") (insert "--"))
  711.      ((looking-at "-n") (insert "-"))
  712.      ((looking-at "-/") (insert "\\"))
  713.      ((looking-at ")|") (insert ?\[))
  714.      ((looking-at "|)") (insert ?\]))
  715.      ((looking-at "-3") (insert "..."))
  716.      ((looking-at "=\\\\") (insert "$"))
  717.  
  718.      ((looking-at "'o")        ; degree
  719.       (insert (if webster-iso8859/1 ?\260 ?\*)))
  720.  
  721.      ((or (looking-at "nj")        ; nj symbol
  722.           (looking-at "|-")        ; dagger
  723.           (looking-at "|=")        ; doubledagger
  724.           (looking-at "|o")        ; lowerphi
  725.           (looking-at "'b")        ; stroke
  726.           )
  727.       (if webster-fontify
  728.           (webster-fontify (point) (+ (point) 2) 'webster-bold))
  729.       (insert "  ")
  730.       (forward-char -2))
  731.  
  732.      ((looking-at "[cC]\371")    ; (\bQcidilla)\bQ
  733.       (if webster-iso8859/1
  734.           (insert (if (= (following-char) ?C) ?\307 ?\347))
  735.         (forward-char 1)
  736.         (insert ?\,)))
  737.  
  738. ;     ((or (looking-at "[a-zA-Z]\250")    ; (\bQsub-diaeresis)\bQ
  739. ;          (looking-at "[a-zA-Z]\346")    ; (\bQa-e)\bQ
  740. ;          (looking-at "[a-zA-Z]\361")    ; (\bQcurly-N)\bQ
  741. ;          (looking-at "[a-zA-Z]\367")    ; (\bQsub-macron)\bQ
  742. ;          (looking-at "[a-zA-Z]\370")    ; (\bQslash-o)\bQ
  743. ;          (looking-at "[a-zA-Z]\371")    ; (\bQcidilla)\bQ
  744. ;          (looking-at "[a-zA-Z]\372")    ; (\bQsup-circle)\bQ
  745. ;          (looking-at "[a-zA-Z]\373")    ; (\bQmacron-tilda)\bQ
  746. ;          (looking-at "[a-zA-Z]\374")    ; (\bQhachek)\bQ
  747. ;          (looking-at "[a-zA-Z]\375")    ; (\bQsub-breve)\bQ
  748. ;          (looking-at "[a-zA-Z]\376")    ; (\bQbreve)\bQ
  749. ;          (looking-at "[a-zA-Z]\377")    ; (\bQsub-dot)\bQ
  750. ;          )
  751. ;      (forward-char 1) (insert " ") (forward-char -1)
  752. ;      (webster-fontify (1- (point)) (point) 'webster-underline))
  753.  
  754.      ((looking-at "/[a-zA-Z]")        ; greek
  755.       (forward-char 1)
  756.       (insert " <")
  757.       (forward-char 1)
  758.       (insert ?\>)
  759.       (forward-char -5))
  760.  
  761.      ;; overstrike
  762.      ((looking-at (format "[%c][%c]" (following-char) (following-char)))
  763.       (insert (following-char))
  764.       (if webster-fontify
  765.           (webster-fontify (- (point) 1) (point) 'webster-bold)))
  766.  
  767.      (t                ; ## debug
  768.       (insert (following-char))
  769.       (insert "\b")
  770.       (insert (buffer-substring (+ 1 (point)) (+ 2 (point))))
  771.       ))
  772.     (delete-char 2))
  773.  
  774.       (goto-char (point-min))
  775.       (setq start (point)
  776.         end (point-max))
  777.       (widen)
  778.       (beginning-of-line)
  779.       (narrow-to-region (point) end)
  780.       (goto-char start)
  781.       ;; (fill-region-as-paragraph (point-min) (point-max))
  782.       (while (not (eobp))
  783.     (setq start (point))
  784.     (skip-chars-forward "^ \n\t")
  785.     (if (>= (current-column) fill-column)
  786.         (progn
  787.           (goto-char start)
  788.           (delete-horizontal-space)
  789.           (insert "\n" (or fill-prefix "")))
  790.       (skip-chars-forward " \n\t")))
  791.       ))))
  792.  
  793.  
  794. (defun webster-pos (start end)
  795.   (save-excursion
  796.     (goto-char start)
  797.     (cond ((and (= start (1- end)) (looking-at "n")) "noun")
  798.       ((or (not webster-fontify) (/= start (- end 2)))
  799.        (buffer-substring start end))
  800.       ((looking-at "ac") "adjective combinational form")
  801.       ((looking-at "aj") "adjective")
  802.       ((looking-at "as") "adjective suffix")
  803.       ((looking-at "av") "adverb")
  804.       ((looking-at "ca") "adjective combinational form")
  805.       ((looking-at "cf") "combinational form")
  806.       ((looking-at "cj") "conjunction")
  807.       ((looking-at "da") "definite article")
  808.       ((looking-at "ia") "indefinite article")
  809.       ((looking-at "ij") "interjection")
  810.       ((looking-at "is") "interjection suffix")
  811.       ((looking-at "js") "adjective suffix")
  812.       ((looking-at "nc") "noun combinational form")
  813.       ((looking-at "np") "noun plural suffix")
  814.       ((looking-at "ns") "noun suffix")
  815.       ((looking-at "pf") "prefix")
  816.       ((looking-at "pn") "pronoun")
  817.       ((looking-at "pp") "preposition")
  818.       ((looking-at "sf") "verb suffix")
  819.       ((looking-at "tm") "trademark")
  820.       ((looking-at "va") "verbal auxilliary")
  821.       ((looking-at "vb") "verb")
  822.       ((looking-at "vc") "verb combinational form")
  823.       ((looking-at "vi") "verb intransitive")
  824.       ((looking-at "vm") "verb impersonal")
  825.       ((looking-at "vp") "verb imperfect")
  826.       ((looking-at "vs") "verb suffix")
  827.       ((looking-at "vt") "verb transitive")
  828.       (t (buffer-substring start end)))))
  829.  
  830.  
  831. (defun webster-convert ()
  832.   (goto-char (point-min))
  833.   ;; nuke the continuation lines
  834.   (save-excursion
  835.     (while (re-search-forward "^C:" nil t)
  836.       (forward-char -2)
  837.       (while (looking-at "^C:")
  838.     (forward-line 1))
  839.       (forward-line -1)
  840.       (while (looking-at "^C:")
  841.     (forward-char -1)
  842.     (let ((n (- (point) (save-excursion (beginning-of-line) (point)))))
  843.       (delete-char 3)
  844.       ;; What a stupid format!  (example: "fat")
  845.       (if (= n 79) (insert " "))
  846.       (beginning-of-line)))))
  847.   (goto-char (point-min))
  848.   (let ((last-type nil)
  849.     (this-type nil)
  850.     (last-part nil))
  851.     (while (not (eobp))
  852.       (setq this-type (following-char))
  853.       (cond
  854.        ((looking-at "^WORD ")
  855.     (let ((p (point)))
  856.       (end-of-line)
  857.       (delete-region p (point))))
  858.  
  859.        ((looking-at "^21[12] ")    ; reply to a LIST command; one line.
  860.     (delete-char 4))
  861.        ((looking-at "^220 ")    ; reply to a LIST command; intern the results.
  862.     (let ((p (point)))
  863.       (if (eq (preceding-char) ?\n) (setq p (1- p)))
  864.       (end-of-line)
  865.       (delete-region p (point)))
  866.     (insert "\n")
  867.     (while (not (or (eobp) (looking-at "\n\n")))
  868.       (forward-line 1)
  869.       (insert "    ")
  870.       (let (s e)
  871.         (while (looking-at "[^\n;]+;")
  872.           (webster-intern (buffer-substring (setq s (match-beginning 0))
  873.                         (setq e (1- (match-end 0)))))
  874.           (goto-char (match-end 0))
  875.           (insert " ")
  876.           (if webster-fontify
  877.           (webster-fontify s e 'webster-bold t)))
  878.         (if (looking-at "\n")
  879.         nil
  880.           (webster-intern
  881.            (buffer-substring (setq s (point))
  882.                  (progn (end-of-line) (setq e (point)))))
  883.           (if webster-fontify
  884.           (webster-fontify s e 'webster-bold t)))
  885.         )))
  886.  
  887.        ((looking-at "^\n")
  888.     (delete-char 1))
  889.  
  890.        ((looking-at "^\\(200\\|221\\|PREFIX\\|LIST\\|EXACT\\)[- ]")
  891.     ;; just toss these.
  892.     (let ((p (point)))
  893.       (if (eq (preceding-char) ?\n) (setq p (1- p)))
  894.       (end-of-line)
  895.       (delete-region p (point))))
  896.  
  897.        ((looking-at "^F:")
  898.     ;; First record:  F:entname;homono;prefsuf;dots;accents;pos;posjoin;pos2
  899.     (delete-char 2)
  900.     (search-forward ";")
  901.     (let ((p (1- (point)))
  902.           homonym prefix dots pos posj pos2)
  903.       (if (looking-at "[0-9]+")
  904.           (setq homonym (buffer-substring (point) (match-end 0))))
  905.       (search-forward ";")
  906.       (if (looking-at "[^;]+")
  907.           (setq prefix (buffer-substring (point) (match-end 0))))
  908.       (search-forward ";")
  909.       (if (looking-at "[0-9]+")
  910.           (setq dots (append (buffer-substring (point) (match-end 0))
  911.                  nil)))
  912.       (search-forward ";")
  913.       ;; ignore accents
  914.       (search-forward ";")
  915.       (if (looking-at "[a-z]+")
  916.           (setq pos (webster-pos (point) (match-end 0))))
  917.       (search-forward ";")
  918.       (if (looking-at "[a-z]+")
  919.           (setq posj (webster-pos (point) (match-end 0))))
  920.       (if (looking-at "[a-z]+")
  921.           (setq pos2 (webster-pos (point) (match-end 0))))
  922.       (end-of-line)
  923.       (delete-region p (point))
  924.       (beginning-of-line)
  925.       (insert " ")
  926.       (let ((e (save-excursion (end-of-line) (point))))
  927.         (webster-intern (buffer-substring (point) e))
  928.         (if webster-fontify
  929.         (webster-fontify (point) e 'webster-bold t)))
  930.       (beginning-of-line)
  931.       (if (not homonym)
  932.           (insert " ")
  933.         (let ((p (point)))
  934.           (insert homonym)
  935.           (if webster-fontify
  936.           (webster-fontify p (point) 'webster-bold-italic))))
  937.       (forward-char 1)
  938.       (while dots
  939.         (forward-char (- (car dots) ?0))
  940.         (insert ".")
  941.         (setq dots (cdr dots)))
  942.       (end-of-line)
  943.       (let ((p (point)))
  944.         (if pos (insert " " pos))
  945.         (if posj (insert " " posj))
  946.         (if pos2 (insert " " pos2))
  947.         (if (and webster-fontify (or pos posj pos2))
  948.         (webster-fontify p (point) 'webster-italic)))
  949.       (insert "  ")
  950.       ;; prefix/suffix is "p" or "s"; I don't know what it's for.
  951.       (setq last-part pos)))
  952.  
  953.        ((looking-at "^P:")
  954.     ;; Pronunciation: P:text
  955.     (delete-char 2) (delete-char -1)
  956.     (insert " \\")
  957.     (let ((p (point))
  958.           (fill-prefix "     "))
  959.       (end-of-line)
  960.       (insert " ")
  961.       (if webster-fontify
  962.           (progn
  963.         (webster-fontify (1- p) (1- (point)) 'webster-italic)
  964.         (forward-char -1)))
  965.       (webster-textify-region p (point))
  966.       (insert "\\")))
  967.  
  968.        ((looking-at "E:")
  969.     ;; Etymology:  E:text
  970.     (delete-char 2) (insert "   [")
  971.     (let ((fill-prefix "    "))
  972.       (webster-textify-region (point) (progn (end-of-line) (point))))
  973.     (insert "]"))
  974.  
  975.        ((looking-at "S:")
  976.     ;; Synonym:  S:text
  977.     (delete-char 2) (insert "  ")
  978.     (let ((fill-prefix "      "))
  979.       (webster-textify-region (point) (progn (end-of-line) (point)))))
  980.  
  981.        ((looking-at "X:")
  982.     ;; Cross Reference:  X:word;wrdsuper;wrdsubs;type;word2
  983.     (setq last-part nil)
  984.     (let (p word super sub type word2)
  985.       (delete-char 2)
  986.       (setq p (point))
  987.       (if (looking-at "[^;]+")
  988.           (setq word (upcase (buffer-substring (point) (match-end 0)))))
  989.       (search-forward ";")
  990.       (if (looking-at "[^;]+")
  991.           (setq super (buffer-substring (point) (match-end 0))))
  992.       (search-forward ";")
  993.       (if (looking-at "[^;]+")
  994.           (setq sub (buffer-substring (point) (match-end 0))))
  995.       (search-forward ";")
  996.       (if (looking-at "[0-9]+")
  997.           (setq type (string-to-int
  998.               (buffer-substring (point) (match-end 0)))))
  999.       (search-forward ";")
  1000.       (if (looking-at  "[^;]+")
  1001.           (setq word2 (upcase (buffer-substring (point) (match-end 0)))))
  1002.       (delete-region p (point))
  1003.       (insert "  ")
  1004.       (cond ((eq type 0) (insert "see (\bM" word ")\bM"))
  1005.         ((eq type 1) (insert "see (\bM" word ")\bM table"))
  1006.         ((eq type 2) (insert "### ILLEGAL XREF CODE 2"))
  1007.         ((eq type 3) (insert "see (\bM" word2 ")\bM at (\bM" word
  1008.                      ")\bM table"))
  1009.         ((eq type 4) (insert "compare (\bM" word ")\bM"))
  1010.         ((eq type 5) (insert "compare (\bM" word ")\bM table"))
  1011.         ((eq type 6) (insert "called also (\bM" word ")\bM"))
  1012.         ((eq type 7) (insert "### ILLEGAL XREF CODE 7"))
  1013.         ((eq type 8) (insert "(\bYsyn)\bY see in addition (\bM" word
  1014.                      ")\bM"))
  1015.         ((eq type 9) (insert "(\bYsyn)\bY see (\bM" word ")\bM"))
  1016.         (t (insert "#### ILLEGAL XREF CODE " (or type "nil"))))
  1017.       (let ((fill-prefix "     "))
  1018.         (webster-textify-region p (point)))))
  1019.  
  1020.        ((looking-at "D:")
  1021.     ;; Definition:  D:snsnumber;snsletter;snssubno;pos;text
  1022.     (let (p n sub1 sub2 part)
  1023.       (setq p (point))
  1024.       (forward-char 2)
  1025.       (if (looking-at "[0-9]+")
  1026.           (setq n (buffer-substring (point) (match-end 0))))
  1027.       (search-forward ";")
  1028.       (if (looking-at "[a-z]+")
  1029.           (setq sub1 (buffer-substring (point) (match-end 0))))
  1030.       (search-forward ";")
  1031.       (if (looking-at "[0-9]+")
  1032.           (setq sub2 (buffer-substring (point) (match-end 0))))
  1033.       (search-forward ";")
  1034.       (if (looking-at "[a-z]+")
  1035.           (setq part (webster-pos (point) (match-end 0))))
  1036.       (search-forward ";")
  1037.       (delete-region p (point))
  1038.       (if (and sub2 (not (equal sub2 "1")))
  1039.           (setq sub1 " "))
  1040.       (if (and sub1 (not (equal sub1 "a")))
  1041.           (setq n " "))
  1042.       ;; If a Definition appears after a Label, don't print numbers
  1043.       ;; as the label has done that already.
  1044.       (if (eq last-type ?L)
  1045.           (setq n (and n " ") sub1 (and sub1 " ") sub2 (and sub2 " ")))
  1046.       (if (and part (not (equal part last-part)))
  1047.           (let ((p (point)))
  1048.         (insert "   " part "\n")
  1049.         (if webster-fontify
  1050.             (webster-fontify p (1- (point)) 'webster-italic))
  1051.         (setq last-part part)))
  1052.       (indent-to (- 6 (length n)))
  1053.       (setq p (point))
  1054.       (if (and n (not (equal n "0")))
  1055.           (insert n " "))
  1056.       (if sub1 (insert " " sub1 " "))
  1057.       (if sub2 (insert " (" sub2 ") "))
  1058.       (insert ": ")
  1059.       (if webster-fontify
  1060.           (webster-fontify p (point) 'webster-bold-italic))
  1061.       (setq p (point))
  1062.       (end-of-line)
  1063.       (let ((fill-prefix (make-string (if sub2 17 (if sub1 12 9)) ? )))
  1064.         (webster-textify-region p (point)))))
  1065.  
  1066.        ((looking-at "R:")
  1067.     ;; Run-on:  R:name;dots;accents;pos1;posjoin;pos2
  1068.     (delete-char 2)
  1069.     (insert "  ")
  1070.     (search-forward ";") (delete-char -1)
  1071.     (let ((beg (save-excursion (beginning-of-line) (+ (point) 2))))
  1072.       (webster-intern (buffer-substring beg (point)))
  1073.       (if webster-fontify
  1074.           (webster-fontify beg (point) 'webster-bold t)))
  1075.     (if (looking-at "[0-9]+")
  1076.         (let* ((dots (append (buffer-substring (point) (match-end 0))
  1077.                  nil)))
  1078.           (delete-region (point) (match-end 0))
  1079.           (beginning-of-line)
  1080.           (forward-char 2)
  1081.           (while dots
  1082.         (forward-char (- (car dots) ?0))
  1083.         (insert ".")
  1084.         (setq dots (cdr dots)))))
  1085.     (search-forward ";") (delete-char -1)
  1086.     ;; throw away the accents
  1087.     (let ((p (point)))
  1088.       (search-forward ";")
  1089.       (delete-region p (point)))
  1090.     (insert " ")
  1091.     (if (looking-at "[a-z][a-z]?;")
  1092.         (let* ((start (point))
  1093.            (end (1- (match-end 0)))
  1094.            (pos (webster-pos start end)))
  1095.           (delete-region start end)
  1096.           (insert pos)
  1097.           (if webster-fontify
  1098.           (webster-fontify start (point) 'webster-italic))))
  1099.     (cond ((search-forward ";" nil t) (delete-char -1) (insert " ")))
  1100.     (cond ((search-forward ";" nil t) (delete-char -1) (insert " "))))
  1101.  
  1102.        ((looking-at "L:")
  1103.     ;; Label:  L:snsnumber;snsletter;snssubno;text
  1104.     (let (p n sub1 sub2)
  1105.       (setq p (point))
  1106.       (forward-char 2)
  1107.       (if (looking-at "[0-9]+")
  1108.           (setq n (buffer-substring (point) (match-end 0))))
  1109.       (search-forward ";")
  1110.       (if (looking-at "[a-z]+")
  1111.           (setq sub1 (buffer-substring (point) (match-end 0))))
  1112.       (search-forward ";")
  1113.       (if (looking-at "[0-9]+")
  1114.           (setq sub2 (buffer-substring (point) (match-end 0))))
  1115.       (search-forward ";")
  1116.       (delete-region p (point))
  1117.       (if (and sub2 (not (equal sub2 "1")))
  1118.           (setq sub1 " "))
  1119.       (if (and sub1 (not (equal sub1 "a")))
  1120.           (setq n " "))
  1121.       (indent-to (- 6 (length n)))
  1122.       (setq p (point))
  1123.       (if (not (equal n "0"))
  1124.           (insert (or n " ") " "))
  1125.       (if sub1 (insert " " sub1))
  1126.       (if sub2 (insert " (" sub2 ")"))
  1127.       (insert " ")
  1128.       (if webster-fontify
  1129.           (webster-fontify p (point) 'webster-bold-italic))
  1130.       (setq p (point))
  1131.       (end-of-line)
  1132.       (let ((fill-prefix (make-string (if sub2 17 (if sub1 12 9)) ? )))
  1133.         (webster-textify-region p (point)))))
  1134.  
  1135.        ((looking-at "V:")
  1136.     ;; Variant:  V:name;dots;accents;level1()level2
  1137.     (delete-char 2)
  1138.     (let ((p (point))
  1139.           beg)
  1140.       (search-forward ";") (delete-char -1)
  1141.       (webster-intern (buffer-substring
  1142.                (save-excursion (beginning-of-line)
  1143.                        (setq beg (point)))
  1144.                (point)))
  1145.       (if webster-fontify
  1146.           (webster-fontify beg (point) 'webster-bold t))
  1147.       (if (looking-at "[0-9]+")
  1148.           (let* ((dots (append (buffer-substring (point) (match-end 0))
  1149.                    nil)))
  1150.         (delete-region (point) (match-end 0))
  1151.         (beginning-of-line)
  1152.         (while dots
  1153.           (forward-char (- (car dots) ?0))
  1154.           (insert ".")
  1155.           (setq dots (cdr dots)))))
  1156.       (search-forward ";") ; skip accents
  1157.       (delete-region (1- (point))
  1158.              (save-excursion (end-of-line) (point)))
  1159.       (let ((fill-prefix "    "))
  1160.         (webster-textify-region p (point) t)))
  1161.     (save-excursion
  1162.       (beginning-of-line)
  1163.       (cond ((eq last-type ?F) (delete-char -1))
  1164.         ((eq last-type ?V) (delete-char -1) (insert "; "))
  1165.         (t (insert "  ")))))
  1166.  
  1167.        ((looking-at ".\n")
  1168.     (delete-char 1))
  1169.        ((looking-at "22[0-9] ")
  1170.     (delete-region (point) (save-excursion (end-of-line) (point))))
  1171.        ((looking-at "\n")
  1172.     nil)
  1173.        (t
  1174.     (insert "* ")))
  1175.       (setq last-type this-type)
  1176.       (forward-line 1)
  1177.       (while (save-excursion
  1178.            (and (not (bobp))
  1179.             (progn (forward-line -1) (looking-at "\n"))))
  1180.     (delete-char -1))
  1181.       ))
  1182.   (goto-char (point-min))
  1183.   (cond ((search-forward "\^H" nil t)
  1184.      (goto-char (point-min))
  1185.      (insert
  1186.       "\n****\tThis definition contains unrecognized font-change codes."
  1187.       "\n****\tPlease tell jwz.\n\n")
  1188.      (goto-char (point-min))))
  1189.  
  1190.   ;; lay down the default font; don't put it over the spaces and tabs on
  1191.   ;; the beginning of the line so that those space as if it was a fixed
  1192.   ;; width font.  There must be a better way than 
  1193.   (if webster-fontify
  1194.       (save-excursion
  1195.     (let (e)
  1196.     (goto-char (point-min))
  1197.     (while (not (eobp))
  1198.       (skip-chars-forward " \t")
  1199.       ;; avoid extent overlaps; should be able to use extent priorities
  1200.       ;; to obviate this, but it's late.
  1201.       (while (setq e (extent-at (point)))
  1202.         (goto-char (1+ (extent-end-position e))))
  1203.       (setq e (make-extent (point) (progn (forward-line 1) (point))))
  1204.       (set-extent-face e 'webster)))))
  1205.   )
  1206.  
  1207.  
  1208. ;; Codes:
  1209. ;;
  1210. ;;    (A        start superscript    catalan
  1211. ;;    (B        start unknown        mixed number
  1212. ;;    (G        start greek        alpha
  1213. ;;    (I        start subscript        alcohol
  1214. ;;    (J        start subitalic        mixed number
  1215. ;;    (M        start small        mitten
  1216. ;;    (Q        start special        mitzvah
  1217. ;;    (R        start APL        mixed
  1218. ;;    (X        start italic        everywhere...
  1219. ;;    (Y        start bold        everywhere...
  1220. ;;    )A        end superscript        catalan
  1221. ;;    )B        end unknown        mixed number
  1222. ;;    )G        end greek        alpha
  1223. ;;    )I        end subscript        alcohol
  1224. ;;    )J        end subitalic        mixed number
  1225. ;;    )M        end small        mitten
  1226. ;;    )Q        end special        mitzvah
  1227. ;;    )R        end APL            mixed
  1228. ;;    )X        end italic        everywhere...
  1229. ;;    )Y        end bold        everywhere...
  1230. ;;    "a        a-umlaut        acetoacetic acid
  1231. ;;    "e        e-umlaut        agio
  1232. ;;    "i        i-umlaut        alcaic
  1233. ;;    "o        o-umlaut        ale
  1234. ;;    "u        u-umlaut        alpenglow
  1235. ;;    a:        a-umlaut        aardvark
  1236. ;;    n:        n-umlaut        pogy
  1237. ;;    o:        o-umlaut        coccyx
  1238. ;;    s:        s-umlaut        centrifugation
  1239. ;;    u:        u-umlaut        accouter
  1240. ;;    w:        w-umlaut        bourgeois
  1241. ;;    I:        I-umlaut        natural
  1242. ;;    ~a        a-umlaut        alcove
  1243. ;;    ~e        e-umlaut        Boxer
  1244. ;;    ~i        i-umlaut        Cistercian
  1245. ;;    ~o        o-umlaut        alcove
  1246. ;;    ~u        u-umlaut        Boxer
  1247. ;;    ~E        E-umlaut        arris
  1248. ;;    ~O        O-umlaut        prix fixe
  1249. ;;    >e        e-grave            arriere-pensee
  1250. ;;    >a        a-grave            pompano
  1251. ;;    >u        u-grave            coca
  1252. ;;    >E        E-grave
  1253. ;;    u)        u-grave
  1254. ;;    o)        o-grave
  1255. ;;    i)        i-grave
  1256. ;;    s)        s-grave
  1257. ;;    ;C        C-cedilla        compendia
  1258. ;;    ;c        c-cedilla        babassu
  1259. ;;    <E        E-acute
  1260. ;;    <a        a-acute
  1261. ;;    <e        e-acute
  1262. ;;    S(        S-acute
  1263. ;;    c(        c-acute
  1264. ;;    i(        i-acute
  1265. ;;    o(        o-acute
  1266. ;;    r(        r-acute
  1267. ;;    s(        s-acute
  1268. ;;    y(        y-acute
  1269. ;;    )>        guillemotright        everywhere...
  1270. ;;    <(        guillemotleft        everywhere...
  1271. ;;    (<        guillemotleft (?)    come
  1272. ;;    -m        longdash        pi
  1273. ;;    n_        nj            babbling
  1274. ;;    'o        degree            
  1275. ;;    |)        ]
  1276. ;;    |-        dagger
  1277. ;;    |=        doubledagger
  1278. ;;    |S        section
  1279. ;;    |o        lower-phi
  1280. ;;    |q        paragraph        paragraph
  1281. ;;    =\        "$"
  1282. ;;    (<        "<"
  1283. ;;    (|        "["
  1284. ;;    'b        stroke
  1285. ;;    *o        centerdot
  1286. ;;    +=        plusminus
  1287. ;;    -/        \
  1288. ;;    -3        "..."
  1289. ;;    -:        division
  1290. ;;    -X        multiplication
  1291. ;;    -n        "-"
  1292. ;;    -x        multiplication
  1293. ;;    ''        ' overstrike
  1294. ;;    ::        : overstrike
  1295. ;;    ;;        ; overstrike
  1296. ;;    MM        M overstrike
  1297. ;;    a-        a-lineover
  1298. ;;    e-        e-lineover
  1299. ;;    i-        i-lineover
  1300. ;;    o-        o-lineover
  1301. ;;    u-        u-lineover
  1302. ;;    y-        y-lineover
  1303. ;;    A-        A-lineover
  1304. ;;    E-        E-lineover
  1305. ;;    I-        I-lineover
  1306. ;;    O-        O-lineover
  1307. ;;    U-        U-lineover
  1308. ;;    Q-        Q-lineover2
  1309. ;;    a.        a-dotover
  1310. ;;    e.        e-dotover
  1311. ;;    m.        m-dotover
  1312. ;;    n.        n-dotover
  1313. ;;    o.        o-dotover
  1314. ;;    r.        r-dotover
  1315. ;;    u.        u-dotover
  1316. ;;    e_        e-lineunder
  1317. ;;    h_        h-lineunder
  1318. ;;    k_        k-lineunder
  1319. ;;    r-        r-lineunder
  1320. ;;    r_        r-lineunder
  1321. ;;    t_        t-lineunder
  1322. ;;    u_        u-lineunder
  1323. ;;    k-        k-dotunder
  1324.  
  1325. ;; t(\bQsub-dot)\bQ        t-dotunder
  1326. ;; s(\bQsub-dot)\bQ        s-dotunder
  1327. ;; h(\bQsub-dot)\bQ        h-dotunder        aceldama
  1328. ;; n(\bQsub-dot)\bQ        n-dotunder
  1329. ;; r(\bQsub-dot)\bQ        r-dotunder
  1330. ;; d(\bQsub-dot)\bQ        d-dotunder
  1331. ;; z(\bQsub-dot)\bQ        z-dotunder
  1332. ;; l(\bQsub-dot)\bQ        l-dotunder
  1333. ;; S(\bQsub-dot)\bQ        S-dotunder
  1334. ;; H(\bQsub-dot)\bQ        H-dotunder
  1335. ;; o(\bQsub-dot)\bQ        o-dotunder
  1336. ;; a(\bQsub-dot)\bQ        a-dotunder
  1337. ;; e(\bQbreve)\bQ        e-breve
  1338. ;; u(\bQbreve)\bQ        u-breve
  1339. ;; i(\bQbreve)\bQ        i-breve
  1340. ;; a(\bQbreve)\bQ        a-breve
  1341. ;; A(\bQbreve)\bQ        A-breve
  1342. ;; s(\bQbreve)\bQ        s-breve
  1343. ;; n(\bQbreve)\bQ        n-breve
  1344. ;; E(\bQbreve)\bQ        E-breve
  1345. ;; y(\bQbreve)\bQ        y-breve
  1346. ;; o(\bQbreve)\bQ        o-breve
  1347. ;; h(\bQsub-breve)\bQ        h-breve
  1348. ;; e(\bQhachek)\bQ        e-hachek
  1349. ;; s(\bQhachek)\bQ        s-hachek
  1350. ;; z(\bQhachek)\bQ        z-hachek
  1351. ;; c(\bQhachek)\bQ        c-hachek
  1352. ;; j(\bQhachek)\bQ        j-hachek
  1353. ;; i(\bQhachek)\bQ        i-hachek
  1354. ;; u(\bQhachek)\bQ        u-hachek
  1355. ;; g(\bQhachek)\bQ        g-hachek
  1356. ;; r(\bQhachek)\bQ        r-hachek
  1357. ;; a(\bQhachek)\bQ        a-hachek
  1358. ;; C(\bQhachek)\bQ        C-hachek
  1359. ;; a(\bQmacron-tilda)\bQ    a-macrontilda
  1360. ;; i(\bQmacron-tilda)\bQ    i-macrontilda
  1361. ;; e(\bQmacron-tilda)\bQ    e-macrontilda
  1362. ;; a(\bQsup-circle)\bQ        a-circleover
  1363. ;; A(\bQsup-circle)\bQ        A-circleover
  1364. ;; e(\bQcidilla)\bQ        e-cedilla
  1365. ;; o(\bQcidilla)\bQ        o-cedilla
  1366. ;; a(\bQcidilla)\bQ        a-cedilla
  1367. ;; z(\bQsub-diaeresis)\bQ    z-umlautunder
  1368. ;; r(\bQsub-diaeresis)\bQ    r-umlautunder
  1369. ;; t(\bQsub-macron)\bQ        t-lineunder
  1370. ;; B(\bQ3 character overbar)\bQ    B-lineover3
  1371.  
  1372. ;; (\bQa-e)\bQ-        ae-overbar (?)        herring
  1373.  
  1374. ;; "U            unknown
  1375. ;; '-            unknown
  1376. ;; 'a             unknown
  1377. ;; (j            unknown
  1378. ;; )o            unknown
  1379. ;; -             unknown
  1380. ;; -0            unknown
  1381. ;; ->            unknown
  1382. ;; -M            unknown
  1383. ;; -N            unknown
  1384. ;; -O            unknown
  1385. ;; -s            unknown
  1386. ;; ;(            unknown
  1387. ;; <'            unknown
  1388. ;; <A            unknown
  1389. ;; =S            unknown
  1390. ;; >'            unknown
  1391. ;; B             unknown
  1392. ;; G<            unknown
  1393. ;; G>            unknown
  1394. ;; I'            unknown
  1395. ;; O'            unknown
  1396. ;; S            unknown
  1397. ;; c|            unknown
  1398. ;; e@            unknown
  1399. ;; eg            unknown
  1400. ;; en            unknown
  1401. ;; er            unknown
  1402. ;; et            unknown
  1403. ;; i"            unknown
  1404. ;; l-            unknown
  1405. ;; m-            unknown
  1406. ;; n,            unknown
  1407. ;; nB            unknown
  1408. ;; o@            unknown
  1409. ;; os            unknown
  1410. ;; ot            unknown
  1411. ;; s,            unknown            chouse
  1412. ;; u@            unknown
  1413. ;; |             unknown
  1414.  
  1415. ;; /a            unknown            alpha
  1416. ;; /b            unknown
  1417. ;; /c            unknown
  1418. ;; /d            unknown
  1419. ;; /e            unknown
  1420. ;; /g            unknown
  1421. ;; /h            unknown
  1422. ;; /i            unknown
  1423. ;; /k            unknown
  1424. ;; /l            unknown
  1425. ;; /m            unknown
  1426. ;; /n            unknown
  1427. ;; /p            unknown
  1428. ;; /r            unknown
  1429. ;; /s            unknown
  1430. ;; /t            unknown
  1431. ;; /u            unknown
  1432. ;; /v            unknown
  1433. ;; /w            unknown
  1434. ;; /x            unknown
  1435. ;; /z            unknown
  1436.  
  1437. ;; /C            unknown
  1438. ;; /D            unknown
  1439. ;; /F            unknown
  1440. ;; /G            unknown
  1441. ;; /I            unknown
  1442. ;; /L            unknown
  1443. ;; /N            unknown
  1444. ;; /O            unknown
  1445. ;; /P            unknown
  1446. ;; /S            unknown
  1447. ;; /U            unknown
  1448. ;; /V            unknown
  1449. ;; /W            unknown
  1450. ;; /X            unknown
  1451.