emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/spell-fu 7c2542e109 73/86: Merge branch 'multiple-dictiona


From: ELPA Syncer
Subject: [nongnu] elpa/spell-fu 7c2542e109 73/86: Merge branch 'multiple-dictionaries' into 'master'
Date: Thu, 7 Jul 2022 12:03:45 -0400 (EDT)

branch: elpa/spell-fu
commit 7c2542e1091a527d2bf2a9e05cf584c8cdba5c35
Merge: b2da2874f3 1f3e5b8f05
Author: ideasman42 <ideasman42@gmail.com>
Commit: ideasman42 <ideasman42@gmail.com>

    Merge branch 'multiple-dictionaries' into 'master'
    
    Multiple dictionary support
    
    Closes #9
    
    See merge request ideasman42/emacs-spell-fu!6
---
 readme.rst  |  42 ++-
 spell-fu.el | 862 ++++++++++++++++++++++++++++++++++++------------------------
 2 files changed, 563 insertions(+), 341 deletions(-)

diff --git a/readme.rst b/readme.rst
index 00e5c2dd63..17b5055fb6 100644
--- a/readme.rst
+++ b/readme.rst
@@ -63,6 +63,19 @@ Or you may wish to configure this per-mode, e.g:
      (lambda ()
        (spell-fu-mode)))
 
+Multiple languages can be used in the same buffer by configuring multiple 
dictionaries:
+
+.. code-block:: elisp
+
+   (add-hook 'spell-fu-mode-hook
+     (lambda ()
+       (spell-fu-dictionary-add (spell-fu-get-ispell "de"))
+       (spell-fu-dictionary-add (spell-fu-get-ispell "fr"))
+       (spell-fu-dictionary-add
+         (spell-fu-get-personal-dictionary "de-personal" 
"/home/user/.aspell.de.pws"))
+       (spell-fu-dictionary-add
+         (spell-fu-get-personal-dictionary "fr-personal" 
"/home/user/.aspell.fr.pws"))))
+
 
 Customization
 -------------
@@ -185,10 +198,31 @@ there are some commands provided which may come in handy.
    Checks spelling for the entire buffer, reporting the number of misspelled 
words found.
 
 ``spell-fu-word-add``
-   Add the word under the cursor to the personal dictionary.
+   Add the word under the cursor to a personal dictionary.
 
 ``spell-fu-word-remove``
-   Remove the word under the cursor from the personal dictionary.
+   Remove the word under the cursor from a personal dictionary.
+
+
+Multiple dictionaries
+---------------------
+
+Multiple dictionaries can be enabled and used alongside each other.
+
+``spell-fu-dictionaries``
+   Variable which lists the currently enabled dictionaries.
+
+``spell-fu-dictionary-add``
+   Enable a dictionary in the current buffer.
+
+``spell-fu-dictionary-remove``
+   Disable a dictionary in the current buffer.
+
+``spell-fu-get-ispell-dictionary``
+   Get the ispell / aspell dictionary with the given name.
+
+``spell-fu-get-personal-dictionary``
+   Get a writable personal dictionary for saving user words.
 
 
 Details
@@ -209,11 +243,11 @@ Other Packages
 `WCheck Mode <https://github.com/tlikonen/wcheck-mode>`__
    This is a close match to Spell-fu, the main differences is that it's 
calling a sub-process
    on each word which gives slower results.
-   I also found it's configuration rather difficult to manage.
+   I also found its configuration rather difficult to manage.
 
    Spell-fu in contrast takes a different approach,
    instead of exposing many advanced options,
-   you can set your own function to extract works from a region of text.
+   you can set your own function to extract words from a region of text.
 
 
 TODO
