Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Optimizing tool bar refresh #3

Merged
merged 2 commits into from
Nov 25, 2023
Merged

Optimizing tool bar refresh #3

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
37e9bb3
Caching tool bar string to improve performance.
chaosemer Nov 25, 2023
b2faf15
Fixing style issues.
chaosemer Nov 25, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
117 changes: 78 additions & 39 deletions window-tool-bar.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,9 +36,6 @@
;; Remaining work to hit 1.0:
;;
;; * Play with this on for a bit.
;; * Optimize allocations in `window-tool-bar-string' by having it
;; instead return a list of strings, so only items that can become
;; disabled are recalculated.
;; * Upload to MELPA.
;;
;; Post 1.0 work:
Expand All @@ -54,24 +51,28 @@

;;; Code:

(require 'mwheel)
(require 'tab-line)

(defgroup window-tool-bar nil
"Tool bars per-window."
:group 'convenience)

(defvar window-tool-bar--button-keymap
(define-keymap
"<follow-link>" 'mouse-face
;; Follow link on all clicks of mouse-1 and mouse-2 since the tool
;; bar is not a place the point can travel to.
"<tab-line> <mouse-1>" #'window-tool-bar--call-button
"<tab-line> <double-mouse-1>" #'window-tool-bar--call-button
"<tab-line> <triple-mouse-1>" #'window-tool-bar--call-button
"<tab-line> <mouse-2>" #'window-tool-bar--call-button
"<tab-line> <double-mouse-2>" #'window-tool-bar--call-button
"<tab-line> <triple-mouse-2>" #'window-tool-bar--call-button)
"Keymap used by `window-tool-bar--keymap-entry-to-string'.")
(defvar-keymap window-tool-bar--button-keymap
:doc "Keymap used by `window-tool-bar--keymap-entry-to-string'."
"<follow-link>" 'mouse-face
;; Follow link on all clicks of mouse-1 and mouse-2 since the tool
;; bar is not a place the point can travel to.
"<tab-line> <mouse-1>" #'window-tool-bar--call-button
"<tab-line> <double-mouse-1>" #'window-tool-bar--call-button
"<tab-line> <triple-mouse-1>" #'window-tool-bar--call-button
"<tab-line> <mouse-2>" #'window-tool-bar--call-button
"<tab-line> <double-mouse-2>" #'window-tool-bar--call-button
"<tab-line> <triple-mouse-2>" #'window-tool-bar--call-button)
(fset 'window-tool-bar--button-keymap window-tool-bar--button-keymap) ; So it can be a keymap property

(defvar-local window-tool-bar-string--cache nil
"Cache for previous result of `window-tool-bar-string'.")

;;;###autoload
(defun window-tool-bar-string ()
Expand All @@ -80,11 +81,17 @@
This is for when you want more customizations than
`window-tool-bar-mode' provides. Commonly added to the variable
`tab-line-format', `header-line-format', or `mode-line-format'"
(let ((toolbar-menu (cdr (keymap-global-lookup "<tool-bar>"))))
(mapconcat #'window-tool-bar--keymap-entry-to-string toolbar-menu
;; Without spaces between the text, hovering highlights
;; all adjacent buttons.
(propertize " " 'invisible t))))
(when (or (null window-tool-bar-string--cache)
(window-tool-bar--last-command-triggers-refresh-p))
(let ((toolbar-menu (cdr (keymap-global-lookup "<tool-bar>"))))
(setf window-tool-bar-string--cache
(mapconcat #'window-tool-bar--keymap-entry-to-string
toolbar-menu
;; Without spaces between the text, hovering
;; highlights all adjacent buttons.
(propertize " " 'invisible t)))))

window-tool-bar-string--cache)

(defun window-tool-bar--keymap-entry-to-string (menu-item)
"Convert MENU-ITEM into a (propertized) string representation.
Expand All @@ -97,32 +104,32 @@ MENU-ITEM: Menu item to convert. See info node (elisp)Tool Bar."
(pred (string-prefix-p "--")))))
"|")

;; Main workhorse
;; Menu item, turn into propertized string button
(`(,key menu-item ,name-expr ,binding . ,_)
;; Normal menu item, turn into propertized string button
(when binding ; If no binding exists, then button is hidden.
(when binding ; If no binding exists, then button is hidden.
(let* ((name (eval name-expr))
(str (format "[%s]" (eval name-expr)))
(len (length str))
(enable-form (plist-get menu-item :enable))
(enabled (or (not enable-form)
(eval enable-form))))
(setq str (apply #'propertize
(append (list str)
(when enabled
`(mouse-face tab-line-highlight
keymap ,window-tool-bar--button-keymap)))))
(when enabled
(add-text-properties 0 len
'(mouse-face tab-line-highlight
keymap window-tool-bar--button-keymap)
str))
(when-let ((spec (plist-get menu-item :image)))
(setq str (propertize str
'display (append spec
'(:margin 2)
(unless enabled '(:conversion disabled))))))
(if-let ((spec (plist-get menu-item :help)))
(setq str (propertize str
'help-echo spec))
(setq str (propertize str
'help-echo name)))
(setq str (propertize str
'tool-bar-key key))
(put-text-property 0 len
'display
(append spec
(if enabled '(:margin 2)
'(:margin 2 :conversion disabled)))
str))
(put-text-property 0 len
'help-echo
(or (plist-get menu-item :help) name)
str)
(put-text-property 0 len 'tool-bar-key key str)
str)))))

(defun window-tool-bar--call-button ()
Expand All @@ -136,6 +143,38 @@ MENU-ITEM: Menu item to convert. See info node (elisp)Tool Bar."
(cmd (lookup-key global-map (vector 'tool-bar key))))
(call-interactively cmd))))))

(defvar window-tool-bar--ignored-event-types
(list 'mouse-movement
mouse-wheel-up-event mouse-wheel-up-alternate-event
mouse-wheel-down-event mouse-wheel-down-alternate-event
mouse-wheel-left-event mouse-wheel-left-alternate-event
mouse-wheel-right-event mouse-wheel-right-alternate-event
'pinch)
"Cache for `window-tool-bar--last-command-triggers-refresh-p'.")

(defun window-tool-bar--last-command-triggers-refresh-p ()
"Test if the recent command or event should trigger a tool bar refresh."
(let ((type (event-basic-type last-command-event)))
(and
;; Assume that key presses and button presses are the only user
;; interactions that can alter the tool bar. Specifically, this
;; excludes mouse movement, mouse wheel scroll, and pinch.
(not (member type window-tool-bar--ignored-event-types))
;; Assume that any command that triggers shift select can't alter
;; the tool bar. This excludes pure navigation commands.
(not (window-tool-bar--command-triggers-shift-select-p last-command))
;; Assume that self-insert-command won't alter the tool bar.
;; This is the most commonly executed command.
(not (eq last-command 'self-insert-command)))))

(defun window-tool-bar--command-triggers-shift-select-p (command)
"Test if COMMAND would trigger shift select."
(let* ((form (interactive-form command))
(spec (car-safe (cdr-safe form))))
(and (eq (car-safe form) 'interactive)
(stringp spec)
(seq-position spec ?^))))

;;;###autoload
(define-minor-mode window-tool-bar-mode
"Toggle display of the toolbar in the tab line of the current buffer."
Expand Down