;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
-;; Copyright (C) 1994-1995, 1997-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-2015 Free Software Foundation, Inc.
;; Author: Ken Stevens <k.stevens@ieee.org>
;; Maintainer: Ken Stevens <k.stevens@ieee.org>
(make-obsolete-variable 'ispell-aspell-supports-utf8
'ispell-encoding8-command "23.1")
-(defvar ispell-hunspell-dictionary-equivs-alist
+(defvar ispell-dicts-name2locale-equivs-alist
'(("american" "en_US")
("brasileiro" "pt_BR")
("british" "en_GB")
("slovenian" "sl_SI")
("svenska" "sv_SE")
("hebrew" "he_IL"))
- "Alist with matching hunspell dict names for standard dict names in
+ "Alist with known matching locales for standard dict names in
`ispell-dictionary-base-alist'.")
(defvar ispell-emacs-alpha-regexp
"For aspell dictionary DICT-NAME, return a list of parameters if an
associated data file is found or nil otherwise. List format is that
of `ispell-dictionary-base-alist' elements."
+
+ ;; Make sure `ispell-aspell-dict-dir' is defined
+ (or ispell-aspell-dict-dir
+ (setq ispell-aspell-dict-dir
+ (ispell-get-aspell-config-value "dict-dir")))
+
;; Make sure `ispell-aspell-data-dir' is defined
(or ispell-aspell-data-dir
(setq ispell-aspell-data-dir
(ispell-get-aspell-config-value "data-dir")))
- ;; Try finding associated datafile
- (let* ((datafile1
- (concat ispell-aspell-data-dir "/"
- ;; Strip out variant, country code, etc.
- (and (string-match "^[[:alpha:]]+" dict-name)
- (match-string 0 dict-name)) ".dat"))
- (datafile2
- (concat ispell-aspell-data-dir "/"
- ;; Strip out anything but xx_YY.
- (and (string-match "^[[:alpha:]_]+" dict-name)
- (match-string 0 dict-name)) ".dat"))
- (data-file
- (if (file-readable-p datafile1)
- datafile1
- (if (file-readable-p datafile2)
- datafile2)))
- otherchars)
+
+ ;; Try finding associated datafile. 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.
+ (let ((data-file
+ (catch 'datafile
+ (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).
+ (dolist (tmp-regexp (list "^[[:alpha:]]+"
+ "^[[:alpha:]_]+"))
+ (let ((fullpath
+ (concat tmp-path "/"
+ (and (string-match tmp-regexp dict-name)
+ (match-string 0 dict-name)) ".dat")))
+ (if (file-readable-p fullpath)
+ (throw 'datafile fullpath)))))))
+ otherchars)
(if data-file
(with-temp-buffer
(realdict (assoc realname alist)))
(when (and realdict (not already-exists-p))
(push (cons aliasname (cdr realdict)) alist))))))
+ ;; Add entries for standard dict-names with found locale-matching entry
+ (dolist (dict-map-entry ispell-dicts-name2locale-equivs-alist)
+ (let ((name (car dict-map-entry))
+ (locale (cadr dict-map-entry)))
+ (unless (assoc name alist) ;; skip if already present
+ (if (assoc locale alist)
+ (push (cons name (cdr (assoc locale alist))) alist)))))
alist))
;; Make ispell.el work better with hunspell.
(if (cadr (assoc dict ispell-dictionary-alist))
(message "ispell-hfde: Non void entry for %s. Skipping.\n" dict)
(let ((dict-alias
- (cadr (assoc dict ispell-hunspell-dictionary-equivs-alist)))
+ (cadr (assoc dict ispell-dicts-name2locale-equivs-alist)))
(use-for-dicts (list dict))
(dict-args-cdr (cdr (ispell-parse-hunspell-affix-file dict)))
newlist)
;; Get a list of uninitialized dicts using the same affix file.
- (dolist (dict-equiv-alist-entry ispell-hunspell-dictionary-equivs-alist)
+ (dolist (dict-equiv-alist-entry ispell-dicts-name2locale-equivs-alist)
(let ((dict-equiv-key (car dict-equiv-alist-entry))
(dict-equiv-value (cadr dict-equiv-alist-entry)))
(if (or (member dict dict-equiv-alist-entry)
"Look for installed hunspell dictionaries.
Will initialize `ispell-hunspell-dictionary-alist' and
`ispell-hunspell-dictionary-alist' after values found
-and remove `ispell-hunspell-dictionary-equivs-alist'
+and remove `ispell-dicts-name2locale-equivs-alist'
entries if a specific dict was found."
(let ((hunspell-found-dicts
(split-string
"-- ispell-fhd: Skipping entry: %s\n" dict)))))
;; Remove entry from aliases alist if explicit dict was found.
(let (newlist)
- (dolist (dict ispell-hunspell-dictionary-equivs-alist)
+ (dolist (dict ispell-dicts-name2locale-equivs-alist)
(if (assoc (car dict) ispell-hunspell-dict-paths-alist)
(ispell-print-if-debug
"-- ispell-fhd: Excluding %s alias. Standalone dict found.\n"
(car dict))
(add-to-list 'newlist dict)))
- (setq ispell-hunspell-dictionary-equivs-alist newlist))
+ (setq ispell-dicts-name2locale-equivs-alist newlist))
;; Add known hunspell aliases
- (dolist (dict-equiv ispell-hunspell-dictionary-equivs-alist)
+ (dolist (dict-equiv ispell-dicts-name2locale-equivs-alist)
(let ((dict-equiv-key (car dict-equiv))
(dict-equiv-value (cadr dict-equiv))
(exclude-aliases (list ;; Exclude TeX aliases
(let* ((dict-name (nth 0 adict))
(dict-equiv
(cadr (assoc dict-name
- ispell-hunspell-dictionary-equivs-alist)))
+ ispell-dicts-name2locale-equivs-alist)))
(ispell-args (nth 5 adict))
(ispell-args-has-d (member "-d" ispell-args))
skip-dict)
or `i' is used.
Global `ispell-quit' set to start location to continue spell session."
(let ((count ?0)
- (line ispell-choices-win-default-height)
- ;; ensure 4 context lines.
- (max-lines (- (ispell-adjusted-window-height) 4))
(choices miss)
(window-min-height (min window-min-height
ispell-choices-win-default-height))
(command-characters '( ? ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m ))
- (dedicated (window-dedicated-p))
(skipped 0)
- char num result textwin dedicated-win)
+ char num result textwin)
;; setup the *Choices* buffer with valid data.
(with-current-buffer (get-buffer-create ispell-choices-buffer)
(boundp 'horizontal-scrollbar-visible-p)
(set-specifier horizontal-scrollbar-visible-p nil
(cons (current-buffer) nil))))
+ (ispell-with-no-warnings
+ (and (boundp 'horizontal-scroll-bar)
+ (setq horizontal-scroll-bar nil)))
(erase-buffer)
(if guess
(progn
(insert "Affix rules generate and capitalize "
"this word as shown below:\n\t")
(while guess
- (if (> (+ 4 (current-column) (length (car guess)))
- (window-width))
- (progn
- (insert "\n\t")
- (setq line (1+ line))))
+ (when (> (+ 4 (current-column) (length (car guess)))
+ (window-width))
+ (insert "\n\t"))
(insert (car guess) " ")
(setq guess (cdr guess)))
- (insert "\nUse option `i' to accept this spelling and put it in your private dictionary.\n")
- (setq line (+ line (if choices 3 2)))))
- (while (and choices
- (< (if (> (+ 7 (current-column) (length (car choices))
- (if (> count ?~) 3 0))
- (window-width))
- (progn
- (insert "\n")
- (setq line (1+ line)))
- line)
- max-lines))
+ (insert "\nUse option `i' to accept this spelling and put it in your private dictionary.\n")))
+ (while choices
+ (when (> (+ 7 (current-column)
+ (length (car choices))
+ (if (> count ?~) 3 0))
+ (window-width))
+ (insert "\n"))
;; not so good if there are over 20 or 30 options, but then, if
;; there are that many you don't want to scan them all anyway...
(while (memq count command-characters) ; skip command characters.
(if (not (pos-visible-in-window-p end))
(sit-for 0))
- ;; allow temporary split of dedicated windows...
- (if dedicated
- (progn
- (setq dedicated-win (selected-window))
- (set-window-dedicated-p dedicated-win nil)))
-
;; Display choices for misspelled word.
- (ispell-show-choices line end)
- (select-window (setq textwin (next-window)))
+ (setq textwin (selected-window))
+ (ispell-show-choices)
+ (select-window textwin)
;; highlight word, protecting current buffer status
(unwind-protect
(or ispell-complete-word-dict
ispell-alternate-dictionary))
miss (ispell-lookup-words new-word)
- choices miss
- line ispell-choices-win-default-height)
- (while (and choices ; adjust choices window.
- (< (if (> (+ 7 (current-column)
- (length (car choices))
- (if (> count ?~) 3 0))
- (window-width))
- (progn
- (insert "\n")
- (setq line (1+ line)))
- line)
- max-lines))
+ choices miss)
+ (while choices
+ (when (> (+ 7 (current-column)
+ (length (car choices))
+ (if (> count ?~) 3 0))
+ (window-width))
+ (insert "\n"))
(while (memq count command-characters)
(setq count (ispell-int-char (1+ count))
skipped (1+ skipped)))
count (ispell-int-char (1+ count))))
(setq count (ispell-int-char
(- count ?0 skipped))))
- (ispell-show-choices line end)
- (select-window (next-window)))))
+ (setq textwin (selected-window))
+ (ispell-show-choices)
+ (select-window textwin))))
(and (eq 'block ispell-highlight-p)
(ispell-highlight-spelling-error start end nil
'block))
(and ispell-highlight-p ; unhighlight
(save-window-excursion
(select-window textwin)
- (ispell-highlight-spelling-error start end)))
- (if dedicated
- (set-window-dedicated-p dedicated-win t)))))
+ (ispell-highlight-spelling-error start end))))))
-(defun ispell-show-choices (line end)
+(defun ispell-show-choices ()
"Show the choices in another buffer or frame."
(if (and ispell-use-framepop-p (fboundp 'framepop-display-buffer))
(progn
(framepop-display-buffer (get-buffer ispell-choices-buffer))
;; (get-buffer-window ispell-choices-buffer t)
(select-window (previous-window))) ; *Choices* window
- ;; standard selection by splitting a small buffer out of this window.
- (let ((choices-window (get-buffer-window ispell-choices-buffer)))
- (if choices-window
- (if (= line (ispell-adjusted-window-height choices-window))
- (select-window choices-window)
- ;; *Choices* window changed size. Adjust the choices window
- ;; without scrolling the spelled window when possible
- (let ((window-line
- (- line (ispell-adjusted-window-height choices-window)))
- (visible (progn (vertical-motion -1) (point))))
- (if (< line ispell-choices-win-default-height)
- (setq window-line (+ window-line
- (- ispell-choices-win-default-height
- line))))
- (move-to-window-line 0)
- (vertical-motion window-line)
- (set-window-start (selected-window)
- (if (> (point) visible) visible (point)))
- (goto-char end)
- (select-window choices-window)
- (enlarge-window window-line)))
- ;; Overlay *Choices* window when it isn't showing
- (ispell-overlay-window (max line ispell-choices-win-default-height)))
- (switch-to-buffer ispell-choices-buffer)
- (goto-char (point-min)))))
+ ;; Display choices above selected window.
+ (ispell-display-buffer (get-buffer-create ispell-choices-buffer))))
;;;###autoload
"Type 'x C-h f ispell-help' for more help")))
(save-window-excursion
(if ispell-help-in-bufferp
- (progn
- (ispell-overlay-window 4)
- (switch-to-buffer (get-buffer-create "*Ispell Help*"))
- (insert (concat help-1 "\n" help-2 "\n" help-3))
+ (let ((buffer (get-buffer-create "*Ispell Help*")))
+ (with-current-buffer buffer
+ (insert (concat help-1 "\n" help-2 "\n" help-3)))
+ (ispell-display-buffer buffer)
(sit-for 5)
(kill-buffer "*Ispell Help*"))
(unwind-protect
(ispell-highlight-spelling-error-overlay start end highlight))
(t (ispell-highlight-spelling-error-generic start end highlight refresh))))
-(defun ispell-adjusted-window-height (&optional window)
- "Like `window-height', adjusted to correct for the effect of tall mode-lines.
-The value returned is actually the nominal number of text-lines in the
-window plus 1. On a terminal, this is the same value returned by
-`window-height', but if the window has a mode-line is taller than a normal
-text line, the returned value may be smaller than that from
-`window-height'."
- (cond ((fboundp 'window-text-height)
- (1+ (window-text-height window)))
- ((or (and (fboundp 'display-graphic-p) (display-graphic-p))
- (and (featurep 'xemacs) window-system))
- (1- (window-height window)))
- (t
- (window-height window))))
-
-(defun ispell-overlay-window (height)
- "Create a window covering the top HEIGHT lines of the current window.
-Ensure that the line above point is still visible but otherwise avoid
-scrolling the current window. Leave the new window selected."
- (save-excursion
- (let ((oldot (save-excursion (vertical-motion -1) (point)))
- (top (save-excursion (move-to-window-line height) (point))))
- ;; If line above old point (line starting at oldot) would be
- ;; hidden by new window, scroll it to just below new win
- ;; otherwise set top line of other win so it doesn't scroll.
- (if (< oldot top) (setq top oldot))
- ;; if frame is unsplittable, temporarily disable that...
- (if (cdr (assq 'unsplittable (frame-parameters (selected-frame))))
- (let ((frame (selected-frame)))
- (modify-frame-parameters frame '((unsplittable . nil)))
- (split-window nil height)
- (modify-frame-parameters frame '((unsplittable . t))))
- (split-window nil height))
- (let ((deficit (- height (ispell-adjusted-window-height))))
- (when (> deficit 0)
- ;; Number of lines the window is still too short. We ensure that
- ;; there are at least (1- HEIGHT) lines visible in the window.
- (enlarge-window deficit)
- (goto-char top)
- (vertical-motion deficit)
- (setq top (min (point) oldot))))
- (set-window-start (next-window) top))))
-
+(defun ispell-display-buffer (buffer)
+ "Show BUFFER in new window above selected one.
+Also position fit window to BUFFER and select it."
+ (let* ((unsplittable
+ (cdr (assq 'unsplittable (frame-parameters (selected-frame)))))
+ (window
+ (or (get-buffer-window buffer)
+ (and unsplittable
+ ;; If frame is unsplittable, temporarily disable that...
+ (let ((frame (selected-frame)))
+ (modify-frame-parameters frame '((unsplittable . nil)))
+ (prog1
+ (condition-case nil
+ (split-window
+ nil (- ispell-choices-win-default-height) 'above)
+ (error nil))
+ (modify-frame-parameters frame '((unsplittable . t))))))
+ (and (not unsplittable)
+ (condition-case nil
+ (split-window
+ nil (- ispell-choices-win-default-height) 'above)
+ (error nil)))
+ (display-buffer buffer))))
+ (if (not window)
+ (error "Couldn't make window for *Choices*")
+ (select-window window)
+ (set-window-buffer window buffer)
+ (set-window-point window (point-min))
+ (fit-window-to-buffer window nil nil nil nil t))))
;; Should we add a compound word match return value?
(defun ispell-parse-output (output &optional accept-list shift)