;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
-;; Copyright (C) 1994-1995, 1997-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-2013 Free Software Foundation, Inc.
;; Author: Ken Stevens <k.stevens@ieee.org>
;; Maintainer: Ken Stevens <k.stevens@ieee.org>
(save-excursion
(re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
+;;; XEmacs21 does not have `with-no-warnings'. Taken from org mode.
+(defmacro ispell-with-no-warnings (&rest body)
+ (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
+
;;; Code:
(defvar mail-yank-prefix)
:version "22.1")
(defcustom ispell-highlight-face (if ispell-lazy-highlight 'isearch 'highlight)
- "The face used for Ispell highlighting. For Emacsen with overlays.
-Possible values are `highlight', `modeline', `secondary-selection',
-`region', and `underline'.
+ "Face used for Ispell highlighting.
This variable can be set by the user to whatever face they desire.
It's most convenient if the cursor color and highlight color are
slightly different."
"ispell")
"Program invoked by \\[ispell-word] and \\[ispell-region] commands."
:type 'string
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (if (featurep 'ispell)
+ (ispell-set-spellchecker-params)))
:group 'ispell)
(defcustom ispell-alternate-dictionary
set as casechars and otherchars in the LANGUAGE.aff file \(e.g.,
english.aff\). aspell and hunspell don't have this limitation.")
-(defvar ispell-really-aspell nil) ; Non-nil if we can use aspell extensions.
-(defvar ispell-really-hunspell nil) ; Non-nil if we can use hunspell extensions.
+(defvar ispell-really-aspell nil
+ "Non-nil if we can use aspell extensions.")
+(defvar ispell-really-hunspell nil
+ "Non-nil if we can use hunspell extensions.")
(defvar ispell-encoding8-command nil
"Command line option prefix to select encoding if supported, nil otherwise.
If setting the encoding is supported by spellchecker and is selectable from
(make-obsolete-variable 'ispell-aspell-supports-utf8
'ispell-encoding8-command "23.1")
+(defvar ispell-hunspell-dictionary-equivs-alist
+ '(("american" "en_US")
+ ("brasileiro" "pt_BR")
+ ("british" "en_GB")
+ ("castellano" "es_ES")
+ ("castellano8" "es_ES")
+ ("czech" "cs_CZ")
+ ("dansk" "da_DK")
+ ("deutsch" "de_DE")
+ ("deutsch8" "de_DE")
+ ("english" "en_US")
+ ("esperanto" "eo")
+ ("esperanto-tex" "eo")
+ ("finnish" "fi_FI")
+ ("francais7" "fr_FR")
+ ("francais" "fr_FR")
+ ("francais-tex" "fr_FR")
+ ("german" "de_DE")
+ ("german8" "de_DE")
+ ("italiano" "it_IT")
+ ("nederlands" "nl_NL")
+ ("nederlands8" "nl_NL")
+ ("norsk" "nn_NO")
+ ("norsk7-tex" "nn_NO")
+ ("polish" "pl_PL")
+ ("portugues" "pt_PT")
+ ("russian" "ru_RU")
+ ("russianw" "ru_RU")
+ ("slovak" "sk_SK")
+ ("slovenian" "sl_SI")
+ ("svenska" "sv_SE")
+ ("hebrew" "he_IL"))
+ "Alist with matching hunspell dict names for standard dict names in
+ `ispell-dictionary-base-alist'.")
+
(defvar ispell-emacs-alpha-regexp
(if (string-match "^[[:alpha:]]+$" "abcde")
"[[:alpha:]]"
(if (string-match "\\`aspell" speller) "-v" "-vv"))))
(goto-char (point-min))
(if interactivep
- ;; report version information of ispell and ispell.el
+ ;; Report version information of ispell and ispell.el
(progn
(end-of-line)
(setq result (concat (buffer-substring-no-properties (point-min)
(setq default-directory (expand-file-name "~/")))
(apply 'call-process-region args)))
+(defun ispell-create-debug-buffer (&optional append)
+ "Create an ispell debug buffer for debugging output.
+Use APPEND to append the info to previous buffer if exists,
+otherwise is reset. Returns name of ispell debug buffer.
+See `ispell-buffer-with-debug' for an example of use."
+ (let ((ispell-debug-buffer (get-buffer-create "*ispell-debug*")))
+ (with-current-buffer ispell-debug-buffer
+ (if append
+ (insert
+ (format "-----------------------------------------------\n"))
+ (erase-buffer)))
+ ispell-debug-buffer))
+
+(defsubst ispell-print-if-debug (format &rest args)
+ "Print message to `ispell-debug-buffer' buffer if enabled."
+ (if (boundp 'ispell-debug-buffer)
+ (with-current-buffer ispell-debug-buffer
+ (goto-char (point-max))
+ (insert (apply #'format format args)))))
;; The preparation of the menu bar menu must be autoloaded
(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)))
+ (let* ((aliasname (file-name-base alias-file))
(already-exists-p (assoc aliasname alist))
(realname (match-string 1))
(realdict (assoc realname alist)))
(push (cons aliasname (cdr realdict)) alist))))))
alist))
+;; Make ispell.el work better with hunspell.
+
+(defvar ispell-hunspell-dict-paths-alist nil
+ "Alist of parsed hunspell dicts and associated affix files.
+Will be used to parse corresponding .aff file and create associated
+parameters to be inserted into `ispell-hunspell-dictionary-alist'.
+Internal use.")
+
+(defvar ispell-hunspell-dictionary-alist nil
+ "Alist of parsed hunspell dicts and associated parameters.
+This alist will initially contain names of found dicts. Associated
+parameters will be added when dict is used for the first time.
+Internal use.")
+
+(defun ispell-hunspell-fill-dictionary-entry (dict)
+ "Fill `ispell-dictionary-alist' uninitialized entries for `DICT' and aliases.
+Value will be extracted from hunspell affix file and used for
+all uninitialized dicts using that affix file."
+ (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)))
+ (use-for-dicts (list dict))
+ (dict-args-cdr (cdr (ispell-parse-hunspell-affix-file dict)))
+ newlist)
+ ;; Get a list of unitialized dicts using the same affix file.
+ (dolist (dict-equiv-alist-entry ispell-hunspell-dictionary-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)
+ (member dict-alias dict-equiv-alist-entry))
+ (dolist ( tmp-dict (list dict-equiv-key dict-equiv-value))
+ (if (cadr (assoc tmp-dict ispell-dictionary-alist))
+ (ispell-print-if-debug
+ "ispell-hfde: %s already expanded. Skipping.\n" tmp-dict)
+ (add-to-list 'use-for-dicts tmp-dict))))))
+ (ispell-print-if-debug
+ "ispell-hfde: Filling %s entry. Use for %s.\n" dict use-for-dicts)
+ ;; The final loop.
+ (dolist (entry ispell-dictionary-alist)
+ (if (member (car entry) use-for-dicts)
+ (add-to-list 'newlist
+ (append (list (car entry)) dict-args-cdr))
+ (add-to-list 'newlist entry)))
+ (setq ispell-dictionary-alist newlist))))
+
+(defun ispell-parse-hunspell-affix-file (dict-key)
+ "Parse hunspell affix file to extract parameters for `DICT-KEY'.
+Return a list in `ispell-dictionary-alist' format."
+ (let ((affix-file (cadr (assoc dict-key ispell-hunspell-dict-paths-alist))))
+ (unless affix-file
+ (error "ispell-phaf: No matching entry for %s.\n" dict-key))
+ (if (not (file-exists-p affix-file))
+ (error "ispell-phaf: File \"%s\" not found.\n" affix-file))
+ (let ((dict-name (file-name-sans-extension
+ (file-name-nondirectory affix-file)))
+ otherchars-string otherchars-list)
+ (with-temp-buffer
+ (insert-file-contents affix-file)
+ (setq otherchars-string
+ (save-excursion
+ (goto-char (point-min))
+ (if (search-forward-regexp "^WORDCHARS +" nil t )
+ (buffer-substring (point)
+ (progn (end-of-line) (point))))))
+ ;; Remove trailing whitespace and extra stuff. Make list if
+ ;; non-nil.
+ (setq otherchars-list
+ (if otherchars-string
+ (split-string
+ (if (string-match " +.*$" otherchars-string)
+ (replace-match "" nil nil otherchars-string)
+ otherchars-string)
+ "" t)))
+
+ ;; Fill dict entry
+ (list dict-key
+ "[[:alpha:]]"
+ "[^[:alpha:]]"
+ (if otherchars-list
+ (regexp-opt otherchars-list)
+ "")
+ t ; many-otherchars-p: We can't tell, set to t.
+ (list "-d" dict-name)
+ nil ; extended-char-mode: not supported by hunspell!
+ 'utf-8)))))
+
+(defun ispell-find-hunspell-dictionaries ()
+ "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'
+entries if a specific dict was found."
+ (let ((hunspell-found-dicts
+ (split-string
+ (with-temp-buffer
+ (ispell-call-process ispell-program-name
+ null-device
+ t
+ nil
+ "-D")
+ (buffer-string))
+ "[\n\r]+"
+ t))
+ hunspell-default-dict
+ hunspell-default-dict-entry)
+ (dolist (dict hunspell-found-dicts)
+ (let* ((full-name (file-name-nondirectory dict))
+ (basename (file-name-sans-extension full-name))
+ (affix-file (concat dict ".aff")))
+ (if (string-match "\\.aff$" dict)
+ ;; Found default dictionary
+ (if hunspell-default-dict
+ (error "ispell-fhd: Default dict already defined as %s. Not using %s.\n"
+ hunspell-default-dict dict)
+ (setq affix-file dict)
+ (setq hunspell-default-dict (list basename affix-file)))
+ (if (and (not (assoc basename ispell-hunspell-dict-paths-alist))
+ (file-exists-p affix-file))
+ ;; Entry has an associated .aff file and no previous value.
+ (let ((affix-file (expand-file-name affix-file)))
+ (ispell-print-if-debug
+ "++ ispell-fhd: dict-entry:%s name:%s basename:%s affix-file:%s\n"
+ dict full-name basename affix-file)
+ (add-to-list 'ispell-hunspell-dict-paths-alist
+ (list basename affix-file)))
+ (ispell-print-if-debug
+ "-- 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)
+ (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))
+ ;; Add known hunspell aliases
+ (dolist (dict-equiv ispell-hunspell-dictionary-equivs-alist)
+ (let ((dict-equiv-key (car dict-equiv))
+ (dict-equiv-value (cadr dict-equiv))
+ (exclude-aliases (list ;; Exclude TeX aliases
+ "esperanto-tex"
+ "francais7"
+ "francais-tex"
+ "norsk7-tex")))
+ (if (and (assoc dict-equiv-value ispell-hunspell-dict-paths-alist)
+ (not (assoc dict-equiv-key ispell-hunspell-dict-paths-alist))
+ (not (member dict-equiv-key exclude-aliases)))
+ (let ((affix-file (cadr (assoc dict-equiv-value
+ ispell-hunspell-dict-paths-alist))))
+ (ispell-print-if-debug "++ ispell-fhd: Adding alias %s -> %s.\n"
+ dict-equiv-key affix-file)
+ (add-to-list
+ 'ispell-hunspell-dict-paths-alist
+ (list dict-equiv-key affix-file))))))
+ ;; Parse and set values for default dictionary.
+ (setq hunspell-default-dict (car hunspell-default-dict))
+ (setq hunspell-default-dict-entry
+ (ispell-parse-hunspell-affix-file hunspell-default-dict))
+ ;; Create an alist of found dicts with only names, except for default dict.
+ (setq ispell-hunspell-dictionary-alist
+ (list (append (list nil) (cdr hunspell-default-dict-entry))))
+ (dolist (dict (mapcar 'car ispell-hunspell-dict-paths-alist))
+ (if (string= dict hunspell-default-dict)
+ (add-to-list 'ispell-hunspell-dictionary-alist
+ hunspell-default-dict-entry)
+ (add-to-list 'ispell-hunspell-dictionary-alist
+ (list dict))))))
+
;; Set params according to the selected spellchecker
(defvar ispell-last-program-name nil
(setq ispell-library-directory (ispell-check-version))
t)
(error nil))
- ispell-really-aspell
ispell-encoding8-command
ispell-emacs-alpha-regexp)
- (unless ispell-aspell-dictionary-alist
- (ispell-find-aspell-dictionaries)))
-
- ;; Substitute ispell-dictionary-alist with the list of dictionaries
- ;; corresponding to the given spellchecker. If a recent aspell, use
- ;; the list of really installed dictionaries and add to it elements
- ;; of the original list that are not present there. Allow distro info.
+ ;; auto-detection will only be used if spellchecker is not
+ ;; ispell, supports a way to set communication to UTF-8 and
+ ;; Emacs flavor supports [:alpha:]
+ (if ispell-really-aspell
+ (or ispell-aspell-dictionary-alist
+ (ispell-find-aspell-dictionaries))
+ (if ispell-really-hunspell
+ (or ispell-hunspell-dictionary-alist
+ (ispell-find-hunspell-dictionaries)))))
+
+ ;; Substitute ispell-dictionary-alist with the list of
+ ;; dictionaries corresponding to the given spellchecker.
+ ;; If a recent aspell or hunspell, use the list of really
+ ;; installed dictionaries and add to it elements of the original
+ ;; list that are not present there. Allow distro info.
(let ((found-dicts-alist
- (if (and ispell-really-aspell
- ispell-encoding8-command)
- ispell-aspell-dictionary-alist
+ (if (and ispell-encoding8-command
+ ispell-emacs-alpha-regexp)
+ (if ispell-really-aspell
+ ispell-aspell-dictionary-alist
+ (if ispell-really-hunspell
+ ispell-hunspell-dictionary-alist))
nil))
+ (ispell-dictionary-base-alist ispell-dictionary-base-alist)
ispell-base-dicts-override-alist ; Override only base-dicts-alist
all-dicts-alist)
+ ;; While ispell and aspell (through aliases) use the traditional
+ ;; dict naming originally expected by ispell.el, hunspell
+ ;; uses locale based names with no alias. We need to map
+ ;; standard names to locale based names to make default dict
+ ;; definitions available for hunspell.
+ (if ispell-really-hunspell
+ (let (tmp-dicts-alist)
+ (dolist (adict ispell-dictionary-base-alist)
+ (let* ((dict-name (nth 0 adict))
+ (dict-equiv
+ (cadr (assoc dict-name
+ ispell-hunspell-dictionary-equivs-alist)))
+ (ispell-args (nth 5 adict))
+ (ispell-args-has-d (member "-d" ispell-args))
+ skip-dict)
+ ;; Remove "-d" option from `ispell-args' if present
+ (if ispell-args-has-d
+ (let ((ispell-args-after-d
+ (cdr (cdr ispell-args-has-d)))
+ (ispell-args-before-d
+ (butlast ispell-args (length ispell-args-has-d))))
+ (setq ispell-args
+ (nconc ispell-args-before-d
+ ispell-args-after-d))))
+ ;; Unless default dict, re-add "-d" option with the mapped value
+ (if dict-name
+ (if dict-equiv
+ (nconc ispell-args (list "-d" dict-equiv))
+ (message
+ "ispell-set-spellchecker-params: Missing hunspell equiv for \"%s\". Skipping."
+ dict-name)
+ (setq skip-dict t)))
+
+ (unless skip-dict
+ (add-to-list 'tmp-dicts-alist
+ (list
+ dict-name ; dict name
+ (nth 1 adict) ; casechars
+ (nth 2 adict) ; not-casechars
+ (nth 3 adict) ; otherchars
+ (nth 4 adict) ; many-otherchars-p
+ ispell-args ; ispell-args
+ (nth 6 adict) ; extended-character-mode
+ (nth 7 adict) ; dict encoding
+ ))))
+ (setq ispell-dictionary-base-alist tmp-dicts-alist))))
+
(run-hooks 'ispell-initialize-spellchecker-hook)
;; Add dicts to ``ispell-dictionary-alist'' unless already present.
;; If Emacs flavor supports [:alpha:] use it for global dicts. If
;; spellchecker also supports UTF-8 via command-line option use it
- ;; in communication. This does not affect definitions in ~/.emacs.
+ ;; in communication. This does not affect definitions in your
+ ;; init file.
(if ispell-emacs-alpha-regexp
(let (tmp-dicts-alist)
(dolist (adict ispell-dictionary-alist)
- (add-to-list 'tmp-dicts-alist
- (list
- (nth 0 adict) ; dict name
- "[[:alpha:]]" ; casechars
- "[^[:alpha:]]" ; not-casechars
- (nth 3 adict) ; otherchars
- (nth 4 adict) ; many-otherchars-p
- (nth 5 adict) ; ispell-args
- (nth 6 adict) ; extended-character-mode
- (if ispell-encoding8-command
- 'utf-8
- (nth 7 adict)))))
- (setq ispell-dictionary-alist tmp-dicts-alist)))))
+ (if (cadr adict) ;; Do not touch hunspell uninitialized entries
+ (add-to-list 'tmp-dicts-alist
+ (list
+ (nth 0 adict) ; dict name
+ "[[:alpha:]]" ; casechars
+ "[^[:alpha:]]" ; not-casechars
+ (nth 3 adict) ; otherchars
+ (nth 4 adict) ; many-otherchars-p
+ (nth 5 adict) ; ispell-args
+ (nth 6 adict) ; extended-character-mode
+ (if ispell-encoding8-command
+ 'utf-8
+ (nth 7 adict))))
+ (add-to-list 'tmp-dicts-alist adict)))
+ (setq ispell-dictionary-alist tmp-dicts-alist)))))
(defun ispell-valid-dictionary-list ()
"Return a list of valid dictionaries.
(defun ispell-accept-output (&optional timeout-secs timeout-msecs)
"Wait for output from ispell process, or TIMEOUT-SECS and TIMEOUT-MSECS.
-If asynchronous subprocesses are not supported, call `ispell-filter' and
-pass it the output of the last ispell invocation."
+If asynchronous subprocesses are not supported, call function `ispell-filter'
+and pass it the output of the last ispell invocation."
(if ispell-async-processp
(accept-process-output ispell-process timeout-secs timeout-msecs)
(if (null ispell-process)
quit spell session exited."
(interactive (list ispell-following-word ispell-quietly current-prefix-arg t))
(cond
- ((and region (use-region-p))
+ ((and region
+ (if (featurep 'emacs)
+ (use-region-p)
+ (and (boundp 'transient-mark-mode) transient-mark-mode
+ (boundp 'mark-active) mark-active
+ (not (eq (region-beginning) (region-end))))))
(ispell-region (region-beginning) (region-end)))
(continue (ispell-continue))
(t
(interactive (list ispell-silently-savep t))
(if (and ispell-pdict-modified-p (listp ispell-pdict-modified-p))
(setq ispell-pdict-modified-p (car ispell-pdict-modified-p)))
- (if (or ispell-pdict-modified-p force-save)
- (if (or no-query (y-or-n-p "Personal dictionary modified. Save? "))
- (progn
- (ispell-send-string "#\n") ; save dictionary
- (message "Personal dictionary saved."))))
+ (when (and (or ispell-pdict-modified-p force-save)
+ (or no-query
+ (y-or-n-p "Personal dictionary modified. Save? ")))
+ (ispell-send-string "#\n") ; save dictionary
+ (message "Personal dictionary saved.")
+ (when flyspell-mode
+ (flyspell-mode 0)
+ (flyspell-mode 1)))
;; unassert variable, even if not saved to avoid questioning.
(setq ispell-pdict-modified-p nil))
" -- dict: " (or ispell-current-dictionary "default")
" -- prog: " (file-name-nondirectory ispell-program-name)))
;; XEmacs: no need for horizontal scrollbar in choices window
- (with-no-warnings
+ (ispell-with-no-warnings
(and (fboundp 'set-specifier)
(boundp 'horizontal-scrollbar-visible-p)
(set-specifier horizontal-scrollbar-visible-p nil
(regexp-quote (buffer-substring-no-properties start end))
"\\b"))
(isearch-regexp t)
- (isearch-case-fold-search nil))
+ (isearch-case-fold-search nil)
+ (isearch-forward t)
+ (isearch-other-end start)
+ (isearch-error nil))
(isearch-lazy-highlight-new-loop
(if (boundp 'reg-start) reg-start)
(if (boundp 'reg-end) reg-end)))
(defun ispell-start-process ()
"Start the Ispell process, with support for no asynchronous processes.
Keeps argument list for future Ispell invocations for no async support."
- ;; Local dictionary becomes the global dictionary in use.
- (setq ispell-current-dictionary
- (or ispell-local-dictionary ispell-dictionary))
- (setq ispell-current-personal-dictionary
- (or ispell-local-pdict ispell-personal-dictionary))
+ ;; `ispell-current-dictionary' and `ispell-current-personal-dictionary'
+ ;; are properly set in `ispell-internal-change-dictionary'.
+
+ ;; Parse hunspell affix file if using hunspell and entry is uninitialized.
+ (if ispell-really-hunspell
+ (or (cadr (assoc ispell-current-dictionary ispell-dictionary-alist))
+ (ispell-hunspell-fill-dictionary-entry ispell-current-dictionary)))
+
(let* ((default-directory
(if (and (file-directory-p default-directory)
(file-readable-p default-directory))
(list "-d" ispell-current-dictionary))
orig-args
(if ispell-current-personal-dictionary ; Use specified pers dict.
- (list "-p"
- (expand-file-name ispell-current-personal-dictionary)))
+ (list "-p" ispell-current-personal-dictionary))
;; If we are using recent aspell or hunspell, make sure we use the
;; right encoding for communication. ispell or older aspell/hunspell
;; does not support this.
(let* (;; Basename of dictionary used by the spell-checker
(dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args))))
ispell-current-dictionary))
+ ;; The directory where process was started.
+ (current-ispell-directory default-directory)
+ ;; The default directory for the process.
;; Use "~/" as default-directory unless using Ispell with per-dir
;; personal dictionaries and not in a minibuffer under XEmacs
(default-directory
;; This hook is typically used by flyspell to flush some variables used
;; to optimize the common cases.
(run-hooks 'ispell-kill-ispell-hook)
- (if (or clear (interactive-p))
+ (if (or clear
+ (if (featurep 'xemacs)
+ (interactive-p)
+ (called-interactively-p 'interactive)))
(setq ispell-buffer-session-localwords nil))
(if (not (and ispell-process
(eq (ispell-process-status) 'run)))
;; Specified dictionary is the default already. Could reload
;; the dictionaries if needed.
(ispell-internal-change-dictionary)
- (and (interactive-p)
+ (and (if (featurep 'xemacs)
+ (interactive-p)
+ (called-interactively-p 'interactive))
(message "No change, using %s dictionary" dict)))
(t ; reset dictionary!
(if (or (assoc dict ispell-local-dictionary-alist)
"Update the dictionary and the personal dictionary used by Ispell.
This may kill the Ispell process; if so, a new one will be started
when needed."
- (let ((dict (or ispell-local-dictionary ispell-dictionary))
- (pdict (or ispell-local-pdict ispell-personal-dictionary)))
+ (let* ((dict (or ispell-local-dictionary ispell-dictionary))
+ (pdict (or ispell-local-pdict ispell-personal-dictionary))
+ (expanded-pdict (if pdict (expand-file-name pdict))))
(unless (and (equal ispell-current-dictionary dict)
- (equal ispell-current-personal-dictionary pdict))
+ (equal ispell-current-personal-dictionary
+ expanded-pdict))
(ispell-kill-ispell t)
(setq ispell-current-dictionary dict
- ispell-current-personal-dictionary pdict))))
+ ispell-current-personal-dictionary expanded-pdict))))
;; Avoid error messages when compiling for these dynamic variables.
(defvar ispell-start)
(if (not recheckp)
(ispell-accept-buffer-local-defs)) ; set up dictionary, local words, etc.
(let ((skip-region-start (make-marker))
- (rstart (make-marker)))
- (unwind-protect
- (save-excursion
- (message "Spell-checking %s using %s with %s dictionary..."
- (if (and (= reg-start (point-min)) (= reg-end (point-max)))
- (buffer-name) "region")
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default"))
- ;; Returns cursor to original location.
- (save-window-excursion
- (goto-char reg-start)
- (let ((transient-mark-mode)
- (case-fold-search case-fold-search)
- (query-fcc t)
- in-comment key)
- (let (message-log-max)
- (message "searching for regions to skip"))
- (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t)
- (progn
- (setq key (match-string-no-properties 0))
- (set-marker skip-region-start (- (point) (length key)))
- (goto-char reg-start)))
- (let (message-log-max)
- (message
- "Continuing spelling check using %s with %s dictionary..."
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default")))
- (set-marker rstart reg-start)
- (set-marker ispell-region-end reg-end)
- (while (and (not ispell-quit)
- (< (point) ispell-region-end))
- ;; spell-check region with skipping
- (if (and (marker-position skip-region-start)
- (<= skip-region-start (point)))
+ (rstart (make-marker))
+ (region-type (if (and (= reg-start (point-min)) (= reg-end (point-max)))
+ (buffer-name) "region"))
+ (program-basename (file-name-nondirectory ispell-program-name))
+ (dictionary (or ispell-current-dictionary "default")))
+ (unwind-protect
+ (save-excursion
+ (message "Spell-checking %s using %s with %s dictionary..."
+ region-type program-basename dictionary)
+ ;; Returns cursor to original location.
+ (save-window-excursion
+ (goto-char reg-start)
+ (let ((transient-mark-mode)
+ (case-fold-search case-fold-search)
+ (query-fcc t)
+ in-comment key)
+ (ispell-print-if-debug
+ "ispell-region: (ispell-skip-region-list):\n%s
+ispell-region: (ispell-begin-skip-region-regexp):\n%s
+ispell-region: Search for first region to skip after (ispell-begin-skip-region-regexp)\n"
+ (ispell-skip-region-list)
+ (ispell-begin-skip-region-regexp))
+ (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t)
(progn
- ;; If region inside line comment, must keep comment start.
- (setq in-comment (point)
- in-comment
- (and comment-start
- (or (null comment-end) (string= "" comment-end))
- (save-excursion
- (beginning-of-line)
- (re-search-forward comment-start in-comment t))
- comment-start))
- ;; Can change skip-regexps (in ispell-message)
- (ispell-skip-region key) ; moves pt past region.
- (set-marker rstart (point))
- ;; check for saving large attachments...
- (setq query-fcc (and query-fcc
- (ispell-ignore-fcc skip-region-start
- rstart)))
- (if (and (< rstart ispell-region-end)
- (re-search-forward
- (ispell-begin-skip-region-regexp)
- ispell-region-end t))
- (progn
- (setq key (match-string-no-properties 0))
- (set-marker skip-region-start
- (- (point) (length key)))
- (goto-char rstart))
- (set-marker skip-region-start nil))))
- (setq reg-end (max (point)
- (if (marker-position skip-region-start)
- (min skip-region-start ispell-region-end)
- (marker-position ispell-region-end))))
- (let* ((ispell-start (point))
- (ispell-end (min (point-at-eol) reg-end))
- (string (ispell-get-line
- ispell-start ispell-end in-comment)))
- (if in-comment ; account for comment chars added
- (setq ispell-start (- ispell-start (length in-comment))
- in-comment nil))
- (setq ispell-end (point)) ; "end" tracks region retrieved.
- (if string ; there is something to spell check!
- ;; (special start end)
- (setq shift (ispell-process-line string
- (and recheckp shift))))
- (goto-char ispell-end)))))
- (if ispell-quit
- nil
- (or shift 0)))
- ;; protected
- (if (and (not (and recheckp ispell-keep-choices-win))
- (get-buffer ispell-choices-buffer))
- (kill-buffer ispell-choices-buffer))
- (set-marker skip-region-start nil)
- (set-marker rstart nil)
- (if ispell-quit
- (progn
- ;; preserve or clear the region for ispell-continue.
- (if (not (numberp ispell-quit))
- (set-marker ispell-region-end nil)
- ;; Ispell-continue enabled - ispell-region-end is set.
- (goto-char ispell-quit))
- ;; Check for aborting
- (if (and ispell-checking-message (numberp ispell-quit))
- (progn
- (setq ispell-quit nil)
- (error "Message send aborted")))
- (if (not recheckp) (setq ispell-quit nil)))
- (if (not recheckp) (set-marker ispell-region-end nil))
- ;; Only save if successful exit.
- (ispell-pdict-save ispell-silently-savep)
- (message "Spell-checking %s using %s with %s dictionary...done"
- (if (and (= reg-start (point-min)) (= reg-end (point-max)))
- (buffer-name) "region")
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default"))))))
+ (setq key (match-string-no-properties 0))
+ (set-marker skip-region-start (- (point) (length key)))
+ (goto-char reg-start)
+ (ispell-print-if-debug
+ "ispell-region: First skip: %s at (pos,line,column): (%s,%s,%s).\n"
+ key
+ (save-excursion (goto-char skip-region-start) (point))
+ (line-number-at-pos skip-region-start)
+ (save-excursion (goto-char skip-region-start) (current-column)))))
+ (ispell-print-if-debug
+ "ispell-region: Continue spell-checking with %s and %s dictionary...\n"
+ program-basename dictionary)
+ (set-marker rstart reg-start)
+ (set-marker ispell-region-end reg-end)
+ (while (and (not ispell-quit)
+ (< (point) ispell-region-end))
+ ;; spell-check region with skipping
+ (if (and (marker-position skip-region-start)
+ (<= skip-region-start (point)))
+ (progn
+ ;; If region inside line comment, must keep comment start.
+ (setq in-comment (point)
+ in-comment
+ (and comment-start
+ (or (null comment-end) (string= "" comment-end))
+ (save-excursion
+ (beginning-of-line)
+ (re-search-forward comment-start in-comment t))
+ comment-start))
+ ;; Can change skip-regexps (in ispell-message)
+ (ispell-skip-region key) ; moves pt past region.
+ (set-marker rstart (point))
+ ;; check for saving large attachments...
+ (setq query-fcc (and query-fcc
+ (ispell-ignore-fcc skip-region-start
+ rstart)))
+ (if (and (< rstart ispell-region-end)
+ (re-search-forward
+ (ispell-begin-skip-region-regexp)
+ ispell-region-end t))
+ (progn
+ (setq key (match-string-no-properties 0))
+ (set-marker skip-region-start
+ (- (point) (length key)))
+ (goto-char rstart)
+ (ispell-print-if-debug
+ "ispell-region: Next skip: %s at (pos,line,column): (%s,%s,%s).\n"
+ key
+ (save-excursion (goto-char skip-region-start) (point))
+ (line-number-at-pos skip-region-start)
+ (save-excursion (goto-char skip-region-start) (current-column))))
+ (set-marker skip-region-start nil))))
+ (setq reg-end (max (point)
+ (if (marker-position skip-region-start)
+ (min skip-region-start ispell-region-end)
+ (marker-position ispell-region-end))))
+ (let* ((ispell-start (point))
+ (ispell-end (min (point-at-eol) reg-end))
+ ;; See if line must be prefixed by comment string to let ispell know this is
+ ;; part of a comment string. This is only supported in some modes.
+ ;; In particular, this is not supported in autoconf mode where adding the
+ ;; comment string messes everything up because ispell tries to spellcheck the
+ ;; `dnl' string header causing misalignments in some cases (debbugs.gnu.org: #12768).
+ (add-comment (and in-comment
+ (not (string= in-comment "dnl "))
+ in-comment))
+ (string (ispell-get-line
+ ispell-start ispell-end add-comment)))
+ (ispell-print-if-debug
+ "ispell-region: string pos (%s->%s), eol: %s, [in-comment]: [%s], [add-comment]: [%s], [string]: [%s]\n"
+ ispell-start ispell-end (point-at-eol) in-comment add-comment string)
+ (if add-comment ; account for comment chars added
+ (setq ispell-start (- ispell-start (length add-comment))
+ add-comment nil))
+ (setq ispell-end (point)) ; "end" tracks region retrieved.
+ (if string ; there is something to spell check!
+ ;; (special start end)
+ (setq shift (ispell-process-line string
+ (and recheckp shift))))
+ (goto-char ispell-end)))))
+ (if ispell-quit
+ nil
+ (or shift 0)))
+ ;; protected
+ (if (and (not (and recheckp ispell-keep-choices-win))
+ (get-buffer ispell-choices-buffer))
+ (kill-buffer ispell-choices-buffer))
+ (set-marker skip-region-start nil)
+ (set-marker rstart nil)
+ (if ispell-quit
+ (progn
+ ;; preserve or clear the region for ispell-continue.
+ (if (not (numberp ispell-quit))
+ (set-marker ispell-region-end nil)
+ ;; Ispell-continue enabled - ispell-region-end is set.
+ (goto-char ispell-quit))
+ ;; Check for aborting
+ (if (and ispell-checking-message (numberp ispell-quit))
+ (progn
+ (setq ispell-quit nil)
+ (error "Message send aborted")))
+ (if (not recheckp) (setq ispell-quit nil)))
+ (if (not recheckp) (set-marker ispell-region-end nil))
+ ;; Only save if successful exit.
+ (ispell-pdict-save ispell-silently-savep)
+ (message "Spell-checking %s using %s with %s dictionary...done"
+ region-type program-basename dictionary)))))
(defun ispell-begin-skip-region-regexp ()
;; Alignment cannot be tracked and this error will occur when
;; `query-replace' makes multiple corrections on the starting line.
(or (ispell-looking-at (car poss))
- ;; This occurs due to filter pipe problems
- (error (concat "Ispell misalignment: word "
- "`%s' point %d; probably incompatible versions")
- (car poss) (marker-position word-start)))
- ;; ispell-cmd-loop can go recursive & change buffer
- (if ispell-keep-choices-win
- (setq replace (ispell-command-loop
- (car (cdr (cdr poss)))
- (car (cdr (cdr (cdr poss))))
- (car poss) (marker-position word-start)
- (+ word-len (marker-position word-start))))
- (save-window-excursion
- (setq replace (ispell-command-loop
- (car (cdr (cdr poss)))
- (car (cdr (cdr (cdr poss))))
- (car poss) (marker-position word-start)
- (+ word-len (marker-position word-start))))))
-
- (goto-char word-start)
- ;; Recheck when query replace edit changes misspelled word.
- ;; Error in tex mode when a potential math mode change exists.
- (if (and replace (listp replace) (= 2 (length replace)))
- (if (and (eq ispell-parser 'tex)
- (string-match "[\\\\][]()[]\\|\\\\begin\\|\\$"
- (regexp-quote string)))
- (error
- "Don't start query replace on a line with math characters"
- )
- (set-marker line-end (point))
- (setq ispell-filter nil
- recheck-region t)))
-
- ;; insert correction if needed
- (cond
- ((or (null replace)
- (equal 0 replace)) ; ACCEPT/INSERT
- (if (equal 0 replace) ; BUFFER-LOCAL DICT ADD
- (ispell-add-per-file-word-list (car poss)))
- ;; do not recheck accepted word on this line
- (setq accept-list (cons (car poss) accept-list)))
- (t ; replacement word selected or entered
- (delete-region (point) (+ word-len (point)))
- (if (not (listp replace))
- (progn
- (insert replace) ; insert dictionary word
- (ispell-send-replacement (car poss) replace)
- (setq accept-list (cons replace accept-list)))
- (let ((replace-word (car replace)))
- ;; Recheck hand entered replacement word
- (insert replace-word)
- (ispell-send-replacement (car poss) replace-word)
- (if (car (cdr replace))
- (save-window-excursion
- (delete-other-windows) ; to correctly show help.
- ;; Assume case-replace &
- ;; case-fold-search correct?
- (query-replace (car poss) (car replace) t)))
- (goto-char word-start)
- ;; do not recheck if already accepted
- (if (member replace-word accept-list)
- (setq accept-list (cons replace-word accept-list)
- replace replace-word)
- (let ((region-end (copy-marker ispell-region-end)))
- (setq recheck-region ispell-filter
- ispell-filter nil ; save filter
- shift 0 ; already accounted
- shift (ispell-region
- word-start
- (+ word-start (length replace-word))
- t shift))
- (if (null shift) ; quitting check.
- (setq shift 0))
- (set-marker ispell-region-end region-end)
- (set-marker region-end nil)
- (setq ispell-filter recheck-region
- recheck-region nil
- replace replace-word)))))
-
- (setq shift (+ shift (- (length replace) word-len)))
-
- ;; Move line-start across word...
- ;; new shift function does this now...
- ;;(set-marker line-start (+ line-start
- ;; (- (length replace)
- ;; (length (car poss)))))
- ))
- (if (not ispell-quit)
+ ;; This error occurs due to filter pipe problems
+ (let* ((ispell-pipe-word (car poss))
+ (actual-point (marker-position word-start))
+ (actual-line (line-number-at-pos actual-point))
+ (actual-column (save-excursion (goto-char actual-point)
+ (current-column))))
+ (ispell-print-if-debug
+ "ispell-process-line: Ispell misalignment error:
+ [Word from ispell pipe]: [%s], actual (point,line,column): (%s,%s,%s)\n"
+ ispell-pipe-word actual-point actual-line actual-column)
+ (error (concat "Ispell misalignment: word "
+ "`%s' point %d; probably incompatible versions")
+ ispell-pipe-word actual-point)))
+ ;; ispell-cmd-loop can go recursive & change buffer
+ (if ispell-keep-choices-win
+ (setq replace (ispell-command-loop
+ (car (cdr (cdr poss)))
+ (car (cdr (cdr (cdr poss))))
+ (car poss) (marker-position word-start)
+ (+ word-len (marker-position word-start))))
+ (save-window-excursion
+ (setq replace (ispell-command-loop
+ (car (cdr (cdr poss)))
+ (car (cdr (cdr (cdr poss))))
+ (car poss) (marker-position word-start)
+ (+ word-len (marker-position word-start))))))
+
+ (goto-char word-start)
+ ;; Recheck when query replace edit changes misspelled word.
+ ;; Error in tex mode when a potential math mode change exists.
+ (if (and replace (listp replace) (= 2 (length replace)))
+ (if (and (eq ispell-parser 'tex)
+ (string-match "[\\\\][]()[]\\|\\\\begin\\|\\$"
+ (regexp-quote string)))
+ (error
+ "Don't start query replace on a line with math characters"
+ )
+ (set-marker line-end (point))
+ (setq ispell-filter nil
+ recheck-region t)))
+
+ ;; Insert correction if needed.
+ (cond
+ ((or (null replace)
+ (equal 0 replace)) ; ACCEPT/INSERT
+ (if (equal 0 replace) ; BUFFER-LOCAL DICT ADD
+ (ispell-add-per-file-word-list (car poss)))
+ ;; Do not recheck accepted word on this line.
+ (setq accept-list (cons (car poss) accept-list)))
+ (t ; Replacement word selected or entered.
+ (delete-region (point) (+ word-len (point)))
+ (if (not (listp replace))
+ (progn
+ (insert replace) ; Insert dictionary word.
+ (ispell-send-replacement (car poss) replace)
+ (setq accept-list (cons replace accept-list)))
+ (let ((replace-word (car replace)))
+ ;; Recheck hand entered replacement word.
+ (insert replace-word)
+ (ispell-send-replacement (car poss) replace-word)
+ (if (car (cdr replace))
+ (save-window-excursion
+ (delete-other-windows) ; to correctly show help.
+ ;; Assume case-replace &
+ ;; case-fold-search correct?
+ (query-replace (car poss) (car replace) t)))
+ (goto-char word-start)
+ ;; Do not recheck if already accepted.
+ (if (member replace-word accept-list)
+ (setq accept-list (cons replace-word accept-list)
+ replace replace-word)
+ (let ((region-end (copy-marker ispell-region-end)))
+ (setq recheck-region ispell-filter
+ ispell-filter nil ; Save filter.
+ shift 0 ; Already accounted.
+ shift (ispell-region
+ word-start
+ (+ word-start (length replace-word))
+ t shift))
+ (if (null shift) ; Quitting check.
+ (setq shift 0))
+ (set-marker ispell-region-end region-end)
+ (set-marker region-end nil)
+ (setq ispell-filter recheck-region
+ recheck-region nil
+ replace replace-word)))))
+
+ (setq shift (+ shift (- (length replace) word-len)))
+
+ ;; Move line-start across word...
+ ;; new shift function does this now...
+ ;;(set-marker line-start (+ line-start
+ ;; (- (length replace)
+ ;; (length (car poss)))))
+ ))
+ (if (not ispell-quit)
;; FIXME: remove redundancy with identical code above.
- (let (message-log-max)
- (message
+ (let (message-log-max)
+ (message
"Continuing spelling check using %s with %s dictionary..."
(file-name-nondirectory ispell-program-name)
(or ispell-current-dictionary "default"))))
- (sit-for 0)
- (setq ispell-start (marker-position line-start)
- ispell-end (marker-position line-end))
- ;; Adjust markers when end of region lost from highlighting.
- (if (and (not recheck-region)
+ (sit-for 0)
+ (setq ispell-start (marker-position line-start)
+ ispell-end (marker-position line-end))
+ ;; Adjust markers when end of region lost from highlighting.
+ (if (and (not recheck-region)
(< ispell-end (+ word-start word-len)))
- (setq ispell-end (+ word-start word-len)))
- (if (= word-start ispell-region-end)
- (set-marker ispell-region-end (+ word-start word-len)))
- ;; going out of scope - unneeded
- (set-marker line-start nil)
- (set-marker word-start nil)
- (set-marker line-end nil)))
- ;; finished with misspelling!
+ (setq ispell-end (+ word-start word-len)))
+ (if (= word-start ispell-region-end)
+ (set-marker ispell-region-end (+ word-start word-len)))
+ ;; Going out of scope - unneeded.
+ (set-marker line-start nil)
+ (set-marker word-start nil)
+ (set-marker line-end nil)))
+ ;; Finished with misspelling!
(setq ispell-filter (cdr ispell-filter)))
shift))
(interactive)
(ispell-region (point-min) (point-max)))
+;;;###autoload
+(defun ispell-buffer-with-debug (&optional append)
+ "`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer.
+Use APPEND to append the info to previous buffer if exists."
+ (interactive)
+ (let ((ispell-debug-buffer (ispell-create-debug-buffer append)))
+ (ispell-buffer)))
;;;###autoload
(defun ispell-continue ()
The `X' command aborts sending the message so that you can edit the buffer.
To spell-check whenever a message is sent, include the appropriate lines
-in your .emacs file:
+in your init file:
(add-hook 'message-send-hook 'ispell-message) ;; GNUS 5
(add-hook 'news-inews-hook 'ispell-message) ;; GNUS 4
(add-hook 'mail-send-hook 'ispell-message)
(cite-regexp ;Prefix of quoted text
(cond
((functionp 'sc-cite-regexp) ; sc 3.0
- (with-no-warnings
- (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
- (ispell-non-empty-string sc-reference-tag-string))))
+ (ispell-with-no-warnings
+ (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
+ (ispell-non-empty-string sc-reference-tag-string))))
((boundp 'sc-cite-regexp) ; sc 2.3
(concat "\\(" sc-cite-regexp "\\)" "\\|"
- (with-no-warnings
+ (ispell-with-no-warnings
(ispell-non-empty-string sc-reference-tag-string))))
((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below
(equal major-mode 'message-mode)) ;GNUS 5
(concat "In article <" "\\|"
"[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|"
- (with-no-warnings message-cite-prefix-regexp)
+ (ispell-with-no-warnings message-cite-prefix-regexp)
"\\|"
default-prefix))
((equal major-mode 'mh-letter-mode) ; mh mail message
(concat "[^,;&+=\n]+ writes:" "\\|"
- (with-no-warnings
+ (ispell-with-no-warnings
(ispell-non-empty-string mh-ins-buf-prefix))))
((not internal-messagep) ; Assume nn sent us this message.
(concat "In [a-zA-Z.]+ you write:" "\\|"
; LocalWords: alists minibuffer bufferp autoload loaddefs aff Dansk KOI SPC op
; LocalWords: Francais Nederlands charset autoloaded popup nonmenu regexp num
; LocalWords: AMStex hspace includeonly nocite epsfig displaymath eqnarray reg
-; LocalWords: minipage modeline pers dict unhighlight buf grep sync prev inc
+; LocalWords: minipage pers dict unhighlight buf grep sync prev inc
; LocalWords: fn oldot NB AIX msg init read's bufs pt cmd Quinlan eg
; LocalWords: uuencoded unidiff sc nn VM SGML eval IspellPersDict
; LocalWords: lns XEmacs HTML casechars Multibyte