]> code.delx.au - gnu-emacs/blobdiff - lisp/textmodes/ispell.el
Merge from emacs-24; up to 2012-12-17T11:17:34Z!rgm@gnu.org
[gnu-emacs] / lisp / textmodes / ispell.el
index 0c7966f22d3f10aa04d78ca729a62720b21d7e37..dbcf3910db80cfa65423ce7fe946ad7451ace13c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
 
-;; Copyright (C) 1994-1995, 1997-201 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-2013 Free Software Foundation, Inc.
 
 ;; Author:           Ken Stevens <k.stevens@ieee.org>
 ;; Maintainer:       Ken Stevens <k.stevens@ieee.org>
@@ -357,6 +357,10 @@ Must be greater than 1."
       "ispell")
   "Program invoked by \\[ispell-word] and \\[ispell-region] commands."
   :type 'string
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (if (featurep 'ispell)
+             (ispell-set-spellchecker-params)))
   :group 'ispell)
 
 (defcustom ispell-alternate-dictionary
@@ -769,6 +773,41 @@ here just for backwards compatibility.")
 (make-obsolete-variable 'ispell-aspell-supports-utf8
                         'ispell-encoding8-command "23.1")
 
+(defvar ispell-hunspell-dictionary-equivs-alist
+  '(("american"      "en_US")
+    ("brasileiro"    "pt_BR")
+    ("british"       "en_GB")
+    ("castellano"    "es_ES")
+    ("castellano8"   "es_ES")
+    ("czech"         "cs_CZ")
+    ("dansk"         "da_DK")
+    ("deutsch"       "de_DE")
+    ("deutsch8"      "de_DE")
+    ("english"       "en_US")
+    ("esperanto"     "eo")
+    ("esperanto-tex" "eo")
+    ("finnish"       "fi_FI")
+    ("francais7"     "fr_FR")
+    ("francais"      "fr_FR")
+    ("francais-tex"  "fr_FR")
+    ("german"        "de_DE")
+    ("german8"       "de_DE")
+    ("italiano"      "it_IT")
+    ("nederlands"    "nl_NL")
+    ("nederlands8"   "nl_NL")
+    ("norsk"         "nn_NO")
+    ("norsk7-tex"    "nn_NO")
+    ("polish"        "pl_PL")
+    ("portugues"     "pt_PT")
+    ("russian"       "ru_RU")
+    ("russianw"      "ru_RU")
+    ("slovak"        "sk_SK")
+    ("slovenian"     "sl_SI")
+    ("svenska"       "sv_SE")
+    ("hebrew"        "he_IL"))
+  "Alist with matching hunspell dict names for standard dict names in
+  `ispell-dictionary-base-alist'.")
+
 (defvar ispell-emacs-alpha-regexp
   (if (string-match "^[[:alpha:]]+$" "abcde")
       "[[:alpha:]]"
@@ -903,6 +942,24 @@ Otherwise returns the library directory name, if that is defined."
       (setq default-directory (expand-file-name "~/")))
     (apply 'call-process-region args)))
 
+(defun ispell-create-debug-buffer (&optional append)
+  "Create an ispell debug buffer for debugging output.
+Use APPEND to append the info to previous buffer if exists,
+otherwise is reset.  Returns name of ispell debug buffer.
+See `ispell-buffer-with-debug' for an example of use."
+  (let ((ispell-debug-buffer (get-buffer-create "*ispell-debug*")))
+    (with-current-buffer ispell-debug-buffer
+      (if append
+         (insert
+          (format "-----------------------------------------------\n"))
+       (erase-buffer)))
+    ispell-debug-buffer))
+
+(defsubst ispell-print-if-debug (string)
+  "Print STRING to `ispell-debug-buffer' buffer if enabled."
+  (if (boundp 'ispell-debug-buffer)
+      (with-current-buffer ispell-debug-buffer
+       (insert string))))
 
 
 ;; The preparation of the menu bar menu must be autoloaded
@@ -1112,9 +1169,57 @@ aspell is used along with Emacs).")
                    ispell-encoding8-command)
               ispell-aspell-dictionary-alist
             nil))
