comparison lisp/textmodes/ispell.el @ 10697:d2fd1a6288b4

Personal dictionary save forced when called from menu, Epoch compile support. (ispell-skip-sgml): Added variable for skipping SGML tags & references. (ispell-buffer-local-parsing): Hard wire set of ispell-skip-sgml-tags to sgml-mode. (ispell-pdict-save): Message improvement. (ispell-command-loop): Properly adjust screen with different settings of ispell-choices-win-default-height. (check-ispell-version): Use fundamental-mode as default-major-mode. (ispell-change-dictionary): Remove unnecessary process kills (ispell-region): Fold sgml support in with tib checking. (ispell-message): Skips checking of forwarded messages.

10696:5cf8a7a41664

;;;
;;; Copyright (C) 1994 Free Software Foundation, Inc.
;;;
;;;
;;; Authors         : Ken Stevens <[e-mail]>
;;; Last Modified On: Thu Dec  8 13:17:41 EST 1994
;;; Update Revision : 2.34
;;; Syntax          : emacs-lisp
;;; Status	    : Release with 3.1.12+ ispell.
;;; Version	    : International Ispell Version 3.1 by Geoff Kuenning.
;;; Bug Reports	    : [e-mail]
;;;

;;; BUGS:
;;;  Highlighting in version 19 still doesn't work on tty's.
;;;  On some versions of emacs, growing the minibuffer fails.
;;;
;;; HISTORY
;;;
;;; Revision 2.34  1994/12/08 13:17:41  stevens
;;; Interaction corrected to function with all 3.1 ispell versions.
;;;
;;; Revision 2.33  1994/11/24 02:31:20  stevens

      (define-key ispell-menu-map [ispell-change-dictionary]
	'("Change Dictionary" . ispell-change-dictionary))
      (define-key ispell-menu-map [ispell-kill-ispell]
	'("Kill Process" . ispell-kill-ispell))
      (define-key ispell-menu-map [ispell-pdict-save]
	'("Save Dictionary" . (lambda () (interactive) (ispell-pdict-save t))))
      (define-key ispell-menu-map [ispell-complete-word]
	'("Complete Word" . ispell-complete-word))
      (define-key ispell-menu-map [ispell-complete-word-interior-frag]
	'("Complete Word Frag" . ispell-complete-word-interior-frag))))

	     ["Continue Check"	ispell-continue			t]
	     ["Complete Word Frag"ispell-complete-word-interior-frag t]
	     ["Complete Word"	ispell-complete-word		t]
	     ["Kill Process"	ispell-kill-ispell		t]
	     "-"
	     ["Save Dictionary"	(ispell-pdict-save t)		t]
	     ["Change Dictionary" ispell-change-dictionary	t]))
	  name)
      (while dicts
	(setq name (car (car dicts))
	      dicts (cdr dicts))

`nroff-mode' to put the current buffer into the desired parsing mode.

Extended character mode can be changed for this buffer by placing
a `~' followed by an extended-character mode -- such as `~.tex'.")

(defvar ispell-local-pdict ispell-personal-dictionary
  "A buffer local variable containing the current personal dictionary.
If non-nil, the value must be a string, which is a file name.

If you specify a personal dictionary for the current buffer which is

;;; **********************************************************************
;;; **********************************************************************


(if (string-lessp "19" emacs-version)
    (defalias 'ispell 'ispell-buffer))

;;;###autoload (define-key global-map "\M-$" 'ispell-word)

;;;###autoload
(defun ispell-word (&optional following quietly continue)

  (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? "))
	  (process-send-string ispell-process "#\n")))
  ;; unassert variable, even if not saved to avoid questioning.
  (setq ispell-pdict-modified-p nil))


(defun ispell-command-loop (miss guess word start end)

    (if (not (pos-visible-in-window-p end))
	(sit-for 0))
    ;; Display choices for misspelled word.
    (let ((choices-window (get-buffer-window ispell-choices-buffer)))
      (if choices-window
	  (if (not (equal line (window-height choices-window)))
	      ;; *Choices* window changed size.  Adjust the choices window
	      ;; without scrolling the spelled window when possible
	      (let ((window-line (- line (window-height choices-window)))
		    (visible (progn (forward-line -1) (point))))
		(move-to-window-line 0)
		(forward-line window-line)
		(set-window-start (selected-window)
				  (if (> (point) visible) visible (point)))
		(goto-char end)
		(select-window (previous-window)) ; *Choices* window
		(enlarge-window window-line))
	    (select-window choices-window))
	;; Overlay *Choices* window when it isn't showing
	(ispell-overlay-window (max line ispell-choices-win-default-height)))
      (switch-to-buffer ispell-choices-buffer)
      (goto-char (point-min)))

				(insert "(" count ") " (car choices) "  ")
				(setq choices (cdr choices)
				      count (1+ count)))
			      (setq count (- count ?0 skipped)))
			    (select-window (previous-window))
			    (if (/= new-line line)
				(progn
				  (if (> new-line line)
				      (enlarge-window (- new-line line))
				    (shrink-window (- line new-line)))
				  (setq line new-line)))
			    (select-window (next-window)))))
		    t)			; reselect from new choices
		   ((= char ?u)
		    (process-send-string ispell-process

  ;; email to prove it) so I think this is worthwhile.  And the -v[ersion]
  ;; option is the only way I can think of to do this that works with
  ;; all versions, since versions earlier than 3.0.09 didn't identify
  ;; themselves on startup.
  (save-excursion
    (set-buffer (get-buffer-create " *ispell-tmp*"))
    (erase-buffer)
    ;; Avoid obscure bugs caused by users who change the syntax of `.' in
    ;; whatever default major mode the user uses, e.g. text mode.
    (fundamental-mode)
    (let ((status (call-process ispell-program-name nil t nil "-v"))
	  (case-fold-search t))
      (goto-char (point-min))
      (if (not (memq status '(0 nil)))
	  (error "%s exited with %s %s" ispell-program-name
		 (if (stringp status) "signal" "code") status))
      (if (not (re-search-forward

    (setq ispell-process nil)
    (message "Ispell process killed")
    nil))


;;;###autoload
(defun ispell-change-dictionary (dict &optional arg)
  "Change `ispell-dictionary' (q.v.) and kill old Ispell process.
A new one will be started as soon as necessary.

  ;; This relies on completing-read's bug of returning "" for no match
  (cond ((equal dict "")
	 (message "Using %s dictionary"
		  (or ispell-local-dictionary ispell-dictionary "default")))
	((and (equal dict ispell-dictionary)
	      (equal dict ispell-local-dictionary))
	 ;; Specified dictionary is the default already.  No-op
	 (message "No change, using %s dictionary" (or dict "default")))
	(t				; reset dictionary!
	 (if (assoc dict ispell-dictionary-alist)
	     (progn
	       (if (or arg (null dict))	; set default dictionary
		   (setq ispell-dictionary dict))

		     (buffer-name) "region")
		 (or ispell-dictionary "default"))
	;; Returns cursor to original location.
	(save-window-excursion
	  (goto-char reg-start)
	  (let ((transient-mark-mode nil))
	    (while (and (not ispell-quit) (< (point) reg-end))
	      (let ((start (point))
		    (offset-change 0)
		    (end (save-excursion (end-of-line) (min (point) reg-end)))
		    (ispell-casechars (ispell-get-casechars))

			  (setq string
				(concat "^" (buffer-substring start limit)
					"\n")
				offset-change (- offset-change ispell-offset)))
		      (goto-char limit))))
		 ((and ispell-skip-tib	; SKIP TIB REFERENCES!
		       (re-search-forward ispell-tib-ref-beginning end t))
		  (if (= (- (point) 2) start) ; tib ref is 2 chars.
		      ;; Skip to end of tib ref, not necessarily on this line.
		      ;; Return an error if tib ref not found
		      (if (not(re-search-forward ispell-tib-ref-end reg-end t))
			  (progn
			    (ispell-pdict-save ispell-silently-savep)
			    (ding)
			    (message
			     (concat
			      "Open tib reference--set `ispell-skip-tib'"
			      " to nil to avoid this error"))
			    ;; keep cursor at error location
			    (setq ispell-quit (- (point) 2))))
		    ;; tib ref starts later on line. Check spelling before tib.
		    (let ((limit (- (point) 2)))
		      (goto-char start)
		      (if (or (re-search-forward ispell-casechars limit t)
			      (re-search-forward "[][()$]" limit t))
			  (setq string
				(concat "^" (buffer-substring start limit)
					"\n")
				offset-change (- offset-change ispell-offset)))
		      (goto-char limit))))
		 ((looking-at "[---#@*+!%~^]") ; SKIP SPECIAL ISPELL CHARACTERS
		  (forward-char 1))
		 ((or (re-search-forward ispell-casechars end t) ; TEXT EXISTS
		      (re-search-forward "[][()$]" end t)) ; or MATH COMMANDS
		  (setq string (concat "^" (buffer-substring start end) "\n")
			offset-change (- offset-change ispell-offset))
		  (goto-char end))

      (while (< (point) limit)
	;; Skip across text cited from other messages.
	(while (and (looking-at cite-regexp-start)
		    (< (point) limit)
		    (zerop (forward-line 1))))
	(if (< (point) limit)
	    ;; Check the next batch of lines that *aren't* cited.
	    (let ((end (save-excursion
			 (if (re-search-forward cite-regexp-end limit 'end)
			     (match-beginning 0)
			   (marker-position limit)))))
	      (ispell-region (point) end)
	      (goto-char end))))
      (set-marker limit nil))))


(defun ispell-non-empty-string (string)
  (if (or (not string) (string-equal string ""))

  (if (or (and (eq ispell-parser 'use-mode-name)
	       (string-match "[Tt][Ee][Xx]-mode" (symbol-name major-mode)))
	  (eq ispell-parser 'tex))
      (process-send-string ispell-process "+\n") ; set ispell mode to tex
    (process-send-string ispell-process "-\n"))	; set mode to normal (nroff)
  ;; Set default extended character mode for given buffer, if any.
  (let ((extended-char-mode (ispell-get-extended-character-mode)))
    (if extended-char-mode
	(process-send-string ispell-process (concat extended-char-mode "\n"))))
  ;; Set buffer-local parsing mode and extended character mode, if specified.

		  (setq reg-end (+ 1 reg-end (length word))))
	      (insert (concat " " word)))))))
  reg-end)


(defconst ispell-version "2.34 -- Thu Dec  8 13:17:41 EST 1994")

(provide 'ispell)


;;; LOCAL VARIABLES AND BUFFER-LOCAL VALUE EXAMPLES.

10697:d2fd1a6288b4

;;;
;;; Copyright (C) 1994 Free Software Foundation, Inc.
;;;
;;;
;;; Authors         : Ken Stevens <[e-mail]>
;;; Last Modified On: Mon Feb  6 17:39:38 EST 1995
;;; Update Revision : 2.36
;;; Syntax          : emacs-lisp
;;; Status	    : Release with 3.1.12+ ispell.
;;; Version	    : International Ispell Version 3.1 by Geoff Kuenning.
;;; Bug Reports	    : [e-mail]
;;;

;;; BUGS:
;;;  Highlighting in version 19 still doesn't work on tty's.
;;;  On some versions of emacs, growing the minibuffer fails.
;;;
;;; HISTORY
;;;
;;; Revision 2.36  1995/2/6 17:39:38	stevens
;;; Properly adjust screen with different ispell-choices-win-default-height
;;; settings.  Skips SGML entity references.
;;;
;;; Revision 2.35  1995/1/13 14:16:46	stevens
;;; Skips SGML tags, ispell-change-dictionary fix for add-hook, assure personal
;;; dictionary is saved when called from the menu
;;;
;;; Revision 2.34  1994/12/08 13:17:41  stevens
;;; Interaction corrected to function with all 3.1 ispell versions.
;;;
;;; Revision 2.33  1994/11/24 02:31:20  stevens

      (define-key ispell-menu-map [ispell-change-dictionary]
	'("Change Dictionary" . ispell-change-dictionary))
      (define-key ispell-menu-map [ispell-kill-ispell]
	'("Kill Process" . ispell-kill-ispell))
      (define-key ispell-menu-map [ispell-pdict-save]
	'("Save Dictionary" . (lambda () (interactive) (ispell-pdict-save t t))))
      (define-key ispell-menu-map [ispell-complete-word]
	'("Complete Word" . ispell-complete-word))
      (define-key ispell-menu-map [ispell-complete-word-interior-frag]
	'("Complete Word Frag" . ispell-complete-word-interior-frag))))

	     ["Continue Check"	ispell-continue			t]
	     ["Complete Word Frag"ispell-complete-word-interior-frag t]
	     ["Complete Word"	ispell-complete-word		t]
	     ["Kill Process"	ispell-kill-ispell		t]
	     "-"
	     ["Save Dictionary"	(ispell-pdict-save t t)		t]
	     ["Change Dictionary" ispell-change-dictionary	t]))
	  name)
      (while dicts
	(setq name (car (car dicts))
	      dicts (cdr dicts))

`nroff-mode' to put the current buffer into the desired parsing mode.

Extended character mode can be changed for this buffer by placing
a `~' followed by an extended-character mode -- such as `~.tex'.")

(defvar ispell-skip-sgml nil
  "Skips spell checking of SGML tags and entity references when non-nil.
This variable is set when major-mode is sgml-mode.")

;;;###autoload
(defvar ispell-local-pdict ispell-personal-dictionary
  "A buffer local variable containing the current personal dictionary.
If non-nil, the value must be a string, which is a file name.

If you specify a personal dictionary for the current buffer which is

;;; **********************************************************************
;;; **********************************************************************


(and (string-lessp "19" emacs-version)
     (not (boundp 'epoch::version))
     (defalias 'ispell 'ispell-buffer))

;;;###autoload (define-key global-map "\M-$" 'ispell-word)

;;;###autoload
(defun ispell-word (&optional following quietly continue)

  (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
	    (process-send-string ispell-process "#\n")
	    (message "Personal dictionary saved."))))
  ;; unassert variable, even if not saved to avoid questioning.
  (setq ispell-pdict-modified-p nil))


(defun ispell-command-loop (miss guess word start end)

    (if (not (pos-visible-in-window-p end))
	(sit-for 0))
    ;; Display choices for misspelled word.
    (let ((choices-window (get-buffer-window ispell-choices-buffer)))
      (if choices-window
	  (if (= line (window-height choices-window))
	      (select-window choices-window)
	    ;; *Choices* window changed size.  Adjust the choices window
	    ;; without scrolling the spelled window when possible
	    (let ((window-line (- line (window-height choices-window)))
		  (visible (progn (forward-line -1) (point))))
	      (if (< line ispell-choices-win-default-height)
		  (setq window-line (+ window-line
				       (- ispell-choices-win-default-height
					  line))))
	      (move-to-window-line 0)
	      (forward-line window-line)
	      (set-window-start (selected-window)
				(if (> (point) visible) visible (point)))
	      (goto-char end)
	      (select-window (previous-window)) ; *Choices* window
	      (enlarge-window window-line)))
	;; Overlay *Choices* window when it isn't showing
	(ispell-overlay-window (max line ispell-choices-win-default-height)))
      (switch-to-buffer ispell-choices-buffer)
      (goto-char (point-min)))

				(insert "(" count ") " (car choices) "  ")
				(setq choices (cdr choices)
				      count (1+ count)))
			      (setq count (- count ?0 skipped)))
			    (select-window (previous-window))
			    (if (and (/= new-line line)
				     (> (max line new-line)
					ispell-choices-win-default-height))
				(let* ((minh ispell-choices-win-default-height)
				       (gr-bl (if (< line minh) ; blanks
						  (- minh line)
						0))
				       (shr-bl (if (< new-line minh) ; blanks
						   (- minh new-line)
						 0)))
				  (if (> new-line line)
				      (enlarge-window (- new-line line gr-bl))
				    (shrink-window (- line new-line shr-bl)))
				  (setq line new-line)))
			    (select-window (next-window)))))
		    t)			; reselect from new choices
		   ((= char ?u)
		    (process-send-string ispell-process

  ;; email to prove it) so I think this is worthwhile.  And the -v[ersion]
  ;; option is the only way I can think of to do this that works with
  ;; all versions, since versions earlier than 3.0.09 didn't identify
  ;; themselves on startup.
  (save-excursion
    (let ((case-fold-search t)
	  ;; avoid bugs when syntax of `.' changes in various default modes
	  (default-major-mode 'fundamental-mode)
	  status)
      (set-buffer (get-buffer-create " *ispell-tmp*"))
      (erase-buffer)
      (setq status (call-process ispell-program-name nil t nil "-v"))
      (goto-char (point-min))
      (if (not (memq status '(0 nil)))
	  (error "%s exited with %s %s" ispell-program-name
		 (if (stringp status) "signal" "code") status))
      (if (not (re-search-forward

    (setq ispell-process nil)
    (message "Ispell process killed")
    nil))


;;; ispell-change-dictionary is set in some people's hooks.  Maybe it should
;;;  call ispell-init-process rather than wait for a spell checking command?

;;;###autoload
(defun ispell-change-dictionary (dict &optional arg)
  "Change `ispell-dictionary' (q.v.) and kill old Ispell process.
A new one will be started as soon as necessary.

  ;; This relies on completing-read's bug of returning "" for no match
  (cond ((equal dict "")
	 (message "Using %s dictionary"
		  (or ispell-local-dictionary ispell-dictionary "default")))
	((and (equal dict ispell-dictionary)
	      (or (null ispell-local-dictionary)
		  (equal dict ispell-local-dictionary)))
	 ;; Specified dictionary is the default already.  No-op
	 (and (interactive-p)
	      (message "No change, using %s dictionary" (or dict "default"))))
	(t				; reset dictionary!
	 (if (assoc dict ispell-dictionary-alist)
	     (progn
	       (if (or arg (null dict))	; set default dictionary
		   (setq ispell-dictionary dict))

		     (buffer-name) "region")
		 (or ispell-dictionary "default"))
	;; Returns cursor to original location.
	(save-window-excursion
	  (goto-char reg-start)
	  (let ((transient-mark-mode nil)
		ref-type)
	    (while (and (not ispell-quit) (< (point) reg-end))
	      (let ((start (point))
		    (offset-change 0)
		    (end (save-excursion (end-of-line) (min (point) reg-end)))
		    (ispell-casechars (ispell-get-casechars))

			  (setq string
				(concat "^" (buffer-substring start limit)
					"\n")
				offset-change (- offset-change ispell-offset)))
		      (goto-char limit))))
		 ((looking-at "[---#@*+!%~^]") ; SKIP SPECIAL ISPELL CHARACTERS
		  (forward-char 1))
		 ((or (and ispell-skip-tib ; SKIP TIB REFERENCES OR SGML MARKUP
			   (re-search-forward ispell-tib-ref-beginning end t)
			   (setq ref-type 'tib))
		      (and ispell-skip-sgml
			   (search-forward "[<&]" end t)
			   (setq ref-type 'sgml)))
		  (if (or (and (eq 'tib ref-type) ; tib tag is 2 chars.
			       (= (- (point) 2) start))
			  (and (eq 'sgml ref-type) ; sgml skips 1 char.
			       (= (- (point) 1) start)))
		      ;; Skip to end of reference, not necessarily on this line
		      ;; Return an error if tib/sgml reference not found
		      (if (or
			   (and
			    (eq 'tib ref-type)
			    (not
			     (re-search-forward ispell-tib-ref-end reg-end t)))
			   (and (eq 'sgml ref-type)
				(not (search-forward "[>;]" reg-end t))))
			  (progn
			    (ispell-pdict-save ispell-silently-savep)
			    (ding)
			    (message
			     (concat
			      "Open tib or SGML command.  Fix buffer or set "
			      (if (eq 'tib ref-type)
				  "ispell-skip-tib"
				"ispell-skip-sgml")
			      " to nil"))
			    ;; keep cursor at error location
			    (setq ispell-quit (- (point) 2))))
		    ;; Check spelling between reference and start of the line.
		    (let ((limit (- (point) (if (eq 'tib ref-type) 2 1))))
		      (goto-char start)
		      (if (or (re-search-forward ispell-casechars limit t)
			      (re-search-forward "[][()$]" limit t))
			  (setq string
				(concat "^" (buffer-substring start limit)
					"\n")
				offset-change (- offset-change ispell-offset)))
		      (goto-char limit))))
		 ((or (re-search-forward ispell-casechars end t) ; TEXT EXISTS
		      (re-search-forward "[][()$]" end t)) ; or MATH COMMANDS
		  (setq string (concat "^" (buffer-substring start end) "\n")
			offset-change (- offset-change ispell-offset))
		  (goto-char end))

      (while (< (point) limit)
	;; Skip across text cited from other messages.
	(while (and (looking-at cite-regexp-start)
		    (< (point) limit)
		    (zerop (forward-line 1))))

	(if (< (point) limit)
	    (let* ((start (point))
		   ;; Check the next batch of lines that *aren't* cited.
		   (end-c (and (re-search-forward cite-regexp-end limit 'end)
			       (match-beginning 0)))
		   ;; skip a forwarded message
		   (end-fwd (and (goto-char start)
				 (re-search-forward "---* Forwarded Message"
						    limit 'end)))
		   (end (or (and end-c end-fwd (min end-c end-fwd))
			    end-c end-fwd
			    ;; defalut to limit of text.
			    (marker-position limit))))
	      (goto-char start)
	      (ispell-region start end)
	      (if (and end-fwd (= end end-fwd))
		  (progn
		    (goto-char end)
		    (search-forward "--- End of Forwarded Message" limit 'end))
		(goto-char end)))))
      (set-marker limit nil))))


(defun ispell-non-empty-string (string)
  (if (or (not string) (string-equal string ""))

  (if (or (and (eq ispell-parser 'use-mode-name)
	       (string-match "[Tt][Ee][Xx]-mode" (symbol-name major-mode)))
	  (eq ispell-parser 'tex))
      (process-send-string ispell-process "+\n") ; set ispell mode to tex
    (process-send-string ispell-process "-\n"))	; set mode to normal (nroff)
  ;; Hard-wire test for SGML mode.
  (setq ispell-skip-sgml (eq 'sgml-mode major-mode))
  ;; Set default extended character mode for given buffer, if any.
  (let ((extended-char-mode (ispell-get-extended-character-mode)))
    (if extended-char-mode
	(process-send-string ispell-process (concat extended-char-mode "\n"))))
  ;; Set buffer-local parsing mode and extended character mode, if specified.

		  (setq reg-end (+ 1 reg-end (length word))))
	      (insert (concat " " word)))))))
  reg-end)


(defconst ispell-version "2.36 -- Mon Feb  6 17:39:38 EST 1995")

(provide 'ispell)


;;; LOCAL VARIABLES AND BUFFER-LOCAL VALUE EXAMPLES.