all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* Sticky tooltips
@ 2020-09-28 20:04 Arthur Miller
  2020-09-28 22:11 ` Jean Louis
  2020-09-29  2:41 ` Eli Zaretskii
  0 siblings, 2 replies; 20+ messages in thread
From: Arthur Miller @ 2020-09-28 20:04 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: test --]
[-- Type: text/plain, Size: 4296 bytes --]

;;; poor-man-tooltip.el ---                                 -*- lexical-binding: t; -*-

(require 'widget)

(defvar pm-tooltip-duration)
(setq pm-tooltip-duration 4)

(defun pm-test ()
  (interactive)
  (pm-tooltip "Here is some tootip text."))

(define-minor-mode pm-minor-mode
  ""
  :keymap (let ((map (make-sparse-keymap)))
            (define-key map (kbd "C-g")   'pm-quit-tooltip)
            map))

(defun pm-tooltip (tooltip-text)
  
  (let ((cur-line 0)
        (lng-line 0)
        (tooltip-timer nil)
        (tooltip-frame nil))
    
    (with-current-buffer (get-buffer-create "tooltip-buffer")
      (kill-all-local-variables)
      (let ((inhibit-read-only t))
        (erase-buffer))
      (remove-overlays)
      
      (insert " ")
      (insert tooltip-text)
      (goto-char (point-min))

      (while (not (eobp))
        (setq cur-line (- (line-end-position) (line-beginning-position)))
        (when (> cur-line lng-line)
          (setq lng-line cur-line))
        (forward-line))
      
      (newline)
      (insert-char ?- (- lng-line 6))
      (widget-insert " Sticky ")
      (widget-create 'checkbox 
                 :notify (lambda (s &rest ignore)
                           (if (widget-value s)
                                 (progn
                                   (when tooltip-timer
                                     (cancel-timer tooltip-timer)
                                     (setq tooltip-timer nil))
                                   (message "Sticky tooltip enabled!"))
                             ;; else
                             (progn
                               (when tooltip-frame
                                 (setq tooltip-timer (pm-start-timer
                                                      tooltip-frame)))
                               (message "Sticky tooltip disabled!")))))
      (use-local-map widget-keymap)
      (widget-setup))
      
    (setq tooltip-frame (pm-show-at-cursor "tooltip-buffer"))
    (setq tooltip-timer (pm-start-timer tooltip-frame))))

(defun pm-quit-tooltip (tooltip-frame)
  (with-current-buffer (get-buffer "tooltip-buffer")
    (kill-buffer))
  (delete-frame tooltip-frame))

(defun pm-start-timer (tooltip-frame)
  (let ((tooltip-timer
        (run-with-timer pm-tooltip-duration nil
                        (apply-partially #'pm-quit-tooltip tooltip-frame))))
    tooltip-timer))

(defun pm-show-at-point (menuname)
  (let ((position (pos-visible-in-window-p nil nil t)))
      (pm-create-tooltip menuname (nth 0 position) (nth 1 position))))

(defun pm-show-at-cursor (menuname)
  (let ((cursor-pos (mouse-pixel-position)))
        (pm-create-tooltip menuname (cadr cursor-pos) (cddr cursor-pos))))
    
(defun pm-create-tooltip (menuname x y)
  
  (with-current-buffer (get-buffer menuname)
    (pm-minor-mode)

    (setq tab-line-format nil)
    (setq mode-line-format nil)
    (setq cursor-type nil)
    (setq buffer-read-only t)
    
    (let ((parent (selected-frame))
          (child-frame (make-frame   '((visible . 0)
                                       (border-width . 2)
                                       (internal-border-width . 2)
                                       (undecorated . 0)
                                       (keep-ratio . t)
                                       (menu-bar-lines . 0)
                                       (tool-bar-lines . 0)
                                       (left-fringe . 0)
                                       (right-fringe . 0)
                                       (line-spacing . 0)
                                       (unsplittable . t)
                                       (minibuffer . nil)
                                       (no-other-frame . t)
                                       (drag-internal-border . t)
                                       (inhibit-double-buffering . t)
                                       (desktop-dont-save . t)))))
      
      (set-frame-parameter child-frame 'parent-frame parent)
      (fit-frame-to-buffer child-frame)
      ;; seems that afte fit-frame-to-buff there is few pixels missing
      (set-frame-width child-frame (+ 1 (frame-width child-frame)))
      (set-frame-position child-frame x y)
      child-frame)))

(provide 'poor-man-tooltip)

[-- Attachment #2: Type: text/plain, Size: 1107 bytes --]


Somebody suggested for sticky tooltips the other day; Mr. Eli Z.
explained about tooltips, when compiled in Gtk are controlled by Gtk.

So I wonder - do they need to be?

A tooltip is just a small pop-up window showing some text (usually).
Emacs is already very good at showing text in all kind of windows so
question is, is Gtk really needed to render tooltips? Even if Emacs
is compiled with Gtk? Is there any special advantage over an "Emacs
frame"?

I tested idea with a sticky tooltip based on just ordinary buffer
displayed in a child frame. I haven't done any text
styling/propertizing, faces, colors etc. The frame is displayed at mouse
cursor (just for test) and it starts a timer which deletes frame after
an (customizable) interval. There is a small checkbox to make it
"sticky" (it just removed the expiration timer); toggling it on will
start timer again.

It is just a sketch of the idea; i just wonder if such similar tooltip
implementatation (all Emacs) would be interesting. It seems to be quite
trivial and if it is done all in Elisp then I guess it would be same on
all gui platforms? 


^ permalink raw reply	[flat|nested] 20+ messages in thread
* Sticky tooltips
@ 2020-10-05  0:55 Arthur Miller
  0 siblings, 0 replies; 20+ messages in thread
From: Arthur Miller @ 2020-10-05  0:55 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 939 bytes --]

I played a bit, and it does not look so bad actually. I have played both
with 'propertized' widget and one with 'plain' text; the latter takes
less space on the screen; but it is just to switch comments and test the
propertized version in the patch. 

Adding a checkbox wasn't difficult part and modifiying x-show-tip
accordingly wasn't the hard part. x-show-tip in xfns.c is almost
unchanged minus the part for creating a new buffer and inserting the
string. However, I don't know where to look for mouse motion callback to
turn off automatic hiding on mouse move. Anyway, with patch it is
possible to see how it looks like, even if callback itself does not work.

I added a customize option tooltip-enable-sticky (off by default) which
takes effect only if gtk tooltips are disabled:

(setq x-gtk-use-system-tooltips nil
      tooltip-enable-sticky t)

It is just an idea how it might look and work to see if it is interesting
to have.


[-- Attachment #2: tooltip.el.patch --]
[-- Type: text/x-patch, Size: 3690 bytes --]

--- tooltip.el	2020-08-21 15:12:24.108484748 +0200
+++ lisp/tooltip.el	2020-10-05 02:47:13.662826815 +0200
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (require 'syntax)
+(require 'widget) ; for "sticky" tooltips
 
 (defvar comint-prompt-regexp)
 
@@ -164,6 +165,14 @@
   :group 'tooltip
   :version "27.1")
 
+(defcustom tooltip-enable-sticky nil
+  "Set this variable to true to enable `sticky' tooltip interface.
+This variable does not have effect when Gtk tooltips are enabled
+  (requires Emacs to be compiled with Gtk suppoart and
+  x-gtk-use-system-tootlip to be set to true)."
+  :type 'boolean
+  :group 'tooltip)
+
 \f
 ;;; Variables that are not customizable.
 
@@ -258,12 +267,61 @@
 	    (setf (alist-get 'border-color params) fg))
 	  (when (stringp bg)
 	    (setf (alist-get 'background-color params) bg))
-	  (x-show-tip (propertize text 'face 'tooltip)
-		      (selected-frame)
-		      params
-		      tooltip-hide-delay
-		      tooltip-x-offset
-		      tooltip-y-offset))
+          (if x-gtk-use-system-tooltips
+	      (x-show-tip (propertize text 'face 'tooltip)
+		          (selected-frame)
+		          params
+		          tooltip-hide-delay
+		          tooltip-x-offset
+		          tooltip-y-offset)
+
+            ;; we are not using gtk
+            (with-current-buffer (get-buffer-create " *tip*")
+              (let ((inhibit-read-only t))
+                (erase-buffer)
+                (remove-overlays)
+                (insert (propertize text 'face 'tooltip))
+
+                (when tooltip-enable-sticky
+                  (goto-char (point-min))
+                  (let ((cur-line 0)
+                        (lng-line 0))
+                    (while (not (eobp))
+                      (setq cur-line (- (line-end-position) (line-beginning-position)))
+                      (when (> cur-line lng-line)
+                        (setq lng-line cur-line))
+                      (forward-line))
+
+                    (newline)
+
+                    ;; (insert (propertize
+                    ;;               (make-string (- lng-line 6) ?─)
+                    ;;               'face 'tooltip))
+                    ;; (widget-insert (propertize " Sticky " 'face
+                    ;;                            'tooltip))
+                    (insert (make-string (- lng-line 6) ?─))
+                    (widget-insert " Sticky ")
+                    (widget-create 'checkbox
+                                   :notify (lambda (s &rest ignore)
+                                             (if (widget-value s)
+                                                 (progn ;; OBS nothing here yet
+                                                   ;; (when tooltip-timer
+                                                   ;;   (cancel-timer tooltip-timer)
+                                                   ;;   (setq tooltip-timer nil))
+                                                   )
+                                               ;; else
+                                               (tooltip-hide))))
+                  (use-local-map widget-keymap)
+                  (widget-setup)))
+
+                ;; this (propertize text ... ) here is unnecessary
+                ;; ... but this is just a fast hack
+                (x-show-tip (propertize text 'face 'tooltip)
+                            (selected-frame)
+		            params
+		            tooltip-hide-delay
+		            tooltip-x-offset
+		            tooltip-y-offset)))))
       (error
        (message "Error while displaying tooltip: %s" error)
        (sit-for 1)

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: xfns.c.patch --]
[-- Type: text/x-patch, Size: 844 bytes --]

--- xfns.c	2020-09-27 12:07:36.298841349 +0200
+++ src/xfns.c	2020-10-05 02:15:01.690628616 +0200
@@ -7081,7 +7081,11 @@
      buffer.  */
   count_1 = SPECPDL_INDEX ();
   old_buffer = current_buffer;
+  /*
   set_buffer_internal_1 (XBUFFER (w->contents));
+  specbind (Qinhibit_read_only, Qt);
+  specbind (Qinhibit_modification_hooks, Qt);
+  specbind (Qinhibit_point_motion_hooks, Qt);
   bset_truncate_lines (current_buffer, Qnil);
   specbind (Qinhibit_read_only, Qt);
   specbind (Qinhibit_modification_hooks, Qt);
@@ -7092,6 +7096,7 @@
   clear_glyph_matrix (w->current_matrix);
   SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
   try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
+  */
   /* Calculate size of tooltip window.  */
   size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil,
 				  make_fixnum (w->pixel_height), Qnil);

^ permalink raw reply	[flat|nested] 20+ messages in thread
* Sticky tooltips
@ 2020-10-22 16:17 Arthur Miller
  0 siblings, 0 replies; 20+ messages in thread
From: Arthur Miller @ 2020-10-22 16:17 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: sticky-tips.patch --]
[-- Type: text/x-patch, Size: 6486 bytes --]

diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index ffc3d499e3..8ca56f2100 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -67,6 +67,10 @@ tooltip-mode
 
 \f
 ;;; Customizable settings
+;; keep true while testing, will be default nil
+(defcustom tooltip-enable-sticky-tips t
+  "Seconds to wait before displaying a tooltip the first time."
+  :type 'boolean)
 
 (defcustom tooltip-delay 0.7
   "Seconds to wait before displaying a tooltip the first time."
@@ -175,6 +179,9 @@ tooltip-hide-time
 
 (defvar gud-tooltip-mode) ;; Prevent warning.
 
+(defvar sticky-tooltip-timer nil
+  "Time during which sticky tooltip is not hidden.")
+
 ;;; Event accessors
 
 (defun tooltip-event-buffer (event)
@@ -210,6 +217,10 @@ tooltip-timeout
   (run-hook-with-args-until-success 'tooltip-functions
 				    tooltip-last-mouse-motion-event))
 
+(defun tooltip-start-sticky-timer ()
+  (setq sticky-tooltip-timer
+        (run-with-timer tooltip-hide-delay nil 'tooltip-hide)
+        sticky-is-up t))
 \f
 ;;; Displaying tips
 
@@ -237,6 +248,8 @@ tooltip-show
 
 Optional second arg USE-ECHO-AREA non-nil means to show tooltip
 in echo area."
+  ;; while testing keep gtk tips off
+  (setq x-gtk-use-system-tooltips nil)
   (if use-echo-area
       (tooltip-show-help-non-mode text)
     (condition-case error
@@ -248,12 +261,47 @@ tooltip-show
 	    (setf (alist-get 'border-color params) fg))
 	  (when (stringp bg)
 	    (setf (alist-get 'background-color params) bg))
-	  (x-show-tip (propertize text 'face 'tooltip)
-		      (selected-frame)
+
+          (unless x-gtk-use-system-tooltips
+            (with-current-buffer (get-buffer-create " *tip*")
+              (let ((inhibit-read-only t))
+                (erase-buffer)
+                (remove-overlays)
+                (insert (propertize text 'face 'tooltip))
+
+                (when tooltip-enable-sticky-tips
+                  (goto-char (point-min))
+                  (let ((cur-line 0)
+                        (lng-line 0))
+                    (while (not (eobp))
+                      (setq cur-line (- (line-end-position) (line-beginning-position)))
+                      (when (> cur-line lng-line)
+                        (setq lng-line cur-line))
+                      (forward-line))
+                    (newline)
+                    (insert (make-string (- lng-line 6) ?─))
+                    (widget-insert " Sticky ")
+                    (widget-create 'checkbox
+                                   :notify
+                                   (lambda (s &rest ignore)
+                                     (if (widget-value s)
+                                         (message "START WIDGET")
+                                       (message "EXIT WIDGET"))))
+                    (use-local-map widget-keymap)
+                    (widget-setup))))))
+
+          ;; text properties are now handled, in buffer, and
+          ;; 'text' argument is only needed for gtk-tooltips
+          ;; (not used if we are here)
+          (x-show-tip text
+                      (selected-frame)
 		      params
 		      tooltip-hide-delay
 		      tooltip-x-offset
-		      tooltip-y-offset))
+		      tooltip-y-offset)
+
+          (when tooltip-enable-sticky-tips
+            (tooltip-start-sticky-timer)))
       (error
        (message "Error while displaying tooltip: %s" error)
        (sit-for 1)
@@ -368,7 +416,8 @@ tooltip-show-help
 	(cond ((null msg)
 	       ;; Cancel display.  This also cancels a delayed tip, if
 	       ;; there is one.
-	       (tooltip-hide))
+               (unless sticky-tooltip-timer
+	         (tooltip-hide)))
 	      ((equal-including-properties previous-help msg)
 	       ;; Same help as before (but possibly the mouse has moved).
 	       ;; Keep what we have.
@@ -376,6 +425,8 @@ tooltip-show-help
 	      (t
 	       ;; A different help.  Remove a previous tooltip, and
 	       ;; display a new one, with some delay.
+               (when sticky-tooltip-timer
+                 (cancel-timer sticky-tooltip-timer))
 	       (tooltip-hide)
 	       (tooltip-start-delayed-tip))))
     ;; On text-only displays, try `tooltip-show-help-non-mode'.
diff --git a/src/xfns.c b/src/xfns.c
index 46e4bd73a6..afb26b6b94 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -6909,7 +6909,6 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
     dy = make_fixnum (-10);
   else
     CHECK_FIXNUM (dy);
-
 #ifdef USE_GTK
   if (x_gtk_use_system_tooltips)
     {
@@ -6930,6 +6929,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
       unblock_input ();
       if (ok) goto start_timer;
     }
+
 #endif /* USE_GTK */
 
   if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame)))
@@ -7081,20 +7081,20 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
      buffer.  */
   count_1 = SPECPDL_INDEX ();
   old_buffer = current_buffer;
-  set_buffer_internal_1 (XBUFFER (w->contents));
-  bset_truncate_lines (current_buffer, Qnil);
-  specbind (Qinhibit_read_only, Qt);
-  specbind (Qinhibit_modification_hooks, Qt);
-  specbind (Qinhibit_point_motion_hooks, Qt);
-  Ferase_buffer ();
-  Finsert (1, &string);
-  clear_glyph_matrix (w->desired_matrix);
-  clear_glyph_matrix (w->current_matrix);
-  SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
-  try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
-  /* Calculate size of tooltip window.  */
+  // set_buffer_internal_1 (XBUFFER (w->contents));
+  // bset_truncate_lines (current_buffer, Qnil);
+  // specbind (Qinhibit_read_only, Qt);
+  // specbind (Qinhibit_modification_hooks, Qt);
+  // specbind (Qinhibit_point_motion_hooks, Qt);
+  // Ferase_buffer ();
+  // Finsert (1, &string);
+  // clear_glyph_matrix (w->desired_matrix);
+  // clear_glyph_matrix (w->current_matrix);
+  // SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
+  // try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
+  // /* Calculate size of tooltip window.  */
   size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil,
-				  make_fixnum (w->pixel_height), Qnil);
+                                  make_fixnum (w->pixel_height), Qnil);
   /* Add the frame's internal border to calculated size.  */
   width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);
   height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);

[-- Attachment #2: Type: text/plain, Size: 744 bytes --]


I had a bit of time today to play with the idea of sticky tooltips. I am
still testing the interaction between tooltips and frame; so I tried
with a timer to keep a tooltip alive long enough so that user can move
mouse into the frame to enable a frame to be sticky (no functionality
yet).

I am having a little bit of a problem there; and I am not really sure
why. When I move mouse slow enough, it works for the most part; but if
mouse is moved quickly it sometimes work, sometimes not, and sometimes a
bit jerky: the tip frame "jumps" after the mouse. I guess it all depends
on timers and how Emacs delivers events. I am not sure what would be the
best strategy to go about this, so I appreciate if someone can give me a
tip (pun intended).

^ permalink raw reply related	[flat|nested] 20+ messages in thread

end of thread, other threads:[~2020-10-22 16:17 UTC | newest]

Thread overview: 20+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-09-28 20:04 Sticky tooltips Arthur Miller
2020-09-28 22:11 ` Jean Louis
2020-09-29  3:39   ` Arthur Miller
2020-09-29  4:20     ` Jean Louis
2020-09-29  2:41 ` Eli Zaretskii
2020-09-29  3:36   ` Arthur Miller
2020-09-29 14:17     ` Eli Zaretskii
2020-09-29 21:30       ` Arthur Miller
2020-09-30 14:50         ` Eli Zaretskii
2020-09-30 15:17           ` Arthur Miller
2020-10-01  2:28           ` Sv: " arthur miller
2020-10-01 12:58             ` Eli Zaretskii
2020-10-02 10:47               ` Sv: " arthur miller
2020-10-05  9:27               ` Arthur Miller
2020-10-05  9:48                 ` Eli Zaretskii
2020-10-05 10:18                   ` Arthur Miller
2020-10-05 10:52                     ` Eli Zaretskii
2020-10-05 11:04                       ` Arthur Miller
  -- strict thread matches above, loose matches on Subject: below --
2020-10-05  0:55 Arthur Miller
2020-10-22 16:17 Arthur Miller

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.