[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/textmodes/ispell.el
From: |
Richard M . Stallman |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/textmodes/ispell.el |
Date: |
Tue, 09 Aug 2005 10:11:49 -0400 |
Index: emacs/lisp/textmodes/ispell.el
diff -c emacs/lisp/textmodes/ispell.el:1.170
emacs/lisp/textmodes/ispell.el:1.171
*** emacs/lisp/textmodes/ispell.el:1.170 Sat Aug 6 17:41:14 2005
--- emacs/lisp/textmodes/ispell.el Tue Aug 9 14:11:49 2005
***************
*** 862,870 ****
--- 862,974 ----
)
"Non-nil means that the OS supports asynchronous processes.")
+ ;; Make ispell.el work better with aspell.
+
+ (defvar ispell-have-aspell-dictionaries nil
+ "Non-nil if we have queried Aspell for dictionaries at least once.")
+
+ (defun ispell-find-aspell-dictionaries ()
+ "Find Aspell's dictionaries, and record in `ispell-dictionary-alist'."
+ (interactive)
+ (unless ispell-really-aspell
+ (error "This function only works with aspell"))
+ (let ((dictionaries
+ (split-string
+ (with-temp-buffer
+ (call-process ispell-program-name nil t nil "dicts")
+ (buffer-string)))))
+ (setq ispell-dictionary-alist
+ (mapcar #'ispell-aspell-find-dictionary dictionaries))
+ (ispell-aspell-add-aliases)
+ ;; Add a default entry
+ (let* ((english-dict (assoc "en" ispell-dictionary-alist))
+ (default-dict (cons nil (cdr english-dict))))
+ (push default-dict ispell-dictionary-alist))
+ (setq ispell-have-aspell-dictionaries t)))
+
+ (defvar ispell-aspell-data-dir nil
+ "Data directory of Aspell.")
+
+ (defvar ispell-aspell-dict-dir nil
+ "Dictionary directory of Aspell.")
+
+ (defun ispell-get-aspell-config-value (key)
+ "Return value of Aspell configuration option KEY.
+ Assumes that value contains no whitespace."
+ (with-temp-buffer
+ (call-process ispell-program-name nil t nil "config" key)
+ (car (split-string (buffer-string)))))
+
+ (defun ispell-aspell-find-dictionary (dict-name)
+ (let* ((lang ;; Strip out region, variant, etc.
+ (and (string-match "^[[:alpha:]]+" dict-name)
+ (match-string 0 dict-name)))
+ (data-file
+ (concat (or ispell-aspell-data-dir
+ (setq ispell-aspell-data-dir
+ (ispell-get-aspell-config-value "data-dir")))
+ "/" lang ".dat"))
+ otherchars)
+ ;; This file really should exist; there is no sensible recovery.
+ (with-temp-buffer
+ (insert-file-contents data-file)
+ ;; There is zero or one line with special characters declarations.
+ (when (search-forward-regexp "^special" nil t)
+ (let ((specials (split-string
+ (buffer-substring (point)
+ (progn (end-of-line) (point))))))
+ ;; The line looks like: special ' -** - -** . -** : -*-
+ ;; -** means that this character
+ ;; - doesn't appear at word start
+ ;; * may appear in the middle of a word
+ ;; * may appear at word end
+ ;; `otherchars' is about the middle case.
+ (while specials
+ (when (eq (aref (cadr specials) 1) ?*)
+ (push (car specials) otherchars))
+ (setq specials (cddr specials))))))
+ (list dict-name
+ "[[:alpha:]]"
+ "[^[:alpha:]]"
+ (regexp-opt otherchars)
+ t ; We can't tell, so set this to t
+ (list "-d" dict-name "--encoding=utf-8")
+ nil ; aspell doesn't support this
+ ;; Here we specify the encoding to use while communicating with
+ ;; aspell. This doesn't apply to command line arguments, so
+ ;; just don't pass words to spellcheck as arguments...
+ 'utf-8)))
+
+ (defun ispell-aspell-add-aliases ()
+ "Find aspell's dictionary aliases and add them to
`ispell-dictionary-alist'."
+ (let ((aliases (file-expand-wildcards
+ (concat (or ispell-aspell-dict-dir
+ (setq ispell-aspell-dict-dir
+ (ispell-get-aspell-config-value
"dict-dir")))
+ "/*.alias"))))
+ (dolist (alias-file aliases)
+ (with-temp-buffer
+ (insert-file-contents alias-file)
+ ;; Look for a line "add FOO.multi", extract FOO
+ (when (search-forward-regexp "^add \\([^.]+\\)\\.multi" nil t)
+ (let* ((aliasname (file-name-sans-extension
+ (file-name-nondirectory alias-file)))
+ (already-exists-p (assoc aliasname ispell-dictionary-alist))
+ (realname (match-string 1))
+ (realdict (assoc realname ispell-dictionary-alist)))
+ (when (and realdict (not already-exists-p))
+ (push (cons aliasname (cdr realdict))
ispell-dictionary-alist))))))))
+
(defun ispell-valid-dictionary-list ()
"Returns a list of valid dictionaries.
The variable `ispell-library-directory' defines the library location."
+ ;; If Ispell is really Aspell, query it for the dictionary list.
+ (when (and (not ispell-have-aspell-dictionaries)
+ (condition-case ()
+ (progn (ispell-check-version) t)
+ (error nil))
+ ispell-really-aspell)
+ (ispell-find-aspell-dictionaries))
(let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist))
(dict-list (cons "default" nil))
name load-dict)
***************
*** 875,881 ****
(if (and
name
;; include all dictionaries if lib directory not known.
! (or (not ispell-library-directory)
(file-exists-p (concat ispell-library-directory
"/" name ".hash"))
(file-exists-p (concat ispell-library-directory "/" name ".has"))
--- 979,987 ----
(if (and
name
;; include all dictionaries if lib directory not known.
! ;; For Aspell, we already know which dictionaries exist.
! (or ispell-really-aspell
! (not ispell-library-directory)
(file-exists-p (concat ispell-library-directory
"/" name ".hash"))
(file-exists-p (concat ispell-library-directory "/" name ".has"))
***************
*** 887,922 ****
(setq dict-list (cons name dict-list))))
dict-list))
- ;;;###autoload
- (if ispell-menu-map-needed
- (let ((dicts (if (fboundp 'ispell-valid-dictionary-list)
- (ispell-valid-dictionary-list)
- ;; This case is used in loaddefs.el
- ;; since ispell-valid-dictionary-list isn't defined then.
- (mapcar (lambda (x) (or (car x) "default"))
- ispell-dictionary-alist)))
- (dict-map (make-sparse-keymap "Dictionaries")))
- (setq ispell-menu-map (make-sparse-keymap "Spell"))
- ;; add the dictionaries to the bottom of the list.
- (if (not dicts)
- (define-key ispell-menu-map [default]
- '("Select Default Dict"
- "Dictionary for which Ispell was configured"
- . (lambda () (interactive)
- (ispell-change-dictionary "default")))))
- (fset 'ispell-dict-map dict-map)
- (define-key ispell-menu-map [dictionaries]
- `(menu-item "Select Dict" ispell-dict-map))
- (dolist (name dicts)
- (define-key dict-map (vector (intern name))
- (cons (concat "Select " (capitalize name) " Dict")
- `(lambda () (interactive)
- (ispell-change-dictionary ,name)))))))
-
;;; define commands in menu in opposite order you want them to appear.
;;;###autoload
(if ispell-menu-map-needed
(progn
(define-key ispell-menu-map [ispell-change-dictionary]
'(menu-item "Change Dictionary..." ispell-change-dictionary
:help "Supply explicit dictionary file name"))
--- 993,1003 ----
(setq dict-list (cons name dict-list))))
dict-list))
;;; define commands in menu in opposite order you want them to appear.
;;;###autoload
(if ispell-menu-map-needed
(progn
+ (setq ispell-menu-map (make-sparse-keymap "Spell"))
(define-key ispell-menu-map [ispell-change-dictionary]
'(menu-item "Change Dictionary..." ispell-change-dictionary
:help "Supply explicit dictionary file name"))
***************
*** 1491,1497 ****
(funcall ispell-format-word word)))
(and (fboundp 'extent-at)
(extent-at start)
! (delete-extent (extent-at start))))
((stringp poss)
(or quietly
(message "%s is correct because of root %s"
--- 1572,1579 ----
(funcall ispell-format-word word)))
(and (fboundp 'extent-at)
(extent-at start)
! (and (fboundp 'delete-extent)
! (delete-extent (extent-at start)))))
((stringp poss)
(or quietly
(message "%s is correct because of root %s"
***************
*** 1499,1511 ****
(funcall ispell-format-word poss)))
(and (fboundp 'extent-at)
(extent-at start)
! (delete-extent (extent-at start))))
((null poss) (message "Error in ispell process"))
(ispell-check-only ; called from ispell minor mode.
(if (fboundp 'make-extent)
! (let ((ext (make-extent start end)))
! (set-extent-property ext 'face ispell-highlight-face)
! (set-extent-property ext 'priority 2000))
(beep)
(message "%s is incorrect"(funcall ispell-format-word word))))
(t ; prompt for correct word.
--- 1581,1595 ----
(funcall ispell-format-word poss)))
(and (fboundp 'extent-at)
(extent-at start)
! (and (fboundp 'delete-extent)
! (delete-extent (extent-at start)))))
((null poss) (message "Error in ispell process"))
(ispell-check-only ; called from ispell minor mode.
(if (fboundp 'make-extent)
! (if (fboundp 'set-extent-property)
! (let ((ext (make-extent start end)))
! (set-extent-property ext 'face ispell-highlight-face)
! (set-extent-property ext 'priority 2000)))
(beep)
(message "%s is incorrect"(funcall ispell-format-word word))))
(t ; prompt for correct word.