emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

tofu-help-mode (was: Suggest installing more fonts?)


From: Stefan Monnier
Subject: tofu-help-mode (was: Suggest installing more fonts?)
Date: Wed, 21 Oct 2020 12:03:58 -0400
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux)

BTW, for those interested, here's a proof-of-concept.

I don't intend to work much more on this (except maybe for the
`post-redisplay-functions` part which might be useful on its own), so
I'd encourage someone else to take it over from here if they'd like to
see it turn into something usable.


        Stefan


diff --git a/lisp/simple.el b/lisp/simple.el
index ef519aa2cb..647ffd7320 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6342,6 +6342,48 @@ redisplay--pre-redisplay-functions
 (add-function :before pre-redisplay-function
               #'redisplay--pre-redisplay-functions)
 
+(defvar post-redisplay-functions nil
+  "Hook run just after redisplay.
+It is called in each window that has been redisplayed.  It takes one argument,
+which is the window that was redisplayed.  When run, the `current-buffer'
+is set to the buffer displayed in that window.")
+
+(defun redisplay--post-redisplay-functions (windows)
+  (with-demoted-errors "redisplay--post-redisplay-functions: %S"
+    (if (null windows)
+        (with-current-buffer (window-buffer (selected-window))
+          (run-hook-with-args 'post-redisplay-functions (selected-window)))
+      (dolist (win (if (listp windows) windows (window-list-1 nil nil t)))
+        (with-current-buffer (window-buffer win)
+          (run-hook-with-args 'post-redisplay-functions win))))))
+
+(add-function :before post-redisplay-function
+              #'redisplay--post-redisplay-functions)
+
+(defun tofu-help--post-redisplay (_window)
+  (declare-function describe-char-display "descr-text" (pos char))
+  (while (consp redisplay-tofu)
+    (let* ((pos (pop redisplay-tofu))
+           (char (if (< pos (point-max)) (char-after pos))))
+      ;; Don't hide pre-existing help-echo.
+      (unless (or (null char)
+                  (get-text-property pos 'help-echo)
+                  (describe-char-display pos char))
+        (with-silent-modifications
+          (put-text-property pos (1+ pos) 'help-echo
+                             (or (get-char-code-property char 'name)
+                                (get-char-code-property char 'old-name)
+                                "This is unknown TOFU!")))))))
+
+(define-minor-mode tofu-help-mode
+  "Add help-echo on TOFU chars."
+  :lighter nil
+  (kill-local-variable 'redisplay-tofu)
+  (remove-hook 'post-redisplay-functions #'tofu-help--post-redisplay t)
+  (when tofu-help-mode
+    (require 'descr-text)               ;For describe-char-display
+    (setq-local redisplay-tofu nil)
+    (add-hook 'post-redisplay-functions #'tofu-help--post-redisplay nil t)))
 
 (defvar-local mark-ring nil
   "The list of former marks of the current buffer, most recent first.")
diff --git a/src/xdisp.c b/src/xdisp.c
index 4086eef9d0..e5559774b8 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -7333,6 +7333,18 @@ #define CHAR_COMPOSED_P(IT,CHARPOS,BYTEPOS,END_CHARPOS)  
                \
                                                       (IT)->face_id),  \
                                 (IT)->string)))
 
+static void
+record_tofu (struct it *it)
+{
+  if (!EQ (Vredisplay_tofu, Qt))
+    {
+      Lisp_Object pos = make_fixnum (IT_CHARPOS (*it));
+      /* FIXME: If the user sets `redisplay-tofu' to a value that's
+         neither t nor a proper list, this signals an error!  */
+      if (NILP (Fmemq (pos, Vredisplay_tofu)))
+        Vredisplay_tofu = Fcons (pos, Vredisplay_tofu);
+    }
+}
 
 /* Lookup the char-table Vglyphless_char_display for character C (-1
    if we want information for no-font case), and return the display
@@ -7382,7 +7394,10 @@ lookup_glyphless_char_display (int c, struct it *it)
   else if (EQ (glyphless_method, Qempty_box))
     it->glyphless_method = GLYPHLESS_DISPLAY_EMPTY_BOX;
   else if (EQ (glyphless_method, Qhex_code))
-    it->glyphless_method = GLYPHLESS_DISPLAY_HEX_CODE;
+    {
+      record_tofu (it);
+      it->glyphless_method = GLYPHLESS_DISPLAY_HEX_CODE;
+    }
   else if (STRINGP (glyphless_method))
     it->glyphless_method = GLYPHLESS_DISPLAY_ACRONYM;
   else
@@ -15514,6 +15529,7 @@ #define RESUME_POLLING                                  
\
 static int redisplay_window_wcounter;
 static int redisplay_window_bcounter;
 static int redisplay_window_fcounter;
+static Lisp_Object redisplayed_windows;
 
 /* Perhaps in the future avoid recentering windows if it
    is not necessary; currently that causes some problems.  */