+         (ispell-dictionary-base-alist ispell-dictionary-base-alist)
          ispell-base-dicts-override-alist ; Override only base-dicts-alist
          all-dicts-alist)
 
+      ;; While ispell and aspell (through aliases) use the traditional
+      ;; dict naming originally expected by ispell.el, hunspell
+      ;; uses locale based names with no alias.  We need to map
+      ;; standard names to locale based names to make default dict
+      ;; definitions available for hunspell.
+      (if ispell-really-hunspell
+         (let (tmp-dicts-alist)
+           (dolist (adict ispell-dictionary-base-alist)
+             (let* ((dict-name (nth 0 adict))
+                    (dict-equiv
+                     (cadr (assoc dict-name
+                                  ispell-hunspell-dictionary-equivs-alist)))
+                    (ispell-args (nth 5 adict))
+                    (ispell-args-has-d (member "-d" ispell-args))
+                    skip-dict)
+               ;; Remove "-d" option from `ispell-args' if present
+               (if ispell-args-has-d
+                   (let ((ispell-args-after-d
+                          (cdr (cdr ispell-args-has-d)))
+                         (ispell-args-before-d
+                          (butlast ispell-args (length ispell-args-has-d))))
+                     (setq ispell-args
+                           (nconc ispell-args-before-d
+                                  ispell-args-after-d))))
+               ;; Unless default dict, re-add "-d" option with the mapped value
+               (if dict-name
+                   (if dict-equiv
+                       (nconc ispell-args (list "-d" dict-equiv))
+                     (message
+                      "ispell-set-spellchecker-params: Missing hunspell equiv for \"%s\". Skipping."
+                      dict-name)
+                     (setq skip-dict t)))
+
+               (unless skip-dict
+                 (add-to-list 'tmp-dicts-alist
+                              (list
+                               dict-name      ; dict name
+                               (nth 1 adict)  ; casechars
+                               (nth 2 adict)  ; not-casechars
+                               (nth 3 adict)  ; otherchars
+                               (nth 4 adict)  ; many-otherchars-p
+                               ispell-args    ; ispell-args
+                               (nth 6 adict)  ; extended-character-mode
+                               (nth 7 adict)  ; dict encoding
+                               ))))
+             (setq ispell-dictionary-base-alist tmp-dicts-alist))))
+
       (run-hooks 'ispell-initialize-spellchecker-hook)
 
       ;; Add dicts to ``ispell-dictionary-alist'' unless already present.
@@ -1127,7 +1232,8 @@ aspell is used along with Emacs).")
 
     ;; If Emacs flavor supports [:alpha:] use it for global dicts.  If
     ;; spellchecker also supports UTF-8 via command-line option use it
-    ;; in communication.  This does not affect definitions in ~/.emacs.
+    ;; in communication.  This does not affect definitions in your
+    ;; init file.
     (if ispell-emacs-alpha-regexp
        (let (tmp-dicts-alist)
          (dolist (adict ispell-dictionary-alist)
@@ -1571,8 +1677,8 @@ You can set this variable in hooks in your init file -- eg:
 
 (defun ispell-accept-output (&optional timeout-secs timeout-msecs)
   "Wait for output from ispell process, or TIMEOUT-SECS and TIMEOUT-MSECS.
-If asynchronous subprocesses are not supported, call `ispell-filter' and
-pass it the output of the last ispell invocation."
+If asynchronous subprocesses are not supported, call function `ispell-filter'
+and pass it the output of the last ispell invocation."
   (if ispell-async-processp
       (accept-process-output ispell-process timeout-secs timeout-msecs)
     (if (null ispell-process)
@@ -1892,11 +1998,14 @@ If so, ask if it needs to be saved."
   (interactive (list ispell-silently-savep t))
   (if (and ispell-pdict-modified-p (listp ispell-pdict-modified-p))
       (setq ispell-pdict-modified-p (car ispell-pdict-modified-p)))
-  (if (or ispell-pdict-modified-p force-save)
-      (if (or no-query (y-or-n-p "Personal dictionary modified.  Save? "))
-         (progn
-           (ispell-send-string "#\n")  ; save dictionary
-           (message "Personal dictionary saved."))))
+  (when (and (or ispell-pdict-modified-p force-save)
+            (or no-query
+                (y-or-n-p "Personal dictionary modified.  Save? ")))
+    (ispell-send-string "#\n") ; save dictionary
+    (message "Personal dictionary saved.")
+    (when flyspell-mode
+      (flyspell-mode 0)
+      (flyspell-mode 1)))
   ;; unassert variable, even if not saved to avoid questioning.
   (setq ispell-pdict-modified-p nil))
 
@@ -2623,11 +2732,8 @@ When asynchronous processes are not supported, `run' is always returned."
 (defun ispell-start-process ()
   "Start the Ispell process, with support for no asynchronous processes.
 Keeps argument list for future Ispell invocations for no async support."
-  ;; Local dictionary becomes the global dictionary in use.
-  (setq ispell-current-dictionary
-        (or ispell-local-dictionary ispell-dictionary))
-  (setq ispell-current-personal-dictionary
-        (or ispell-local-pdict ispell-personal-dictionary))
+  ;; `ispell-current-dictionary' and `ispell-current-personal-dictionary'
+  ;; are properly set in `ispell-internal-change-dictionary'.
   (let* ((default-directory
            (if (and (file-directory-p default-directory)
                     (file-readable-p default-directory))
@@ -2642,8 +2748,7 @@ Keeps argument list for future Ispell invocations for no async support."
                (list "-d" ispell-current-dictionary))
            orig-args
            (if ispell-current-personal-dictionary ; Use specified pers dict.
-               (list "-p"
-                     (expand-file-name ispell-current-personal-dictionary)))
+               (list "-p" ispell-current-personal-dictionary))
            ;; If we are using recent aspell or hunspell, make sure we use the
            ;; right encoding for communication. ispell or older aspell/hunspell
            ;; does not support this.
@@ -2680,6 +2785,9 @@ Keeps argument list for future Ispell invocations for no async support."
   (let* (;; Basename of dictionary used by the spell-checker
         (dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args))))
                         ispell-current-dictionary))
+        ;; The directory where process was started.
+        (current-ispell-directory default-directory)
+        ;; The default directory for the process.
         ;; Use "~/" as default-directory unless using Ispell with per-dir
         ;; personal dictionaries and not in a minibuffer under XEmacs
         (default-directory
@@ -2870,13 +2978,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)))
+  (let* ((dict (or ispell-local-dictionary ispell-dictionary))
+        (pdict (or ispell-local-pdict ispell-personal-dictionary))
+        (expanded-pdict (if pdict (expand-file-name pdict))))
     (unless (and (equal ispell-current-dictionary dict)
-                (equal ispell-current-personal-dictionary pdict))
+                (equal ispell-current-personal-dictionary
+                       expanded-pdict))
       (ispell-kill-ispell t)
       (setq ispell-current-dictionary dict
-           ispell-current-personal-dictionary pdict))))
+           ispell-current-personal-dictionary expanded-pdict))))
 
 ;; Avoid error messages when compiling for these dynamic variables.
 (defvar ispell-start)
@@ -2894,114 +3004,142 @@ amount for last line processed."
   (if (not recheckp)
       (ispell-accept-buffer-local-defs)) ; set up dictionary, local words, etc.
   (let ((skip-region-start (make-marker))
-       (rstart (make-marker)))
-  (unwind-protect
-      (save-excursion
-       (message "Spell-checking %s using %s with %s dictionary..."
-                (if (and (= reg-start (point-min)) (= reg-end (point-max)))
-                    (buffer-name) "region")
-                (file-name-nondirectory ispell-program-name)
-                (or ispell-current-dictionary "default"))
-       ;; Returns cursor to original location.
-       (save-window-excursion
-         (goto-char reg-start)
-         (let ((transient-mark-mode)
-               (case-fold-search case-fold-search)
-               (query-fcc t)
-               in-comment key)
-           (let (message-log-max)
-             (message "searching for regions to skip"))
-           (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t)
-               (progn
-                 (setq key (match-string-no-properties 0))
-                 (set-marker skip-region-start (- (point) (length key)))
-                 (goto-char reg-start)))
-           (let (message-log-max)
-             (message
-               "Continuing spelling check using %s with %s dictionary..."
-               (file-name-nondirectory ispell-program-name)
-               (or ispell-current-dictionary "default")))
-           (set-marker rstart reg-start)
-           (set-marker ispell-region-end reg-end)
-           (while (and (not ispell-quit)
-                       (< (point) ispell-region-end))
-             ;; spell-check region with skipping
-             (if (and (marker-position skip-region-start)
-                      (<= skip-region-start (point)))
+       (rstart (make-marker))
+       (region-type (if (and (= reg-start (point-min)) (= reg-end (point-max)))
+                        (buffer-name) "region"))
+       (program-basename (file-name-nondirectory ispell-program-name))
+       (dictionary (or ispell-current-dictionary "default")))
+    (unwind-protect
+       (save-excursion
+         (message "Spell-checking %s using %s with %s dictionary..."
+                  region-type program-basename dictionary)
+         ;; Returns cursor to original location.
+         (save-window-excursion
+           (goto-char reg-start)
+           (let ((transient-mark-mode)
+                 (case-fold-search case-fold-search)
+                 (query-fcc t)
+                 in-comment key)
+             (ispell-print-if-debug
+              (concat
+               (format
+                "ispell-region: (ispell-skip-region-list):\n%s\n"
+                (ispell-skip-region-list))
+               (format
+                "ispell-region: (ispell-begin-skip-region-regexp):\n%s\n"
+                (ispell-begin-skip-region-regexp))
+               "ispell-region: Search for first region to skip after (ispell-begin-skip-region-regexp)\n"))
+             (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t)
                  (progn
-                   ;; If region inside line comment, must keep comment start.
-                   (setq in-comment (point)
-                         in-comment
-                         (and comment-start
-                              (or (null comment-end) (string= "" comment-end))
-                              (save-excursion
-                                (beginning-of-line)
-                                (re-search-forward comment-start in-comment t))
-                              comment-start))
-                   ;; Can change skip-regexps (in ispell-message)
-                   (ispell-skip-region key) ; moves pt past region.
-                   (set-marker rstart (point))
-                   ;; check for saving large attachments...
-                   (setq query-fcc (and query-fcc
-                                        (ispell-ignore-fcc skip-region-start
-                                                           rstart)))
-                   (if (and (< rstart ispell-region-end)
-                            (re-search-forward
-                             (ispell-begin-skip-region-regexp)
-                             ispell-region-end t))
-                       (progn
-                         (setq key (match-string-no-properties 0))
-                         (set-marker skip-region-start
-                                     (- (point) (length key)))
-                         (goto-char rstart))
-                     (set-marker skip-region-start nil))))
-             (setq reg-end (max (point)
-                                (if (marker-position skip-region-start)
-                                    (min skip-region-start ispell-region-end)
-                                  (marker-position ispell-region-end))))
-             (let* ((ispell-start (point))
-                    (ispell-end (min (point-at-eol) reg-end))
-                    (string (ispell-get-line
-                              ispell-start ispell-end in-comment)))
-               (if in-comment          ; account for comment chars added
-                   (setq ispell-start (- ispell-start (length in-comment))
-                         in-comment nil))
-               (setq ispell-end (point)) ; "end" tracks region retrieved.
-               (if string              ; there is something to spell check!
-                   ;; (special start end)
-                   (setq shift (ispell-process-line string
-                                                    (and recheckp shift))))
-               (goto-char ispell-end)))))
-       (if ispell-quit
-           nil
-         (or shift 0)))
-    ;; protected
-    (if (and (not (and recheckp ispell-keep-choices-win))
-            (get-buffer ispell-choices-buffer))
-       (kill-buffer ispell-choices-buffer))
-    (set-marker skip-region-start nil)
-    (set-marker rstart nil)
-    (if ispell-quit
-       (progn
-         ;; preserve or clear the region for ispell-continue.
-         (if (not (numberp ispell-quit))
-             (set-marker ispell-region-end nil)
-           ;; Ispell-continue enabled - ispell-region-end is set.
-           (goto-char ispell-quit))
-         ;; Check for aborting
-         (if (and ispell-checking-message (numberp ispell-quit))
-             (progn
-               (setq ispell-quit nil)
-               (error "Message send aborted")))
-         (if (not recheckp) (setq ispell-quit nil)))
-      (if (not recheckp) (set-marker ispell-region-end nil))
-      ;; Only save if successful exit.
-      (ispell-pdict-save ispell-silently-savep)
-      (message "Spell-checking %s using %s with %s dictionary...done"
-              (if (and (= reg-start (point-min)) (= reg-end (point-max)))
-                  (buffer-name) "region")
-              (file-name-nondirectory ispell-program-name)
-              (or ispell-current-dictionary "default"))))))
+                   (setq key (match-string-no-properties 0))
+                   (set-marker skip-region-start (- (point) (length key)))
+                   (goto-char reg-start)
+                   (ispell-print-if-debug
+                    (format "ispell-region: First skip: %s at (pos,line,column): (%s,%s,%s).\n"
+                            key
+                            (save-excursion (goto-char skip-region-start) (point))
+                            (line-number-at-pos skip-region-start)
+                            (save-excursion (goto-char skip-region-start) (current-column))))))
+             (ispell-print-if-debug
+              (format
+               "ispell-region: Continue spell-checking with %s and %s dictionary...\n"
+               program-basename dictionary))
+             (set-marker rstart reg-start)
+             (set-marker ispell-region-end reg-end)
+             (while (and (not ispell-quit)
+                         (< (point) ispell-region-end))
+               ;; spell-check region with skipping
+               (if (and (marker-position skip-region-start)
+                        (<= skip-region-start (point)))
+                   (progn
+                     ;; If region inside line comment, must keep comment start.
+                     (setq in-comment (point)
+                           in-comment
+                           (and comment-start
+                                (or (null comment-end) (string= "" comment-end))
+                                (save-excursion
+                                  (beginning-of-line)
+                                  (re-search-forward comment-start in-comment t))
+                                comment-start))
+                     ;; Can change skip-regexps (in ispell-message)
+                     (ispell-skip-region key) ; moves pt past region.
+                     (set-marker rstart (point))
+                     ;; check for saving large attachments...
+                     (setq query-fcc (and query-fcc
+                                          (ispell-ignore-fcc skip-region-start
+                                                             rstart)))
+                     (if (and (< rstart ispell-region-end)
+                              (re-search-forward
+                               (ispell-begin-skip-region-regexp)
+                               ispell-region-end t))
+                         (progn
+                           (setq key (match-string-no-properties 0))
+                           (set-marker skip-region-start
+                                       (- (point) (length key)))
+                           (goto-char rstart)
+                           (ispell-print-if-debug
+                            (format "ispell-region: Next skip: %s at (pos,line,column): (%s,%s,%s).\n"
+                                    key
+                                    (save-excursion (goto-char skip-region-start) (point))
+                                    (line-number-at-pos skip-region-start)
+                                    (save-excursion (goto-char skip-region-start) (current-column)))))
+                       (set-marker skip-region-start nil))))
+               (setq reg-end (max (point)
+                                  (if (marker-position skip-region-start)
+                                      (min skip-region-start ispell-region-end)
+                                    (marker-position ispell-region-end))))
+               (let* ((ispell-start (point))
+                      (ispell-end (min (point-at-eol) reg-end))
+                      ;; See if line must be prefixed by comment string to let ispell know this is
+                      ;; part of a comment string.  This is only supported in some modes.
+                      ;; In particular, this is not supported in autoconf mode where adding the
+                      ;; comment string messes everything up because ispell tries to spellcheck the
+                      ;; `dnl' string header causing misalignments in some cases (debbugs.gnu.org: #12768).
+                      (add-comment (and in-comment
+                                        (not (string= in-comment "dnl "))
+                                        in-comment))
+                      (string (ispell-get-line
+                               ispell-start ispell-end add-comment)))
+                 (ispell-print-if-debug
+                  (format
+                   "ispell-region: string pos (%s->%s), eol: %s, [in-comment]: [%s], [add-comment]: [%s], [string]: [%s]\n"
+                   ispell-start ispell-end (point-at-eol) in-comment add-comment string))
+                 (if add-comment               ; account for comment chars added
+                     (setq ispell-start (- ispell-start (length add-comment))
+                           add-comment nil))
+                 (setq ispell-end (point)) ; "end" tracks region retrieved.
+                 (if string            ; there is something to spell check!
+                     ;; (special start end)
+                     (setq shift (ispell-process-line string
+                                                      (and recheckp shift))))
+                 (goto-char ispell-end)))))
+         (if ispell-quit
+             nil
+           (or shift 0)))
+      ;; protected
+      (if (and (not (and recheckp ispell-keep-choices-win))
+              (get-buffer ispell-choices-buffer))
+         (kill-buffer ispell-choices-buffer))
+      (set-marker skip-region-start nil)
+      (set-marker rstart nil)
+      (if ispell-quit
+         (progn
+           ;; preserve or clear the region for ispell-continue.
+           (if (not (numberp ispell-quit))
+               (set-marker ispell-region-end nil)
+             ;; Ispell-continue enabled - ispell-region-end is set.
+             (goto-char ispell-quit))
+           ;; Check for aborting
+           (if (and ispell-checking-message (numberp ispell-quit))
+               (progn
+                 (setq ispell-quit nil)
+                 (error "Message send aborted")))
+           (if (not recheckp) (setq ispell-quit nil)))
+       (if (not recheckp) (set-marker ispell-region-end nil))
+       ;; Only save if successful exit.
+       (ispell-pdict-save ispell-silently-savep)
+       (message "Spell-checking %s using %s with %s dictionary...done"
+                region-type program-basename dictionary)))))
 
 
 (defun ispell-begin-skip-region-regexp ()
@@ -3248,10 +3386,19 @@ Returns the sum SHIFT due to changes in word replacements."
            ;; Alignment cannot be tracked and this error will occur when
            ;; `query-replace' makes multiple corrections on the starting line.
            (or (ispell-looking-at (car poss))
-               ;; This occurs due to filter pipe problems
-               (error (concat "Ispell misalignment: word "
-                              "`%s' point %d; probably incompatible versions")
-                      (car poss) (marker-position word-start)))
+               ;; This error occurs due to filter pipe problems
+               (let* ((ispell-pipe-word (car poss))
+                      (actual-point (marker-position word-start))
+                      (actual-line (line-number-at-pos actual-point))
+                      (actual-column (save-excursion (goto-char actual-point) (current-column))))
+                 (ispell-print-if-debug
+                  (concat
+                   "ispell-process-line: Ispell misalignment error:\n"
+                   (format "  [Word from ispell pipe]: [%s], actual (point,line,column): (%s,%s,%s)\n"
+                           ispell-pipe-word actual-point actual-line actual-column)))
+                 (error (concat "Ispell misalignment: word "
+                                "`%s' point %d; probably incompatible versions")
+                        ispell-pipe-word actual-point)))
            ;; ispell-cmd-loop can go recursive & change buffer
            (if ispell-keep-choices-win
                (setq replace (ispell-command-loop
@@ -3385,6 +3532,13 @@ Returns the sum SHIFT due to changes in word replacements."
   (interactive)
   (ispell-region (point-min) (point-max)))
 
+;;;###autoload
+(defun ispell-buffer-with-debug (&optional append)
+  "`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer.
+Use APPEND to append the info to previous buffer if exists."
+  (interactive)
+  (let ((ispell-debug-buffer (ispell-create-debug-buffer append)))
+    (ispell-buffer)))
 
 ;;;###autoload
 (defun ispell-continue ()
@@ -3680,7 +3834,7 @@ use the `x' command.  (Any subsequent regions will be checked.)
 The `X' command aborts sending the message so that you can edit the buffer.
 
 To spell-check whenever a message is sent, include the appropriate lines
-in your .emacs file:
+in your init file:
    (add-hook 'message-send-hook 'ispell-message)  ;; GNUS 5
    (add-hook 'news-inews-hook 'ispell-message)    ;; GNUS 4
    (add-hook 'mail-send-hook  'ispell-message)