bug#74876: 31.0.50; Force fringe refresh / force-window-update not affecting fringes

[Michal Nazarewicz <mina86@mina86.com>]

On Sun, Dec 15 2024, Eli Zaretskii wrote:
> Thanks.  I don't think what you want can possibly work, unless we
> completely redesign how the fringes are updated.

Well… there’s always the atomic option of calling redraw-frame.  Though
I’ve found that changing an attribute of a font is sufficient.
I believe what makes things work is setting f->face_change and calling
fset_redisplay.

---- >8 ----------------------------------------------------------------

(defvar-local adob-remapping nil)
(put 'adob-remapping 'permanent-local nil)

(defface adob-test '((t :background "red")) "Test")
(defface adob-hack '() "Test")

(defun adob-force-window-update (wnd)
  (force-window-update wnd)
  (let ((frame (window-frame wnd))
        (value (face-attribute 'adob-hack :inverse-video frame nil)))
    (internal-set-lisp-face-attribute
     'adob-hack :inverse-video (not value) frame)))

(defun adob-force-window-update (wnd)
  (force-window-update wnd)
  ; (redraw-frame (window-frame wnd))
  (let ((frame (window-frame wnd))
        (value (face-attribute 'adob-hack :inverse-video frame nil)))
    (internal-set-lisp-face-attribute
     'adob-hack :inverse-video (not value) frame)))

(defun adob-test-for-each-window (func)
  (save-current-buffer
    (dolist (frame (frame-list))
      (dolist (wnd (window-list frame))
        (set-buffer (window-buffer wnd))
        (when (funcall func wnd)
          (adob-force-window-update wnd))))))

(defun adob-test-update ()
  (let ((face '(:filtered (:window adob-test t) adob-test))
        (selected-window (selected-window)))
    (adob-test-for-each-window
     (lambda (wnd)
       (let ((val (eq wnd selected-window)) update)
         (unless adob-remapping
           (setq adob-remapping (face-remap-add-relative 'fringe face)
                 update t))
         (unless (eq val (window-parameter wnd 'adob-test))
           (set-window-parameter wnd 'adob-test val)
           (setq update t))
         update)))))

(defun adob-test-on ()
  (interactive)
  (adob-test-update)
  (add-hook 'post-command-hook #'adob-test-update))

(defun adob-test-off ()
  (interactive)
  (remove-hook 'post-command-hook #'adob-test-update)
  (adob-test-for-each-window
   (lambda (wnd)
     (when adob-remapping
       (face-remap-remove-relative adob-remapping)
       (setq adob-remapping nil)
       t))))

---- 8< ----------------------------------------------------------------

-- 
Best regards
ミハウ “𝓶𝓲𝓷𝓪86” ナザレヴイツ
«If at first you don’t succeed, give up skydiving»