kspell.el
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:10k
源码类别:

通讯编程

开发平台:

Visual C++

  1. ;; Alternative spelling enterface for Emacs, contributed by Don Knuth
  2. ;; (Uses the wordtest and extex programs, which are
  3. ;;  supplied as examples with the CWEB distribution,
  4. ;;  available by anonymous ftp from labrea.stanford.edu)
  5. ;; Based in part on "spell.el" from GNU Emacs; redistributed under
  6. ;; the terms of the GNU General Public License; NO WARRANTY implied.
  7. ;; To install this, using the default directories defined below,
  8. ;; install wordtest and extex in /usr/local/bin, then say
  9. ;; "ln /usr/local/bin/extex /usr/local/bin/excweb", then install
  10. ;; a suitable dictionary in /usr/local/lib/dict/words; one such
  11. ;; dictionary can be found in ~ftp/pub/dict/words at labrea.stanford.edu.
  12. ;; Also create an empty file called .words in your home directory.
  13. ;; Finally, add (load-library "kspell") to your .emacs file, or
  14. ;; include such a line in site-init.el if kspell is to be use by everybody.
  15. ;; If you get a message like "Checking spelling of buffer...not correct"
  16. ;; and nothing else, the probable cause is that the wordtest program
  17. ;; could not open /usr/local/lib/dict/words or ~/.words for reading.
  18. (provide 'kspell)
  19. (defvar wordtest-command "wordtest" ;; maybe "/usr/local/bin/wordtest" better?
  20.   "*Command to run the wordtest program; can include command-line options.")
  21. ;; "wordtest [options] [dictionaries] <infile >outfile" outputs all
  22. ;; lines of infile that don't appear in the dictionaries. The options
  23. ;; can define arbitrary character code mappings of 8-bit characters.
  24. ;; The default mapping takes a-z into A-Z, otherwise is ASCII.
  25. (defvar wordtest-filter "extex" ;; maybe "/usr/local/bin/extex" is better?
  26.   "*Command to run the filter needed by wordtest.")
  27. (make-variable-buffer-local 'wordtest-filter)
  28. ;; The extex filter extracts words from its input and outputs them on
  29. ;; separate lines as required by wordtest. It removes TeX control
  30. ;; sequences except those used to make accents and special characters.
  31. ;; There's a companion filter excweb that also removes C code from CWEBs.
  32. (setq cweb-mode-hook '(lambda () (setq wordtest-filter "excweb")))
  33. (defvar wordtest-system-dictionary "/usr/local/lib/dict/words"
  34.   "*Sorted dictionary containing all "correct" words,
  35. including all variant forms obtained by prefix and suffix transformations.")
  36. ;; The standard UNIX dictionary /usr/dict/words is NOT satisfactory.
  37. (defvar wordtest-personal-dictionary "~/.words"
  38.   "*Default dictionary to supplement the words in the system dictionary.
  39. If nil, no supplementary dictionary will be used.
  40. This dictionary must be in alphabetic order as defined by wordtest.
  41. Inserting any word with the + option to kspell-region will sort the file.")
  42. (make-variable-buffer-local 'wordtest-personal-dictionary)
  43. (defun set-personal-dictionary (filename)
  44.   "Defines the supplementary personal dictionary for kspell to use in the
  45. current buffer, overriding the default value of wordtest-personal-dictionary."
  46.   (interactive "FPersonal dictionary file name: ")
  47.   (setq wordtest-personal-dictionary filename))
  48. (defun unset-personal-dictionary ()
  49.   "Tells kspell not to use personal spelling dictionary with current buffer."
  50.   (interactive)
  51.   (setq wordtest-personal-dictionary nil))
  52. (defun insert-into-personal-dictionary (word)
  53.   "Put WORD into user's dictionary and sort that dictionary."
  54.   (interactive "sword: ")
  55.   (let ((xword (concat word "n")))
  56.     (if (null wordtest-personal-dictionary)
  57.         (setq wordtest-personal-dictionary
  58.               (read-string "Personal dictionary file name: " "~/.words")))
  59.     (set-buffer (find-file-noselect wordtest-personal-dictionary))
  60.     (goto-char (point-min))
  61.     (insert xword)
  62.     (call-process-region (point-min) (point-max) shell-file-name
  63.                          t t nil "-c" wordtest-command)
  64.     (search-backward xword (point-min) 1) ;; in case the user is watching
  65.     (while (not (bolp)) (search-backward xword (point-min) 1))
  66.     (save-buffer)))
  67.     
  68. (defun kspell-buffer ()
  69.   "Check spelling of every word in the buffer.
  70. For each incorrect word, you are asked for the correct spelling
  71. and then put into a query-replace to fix some or all occurrences.
  72. If you do not want to change a word, just give the same word
  73. as its "incorrect" spelling; then the query replace is skipped.
  74. Words are given in lowercase, but they will be Capitalized when
  75. replacing Capitalized words, ALL_CAPS when replacing ALL_CAPS words.
  76. If you type ? after a replacement, your correction will first be
  77. looked up in the dictionary, and the query-replace will occur
  78. only if the replacement is found. If you type + after a replacement,
  79. your replacement will be inserted into the current personal dictionary.
  80. You can leave the minibuffer to do some other editing and then come
  81. back again to the query-replace loop by typing \[other-window]."
  82.   (interactive)
  83.   (save-excursion (kspell-region (point-min) (point-max) "buffer")))
  84. (defun kspell-word ()
  85.   "Check spelling of the word at or before point.
  86. If it is not correct, ask user for the correct spelling and
  87. query-replace the entire buffer to substitute it as with kspell-buffer."
  88.   (interactive)
  89.   (let (beg end wordtest-filter)
  90.     (save-excursion
  91.      (if (not (looking-at "\<"))
  92.          (forward-word -1))
  93.      (setq beg (point))
  94.      (forward-word 1)
  95.      (setq end (point))
  96.      (kspell-region beg end (buffer-substring beg end)))))
  97. (defun kspell-region (start end &optional description)
  98.   "Like kspell-buffer but checks only words in the current region.
  99. Used in a program, applies from START to END.
  100. DESCRIPTION is an optional string naming the unit being checked:
  101. for example, "buffer"."
  102.   (interactive "r")
  103.   (let (correct
  104.         (filter wordtest-filter)
  105.         (buf (get-buffer-create " *kspell*")) ;; hidden by list-buffers
  106.         (dicts wordtest-system-dictionary))
  107.     (if wordtest-personal-dictionary
  108.         (setq dicts (concat dicts " " wordtest-personal-dictionary)))        
  109.     (save-excursion
  110.       (save-excursion
  111.         (set-buffer buf)
  112.         (widen)
  113.         (erase-buffer))
  114.       (message "Checking spelling of %s..." (or description "region"))
  115.       (if (and (null filter)
  116.                (< end (point-max))
  117.                (= ?n (char-after end)))
  118.           (call-process-region start (1+ end) shell-file-name
  119.                                nil buf nil "-c"
  120.                                (concat wordtest-command " " dicts))
  121.         (let ((oldbuf (current-buffer)))
  122.           (save-excursion
  123.             (set-buffer buf)
  124.             (insert-buffer-substring oldbuf start end)
  125.             (or (bolp) (insert ?n))
  126.             (if filter
  127.                 (call-process-region (point-min) (point-max) shell-file-name
  128.                                      t t nil "-c" filter))
  129.             (call-process-region (point-min) (point-max) shell-file-name
  130.                                  t t nil "-c"
  131.                                  (concat wordtest-command " " dicts)))))
  132.       (setq correct (save-excursion (set-buffer buf) (= (buffer-size) 0)))
  133.       (message "Checking spelling of %s...%scorrect"
  134.                (or description "region")
  135.                (if correct "" "not "))
  136.       (if correct t
  137.         (let (word newword qtext lastchar
  138.                    (case-fold-search t)
  139.                    (case-replace t))
  140.           (while (save-excursion
  141.                    (set-buffer buf)
  142.                    (> (buffer-size) 0))
  143.             (save-excursion
  144.               (set-buffer buf)
  145.               (goto-char (point-min))
  146.               (setq word (downcase
  147.                           (buffer-substring (point)
  148.                                             (progn (end-of-line) (point)))))
  149.               (forward-char 1) ;; pass the newline
  150.               (delete-region (point-min) (point))
  151.               (setq qtext (concat "\b" (regexp-quote word) "\b")))
  152.             (goto-char (point-min))
  153.             (setq lastchar nil)
  154.             (if (re-search-forward qtext nil t)
  155.                 (while (null lastchar)
  156.                   (setq newword
  157.                         (read-string
  158.                          (concat "edit a replacement for `" word "': ")
  159.                          word))
  160.                   (if (null newword) (setq lastchar 0)
  161.                     (setq lastchar (string-to-char (substring newword -1)))
  162.                     (if (memq lastchar '(?? ?+))
  163.                         (setq newword (substring newword 0 -1))))
  164.                   (cond ((= lastchar ??)
  165.                          (cond ((or (string= word newword) (string= "" newword))
  166.                                 (describe-function 'kspell-buffer)
  167.                                 (setq lastchar nil))
  168.                                ((not (kspelt-right newword))
  169.                                 (setq lastchar nil))))
  170.                         ((= lastchar ?+)
  171.                          (save-excursion
  172.                            (insert-into-personal-dictionary newword))))
  173.                   (cond ((string= word newword))
  174.                         ((null lastchar))
  175.                         (t
  176.                          (goto-char (point-min))
  177.                          (if (or (equal word newword) (null lastchar)) t
  178.                            (query-replace-regexp qtext newword))))))))))))
  179. (defun kspelt-right (word)
  180.   "T if WORD is in the system dictionary or user's personal dictionary."
  181.   (let ((buf (get-buffer-create " *temp*"))
  182.         (pdict wordtest-personal-dictionary))
  183.     (message "Checking spelling of %s..." word)
  184.     (save-excursion
  185.      (set-buffer buf)
  186.      (widen)
  187.      (erase-buffer)
  188.      (insert word "n")
  189.      (if pdict
  190.          (call-process-region (point-min) (point-max) shell-file-name
  191.                               t t nil "-c"
  192.                               (concat wordtest-command " "
  193.                                       wordtest-system-dictionary " "
  194.                                       pdict))
  195.        (call-process-region (point-min) (point-max) shell-file-name
  196.                             t t nil "-c"
  197.                             (concat wordtest-command " "
  198.                                     wordtest-system-dictionary)))
  199.      (= 0 (buffer-size)))))
  200. (defun kspell-string (string)
  201.   "Check spelling of string supplied as argument."
  202.   (interactive "sSpell string: ")
  203.   (message "%s is %scorrect" string
  204.            (if (kspelt-right string) "" "in")))