# HG changeset patch # User Richard M. Stallman # Date 1123596709 0 # Node ID 2fe6c83ec9b432fedbccd861409dfdcdcdcf625f # Parent 04c559b57456f18ccb084731c7336fcaf15b3329 (ispell-word): More fboundp checks. (ispell-find-aspell-dictionaries): New command. (ispell-have-aspell-dictionaries): New variable. (ispell-aspell-data-dir, ispell-aspell-dict-dir): New variables. (ispell-get-aspell-config-value): New function. (ispell-aspell-find-dictionary): New function. (ispell-aspell-add-aliases): New function. (ispell-valid-dictionary-list): Call ispell-find-aspell-dictionaries if appropriate. Don't look for ispell dictionaries if we use aspell. (ispell-menu-map): Don't build a submenu of dictionaries. diff -r 04c559b57456 -r 2fe6c83ec9b4 lisp/textmodes/ispell.el --- a/lisp/textmodes/ispell.el Tue Aug 09 14:05:24 2005 +0000 +++ b/lisp/textmodes/ispell.el Tue Aug 09 14:11:49 2005 +0000 @@ -862,9 +862,113 @@ ) "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,7 +979,9 @@ (if (and name ;; include all dictionaries if lib directory not known. - (or (not ispell-library-directory) + ;; 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,36 +993,11 @@ (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 + (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,7 +1572,8 @@ (funcall ispell-format-word word))) (and (fboundp 'extent-at) (extent-at start) - (delete-extent (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,13 +1581,15 @@ (funcall ispell-format-word poss))) (and (fboundp 'extent-at) (extent-at start) - (delete-extent (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) - (let ((ext (make-extent start end))) - (set-extent-property ext 'face ispell-highlight-face) - (set-extent-property ext 'priority 2000)) + (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.