# HG changeset patch # User John Wiegley # Date 1084020529 0 # Node ID 2f1fd122c9fe939e3bba7b03c48fb719f18c5449 # Parent b278cb498cc8bd0f7506c562ab89cd11cb82783c 2004-05-08 John Wiegley * textmodes/flyspell.el (flyspell-highlight-incorrect-region): Ignore the read-only property when flyspell highlighting is on. Not ignoring it leads to a series of confusing errors. (flyspell-highlight-duplicate-region): Ignore read-only, as above, but also make sure to call flyspell-incorrect-hook. (flyspell-maybe-correct-transposition): Perform transposition test by bit twiddling a string, rather than using a temp buffer. (flyspell-maybe-correct-doubling): Use a string rather than a temp buffer. This is also the original version of the code, which could not be checked in before due to a previous lack of assignment papers. This version has seen heavy usage on my system for several years now. diff -r b278cb498cc8 -r 2f1fd122c9fe lisp/textmodes/flyspell.el --- a/lisp/textmodes/flyspell.el Sat May 08 12:42:07 2004 +0000 +++ b/lisp/textmodes/flyspell.el Sat May 08 12:48:49 2004 +0000 @@ -1516,46 +1516,51 @@ ;*---------------------------------------------------------------------*/ (defun flyspell-highlight-incorrect-region (beg end poss) "Set up an overlay on a misspelled word, in the buffer from BEG to END." - (unless (run-hook-with-args-until-success - 'flyspell-incorrect-hook beg end poss) - (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) - (progn - ;; we cleanup current overlay at the same position - (if (and (not flyspell-persistent-highlight) - (overlayp flyspell-overlay)) - (delete-overlay flyspell-overlay) - (let ((overlays (overlays-at beg))) - (while (consp overlays) - (if (flyspell-overlay-p (car overlays)) - (delete-overlay (car overlays))) - (setq overlays (cdr overlays))))) - ;; now we can use a new overlay - (setq flyspell-overlay - (make-flyspell-overlay beg end - 'flyspell-incorrect-face - 'highlight)))))) + (let ((inhibit-read-only t)) + (unless (run-hook-with-args-until-success + 'flyspell-incorrect-hook beg end poss) + (if (or flyspell-highlight-properties + (not (flyspell-properties-at-p beg))) + (progn + ;; we cleanup current overlay at the same position + (if (and (not flyspell-persistent-highlight) + (overlayp flyspell-overlay)) + (delete-overlay flyspell-overlay) + (let ((overlays (overlays-at beg))) + (while (consp overlays) + (if (flyspell-overlay-p (car overlays)) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays))))) + ;; now we can use a new overlay + (setq flyspell-overlay + (make-flyspell-overlay + beg end 'flyspell-incorrect-face 'highlight))))))) ;*---------------------------------------------------------------------*/ ;* flyspell-highlight-duplicate-region ... */ ;*---------------------------------------------------------------------*/ (defun flyspell-highlight-duplicate-region (beg end) "Set up an overlay on a duplicated word, in the buffer from BEG to END." - (if (or flyspell-highlight-properties (not (flyspell-properties-at-p beg))) - (progn - ;; we cleanup current overlay at the same position - (if (and (not flyspell-persistent-highlight) - (overlayp flyspell-overlay)) - (delete-overlay flyspell-overlay) - (let ((overlays (overlays-at beg))) - (while (consp overlays) - (if (flyspell-overlay-p (car overlays)) - (delete-overlay (car overlays))) - (setq overlays (cdr overlays))))) - ;; now we can use a new overlay - (setq flyspell-overlay - (make-flyspell-overlay beg end - 'flyspell-duplicate-face - 'highlight))))) + (let ((inhibit-read-only t)) + (unless (run-hook-with-args-until-success + 'flyspell-incorrect-hook beg end poss) + (if (or flyspell-highlight-properties + (not (flyspell-properties-at-p beg))) + (progn + ;; we cleanup current overlay at the same position + (if (and (not flyspell-persistent-highlight) + (overlayp flyspell-overlay)) + (delete-overlay flyspell-overlay) + (let ((overlays (overlays-at beg))) + (while (consp overlays) + (if (flyspell-overlay-p (car overlays)) + (delete-overlay (car overlays))) + (setq overlays (cdr overlays))))) + ;; now we can use a new overlay + (setq flyspell-overlay + (make-flyspell-overlay beg end + 'flyspell-duplicate-face + 'highlight))))))) ;*---------------------------------------------------------------------*/ ;* flyspell-auto-correct-cache ... */ @@ -2061,23 +2066,23 @@ This function is meant to be added to 'flyspell-incorrect-hook'." (when (consp poss) - (let ((temp-buffer (get-buffer-create " *flyspell-temp*")) - found) - (save-excursion - (copy-to-buffer temp-buffer beg end) - (set-buffer temp-buffer) - (goto-char (1+ (point-min))) - (while (and (not (eobp)) (not found)) - (transpose-chars 1) - (if (member (buffer-string) (nth 2 poss)) - (setq found (point)) - (transpose-chars -1) - (forward-char)))) - (when found - (save-excursion - (goto-char (+ beg found -1)) - (transpose-chars -1) - t))))) + (catch 'done + (let ((str (buffer-substring beg end)) + (i 0) (len (- end beg)) tmp) + (while (< (1+ i) len) + (setq tmp (aref str i)) + (aset str i (aref str (1+ i))) + (aset str (1+ i) tmp) + (when (member str (nth 2 poss)) + (save-excursion + (goto-char (+ beg i 1)) + (transpose-chars 1)) + (throw 'done t)) + (setq tmp (aref str i)) + (aset str i (aref str (1+ i))) + (aset str (1+ i) tmp) + (setq i (1+ i)))) + nil))) (defun flyspell-maybe-correct-doubling (beg end poss) "Check replacements for doubled characters. @@ -2091,24 +2096,19 @@ This function is meant to be added to 'flyspell-incorrect-hook'." (when (consp poss) - (let ((temp-buffer (get-buffer-create " *flyspell-temp*")) - found) - (save-excursion - (copy-to-buffer temp-buffer beg end) - (set-buffer temp-buffer) - (goto-char (1+ (point-min))) - (while (and (not (eobp)) (not found)) - (when (char-equal (char-after) (char-before)) - (delete-char 1) - (if (member (buffer-string) (nth 2 poss)) - (setq found (point)) - (insert-char (char-before) 1))) - (forward-char))) - (when found - (save-excursion - (goto-char (+ beg found -1)) - (delete-char 1) - t))))) + (catch 'done + (let ((str (buffer-substring beg end)) + (i 0) (len (- end beg))) + (while (< (1+ i) len) + (when (and (= (aref str i) (aref str (1+ i))) + (member (concat (substring str 0 (1+ i)) + (substring str (+ i 2))) + (nth 2 poss))) + (goto-char (+ beg i)) + (delete-char 1) + (throw 'done t)) + (setq i (1+ i)))) + nil))) ;*---------------------------------------------------------------------*/ ;* flyspell-already-abbrevp ... */