(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.

2 files changed, 128 insertions, 41 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 817bee01c17..5ddf15cceda 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -12,6 +12,8 @@
 
 2005-08-09  Richard M. Stallman  <rms@gnu.org>
 
+        * textmodes/ispell.el (ispell-word): More fboundp checks.
+
         * files.el (find-file-noselect): Don't call set-buffer-major-mode.
         (find-file-noselect-1): Call it here, only if RAWFILE.
         (normal-mode): Always set some major mode.
@@ -20,15 +22,16 @@
 
 2005-08-09  Magnus Henoch  <mange@freemail.hu>
 
-        * textmodes/ispell.el (aspell-have-dictionaries): New variable.
-        (aspell-find-dictionaries): New command.
-        (aspell-data-dir): New variable.
-        (aspell-find-data-dir): New function.
-        (aspell-find-dictionary): New function.
-        (ispell-valid-dictionary-list): Call aspell-find-dictionaries if
-        appropriate.  Don't look for ispell dictionaries if we use
-        aspell.
-
+        * textmodes/ispell.el (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.
+        
 2005-08-09  Richard M. Stallman  <rms@gnu.org>
 
         * progmodes/sql.el (sql-interactive-mode-map): Use fboundp.
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index a0a0ca20218..5afdf63ff2a 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -862,9 +862,113 @@ and added as a submenu of the \"Edit\" menu.")
                                    )
   "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 @@ The variable `ispell-library-directory' defines the library location."
       (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 @@ The variable `ispell-library-directory' defines the library location."
           (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 @@ quit          spell session exited."
                           (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 @@ quit          spell session exited."
                           (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.