@@ -16016,9 +16032,13 @@ #define AINC(a,i)                                      
                \
   redisplay_window_bcounter = 0;
   redisplay_window_fcounter = 0;
   redisplay_window_wcounter = 0;
+  redisplayed_windows = Qt;
 
   if (consider_all_windows_p)
     {
+      if (REDISPLAY_SOME_P ())
+        redisplayed_windows = Qnil;
+
       FOR_EACH_FRAME (tail, frame)
        XFRAME (frame)->updated_p = false;
 
@@ -16328,6 +16348,10 @@ #define AINC(a,i)                                      
                \
     request_sigio ();
   RESUME_POLLING;
 
+  if (FUNCTIONP (Vpost_redisplay_function))
+    safe__call1 (true, Vpost_redisplay_function,
+                 consider_all_windows_p ? redisplayed_windows : Qnil);
+
   /* If a frame has become visible which was not before, redisplay
      again, so that we display it.  Expose events for such a frame
      (which it gets when becoming visible) don't call the parts of
@@ -18422,6 +18446,9 @@ redisplay_window (Lisp_Object window, bool 
just_this_one_p)
       && BUF_PT (buffer) == w->last_point)
     return;
 
+  if (!EQ (redisplayed_windows, Qt))
+    redisplayed_windows = Fcons (window, redisplayed_windows);
+
   if (w->redisplay)
     redisplay_window_wcounter++;
   if (f->redisplay)
@@ -29696,7 +29723,7 @@ compute_relative_width (struct it *it, Lisp_Object prop)
 
   it2 = *it;
   if (it->multibyte_p)
-    it2.c = it2.char_to_display = string_char_and_length (p, it2.len);
+    it2.c = it2.char_to_display = string_char_and_length (p, &it2.len);
   else
     {
       it2.c = it2.char_to_display = *p, it2.len = 1;
@@ -34683,6 +34710,9 @@ syms_of_xdisp (void)
   Vmessage_stack = Qnil;
   staticpro (&Vmessage_stack);
 
+  redisplayed_windows = Qt;
+  staticpro (&redisplayed_windows);
+
   /* Non-nil means don't actually do any redisplay.  */
   DEFSYM (Qinhibit_redisplay, "inhibit-redisplay");
 
@@ -35544,6 +35574,13 @@ syms_of_xdisp (void)
 or t (meaning all windows).  */);
   Vpre_redisplay_function = intern ("ignore");
 
+  DEFVAR_LISP ("post-redisplay-function", Vpost_redisplay_function,
+              doc: /* Function run just after redisplay.
+It is called with one argument, which is the set of windows that have been
+redisplayed.  This set can be nil (meaning, only the selected window),
+or t (meaning all windows).  */);
+  Vpost_redisplay_function = intern ("ignore");
+
   /* Symbol for the purpose of Vglyphless_char_display.  */
   DEFSYM (Qglyphless_char_display, "glyphless-char-display");
   Fput (Qglyphless_char_display, Qchar_table_extra_slots, make_fixnum (1));
@@ -35614,6 +35651,10 @@ syms_of_xdisp (void)
               doc: /*  */);
   Vredisplay__touched_fcounts = Fmake_hash_table (0, NULL);
 
+  DEFVAR_LISP ("redisplay-tofu", Vredisplay_tofu,
+               doc: /*  */);
+  Vredisplay_tofu = Qt;
+
   DEFVAR_BOOL ("redisplay--inhibit-bidi", redisplay__inhibit_bidi,
      doc: /* Non-nil means it is not safe to attempt bidi reordering for 
display.  */);
   /* Initialize to t, since we need to disable reordering until




reply via email to

[Prev in Thread] Current Thread [Next in Thread]