Skip to content

Instantly share code, notes, and snippets.

@lawlist

lawlist/nsspellchecker.diff

Last active May 30, 2016 16:45
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save lawlist/6a9b281870fcc114ad3c6c1dca121f95 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save lawlist/6a9b281870fcc114ad3c6c1dca121f95 to your computer and use it in GitHub Desktop.
Download ZIP
nsspellchecker -- extracted code from Aquamacs and created unofficial draft patch for generic/vanilla build of Emacs master branch as of commit (05/29/2016) 76fb19b359dec8556dc66dbac3ad3d333feea3c3.
Raw
nsspellchecker.diff
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index 937e47f..165263a 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -73,6 +73,8 @@
(cons (logior (lsh 0 16) 12) 'ns-new-frame)
(cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar)
(cons (logior (lsh 0 16) 14) 'ns-show-prefs)
+ (cons (logior (lsh 0 16) 20) 'ns-check-spelling)
+ (cons (logior (lsh 0 16) 21) 'ns-spelling-change)
))))
(set-terminal-parameter frame 'x-setup-function-keys t)))
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 5080ed0..c0cbfdb 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -164,6 +164,8 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [ns-open-file] 'ns-find-file)
(define-key global-map [ns-open-temp-file] [ns-open-file])
(define-key global-map [ns-change-font] 'ns-respond-to-change-font)
+(define-key global-map [ns-check-spelling] 'ns-respond-to-find-next-misspelling)
+(define-key global-map [ns-spelling-change] 'ns-respond-to-change-spelling)
(define-key global-map [ns-open-file-line] 'ns-open-file-select-line)
(define-key global-map [ns-spi-service-call] 'ns-spi-service-call)
(define-key global-map [ns-new-frame] 'make-frame)
@@ -660,6 +662,31 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(defvar ns-reg-to-script) ; nsfont.m
+(autoload 'ns-toggle-spellchecker-panel "flyspell"
+ "Show NSSpellChecker spellingPanel, and call
+ns-highlight-misspelling-and-suggest. If panel
+is already visible, close it." t)
+
+(autoload 'ns-highlight-misspelling-and-suggest "flyspell"
+ "Search forward in current buffer for first misspelling, looping if end
+is reached. If found, set region to the misspelling, apply face
+flyspell-incorrect, and show word in OS X spelling panel" nil)
+
+(defun ns-respond-to-change-spelling (start end)
+ "Respond to changeSpelling: event, expecting ns-spelling-text
+to substitute for selected buffer text."
+ (interactive "r")
+ (if mark-active
+ (delete-region start end))
+ (insert ns-spelling-text))
+
+(defun ns-respond-to-find-next-misspelling ()
+ "Respond to checkSpelling: event. Also called by Spellchecker
+panel immediately after correcting a word in a buffer."
+ (interactive)
+ (ns-highlight-misspelling-and-suggest)
+ )
+
;; This maps font registries (not exposed by NS APIs for font selection) to
;; Unicode scripts (which can be mapped to Unicode character ranges which are).
;; See ../international/fontset.el
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 042b7d4..2e6cebb 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -40,6 +40,7 @@
(require 'ispell)
(eval-when-compile (require 'cl-lib))
+(require 'thingatpt) ;; use (word-at-point) in ns-spellchecking functions
;;*---------------------------------------------------------------------*/
;;* Group ... */
@@ -88,34 +89,11 @@ downcased before comparing with these exceptions."
:version "24.1")
(defcustom flyspell-sort-corrections nil
- "If non-nil, sort the corrections before popping them.
-The sorting is controlled by the `flyspell-sort-corrections-function'
-variable, and defaults to sorting alphabetically."
+ "Non-nil means, sort the corrections alphabetically before popping them."
:group 'flyspell
:version "21.1"
:type 'boolean)
-(defcustom flyspell-sort-corrections-function
- 'flyspell-sort-corrections-alphabetically
- "The function used to sort corrections.
-This only happens if `flyspell-sort-corrections' is non-nil. The
-function takes three parameters -- the two correction candidates
-to be sorted, and the third parameter is the word that's being
-corrected."
- :version "25.2"
- :type 'function
- :group 'flyspell)
-
-(defun flyspell-sort-corrections-alphabetically (corr1 corr2 _)
- (string< corr1 corr2))
-
-(defun flyspell-sort (corrs word)
- (if flyspell-sort-corrections
- (sort corrs
- (lambda (c1 c2)
- (funcall flyspell-sort-corrections-function c1 c2 word)))
- corrs))
-
(defcustom flyspell-duplicate-distance 400000
"The maximum distance for finding duplicates of unrecognized words.
This applies to the feature that when a word is not found in the dictionary,
@@ -305,11 +283,452 @@ If this variable is nil, all regions are treated as small."
'flyspell-auto-correct-word))))
(defcustom flyspell-auto-correct-binding
- [(control ?\;)]
+ [(control ?\')]
"The key binding for flyspell auto correction."
:type 'key-sequence
:group 'flyspell)
+(defcustom flyspell-mode-auto-on t
+ "Non-nil means that executing `flyspell-region' or `flyspell-buffer'
+will automatically turn on `flyspell-mode' for that buffer."
+ :group 'flyspell
+ :type 'boolean)
+
+;; **********************************************************************
+;; functions that use NSSpellChecker as the spellchecking
+;; engine, instead of ispell or aspell
+
+(defun ns-spellcheck-and-flyspell-word (beg end)
+ "Use NSSpellChecker to locate misspelled words within range
+BEG to END in current buffer. Run flyspell-word on the misspelling,
+and repeat search if word is not considered a misspelling by flyspell.
+Returns buffer location of misspelled word if found, or nil. As a side
+effect, marks the misspelled word (if found) with face flyspell-incorrect."
+ (let ((pos beg)
+ misspell-location
+ misspell-end
+ done)
+ ;; update dictionary if needed
+ (unless (string= ispell-current-dictionary
+ (ns-spellchecker-current-language))
+ (ispell-change-dictionary (ns-spellchecker-current-language)))
+ ;; loop through until we find a misspelling or end of string
+ (while (not done)
+ (setq misspell-location
+ (ns-spellchecker-check-spelling (buffer-substring pos end)
+ (current-buffer)))
+ (if misspell-location
+ (save-excursion
+ (setq misspell-end
+ (+ pos (car misspell-location) (cdr misspell-location)))
+ (goto-char misspell-end)
+ (if (flyspell-word) ;; returns t if not misspelled
+ ;; ignore misspelling if flyspell-word says it's OK,
+ ;; but continue checking
+ (setq misspell-location nil)
+ ;; if flyspell-word concurs, we've found a misspelling & are done
+ (setq done t)
+ ))
+ ;; no misspellings in string; finish.
+ (setq done t))
+ (unless done
+ ;; check remainder of string
+ (setq pos misspell-end)))
+ ;; if a misspelling has been found, report is location (otherwise nil)
+ (when misspell-location
+ (cons (+ pos (car misspell-location)) misspell-end))
+ ))
+
+(defun ns-find-next-misspelling (&optional noskip)
+ "Move forward in buffer to next misspelling; set region to the word,
+and apply flyspell-incorrect face. If NOSKIP is non-nil, don't skip
+the current highlighted word (if any)."
+;; search forward for a spelling error according to NSSpellChecker
+;; do flyspell-word or equivalent to see if it is really misspelled
+;; (e.g. not TeX or other filtered expression)
+;; if it is, then also highlight it, and put it in the spelling panel
+ (interactive)
+ (unless (string= ispell-current-dictionary
+ (ns-spellchecker-current-language))
+ (ispell-change-dictionary (ns-spellchecker-current-language)))
+ (let* ((pos (if mark-active
+ ;; use beginning of region as start point for spellchecking,
+ ;; if there is an active region
+ (min (mark) (point))
+ (point)))
+ (beg (point-min))
+ (end (point-max))
+ ;; (chunk-begin pos)
+ misspell-location
+ ;; chunk-end
+ ;; approx-end
+ )
+ (save-excursion ;retain point & region if no misspelling found
+ (goto-char pos)
+ ;; this bit is needed to unhighlight the previous word, if it
+ ;; is ignored or learned in the spelling panel
+ (let ((word (word-at-point)))
+ (if (and word
+ (not (ns-spellchecker-check-spelling word (current-buffer))))
+ (flyspell-unhighlight-at (point))))
+ ;; If midway through a word, start at search at next word;
+ ;; but don't skip an entire word
+ (if (backward-word)
+ (forward-word))
+ ;; When a selection is active, always skip the first word or
+ ;; partial word (as TextEdit does), so we don't spellcheck
+ ;; the same word again
+ (if (and mark-active (not noskip)) (forward-word))
+ (flyspell-word)
+ (setq pos (point))
+ ;; if region from point to end is larger than 1.5x
+ ;; NS-SPELLCHECKER-CHUNK-SIZE chars, then check text in smaller chunks
+ ;; (if (< (- end pos) (* 1.5 ns-spellchecker-chunk-size))
+ ;; (setq chunk-end end)
+ ;; (setq chunk-end (+ pos ns-spellchecker-chunk-size))
+ ;; ;; try not to spellcheck across a sentence boundary, to keep
+ ;; ;; grammar checking happy; make sure we at least don't split words.
+ ;; (save-excursion
+ ;; (goto-char approx-end)
+ ;; (forward-sentence)
+ ;; (setq chunk-end (point))
+ ;; ;; If sentence boundary not found within 10% after
+ ;; ;; specified chunk size, look for first sentence
+ ;; ;; boundary up to 10% before desired chunk size.
+ ;; ;; If not found, use first word boundary after desired chunk size
+ ;; (if (> (abs (- chunk-end approx-end))
+ ;; (* 0.1 ns-spellchecker-chunk-size))
+ ;; (progn
+ ;; ;; find nearest previous sentence boundary
+ ;; (backward-sentence)
+ ;; (setq chunk-end (point))
+ ;; ;; check whether it's within 10% of specified value
+ ;; (if (> (abs (- approx-end chunk-end))
+ ;; (* 0.1 ns-spellchecker-chunk-size))
+ ;; (progn
+ ;; ;; if not, use next word boundary
+ ;; (goto-char approx-end)
+ ;; (forward-word)
+ ;; (setq chunk-end (point))))))))
+ ;; (while (and
+ ;; (eq (car misspelled-location) -1)
+ ;; (not overlap))
+ ;; (setq misspell-location
+ ;; (ns-spellchecker-check-spelling
+ ;; (buffer-substring chunk-begin chunk-end)))
+ ;; ;; )
+ ;; (setq misspell-location
+ ;; (ns-spellchecker-check-spelling (buffer-substring pos end)))
+ ;; (if (= (car misspell-location) -1)
+ ;; nil
+ ;; (setq misspell-beg
+ ;; (+ pos (car misspell-location))
+ ;; misspell-end
+ ;; (+ pos (car misspell-location) (cdr misspell-location)))
+ ;; (goto-char misspell-end)
+ ;; (setq misspell-found-p (not (flyspell-word))))
+ ;; (unless misspell-found-p
+ ;; (setq misspell-location
+ ;; (ns-spellchecker-check-spelling (buffer-substring beg pos)))
+ ;; (if (= (car misspell-location) -1)
+ ;; nil
+ ;; (setq misspell-beg
+ ;; (+ beg (car misspell-location))
+ ;; misspell-end
+ ;; (+ beg (car misspell-location) (cdr misspell-location)))
+ ;; (goto-char misspell-end)
+ ;; (setq misspell-found-p (not (flyspell-word)))))
+ ;; (if misspell-found-p
+ ;; return start and end of the misspelled word, or nil if none found
+ ;; (cons misspell-beg misspell-end))
+ (setq misspell-location
+ (ns-spellcheck-and-flyspell-word pos end))
+ (if (not misspell-location)
+ (setq misspell-location (ns-spellcheck-and-flyspell-word beg pos)))
+ ;; returns nil if we haven't found a misspelling
+ misspell-location
+ )))
+
+(defun ns-highlight-misspelling-and-suggest (&optional noskip)
+ "Search forward in current buffer for first misspelling, looping if end
+is reached. If found, set region to the misspelling, apply face
+flyspell-incorrect, and show word in OS X spelling panel. If
+NOSKIP is non-nil, don't skip the current highlighted word (if any)."
+ (interactive)
+ (let* ((misspell-region (ns-find-next-misspelling noskip))
+ (misspell-beg (car misspell-region))
+ (misspell-end (cdr misspell-region))
+ word)
+ (if (not misspell-region)
+ ;; no misspelling found; blank and beep the spelling panel
+ (progn
+ (ns-spellchecker-show-word "")
+ (message "Spell checker: found no errors"))
+ ;; misspelling found; set region to mispelled word, and show
+ ;; in spelling panel
+ (goto-char misspell-end)
+ (push-mark misspell-beg 'no-msg 'activate)
+ (setq word (buffer-substring misspell-beg misspell-end))
+ (ns-spellchecker-show-word word)))
+ (if (and flyspell-mode-auto-on (not flyspell-mode))
+ (turn-on-flyspell)))
+
+(defun ns-start-spellchecker ()
+ "Show NSSpellChecker spellingPanel, and call
+ns-highlight-misspelling-and-suggest, which see."
+ (interactive)
+ (ns-popup-spellchecker-panel)
+ (ns-highlight-misspelling-and-suggest))
+
+(defun ns-toggle-spellchecker-panel ()
+ "Show NSSpellChecker spellingPanel, and call
+ns-highlight-misspelling-and-suggest. If panel
+is already visible, close it instead."
+ (interactive)
+ (if (ns-spellchecker-panel-visible-p)
+ (ns-close-spellchecker-panel)
+ (ns-popup-spellchecker-panel)
+ ;; panel shouldn't skip past currently selected word, if there is one
+ (ns-highlight-misspelling-and-suggest 'noskip)))
+
+;;;###autoload
+(defun spellcheck-now ()
+ "Start spellchecking, using OS X spellchecker
+(`ns-highlight-misspelling-and-suggest') or `ispell-buffer' (which see),
+depending on value of `ispell-program-name'."
+ (interactive)
+ (if (string= ispell-program-name "NSSpellChecker")
+ (ns-highlight-misspelling-and-suggest)
+ (ispell-buffer)))
+
+;;;###autoload
+(defun spellchecker-panel-or-ispell ()
+ "Calls `ns-toggle-spellchecker-panel' or `ispell' (which see), depending
+on current value of `ispell-program-name'."
+ (interactive)
+ (if (string= ispell-program-name "NSSpellChecker")
+ (ns-toggle-spellchecker-panel)
+ (ispell)))
+
+(defun ns-flyspell-region (beg end)
+ "Flyspell text between BEG and END using ns-spellchecker-check-spelling."
+ (interactive "r")
+ (unless (string= ispell-current-dictionary
+ (ns-spellchecker-current-language))
+ (ispell-change-dictionary (ns-spellchecker-current-language)))
+ (save-excursion
+ (let ((spellcheck-position beg)
+ (count 0)
+ ;; if called by ns-flyspell-large-region, then report progress
+ ;; relative to "large region" extents instead of simply extents of
+ ;; the current sub-region
+ (progress-beg
+ (if (boundp 'ns-flyspell-large-region-beg)
+ ns-flyspell-large-region-beg
+ beg))
+ (progress-end
+ (if (boundp 'ns-flyspell-large-region-end)
+ ns-flyspell-large-region-end
+ end))
+ spellcheck-text
+ ns-spellcheck-output
+ misspelled-location
+ misspelled-length)
+ ;; remove any existing flyspell overlays before checking
+ (flyspell-delete-region-overlays beg end)
+ (while (< spellcheck-position end)
+ ;; report progress
+ (if flyspell-issue-message-flag
+ (message "Spell Checking...%d%% [%s]"
+ (* 100 (/ (float (- spellcheck-position progress-beg))
+ (- progress-end progress-beg)))
+ (word-at-point)))
+ ;; extract text from last checked word to end
+ (setq spellcheck-text (buffer-substring spellcheck-position end))
+ ;; find (position . length) of first misspelled word in extracted text
+ (setq ns-spellcheck-output
+ ;; returns nil if no misspellings found
+ (ns-spellchecker-check-spelling spellcheck-text (current-buffer)))
+ (if ns-spellcheck-output
+ ;; found misspelled word
+ (progn
+ (setq misspelled-location
+ (+ (car ns-spellcheck-output) spellcheck-position))
+ (setq misspelled-length (cdr ns-spellcheck-output))
+ ;; start next check after current found word
+ (setq spellcheck-position
+ (+ misspelled-location misspelled-length))
+ ;; use flyspell-word to filter and mark misspellings
+ (goto-char spellcheck-position)
+ (flyspell-word))
+ ;; no misspellings found; we've reached the end of chunk
+ (setq spellcheck-position end))
+ )
+ (if (and (not (boundp 'ns-flyspell-large-region-end))
+ flyspell-issue-message-flag)
+ (message "Spell Checking completed."))
+ ;; function returns end of this chunk
+ end)))
+
+(defun ns-flyspell-large-region (beg end)
+ "Flyspell text between BEG and END using ns-spellchecker-check-spelling.
+Break long text into chunks of approximate size NS-SPELLCHECKER-CHUNK-SIZE,
+dividing at sentence boundaries where possible, or at word boundaries if
+sentence boundaries are too far between."
+ (interactive "r")
+ (save-excursion
+ (let ((inhibit-redisplay t)
+ (chunk-beg beg)
+ (ns-flyspell-large-region-beg beg)
+ (ns-flyspell-large-region-end end)
+ chunk-end
+ approx-end)
+ (while
+ (<
+ (progn
+ ;; if length from chunk start to overall end is less
+ ;; than 1.5x chunk size, set chunk end to overall end
+ (if (< (- end chunk-beg) (* 1.5 ns-spellchecker-chunk-size))
+ (setq chunk-end end)
+ ;; otherwise, set end to sentence boundary near desired chunk size
+ (save-excursion
+ (setq approx-end (+ chunk-beg ns-spellchecker-chunk-size))
+ (goto-char approx-end)
+ (forward-sentence)
+ (setq chunk-end (point))
+ ;; If sentence boundary not found within 10% after
+ ;; specified chunk size, look for first sentence
+ ;; boundary up to 10% before desired chunk size.
+ ;; If not found, use first word boundary after desired chunk size
+ (if (> (- chunk-end approx-end)
+ (* 0.1 ns-spellchecker-chunk-size))
+ (progn
+ ;; find nearest previous sentence boundary
+ (backward-sentence)
+ (setq chunk-end (point))
+ ;; check whether it's within 10% of specified value
+ (if (> (- approx-end chunk-end)
+ (* 0.1 ns-spellchecker-chunk-size))
+ (progn
+ ;; if not, use next word boundary
+ (goto-char approx-end)
+ (forward-word)
+ (setq chunk-end (point))))))))
+ ;; make sure we haven't extended the chunk beyond the region
+ (if (> chunk-end end)
+ (setq chunk-end end))
+ ;; check spelling of chunk, returning chunk end location
+ (ns-flyspell-region chunk-beg chunk-end))
+ end)
+ ;; if not done, start new chunk at previous chunk end
+ (setq chunk-beg chunk-end))
+ ;; when done, report completion
+ (if flyspell-issue-message-flag (message "Spell Checking completed."))
+ )))
+
+;; **********************************************************************
+;; global-flyspell-mode and automatic text-mode flyspelling
+
+(defun maybe-turn-on-flyspell ()
+ "Run `turn-on-flyspell' for current buffer, unless one of
+`global-flyspell-inhibit-functions' returns t"
+ (unless (run-hook-with-args-until-success
+ 'global-flyspell-inhibit-functions)
+ (turn-on-flyspell)))
+
+;; turn on flyspell-mode for all buffers, with exception of new fundamental-mode
+;; buffers and those returning t for any function listed in
+;; `global-flyspell-inhibit-functions'
+;;;###autoload
+(define-globalized-minor-mode global-flyspell-mode flyspell-mode
+ maybe-turn-on-flyspell)
+
+(defcustom global-flyspell-inhibit-functions
+ '(global-flyspell-default-inhibit-function)
+ "List of functions to be called before `global-flyspell-mode' activates
+flyspell in a buffer. Those functions are called one by one, with no
+arguments, until one of them returns a non-nil value, and thus, prevents
+activation of `flyspell-mode' (but only via `global-flyspell-mode')."
+ :group 'flyspell
+ :type 'hook)
+
+(defcustom global-flyspell-inhibit-buffer-names
+ nil
+ "List of buffer names in which `global-flyspell-mode' will not
+ activate `flyspell-mode'"
+ :group 'flyspell
+ :type '(repeat (string)))
+
+(defun global-flyspell-default-inhibit-function ()
+ "Return non-nil if current buffer: has a major mode with a
+property named mode-class with value special; has a name starting
+with a space and is not visiting a file; is designated by its
+name as a buffer to be displayed specially; or is listed by name
+in `global-flyspell-inhibit-buffer-names'. This is used to
+indicate that the buffer should not have `flyspell-mode' turned on
+by `global-flyspell-mode'."
+ (or
+ ;; buffers whose major-mode is marked as "special"
+ (eq (get major-mode 'mode-class) 'special)
+ ;; buffers whose name starts with space, if not visiting a file
+ (and (char-equal ?\ (aref (buffer-name) 0))
+ (not (buffer-file-name)))
+ ;; buffers designated for special display (e.g. dedicated frame)
+ (special-display-p (buffer-name))
+ ;; buffer with name listed in global-flyspell-inhibit-buffer-names
+ (member (buffer-name) global-flyspell-inhibit-buffer-names)
+ ))
+
+;;;###autoload
+(defun flyspell-text-modes ()
+ "Use Flyspell in Text mode and related modes.
+Applies to all buffers that use modes related to Text mode,
+both existing buffers and buffers that you subsequently create.
+Turns off `flyspell-all-modes' if on."
+ (interactive)
+ (if global-flyspell-mode
+ (global-flyspell-mode -1))
+ (add-hook 'text-mode-hook 'turn-on-flyspell)
+ (customize-mark-as-set 'text-mode-hook)
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (let ((textual (or (derived-mode-p 'text-mode) text-mode-variant)))
+ (if textual
+ (turn-on-flyspell)
+ (if flyspell-mode (turn-off-flyspell))))))
+ (message "Flyspell activated in Text modes"))
+
+;;;###autoload
+(defun flyspell-all-modes ()
+ "Use Flyspell in all major modes.
+Applies both to existing buffers and buffers that you subsequently
+create. Turns off `flyspell-text-modes' if on."
+ (interactive)
+ (let ((disable-for-text (memq 'turn-on-flyspell
+ text-mode-hook)))
+ (if disable-for-text
+ (progn
+ (remove-hook 'text-mode-hook 'turn-on-flyspell)
+ (customize-mark-as-set 'text-mode-hook)))
+ (global-flyspell-mode 1)
+ (message "Flyspell activated in all modes")))
+
+;;;###autoload
+(defun flyspell-no-modes ()
+ "Turn off `flyspell-text-modes' or `flyspell-all-modes' if on.
+Also turns off flyspell-mode in all existing buffers."
+ (interactive)
+ (let ((disable-for-text (memq 'turn-on-flyspell
+ text-mode-hook)))
+ (if disable-for-text
+ (progn
+ (remove-hook 'text-mode-hook 'turn-on-flyspell)
+ (customize-mark-as-set 'text-mode-hook)))
+ ;; this turns off flyspell everywhere, whether or not the global mode was
+ ;; previously on:
+ (global-flyspell-mode -1)
+ (message "Flyspell deactivated in all modes")))
+
;;*---------------------------------------------------------------------*/
;;* Mode specific options */
;;* ------------------------------------------------------------- */
@@ -602,7 +1021,8 @@ in your init file.
(defun flyspell-hack-local-variables-hook ()
;; When local variables are loaded, see if the dictionary context
;; has changed.
- (flyspell-accept-buffer-local-defs 'force))
+ ;; (flyspell-accept-buffer-local-defs 'force)
+ )
(defun flyspell-kill-ispell-hook ()
(setq flyspell-last-buffer nil)
@@ -1030,7 +1450,9 @@ Mostly we check word delimiters."
(defun flyspell-notify-misspell (word poss)
(let ((replacements (if (stringp poss)
poss
- (flyspell-sort (car (cdr (cdr poss))) word))))
+ (if flyspell-sort-corrections
+ (sort (car (cdr (cdr poss))) 'string<)
+ (car (cdr (cdr poss)))))))
(if flyspell-issue-message-flag
(message "misspelling `%s' %S" word replacements))))
@@ -1172,6 +1594,8 @@ misspelling and skips redundant spell-checking step."
(setq flyspell-word-cache-end end)
(setq flyspell-word-cache-word word)
;; now check spelling of word.
+ (if (string= ispell-program-name "NSSpellChecker")
+ (setq poss (ns-spellchecker-parse-output word))
(if (not known-misspelling)
(progn
(ispell-send-string "%\n")
@@ -1198,7 +1622,7 @@ misspelling and skips redundant spell-checking step."
(setq poss (ispell-parse-output (car ispell-filter)))))
;; Else, this was a known misspelling to begin with, and
;; we should forge an ispell return value.
- (setq poss (list word 1 nil nil)))
+ (setq poss (list word 1 nil nil))))
(let ((res (cond ((eq poss t)
;; correct
(setq flyspell-word-cache-result t)
@@ -1555,7 +1979,12 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
;;*---------------------------------------------------------------------*/
(defun flyspell-large-region (beg end)
(let* ((curbuf (current-buffer))
- (buffer (get-buffer-create "*flyspell-region*")))
+ (buffer (get-buffer-create "*flyspell-region*"))
+ (current-dict-name (or ispell-local-dictionary ispell-dictionary-internal))
+ (current-dict
+ (if (eq ispell-use-cocoaspell-internal 'full)
+ (aspell-dict-abbrev current-dict-name)
+ current-dict-name)))
(setq flyspell-external-ispell-buffer buffer)
(setq flyspell-large-region-buffer curbuf)
(setq flyspell-large-region-beg beg)
@@ -1568,8 +1997,7 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
(set-buffer curbuf)
(ispell-set-spellchecker-params) ; Initialize variables and dicts alists
;; Local dictionary becomes the global dictionary in use.
- (setq ispell-current-dictionary
- (or ispell-local-dictionary ispell-dictionary))
+ (setq ispell-current-dictionary current-dict-name)
(setq ispell-current-personal-dictionary
(or ispell-local-pdict ispell-personal-dictionary))
(let ((args (ispell-get-ispell-args))
@@ -1578,7 +2006,7 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
(if (and ispell-current-dictionary ; use specified dictionary
(not (member "-d" args))) ; only define if not overridden
(setq args
- (append (list "-d" ispell-current-dictionary) args)))
+ (append (list "-d" current-dict) args)))
(if ispell-current-personal-dictionary ; use specified pers dict
(setq args
(append args
@@ -1646,9 +2074,21 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
(let ((old beg))
(setq beg end)
(setq end old)))
+ (if (string= ispell-program-name "NSSpellChecker")
+ (progn
+ (if (> (- end beg) (* ns-spellchecker-chunk-size 1.5))
+ ;; large; spellcheck in chunks.
+ (ns-flyspell-large-region beg end)
+ ;; not so large; spellcheck all at once.
+ (ns-flyspell-region beg end))
+ ;; check for and mark consecutive repeated words
+ (flyspell-check-region-doublons beg end))
(if (and flyspell-large-region (> (- end beg) flyspell-large-region))
(flyspell-large-region beg end)
- (flyspell-small-region beg end)))))
+ (flyspell-small-region beg end))))
+ (if (and flyspell-mode-auto-on (not flyspell-mode))
+ (turn-on-flyspell))
+ ))
;;*---------------------------------------------------------------------*/
;;* flyspell-buffer ... */
@@ -1772,10 +2212,10 @@ FACE and MOUSE-FACE specify the `face' and `mouse-face' properties
for the overlay."
(let ((overlay (make-overlay beg end nil t nil)))
(overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face mouse-face)
+ ;; (overlay-put overlay 'mouse-face mouse-face)
(overlay-put overlay 'flyspell-overlay t)
(overlay-put overlay 'evaporate t)
- (overlay-put overlay 'help-echo "mouse-2: correct word at point")
+ ;; (overlay-put overlay 'help-echo "mouse-2: correct word at point")
(overlay-put overlay 'keymap flyspell-mouse-map)
(when (eq face 'flyspell-incorrect)
(and (stringp flyspell-before-incorrect-word-string)
@@ -1976,8 +2416,10 @@ This command proposes various successive corrections for the current word."
(word (car word))
poss ispell-filter)
(setq flyspell-auto-correct-word word)
- ;; Now check spelling of word..
- (ispell-send-string "%\n") ;Put in verbose mode.
+ ;; now check spelling of word.
+ (if (string= ispell-program-name "NSSpellChecker")
+ (setq poss (ns-spellchecker-parse-output word))
+ (ispell-send-string "%\n") ;put in verbose mode
(ispell-send-string (concat "^" word "\n"))
;; Wait until ispell has processed word.
(while (progn
@@ -1990,7 +2432,7 @@ This command proposes various successive corrections for the current word."
(or ispell-filter
(setq ispell-filter '(*)))
(if (consp ispell-filter)
- (setq poss (ispell-parse-output (car ispell-filter))))
+ (setq poss (ispell-parse-output (car ispell-filter)))))
(cond
((or (eq poss t) (stringp poss))
;; Don't correct word.
@@ -2000,8 +2442,9 @@ This command proposes various successive corrections for the current word."
(error "Ispell: error in Ispell process"))
(t
;; The word is incorrect, we have to propose a replacement.
- (let ((replacements (flyspell-sort (car (cdr (cdr poss)))
- word)))
+ (let ((replacements (if flyspell-sort-corrections
+ (sort (car (cdr (cdr poss))) 'string<)
+ (car (cdr (cdr poss))))))
(setq flyspell-auto-correct-region nil)
(if (consp replacements)
(progn
@@ -2135,6 +2578,8 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
(word (car word))
poss ispell-filter)
;; now check spelling of word.
+ (if (string= ispell-program-name "NSSpellChecker")
+ (setq poss (ns-spellchecker-parse-output word))
(ispell-send-string "%\n") ;put in verbose mode
(ispell-send-string (concat "^" word "\n"))
;; wait until ispell has processed word
@@ -2148,7 +2593,7 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
(or ispell-filter
(setq ispell-filter '(*)))
(if (consp ispell-filter)
- (setq poss (ispell-parse-output (car ispell-filter))))
+ (setq poss (ispell-parse-output (car ispell-filter)))))
(cond
((or (eq poss t) (stringp poss))
;; don't correct word
@@ -2161,8 +2606,10 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
poss word cursor-location start end opoint))
(t
;; The word is incorrect, we have to propose a replacement.
- (flyspell-do-correct (flyspell-emacs-popup event poss word)
- poss word cursor-location start end opoint)))
+ ;; restore point now, in case user selects a non-flyspell option.
+ (goto-char opoint)
+ (flyspell-emacs-popup
+ event poss word cursor-location start end opoint)))
(ispell-pdict-save t)))))
;;*---------------------------------------------------------------------*/
@@ -2177,14 +2624,19 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
nil)
((eq replace 'save)
(goto-char save)
+ (if (string= ispell-program-name "NSSpellChecker")
+ (ns-spellchecker-learn-word word)
(ispell-send-string (concat "*" word "\n"))
;; This was added only to the XEmacs side in revision 1.18 of
;; flyspell. I assume its absence on the Emacs side was an
;; oversight. --Stef
(ispell-send-string "#\n")
+ (setq ispell-pdict-modified-p '(t)))
(flyspell-unhighlight-at cursor-location)
- (setq ispell-pdict-modified-p '(t)))
+ )
((or (eq replace 'buffer) (eq replace 'session))
+ (if (string= ispell-program-name "NSSpellChecker")
+ (ns-spellchecker-ignore-word word (current-buffer))
(ispell-send-string (concat "@" word "\n"))
(add-to-list 'ispell-buffer-session-localwords word)
(or ispell-buffer-local-name ; session localwords might conflict
@@ -2193,9 +2645,11 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
(if (null ispell-pdict-modified-p)
(setq ispell-pdict-modified-p
(list ispell-pdict-modified-p)))
- (goto-char save)
+ (goto-char save))
(if (eq replace 'buffer)
- (ispell-add-per-file-word-list word)))
+ (ispell-add-per-file-word-list word))
+ (flyspell-unhighlight-at cursor-location)
+ )
(replace
;; This was added only to the Emacs side. I assume its absence on
;; the XEmacs side was an oversight. --Stef
@@ -2210,7 +2664,8 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
(delete-region start end)
(goto-char start)
(funcall flyspell-insert-function new-word)
- (if flyspell-abbrev-p
+ (if (and (not (string= ispell-program-name "NSSpellChecker"))
+ flyspell-abbrev-p)
(flyspell-define-abbrev word new-word)))
;; In the original Emacs code, this was only called in the body
;; of the if. I arbitrarily kept the XEmacs behavior instead.
@@ -2236,7 +2691,9 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
;;*---------------------------------------------------------------------*/
;;* flyspell-emacs-popup ... */
;;*---------------------------------------------------------------------*/
-(defun flyspell-emacs-popup (event poss word)
+;; flyspell-emacs-popup modified to define & use a keymap, so we can
+;; easily append another keymap (as "parent-keymap")
+(defun flyspell-emacs-popup (event poss word cursor-location start end save)
"The Emacs popup menu."
(if (and (not event)
(display-mouse-p))
@@ -2249,38 +2706,116 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
(setq event (list (list (car (cdr mouse-pos))
(1+ (cdr (cdr mouse-pos))))
(car mouse-pos)))))
- (let* ((corrects (flyspell-sort (car (cdr (cdr poss))) word))
- (cor-menu (if (consp corrects)
- (mapcar (lambda (correct)
- (list correct correct))
- corrects)
- '()))
+ (let* ((corrects (if flyspell-sort-corrections
+ ;; reverse word order for proper menu display
+ (reverse (sort (car (cdr (cdr poss))) 'string<))
+ (reverse (car (cdr (cdr poss))))))
(affix (car (cdr (cdr (cdr poss)))))
- show-affix-info
- (base-menu (let ((save (if (and (consp affix) show-affix-info)
- (list
- (list (concat "Save affix: " (car affix))
- 'save)
- '("Accept (session)" session)
- '("Accept (buffer)" buffer))
- '(("Save word" save)
- ("Accept (session)" session)
- ("Accept (buffer)" buffer)))))
- (if (consp cor-menu)
- (append cor-menu (cons "" save))
- save)))
- (menu (cons "flyspell correction menu" base-menu)))
- (car (x-popup-menu event
- (list (format "%s [%s]" word (or ispell-local-dictionary
- ispell-dictionary))
- menu)))))
+ show-affix-info)
+
+ (setq flyspell-context-menu-map
+ (make-sparse-keymap
+ (if (string= ispell-program-name "NSSpellChecker")
+ (if (not (car (cdr (cdr poss))))
+ "No Guesses Found"
+ (format "%s" word))
+ (format "%s [%s]" word (or ispell-local-dictionary
+ ispell-dictionary)))))
+
+ (define-key flyspell-context-menu-map [flyspell-corr-sep2]
+ ;; only include this separator when we'll also have more menu below it
+ `(menu-item "--" 'ignore :visible (not (eq
+ osx-key-mode-mouse-3-behavior
+ 'mouse-save-then-kill))))
+ (define-key flyspell-context-menu-map [buffer]
+ `(menu-item (if (string= ispell-program-name "NSSpellChecker")
+ "Ignore Spelling & Comment Buffer"
+ "Accept (buffer)")
+ (lambda () (interactive)
+ (flyspell-do-correct
+ 'buffer
+ ',poss
+ ,word
+ ,cursor-location
+ ,start
+ ,end
+ ,save))
+ :help "Always consider spelling as correct in this buffer"))
+ (define-key flyspell-context-menu-map [session]
+ `(menu-item (if (string= ispell-program-name "NSSpellChecker")
+ "Ignore Spelling"
+ "Accept (session)")
+ (lambda () (interactive)
+ (flyspell-do-correct
+ 'session
+ ',poss
+ ,word
+ ,cursor-location
+ ,start
+ ,end
+ ,save))
+ :help (if (string= ispell-program-name "NSSpellChecker")
+ "Consider spelling as correct in this buffer and session"
+ "Consider spelling correct for buffers in current session")))
+ (define-key flyspell-context-menu-map [save]
+ `(menu-item (if (string= ispell-program-name "NSSpellChecker")
+ "Learn Spelling"
+ "Save word")
+ (lambda () (interactive)
+ (flyspell-do-correct
+ 'save
+ ',poss
+ ,word
+ ,cursor-location
+ ,start
+ ,end
+ ,save))
+ :help "Save spelling to dictionary"))
+ (define-key flyspell-context-menu-map [affix]
+ ;; affix is nil for NSSpellChecker, so not visible
+ `(menu-item (concat "Save affix: " ,(car affix))
+ (lambda () (interactive)
+ (flyspell-do-correct
+ 'save
+ ',poss
+ ,word
+ ,cursor-location
+ ,start
+ ,end
+ ,save))
+ :help "Save affix construction to dictionary"
+ :visible (and ,(consp affix) ,show-affix-info)))
+ (when (consp corrects)
+ (define-key flyspell-context-menu-map [flyspell-corr-sep] '(menu-item "--"))
+ (let ((count 0)
+ cor-count-str)
+ (mapc (lambda (correct)
+ ;; generate custom symbol to serve as each key
+ (setq count (1+ count)
+ cor-count-str (concat "correct" (number-to-string count)))
+ (define-key flyspell-context-menu-map `[,(intern cor-count-str)]
+ `(menu-item ,correct
+ (lambda () (interactive)
+ (flyspell-do-correct
+ ,correct
+ ',poss
+ ,word
+ ,cursor-location
+ ,start
+ ,end
+ ,save))
+ :help "Replace word with guess")))
+ corrects)))
+ (popup-menu flyspell-context-menu-map event nil)))
;;*---------------------------------------------------------------------*/
;;* flyspell-xemacs-popup ... */
;;*---------------------------------------------------------------------*/
(defun flyspell-xemacs-popup (poss word cursor-location start end save)
"The XEmacs popup menu."
- (let* ((corrects (flyspell-sort (car (cdr (cdr poss))) word))
+ (let* ((corrects (if flyspell-sort-corrections
+ (sort (car (cdr (cdr poss))) 'string<)
+ (car (cdr (cdr poss)))))
(cor-menu (if (consp corrects)
(mapcar (lambda (correct)
(vector correct
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 0ed6c68..67ea91d 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1,9 +1,10 @@
-;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -*- lexical-binding:t -*-
+;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
;; Copyright (C) 1994-1995, 1997-2016 Free Software Foundation, Inc.
;; Author: Ken Stevens <k.stevens@ieee.org>
;; Maintainer: Ken Stevens <k.stevens@ieee.org>
+;; in Aquamacs: Nathaniel Cunningham <nathaniel.cunningham@gmail.com>
;; Stevens Mod Date: Mon Jan 7 12:32:44 PST 2003
;; Stevens Revision: 3.6
;; Status : Release with 3.1.12+ and 3.2.0+ ispell.
@@ -11,7 +12,7 @@
;; Web Site : http://kdstevens.com/~stevens/ispell-page.html
;; Keywords: unix wp
-;; This file is part of GNU Emacs.
+;; This file is part of GNU Emacs and of Aquamacs Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -46,9 +47,9 @@
;; 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
@@ -196,46 +197,54 @@
;; Fixed bug in returning to nroff mode from tex mode.
;;; Compatibility code for XEmacs and (not too) older emacsen:
-(defalias 'ispell-check-minver
- (if (fboundp 'version<=) 'version<=
- (lambda (minver version)
- "Check if string VERSION is at least string MINVER.
+
+(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.
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
-(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.
+(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.
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
@@ -243,8 +252,8 @@ before LIMIT.
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)
@@ -252,8 +261,6 @@ full featured `looking-back' function is missing."
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
(defvar mail-yank-prefix)
(defgroup ispell nil
@@ -344,11 +351,14 @@ Must be greater than 1."
:type 'integer
:group 'ispell)
+;;;###autoload
(defcustom ispell-program-name
- (or (executable-find "aspell")
- (executable-find "ispell")
- (executable-find "hunspell")
- "ispell")
+;; set NSSpellChecker as the default; no need to see if it's installed
+ "NSSpellChecker"
+ ;; (or (executable-find "aspell")
+ ;; (executable-find "ispell")
+ ;; (executable-find "hunspell")
+ ;; "ispell")
"Program invoked by \\[ispell-word] and \\[ispell-region] commands."
:type 'string
:set (lambda (symbol value)
@@ -396,15 +406,19 @@ Always stores Fcc copy of message when nil."
(defcustom ispell-grep-command
- "grep"
+ ;; 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")
"Name of the grep command for search processes."
:type 'string
:group 'ispell)
(defcustom ispell-grep-options
- "-Ei"
+ (if (memq system-type '(windows-nt ms-dos)) "-Ei" "-i")
"String of options to use when running the program in `ispell-grep-command'.
-Should probably be \"-Ei\"."
+Should probably be \"-i\" or \"-e\".
+Some machines (like the NeXT) don't support \"-i\"."
:type 'string
:group 'ispell)
@@ -522,6 +536,10 @@ is automatically set when defined in the file with either
(const :tag "default" nil))
:group 'ispell)
+(defvar ispell-dictionary-internal ispell-dictionary
+ "Internal copy of `ispell-dictionary'; can be modified by NSSpellChecker
+panel without disturbing `ispell-dictionary' setting.")
+
(defcustom ispell-extra-args nil
"If non-nil, a list of extra switches to pass to the Ispell program.
For example, (\"-W\" \"3\") to cause it to accept all 1-3 character
@@ -807,6 +825,459 @@ here just for backwards compatibility.")
"[[:alpha:]] if Emacs supports [:alpha:] regexp, nil
otherwise (current XEmacs does not support it).")
+;; **********************************************************************
+;; settings to control the use of NSSpellChecker as the spellchecking
+;; engine, instead of ispell/aspell/hunspell
+
+(defvar ns-spellchecker-language-alist
+'(("es" . "castellano")
+ ("da" . "dansk")
+ ("de" . "deutsch")
+ ("en" . "english")
+ ("fr" . "francais")
+ ("it" . "italiano")
+ ("nl" . "nederlands")
+ ("pt" . "portugues")
+ ("ru" . "russian")
+ ("sv" . "svenska"))
+ "alist pairing NSSpellChecker languages with corresponding entries
+in ispell's default ispell-dictionary-alist. This is only for the
+purposes of extracting `otherchars' and `many-otherchars-p'")
+
+(defun ns-spellchecker-ispell-equiv-language (language)
+ "Returns the name of the language from
+ispell-dictionary-base-alist that corresponds to LANGUAGE
+of NSSpellChecker. Returns nil if no corresponding language found."
+ (let ((lang-short-abbrev (substring language 0 2))
+ (lang-abbrev-p (or (equal (length language) 2)
+ (equal (substring language 2 3) "_"))))
+ (if lang-abbrev-p
+ (cdr (assoc lang-short-abbrev ns-spellchecker-language-alist)))))
+
+(defun ns-spellchecker-dictionary-otherchars (language)
+ "Returns the pair (otherchars . many-otherchars-p) for the specified
+NSSpellChecker LANGUAGE, by finding the corresponding entries in
+ispell-dictionary-base-alist. If no corresponding entry is found, assumes
+' for otherchars and t for many-otherchars-p."
+ (let* ((ispell-language (ns-spellchecker-ispell-equiv-language language))
+ (ispell-lang-list (assoc ispell-language ispell-dictionary-base-alist))
+ otherchars
+ many-otherchars-p)
+ (if ispell-language
+ (setq otherchars
+ (car (cdr (cdr (cdr ispell-lang-list))))
+ many-otherchars-p
+ (car (cdr (cdr (cdr (cdr ispell-lang-list))))))
+ (setq otherchars "[']"
+ many-otherchars-p t))
+ (cons otherchars many-otherchars-p)))
+
+(defun ns-spellchecker-dictionary-details (language)
+ (let* ((otherchars-pair (ns-spellchecker-dictionary-otherchars language))
+ (otherchars (car otherchars-pair))
+ (many-otherchars-p (cdr otherchars-pair)))
+ (list
+ language
+ "[[:alpha:]]"
+ "[^[:alpha:]]"
+ otherchars
+ many-otherchars-p
+ nil
+ nil
+ 'iso-8859-1)))
+
+(defun ns-spellchecker-list-dictionaries ()
+ (let ((lang-list (ns-spellchecker-list-languages))
+ dictionary-list)
+ ;; if (ns-spellchecker-current-language) returns a language not
+ ;; included by (ns-spellchecker-list-languages) --
+ ;; e.g. "Multilingual" in OS 10.6 -- append it to the list.
+ (add-to-list 'lang-list (ns-spellchecker-current-language))
+ (dolist (lang lang-list)
+ (setq dictionary-list
+ (cons (ns-spellchecker-dictionary-details lang)
+ dictionary-list)))
+ dictionary-list))
+
+(defcustom ns-spellchecker-chunk-size 100000
+ "approximate size in characters of the chunks of text to be
+passed to `ns-spellchecker-check-spelling' when checking large
+regions."
+ :type '(choice (const :tag "Default" 100000)
+ number ))
+
+(defun ns-spellchecker-parse-output (word)
+ "NSSpellChecker replacement for ispell-parse-output. Spellcheck WORD
+and Return:
+1: t for an exact match.
+2: A list of possible correct spellings of the format:
+ (\"ORIGINAL-WORD\" OFFSET MISS-LIST)
+ ORIGINAL-WORD is a string of the possibly misspelled word.
+ OFFSET is an integer giving the character offset of the word from
+ the beginning of the line.
+ MISS-LIST is a possibly null list of guesses."
+ (unless (string= ispell-current-dictionary
+ (ns-spellchecker-current-language))
+ (ispell-change-dictionary (ns-spellchecker-current-language)))
+ (let* ((output (ns-spellchecker-check-spelling word (current-buffer)))
+ (offset (car output)))
+ (if offset
+ ;; word is incorrect -- return
+ ;; (\"ORIGINAL-WORD\" OFFSET MISS-LIST GUESS-LIST)
+ ;; GUESS-LIST built from known affixes is nil for NSSpellChecker
+ (list word (1+ offset) (ns-spellchecker-get-suggestions word) nil)
+ ;; offset is nil: word is correct -- return t
+ t)))
+
+(defun ispell-ns-spellcheck-string (string)
+ "NSSpellChecker replacement for ispell-parse-output. Spellcheck STRING
+and return a list of lists (one for each misspelled word) of the format:
+ (\"ORIGINAL-WORD\" OFFSET MISS-LIST nil)
+ ORIGINAL-WORD is a string of the possibly misspelled word.
+ OFFSET is an integer giving the line offset of the word.
+ MISS-LIST is a possibly null list of guesses."
+ (unless (string= ispell-current-dictionary
+ (ns-spellchecker-current-language))
+ (ispell-change-dictionary (ns-spellchecker-current-language)))
+ (let ((strlen (length string))
+ (prev-offset 0)
+ ns-spellcheck-output
+ offset
+ length
+ word
+ return-list)
+ (while (progn
+ (setq ns-spellcheck-output
+ (ns-spellchecker-check-spelling string (current-buffer))
+ offset (car ns-spellcheck-output)
+ length (cdr ns-spellcheck-output))
+ ;; if no misspelled words, terminate while loop
+ (when offset
+ ;; misspelled word found; get word;
+ ;; set string to not-yet-checked portion;
+ ;; add details of misspelling to head of return-list
+ (setq word (substring string offset (+ offset length))
+ string (substring string (+ offset length)))
+ (add-to-list 'return-list
+ (list word (+ prev-offset offset)
+ (ns-spellchecker-get-suggestions word)
+ nil))
+ (setq prev-offset (+ prev-offset offset length))
+ )))
+ return-list))
+
+;;; **********************************************************************
+;;; settings to use cocoAspell preferences (from Spelling prefpane)
+;;; or cocoAspell-installed aspell dictionaries
+
+;; we need an alist or hash table pairing up language names and
+;; abbreviations
+(defvar ispell-language-abbrev-alist
+ (list
+ (cons "Afrikaans" "af")
+ (cons "Amharic" "am")
+ (cons "Arabic" "ar")
+ (cons "Azerbaijani" "az")
+ (cons "Belarusian" "be")
+ (cons "Bulgarian" "bg")
+ (cons "Bengali" "bn")
+ (cons "Breton" "br")
+ (cons "Catalan" "ca")
+ (cons "Czech" "cs")
+ (cons "Kashubian" "csb")
+ (cons "Welsh" "cy")
+ (cons "Danish" "da")
+ (cons "German" "de")
+ (cons "Greek" "el")
+ (cons "English" "en")
+ (cons "Esperanto" "eo")
+ (cons "Spanish" "es")
+ (cons "Estonian" "et")
+ (cons "Persian" "fa")
+ (cons "Finnish" "fi")
+ (cons "Faroese" "fo")
+ (cons "French" "fr")
+ (cons "Frisian" "fy")
+ (cons "Irish" "ga")
+ (cons "Scottish Gaelic" "gd")
+ (cons "Gallegan" "gl")
+ (cons "Gujarati" "gu")
+ (cons "Manx" "gv")
+ (cons "Hebrew" "he")
+ (cons "Hindi" "hi")
+ (cons "Hiligaynon" "hil")
+ (cons "Croatian" "hr")
+ (cons "Upper Sorbian" "hsb")
+ (cons "Hungarian" "hu")
+ (cons "Armenian" "hy")
+ (cons "Interlingua" "ia")
+ (cons "Indonesian" "id")
+ (cons "Icelandic" "is")
+ (cons "Italian" "it")
+ (cons "Kurdish" "ku")
+ (cons "Latin" "la")
+ (cons "Lithuanian" "lt")
+ (cons "Latvian" "lv")
+ (cons "Malagasy" "mg")
+ (cons "Maori" "mi")
+ (cons "Macedonian" "mk")
+ (cons "Malayalam" "ml")
+ (cons "Mongolian" "mn")
+ (cons "Marathi" "mr")
+ (cons "Malay" "ms")
+ (cons "Maltese" "mt")
+ (cons "Norwegian Bokmål" "nb")
+ (cons "Low German; Low Saxon" "nds")
+ (cons "Dutch" "nl")
+ (cons "Norwegian Nynorsk" "nn")
+ (cons "Nyanja; Chichewa; Chewa" "ny")
+ (cons "Oriya" "or")
+ (cons "Punjabi" "pa")
+ (cons "Polish" "pl")
+ (cons "Portuguese" "pt")
+ (cons "Quechua" "qu")
+ (cons "Romanian" "ro")
+ (cons "Russian" "ru")
+ (cons "Kinyarwanda" "rw")
+ (cons "Sardinian" "sc")
+ (cons "Slovak" "sk")
+ (cons "Slovenian" "sl")
+ (cons "Serbian" "sr")
+ (cons "Swedish" "sv")
+ (cons "Swahili" "sw")
+ (cons "Tamil" "ta")
+ (cons "Telugu" "te")
+ (cons "Tetum" "tet")
+ (cons "Turkmen" "tk")
+ (cons "Tagalog" "tl")
+ (cons "Tswana" "tn")
+ (cons "Turkish" "tr")
+ (cons "Ukrainian" "uk")
+ (cons "Uzbek" "uz")
+ (cons "Vietnamese" "vi")
+ (cons "Walloon" "wa")
+ (cons "Yiddish" "yi")
+ (cons "Zulu" "zu"))
+ "Paired language names and ISO abbreviations.
+Used to match cocoAspell language names to dictionary
+file names.")
+
+;; another alist for language region abbreviations
+(defvar ispell-lregion-abbrev-alist
+ (list
+ (cons "United States" "US")
+ (cons "Canada" "CA")
+ (cons "United Kingdom" "GB")
+ (cons "France" "FR")
+ (cons "Switzerland" "CH")
+ (cons "Austria" "AT")
+ (cons "Germany" "DE")
+ (cons "Brazil" "BR")
+ (cons "Portugal" "PT"))
+ "Paired language region names and abbreviations.
+Used to match cocoAspell language names to dictionary
+file names.")
+
+(defvar aspell-knows-no-dicts nil
+ "Records whether or not aspell's default configuration can
+locate any dictionaries.")
+
+(defcustom ispell-use-cocoaspell
+ 'auto
+ "Specify whether spell-checking with aspell should use
+cocoaAspell installation. The following options are available:
+- `full'
+ Use cocoAspell preferences and dictionaries.
+- `dicts'
+ Use cocoAspell dictionaries only (e.g. when
+ Spelling prefpane isn't installed).
+- nil
+ Use generic aspell without cocoAspell.
+- `auto'
+ Determine the proper setting at runtime,
+ based on detected aspell/cocoAspell installation."
+ :group 'ispell
+ :type '(choice :tag "Aspell should use..."
+ (const :tag "cocoAspell Preferences and Dictionaries" full)
+ (const :tag "cocoAspell Dictionaries Only" dicts)
+ (const :tag "generic install (Don't use cocoAspell)" nil)
+ (const :tag "automatic setting" auto)))
+
+(defvar ispell-use-cocoaspell-internal nil
+ "Internal value based on `ispell-use-cocoaspell', after checking
+aspell/cocoaspell installation if needed. Do not set directly.")
+
+(defvar ispell-cocoaspell-prefs-dir nil
+ "Full path to cocoAspell's preferences directory, if cocoAspell installed")
+
+(defvar ispell-cocoaspell-prefpane-plist nil
+ "Full path to file recording cocoAspell Spelling prefpane's preferences.
+File contents are used to determine which languages are available for
+spell checking.")
+
+(defvar ispell-cocoaspell-dict-list nil
+ "List of dictionaries checked in cocoAspell's Spelling prefpane.")
+
+(defvar ispell-cocoaspell-dict-dir-list nil
+ "List of paths of directories for all cocoAspell-installed
+aspell dictionaries.")
+
+(defvar ispell-cocoaspell-dict-aliases nil
+ "List of base filenames of all *.alias files in cocoAspell-installed aspell
+dictionary directories. These will be used to generate ispell-dictionary-alist
+when cocoAspell dictionaries are installed, but no Spelling prefpane.")
+
+(defun ispell-update-cocoaspell-settings ()
+ (setq aspell-knows-no-dicts
+ (condition-case nil
+ (with-temp-buffer
+ ;; is there a stored cocoaSpell configuration?
+ (call-process ispell-program-name nil t nil "dicts")
+ (eq (point-min) (point-max)))
+ (error nil)))
+
+ ;; determine how to configure aspell
+ (setq ispell-use-cocoaspell-internal
+ (if (eq ispell-use-cocoaspell 'auto)
+ ;; automatically determine appropriate setting
+ (when aspell-knows-no-dicts
+ ;; assume cocoaspell if no dictionaries known to aspell
+ (if (file-accessible-directory-p
+ (expand-file-name "~/Library/Services/cocoAspell.service/"))
+ ;; if cocoaSpell service is installed, use full cocoaspell support
+ 'full
+ ;; else just use cocoaSpell-installed dictionaries
+ 'dicts))
+ ;; use setting as specified by user
+ ispell-use-cocoaspell))
+
+ (setq ispell-cocoaspell-prefs-dir
+ (when (eq ispell-use-cocoaspell-internal 'full)
+ (expand-file-name "~/Library/Preferences/cocoAspell/")))
+
+ (setq ispell-cocoaspell-prefpane-plist
+ (when (eq ispell-use-cocoaspell-internal 'full)
+ ;; overall preferences set in Spelling prefpane
+ (expand-file-name
+ "~/Library/Services/cocoAspell.service/Contents/Info.plist")))
+
+ (setq ispell-cocoaspell-dict-list
+ (when (eq ispell-use-cocoaspell-internal 'full)
+ (let ((lang-list))
+ (with-temp-buffer
+ ;; extract language names selected in Spelling prefpane
+ (insert-file-contents ispell-cocoaspell-prefpane-plist)
+ ;; (call-process "plutil" nil t t "-convert" "xml1" "-o" "-"
+ ;; ispell-cocoaspell-prefpane-plist)
+ ;; (goto-char (point-min))
+ ;; move point to just before first language name
+ (re-search-forward "<key>NSLanguages</key>\\s +<array>\\s +<string>")
+ (while (progn
+ ;; find each language name, and move point to just before next
+ ;; tag after current string
+ (re-search-forward "\\(.+\\)</string>\\s +<\\([/a-z]+\\)>")
+ ;; tack current language onto lang-list
+ (add-to-list 'lang-list (match-string 1))
+ ;; continue if next tag indicates another language string
+ (equal (match-string 2) "string")))
+ ;; return the language list
+ lang-list))))
+
+ (setq ispell-cocoaspell-dict-dir-list
+ (when (eq ispell-use-cocoaspell-internal 'dicts)
+ (file-expand-wildcards
+ "/Library/Application Support/cocoAspell/aspell*-*-*")))
+
+ (setq ispell-cocoaspell-dict-aliases
+ (when (eq ispell-use-cocoaspell-internal 'dicts)
+ (mapcar (lambda (dict-alias)
+ (file-name-sans-extension
+ (file-name-nondirectory dict-alias)))
+ (file-expand-wildcards
+ "/Library/Application Support/cocoAspell/aspell*-*-*/*.multi"))))
+ )
+ ;; convert from names e.g. English (United States) to en_US
+ ;; append stuff in brackets
+ ;; also include length if it exists
+(defun aspell-dict-abbrev (langstring)
+ "Given LANGSTRING, a string name for a cocoAspell dictionary, return
+abbreviated dict name, which cocoAspell uses as base filename for that
+dictionary's files. e.g., passed `English (United States) [w_accents]'
+return 'en_US-w_accents'."
+ (unless (null langstring)
+ (let* ((lang-elts
+ ;; parse out: language
+ (string-match (concat "\\([[:alpha:]]+;?\\( [[:alpha:]]+;?\\)*\\)"
+ ;; region
+ "\\( (\\([[:alpha:] ]+\\))\\)?"
+ ;; modifiers
+ "\\( \\[\\(.+\\)\\]\\)?"
+ ) langstring))
+ (lang (match-string 1 langstring))
+ (lregion (match-string 4 langstring))
+ (mods (match-string 6 langstring))
+ (lang-abbrev (cdr (assoc lang ispell-language-abbrev-alist)))
+ (lregion-abbrev (or (cdr (assoc lregion ispell-lregion-abbrev-alist))
+ lregion))) ;; if no abbrev in alist, keep name
+ (if lregion-abbrev (setq lregion-abbrev (concat "_" lregion-abbrev)))
+ (if mods (setq mods (concat "-" mods)))
+ (concat lang-abbrev lregion-abbrev mods)))) ;; generate aspell conf filename
+
+(defun ispell-cocoaspell-dict-dir (dict-abbrev)
+ "Return the full path of the directory in which cocoAspell dictionary
+files for dictionary DICT-ABBREV are located."
+ (let ((filename (concat ispell-cocoaspell-prefs-dir dict-abbrev ".conf")))
+ (if (file-readable-p filename)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (when (search-forward-regexp "^dict-dir " nil t)
+ (buffer-substring (point) (progn (end-of-line) (point)))))
+ (let* ((dict-abbrev-parts (split-string dict-abbrev "-"))
+ (dict-abbrev-root (car dict-abbrev-parts))
+ (dict-abbrev-mods (nth 1 dict-abbrev-parts))
+ (dict-abbrev-root-parts (split-string dict-abbrev-root "_"))
+ (dict-lang-abbrev (car dict-abbrev-root-parts))
+ (dict-region-abbrev (nth 1 dict-abbrev-root-parts))
+ (dict-parent-dir "/Library/Application Support/cocoAspell/")
+ (dict-dir (car (or (directory-files
+ dict-parent-dir
+ nil
+ (concat "aspell[0-9]?-"
+ dict-lang-abbrev "-"
+ dict-abbrev-mods "-.+"))
+ (directory-files
+ dict-parent-dir
+ nil
+ (concat "aspell[0-9]?-"
+ dict-lang-abbrev "-"
+ dict-region-abbrev "-.+"))
+ (directory-files
+ dict-parent-dir
+ nil
+ (concat "aspell[0-9]?-"
+ dict-lang-abbrev "-.+"))))))
+ (concat dict-parent-dir dict-dir)))))
+
+(defun ispell-cocoaspell-aspell-args (dict-abbrev)
+ "Return the arguments to be passed to the aspell command to use dictionary
+DICT-ABBREV."
+ (let* ((lang-conf (concat ispell-cocoaspell-prefs-dir dict-abbrev ".conf"))
+ (readable (file-readable-p lang-conf)))
+ (if readable
+ (list (concat "--conf=" ispell-cocoaspell-prefs-dir "filters.conf")
+ (concat "--per-conf=" ispell-cocoaspell-prefs-dir dict-abbrev ".conf"))
+ (let* ((dict-abbrev-parts (split-string dict-abbrev "-"))
+ (dict-abbrev-root (car dict-abbrev-parts))
+ (dict-abbrev-mods (nth 1 dict-abbrev-parts))
+ (dict-dir (ispell-cocoaspell-dict-dir dict-abbrev)))
+ (list (concat "--dict-dir=" dict-dir)
+ (concat "--home-dir=" ispell-cocoaspell-prefs-dir)
+ (concat "--jargon=" dict-abbrev-mods)
+ (concat "--lang=" dict-abbrev-root)
+ (concat "--personal=" dict-abbrev-root ".pws")
+ (concat "--repl=" dict-abbrev-root ".prepl"))))))
+
+
;;; **********************************************************************
;;; The following are used by ispell, and should not be changed.
;;; **********************************************************************
@@ -835,6 +1306,15 @@ Otherwise returns the library directory name, if that is defined."
;; all versions, since versions earlier than 3.0.09 didn't identify
;; themselves on startup.
(interactive "p")
+ (if (string= ispell-program-name "NSSpellChecker")
+ ;; If using NSSpellChecker, just initialize variables and return.
+ (progn
+ ;; Make sure these variables are (re-)initialized to the default value
+ (setq ispell-really-aspell nil
+ ispell-aspell-supports-utf8 nil
+ ispell-really-hunspell nil
+ ispell-encoding8-command nil)
+ t)
(let ((default-directory (or (and (boundp 'temporary-file-directory)
temporary-file-directory)
default-directory))
@@ -916,7 +1396,7 @@ Otherwise returns the library directory name, if that is defined."
(if (ispell-check-minver hunspell8-minver ispell-really-hunspell)
(setq ispell-encoding8-command "-i")
(setq ispell-really-hunspell nil))))))
- result))
+ result)))
(defun ispell-call-process (&rest args)
"Like `call-process' but defend against bad `default-directory'."
@@ -932,8 +1412,6 @@ Otherwise returns the library directory name, if that is defined."
(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,
@@ -992,7 +1470,7 @@ and added as a submenu of the \"Edit\" menu.")
(defvar ispell-async-processp (and (fboundp 'delete-process)
(fboundp 'process-send-string)
(fboundp 'accept-process-output)
- ;;(fboundp 'make-process)
+ ;;(fboundp 'start-process)
;;(fboundp 'set-process-filter)
;;(fboundp 'process-kill-without-query)
)
@@ -1005,14 +1483,19 @@ and added as a submenu of the \"Edit\" menu.")
Internal use.")
(defun ispell-find-aspell-dictionaries ()
- "Find Aspell's dictionaries, and record in `ispell-dictionary-alist'."
+ "Find Aspell's dictionaries, and record in `ispell-aspell-dictionary-alist'."
(unless (and ispell-really-aspell ispell-encoding8-command)
(error "This function only works with Aspell >= 0.60"))
(let* ((dictionaries
- (split-string
+ (cond
+ ((eq ispell-use-cocoaspell-internal 'full)
+ ispell-cocoaspell-dict-list)
+ ((eq ispell-use-cocoaspell-internal 'dicts)
+ ispell-cocoaspell-dict-aliases)
+ (t (split-string
(with-temp-buffer
(ispell-call-process ispell-program-name nil t nil "dicts")
- (buffer-string))))
+ (buffer-string))))))
;; Search for the named dictionaries.
(found
(delq nil
@@ -1022,13 +1505,30 @@ Internal use.")
(setq found (ispell-aspell-add-aliases found))
;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist
;; which have no element in FOUND at all.
- (dolist (dict ispell-dictionary-base-alist)
- (unless (assoc (car dict) found)
- (setq found (nconc found (list dict)))))
+ ;; ==SKIP this step -- don't add entries corresponding to dicts we don't have!!!==
+;; (dolist (dict ispell-dictionary-base-alist)
+;; (unless (assoc (car dict) found)
+;; (setq found (nconc found (list dict)))))
(setq ispell-aspell-dictionary-alist found)
;; Add a default entry
- (let ((default-dict
- '(nil "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil utf-8)))
+ (let* ((english-dict-cdr
+ (if ispell-use-cocoaspell-internal
+ (or
+ (assoc-default "^[Ee]nglish$" ispell-aspell-dictionary-alist
+ (lambda (dict-name key)
+ (string-match key dict-name)))
+ (assoc-default "^[Ee]n$" ispell-aspell-dictionary-alist
+ (lambda (dict-name key)
+ (string-match key dict-name)))
+ (assoc-default "^[Ee]ngl.*" ispell-aspell-dictionary-alist
+ (lambda (dict-name key)
+ (and (string-match key dict-name)
+ (not (string-match ".*variant.*"
+ dict-name))))))
+ (cdr (assoc "en" ispell-aspell-dictionary-alist))))
+ (default-dict
+ (cons nil (or english-dict-cdr
+ (cdr (car ispell-aspell-dictionary-alist))))))
(push default-dict ispell-aspell-dictionary-alist))))
(defvar ispell-aspell-data-dir nil
@@ -1058,26 +1558,39 @@ of `ispell-dictionary-base-alist' elements."
(or ispell-aspell-data-dir
(setq ispell-aspell-data-dir
(ispell-get-aspell-config-value "data-dir")))
-
- ;; 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),
- ;; then try xx-alt.dat, for de-alt etc.
- (dolist (tmp-regexp (list "^[[:alpha:]]+"
- "^[[:alpha:]_]+"
- "^[[:alpha:]]+-\\(alt\\|old\\)"))
- (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)))))))
+ ;; Try finding associated datafile
+ (let* ((dict-abbrev (when (eq ispell-use-cocoaspell-internal 'full)
+ (aspell-dict-abbrev dict-name)))
+ (lang ;; Strip out region, variant, etc.
+ (and (string-match "^[[:alpha:]]+" (or dict-abbrev dict-name))
+ (match-string 0 (or dict-abbrev dict-name))))
+ ;; When using cocoaspell, need to specify dict-dir directly.
+ (dict-dir (cond
+ ((eq ispell-use-cocoaspell-internal 'full)
+ (ispell-cocoaspell-dict-dir dict-abbrev))
+ ((eq ispell-use-cocoaspell-internal 'dicts)
+ (file-name-directory
+ (car
+ (file-expand-wildcards
+ (concat
+ "/Library/Application Support/cocoAspell/aspell*-*-*/"
+ dict-name ".multi")))))))
+ (datafile0
+ (if ispell-use-cocoaspell-internal (concat dict-dir "/" lang ".dat")))
+ (datafile1
+ (concat ispell-aspell-data-dir "/" lang ".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 (and datafile0 (file-readable-p datafile0))
+ datafile0
+ (if (file-readable-p datafile1)
+ datafile1
+ (if (file-readable-p datafile2)
+ datafile2))))
otherchars)
(if data-file
@@ -1103,7 +1616,14 @@ of `ispell-dictionary-base-alist' elements."
"[^[:alpha:]]"
(regexp-opt otherchars)
t ; We can't tell, so set this to t
- (list "-d" dict-name)
+ ;; set arguments for aspell
+ ;; if we use cocoAspell prefs, use conf files associated with language
+ (cond ((eq ispell-use-cocoaspell-internal 'full)
+ (ispell-cocoaspell-aspell-args dict-abbrev))
+ ((eq ispell-use-cocoaspell-internal 'dicts)
+ (list "-d" dict-name
+ "--dict-dir" dict-dir))
+ (t (list "-d" dict-name)))
nil ; aspell doesn't support this
;; Here we specify the encoding to use while communicating with
;; aspell. This doesn't apply to command line arguments, so
@@ -1174,15 +1694,15 @@ all uninitialized dicts using that affix file."
(if (cadr (assoc tmp-dict ispell-dictionary-alist))
(ispell-print-if-debug
"ispell-hfde: %s already expanded; skipping.\n" tmp-dict)
- (cl-pushnew tmp-dict use-for-dicts :test #'equal))))))
+ (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)
- (cl-pushnew (if (member (car entry) use-for-dicts)
- (cons (car entry) dict-args-cdr)
- entry)
- newlist :test #'equal))
+ (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)
@@ -1227,7 +1747,7 @@ did."
(chars-list (append otherchars-string nil)))
(setq chars-list (delq ?\ chars-list))
(dolist (ch chars-list)
- (cl-pushnew ch otherchars-list :test #'equal)))))
+ (add-to-list 'otherchars-list ch)))))
;; Cons the argument for the -d switch.
(setq dict-arg (concat dict-arg
(if (> (length dict-arg) 0) ",")
@@ -1238,7 +1758,7 @@ did."
"[[: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)
@@ -1260,7 +1780,7 @@ in the list must have an affix file where Hunspell affix files are kept."
(or (assoc first-dict ispell-local-dictionary-alist)
(assoc first-dict ispell-dictionary-alist)
(error "Unknown dictionary: %s" first-dict)))
- (cl-pushnew (list dict '()) ispell-dictionary-alist :test #'equal)
+ (add-to-list 'ispell-dictionary-alist (list dict '()))
(ispell-hunspell-fill-dictionary-entry dict))
(defun ispell-find-hunspell-dictionaries ()
@@ -1300,8 +1820,8 @@ entries if a specific dictionary was found."
(ispell-print-if-debug
"++ ispell-fhd: dict-entry:%s name:%s basename:%s affix-file:%s\n"
dict full-name basename affix-file)
- (cl-pushnew (list basename affix-file)
- ispell-hunspell-dict-paths-alist :test #'equal))
+ (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.
@@ -1311,7 +1831,7 @@ entries if a specific dictionary was found."
(ispell-print-if-debug
"-- ispell-fhd: Excluding %s alias. Standalone dict found.\n"
(car dict))
- (cl-pushnew dict newlist :test #'equal)))
+ (add-to-list 'newlist dict)))
(setq ispell-dicts-name2locale-equivs-alist newlist))
;; Add known hunspell aliases
(dolist (dict-equiv ispell-dicts-name2locale-equivs-alist)
@@ -1329,20 +1849,22 @@ entries if a specific dictionary was found."
ispell-hunspell-dict-paths-alist))))
(ispell-print-if-debug "++ ispell-fhd: Adding alias %s -> %s.\n"
dict-equiv-key affix-file)
- (cl-pushnew (list dict-equiv-key affix-file)
- ispell-hunspell-dict-paths-alist :test #'equal)))))
+ (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 (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))))
+ (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
@@ -1371,15 +1893,10 @@ aspell is used along with Emacs).")
(error nil))
ispell-encoding8-command
ispell-emacs-alpha-regexp)
- ;; 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)))))
+ (progn
+ (ispell-update-cocoaspell-settings)
+ (unless ispell-aspell-dictionary-alist
+ (ispell-find-aspell-dictionaries))))
;; Substitute ispell-dictionary-alist with the list of
;; dictionaries corresponding to the given spellchecker.
@@ -1387,13 +1904,12 @@ aspell is used along with Emacs).")
;; 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-encoding8-command
- ispell-emacs-alpha-regexp)
- (if ispell-really-aspell
- ispell-aspell-dictionary-alist
- (if ispell-really-hunspell
- ispell-hunspell-dictionary-alist))
- nil))
+ (cond ((and ispell-really-aspell
+ ispell-encoding8-command)
+ ispell-aspell-dictionary-alist)
+ ((string= ispell-program-name "NSSpellChecker")
+ (ns-spellchecker-list-dictionaries))
+ (t nil)))
(ispell-dictionary-base-alist ispell-dictionary-base-alist)
ispell-base-dicts-override-alist ; Override only base-dicts-alist
all-dicts-alist)
@@ -1433,28 +1949,35 @@ aspell is used along with Emacs).")
(setq skip-dict t)))
(unless skip-dict
- (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)))
+ (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.
(dolist (dict (append found-dicts-alist
- ispell-base-dicts-override-alist
- ispell-dictionary-base-alist))
+ ispell-base-dicts-override-alist))
+ ;; Why would we add all dictionaries to the list that already has available ones?
+ ;; ispell-dictionary-base-alist))
(unless (assoc (car dict) all-dicts-alist)
- (push dict all-dicts-alist)))
+ (add-to-list 'all-dicts-alist dict)))
(setq ispell-dictionary-alist all-dicts-alist))
+ (setq ispell-dictionary-internal
+ (if (string= ispell-program-name "NSSpellChecker")
+ ;; get working value of ispell-dictionary from spellingPanel
+ (ns-spellchecker-current-language)
+ ;; or set from global value
+ ispell-dictionary))
;; If Emacs flavor supports [:alpha:] use it for global dicts. If
;; spellchecker also supports UTF-8 via command-line option use it
@@ -1463,20 +1986,20 @@ aspell is used along with Emacs).")
(if ispell-emacs-alpha-regexp
(let (tmp-dicts-alist)
(dolist (adict ispell-dictionary-alist)
- (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))
+ (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 ()
@@ -1489,7 +2012,9 @@ The variable `ispell-library-directory' defines their location."
(ispell-set-spellchecker-params))
(let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist))
- (dict-list (cons "default" nil))
+ (dict-list (if (string= ispell-program-name "NSSpellChecker")
+ nil
+ (cons "default" nil)))
name dict-bname)
(dolist (dict dicts)
(setq name (car dict)
@@ -1500,6 +2025,7 @@ The variable `ispell-library-directory' defines their location."
name
;; For Aspell, we already know which dictionaries exist.
(or ispell-really-aspell
+ (string= ispell-program-name "NSSpellChecker")
;; Include all dictionaries if lib directory not known.
;; Same for Hunspell, where ispell-library-directory is nil.
(not ispell-library-directory)
@@ -1510,10 +2036,97 @@ The variable `ispell-library-directory' defines their location."
(push name dict-list)))
dict-list))
+(defun toggle-text-mode-flyspell ()
+ "Toggle whether to use Flyspell in Text mode and related modes.
+This command affects all buffers that use modes related to Text mode,
+both existing buffers and buffers that you subsequently create."
+ (interactive)
+ (let ((enable-mode (not (memq 'turn-on-flyspell text-mode-hook))))
+ (if enable-mode
+ (add-hook 'text-mode-hook 'turn-on-flyspell)
+ (remove-hook 'text-mode-hook 'turn-on-flyspell))
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (if (or (derived-mode-p 'text-mode) text-mode-variant)
+ (flyspell-mode (if enable-mode 1 0)))))
+ (message "Flyspell %s in Text modes"
+ (if enable-mode "enabled" "disabled"))))
+
+;;;###autoload
+(defun menu-bar-text-mode-flyspell ()
+ (interactive)
+ (toggle-text-mode-flyspell)
+ (customize-mark-as-set 'text-mode-hook))
+
;; Define commands in menu in opposite order you want them to appear.
;;;###autoload
(if ispell-menu-map-needed
(progn
+ (defvar ispell-submenu-map (make-sparse-keymap "Ispell"))
+ (define-key ispell-submenu-map [ispell-complete-word]
+ `(menu-item ,(purecopy "Complete Word") ispell-complete-word
+ :help ,(purecopy "Complete word at cursor using dictionary")))
+ (define-key ispell-submenu-map [ispell-complete-word-interior-frag]
+ `(menu-item ,(purecopy "Complete Word Fragment")
+ ispell-complete-word-interior-frag
+ :help ,(purecopy "Complete word fragment at cursor")))
+ (define-key ispell-submenu-map [ispell-continue]
+ `(menu-item ,(purecopy "Continue Spell-Checking") ispell-continue
+ :enable (and (boundp 'ispell-region-end)
+ (marker-position ispell-region-end)
+ (equal (marker-buffer ispell-region-end)
+ (current-buffer)))
+ :help ,(purecopy "Continue spell checking last region")))
+ (define-key ispell-submenu-map [ispell-word]
+ `(menu-item ,(purecopy "Spell-Check Word") ispell-word
+ :help ,(purecopy "Spell-check word at cursor")))
+ (define-key ispell-submenu-map [ispell-comments-and-strings]
+ `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings
+ :help ,(purecopy "Spell-check only comments and strings")))
+ (define-key ispell-submenu-map [ispell-region]
+ `(menu-item ,(purecopy "Spell-Check Region") ispell-region
+ :enable mark-active
+ :help ,(purecopy "Spell-check text in marked region")))
+ (define-key ispell-submenu-map [ispell-message]
+ `(menu-item ,(purecopy "Spell-Check Message") ispell-message
+ :visible (eq major-mode 'mail-mode)
+ :help ,(purecopy "Skip headers and included message text")))
+ (define-key ispell-submenu-map [ispell-buffer]
+ `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer
+ :help ,(purecopy "Check spelling of selected buffer")))
+ ;;(put 'ispell-region 'menu-enable 'mark-active)
+
+ (fset 'ispell-submenu-map (symbol-value 'ispell-submenu-map))))
+
+;;;###autoload
+(if ispell-menu-map-needed
+ (progn
+ (defvar flyspell-modes-submenu-map (make-sparse-keymap "Flyspell modes"))
+ (define-key flyspell-modes-submenu-map [flyspell-no-modes]
+ `(menu-item ,(purecopy "No Modes") flyspell-no-modes
+ :button (:radio . (and (not (memq 'turn-on-flyspell
+ text-mode-hook))
+ (not (bound-and-true-p
+ global-flyspell-mode))))
+ :help ,(purecopy "Turn off automatic spellchecking by mode")))
+ (define-key flyspell-modes-submenu-map [flyspell-text-modes]
+ `(menu-item ,(purecopy "Text Modes") flyspell-text-modes
+ :button (:radio . (and (memq 'turn-on-flyspell text-mode-hook)
+ (not (bound-and-true-p
+ global-flyspell-mode))))
+ :help ,(purecopy "Turn on flyspell in text modes only")))
+ (define-key flyspell-modes-submenu-map [flyspell-all-modes]
+ `(menu-item ,(purecopy "All Modes") flyspell-all-modes
+ :button (:radio . (bound-and-true-p global-flyspell-mode))
+ :help ,(purecopy "Turn on flyspell in all modes")))
+
+ (fset 'flyspell-modes-submenu-map
+ (symbol-value 'flyspell-modes-submenu-map))))
+
+;;; define commands in menu in opposite order you want them to appear.
+;;;###autoload
+(if ispell-menu-map-needed
+ (progn
(setq ispell-menu-map (make-sparse-keymap "Spell"))
(define-key ispell-menu-map [ispell-change-dictionary]
`(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary
@@ -1523,10 +2136,12 @@ The variable `ispell-library-directory' defines their location."
(lambda () (interactive) (ispell-kill-ispell nil 'clear))
:enable (and (boundp 'ispell-process) ispell-process
(eq (ispell-process-status) 'run))
+ :visible (not (string= ispell-program-name "NSSpellChecker"))
:help ,(purecopy "Terminate Ispell subprocess")))
(define-key ispell-menu-map [ispell-pdict-save]
`(menu-item ,(purecopy "Save Dictionary")
(lambda () (interactive) (ispell-pdict-save t t))
+ :visible (not (string= ispell-program-name "NSSpellChecker"))
:help ,(purecopy "Save personal dictionary")))
(define-key ispell-menu-map [ispell-customize]
`(menu-item ,(purecopy "Customize...")
@@ -1537,17 +2152,35 @@ The variable `ispell-library-directory' defines their location."
`(menu-item ,(purecopy "Help")
(lambda () (interactive) (describe-function 'ispell-help))
:help ,(purecopy "Show standard Ispell keybindings and commands")))
+
+ (define-key ispell-menu-map [ispell-submenu]
+ `(menu-item ,(purecopy "Ispell") ,ispell-submenu-map
+ :visible (string= ispell-program-name "NSSpellChecker")))
+ (define-key ispell-menu-map [spellcheck-menu-separator]
+ `(menu-item ,(purecopy "--")))
+
+ (define-key ispell-menu-map [flyspell-modes-submenu]
+ `(menu-item ,(purecopy "Check Spelling While Typing in Modes")
+ ,flyspell-modes-submenu-map))
(define-key ispell-menu-map [flyspell-mode]
- `(menu-item ,(purecopy "Automatic spell checking (Flyspell)")
+ `(menu-item ,(purecopy "Check Spelling While Typing (in this buffer)")
flyspell-mode
:help ,(purecopy "Check spelling while you edit the text")
+ ;; allow toggling regardless of mode-related flyspell settings
:button (:toggle . (bound-and-true-p flyspell-mode))))
+ (define-key ispell-menu-map [flyspell-buffer]
+ `(menu-item ,(purecopy "Mark All Misspellings")
+ flyspell-buffer
+ :help ,(purecopy "Scan full buffer for misspellings")))
+
(define-key ispell-menu-map [ispell-complete-word]
`(menu-item ,(purecopy "Complete Word") ispell-complete-word
+ :visible (not (string= ispell-program-name "NSSpellChecker"))
:help ,(purecopy "Complete word at cursor using dictionary")))
(define-key ispell-menu-map [ispell-complete-word-interior-frag]
`(menu-item ,(purecopy "Complete Word Fragment")
ispell-complete-word-interior-frag
+ :visible (not (string= ispell-program-name "NSSpellChecker"))
:help ,(purecopy "Complete word fragment at cursor")))))
;;;###autoload
@@ -1559,13 +2192,15 @@ The variable `ispell-library-directory' defines their location."
(marker-position ispell-region-end)
(equal (marker-buffer ispell-region-end)
(current-buffer)))
+ :visible (not (string= ispell-program-name "NSSpellChecker"))
:help ,(purecopy "Continue spell checking last region")))
(define-key ispell-menu-map [ispell-word]
`(menu-item ,(purecopy "Spell-Check Word") ispell-word
+ :visible (not (string= ispell-program-name "NSSpellChecker"))
:help ,(purecopy "Spell-check word at cursor")))
(define-key ispell-menu-map [ispell-comments-and-strings]
- `(menu-item ,(purecopy "Spell-Check Comments")
- ispell-comments-and-strings
+ `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings
+ :visible (not (string= ispell-program-name "NSSpellChecker"))
:help ,(purecopy "Spell-check only comments and strings")))))
;;;###autoload
@@ -1574,15 +2209,35 @@ The variable `ispell-library-directory' defines their location."
(define-key ispell-menu-map [ispell-region]
`(menu-item ,(purecopy "Spell-Check Region") ispell-region
:enable mark-active
+ :visible (not (string= ispell-program-name "NSSpellChecker"))
:help ,(purecopy "Spell-check text in marked region")))
(define-key ispell-menu-map [ispell-message]
`(menu-item ,(purecopy "Spell-Check Message") ispell-message
- :visible (eq major-mode 'mail-mode)
+ :visible (and (eq major-mode 'mail-mode)
+ (not (string= ispell-program-name
+ "NSSpellChecker")))
:help ,(purecopy "Skip headers and included message text")))
(define-key ispell-menu-map [ispell-buffer]
- `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer
+ `(menu-item ,(purecopy "Spell-Check Buffer") spellcheck-now
+ :visible (not (string= ispell-program-name "NSSpellChecker"))
:help ,(purecopy "Check spelling of selected buffer")))
;;(put 'ispell-region 'menu-enable 'mark-active)
+
+ (define-key ispell-menu-map [nsspellchecker-panel-hide]
+ `(menu-item ,(purecopy "Hide Spelling Panel") spellchecker-panel-or-ispell
+ :visible (and (string= ispell-program-name "NSSpellChecker")
+ (ns-spellchecker-panel-visible-p))
+ :help ,(purecopy "Toggle OS X spellcheck panel visibility")))
+ (define-key ispell-menu-map [nsspellchecker-panel-show]
+ `(menu-item ,(purecopy "Show Spelling Panel") spellchecker-panel-or-ispell
+ :visible (and (string= ispell-program-name "NSSpellChecker")
+ (not (ns-spellchecker-panel-visible-p)))
+ :help ,(purecopy "Toggle OS X spellcheck panel visibility")))
+ (define-key ispell-menu-map [nsspellcheck]
+ `(menu-item ,(purecopy "Spellcheck Now") spellcheck-now
+ :visible (string= ispell-program-name "NSSpellChecker")
+ :help ,(purecopy "Check spelling with OS X spellchecker")))
+
(fset 'ispell-menu-map (symbol-value 'ispell-menu-map))))
;;; XEmacs versions 19 & 20
@@ -1865,7 +2520,6 @@ Valid forms include:
("\\\\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)
@@ -2108,6 +2762,8 @@ quit spell session exited."
(or quietly
(message "Checking spelling of %s..."
(funcall ispell-format-word-function word)))
+ (if (string= ispell-program-name "NSSpellChecker")
+ (setq poss (ns-spellchecker-parse-output word))
(ispell-send-string "%\n") ; put in verbose mode
(ispell-send-string (concat "^" word "\n"))
;; wait until ispell has processed word
@@ -2119,7 +2775,7 @@ quit spell session exited."
(if (and ispell-filter (listp ispell-filter))
(if (> (length ispell-filter) 1)
(error "Ispell and its process have different character maps")
- (setq poss (ispell-parse-output (car ispell-filter)))))
+ (setq poss (ispell-parse-output (car ispell-filter))))))
(cond ((eq poss t)
(or quietly
(message "%s is correct"
@@ -2411,22 +3067,25 @@ Global `ispell-quit' set to start location to continue spell session."
(cond
((= char ? ) nil) ; accept word this time only
((= char ?i) ; accept and insert word into pers dict
+ (if (string= ispell-program-name "NSSpellChecker")
+ (ns-spellchecker-learn-word word)
(ispell-send-string (concat "*" word "\n"))
- (setq ispell-pdict-modified-p '(t)) ; dictionary modified!
+ (setq ispell-pdict-modified-p '(t))) ; dictionary modified!
(and (fboundp 'flyspell-unhighlight-at)
(flyspell-unhighlight-at start))
nil)
((or (= char ?a) (= char ?A)) ; accept word without insert
+ (if (string= ispell-program-name "NSSpellChecker")
+ (ns-spellchecker-ignore-word word (current-buffer))
(ispell-send-string (concat "@" word "\n"))
- (cl-pushnew word ispell-buffer-session-localwords
- :test #'equal)
+ (add-to-list 'ispell-buffer-session-localwords word)
(and (fboundp 'flyspell-unhighlight-at)
(flyspell-unhighlight-at start))
(or ispell-buffer-local-name ; session localwords might conflict
(setq ispell-buffer-local-name (buffer-name)))
(if (null ispell-pdict-modified-p)
(setq ispell-pdict-modified-p
- (list ispell-pdict-modified-p)))
+ (list ispell-pdict-modified-p))))
(if (= char ?A) 0)) ; return 0 for ispell-add buffer-local
((or (= char ?r) (= char ?R)) ; type in replacement
(and (eq 'block ispell-highlight-p) ; refresh tty's
@@ -2516,13 +3175,17 @@ Global `ispell-quit' set to start location to continue spell session."
'block))
t) ; reselect from new choices
((= char ?u) ; insert lowercase into dictionary
+ (if (string= ispell-program-name "NSSpellChecker")
+ (ns-spellchecker-learn-word (downcase word))
(ispell-send-string (concat "*" (downcase word) "\n"))
- (setq ispell-pdict-modified-p '(t)) ; dictionary modified!
+ (setq ispell-pdict-modified-p '(t))) ; dictionary modified!
nil)
((= char ?m) ; type in what to insert
+ (if (string= ispell-program-name "NSSpellChecker")
+ (ns-spellchecker-learn-word (read-string "Insert: " word))
(ispell-send-string
(concat "*" (read-string "Insert: " word) "\n"))
- (setq ispell-pdict-modified-p '(t))
+ (setq ispell-pdict-modified-p '(t)))
(cons word nil))
((and (>= num 0) (< num count))
(if ispell-query-replace-choices ; Query replace flag
@@ -2674,8 +3337,8 @@ SPC: Accept word this time.
(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
-\(usually \"grep\") used to search for the words.
+Otherwise the variable `ispell-grep-command' contains the command used to
+search for the words (usually egrep).
Optional second argument contains the dictionary to use; the default is
`ispell-alternate-dictionary', overridden by `ispell-complete-word-dict'
@@ -2752,7 +3415,7 @@ if defined."
;; 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)
@@ -2972,9 +3635,11 @@ Optional third arg SHIFT is an offset to apply based on previous corrections."
(defun ispell-process-status ()
"Return the status of the Ispell process.
When asynchronous processes are not supported, `run' is always returned."
+ (if (string= ispell-program-name "NSSpellChecker")
+ 'run
(if ispell-async-processp
(process-status ispell-process)
- (and ispell-process 'run)))
+ (and ispell-process 'run))))
(defun ispell-start-process ()
@@ -2993,12 +3658,17 @@ Keeps argument list for future Ispell invocations for no async support."
default-directory
;; Defend against bad `default-directory'.
(expand-file-name "~/")))
+ ;; cocoAspell dict basename is abbreviated version
+ (current-dict
+ (if (eq ispell-use-cocoaspell-internal 'full)
+ (aspell-dict-abbrev ispell-current-dictionary)
+ ispell-current-dictionary))
(orig-args (ispell-get-ispell-args))
(args
(append
(if (and ispell-current-dictionary ; Not for default dict (nil)
(not (member "-d" orig-args))) ; Only define if not overridden.
- (list "-d" ispell-current-dictionary))
+ (list "-d" current-dict))
orig-args
(if ispell-current-personal-dictionary ; Use specified pers dict.
(list "-p" ispell-current-personal-dictionary))
@@ -3032,13 +3702,14 @@ Keeps argument list for future Ispell invocations for no async support."
(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) ;FIXME: Unused?
+ (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
@@ -3074,7 +3745,7 @@ Keeps argument list for future Ispell invocations for no async support."
(ispell-kill-ispell t)
(message "Starting new Ispell process %s with %s dictionary..."
ispell-program-name
- (or ispell-local-dictionary ispell-dictionary "default"))
+ (or ispell-local-dictionary ispell-dictionary-internal "default"))
(sit-for 0)
(setq ispell-library-directory (ispell-check-version)
;; Assign a non-nil value to ispell-process-directory
@@ -3141,7 +3812,7 @@ Keeps argument list for future Ispell invocations for no async support."
;; 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
@@ -3194,23 +3865,26 @@ Without a prefix arg, set it \"locally\", just for this buffer.
By just answering RET you can find out what the current dictionary is."
(interactive
+ (let ((completion-ignore-case t))
(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))
+ current-prefix-arg)))
(ispell-set-spellchecker-params) ; Initialize variables and dicts alists
(unless arg (ispell-buffer-local-dict 'no-reload))
(if (equal dict "default") (setq dict nil))
;; This relies on completing-read's bug of returning "" for no match
- (cond ((equal dict "")
+ (cond ((and (equal dict nil) (string= ispell-program-name "NSSpellChecker"))
+ (setq ispell-dictionary-internal (ns-spellchecker-current-language)))
+ ((equal dict "")
(ispell-internal-change-dictionary)
(message "Using %s dictionary"
(or (and (not arg) ispell-local-dictionary)
- ispell-dictionary "default")))
+ ispell-dictionary-internal "default")))
((equal dict (or (and (not arg) ispell-local-dictionary)
- ispell-dictionary "default"))
+ ispell-dictionary-internal "default"))
;; Specified dictionary is the default already. Could reload
;; the dictionaries if needed.
(ispell-internal-change-dictionary)
@@ -3223,7 +3897,8 @@ By just answering RET you can find out what the current dictionary is."
(assoc dict ispell-dictionary-alist))
(if arg
;; set default dictionary
- (setq ispell-dictionary dict)
+ (setq ispell-dictionary dict
+ ispell-dictionary-internal dict)
;; set local dictionary
(setq ispell-local-dictionary dict)
(setq ispell-local-dictionary-overridden t))
@@ -3238,15 +3913,15 @@ By just answering RET you can find out what the current dictionary is."
"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))
- (expanded-pdict (if pdict (expand-file-name pdict))))
+ (let ((dict (or ispell-local-dictionary ispell-dictionary-internal))
+ (pdict (or ispell-local-pdict ispell-personal-dictionary)))
(unless (and (equal ispell-current-dictionary dict)
- (equal ispell-current-personal-dictionary
- expanded-pdict))
+ (equal ispell-current-personal-dictionary pdict))
(ispell-kill-ispell t)
(setq ispell-current-dictionary dict
- ispell-current-personal-dictionary expanded-pdict))))
+ ispell-current-personal-dictionary pdict)
+ (if (string= ispell-program-name "NSSpellChecker")
+ (ns-spellchecker-set-language dict)))))
;; Avoid error messages when compiling for these dynamic variables.
(defvar ispell-start)
@@ -3403,7 +4078,7 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r
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
@@ -3611,6 +4286,8 @@ Returns the sum SHIFT due to changes in word replacements."
(if (not (numberp shift))
(setq shift 0))
;; send string to spell process and get input.
+ (if (string= ispell-program-name "NSSpellChecker")
+ (setq ispell-filter (nreverse (ispell-ns-spellcheck-string string)))
(ispell-send-string string)
(while (progn
(ispell-accept-output)
@@ -3618,11 +4295,17 @@ Returns the sum SHIFT due to changes in word replacements."
(not (string= "" (car ispell-filter)))))
;; parse all inputs from the stream one word at a time.
;; Place in FIFO order and remove the blank item.
- (setq ispell-filter (nreverse (cdr ispell-filter)))
+ (setq ispell-filter (nreverse (cdr ispell-filter))))
(while (and (not ispell-quit) ispell-filter)
;; get next word, accounting for accepted words and start shifts
- (setq poss (ispell-parse-output (car ispell-filter)
- accept-list shift))
+ (setq poss (if (string= ispell-program-name "NSSpellChecker")
+ ;; add shift to offset from ispell-ns-spellcheck-string
+ (progn
+ (setcar (cdr (car ispell-filter))
+ (+ shift (cadr (car ispell-filter))))
+ (car ispell-filter))
+ (ispell-parse-output (car ispell-filter)
+ accept-list shift)))
(if (and poss (listp poss)) ; spelling error occurred.
;; Whenever we have misspellings, we can change
;; the buffer. Keep boundaries as markers.
@@ -3860,7 +4543,7 @@ Standard ispell choices are then available."
(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)
@@ -4094,10 +4777,10 @@ 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 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:
@@ -4246,6 +4929,9 @@ You can bind this to the key C-c i in GNUS or mail by adding to
(defun ispell-accept-buffer-local-defs ()
"Load all buffer-local information, restarting Ispell when necessary."
+ (if (string= ispell-program-name "NSSpellChecker")
+ (setq ispell-current-dictionary
+ (or ispell-local-dictionary ispell-dictionary-internal)))
(ispell-buffer-local-dict) ; May kill ispell-process.
(ispell-buffer-local-words) ; Will initialize ispell-process.
(ispell-buffer-local-parsing))
@@ -4256,7 +4942,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to
Overrides the default parsing mode.
Includes LaTeX/Nroff modes and extended character mode."
;; (ispell-init-process) must already be called.
- (ispell-send-string "!\n") ; Put process in terse mode.
+ (if (not (string= ispell-program-name "NSSpellChecker"))
+ (ispell-send-string "!\n")) ; Put process in terse mode.
;; We assume all major modes with "tex-mode" in them should use latex parsing
;; When exclusively checking comments, set to raw text mode (nroff).
(if (and (not (eq 'exclusive ispell-check-comments))
@@ -4265,16 +4952,19 @@ Includes LaTeX/Nroff modes and extended character mode."
(symbol-name major-mode)))
(eq ispell-parser 'tex)))
(progn
- (ispell-send-string "+\n") ; set ispell mode to tex
+ (if (not (string= ispell-program-name "NSSpellChecker"))
+ (ispell-send-string "+\n")) ; set ispell mode to tex
(if (not (eq ispell-parser 'tex))
(set (make-local-variable 'ispell-parser) 'tex)))
- (ispell-send-string "-\n")) ; set mode to normal (nroff)
+ (if (not (string= ispell-program-name "NSSpellChecker"))
+ (ispell-send-string "-\n"))) ; set mode to normal (nroff)
;; If needed, test for SGML & HTML modes and set a buffer local nil/t value.
(if (and ispell-skip-html (not (eq ispell-skip-html t)))
(setq ispell-skip-html
(not (null (string-match "sgml\\|html\\|xml"
(downcase (symbol-name major-mode)))))))
;; Set default extended character mode for given buffer, if any.
+ (when (not (string= ispell-program-name "NSSpellChecker"))
(let ((extended-char-mode (ispell-get-extended-character-mode)))
(if extended-char-mode
(ispell-send-string (concat extended-char-mode "\n"))))
@@ -4297,7 +4987,7 @@ Includes LaTeX/Nroff modes and extended character mode."
((string-match "~" string) ; Set extended character mode.
(ispell-send-string (concat string "\n")))
(t (message "Invalid Ispell Parsing argument!")
- (sit-for 2))))))))
+ (sit-for 2)))))))))
;; Can kill the current ispell process
@@ -4345,12 +5035,13 @@ Both should not be used to define a buffer-local dictionary."
(ispell-kill-ispell t))
;; Actually start a new ispell process, because we need
;; to send commands now to specify the local words to it.
+ (if (not (string= ispell-program-name "NSSpellChecker"))
(ispell-init-process)
(dolist (session-localword ispell-buffer-session-localwords)
(ispell-send-string (concat "@" session-localword "\n")))
(or ispell-buffer-local-name
(if ispell-buffer-session-localwords
- (setq ispell-buffer-local-name (buffer-name))))
+ (setq ispell-buffer-local-name (buffer-name)))))
(save-excursion
(goto-char (point-min))
(while (search-forward ispell-words-keyword nil t)
@@ -4367,7 +5058,13 @@ Both should not be used to define a buffer-local dictionary."
;; Error handling needs to be added between ispell and Emacs.
(if (and (< 1 (length string))
(equal 0 (string-match ispell-casechars string)))
- (ispell-send-string (concat "@" string "\n"))))))))
+ (if (string= ispell-program-name "NSSpellChecker")
+ (progn
+ ;; dummy spellcheck to ensure that NSSpellChecker
+ ;; is initialized
+ (ns-spellchecker-check-spelling "test")
+ (ns-spellchecker-ignore-word string (current-buffer)))
+ (ispell-send-string (concat "@" string "\n")))))))))
;; Returns optionally adjusted region-end-point.
@@ -4419,7 +5116,6 @@ Both should not be used to define a buffer-local dictionary."
(insert comment-end)))))
(insert (concat " " word))))))))
-;;FIXME: Use `user-error' instead!
(add-to-list 'debug-ignored-errors "^No word found to check!$")
(provide 'ispell)
diff --git a/src/nsfns.m b/src/nsfns.m
index ea09908..2ce5ab9 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -1095,6 +1095,363 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side
========================================================================== */
+/* Spelling */
+
+DEFUN ("ns-popup-spellchecker-panel", Fns_popup_spellchecker_panel, Sns_popup_spellchecker_panel,
+ 0, 0, "",
+ doc: /* Pop up the spell checking panel.
+Shows the NS spell checking panel and brings it to the front.*/)
+ (void)
+{
+ id sc;
+
+ check_window_system (NULL);
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ block_input();
+ [[sc spellingPanel] orderFront: NSApp];
+
+ // Spelling panel should appear with previous content, not empty.
+ // [sc updateSpellingPanelWithMisspelledWord:@""]; // no word, no spelling errors
+
+ // found here: http://trac.webkit.org/changeset/19670
+ // // FIXME 4811447: workaround for lack of API
+ // NSSpellChecker *spellChecker = [NSSpellChecker sharedSpellChecker];
+ // does not work
+ // if ([sc respondsToSelector:@selector(_updateGrammar)])
+ // [sc performSelector:@selector(_updateGrammar)];
+ unblock_input();
+ return Qnil;
+}
+
+DEFUN ("ns-close-spellchecker-panel", Fns_close_spellchecker_panel, Sns_close_spellchecker_panel,
+ 0, 0, "",
+ doc: /* Close the spell checking panel.*/)
+ (void)
+{
+ id sc;
+
+ check_window_system (NULL);
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ block_input();
+ [[sc spellingPanel] close];
+
+ unblock_input();
+ return Qnil;
+}
+
+DEFUN ("ns-spellchecker-panel-visible-p", Fns_spellchecker_panel_visible_p, Sns_spellchecker_panel_visible_p,
+ 0, 0, "",
+ doc: /* Return t if spellchecking panel is visible,
+nil otherwise.*/)
+ (void)
+{
+ id sc;
+ BOOL visible;
+
+ check_window_system (NULL);
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ block_input();
+ visible = [[sc spellingPanel] isVisible];
+
+ unblock_input();
+ return visible ? Qt : Qnil;
+}
+
+
+DEFUN ("ns-spellchecker-show-word", Fns_spellchecker_show_word, Sns_spellchecker_show_word,
+ 1, 1, 0,
+ doc: /* Show word WORD in the spellchecking panel.
+Give empty string to delete word.*/)
+ (str)
+ Lisp_Object str;
+{
+ id sc;
+
+ CHECK_STRING (str);
+ check_window_system (NULL);
+ block_input();
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ [sc updateSpellingPanelWithMisspelledWord:[NSString stringWithUTF8String: SDATA (str)]]; // no word, no spelling errors
+
+ unblock_input();
+ return Qnil;
+}
+
+
+DEFUN ("ns-spellchecker-learn-word", Fns_spellchecker_learn_word, Sns_spellchecker_learn_word,
+ 1, 1, 0,
+ doc: /* Learn word WORD.
+Returns learned word if successful.
+Not available on 10.4.*/)
+ (str)
+ Lisp_Object str;
+{
+ CHECK_STRING (str);
+ check_window_system (NULL);
+ block_input();
+ id sc = [NSSpellChecker sharedSpellChecker];
+
+#ifdef NS_IMPL_COCOA
+ if ([sc respondsToSelector:@selector(learnWord:)]) // (NSAppKitVersionNumber >= 824.0)
+ {
+
+ [sc learnWord:[NSString stringWithUTF8String: SDATA (str)]];
+ unblock_input();
+ return str;
+ }
+#endif
+ unblock_input();
+ return Qnil;
+}
+
+
+DEFUN ("ns-spellchecker-ignore-word", Fns_spellchecker_ignore_word, Sns_spellchecker_ignore_word,
+ 1, 2, 0,
+ doc: /* Ignore word WORD in buffer BUFFER.*/)
+ (str, buffer)
+ Lisp_Object str, buffer;
+{
+ id sc;
+
+ CHECK_STRING (str);
+ check_window_system (NULL);
+ block_input();
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ NSInteger tag = 1;
+ if (! NILP (buffer))
+ {
+ tag = sxhash (buffer, 0);
+ }
+
+ [sc ignoreWord:[NSString stringWithUTF8String: SDATA (str)] inSpellDocumentWithTag:tag];
+ unblock_input();
+ return Qnil;
+}
+
+
+DEFUN ("ns-spellchecker-ignored-words", Fns_spellchecker_ignored_words, Sns_spellchecker_ignored_words,
+ 1, 1, 0,
+ doc: /* Return list of words ignored by NSSpellChecker
+for buffer BUFFER */)
+ (buffer)
+ Lisp_Object buffer;
+{
+ id sc;
+
+ check_window_system (NULL);
+ block_input();
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ NSInteger tag = 1;
+ if (! NILP (buffer))
+ {
+ tag = sxhash (buffer, 0);
+ }
+
+ Lisp_Object retval = Qnil;
+ NSArray *words = [sc ignoredWordsInSpellDocumentWithTag:tag];
+ int arrayCount = [words count];
+ int i;
+ for (i = 0; i < arrayCount; i++) {
+ // build Lisp list of strings
+ retval = Fcons (build_string ([[words objectAtIndex:i] UTF8String]),
+ retval);
+ }
+ unblock_input();
+ return retval;
+}
+
+
+DEFUN ("ns-spellchecker-check-spelling", Fns_spellchecker_check_spelling, Sns_spellchecker_check_spelling,
+ 1, 2, 0,
+ doc: /* Check spelling of STRING
+Returns the location of the first misspelled word in a
+cons cell of form (beginning . length), or nil if all
+words are spelled as in the dictionary.*/)
+ (string, buffer)
+ Lisp_Object string, buffer;
+{
+ id sc;
+
+ CHECK_STRING (string);
+ check_window_system (NULL);
+ block_input();
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ /* NSRange first_word = nil; // Invalid initializer! NSRange is a struct */
+ NSInteger tag = 1;
+ if (! NILP (buffer) )
+ {
+ tag = sxhash (buffer, 0);
+ }
+
+ /* unfinished -
+ if ([sc respondsToSelector:@selector(checkString:range:types:options:inSpellDocumentWithTag:orthography:wordCount:)])
+ {
+ NSString *nsString = [NSString stringWithUTF8String: SDATA (string)];
+ NSArray *spelling_result = [sc
+ checkString:nsString
+ range:NSMakeRange(0,[nsString size]-1)
+ types:NSTextCheckingAllSystemTypes - NSTextCheckingTypeGrammar
+ options:nil
+ inSpellDocumentWithTag:tag
+ orthography:nil // difficult to produce
+ wordCount:nil];
+
+ } else */
+ // {
+
+ NSRange first_word = [sc checkSpellingOfString:[NSString stringWithUTF8String: SDATA (string)] startingAt:((NSInteger) 0)
+ language:nil wrap:NO inSpellDocumentWithTag:tag wordCount:nil];
+
+ // }
+ unblock_input();
+ if (first_word.location == NSNotFound || (int) first_word.location < 0)
+ return Qnil;
+ else
+ return Fcons (make_number (first_word.location), make_number (first_word.length));
+}
+
+
+DEFUN ("ns-spellchecker-check-grammar", Fns_spellchecker_check_grammar, Sns_spellchecker_check_grammar,
+ 1, 2, 0,
+ doc: /* Check spelling of SENTENCE.
+BUFFER, if given, idenitifies the document containing list
+of ignored grammatical constructions. */)
+ (sentence, buffer)
+ Lisp_Object sentence, buffer;
+{
+ id sc;
+
+ CHECK_STRING (sentence);
+ check_window_system (NULL);
+ block_input();
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ NSInteger tag = 1;
+ if (! NILP (buffer) )
+ {
+ tag = sxhash (buffer, 0);
+ }
+
+ NSArray *errdetails;
+
+ /* to do: use long version */
+ NSRange first_word = [sc checkGrammarOfString: [NSString stringWithUTF8String: SDATA (sentence)] startingAt:((NSInteger) 0)
+ language:nil wrap:NO inSpellDocumentWithTag:tag details:&errdetails];
+
+ unblock_input();
+ if (first_word.length == 0) // Is this how "no location" is indicated?
+ return Qnil;
+ else
+ return Fcons (make_number ((int) first_word.location), make_number ((int) first_word.length));
+}
+
+
+DEFUN ("ns-spellchecker-get-suggestions", Fns_spellchecker_get_suggestions, Sns_spellchecker_get_suggestions,
+ 1, 1, 0,
+ doc: /* Get suggestions for WORD.
+If word contains all capital letters, or its first
+letter is capitalized, the suggested words are
+capitalized in the same way. */)
+ (word)
+ Lisp_Object word;
+{
+ id sc;
+
+ CHECK_STRING (word);
+ check_window_system (NULL);
+ block_input();
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ Lisp_Object retval = Qnil;
+ NSArray *guesses = [sc guessesForWord: [NSString stringWithUTF8String: SDATA (word)]];
+ int arrayCount = [guesses count];
+ int i = arrayCount;
+ while (--i >= 0)
+ retval = Fcons (build_string ([[guesses objectAtIndex:i] UTF8String]),
+ retval);
+ unblock_input();
+ return retval;
+}
+
+
+DEFUN ("ns-spellchecker-list-languages", Fns_spellchecker_list_languages, Sns_spellchecker_list_languages,
+ 0, 0, 0,
+ doc: /* Get all available spell-checking languages.
+Returns nil if not successful.*/)
+ (void)
+{
+ id sc;
+ Lisp_Object retval = Qnil;
+
+ check_window_system (NULL);
+ block_input();
+ sc = [NSSpellChecker sharedSpellChecker];
+
+#ifdef NS_IMPL_COCOA
+ if ([sc respondsToSelector:@selector(availableLanguages)]) // (NSAppKitVersionNumber >= 824.0)
+ {
+ NSArray *langs = [sc availableLanguages];
+ int arrayCount = [langs count];
+ int i;
+ for (i = 0; i < arrayCount; i++) {
+ // build Lisp list of strings
+ retval = Fcons (build_string ([[langs objectAtIndex:i] UTF8String]),
+ retval);
+ }
+ }
+#endif
+ unblock_input();
+ return retval;
+}
+
+
+DEFUN ("ns-spellchecker-current-language", Fns_spellchecker_current_language, Sns_spellchecker_current_language,
+ 0, 0, 0,
+ doc: /* Get the current spell-checking language.*/)
+ (void)
+{
+ id sc;
+
+ check_window_system (NULL);
+ block_input();
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ Lisp_Object retval = Qnil;
+ NSString *lang = [sc language];
+ retval = build_string ([lang UTF8String]);
+
+ unblock_input();
+ return retval;
+}
+
+
+DEFUN ("ns-spellchecker-set-language", Fns_spellchecker_set_language, Sns_spellchecker_set_language,
+ 1, 1, 0,
+ doc: /* Set spell-checking language.
+LANGUAGE must be one of the languages returned by
+`ns-spellchecker-list-langauges'.*/)
+ (language)
+ Lisp_Object language;
+{
+ id sc;
+
+ CHECK_STRING (language);
+ check_window_system (NULL);
+ block_input();
+ sc = [NSSpellChecker sharedSpellChecker];
+
+ [sc setLanguage: [NSString stringWithUTF8String: SDATA (language)]];
+ unblock_input();
+ return Qnil;
+}
+
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1, 1, 0,
doc: /* Make a new Nextstep window, called a "frame" in Emacs terms.
@@ -3136,6 +3493,20 @@ - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename
doc: /* Toolkit version for NS Windowing. */);
Vns_version_string = ns_appkit_version_str ();
+ defsubr (&Sns_popup_spellchecker_panel);
+ defsubr (&Sns_close_spellchecker_panel);
+ defsubr (&Sns_spellchecker_panel_visible_p);
+ defsubr (&Sns_spellchecker_learn_word);
+ defsubr (&Sns_spellchecker_ignore_word);
+ defsubr (&Sns_spellchecker_ignored_words);
+ defsubr (&Sns_spellchecker_show_word);
+ defsubr (&Sns_spellchecker_check_spelling);
+ defsubr (&Sns_spellchecker_check_grammar);
+ defsubr (&Sns_spellchecker_get_suggestions);
+ defsubr (&Sns_spellchecker_list_languages);
+ defsubr (&Sns_spellchecker_current_language);
+ defsubr (&Sns_spellchecker_set_language);
+
defsubr (&Sns_read_file_name);
defsubr (&Sns_get_resource);
defsubr (&Sns_set_resource);
diff --git a/src/nsterm.h b/src/nsterm.h
index c2285c9..904017e 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -759,6 +759,8 @@ extern EmacsMenu *mainMenu, *svcsMenu, *dockMenu;
#define KEY_NS_NEW_FRAME ((1<<28)|(0<<16)|12)
#define KEY_NS_TOGGLE_TOOLBAR ((1<<28)|(0<<16)|13)
#define KEY_NS_SHOW_PREFS ((1<<28)|(0<<16)|14)
+#define KEY_NS_CHECK_SPELLING ((1<<28)|(0<<16)|20)
+#define KEY_NS_SPELLING_CHANGE ((1<<28)|(0<<16)|21)
/* could use list to store these, but rest of emacs has a big infrastructure
for managing a table of bitmap "records" */
diff --git a/src/nsterm.m b/src/nsterm.m
index f2b0d90..4fc21d4 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -5727,6 +5727,54 @@ - (void)changeFont: (id)sender
}
+/* called on spelling text change (part of NSChangeSpelling protocol) */
+- (void)changeSpelling: (id)sender
+{
+ NSEvent *e =[[self window] currentEvent];
+
+ NSTRACE (changeSpelling);
+ if (!emacs_event)
+ return;
+
+ /* SET_FRAME_GARBAGED (emacsframe); needed? */
+
+ emacs_event->kind = NS_NONKEY_EVENT;
+ emacs_event->modifiers = 0;
+ emacs_event->code = KEY_NS_SPELLING_CHANGE;
+ ns_spelling_text = build_string ([[[(NSControl*)sender selectedCell] stringValue] UTF8String]);
+ EV_TRAILER (e);
+}
+
+- (void)ignoreSpelling:(id)sender {
+ NSInteger tag = sxhash (Fcurrent_buffer (), 0);
+
+ [[NSSpellChecker sharedSpellChecker] ignoreWord:[[sender selectedCell] stringValue]
+ inSpellDocumentWithTag: tag];
+
+ /* Note (To Do): To make the ignored words feature useful, the
+ application must store a document’s ignored words list with the
+ document. See the NSSpellChecker class description for more
+ information. [From Apple's Cocoa documentation]*/
+}
+
+
+/* Find Next button */
+- (void)checkSpelling:(id)sender {
+ NSEvent *e =[[self window] currentEvent];
+
+ NSTRACE (checkSpelling);
+ if (!emacs_event)
+ return;
+
+ SET_FRAME_GARBAGED (emacsframe);
+
+ emacs_event->kind = NS_NONKEY_EVENT;
+ emacs_event->modifiers = 0;
+ emacs_event->code = KEY_NS_CHECK_SPELLING;
+ EV_TRAILER (e);
+}
+
+
- (BOOL)acceptsFirstResponder
{
NSTRACE ("[EmacsView acceptsFirstResponder]");
@@ -8683,6 +8731,10 @@ Convert an X font name (XLFD) to an NS font name.
"String for visualizing working composition sequence.");
ns_working_text =Qnil;
+ DEFVAR_LISP ("ns-spelling-text", ns_spelling_text,
+ "The substitute text corresponding to the ns-spelling-change event.");
+ ns_spelling_text =Qnil;
+
DEFVAR_LISP ("ns-input-font", ns_input_font,
"The font specified in the last NS event.");
ns_input_font =Qnil;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment