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