-;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
+;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1995, 1997-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-2016 Free Software Foundation, Inc.
;; Author: Ken Stevens <k.stevens@ieee.org>
;; Maintainer: Ken Stevens <k.stevens@ieee.org>
;; your own dictionaries.
;; Depending on the mail system you use, you may want to include these:
-;; (add-hook 'news-inews-hook 'ispell-message)
-;; (add-hook 'mail-send-hook 'ispell-message)
-;; (add-hook 'mh-before-send-letter-hook 'ispell-message)
+;; (add-hook 'news-inews-hook #'ispell-message)
+;; (add-hook 'mail-send-hook #'ispell-message)
+;; (add-hook 'mh-before-send-letter-hook #'ispell-message)
;; Ispell has a TeX parser and a nroff parser (the default).
;; The parsing is controlled by the variable ispell-parser. Currently
;; Fixed bug in returning to nroff mode from tex mode.
;;; Compatibility code for XEmacs and (not too) older emacsen:
-
-(eval-and-compile ;; Protect against declare-function undefined in XEmacs
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
-(declare-function ispell-check-minver "ispell" (v1 v2))
-(declare-function ispell-looking-back "ispell"
- (regexp &optional limit &rest ignored))
-
-(if (fboundp 'version<=)
- (defalias 'ispell-check-minver 'version<=)
- (defun ispell-check-minver (minver version)
- "Check if string VERSION is at least string MINVER.
+(defalias 'ispell-check-minver
+ (if (fboundp 'version<=) 'version<=
+ (lambda (minver version)
+ "Check if string VERSION is at least string MINVER.
Both must be in [0-9]+.[0-9]+... format. This is a fallback
compatibility function in case `version<=' is not available."
- (let ((pending t)
- (return t)
- start-ver start-mver)
- ;; Loop until an absolute greater or smaller condition is reached
- ;; or until no elements are left in any of version and minver. In
- ;; this case version is exactly the minimal, so return OK.
- (while pending
- (let (ver mver)
- (if (string-match "[0-9]+" version start-ver)
- (setq start-ver (match-end 0)
- ver (string-to-number (match-string 0 version))))
- (if (string-match "[0-9]+" minver start-mver)
- (setq start-mver (match-end 0)
- mver (string-to-number (match-string 0 minver))))
-
- (if (or ver mver)
- (progn
- (or ver (setq ver 0))
- (or mver (setq mver 0))
- ;; If none of below conditions match, this element is the
- ;; same. Go checking next element.
- (if (> ver mver)
- (setq pending nil)
- (if (< ver mver)
- (setq pending nil
- return nil))))
- (setq pending nil))))
- return)))
+ (let ((pending t)
+ (return t)
+ start-ver start-mver)
+ ;; Loop until an absolute greater or smaller condition is reached
+ ;; or until no elements are left in any of version and minver. In
+ ;; this case version is exactly the minimal, so return OK.
+ (while pending
+ (let (ver mver)
+ (if (string-match "[0-9]+" version start-ver)
+ (setq start-ver (match-end 0)
+ ver (string-to-number (match-string 0 version))))
+ (if (string-match "[0-9]+" minver start-mver)
+ (setq start-mver (match-end 0)
+ mver (string-to-number (match-string 0 minver))))
+
+ (if (or ver mver)
+ (progn
+ (or ver (setq ver 0))
+ (or mver (setq mver 0))
+ ;; If none of below conditions match, this element is the
+ ;; same. Go checking next element.
+ (if (> ver mver)
+ (setq pending nil)
+ (if (< ver mver)
+ (setq pending nil
+ return nil))))
+ (setq pending nil))))
+ return))))
;; XEmacs does not have looking-back
-(if (fboundp 'looking-back)
- (defalias 'ispell-looking-back 'looking-back)
- (defun ispell-looking-back (regexp &optional limit &rest ignored)
- "Return non-nil if text before point matches regular expression REGEXP.
+(defalias 'ispell-looking-back
+ (if (fboundp 'looking-back) 'looking-back
+ (lambda (regexp &optional limit &rest ignored)
+ "Return non-nil if text before point matches regular expression REGEXP.
Like `looking-at' except matches before point, and is slower.
LIMIT if non-nil speeds up the search by specifying a minimum
starting position, to avoid checking matches that would start
This is a stripped down compatibility function for use when
full featured `looking-back' function is missing."
- (save-excursion
- (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
+ (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)
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defvar mail-yank-prefix)
(defgroup ispell nil
(defcustom ispell-grep-command
- ;; MS-Windows/MS-DOS have `egrep' as a Unix shell script, so they
- ;; cannot invoke it. Use "grep -E" instead (see ispell-grep-options
- ;; below).
- (if (memq system-type '(windows-nt ms-dos)) "grep" "egrep")
+ "grep"
"Name of the grep command for search processes."
:type 'string
:group 'ispell)
(defcustom ispell-grep-options
- (if (memq system-type '(windows-nt ms-dos)) "-Ei" "-i")
+ "-Ei"
"String of options to use when running the program in `ispell-grep-command'.
-Should probably be \"-i\" or \"-e\".
-Some machines (like the NeXT) don't support \"-i\"."
+Should probably be \"-Ei\"."
:type 'string
:group 'ispell)
(setq default-directory (expand-file-name "~/")))
(apply 'call-process-region args)))
+(defvar ispell-debug-buffer)
+
(defun ispell-create-debug-buffer (&optional append)
"Create an ispell debug buffer for debugging output.
If APPEND is non-nil, append the info to previous buffer if exists,
(defvar ispell-async-processp (and (fboundp 'delete-process)
(fboundp 'process-send-string)
(fboundp 'accept-process-output)
- ;;(fboundp 'start-process)
+ ;;(fboundp 'make-process)
;;(fboundp 'set-process-filter)
;;(fboundp 'process-kill-without-query)
)
(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))))))
+ (cl-pushnew tmp-dict use-for-dicts :test #'equal))))))
(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)))
+ (cl-pushnew (if (member (car entry) use-for-dicts)
+ (cons (car entry) dict-args-cdr)
+ entry)
+ newlist :test #'equal))
(setq ispell-dictionary-alist newlist))))
(defun ispell-parse-hunspell-affix-file (dict-key)
(chars-list (append otherchars-string nil)))
(setq chars-list (delq ?\ chars-list))
(dolist (ch chars-list)
- (add-to-list 'otherchars-list ch)))))
+ (cl-pushnew ch otherchars-list :test #'equal)))))
;; Cons the argument for the -d switch.
(setq dict-arg (concat dict-arg
(if (> (length dict-arg) 0) ",")
"[[:alpha:]]"
"[^[:alpha:]]"
(if otherchars-list
- (regexp-opt (mapcar 'char-to-string otherchars-list))
+ (regexp-opt (mapcar #'char-to-string otherchars-list))
"")
t ; many-otherchars-p: We can't tell, set to t.
(list "-d" dict-arg)
(or (assoc first-dict ispell-local-dictionary-alist)
(assoc first-dict ispell-dictionary-alist)
(error "Unknown dictionary: %s" first-dict)))
- (add-to-list 'ispell-dictionary-alist (list dict '()))
+ (cl-pushnew (list dict '()) ispell-dictionary-alist :test #'equal)
(ispell-hunspell-fill-dictionary-entry dict))
(defun ispell-find-hunspell-dictionaries ()
(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)))
+ (cl-pushnew (list basename affix-file)
+ ispell-hunspell-dict-paths-alist :test #'equal))
(ispell-print-if-debug
"-- ispell-fhd: Skipping entry: %s\n" dict)))))
;; Remove entry from aliases alist if explicit dict was found.
(ispell-print-if-debug
"-- ispell-fhd: Excluding %s alias. Standalone dict found.\n"
(car dict))
- (add-to-list 'newlist dict)))
+ (cl-pushnew dict newlist :test #'equal)))
(setq ispell-dicts-name2locale-equivs-alist newlist))
;; Add known hunspell aliases
(dolist (dict-equiv ispell-dicts-name2locale-equivs-alist)
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))))))
+ (cl-pushnew (list dict-equiv-key affix-file)
+ ispell-hunspell-dict-paths-alist :test #'equal)))))
;; 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))))))
+ (list (cons nil (cdr hunspell-default-dict-entry))))
+ (dolist (dict (mapcar #'car ispell-hunspell-dict-paths-alist))
+ (cl-pushnew (if (string= dict hunspell-default-dict)
+ hunspell-default-dict-entry
+ (list dict))
+ ispell-hunspell-dictionary-alist :test #'equal))))
;; Set params according to the selected spellchecker
(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
- ))))
+ (cl-pushnew (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
+ )
+ tmp-dicts-alist :test #'equal)))
(setq ispell-dictionary-base-alist tmp-dicts-alist))))
(run-hooks 'ispell-initialize-spellchecker-hook)
ispell-base-dicts-override-alist
ispell-dictionary-base-alist))
(unless (assoc (car dict) all-dicts-alist)
- (add-to-list 'all-dicts-alist dict)))
+ (push dict all-dicts-alist)))
(setq ispell-dictionary-alist all-dicts-alist))
;; If Emacs flavor supports [:alpha:] use it for global dicts. If
(if ispell-emacs-alpha-regexp
(let (tmp-dicts-alist)
(dolist (adict ispell-dictionary-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)))
+ (cl-pushnew (if (cadr adict) ;; Do not touch hunspell uninitialized entries
+ (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)))
+ adict)
+ tmp-dicts-alist :test #'equal))
(setq ispell-dictionary-alist tmp-dicts-alist)))))
(defun ispell-valid-dictionary-list ()
a `~' followed by an extended-character mode -- such as `~.tex'.
The last occurring definition in the buffer will be used.")
+(defun ispell--\\w-filter (char)
+ "Return CHAR in a string when CHAR doesn't have \"word\" syntax,
+nil otherwise. CHAR must be a character."
+ (let ((str (string char)))
+ (and
+ (not (string-match "\\w" str))
+ str)))
+
+(defun ispell--make-\\w-expression (chars)
+ "Make a regular expression like \"\\(\\w\\|[-_]\\)\".
+This (parenthesized) expression matches either a character of
+\"word\" syntax or one in CHARS.
+
+CHARS is a string of characters. A member of CHARS is omitted
+from the expression if it already has word syntax. (Be careful
+about special characters such as ?\\, ?^, ?], and ?- in CHARS.)
+If after this filtering there are no chars left, or only one, a
+special form of the expression is generated."
+ (let ((filtered
+ (mapconcat #'ispell--\\w-filter chars "")))
+ (concat
+ "\\(\\w"
+ (cond
+ ((equal filtered "")
+ "\\)")
+ ((eq (length filtered) 1)
+ (concat "\\|" filtered "\\)"))
+ (t
+ (concat "\\|[" filtered "]\\)"))))))
+
+(defun ispell--make-filename-or-URL-re ()
+ "Construct a regexp to match some file names or URLs or email addresses.
+The expression is crafted to match as great a variety of these
+objects as practicable, without too many false matches happening."
+ (concat ;"\\(--+\\|_+\\|"
+ "\\(/\\w\\|\\("
+ (ispell--make-\\w-expression "-_")
+ "+[.:@]\\)\\)"
+ (ispell--make-\\w-expression "-_")
+ "*\\([.:/@]+"
+ (ispell--make-\\w-expression "-_~=?&")
+ "+\\)+"
+ ;"\\)"
+ ))
+
;;;###autoload
(defvar ispell-skip-region-alist
`((ispell-words-keyword forward-line)
;; Matches e-mail addresses, file names, http addresses, etc. The
;; `-+' `_+' patterns are necessary for performance reasons when
;; `-' or `_' part of word syntax.
- (,(purecopy "\\(--+\\|_+\\|\\(/\\w\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)"))
+; (,(purecopy "\\(--+\\|_+\\|\\(/\\w\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)"))
;; above checks /.\w sequences
;;("\\(--+\\|\\(/\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)")
;; This is a pretty complex regexp. It can be simplified to the following:
("\\\\add\\(tocontents\\|vspace\\)" ispell-tex-arg-end)
("\\\\\\([aA]lph\\|arabic\\)" ispell-tex-arg-end)
;;("\\\\author" ispell-tex-arg-end)
+ ("\\\\cref" ispell-tex-arg-end)
("\\\\bibliographystyle" ispell-tex-arg-end)
("\\\\makebox" ispell-tex-arg-end 0)
("\\\\e?psfig" ispell-tex-arg-end)
(defun ispell-send-replacement (misspelled replacement)
"Notify Aspell that MISSPELLED should be spelled REPLACEMENT.
-This allows to improve the suggestion list based on actual misspellings."
+This allows improving the suggestion list based on actual misspellings."
(and ispell-really-aspell
(ispell-send-string (concat "$$ra " misspelled "," replacement "\n"))))
(run-hooks 'ispell-update-post-hook)
;; ensure word is visible
- (if (not (pos-visible-in-window-p end nil nil t))
+ (if (not (pos-visible-in-window-group-p end))
(sit-for 0))
;; Display choices for misspelled word.
nil)
((or (= char ?a) (= char ?A)) ; accept word without insert
(ispell-send-string (concat "@" word "\n"))
- (add-to-list 'ispell-buffer-session-localwords word)
+ (cl-pushnew word ispell-buffer-session-localwords
+ :test #'equal)
(and (fboundp 'flyspell-unhighlight-at)
(flyspell-unhighlight-at start))
(or ispell-buffer-local-name ; session localwords might conflict
(defun ispell-lookup-words (word &optional lookup-dict)
"Look up WORD in optional word-list dictionary LOOKUP-DICT.
A `*' serves as a wild card. If no wild cards, `look' is used if it exists.
-Otherwise the variable `ispell-grep-command' contains the command used to
-search for the words (usually egrep).
+Otherwise the variable `ispell-grep-command' contains the command
+\(usually \"grep\") used to search for the words.
Optional second argument contains the dictionary to use; the default is
`ispell-alternate-dictionary', overridden by `ispell-complete-word-dict'
;; This is the case when a process dies or fails. The default behavior
;; in this case treats the next input received as fresh input.
-(defun ispell-filter (process output)
+(defun ispell-filter (_process output)
"Output filter function for ispell, grep, and look."
(let ((start 0)
(continue t)
(regexp-quote (buffer-substring-no-properties start end))
"\\b"))
(isearch-regexp t)
+ (isearch-regexp-function nil)
(isearch-case-fold-search nil)
(isearch-forward t)
(isearch-other-end start)
(ispell-send-string "\032\n") ; so Ispell prints version and exits
t)))
-
(defun ispell-init-process ()
"Check status of Ispell process and start if necessary."
(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)
+ (current-ispell-directory default-directory) ;FIXME: Unused?
;; 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
;; Otherwise we get cool errors like "Can't open ".
(sleep-for 1)
(ispell-accept-output 3)
- (error "%s" (mapconcat 'identity ispell-filter "\n"))))
+ (error "%s" (mapconcat #'identity ispell-filter "\n"))))
(setq ispell-filter nil) ; Discard version ID line
(let ((extended-char-mode (ispell-get-extended-character-mode)))
(if extended-char-mode ; ~ extended character mode
(list (completing-read
"Use new dictionary (RET for current, SPC to complete): "
(and (fboundp 'ispell-valid-dictionary-list)
- (mapcar 'list (ispell-valid-dictionary-list)))
+ (mapcar #'list (ispell-valid-dictionary-list)))
nil t)
current-prefix-arg))
(ispell-set-spellchecker-params) ; Initialize variables and dicts alists
Includes `ispell-skip-region-alist' plus tex, tib, html, and comment keys.
Must be called after `ispell-buffer-local-parsing' due to dependence on mode."
(mapconcat
- 'identity
+ #'identity
(delq nil
(list
;; messages
(if (string= "" comment-end) "^" (regexp-quote comment-end)))
(if (and (null ispell-check-comments) comment-start)
(regexp-quote comment-start))
- (ispell-begin-skip-region ispell-skip-region-alist)))
+ (ispell-begin-skip-region ispell-skip-region-alist)
+ (ispell--make-filename-or-URL-re)))
"\\|"))
The list is of the form described by variable `ispell-skip-region-alist'.
Must be called after `ispell-buffer-local-parsing' due to dependence on mode."
(let ((skip-alist ispell-skip-region-alist))
+ (setq skip-alist (append (list (list (ispell--make-filename-or-URL-re)))
+ skip-alist))
;; only additional explicit region definition is tex.
(if (eq ispell-parser 'tex)
(setq case-fold-search nil
(setq case-fold-search nil) ; Try and respect case of word.
(cond
((string-equal (upcase word) word)
- (setq possibilities (mapcar 'upcase possibilities)))
+ (setq possibilities (mapcar #'upcase possibilities)))
((eq (upcase (aref word 0)) (aref word 0))
(setq possibilities (mapcar (function
(lambda (pos)
To spell-check whenever a message is sent, include the appropriate lines
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)
- (add-hook \\='mh-before-send-letter-hook \\='ispell-message)
+ (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)
+ (add-hook \\='mh-before-send-letter-hook #\\='ispell-message)
You can bind this to the key C-c i in GNUS or mail by adding to
`news-reply-mode-hook' or `mail-mode-hook' the following lambda expression:
(ispell-non-empty-string vm-included-text-prefix)))
(t default-prefix)))
(ispell-skip-region-alist
- (cons (list (concat "^\\(" cite-regexp "\\)")
- (function forward-line))
- ispell-skip-region-alist))
+ (cons (list (ispell--make-filename-or-URL-re))
+ (cons (list (concat "^\\(" cite-regexp "\\)")
+ (function forward-line))
+ ispell-skip-region-alist)))
(old-case-fold-search case-fold-search)
(dictionary-alist ispell-message-dictionary-alist)
(ispell-checking-message t))
(insert comment-end)))))
(insert (concat " " word))))))))
+;;FIXME: Use `user-error' instead!
(add-to-list 'debug-ignored-errors "^No word found to check!$")
(provide 'ispell)