Sticky tooltips

[Arthur Miller <arthur.miller@live.com>]

[-- 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?