[222_100] add inline spell checking

Author: AnvarAtayev

TeXmacs/progs/generic/spell-widgets.scm

@@ -43,6 +43,80 @@
 (tm-define (inside-spell-buffer?)
   (== (current-buffer) (spell-buffer)))
 
+(define inline-spell-underlines-serial 0)
+(define inline-spell-underlines-buffer #f)
+
+(define (inline-spell-current-word)
+  (let* ((t (buffer-tree))
+         (p (tree->path t))
+         (lan (get-init "language"))
+         (cp (cursor-path))
+         (pos (and cp (cDr cp))))
+    (if (and pos (list-starts? pos p))
+        (tree-spell-at lan t p (list-tail pos (length p)) 1000)
+        (list))))
+
+(define (inline-spell-underlines-active?)
+  (and (current-view)
+       (get-boolean-preference "spell underlines")
+       (current-buffer)
+       (not (inside-spell-buffer?))
+       (not (buffer-aux? (current-buffer)))))
+
+(define (clear-inline-spell-underlines)
+  (set! inline-spell-underlines-serial (+ inline-spell-underlines-serial 1))
+  (set! inline-spell-underlines-buffer #f)
+  (when (current-view)
+    (clear-spell-errors)))
+
+(tm-define (inline-spell-underlines-refresh)
+  (if (not (inline-spell-underlines-active?))
+      (clear-inline-spell-underlines)
+      (let* ((t (buffer-tree))
+             (buf (current-buffer))
+             (p (tree->path t)))
+        (when (not (== inline-spell-underlines-buffer buf))
+          (set! inline-spell-underlines-buffer buf))
+        (let ((sels (inline-spell-current-word)))
+          (if (null? sels)
+              (clear-spell-errors)
+              (set-spell-errors sels))))))
+
+(define (inline-spell-underlines-key? key)
+  (or (in? key (list "space" "return" "tab" "backspace" "delete"
+                     "left" "right" "up" "down"
+                     "home" "end" "pageup" "pagedown"))
+      (and (== (string-length key) 1)
+           (not (or (char-alphabetic? (string-ref key 0))
+                    (char-numeric? (string-ref key 0)))))))
+
+(define (inline-spell-underlines-typing-key? key)
+  (and (== (string-length key) 1)
+       (or (char-alphabetic? (string-ref key 0))
+           (char-numeric? (string-ref key 0)))))
+
+(define (schedule-inline-spell-underlines-after delay)
+  (when (current-view)
+    (set! inline-spell-underlines-serial (+ inline-spell-underlines-serial 1))
+    (let ((ticket inline-spell-underlines-serial)
+          (buf (current-buffer)))
+      (delayed
+        (:idle delay)
+        (when (and (== ticket inline-spell-underlines-serial)
+                   (== buf (current-buffer)))
+          (inline-spell-underlines-refresh))))))
+
+(define (schedule-inline-spell-underlines)
+  (schedule-inline-spell-underlines-after 350))
+
+(define (schedule-inline-spell-underlines-slow)
+  (schedule-inline-spell-underlines-after 900))
+
+(tm-define (inline-spell-underlines-preference-changed which val)
+  (if (== val "on")
+      (schedule-inline-spell-underlines)
+      (clear-inline-spell-underlines)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Highlighting the spell results
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -130,6 +204,60 @@
       (if (not p) lan
           (tm->stree (tree-descendant-env bt (cDr p) "language" lan))))))
 
+(define (inline-spell-selection-at-cursor)
+  (and-with cp (cursor-path)
+    (let loop ((sels (get-spell-errors)))
+      (cond ((or (null? sels) (null? (cdr sels))) #f)
+            ((and (path-less-eq? (car sels) cp)
+                  (path-less? cp (cadr sels)))
+             (list (car sels) (cadr sels)))
+            (else (loop (cddr sels)))))))
+
+(define (inline-spell-get-language sel)
+  (let* ((bt (buffer-tree))
+         (rp (tree->path bt))
+         (sp (car sel))
+         (p (and (list-starts? sp rp) (sublist sp (length rp) (length sp))))
+         (lan (get-init "language")))
+    (if (not p) lan
+        (tm->stree (tree-descendant-env bt (cDr p) "language" lan)))))
+
+(define (inline-spell-suggestions sel)
+  (and-with ss (selection->string sel)
+    (let* ((lan (inline-spell-get-language sel))
+           (st (tm->stree (spell-check lan ss)))
+           (l0 (if (tm-func? st 'tuple) (cdr st) (list)))
+           (l1 (if (null? l0) l0 (cdr l0))))
+      (if (<= (length l1) 5) l1 (sublist l1 0 5)))))
+
+(define (inline-spell-suggestions-at-cursor)
+  (and-with sel (inline-spell-selection-at-cursor)
+    (inline-spell-suggestions sel)))
+
+(define (inline-spell-toolbar-open sel)
+  (let* ((u (current-buffer))
+         (aux (spell-buffer)))
+    (when (not toolbar-spell-active?)
+      (multi-spell-start)
+      (set! toolbar-spell-active? #t)
+      (set! spell-focus-hack? #t)
+      (set! spell-correct-string "")
+      (set! spell-suggestions (list))
+      (set! spell-corrected 0)
+      (set! spell-accepted 0)
+      (set! spell-inserted 0)
+      (update-bottom-tools))
+    (buffer-set-body aux `(document ""))
+    (buffer-set-master aux u)
+    (set! spell-window (current-window))
+    (set-alt-selection "alternate" (get-spell-errors))
+    (set-spell-reference (car sel))
+    (spell-focus-on sel)))
+
+(tm-define (inline-spell-show-toolbar-at-cursor)
+  (and-with sel (inline-spell-selection-at-cursor)
+    (inline-spell-toolbar-open sel)))
+
 (define (spell-focus-on sel)
   ;;(display* "spell-focus-on " sel "\n")
   (selection-set-range-set sel)
@@ -170,6 +298,27 @@
   (when (nin? key (list "pageup" "pagedown" "home" "end"))
     (former key time)))
 
+(tm-define (keyboard-press key time)
+  (:require (get-boolean-preference "spell underlines"))
+  (former key time)
+  (cond ((inline-spell-underlines-key? key)
+         (schedule-inline-spell-underlines))
+        ((inline-spell-underlines-typing-key? key)
+         (schedule-inline-spell-underlines-slow))))
+
+(tm-define (keyboard-focus has-focus? time)
+  (:require (get-boolean-preference "spell underlines"))
+  (former has-focus? time)
+  (when has-focus?
+    (schedule-inline-spell-underlines)))
+
+(tm-define (mouse-event key x y mods time data)
+  (:require (get-boolean-preference "spell underlines"))
+  (former key x y mods time data)
+  (when (== key "release-left")
+    (inline-spell-underlines-refresh)
+    (inline-spell-show-toolbar-at-cursor)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Highlighting a particular next or previous spell result
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

TeXmacs/progs/init-research.scm

@@ -164,7 +164,10 @@
              search-next-match)
 (lazy-keyboard (generic search-kbd))
 (lazy-define (generic spell-widgets) spell-toolbar
-             open-spell toolbar-spell-start interactive-spell)
+             open-spell toolbar-spell-start interactive-spell
+             inline-spell-underlines-refresh
+             inline-spell-underlines-preference-changed
+             inline-spell-show-toolbar-at-cursor)
 (lazy-define (generic format-widgets) open-paragraph-format open-page-format)
 (lazy-define (generic pattern-selector) open-pattern-selector
              open-gradient-selector open-background-picture-selector)
@@ -180,6 +183,14 @@
 (tm-property (open-source-tree-preferences) (:interactive #t))
 (tm-property (open-document-paragraph-format) (:interactive #t))
 (tm-property (open-document-page-format) (:interactive #t))
+
+(define-preferences
+  ("spell underlines" "off" inline-spell-underlines-preference-changed))
+
+(delayed
+  (:idle 500)
+  (when (get-boolean-preference "spell underlines")
+    (inline-spell-underlines-refresh)))
 (tm-property (open-document-metadata) (:interactive #t))
 (tm-property (open-document-colors) (:interactive #t))
 (tm-property (open-page-headers-footers) (:interactive #t))
@@ -526,4 +537,3 @@
                   (display "Timing:") (display (- (texmacs-time) start-time)) (newline)
                   ;(quit-TeXmacs)
                   ))))))))))))
-

TeXmacs/progs/texmacs/menus/preferences-menu.scm

@@ -267,7 +267,9 @@
           ---
           ("Disable" "0"))
     (enum ("Bibtex command" "bibtex command")
-          "bibtex" "biber" "biblatex" "rubibtex" *)))
+          "bibtex" "biber" "biblatex" "rubibtex" *)
+    (-> "Experimental"
+        (toggle ("Inline spellcheck" "spell underlines")))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Computation of the preference menu

TeXmacs/progs/texmacs/menus/preferences-widgets.scm

@@ -859,7 +859,10 @@ pretty-val : string
                   (get-boolean-preference "gui:print dialogue"))))
       (meti (hlist // (text "Use fonts in texlive"))
         (toggle (set-boolean-preference "texlive:fonts" answer)
-                (get-boolean-preference "texlive:fonts"))))))
+                (get-boolean-preference "texlive:fonts")))
+      (meti (hlist // (text "Inline spellcheck"))
+        (toggle (set-boolean-preference "spell underlines" answer)
+                (get-boolean-preference "spell underlines"))))))
 
 (tm-widget (experimental-preferences-widget*)
   (aligned
@@ -897,7 +900,10 @@ pretty-val : string
                 (get-boolean-preference "use native menubar")))
       (meti (hlist // (text "Use unified toolbars"))
         (toggle (set-boolean-preference "use unified toolbar" answer)
-                (get-boolean-preference "use unified toolbar"))))))
+                (get-boolean-preference "use unified toolbar"))))
+    (meti (hlist // (text "Inline spellcheck"))
+      (toggle (set-boolean-preference "spell underlines" answer)
+              (get-boolean-preference "spell underlines")))))
 
 (tm-widget (other-preferences-widget)
   (centered

devel/222_100.md

@@ -0,0 +1,27 @@
+# [222_100] Inline spell checking
+
+Issue #3102
+
+### Summary
+Implemented inline spell highlighting for the current buffer.
+
+The implementation:
+
+1. Reuses the existing spell backend and tree spell traversal.
+2. Stores spell-error ranges in a dedicated editor-side channel.
+3. Repaints spell errors without routing updates through `THE_SELECTION`.
+4. Shows misspellings with a squiggly underline rendered from the spell rectangles.
+5. Refreshes spell results with the existing cursor-local `tree-spell-at` scan.
+6. Does not refresh spell state from generic mouse movement.
+7. Converts spell ranges into persistent editor-side positions so they survive tree edits safely.
+8. Uses a fast idle refresh on word-boundary/navigation keys and a slower debounce while typing inside a word.
+9. Reuses the existing bottom spell toolbar for inline misspellings when clicked.
+
+### How It Works
+Scheme computes spell ranges and sends them to the editor through:
+
+1. `set-spell-errors`
+2. `get-spell-errors`
+3. `clear-spell-errors`
+
+The editor converts incoming spell ranges into persistent tree positions, keeps them separately from normal selections, resolves them back into rectangles when the tree or visible region changes, and paints a wave near the bottom of each rectangle using a red-tinted incorrect-color theme value. Clicking an inline misspelled word opens the existing bottom spell toolbar and seeds it with the current word's suggestion list and replacement actions from the existing spell backend.

src/Edit/Interface/edit_interface.cpp

@@ -840,6 +840,15 @@ edit_interface_rep::apply_changes () {
       if (is_empty (alt_sel)) alt_selection_rects= array<rectangles> ();
     }
   }
+  if (env_change & (THE_TREE + THE_ENVIRONMENT + THE_SPELL_ERRORS)) {
+    if (N (spell_error_rects) != 0) {
+      rectangles visible (rectangle (vx1, vy1, vx2, vy2));
+      for (int i= 0; i < N (spell_error_rects); i++)
+        invalidate (spell_error_rects[i] & visible);
+      if (is_empty (get_spell_errors ()))
+        spell_error_rects= array<rectangles> ();
+    }
+  }
 
   // cout << "Handling environment\n";
   if (env_change & THE_ENVIRONMENT) {
@@ -1023,6 +1032,30 @@ edit_interface_rep::apply_changes () {
       for (int i= 0; i < N (alt_selection_rects); i++)
         invalidate (alt_selection_rects[i] & visible);
     }
+    else alt_selection_rects= array<rectangles> ();
+  }
+
+  if (env_change & (THE_TREE + THE_ENVIRONMENT + THE_SPELL_ERRORS) ||
+      new_visible != last_visible) {
+    range_set spell_sel= get_spell_errors ();
+    if (!is_empty (spell_sel)) {
+      spell_error_rects= array<rectangles> ();
+      int b= 0, e= N (spell_sel);
+      if (e - b >= 200) {
+        b= max (find_alt_selection_index (spell_sel, vy2, b, e) - 100, b);
+        e= min (find_alt_selection_index (spell_sel, vy1, b, e) + 100, e);
+      }
+      for (int i= b; i + 1 < e; i+= 2) {
+        range_set  sub_sel= simple_range (spell_sel[i], spell_sel[i + 1]);
+        selection  sel    = compute_selection (sub_sel);
+        rectangles rs     = sel->rs;
+        if (N (rs) != 0) spell_error_rects << rs;
+      }
+      rectangles visible (new_visible);
+      for (int i= 0; i < N (spell_error_rects); i++)
+        invalidate (spell_error_rects[i] & visible);
+    }
+    else spell_error_rects= array<rectangles> ();
   }
 
   // cout << "Handling locus highlighting\n";

src/Edit/Interface/edit_interface.hpp

@@ -112,6 +112,7 @@ class edit_interface_rep : virtual public editor_rep {
   void   table_scale_apply (SI x, SI y);
   void   table_scale_stop ();
   array<rectangles> alt_selection_rects;
+  array<rectangles> spell_error_rects;
   rectangle         last_visible;
   rectangle         last_image_brec; // 图片 bbox 缓存
   SI                last_image_hr;   // 图片 handle 半径缓存

src/Edit/Interface/edit_repaint.cpp

@@ -10,6 +10,7 @@
  ******************************************************************************/
 
 #include "Interface/edit_interface.hpp"
+#include "colors.hpp"
 #include "gui.hpp" // for gui_interrupted
 #include "message.hpp"
 #include "preferences.hpp"
@@ -150,6 +151,33 @@ edit_interface_rep::draw_context (renderer ren, rectangle r) {
   draw_surround (ren, r);
 }
 
+static void
+draw_spell_error_wave (renderer ren, rectangles rs) {
+  SI pixel= max ((SI) 1, ren->pixel);
+  SI width= max ((SI) 5, 5 * pixel);
+  SI step = max ((SI) 8, 8 * pixel);
+  SI amp  = max ((SI) 4, 4 * pixel);
+  while (!is_nil (rs)) {
+    rectangle r     = rs->item;
+    SI        x     = r->x1;
+    SI        base  = r->y1 + 2 * pixel;
+    SI        y_near= base;
+    SI        y_far = base - amp;
+    ren->set_pencil (pencil (ren->get_pencil ()->get_color (), width));
+    if (r->x2 - r->x1 <= step) ren->line (r->x1, y_near, r->x2, y_near);
+    else {
+      bool up= true;
+      while (x < r->x2) {
+        SI nx= min (x + step, r->x2);
+        ren->line (x, up ? y_near : y_far, nx, up ? y_far : y_near);
+        x = nx;
+        up= !up;
+      }
+    }
+    rs= rs->next;
+  }
+}
+
 void
 edit_interface_rep::draw_selection (renderer ren, rectangle r) {
   rectangles visible (thicken (r, 2 * ren->pixel, 2 * ren->pixel));
@@ -173,6 +201,14 @@ edit_interface_rep::draw_selection (renderer ren, rectangle r) {
     ren->draw_rectangles (alt_selection_rects[i] & visible);
 #endif
   }
+  int spell_count= N (spell_error_rects);
+  if (spell_count > 0) {
+    color col= blend_colors (rgb_color (220, 70, 70, 220),
+                             get_env_color (INCORRECT_COLOR));
+    ren->set_pencil (pencil (col, ren->pixel));
+    for (int i= 0; i < spell_count; i++)
+      draw_spell_error_wave (ren, spell_error_rects[i] & visible);
+  }
   if (!is_nil (selection_rects)) {
     color col= get_env_color (SELECTION_COLOR);
     if (table_selection) col= get_env_color (TABLE_SELECTION_COLOR);