diff --git a/spell-fu.el b/spell-fu.el
index 0df240e0af..0cd6de257d 100644
--- a/spell-fu.el
+++ b/spell-fu.el
@@ -70,7 +70,7 @@
   :group 'ispell)
 
 (defcustom spell-fu-directory (locate-user-emacs-file "spell-fu" 
".emacs-spell-fu")
-  "The directory to store undo data."
+  "The directory to store dictionary data."
   :type 'string)
 
 (defcustom spell-fu-idle-delay 0.25
@@ -89,6 +89,21 @@ it'll be called with one parameter (the buffer in question), 
and
 it should return non-nil to make Global `spell-fu' Mode not
 check this buffer.")
 
+;; A spell-fu dictionary is a symbol, the variable value of which is a hash 
table with the
+;; dictionary's words.  The symbol additionally has these properties:
+;; - 'description - short human-readable description of the dictionary.
+;; - 'update - function, called to update the words hash table.
+;; - 'add-word - function, called to permanently add a word to the dictionary.
+;;     Not set for read-only dictionaries.
+;; - 'remove-word - ditto
+
+(defvar-local spell-fu-dictionaries nil
+  "List of dictionaries enabled in the current buffer.
+
+Use the spell-fu-get-...-dictionary functions to construct values
+suitable for populating this list.  To add a dictionary, please
+use `spell-fu-dictionary-add'.")
+
 (defface spell-fu-incorrect-face
   '
   ((((supports :underline (:style wave))) :underline (:style wave :color 
"red"))
@@ -146,13 +161,6 @@ Notes:
 ;; Only ever increase.
 (defconst spell-fu--cache-version "0.1")
 
-;; List of language, dictionary mappings.
-(defvar spell-fu--cache-table-alist nil)
-
-;; Buffer local dictionary.
-;; Note that this is typically the same dictionary shared across all buffers.
-(defvar-local spell-fu--cache-table nil)
-
 ;; Keep track of the last overlay, this allows expanding the existing overlay 
where possible.
 ;; Useful since font-locking often uses multiple smaller ranges which can be 
merged into one range.
 ;; Always check this has not been deleted (has a valid buffer) before use.
@@ -162,60 +170,74 @@ Notes:
 ;; ---------------------------------------------------------------------------
 ;; Dictionary Utility Functions
 
-(defun spell-fu--dictionary ()
-  "Access the current dictionary."
-  (or ispell-local-dictionary ispell-dictionary "default"))
+(defun spell-fu--default-dictionaries ()
+  "Construct the default value of `spell-fu-dictionaries'."
+  (nconc
+    (list
+      (spell-fu-get-ispell-dictionary (or ispell-local-dictionary 
ispell-dictionary "default")))
+    (when (and ispell-personal-dictionary (file-exists-p 
ispell-personal-dictionary))
+      (list (spell-fu-get-personal-dictionary "default" 
ispell-personal-dictionary)))))
 
 (defun spell-fu--cache-file (dict)
   "Return the location of the cache file with dictionary DICT."
-  (expand-file-name (format "words_%s.el.data" dict) spell-fu-directory))
+  (expand-file-name (format "words_%s.el.data" (symbol-name dict)) 
spell-fu-directory))
 
 (defun spell-fu--words-file (dict)
   "Return the location of the word-list with dictionary DICT."
-  (expand-file-name (format "words_%s.txt" dict) spell-fu-directory))
+  (expand-file-name (format "words_%s.txt" (symbol-name dict)) 
spell-fu-directory))
 
-(defun spell-fu--aspell-find-data-file (dict)
-  "For Aspell dictionary DICT, return an associated data file path or nil."
-  ;; Based on `ispell-aspell-find-dictionary'.
+(defun spell-fu--refresh ()
+  "Reset spell-checked overlays in the current buffer."
+  ;; For now simply clear syntax highlighting.
+  (unless (<= spell-fu-idle-delay 0.0)
+    (spell-fu--idle-overlays-remove))
+  (spell-fu--overlays-remove)
+  (font-lock-flush))
 
-  ;; Make sure `ispell-aspell-dict-dir' is defined.
-  (unless ispell-aspell-dict-dir
-    (setq ispell-aspell-dict-dir (ispell-get-aspell-config-value "dict-dir")))
+(defun spell-fu--buffers-refresh-with-dict (dict)
+  "Reset spell-checked overlays for buffers using the dictionary DICT."
+  (dolist (buf (buffer-list))
+    (with-current-buffer buf
+      (when
+        (and
+          (bound-and-true-p spell-fu-mode)
+          (bound-and-true-p spell-fu-dictionaries)
+          (member dict spell-fu-dictionaries))
+        (spell-fu--refresh)))))
 
-  ;; Make sure `ispell-aspell-data-dir' is defined.
-  (unless ispell-aspell-data-dir
-    (setq ispell-aspell-data-dir (ispell-get-aspell-config-value "data-dir")))
+(defun spell-fu--get-edit-candidate-dictionaries (word action)
+  "Return dictionaries for which it makes sense to perform ACTION on WORD.
 
-  ;; Try finding associated data-file. aspell will look for master .dat
-  ;; file in `dict-dir' and `data-dir'. Associated .dat files must be
-  ;; in the same directory as master file.
-  (catch 'datafile
-    (save-match-data
-      (dolist (tmp-path (list ispell-aspell-dict-dir ispell-aspell-data-dir))
-        ;; Try `xx.dat' first, strip out variant, country code, etc,
-        ;; then try `xx_YY.dat' (without stripping country code),
-        ;; then try `xx-alt.dat', for `de-alt' etc.
-        (dolist (dict-re (list "^[[:alpha:]]+" "^[[:alpha:]_]+" 
"^[[:alpha:]]+-\\(alt\\|old\\)"))
-          (let ((dict-match (and (string-match dict-re dict) (match-string 0 
dict))))
-            (when dict-match
-              (let ((fullpath (concat (file-name-as-directory tmp-path) 
dict-match ".dat")))
-                (when (file-readable-p fullpath)
-                  (throw 'datafile fullpath))))))))))
+ACTION is 'remove or 'add.  Returned candidates are dictionaries
+which support the operation, and correspondingly do / do not
+already contain WORD."
 
-(defun spell-fu--aspell-lang-from-dict (dict)
-  "Return the language of a DICT or nil if identification fails.
-
-Supports aspell alias dictionaries, e.g. 'german' or 'deutsch',
-for 'de_DE' using Ispell's lookup routines.
-The language is identified by looking for the data file
-associated with the dictionary."
-  (unless ispell-aspell-dictionary-alist
-    (ispell-find-aspell-dictionaries))
-  (let ((dict-name (cadr (nth 5 (assoc dict ispell-aspell-dictionary-alist)))))
-    (when dict-name
-      (let ((data-file (spell-fu--aspell-find-data-file dict-name)))
-        (when data-file
-          (file-name-base data-file))))))
+  (let
+    (
+      (adding (eq action 'add))
+      (encoded-word (encode-coding-string (downcase word) 'utf-8)))
+    (cl-remove-if-not
+      (lambda (dict)
+        (and
+          ;; Operation supported?
+          (get
+            dict
+            (if adding
+              'add-word
+              'remove-word))
+          ;; Word is / is not in dictionary?
+          (eq adding (null (gethash encoded-word (symbol-value dict))))))
+      spell-fu-dictionaries)))
+
+(defun spell-fu--read-dictionary (candidate-dicts prompt)
+  "Ask the user to select one dictionary from CANDIDATE-DICTS."
+  (if (<= (length candidate-dicts) 1)
+    (car candidate-dicts) ; Return the single choice
+    (let
+      (
+        (completion-extra-properties
+          '(:annotation-function (lambda (candidate) (get (intern candidate) 
'description)))))
+      (intern (completing-read prompt (mapcar #'symbol-name 
candidate-dicts))))))
 
 
 ;; ---------------------------------------------------------------------------
@@ -328,100 +350,6 @@ Argument POS return faces at this point."
   (spell-fu--file-is-older-list file-test file-list))
 
 
-;; ---------------------------------------------------------------------------
-;; Word List Generation
-
-(defun spell-fu--word-list-ensure (words-file dict)
-  "Ensure the word list is generated with dictionary DICT.
-Argument WORDS-FILE the file to write the word list into."
-  (let*
-    (
-      (personal-words-file ispell-personal-dictionary)
-      (has-words-file (file-exists-p words-file))
-      (has-dict-personal (and personal-words-file (file-exists-p 
personal-words-file)))
-      (is-dict-outdated
-        (and
-          has-words-file
-          has-dict-personal
-          (spell-fu--file-is-older words-file personal-words-file))))
-
-    (when (or (not has-words-file) is-dict-outdated)
-
-      (spell-fu--with-message-prefix "Spell-fu generating words: "
-        (message "%S" (file-name-nondirectory words-file))
-
-        ;; Build a word list, sorted case insensitive.
-        (let ((word-list nil))
-
-          ;; Optional: insert personal dictionary, stripping header and 
inserting a newline.
-          (with-temp-buffer
-            (when has-dict-personal
-              (insert-file-contents personal-words-file)
-              (goto-char (point-min))
-              (when (looking-at "personal_ws-")
-                (delete-region (line-beginning-position) (1+ 
(line-end-position))))
-              (goto-char (point-max))
-              (unless (eq ?\n (char-after))
-                (insert "\n")))
-
-            (setq word-list (spell-fu--buffer-as-line-list (current-buffer) 
word-list)))
-
-          ;; Insert dictionary from aspell.
-          (with-temp-buffer
-            (let
-              ( ;; Use the pre-configured aspell binary, or call aspell 
directly.
-                (aspell-bin
-                  (or (and ispell-really-aspell ispell-program-name) 
(executable-find "aspell"))))
-
-              (cond
-                ((string-equal dict "default")
-                  (call-process aspell-bin nil t nil "dump" "master"))
-                (t
-                  (call-process aspell-bin nil t nil "-d" dict "dump" 
"master")))
-
-              ;; Check whether the dictionary has affixes, expand if necessary.
-              (when (re-search-backward "^[[:alpha:]]*/[[:alnum:]]*$" nil t)
-                (let ((lang (spell-fu--aspell-lang-from-dict dict)))
-                  (unless
-                    (zerop
-                      (shell-command-on-region
-                        (point-min) (point-max)
-                        (cond
-                          (lang
-                            (format "%s -l %s expand" aspell-bin lang))
-                          (t
-                            (format "%s expand" aspell-bin)))
-                        t t
-                        ;; Output any errors into the message buffer instead 
of the word-list.
-                        "*spell-fu word generation errors*"))
-                    (message
-                      (format
-                        "spell-fu: affix extension for dictionary '%s' failed 
(with language: %S)."
-                        dict
-                        lang)))
-                  (goto-char (point-min))
-                  (while (search-forward " " nil t)
-                    (replace-match "\n")))))
-
-            (setq word-list (spell-fu--buffer-as-line-list (current-buffer) 
word-list)))
-
-          ;; Case insensitive sort is important if this is used for 
`ispell-complete-word-dict'.
-          ;; Which is a handy double-use for this file.
-          (let ((word-list-ncase nil))
-            (dolist (word word-list)
-              (push (cons (downcase word) word) word-list-ncase))
-
-            ;; Sort by the lowercase word.
-            (setq word-list-ncase
-              (sort word-list-ncase (lambda (a b) (string-lessp (car a) (car 
b)))))
-
-            ;; Write to 'words-file'.
-            (with-temp-buffer
-              (dolist (line-cons word-list-ncase)
-                (insert (cdr line-cons) "\n"))
-              (write-region nil nil words-file nil 0))))))))
-
-
 ;; ---------------------------------------------------------------------------
 ;; Word List Cache
 
@@ -502,47 +430,6 @@ the caller will need to regenerate the cache."
           nil)))))
 
 
-;; ---------------------------------------------------------------------------
-;; Word List Initialization
-;;
-;; Top level function, called when enabling the mode.
-
-(defun spell-fu--ensure-dict (dict)
-  "Setup the dictionary, initializing new files as necessary with dictionary 
DICT."
-
-  ;; First use the dictionary if it's in memory.
-  ;; Once Emacs is running, this is used for all new buffers.
-  (setq spell-fu--cache-table (assoc-default dict spell-fu--cache-table-alist))
-
-  ;; Not loaded yet, initialize it.
-  (unless spell-fu--cache-table
-
-    ;; Ensure our path exists.
-    (unless (file-directory-p spell-fu-directory)
-      (make-directory spell-fu-directory))
-
-    (let
-      ( ;; Get the paths of both files, ensure the cache file is newer,
-        ;; otherwise regenerate it.
-        (words-file (spell-fu--words-file dict))
-        (cache-file (spell-fu--cache-file dict)))
-
-      (spell-fu--word-list-ensure words-file dict)
-
-      ;; Load cache or create it, creating it returns the cache
-      ;; to avoid some slow-down on first load.
-      (setq spell-fu--cache-table
-        (or
-          (and
-            (file-exists-p cache-file)
-            (not (spell-fu--file-is-older cache-file words-file))
-            (spell-fu--cache-words-load cache-file))
-          (spell-fu--cache-from-word-list words-file cache-file)))
-
-      ;; Add to to `spell-fu--cache-table-alist' for reuse on next load.
-      (push (cons dict spell-fu--cache-table) spell-fu--cache-table-alist))))
-
-
 ;; ---------------------------------------------------------------------------
 ;; Shared Functions
 
@@ -570,10 +457,33 @@ Otherwise remove all overlays."
 Marking the spelling as incorrect using `spell-fu-incorrect-face' on failure.
 Argument POINT-START the beginning position of WORD.
 Argument POINT-END the end position of WORD."
-  (unless (gethash (encode-coding-string (downcase word) 'utf-8) 
spell-fu--cache-table nil)
+  (or
+    ;; Dictionary search.
+    (let ((encoded-word (encode-coding-string (downcase word) 'utf-8)))
+      (cl-find-if
+        (lambda (dict) (gethash encoded-word (symbol-value dict) nil))
+        spell-fu-dictionaries))
     ;; Ignore all uppercase words.
-    (unless (equal word (upcase word))
-      (spell-fu-mark-incorrect pos-beg pos-end))))
+    (equal word (upcase word))
+    ;; Mark as incorrect otherwise.
+    (spell-fu-mark-incorrect pos-beg pos-end)))
+
+(defun spell-fu--word-at-point ()
+  "Return the word at the current point or nil."
+  (let
+    (
+      (point-init (point))
+      (pos-beg (line-beginning-position))
+      (pos-end (line-end-position)))
+    (save-excursion
+      (goto-char pos-beg)
+      (catch 'result
+        (with-syntax-table spell-fu-syntax-table
+          (save-match-data
+            (while (re-search-forward spell-fu-word-regexp pos-end t)
+              (when (and (<= (match-beginning 0) point-init) (<= point-init 
(match-end 0)))
+                (throw 'result (match-string-no-properties 0))))))
+        (throw 'result nil)))))
 
 
 ;; ---------------------------------------------------------------------------
@@ -1030,178 +940,443 @@ Return t when found, otherwise nil."
   (interactive)
   (spell-fu--goto-next-or-previous-error -1))
 
+(defun spell-fu-word-add (dict)
+  "Add the current word to the dictionary DICT.
+
+Return t when the word has been added."
+  (interactive
+    (list
+      (spell-fu--read-dictionary
+        (spell-fu--get-edit-candidate-dictionaries (spell-fu--word-at-point) 
'add)
+        "Add to dictionary: ")))
+  (let ((word (spell-fu--word-at-point)))
+    (if dict
+      (let ((encoded-word (encode-coding-string (downcase word) 'utf-8)))
+        (funcall (get dict 'add-word) encoded-word)
+        (puthash encoded-word t (symbol-value dict))
+        t)
+      (message "Cannot add %S to any active dictionary." word)
+      nil)))
+
+(defun spell-fu-word-remove (dict)
+  "Remove the current word from the dictionary DICT.
+
+Return t when the word has been removed."
+  (interactive
+    (list
+      (spell-fu--read-dictionary
+        (spell-fu--get-edit-candidate-dictionaries (spell-fu--word-at-point) 
'remove)
+        "Remove from dictionary: ")))
+  (let ((word (spell-fu--word-at-point)))
+    (if dict
+      (let ((encoded-word (encode-coding-string (downcase 
(spell-fu--word-at-point)) 'utf-8)))
+        (funcall (get dict 'remove-word) encoded-word)
+        (remhash encoded-word (symbol-value dict))
+        t)
+      (message "Cannot remove %S from any active dictionary." word)
+      nil)))
+
+(defun spell-fu-dictionary-add (dict)
+  "Add DICT to the list of active dictionaries."
+  (add-to-list 'spell-fu-dictionaries dict)
+  (when (bound-and-true-p spell-fu-mode)
+    (let ((update-fun (get dict 'update)))
+      (when update-fun
+        (funcall update-fun)))
+    (spell-fu--refresh)))
+
+(defun spell-fu-dictionary-remove (dict)
+  "Remove DICT from the list of active dictionaries."
+  (setq spell-fu-dictionaries (delq dict spell-fu-dictionaries))
+  (when (bound-and-true-p spell-fu-mode)
+    (spell-fu--refresh)))
+
 
 ;; ---------------------------------------------------------------------------
-;; Personal Dictionary Management
+;; Ispell / Aspell dictionary support
 ;;
 
-(defun spell-fu--buffers-refresh-with-cache-table (cache-table)
-  "Reset spell-checked overlays for buffers using the dictionary from 
CACHE-TABLE."
-  (dolist (buf (buffer-list))
-    (with-current-buffer buf
-      (when (bound-and-true-p spell-fu-mode)
-        (when (eq cache-table (bound-and-true-p spell-fu--cache-table))
-          ;; For now simply clear syntax highlighting.
-          (unless (<= spell-fu-idle-delay 0.0)
-            (spell-fu--idle-overlays-remove))
-          (spell-fu--overlays-remove)
-          (font-lock-flush))))))
-
-(defun spell-fu--word-add-or-remove (word words-file action)
-  "Apply ACTION to WORD from the personal dictionary WORDS-FILE.
-
-Return t when the action succeeded."
-  (catch 'result
-    (spell-fu--with-message-prefix "Spell-fu: "
-      (unless word
-        (message "word not found!")
-        (throw 'result nil))
-      (unless words-file
-        (message "personal dictionary not defined!")
-        (throw 'result nil))
+;; Word List Generation
 
-      (let ((this-cache-table spell-fu--cache-table))
-        (with-temp-buffer
-          (insert-file-contents-literally words-file)
+(defun spell-fu--aspell-word-list-ensure (words-file dict-name)
+  "Ensure the word list is generated for Aspell dictionary DICT-NAME.
+Argument WORDS-FILE is the file to write the word list into.
 
-          ;; Ensure newline at EOF,
-          ;; not essential but complicates sorted add if we don't do this.
-          ;; also ensures we can step past the header which _could_ be a 
single line
-          ;; without anything below it.
-          (goto-char (point-max))
-          (unless
-            (string-blank-p
-              (buffer-substring-no-properties (line-beginning-position) 
(line-end-position)))
-            (insert "\n"))
-          ;; Delete extra blank lines.
-          ;; So we can use line count as word count.
-          (while
-            (and
-              (eq 0 (forward-line -1))
-              (string-blank-p
-                (buffer-substring-no-properties (line-beginning-position) 
(line-end-position))))
-            (delete-region
-              (line-beginning-position)
-              (progn
-                (forward-line -1)
-                (point))))
-
-          (goto-char (point-min))
-
-          ;; Case insensitive.
+Return t if the file was updated."
+  (let*
+    (
+      (has-words-file (file-exists-p words-file))
+      (dict-aspell-name (cadr (nth 5 (assoc dict-name 
ispell-aspell-dictionary-alist))))
+      (dict-file (and dict-aspell-name (spell-fu--aspell-find-data-file 
dict-name)))
+      (is-dict-outdated
+        (and has-words-file dict-file (spell-fu--file-is-older words-file 
dict-file))))
+
+    (when (or (not has-words-file) is-dict-outdated)
+
+      (spell-fu--with-message-prefix "Spell-fu generating words: "
+        (message "%S" (file-name-nondirectory words-file))
+
+        ;; Build a word list, sorted case insensitive.
+        (let ((word-list nil))
+
+          ;; Insert dictionary from aspell.
+          (with-temp-buffer
+            (let
+              ( ;; Use the pre-configured aspell binary, or call aspell 
directly.
+                (aspell-bin
+                  (or (and ispell-really-aspell ispell-program-name) 
(executable-find "aspell"))))
+
+              (cond
+                ((string-equal dict-name "default")
+                  (call-process aspell-bin nil t nil "dump" "master"))
+                (t
+                  (call-process aspell-bin nil t nil "-d" dict-name "dump" 
"master")))
+
+              ;; Check whether the dictionary has affixes, expand if necessary.
+              (when (re-search-backward "^[[:alpha:]]*/[[:alnum:]]*$" nil t)
+                (let ((lang (spell-fu--aspell-lang-from-dict dict-name)))
+                  (unless
+                    (zerop
+                      (shell-command-on-region
+                        (point-min) (point-max)
+                        (cond
+                          (lang
+                            (format "%s -l %s expand" aspell-bin lang))
+                          (t
+                            (format "%s expand" aspell-bin)))
+                        t t
+                        ;; Output any errors into the message buffer instead 
of the word-list.
+                        "*spell-fu word generation errors*"))
+                    (message
+                      (format
+                        "spell-fu: affix extension for dictionary '%s' failed 
(with language: %S)."
+                        dict-name
+                        lang)))
+                  (goto-char (point-min))
+                  (while (search-forward " " nil t)
+                    (replace-match "\n")))))
+
+            (setq word-list (spell-fu--buffer-as-line-list (current-buffer) 
word-list)))
+
+          ;; Case insensitive sort is important if this is used for 
`ispell-complete-word-dict'.
+          ;; Which is a handy double-use for this file.
+          (let ((word-list-ncase nil))
+            (dolist (word word-list)
+              (push (cons (downcase word) word) word-list-ncase))
+
+            ;; Sort by the lowercase word.
+            (setq word-list-ncase
+              (sort word-list-ncase (lambda (a b) (string-lessp (car a) (car 
b)))))
+
+            ;; Write to 'words-file'.
+            (with-temp-buffer
+              (dolist (line-cons word-list-ncase)
+                (insert (cdr line-cons) "\n"))
+              (write-region nil nil words-file nil 0)))))
+
+      t)))
+
+;; Word List Initialization
+
+(defun spell-fu--aspell-update (dict dict-name)
+  "Set up the Aspell dictionary DICT, initializing it as necessary."
+
+  (let
+    ( ;; Get the paths of temporary files, ensure the cache file is
+      ;; newer, otherwise regenerate it.
+      (words-file (spell-fu--words-file dict))
+      (cache-file (spell-fu--cache-file dict))
+      ;; We have to reload the words hash table, if it was not yet loaded.
+      (forced (not (symbol-value dict))))
+
+    (when (or (spell-fu--aspell-word-list-ensure words-file dict-name) forced)
+      ;; Load cache or create it, creating it returns the cache
+      ;; to avoid some slow-down on first load.
+      (set
+        dict
+        (or
+          (and
+            (file-exists-p cache-file)
+            (not (spell-fu--file-is-older cache-file words-file))
+            (spell-fu--cache-words-load cache-file))
+          (spell-fu--cache-from-word-list words-file cache-file))))))
+
+
+(defun spell-fu--aspell-find-data-file (dict-aspell-name)
+  "For Aspell dictionary DICT, return an associated data file path or nil."
+  ;; Based on `ispell-aspell-find-dictionary'.
+
+  ;; Make sure `ispell-aspell-dict-dir' is defined.
+  (unless ispell-aspell-dict-dir
+    (setq ispell-aspell-dict-dir (ispell-get-aspell-config-value "dict-dir")))
+
+  ;; Make sure `ispell-aspell-data-dir' is defined.
+  (unless ispell-aspell-data-dir
+    (setq ispell-aspell-data-dir (ispell-get-aspell-config-value "data-dir")))
+
+  ;; Try finding associated data-file. aspell will look for master .dat
+  ;; file in `dict-dir' and `data-dir'. Associated .dat files must be
+  ;; in the same directory as master file.
+  (catch 'datafile
+    (save-match-data
+      (dolist (tmp-path (list ispell-aspell-dict-dir ispell-aspell-data-dir))
+        ;; Try `xx.dat' first, strip out variant, country code, etc,
+        ;; then try `xx_YY.dat' (without stripping country code),
+        ;; then try `xx-alt.dat', for `de-alt' etc.
+        (dolist (dict-re (list "^[[:alpha:]]+" "^[[:alpha:]_]+" 
"^[[:alpha:]]+-\\(alt\\|old\\)"))
           (let
             (
-              (changed nil)
-              (header-match
-                (save-match-data
-                  (when
-                    ;; Match a line like: personal_ws-1.1 en 66
-                    (looking-at
-                      (concat
-                        "personal_ws-[[:digit:]\\.]+"
-                        "[[:blank:]]+"
-                        "[A-Za-z_]+"
-                        "[[:blank:]]+"
-                        "\\([[:digit:]]+\\)"))
-                    (forward-line 1)
-                    (match-data))))
-              (word-point
-                (save-match-data
-                  (let ((case-fold-search t))
-                    (when
-                      (re-search-forward (concat "^" (regexp-quote word) 
"[[:blank:]]*$") nil t)
-                      (match-beginning 0))))))
-
-            (cond
-              ((eq action 'add)
-                (when word-point
-                  (message "\"%s\" already in the personal dictionary." word)
-                  (throw 'result nil))
-
-
-                (let ((keep-searching t))
-                  (while
-                    (and
-                      keep-searching
-                      (string-lessp
-                        (buffer-substring-no-properties
-                          (line-beginning-position)
-                          (line-end-position))
-                        word))
-                    (setq keep-searching (eq 0 (forward-line 1)))))
+              (dict-match
+                (and (string-match dict-re dict-aspell-name) (match-string 0 
dict-aspell-name))))
+            (when dict-match
+              (let ((fullpath (concat (file-name-as-directory tmp-path) 
dict-match ".dat")))
+                (when (file-readable-p fullpath)
+                  (throw 'datafile fullpath))))))))))
+
+(defun spell-fu--aspell-lang-from-dict (dict-name)
+  "Return the language of a DICT or nil if identification fails.
+
+Supports aspell alias dictionaries, e.g. 'german' or 'deutsch',
+for 'de_DE' using Ispell's lookup routines.
+The language is identified by looking for the data file
+associated with the dictionary."
+  (unless ispell-aspell-dictionary-alist
+    (ispell-find-aspell-dictionaries))
+  (let ((dict-aspell-name (cadr (nth 5 (assoc dict-name 
ispell-aspell-dictionary-alist)))))
+    (when dict-aspell-name
+      (let ((data-file (spell-fu--aspell-find-data-file dict-aspell-name)))
+        (when data-file
+          (file-name-base data-file))))))
 
-                (insert word "\n")
+;; Dictionary Definition
 
-                (puthash (downcase word) t this-cache-table)
+(defun spell-fu-get-ispell-dictionary (name)
+  (let ((dict (intern (concat "spell-fu-ispell-words-" name))))
+    (unless (boundp dict)
+      ;; Start with no words - construct them lazily
+      (set dict nil)
+      ;; Set description
+      (put dict 'description (concat "Ispell " name " dictionary"))
+      ;; Set update function
+      (put dict 'update (lambda () (spell-fu--aspell-update dict name))))
+    dict))
 
-                (message "\"%s\" successfully added!" word)
-                (setq changed t))
+;; ---------------------------------------------------------------------------
+;; Personal dictionary support
+;;
 
-              ((eq action 'remove)
-                (unless word-point
-                  (message "\"%s\" not in the personal dictionary." word)
-                  (throw 'result nil))
+(defun spell-fu--personal-word-list-ensure (words-file personal-words-file)
+  "Ensure the word list is generated for the personal dictionary DICT-NAME.
+Argument WORDS-FILE is the file to write the word list into.
 
-                ;; Delete line.
-                (goto-char word-point)
-                (delete-region
-                  (line-beginning-position)
-                  (or (and (eq 0 (forward-line 1)) (point)) 
(line-end-position)))
+Return t if the file was updated."
+  (let*
+    (
+      (has-words-file (file-exists-p words-file))
+      (has-dict-personal (and personal-words-file (file-exists-p 
personal-words-file)))
+      (is-dict-outdated
+        (and
+          has-words-file
+          has-dict-personal
+          (spell-fu--file-is-older words-file personal-words-file))))
 
-                (remhash (downcase word) this-cache-table)
+    (when (or (not has-words-file) is-dict-outdated)
 
-                (message "\"%s\" successfully removed!" word)
-                (setq changed t))
+      (spell-fu--with-message-prefix "Spell-fu generating words: "
+        (message "%S" (file-name-nondirectory words-file))
 
-              (t ;; Internal error, should never happen.
-                (error "Invalid action %S" action)))
+        ;; Build a word list, sorted case insensitive.
+        (let ((word-list nil))
 
-            (when changed
-              (when header-match
-                (save-match-data
-                  (set-match-data header-match)
-                  (replace-match
-                    (number-to-string (1- (count-lines (point-min) 
(point-max))))
-                    t
-                    nil
-                    nil
-                    1)))
+          ;; Insert the personal dictionary, stripping header and inserting a 
newline.
+          (with-temp-buffer
+            (when has-dict-personal
+              (insert-file-contents personal-words-file)
+              (goto-char (point-min))
+              (when (looking-at "personal_ws-")
+                (delete-region (line-beginning-position) (1+ 
(line-end-position))))
+              (goto-char (point-max))
+              (unless (eq ?\n (char-after))
+                (insert "\n")))
 
-              (write-region nil nil words-file nil 0)
+            (setq word-list (spell-fu--buffer-as-line-list (current-buffer) 
word-list)))
 
-              (spell-fu--buffers-refresh-with-cache-table this-cache-table)
-              t)))))))
+          ;; Case insensitive sort is important if this is used for 
`ispell-complete-word-dict'.
+          ;; Which is a handy double-use for this file.
+          (let ((word-list-ncase nil))
+            (dolist (word word-list)
+              (push (cons (downcase word) word) word-list-ncase))
+
+            ;; Sort by the lowercase word.
+            (setq word-list-ncase
+              (sort word-list-ncase (lambda (a b) (string-lessp (car a) (car 
b)))))
+
+            ;; Write to 'words-file'.
+            (with-temp-buffer
+              (dolist (line-cons word-list-ncase)
+                (insert (cdr line-cons) "\n"))
+              (write-region nil nil words-file nil 0)))))
+      t)))
+
+(defun spell-fu--personal-update (dict dict-file)
+  "Set up the personal dictionary DICT, initializing it as necessary."
 
-(defun spell-fu--word-at-point ()
-  "Return the word at the current point or nil."
   (let
-    (
-      (point-init (point))
-      (pos-beg (line-beginning-position))
-      (pos-end (line-end-position)))
-    (save-excursion
-      (goto-char pos-beg)
-      (catch 'result
-        (with-syntax-table spell-fu-syntax-table
-          (save-match-data
-            (while (re-search-forward spell-fu-word-regexp pos-end t)
-              (when (and (<= (match-beginning 0) point-init) (<= point-init 
(match-end 0)))
-                (throw 'result (match-string-no-properties 0))))))
-        (throw 'result nil)))))
+    ( ;; Get the paths of temporary files, ensure the cache file is
+      ;; newer, otherwise regenerate it.
+      (words-file (spell-fu--words-file dict))
+      (cache-file (spell-fu--cache-file dict))
+      ;; We have to reload the words hash table, if it was not yet loaded.
+      (forced (not (symbol-value dict))))
+
+    (when (or (spell-fu--personal-word-list-ensure words-file dict-file) 
forced)
+      ;; Load cache or create it, creating it returns the cache
+      ;; to avoid some slow-down on first load.
+      (set
+        dict
+        (or
+          (and
+            (file-exists-p cache-file)
+            (not (spell-fu--file-is-older cache-file words-file))
+            (spell-fu--cache-words-load cache-file))
+          (spell-fu--cache-from-word-list words-file cache-file))))))
 
-(defun spell-fu-word-add ()
-  "Add the current word to the personal dictionary.
+(defun spell-fu--personal-word-add-or-remove (word dict dict-file action)
+  "Apply ACTION to WORD for the personal dictionary DICT-FILE."
+  (catch 'result
+    (spell-fu--with-message-prefix "Spell-fu: "
+      (unless word
+        (message "word not found!")
+        (throw 'result nil))
+      (unless dict-file
+        (message "personal dictionary not defined!")
+        (throw 'result nil))
 
-Return t when the word has been added."
-  (interactive)
-  (spell-fu--word-add-or-remove (spell-fu--word-at-point) 
ispell-personal-dictionary 'add))
+      (with-temp-buffer
+        (insert-file-contents-literally dict-file)
+
+        ;; Ensure newline at EOF,
+        ;; not essential but complicates sorted add if we don't do this.
+        ;; also ensures we can step past the header which _could_ be a single 
line
+        ;; without anything below it.
+        (goto-char (point-max))
+        (unless
+          (string-blank-p
+            (buffer-substring-no-properties (line-beginning-position) 
(line-end-position)))
+          (insert "\n"))
+        ;; Delete extra blank lines.
+        ;; So we can use line count as word count.
+        (while
+          (and
+            (eq 0 (forward-line -1))
+            (string-blank-p
+              (buffer-substring-no-properties (line-beginning-position) 
(line-end-position))))
+          (delete-region
+            (line-beginning-position)
+            (progn
+              (forward-line -1)
+              (point))))
 
-(defun spell-fu-word-remove ()
-  "Remove the current word from the personal dictionary.
+        (goto-char (point-min))
 
-Return t when the word is removed."
-  (interactive)
-  (spell-fu--word-add-or-remove (spell-fu--word-at-point) 
ispell-personal-dictionary 'remove))
+        ;; Case insensitive.
+        (let
+          (
+            (changed nil)
+            (header-match
+              (save-match-data
+                (when
+                  ;; Match a line like: personal_ws-1.1 en 66
+                  (looking-at
+                    (concat
+                      "personal_ws-[[:digit:]\\.]+"
+                      "[[:blank:]]+"
+                      "[A-Za-z_]+"
+                      "[[:blank:]]+"
+                      "\\([[:digit:]]+\\)"))
+                  (forward-line 1)
+                  (match-data))))
+            (word-point
+              (save-match-data
+                (let ((case-fold-search t))
+                  (when (re-search-forward (concat "^" (regexp-quote word) 
"[[:blank:]]*$") nil t)
+                    (match-beginning 0))))))
+
+          (cond
+            ((eq action 'add)
+              (when word-point
+                (message "\"%s\" already in the personal dictionary." word)
+                (throw 'result nil))
+
+
+              (let ((keep-searching t))
+                (while
+                  (and
+                    keep-searching
+                    (string-lessp
+                      (buffer-substring-no-properties
+                        (line-beginning-position)
+                        (line-end-position))
+                      word))
+                  (setq keep-searching (eq 0 (forward-line 1)))))
+
+              (insert word "\n")
+
+              (message "\"%s\" successfully added!" word)
+              (setq changed t))
+
+            ((eq action 'remove)
+              (unless word-point
+                (message "\"%s\" not in the personal dictionary." word)
+                (throw 'result nil))
+
+              ;; Delete line.
+              (goto-char word-point)
+              (delete-region
+                (line-beginning-position)
+                (or (and (eq 0 (forward-line 1)) (point)) (line-end-position)))
+
+              (message "\"%s\" successfully removed!" word)
+              (setq changed t))
+
+            (t ;; Internal error, should never happen.
+              (error "Invalid action %S" action)))
+
+          (when changed
+            (when header-match
+              (save-match-data
+                (set-match-data header-match)
+                (replace-match
+                  (number-to-string (1- (count-lines (point-min) (point-max))))
+                  t
+                  nil
+                  nil
+                  1)))
+
+            (write-region nil nil dict-file nil 0)
+
+            (spell-fu--buffers-refresh-with-dict dict)
+            t))))))
+
+(defun spell-fu-get-personal-dictionary (name dict-file)
+  (let ((dict (intern (concat "spell-fu-ispell-personal-" name))))
+    (unless (boundp dict)
+      ;; Start with no words - construct them lazily
+      (set dict nil)
+      ;; Set description
+      (put dict 'description (format "Personal dictionary %s, located at %s" 
name dict-file))
+      ;; Set update function
+      (put dict 'update (lambda () (spell-fu--personal-update dict dict-file)))
+      ;; Set add/remove functions
+      (put
+        dict
+        'add-word
+        (lambda (word) (spell-fu--personal-word-add-or-remove word dict 
dict-file 'add)))
+      (put
+        dict
+        'remove-word
+        (lambda (word) (spell-fu--personal-word-add-or-remove word dict 
dict-file 'remove))))
+    dict))
 
 
 ;; ---------------------------------------------------------------------------
@@ -1212,7 +1387,20 @@ Return t when the word is removed."
 
 (defun spell-fu-mode-enable ()
   "Turn on option `spell-fu-mode' for the current buffer."
-  (spell-fu--ensure-dict (spell-fu--dictionary))
+
+  ;; Set the default dictionaries.
+  (unless spell-fu-dictionaries
+    (setq spell-fu-dictionaries (spell-fu--default-dictionaries)))
+
+  ;; Ensure our path exists.
+  (unless (file-directory-p spell-fu-directory)
+    (make-directory spell-fu-directory))
+
+  ;; Update dictionaries
+  (dolist (dict spell-fu-dictionaries)
+    (let ((update-fun (get dict 'update)))
+      (when update-fun
+        (funcall update-fun))))
 
   ;; We may want defaults for other modes,
   ;; although keep this general.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]