From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Augusto Stoffel Newsgroups: gmane.emacs.bugs Subject: bug#61814: [RFC] Asynchronous, jit-lock-based Flyspell Date: Sun, 26 Feb 2023 15:56:00 +0100 Message-ID: <87wn44a327.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="4765"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) To: 61814@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Feb 26 15:57:34 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pWIT0-00013e-ED for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 26 Feb 2023 15:57:34 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pWISa-0006pD-S6; Sun, 26 Feb 2023 09:57:08 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pWISV-0006oU-7P for bug-gnu-emacs@gnu.org; Sun, 26 Feb 2023 09:57:06 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pWISU-0003pe-O3 for bug-gnu-emacs@gnu.org; Sun, 26 Feb 2023 09:57:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pWISU-0002MP-8d for bug-gnu-emacs@gnu.org; Sun, 26 Feb 2023 09:57:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Augusto Stoffel Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 26 Feb 2023 14:57:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 61814 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.16774233759061 (code B ref -1); Sun, 26 Feb 2023 14:57:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 26 Feb 2023 14:56:15 +0000 Original-Received: from localhost ([127.0.0.1]:44798 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pWIRi-0002M5-PL for submit@debbugs.gnu.org; Sun, 26 Feb 2023 09:56:15 -0500 Original-Received: from lists.gnu.org ([209.51.188.17]:48832) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pWIRf-0002KD-HB for submit@debbugs.gnu.org; Sun, 26 Feb 2023 09:56:14 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pWIRf-0006b9-2A for bug-gnu-emacs@gnu.org; Sun, 26 Feb 2023 09:56:11 -0500 Original-Received: from mail-ed1-x52e.google.com ([2a00:1450:4864:20::52e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pWIRc-0003dx-HH for bug-gnu-emacs@gnu.org; Sun, 26 Feb 2023 09:56:10 -0500 Original-Received: by mail-ed1-x52e.google.com with SMTP id s26so15745573edw.11 for ; Sun, 26 Feb 2023 06:56:04 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=mime-version:user-agent:message-id:date:subject:to:from:from:to:cc :subject:date:message-id:reply-to; bh=k/FI0Q2pWdOXHBaClL2KYxWhkhF5JmCSeTjlapfIyH4=; b=SFi7Plqo/u0ZGG+KvqtWnVYSX1A6+fSDN+8u+LN2vyEwiJ+dJPakJFvtDvLPJsy0Hr 5/lODoXysMdhycHwFieA9laJSryQl4Z2rUFVjXxqkSQawhvl3dDCzJJIKC4PSIFlojYl 2nLltAes/BbC6VHCLSfnX/a5RxjzYGT2aKwxaWW8oY3p0ctFj0mhsRx7Fi6/h62X7yVP AR9U+/p/xftZdtqnERuVW/dw+IE2OK8FugpNKXJnEYct/G66PW9cWAoEmf4sW2Hz66rQ tYsqIUx67o9VFs8WE9e59v5lGD6MNCZt2PnIVZf0t9PX3k3Vla0SLe4IvXKpRRGD/EMu wxGw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=mime-version:user-agent:message-id:date:subject:to:from :x-gm-message-state:from:to:cc:subject:date:message-id:reply-to; bh=k/FI0Q2pWdOXHBaClL2KYxWhkhF5JmCSeTjlapfIyH4=; b=bHVAMvVOKYy5nW5YBiJV5RZrkMX8ehM1myli4Pw6sIUAZUMjzJSUBLmz0zU3S+rA9w 4hIM91LjFgr5ePk4kIRAwZqABqPOgLwUHYwdtW/zkRC4/tKQwp0312sMNLxWzWlxoRDm 8odZy3FcB5dWk8HN43pexq3pIx4r8BsLMKgiA0KtxeErjELdkbKybWhzBgWOXqSxXg0k c2Myep+lN3hEjN9qvdawtO50cB/LW5c8otJoVPU4AvNe7i+vqptL16FF0Qv5QqG+vKGl grWJovnBVmzKjXzXqcXI7oWloP+9ItWyB+l4aoJRIf8dV9L9IuW0Erb3VgcT8loATCO8 Ud4A== X-Gm-Message-State: AO0yUKWK+ribeD8RvjyS2i9aiYdCJry1At2bsctTf03YU7/pwJY7knju yjO8tgdsYcQesPJW+2oRkp7Ln8oFRjc= X-Google-Smtp-Source: AK7set9j/sCnJzDF2iH5t/BdCdRLj8XUeP2cJ8xY6mXI0IuaxkcWm4F1xk2EbYQ2mXMYNiIC6e+v+A== X-Received: by 2002:a17:906:3bc8:b0:8b1:77bf:3be6 with SMTP id v8-20020a1709063bc800b008b177bf3be6mr34464723ejf.10.1677423363200; Sun, 26 Feb 2023 06:56:03 -0800 (PST) Original-Received: from ars3 ([2a02:8109:8ac0:56d0::8b3a]) by smtp.gmail.com with ESMTPSA id hz18-20020a1709072cf200b008b26f3d45fbsm2075003ejc.143.2023.02.26.06.56.02 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 26 Feb 2023 06:56:02 -0800 (PST) Received-SPF: pass client-ip=2a00:1450:4864:20::52e; envelope-from=arstoffel@gmail.com; helo=mail-ed1-x52e.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:256809 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Tags: patch Find attached an attempt to make Flyspell talk to the spell checking process outside of the main command loop using jit-lock. To activate this mode of operation one should set 'flyspell-synchronous' to nil before turning Flyspell on. Not many of the numerous Flyspell options are supported, but hopefully this can be considered useful even without covering all of them. In any case, let me know what you consider to be the essentials. Also, one obvious glitch is that one gets JIT=E2=84=A2 corrections for the = word being currently typed. Before going on an writing some ugly logic to avoid that, and since one can influence an overlay appearance when the mouse pointer hovers it, I was wondering if there's something analogous for the cursor. --=-=-= Content-Type: text/patch Content-Disposition: attachment; filename=0001-Async-Flyspell.patch >From aaf4869b415c53dfcbef7d06959ba846d11fd338 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel Date: Sun, 25 Sep 2022 17:09:31 +0200 Subject: [PATCH] Async Flyspell --- lisp/textmodes/flyspell.el | 209 ++++++++++++++++++++++++++++++++++++- 1 file changed, 208 insertions(+), 1 deletion(-) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 84c207b8a48..9b7a404a30a 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -532,7 +532,18 @@ flyspell-mode (flyspell-mode-on (called-interactively-p 'interactive)) (error (message "Error enabling Flyspell mode:\n%s" (cdr err)) (flyspell-mode -1))) - (flyspell-mode-off))) + (flyspell-mode-off)) + (unless flyspell-synchronous + (if flyspell-mode + (jit-lock-register #'flyspell-async--schedule) + (jit-lock-unregister #'flyspell-async--schedule)) + (remove-hook 'post-command-hook #'flyspell-post-command-hook t) + (remove-hook 'pre-command-hook #'flyspell-pre-command-hook t) + (remove-hook 'after-change-functions #'flyspell-after-change-function t) + (save-restriction + (widen) + (flyspell-delete-all-overlays) + (remove-text-properties (point-min) (point-max) '(flyspell-pending t))))) ;;;###autoload (defun turn-on-flyspell () @@ -1997,6 +2008,25 @@ flyspell-auto-correct-word (setq flyspell-auto-correct-region nil)) ;; Use the correct dictionary. (flyspell-accept-buffer-local-defs) + ;; Flyspell async case: populate suggestion list so we skip the + ;; else branch of the following `if' altogether. + (when-let* ((data (and (not flyspell-synchronous) + (not flyspell-auto-correct-region) + (get-char-property-and-overlay + (point) 'flyspell-corrections))) + (ov (cdr data)) + (corrections (car data)) + (word (buffer-substring-no-properties + (overlay-start ov) + (overlay-end ov))) + (ring (setcdr (last corrections) + (cons word corrections)))) + (setq flyspell-auto-correct-pos (point) + flyspell-auto-correct-word word + flyspell-auto-correct-ring ring + flyspell-auto-correct-region (cons (overlay-start ov) + (- (overlay-end ov) + (overlay-start ov))))) (if (and (eq flyspell-auto-correct-pos pos) (consp flyspell-auto-correct-region)) ;; We have already been using the function at the same location. @@ -2381,6 +2411,183 @@ flyspell-already-abbrevp (defun flyspell-change-abbrev (table old new) (set (abbrev-symbol old table) new)) +;;; Asynchronous operation + +(defvar flyspell-synchronous t + "If non-nil, disable asynchronous Flyspell operation.") + +(defvar-local flyspell-async--current-request nil) +(defvar-local flyspell-async--request-pool nil) +(defvar-local flyspell-async--recheck-timer nil) +(defvar flyspell-async--procs nil + "A collection of ispell processes for asynchronous Flyspell.") + +(defun flyspell-async-ignore-word-p (_start end) + (when flyspell-generic-check-word-predicate + (save-excursion + (goto-char end) + (not (funcall flyspell-generic-check-word-predicate))))) + +(defun flyspell-async--process-parameters () + "Return a list of parameters for this buffer's ispell process. +Buffers where this produces `equal' results can share their +ispell process." + (list ispell-program-name + ispell-current-dictionary + ispell-current-personal-dictionary + ispell-extra-args)) + +(defun flyspell-async--get-process () + "Get an ispell process for the current buffer." + (let* ((params (flyspell-async--process-parameters)) + (proc (plist-get flyspell-async--procs params #'equal))) + (if (process-live-p proc) + proc + (unless ispell-async-processp + (error "Asynchornous Flyspell requires `ispell-async-processp'")) + (setq proc (ispell-start-process)) + (setq flyspell-async--procs + (plist-put flyspell-async--procs params proc #'equal)) + (set-process-filter proc #'flyspell-async--process-filter) + (set-process-buffer proc (generate-new-buffer " *flyspell-async*")) + (process-send-string proc "!\n") ;Enter terse mode + proc))) + +(defun flyspell-async--process-filter (proc string) + (with-current-buffer (process-buffer proc) + (save-excursion + (goto-char (point-max)) + (insert string)) + (when (re-search-forward "^\n" nil t) + (pcase-let ((`(,buffer ,tick ,start ,end) + (process-get proc 'flyspell-async--current-request))) + (process-put proc 'flyspell-async--current-request nil) + (cond ((not (buffer-live-p buffer))) + ((not (eq tick (buffer-chars-modified-tick buffer))) + ;; Got a belated response, so schedule a retry + (flyspell-async--schedule-recheck buffer)) + (t ;; Response is good, apply misspelling overlays + (let (misspellings) + (goto-char (point-min)) + (while (re-search-forward + (rx bol + (or (seq (any "&?") + " " (group-n 1 (+ (not " "))) + " " (+ digit) + " " (group-n 2 (+ digit)) + ":") + (seq "#" + " " (group-n 1 (+ (not " "))) + " " (group-n 2 (+ digit))))) + nil t) + (let ((word (match-string 1)) + (start (string-to-number (match-string 2))) + corrections) + (goto-char (match-end 0)) + (while (re-search-forward (rx (+ (not (any ", \n")))) + (pos-eol) t) + (push (match-string 0) corrections)) + (push (list word start (nreverse corrections)) + misspellings))) + (flyspell-async--put-overlays buffer start end misspellings)))) + (delete-region (point-min) (point-max)) + ;; Send next request to ispell process, if applicable + (let (request) + (while (and (setq request (pop (process-get proc 'flyspell-async--requests))) + (pcase-let ((`(,buffer ,tick) request)) + (not (and (buffer-live-p buffer) + (eq tick (buffer-chars-modified-tick buffer)))))) + (when (buffer-live-p buffer) + (flyspell-async--schedule-recheck (car request)))) + (when request + (flyspell-async--send-request proc request))))))) + +(defun flyspell-async--put-overlays (buffer start end misspellings) + (with-current-buffer buffer + (with-silent-modifications + (put-text-property start end 'flyspell-pending nil) + (dolist (ov (overlays-in start end)) + (when (eq 'flyspell-incorrect (overlay-get ov 'face)) + (delete-overlay ov))) + (pcase-dolist (`(,word ,offset ,corrections) misspellings) + (when-let* ((wstart (+ start offset -1)) + (wend (+ wstart (length word))) + (ov (unless (flyspell-async-ignore-word-p wstart wend) + (make-flyspell-overlay wstart wend + 'flyspell-incorrect + 'highlight)))) + ;; For debugging + (unless (equal word (buffer-substring-no-properties wstart wend)) + (message "Shouldn't happen %s %s %s" word start (buffer-substring-no-properties wstart wend))) + (overlay-put ov 'flyspell-corrections corrections)))))) + +(defun flyspell-async--send-request (proc request) + (process-put proc 'flyspell-async--current-request request) + (pcase-let ((`(,buffer _ ,start ,end) request)) + (with-current-buffer buffer + (let ((text (buffer-substring-no-properties start end))) + ;; Redact control characters in `text'. + (dotimes (i (length text)) + (when (< (aref text i) ?\s) + (aset text i ?\s))) + (process-send-string proc "^") + (process-send-string proc text) + (process-send-string proc "\n"))))) + +(defun flyspell-async--schedule-recheck (buffer) + (message "Scheduled recheck") ;; For debugging + (with-current-buffer buffer + (when (timerp flyspell-async--recheck-timer) + (cancel-timer flyspell-async--recheck-timer)) + (setq flyspell-async--recheck-timer + (run-with-idle-timer 0.1 nil #'flyspell-async--recheck buffer)))) + +(defun flyspell-async--recheck (buffer) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (let ((proc (flyspell-async--get-process)) + (tick (buffer-chars-modified-tick)) + (end (point-min)) + (limit (point-max)) + start) + (while (setq start (text-property-any end limit 'flyspell-pending t)) + (setq end (or (text-property-not-all start limit 'flyspell-pending t) + limit)) + (push (list buffer tick start end) (process-get proc 'flyspell-async--requests))) + (when-let ((request (and (not (process-get proc 'flyspell-async--current-request)) + (pop (process-get proc 'flyspell-async--requests))))) + (flyspell-async--send-request proc request)))))) + +(defun flyspell-async--schedule (start end) + "Schedule a Flyspell check of region between START and END. +This is intended be a member of `jit-lock-functions'." + (save-excursion ;; Extend region to include whole words + (goto-char start) + (setq start (if (re-search-backward "\\s-" nil t) (match-end 0) (point-min))) + (goto-char end) + (setq end (or (re-search-forward "\\s-" nil t) (point-max)))) + (put-text-property start end 'flyspell-pending t) + (let ((proc (flyspell-async--get-process)) + (request (list (current-buffer) (buffer-chars-modified-tick) start end))) + (if (process-get proc 'flyspell-async--current-request) + (push request (process-get proc 'flyspell-async--requests)) + (flyspell-async--send-request proc request))) + `(jit-lock-bounds ,start . ,end)) + +(define-minor-mode flyspell-async + "Asynchronous Flyspell" + :global nil :lighter " FlyAsync" + (flyspell-mode -1) + (if flyspell-async + (jit-lock-register #'flyspell-async--schedule) + (jit-lock-unregister #'flyspell-async--schedule)) + (save-restriction + (widen) + (dolist (ov (overlays-in (point-min) (point-max))) + (when (eq 'flyspell-incorrect (overlay-get ov 'face)) + (delete-overlay ov))) + (remove-text-properties (point-min) (point-max) '(flyspell-pending t)))) + (provide 'flyspell) ;;; flyspell.el ends here -- 2.39.2 --=-=-=--