* bug#68765: 30.0.50; Adding window-tool-bar package.
@ 2024-01-27 23:36 Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-10 8:19 ` Eli Zaretskii
` (2 more replies)
0 siblings, 3 replies; 15+ messages in thread
From: Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-01-27 23:36 UTC (permalink / raw)
To: 68765
[-- Attachment #1: Type: text/plain, Size: 1222 bytes --]
This is a follow-up from bug#68334 where there was interest in adding
support into Emacs core for tool bars in windows.
(https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334#52) I have
attached three changes I authored to accomplish this, two small changes
to tool-bar and tab-line, and then a code drop of my window-tool-bar.el
package. I have not yet put in documentation in NEWS or the manual
about window-tool-bar and was hoping to get a code review done first.
I think it would be good to have window-tool-bar.el also be a package so
that I can keep supporting Emacs 29 as well. I am happy to have this
put on GNU ELPA and would appreciate help in getting that completed.
I am open to renaming the package and public functions if that's
desired. I like the name "window-tool-bar-mode" as it clearly relates
to tool-bar-mode.
After these patches are accepted, I'd also like to clean up the existing
tool bar maps for built in minor modes. This would allow me to address
Eli's request to have a usable tool bar for M-x gdb
(https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334#23).
For tracking purposes, I signed copyright paperwork back in 2020, so
that shouldn't be an issue. Thanks.
-- MJF
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Enable-multiple-modes-to-appear-in-tab-line.patch --]
[-- Type: text/x-diff; name=0001-Enable-multiple-modes-to-appear-in-tab-line.patch, Size: 5255 bytes --]
From 7f344ed1590b81323e24cdedf77477ae57cb49f9 Mon Sep 17 00:00:00 2001
From: Jared Finder <jared@finder.org>
Date: Fri, 26 Jan 2024 09:49:03 -0800
Subject: [PATCH 1/3] Enable multiple modes to appear in tab line
This adds space for window-tool-bar-mode, which will be added in an
upcoming commit.
* lisp/tab-line.el (tab-line-format-template): Add separator space.
(tab-line-display-order): New user variable to control display order.
(tab-line--runtime-display-order, tab-line--cookie): New internal
variables.
(tab-line-set-display): New function for modes to call to enable only
their content.
(tab-line-mode): Call `tab-line-set-display'.
---
lisp/tab-line.el | 89 +++++++++++++++++++++++++++++++++++++++++++-----
1 file changed, 80 insertions(+), 9 deletions(-)
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index cc60f94c9c5..c7283641cbd 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -573,7 +573,8 @@ tab-line-format-template
(when (and (eq tab-line-tabs-function #'tab-line-tabs-window-buffers)
tab-line-new-button-show
tab-line-new-button)
- (list tab-line-new-button)))))
+ (list tab-line-new-button))
+ (list " "))))
(defun tab-line-tab-face-inactive-alternating (tab tabs face _buffer-p selected-p)
"Return FACE for TAB in TABS with alternation.
@@ -997,18 +998,88 @@ tab-line-event-start
(event-start event)))
\f
+;;; Tab line display ordering
+(defcustom tab-line-display-order
+ (copy-tree '(tab-line-mode window-tool-bar-mode))
+ "The order to display content in the tab-line.
+
+This is a list of symbols. By convention, the symbols correspond
+to the mode name that enables / disables content. Any symbol not
+listed here will automatically be put at the end of the tab line.
+
+See `tab-line-set-display' for the Lisp interface to add and
+remove content."
+ :type '(repeat symbol)
+ :group 'tab-line
+ :version "30.1")
+
+(defvar tab-line--runtime-display-order
+ nil
+ "Symbols that contain content but are not in `tab-line-display-order'.
+This list ensures that content stays in a stable position in the
+tab line.")
+
+(defconst tab-line--cookie
+ '(tab-line-set-display nil)
+ "Cookie used by `tab-line-set-display'.
+This is used to tell if the tab line is being set based on
+`tab-line-display-order' or was overridden by the user.")
+
+(defun tab-line-set-display (sym value)
+ "Lisp interface to add or remove content from the tab line.
+
+After calling this, if there is no content in the tab line, it
+will be automatically hidden.
+
+SYM is a symbol, usually the symbol corresponding to the mode
+showing content such as `tab-line-mode'.
+
+VALUE is the content to display and will be added to
+`tab-line-format' at an appropriate index based on
+`tab-line-display-order'. If you want to remove content because
+the mode is being disabled, set this to nil."
+ ;; Preserve tab-line-format if altered outside of this function.
+ (when (or (null tab-line-format)
+ ;; Assume that user modifications will not use this
+ ;; cookie.
+ (equal (car tab-line-format) tab-line--cookie))
+ (let (pos)
+ (setf pos (seq-position tab-line-display-order sym))
+ (unless pos
+ (when-let ((append-pos (seq-position tab-line--runtime-display-order sym)))
+ (setf pos (+ (length tab-line-display-order)
+ append-pos))))
+ (unless pos
+ (warn "Symbol %S not found in `tab-line-display-order'. Putting at end."
+ sym)
+ (setf pos (+ (length tab-line-display-order)
+ (length tab-line--runtime-display-order))
+ tab-line--runtime-display-order
+ (append tab-line--runtime-display-order
+ (list sym))))
+
+ (let ((desired-length (+ pos 2)) ;Plus 1 additional for the cookie,
+ (current-length (length tab-line-format)))
+ (when (> desired-length current-length)
+ (setf tab-line-format
+ (append tab-line-format
+ (make-list (- desired-length current-length) nil))
+ ;; If tab-line-format was nil, then the cookie needs to be set.
+ (car tab-line-format) tab-line--cookie)))
+
+ (setf (nth (1+ pos) tab-line-format) value))
+
+ ;; If the entire display has been disabled, tab line would display
+ ;; as empty. Explicitly hide the tab line in this case.
+ (when (seq-every-p #'null (cdr tab-line-format))
+ (setf tab-line-format nil))))
+\f
;;;###autoload
(define-minor-mode tab-line-mode
"Toggle display of tab line in the windows displaying the current buffer."
:lighter nil
- (let ((default-value '(:eval (tab-line-format))))
- (if tab-line-mode
- ;; Preserve the existing tab-line set outside of this mode
- (unless tab-line-format
- (setq tab-line-format default-value))
- ;; Reset only values set by this mode
- (when (equal tab-line-format default-value)
- (setq tab-line-format nil)))))
+ (tab-line-set-display 'tab-line-mode
+ (if tab-line-mode '(:eval (tab-line-format)) nil)))
(defcustom tab-line-exclude-modes
'(completion-list-mode)
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Add-user-option-to-only-display-default-tool-bar.patch --]
[-- Type: text/x-diff; name=0002-Add-user-option-to-only-display-default-tool-bar.patch, Size: 2068 bytes --]
From ba90ed7f057ea627bd2168d47223396a7bc36c20 Mon Sep 17 00:00:00 2001
From: Jared Finder <jared@finder.org>
Date: Fri, 26 Jan 2024 10:08:30 -0800
Subject: [PATCH 2/3] Add user option to only display default tool bar
This works well with `window-tool-bar-mode', to be added in upcoming
commit. Then the default tool bar is displayed frame-wide and
mode-specific tool bars are displayed in the window that mode is
active in.
* lisp/tool-bar.el (tool-bar-always-show-default): New user option.
(tool-bar--cache-key, tool-bar-make-keymap-1): Return default tool bar
when option is set.
---
lisp/tool-bar.el | 17 +++++++++++++++--
1 file changed, 15 insertions(+), 2 deletions(-)
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 96b61c7b229..685e4dfbb86 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -100,7 +100,9 @@ secondary-tool-bar-map
(defconst tool-bar-keymap-cache (make-hash-table :test #'equal))
(defsubst tool-bar--cache-key ()
- (cons (frame-terminal) (sxhash-eq tool-bar-map)))
+ (cons (frame-terminal)
+ (sxhash-eq (if tool-bar-always-show-default (default-value 'tool-bar-map)
+ tool-bar-map))))
(defsubst tool-bar--secondary-cache-key ()
(cons (frame-terminal) (sxhash-eq secondary-tool-bar-map)))
@@ -191,7 +193,9 @@ tool-bar-make-keymap-1
bind))
(plist-put plist :image image)))
bind))
- (or map tool-bar-map)))
+ (or map
+ (if tool-bar-always-show-default (default-value 'tool-bar-map)
+ tool-bar-map))))
;;;###autoload
(defun tool-bar-add-item (icon def key &rest props)
@@ -377,6 +381,15 @@ tool-bar-setup
(modify-all-frames-parameters
(list (cons 'tool-bar-position val))))))
+(defcustom tool-bar-always-show-default nil
+ "If non-nil, do not show mode-specific tool bars.
+This works well when using `global-window-tool-bar-mode' to
+display the mode-specific tool bars attached to each window."
+ :type 'boolean
+ :group 'frames
+ :group 'mouse
+ :version "30.1")
+
\f
;; Modifier bar mode.
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Adding-window-tool-bar-package.patch --]
[-- Type: text/x-diff; name=0003-Adding-window-tool-bar-package.patch, Size: 21242 bytes --]
From 24ed752ec0bfdded24cba4892426c2c9710126cf Mon Sep 17 00:00:00 2001
From: Jared Finder <jared@finder.org>
Date: Fri, 26 Jan 2024 15:44:12 -0800
Subject: [PATCH 3/3] Adding window-tool-bar package
---
lisp/window-tool-bar.el | 488 ++++++++++++++++++++++++++++++++++++++++
1 file changed, 488 insertions(+)
create mode 100644 lisp/window-tool-bar.el
diff --git a/lisp/window-tool-bar.el b/lisp/window-tool-bar.el
new file mode 100644
index 00000000000..3950fe12f1a
--- /dev/null
+++ b/lisp/window-tool-bar.el
@@ -0,0 +1,488 @@
+;;; window-tool-bar.el --- Add tool bars inside windows -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
+;; Author: Jared Finder <jared@finder.org>
+;; Created: Nov 21, 2023
+;; Version: 0.2
+;; Keywords: mouse
+;; URL: http://github.com/chaosemer/window-tool-bar
+;; Package-Requires: ((emacs "29.1"))
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package puts a tool bar in each window. This allows you to see
+;; multiple tool bars simultaneously directly next to the buffer it
+;; acts on which feels much more intuitive. Emacs "browsing" modes
+;; generally have sensible tool bars, for example: *info*, *help*, and
+;; *eww* have them.
+;;
+;; It does this while being mindful of screen real estate. Most modes
+;; do not provide a custom tool bar, and this package does not show the
+;; default tool bar. This means that for most buffers there will be no
+;; space taken up. Furthermore, you can put this tool bar in the mode
+;; line or tab line if you want to share it with existing content.
+;;
+;; To get the default behavior, run (global-window-tool-bar-mode 1) or
+;; enable via M-x customize-group RET window-tool-bar RET. This uses
+;; the per-window tab line to show the tool bar.
+;;
+;; If you want to share space with an existing tab line, mode line, or
+;; header line, add (:eval (window-tool-bar-string)) to
+;; `tab-line-format', `mode-line-format', or `header-line-format'.
+
+;;; Known issues:
+;;
+;; On GNU Emacs 29.1, terminals dragging to resize windows will error
+;; with message "<tab-line> <mouse-movement> is undefined". This is a
+;; bug in GNU Emacs,
+;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=67457>.
+;;
+;; On GNU Emacs 29, performance in terminals is lower than on
+;; graphical frames. This is due to a workaround, see "Workaround for
+;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334", below.
+
+;;; Todo:
+;;
+;; Not all features planned are implemented yet. Eventually I would
+;; like to also generally make tool bars better.
+;;
+;; Targeting 0.3:
+;; * Properly support reamining less frequently used tool bar item specs. From
+;; `parse_tool_bar_item':
+;; * :visible
+;; * :filter
+;; * :button
+;; * :wrap
+;; * Add display customization similar to `tool-bar-style'.
+;;
+;; Targeting 1.0:
+;;
+;; * Clean up Emacs tool bars
+;; * Default: Remove default tool-bar entirely
+;; * grep, vc: Remove default tool-bar inherited
+;; * info: Remove Next / Prev / Up, which is already in the header
+;; * smerge: Add tool bar for next/prev
+;;
+;; Post 1.0 work:
+;;
+;; * Show keyboard shortcut on help text.
+;;
+;; * Add a bit more documentation.
+;; * Add customization option: ignore-default-tool-bar-map
+;; * Make tab-line dragging resize the window
+
+;;; Code:
+
+(require 'mwheel)
+(require 'tab-line)
+(require 'tool-bar)
+\f
+;;; Benchmarking code
+;;
+;; Refreshing the tool bar is computationally simple, but generates a
+;; lot of garbage. So this benchmarking focuses on garbage
+;; generation. Since it has to run after most commands, generating
+;; significantly more garbage will cause noticeable performance
+;; degration.
+;;
+;; The refresh has two steps:
+;;
+;; Step 1: Look up the <tool-bar> map.
+;; Step 2: Generate a Lisp string using text properties for the tool
+;; bar string.
+;;
+;; Additionally, we keep track of the percentage of commands that
+;; acutally created a refresh.
+(defvar window-tool-bar--memory-use-delta-step1 (make-list 7 0)
+ "Absolute delta of memory use counters during step 1.
+This is a list in the same structure as `memory-use-counts'.")
+(defvar window-tool-bar--memory-use-delta-step2 (make-list 7 0)
+ "Absolute delta of memory use counters during step 2.
+This is a list in the same structure as `memory-use-counts'.")
+(defvar window-tool-bar--refresh-done-count 0
+ "Number of tool bar string refreshes run.
+The total number of requests is the sum of this and
+`window-tool-bar--refresh-skipped-count'.")
+(defvar window-tool-bar--refresh-skipped-count 0
+ "Number of tool bar string refreshes that were skipped.
+The total number of requests is the sum of this and
+`window-tool-bar--refresh-done-count'.")
+
+(defun window-tool-bar--memory-use-avg-step1 ()
+ "Return average memory use delta during step 1."
+ (mapcar (lambda (elt) (/ elt window-tool-bar--refresh-done-count 1.0))
+ window-tool-bar--memory-use-delta-step1))
+
+(defun window-tool-bar--memory-use-avg-step2 ()
+ "Return average memory use delta during step 2."
+ (mapcar (lambda (elt) (/ elt window-tool-bar--refresh-done-count 1.0))
+ window-tool-bar--memory-use-delta-step2))
+
+(declare-function time-stamp-string "time-stamp")
+
+(defun window-tool-bar-show-memory-use ()
+ "Pop up a window showing the memory use metrics."
+ (interactive)
+ (require 'time-stamp)
+ (save-selected-window
+ (pop-to-buffer "*WTB Memory Report*")
+ (unless (eq major-mode 'special-mode)
+ (special-mode))
+
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (propertize (concat "Function: window-tool-bar-string "
+ (time-stamp-string))
+ 'face 'underline 'font-lock-face 'underline)
+ "\n\n")
+ (window-tool-bar--insert-memory-use
+ "Step 1" (window-tool-bar--memory-use-avg-step1))
+ (window-tool-bar--insert-memory-use
+ "Step 2" (window-tool-bar--memory-use-avg-step2))
+ (insert (format "Refresh count %d\n" window-tool-bar--refresh-done-count)
+ (format "Refresh executed percent %.2f\n"
+ (/ window-tool-bar--refresh-done-count
+ (+ window-tool-bar--refresh-done-count
+ window-tool-bar--refresh-skipped-count)
+ 1.0))
+ "\n"))))
+
+(defun window-tool-bar--insert-memory-use (label avg-memory-use)
+ "Insert memory use into current buffer.
+
+LABEL: A prefix string to be in front of the data.
+AVG-MEMORY-USE: A list of averages, with the same meaning as
+ `memory-use-counts'."
+ (let* ((label-len (length label))
+ (padding (make-string label-len ?\s)))
+ (insert (format "%s %8.2f Conses\n" label (elt avg-memory-use 0)))
+ (insert (format "%s %8.2f Floats\n" padding (elt avg-memory-use 1)))
+ (insert (format "%s %8.2f Vector cells\n" padding (elt avg-memory-use 2)))
+ (insert (format "%s %8.2f Symbols\n" padding (elt avg-memory-use 3)))
+ (insert (format "%s %8.2f String chars\n" padding (elt avg-memory-use 4)))
+ (insert (format "%s %8.2f Intervals\n" padding (elt avg-memory-use 5)))
+ (insert (format "%s %8.2f Strings\n" padding (elt avg-memory-use 6)))))
+\f
+(defgroup window-tool-bar nil
+ "Tool bars per-window."
+ :group 'convenience
+ :prefix "window-tool-bar-")
+
+(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
+
+ ;; Mouse down events do nothing. A binding is needed so isearch
+ ;; does not exit when the tab bar is clicked.
+ "<tab-line> <down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <double-down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <triple-down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <down-mouse-2>" #'window-tool-bar--ignore
+ "<tab-line> <double-down-mouse-2>" #'window-tool-bar--ignore
+ "<tab-line> <triple-down-mouse-2>" #'window-tool-bar--ignore)
+(fset 'window-tool-bar--button-keymap window-tool-bar--button-keymap) ; So it can be a keymap property
+
+;; Register bindings that stay in isearch. Technically, these
+;; commands don't pop up a menu but they act very similar in that they
+;; end up calling an actual command via `call-interactively'.
+(push 'window-tool-bar--call-button isearch-menu-bar-commands)
+(push 'window-tool-bar--ignore isearch-menu-bar-commands)
+
+(defvar-local window-tool-bar-string--cache nil
+ "Cache for previous result of `window-tool-bar-string'.")
+
+;;;###autoload
+(defun window-tool-bar-string ()
+ "Return a (propertized) string for the tool bar.
+
+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'"
+ (if (or (null window-tool-bar-string--cache)
+ (window-tool-bar--last-command-triggers-refresh-p))
+ (let* ((mem0 (memory-use-counts))
+ (toolbar-menu (window-tool-bar--get-keymap))
+ (mem1 (memory-use-counts))
+ (result (mapconcat #'window-tool-bar--keymap-entry-to-string
+ (cdr toolbar-menu) ;Skip 'keymap
+ ;; Without spaces between the text, hovering
+ ;; highlights all adjacent buttons.
+ (if (window-tool-bar--use-images)
+ (propertize " " 'invisible t)
+ " ")))
+ (mem2 (memory-use-counts)))
+ (cl-mapl (lambda (l-init l0 l1)
+ (cl-incf (car l-init) (- (car l1) (car l0))))
+ window-tool-bar--memory-use-delta-step1 mem0 mem1)
+ (cl-mapl (lambda (l-init l1 l2)
+ (cl-incf (car l-init) (- (car l2) (car l1))))
+ window-tool-bar--memory-use-delta-step2 mem1 mem2)
+
+ (setf window-tool-bar-string--cache
+ (concat
+ ;; The tool bar face by default puts boxes around the
+ ;; buttons. However, this box is not displayed if the
+ ;; box starts at the leftmost pixel of the tab-line.
+ ;; Add a single space in this case so the box displays
+ ;; correctly.
+ (when (display-supports-face-attributes-p
+ '(:box (line-width 1)))
+ (propertize " " 'display '(space :width (1))))
+ result))
+ (cl-incf window-tool-bar--refresh-done-count))
+ (cl-incf window-tool-bar--refresh-skipped-count))
+
+ window-tool-bar-string--cache)
+
+(defconst window-tool-bar--graphical-separator
+ (let ((str (make-string 3 ?\s)))
+ (set-text-properties 0 1 '(display (space :width (4))) str)
+ (set-text-properties 1 2
+ '(display (space :width (1))
+ face (:inverse-video t))
+ str)
+ (set-text-properties 2 3 '(display (space :width (4))) str)
+ str))
+
+(defun window-tool-bar--keymap-entry-to-string (menu-item)
+ "Convert MENU-ITEM into a (propertized) string representation.
+
+MENU-ITEM: Menu item to convert. See info node (elisp)Tool Bar."
+ (pcase menu-item
+ ;; Separators
+ ((or `(,_ "--")
+ `(,_ menu-item ,(and (pred stringp)
+ (pred (string-prefix-p "--")))))
+ (if (window-tool-bar--use-images)
+ window-tool-bar--graphical-separator
+ "|"))
+
+ ;; Menu item, turn into propertized string button
+ (`(,key menu-item ,name-expr ,binding . ,plist)
+ (when binding ; If no binding exists, then button is hidden.
+ (let* ((name (eval name-expr))
+ (str (upcase-initials (or (plist-get plist :label)
+ (string-trim-right name "\\.+"))))
+ (len (length str))
+ (enable-form (plist-get plist :enable))
+ (enabled (or (not enable-form)
+ (eval enable-form))))
+ (if enabled
+ (add-text-properties 0 len
+ '(mouse-face window-tool-bar-button-hover
+ keymap window-tool-bar--button-keymap
+ face window-tool-bar-button)
+ str)
+ (put-text-property 0 len
+ 'face
+ 'window-tool-bar-button-disabled
+ str))
+ (when-let ((spec (and (window-tool-bar--use-images)
+ (plist-get menu-item :image))))
+ (put-text-property 0 len
+ 'display
+ (append spec
+ (if enabled '(:margin 2 :ascent center)
+ '(:margin 2 :ascent center
+ :conversion disabled)))
+ str))
+ (put-text-property 0 len
+ 'help-echo
+ (or (plist-get plist :help) name)
+ str)
+ (put-text-property 0 len 'tool-bar-key key str)
+ str)))))
+
+(defun window-tool-bar--call-button ()
+ "Call the button that was clicked on in the tab line."
+ (interactive)
+ (when (mouse-event-p last-command-event)
+ (let ((posn (event-start last-command-event)))
+ ;; Commands need to execute with the right buffer and window
+ ;; selected. The selection needs to be permanent for isearch.
+ (select-window (posn-window posn))
+ (let* ((str (posn-string posn))
+ (key (get-text-property (cdr str) 'tool-bar-key (car str)))
+ (cmd (lookup-key (window-tool-bar--get-keymap) (vector key))))
+ (call-interactively cmd)))))
+
+(defun window-tool-bar--ignore ()
+ "Do nothing. This command exists for isearch."
+ (interactive)
+ nil)
+
+(defvar window-tool-bar--ignored-event-types
+ (let ((list (list 'mouse-movement 'pinch
+ 'wheel-down 'wheel-up 'wheel-left 'wheel-right
+ mouse-wheel-down-event mouse-wheel-up-event
+ mouse-wheel-left-event mouse-wheel-right-event
+ (bound-and-true-p mouse-wheel-down-alternate-event)
+ (bound-and-true-p mouse-wheel-up-alternate-event)
+ (bound-and-true-p mouse-wheel-left-alternate-event)
+ (bound-and-true-p mouse-wheel-right-alternate-event))))
+ (delete-dups (delete nil list)))
+ "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 tool bar in the tab line of the current buffer."
+ :lighter nil
+ (let ((should-display (and window-tool-bar-mode
+ (not (eq tool-bar-map
+ (default-value 'tool-bar-map))))))
+ (if (fboundp 'tab-line-set-display)
+ ;; Newly added function for Emacs 30.
+ (tab-line-set-display 'window-tool-bar-mode
+ (and should-display
+ '(:eval (window-tool-bar-string))))
+ ;; Legacy path for Emacs 29.
+ (setq tab-line-format
+ (and should-display
+ '(:eval (window-tool-bar-string)))))))
+
+;;;###autoload
+(define-globalized-minor-mode global-window-tool-bar-mode
+ window-tool-bar-mode window-tool-bar--turn-on
+ :group 'window-tool-bar
+ (add-hook 'isearch-mode-hook #'window-tool-bar--turn-on)
+ (add-hook 'isearch-mode-end-hook #'window-tool-bar--turn-on))
+
+(defvar window-tool-bar--allow-images t
+ "Internal debug flag to force text mode.")
+
+(defun window-tool-bar--use-images ()
+ "Internal function.
+Respects `window-tool-bar--allow-images' as well as frame
+capabilities."
+ (and window-tool-bar--allow-images
+ (display-images-p)))
+\f
+;;; Display styling:
+(defface window-tool-bar-button
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88) (supports :box t))
+ :box (:line-width -1 :style released-button)
+ :background "grey85")
+ ;; If the box is not supported, dim the button background a bit.
+ (((class color) (min-colors 88))
+ :background "grey70")
+ (t
+ :inverse-video t))
+ "Face used for buttons when the mouse is not hovering over the button."
+ :group 'window-tool-bar)
+
+(defface window-tool-bar-button-hover
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88))
+ :box (:line-width -1 :style released-button)
+ :background "grey95")
+ (t
+ :inverse-video t))
+ "Face used for buttons when the mouse is hovering over the button."
+ :group 'window-tool-bar)
+
+(defface window-tool-bar-button-disabled
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88))
+ :box (:line-width -1 :style released-button)
+ :background "grey50"
+ :foreground "grey70")
+ (t
+ :inverse-video t
+ :background "brightblack"))
+ "Face used for buttons when the button is disabled."
+ :group 'window-tool-bar)
+\f
+;;; Workaround for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334.
+(defun window-tool-bar--get-keymap ()
+ "Return the tool bar keymap."
+ (let ((tool-bar-always-show-default nil))
+ (if (and (version< emacs-version "30")
+ (not (window-tool-bar--use-images)))
+ ;; This code path is a less efficient workaround.
+ (window-tool-bar--make-keymap-1)
+ (keymap-global-lookup "<tool-bar>"))))
+
+(declare-function image-mask-p "image.c" (spec &optional frame))
+
+(defun window-tool-bar--make-keymap-1 ()
+ "Patched copy of `tool-bar-make-keymap-1'."
+ (mapcar (lambda (bind)
+ (let (image-exp plist)
+ (when (and (eq (car-safe (cdr-safe bind)) 'menu-item)
+ ;; For the format of menu-items, see node
+ ;; `Extended Menu Items' in the Elisp manual.
+ (setq plist (nthcdr (if (consp (nth 4 bind)) 5 4)
+ bind))
+ (setq image-exp (plist-get plist :image))
+ (consp image-exp)
+ (not (eq (car image-exp) 'image))
+ (fboundp (car image-exp)))
+ (let ((image (and (display-images-p)
+ (eval image-exp))))
+ (unless (and image (image-mask-p image))
+ (setq image (append image '(:mask heuristic))))
+ (setq bind (copy-sequence bind)
+ plist (nthcdr (if (consp (nth 4 bind)) 5 4)
+ bind))
+ (plist-put plist :image image)))
+ bind))
+ tool-bar-map))
+
+(defun window-tool-bar--turn-on ()
+ "Internal function called by `global-window-tool-bar-mode'."
+ (when global-window-tool-bar-mode
+ (window-tool-bar-mode 1)))
+
+(provide 'window-tool-bar)
+
+;;; window-tool-bar.el ends here
--
2.39.2
^ permalink raw reply related [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-01-27 23:36 bug#68765: 30.0.50; Adding window-tool-bar package Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-10 8:19 ` Eli Zaretskii
2024-02-10 17:25 ` Juri Linkov
2024-02-11 20:51 ` Philip Kaludercic
2024-02-27 3:02 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2 siblings, 1 reply; 15+ messages in thread
From: Eli Zaretskii @ 2024-02-10 8:19 UTC (permalink / raw)
To: Jared Finder, Juri Linkov, Philip Kaludercic, Stefan Monnier; +Cc: 68765
> Date: Sat, 27 Jan 2024 15:36:56 -0800
> From: Jared Finder via "Bug reports for GNU Emacs,
> the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
>
> This is a follow-up from bug#68334 where there was interest in adding
> support into Emacs core for tool bars in windows.
> (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334#52) I have
> attached three changes I authored to accomplish this, two small changes
> to tool-bar and tab-line, and then a code drop of my window-tool-bar.el
> package. I have not yet put in documentation in NEWS or the manual
> about window-tool-bar and was hoping to get a code review done first.
Thanks, please find some review comments below.
> Subject: [PATCH 1/3] Enable multiple modes to appear in tab line
>
> This adds space for window-tool-bar-mode, which will be added in an
> upcoming commit.
>
> * lisp/tab-line.el (tab-line-format-template): Add separator space.
> (tab-line-display-order): New user variable to control display order.
> (tab-line--runtime-display-order, tab-line--cookie): New internal
> variables.
> (tab-line-set-display): New function for modes to call to enable only
> their content.
> (tab-line-mode): Call `tab-line-set-display'.
Juri, would you please review this part of the changeset?
> Subject: [PATCH 2/3] Add user option to only display default tool bar
>
> This works well with `window-tool-bar-mode', to be added in upcoming
> commit. Then the default tool bar is displayed frame-wide and
> mode-specific tool bars are displayed in the window that mode is
> active in.
>
> * lisp/tool-bar.el (tool-bar-always-show-default): New user option.
> (tool-bar--cache-key, tool-bar-make-keymap-1): Return default tool bar
> when option is set.
> ---
> lisp/tool-bar.el | 17 +++++++++++++++--
> 1 file changed, 15 insertions(+), 2 deletions(-)
>
> diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
> index 96b61c7b229..685e4dfbb86 100644
> --- a/lisp/tool-bar.el
> +++ b/lisp/tool-bar.el
> @@ -100,7 +100,9 @@ secondary-tool-bar-map
> (defconst tool-bar-keymap-cache (make-hash-table :test #'equal))
>
> (defsubst tool-bar--cache-key ()
> - (cons (frame-terminal) (sxhash-eq tool-bar-map)))
> + (cons (frame-terminal)
> + (sxhash-eq (if tool-bar-always-show-default (default-value 'tool-bar-map)
> + tool-bar-map))))
>
> (defsubst tool-bar--secondary-cache-key ()
> (cons (frame-terminal) (sxhash-eq secondary-tool-bar-map)))
> @@ -191,7 +193,9 @@ tool-bar-make-keymap-1
> bind))
> (plist-put plist :image image)))
> bind))
> - (or map tool-bar-map)))
> + (or map
> + (if tool-bar-always-show-default (default-value 'tool-bar-map)
> + tool-bar-map))))
>
> ;;;###autoload
> (defun tool-bar-add-item (icon def key &rest props)
> @@ -377,6 +381,15 @@ tool-bar-setup
> (modify-all-frames-parameters
> (list (cons 'tool-bar-position val))))))
>
> +(defcustom tool-bar-always-show-default nil
> + "If non-nil, do not show mode-specific tool bars.
Double negation alert!
> I think it would be good to have window-tool-bar.el also be a package so
> that I can keep supporting Emacs 29 as well. I am happy to have this
> put on GNU ELPA and would appreciate help in getting that completed.
> [...]
> From 24ed752ec0bfdded24cba4892426c2c9710126cf Mon Sep 17 00:00:00 2001
> From: Jared Finder <jared@finder.org>
> Date: Fri, 26 Jan 2024 15:44:12 -0800
>
> ---
> lisp/window-tool-bar.el | 488 ++++++++++++++++++++++++++++++++++++++++
> 1 file changed, 488 insertions(+)
> create mode 100644 lisp/window-tool-bar.el
Philip and Stefan, would you please review this additional package,
which AFAIU is being proposed as a cofre package for ELPA?
> +This works well when using `global-window-tool-bar-mode' to
> +display the mode-specific tool bars attached to each window."
I don't think I understand what you mean by "mode-specific tool bars".
The doc string doesn't explain that, so it is not clear enough, IMO.
> +(defun window-tool-bar-show-memory-use ()
> + "Pop up a window showing the memory use metrics."
I'm not sure I understand why this package needs to be interested in
memory usage. It sounds like a separate feature.
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-02-10 8:19 ` Eli Zaretskii
@ 2024-02-10 17:25 ` Juri Linkov
2024-02-26 22:38 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 15+ messages in thread
From: Juri Linkov @ 2024-02-10 17:25 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: Philip Kaludercic, Jared Finder, Stefan Monnier, 68765
>> * lisp/tab-line.el (tab-line-format-template): Add separator space.
>> (tab-line-display-order): New user variable to control display order.
>> (tab-line--runtime-display-order, tab-line--cookie): New internal
>> variables.
>> (tab-line-set-display): New function for modes to call to enable only
>> their content.
>> (tab-line-mode): Call `tab-line-set-display'.
>
> Juri, would you please review this part of the changeset?
I'm not sure if this provides a clean interface.
Have you tried to show both window-tool-bar and tab-line tabs
on the same tab-line? Do you think this combination is usable?
Or maybe better just repurpose the tab-line in window-tool-bar.el
exclusively for window-local tool-bar?
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-01-27 23:36 bug#68765: 30.0.50; Adding window-tool-bar package Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-10 8:19 ` Eli Zaretskii
@ 2024-02-11 20:51 ` Philip Kaludercic
2024-02-27 3:02 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2 siblings, 0 replies; 15+ messages in thread
From: Philip Kaludercic @ 2024-02-11 20:51 UTC (permalink / raw)
To: Jared Finder; +Cc: 68765
Here are a few comments from a quick skim:
> diff --git a/lisp/window-tool-bar.el b/lisp/window-tool-bar.el
> new file mode 100644
> index 00000000000..3950fe12f1a
> --- /dev/null
> +++ b/lisp/window-tool-bar.el
> @@ -0,0 +1,488 @@
> +;;; window-tool-bar.el --- Add tool bars inside windows -*- lexical-binding: t -*-
> +
> +;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
Leave an empty line here, looks more conventional.
> +;; Author: Jared Finder <jared@finder.org>
> +;; Created: Nov 21, 2023
> +;; Version: 0.2
> +;; Keywords: mouse
> +;; URL: http://github.com/chaosemer/window-tool-bar
If the idea is for this to be a core package, that is developed in the
core, then I don't know if you want to keep this URL.
> +;; Package-Requires: ((emacs "29.1"))
> +
> +;; This file is part of GNU Emacs.
> +
> +;; GNU Emacs is free software; you can redistribute it and/or modify
> +;; it under the terms of the GNU General Public License as published by
> +;; the Free Software Foundation, either version 3 of the License, or
> +;; (at your option) any later version.
> +
> +;; GNU Emacs is distributed in the hope that it will be useful,
> +;; but WITHOUT ANY WARRANTY; without even the implied warranty of
> +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +;; GNU General Public License for more details.
> +
> +;; You should have received a copy of the GNU General Public License
> +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
> +
> +;;; Commentary:
> +;;
> +;; This package puts a tool bar in each window. This allows you to see
> +;; multiple tool bars simultaneously directly next to the buffer it
> +;; acts on which feels much more intuitive. Emacs "browsing" modes
> +;; generally have sensible tool bars, for example: *info*, *help*, and
> +;; *eww* have them.
> +;;
> +;; It does this while being mindful of screen real estate. Most modes
> +;; do not provide a custom tool bar, and this package does not show the
> +;; default tool bar. This means that for most buffers there will be no
> +;; space taken up. Furthermore, you can put this tool bar in the mode
> +;; line or tab line if you want to share it with existing content.
> +;;
> +;; To get the default behavior, run (global-window-tool-bar-mode 1) or
> +;; enable via M-x customize-group RET window-tool-bar RET. This uses
> +;; the per-window tab line to show the tool bar.
> +;;
> +;; If you want to share space with an existing tab line, mode line, or
> +;; header line, add (:eval (window-tool-bar-string)) to
> +;; `tab-line-format', `mode-line-format', or `header-line-format'.
> +
> +;;; Known issues:
> +;;
> +;; On GNU Emacs 29.1, terminals dragging to resize windows will error
> +;; with message "<tab-line> <mouse-movement> is undefined". This is a
> +;; bug in GNU Emacs,
> +;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=67457>.
> +;;
> +;; On GNU Emacs 29, performance in terminals is lower than on
> +;; graphical frames. This is due to a workaround, see "Workaround for
> +;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334", below.
> +
> +;;; Todo:
> +;;
> +;; Not all features planned are implemented yet. Eventually I would
> +;; like to also generally make tool bars better.
> +;;
> +;; Targeting 0.3:
> +;; * Properly support reamining less frequently used tool bar item specs. From
> +;; `parse_tool_bar_item':
> +;; * :visible
> +;; * :filter
> +;; * :button
> +;; * :wrap
> +;; * Add display customization similar to `tool-bar-style'.
> +;;
> +;; Targeting 1.0:
> +;;
> +;; * Clean up Emacs tool bars
> +;; * Default: Remove default tool-bar entirely
> +;; * grep, vc: Remove default tool-bar inherited
> +;; * info: Remove Next / Prev / Up, which is already in the header
> +;; * smerge: Add tool bar for next/prev
> +;;
> +;; Post 1.0 work:
> +;;
> +;; * Show keyboard shortcut on help text.
> +;;
> +;; * Add a bit more documentation.
> +;; * Add customization option: ignore-default-tool-bar-map
> +;; * Make tab-line dragging resize the window
> +
> +;;; Code:
> +
> +(require 'mwheel)
> +(require 'tab-line)
> +(require 'tool-bar)
> +\f
> +;;; Benchmarking code
> +;;
> +;; Refreshing the tool bar is computationally simple, but generates a
> +;; lot of garbage. So this benchmarking focuses on garbage
> +;; generation. Since it has to run after most commands, generating
> +;; significantly more garbage will cause noticeable performance
> +;; degration.
> +;;
> +;; The refresh has two steps:
> +;;
> +;; Step 1: Look up the <tool-bar> map.
> +;; Step 2: Generate a Lisp string using text properties for the tool
> +;; bar string.
> +;;
> +;; Additionally, we keep track of the percentage of commands that
> +;; acutally created a refresh.
> +(defvar window-tool-bar--memory-use-delta-step1 (make-list 7 0)
> + "Absolute delta of memory use counters during step 1.
> +This is a list in the same structure as `memory-use-counts'.")
> +(defvar window-tool-bar--memory-use-delta-step2 (make-list 7 0)
> + "Absolute delta of memory use counters during step 2.
> +This is a list in the same structure as `memory-use-counts'.")
> +(defvar window-tool-bar--refresh-done-count 0
> + "Number of tool bar string refreshes run.
> +The total number of requests is the sum of this and
> +`window-tool-bar--refresh-skipped-count'.")
> +(defvar window-tool-bar--refresh-skipped-count 0
> + "Number of tool bar string refreshes that were skipped.
> +The total number of requests is the sum of this and
> +`window-tool-bar--refresh-done-count'.")
> +
> +(defun window-tool-bar--memory-use-avg-step1 ()
> + "Return average memory use delta during step 1."
> + (mapcar (lambda (elt) (/ elt window-tool-bar--refresh-done-count 1.0))
You can also use (float elt) to avoid the 1.0 at the end.
> + window-tool-bar--memory-use-delta-step1))
> +
> +(defun window-tool-bar--memory-use-avg-step2 ()
> + "Return average memory use delta during step 2."
> + (mapcar (lambda (elt) (/ elt window-tool-bar--refresh-done-count 1.0))
> + window-tool-bar--memory-use-delta-step2))
> +
> +(declare-function time-stamp-string "time-stamp")
> +
> +(defun window-tool-bar-show-memory-use ()
> + "Pop up a window showing the memory use metrics."
> + (interactive)
> + (require 'time-stamp)
> + (save-selected-window
> + (pop-to-buffer "*WTB Memory Report*")
I think you should rewrite this as
(with-current-buffer (get-buffer "...")
;; ...
(pop-to-buffer (current-buffer))
> + (unless (eq major-mode 'special-mode)
> + (special-mode))
> +
> + (goto-char (point-max))
> + (let ((inhibit-read-only t))
> + (insert (propertize (concat "Function: window-tool-bar-string "
> + (time-stamp-string))
> + 'face 'underline 'font-lock-face 'underline)
> + "\n\n")
> + (window-tool-bar--insert-memory-use
> + "Step 1" (window-tool-bar--memory-use-avg-step1))
> + (window-tool-bar--insert-memory-use
> + "Step 2" (window-tool-bar--memory-use-avg-step2))
> + (insert (format "Refresh count %d\n" window-tool-bar--refresh-done-count)
> + (format "Refresh executed percent %.2f\n"
> + (/ window-tool-bar--refresh-done-count
> + (+ window-tool-bar--refresh-done-count
> + window-tool-bar--refresh-skipped-count)
> + 1.0))
> + "\n"))))
> +
> +(defun window-tool-bar--insert-memory-use (label avg-memory-use)
> + "Insert memory use into current buffer.
> +
> +LABEL: A prefix string to be in front of the data.
> +AVG-MEMORY-USE: A list of averages, with the same meaning as
> + `memory-use-counts'."
> + (let* ((label-len (length label))
> + (padding (make-string label-len ?\s)))
> + (insert (format "%s %8.2f Conses\n" label (elt avg-memory-use 0)))
> + (insert (format "%s %8.2f Floats\n" padding (elt avg-memory-use 1)))
> + (insert (format "%s %8.2f Vector cells\n" padding (elt avg-memory-use 2)))
> + (insert (format "%s %8.2f Symbols\n" padding (elt avg-memory-use 3)))
> + (insert (format "%s %8.2f String chars\n" padding (elt avg-memory-use 4)))
> + (insert (format "%s %8.2f Intervals\n" padding (elt avg-memory-use 5)))
> + (insert (format "%s %8.2f Strings\n" padding (elt avg-memory-use 6)))))
You should be able to make this slightly more readable by looping over a
list like '("Conses" "Floats" ...), e.g. using cl-loop
(cl-loop for section = '("Conses" "Floats")
for usage = avg-memory-use
do (insert (format "%s %8.2f %s\n" padding usage section)))
> +\f
> +(defgroup window-tool-bar nil
> + "Tool bars per-window."
> + :group 'convenience
> + :prefix "window-tool-bar-")
> +
> +(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
> +
> + ;; Mouse down events do nothing. A binding is needed so isearch
> + ;; does not exit when the tab bar is clicked.
> + "<tab-line> <down-mouse-1>" #'window-tool-bar--ignore
> + "<tab-line> <double-down-mouse-1>" #'window-tool-bar--ignore
> + "<tab-line> <triple-down-mouse-1>" #'window-tool-bar--ignore
> + "<tab-line> <down-mouse-2>" #'window-tool-bar--ignore
> + "<tab-line> <double-down-mouse-2>" #'window-tool-bar--ignore
> + "<tab-line> <triple-down-mouse-2>" #'window-tool-bar--ignore)
> +(fset 'window-tool-bar--button-keymap window-tool-bar--button-keymap) ; So it can be a keymap property
> +
> +;; Register bindings that stay in isearch. Technically, these
> +;; commands don't pop up a menu but they act very similar in that they
> +;; end up calling an actual command via `call-interactively'.
> +(push 'window-tool-bar--call-button isearch-menu-bar-commands)
> +(push 'window-tool-bar--ignore isearch-menu-bar-commands)
> +
> +(defvar-local window-tool-bar-string--cache nil
> + "Cache for previous result of `window-tool-bar-string'.")
> +
> +;;;###autoload
> +(defun window-tool-bar-string ()
> + "Return a (propertized) string for the tool bar.
> +
> +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'"
> + (if (or (null window-tool-bar-string--cache)
> + (window-tool-bar--last-command-triggers-refresh-p))
> + (let* ((mem0 (memory-use-counts))
> + (toolbar-menu (window-tool-bar--get-keymap))
> + (mem1 (memory-use-counts))
> + (result (mapconcat #'window-tool-bar--keymap-entry-to-string
> + (cdr toolbar-menu) ;Skip 'keymap
> + ;; Without spaces between the text, hovering
> + ;; highlights all adjacent buttons.
> + (if (window-tool-bar--use-images)
> + (propertize " " 'invisible t)
> + " ")))
> + (mem2 (memory-use-counts)))
> + (cl-mapl (lambda (l-init l0 l1)
> + (cl-incf (car l-init) (- (car l1) (car l0))))
> + window-tool-bar--memory-use-delta-step1 mem0 mem1)
> + (cl-mapl (lambda (l-init l1 l2)
> + (cl-incf (car l-init) (- (car l2) (car l1))))
> + window-tool-bar--memory-use-delta-step2 mem1 mem2)
> +
> + (setf window-tool-bar-string--cache
> + (concat
> + ;; The tool bar face by default puts boxes around the
> + ;; buttons. However, this box is not displayed if the
> + ;; box starts at the leftmost pixel of the tab-line.
> + ;; Add a single space in this case so the box displays
> + ;; correctly.
> + (when (display-supports-face-attributes-p
> + '(:box (line-width 1)))
> + (propertize " " 'display '(space :width (1))))
> + result))
> + (cl-incf window-tool-bar--refresh-done-count))
> + (cl-incf window-tool-bar--refresh-skipped-count))
> +
> + window-tool-bar-string--cache)
> +
> +(defconst window-tool-bar--graphical-separator
> + (let ((str (make-string 3 ?\s)))
> + (set-text-properties 0 1 '(display (space :width (4))) str)
> + (set-text-properties 1 2
> + '(display (space :width (1))
> + face (:inverse-video t))
> + str)
> + (set-text-properties 2 3 '(display (space :width (4))) str)
> + str))
> +
> +(defun window-tool-bar--keymap-entry-to-string (menu-item)
> + "Convert MENU-ITEM into a (propertized) string representation.
> +
> +MENU-ITEM: Menu item to convert. See info node (elisp)Tool Bar."
^
quote this in `...'
for the hyperlink to work.
> + (pcase menu-item
> + ;; Separators
> + ((or `(,_ "--")
> + `(,_ menu-item ,(and (pred stringp)
> + (pred (string-prefix-p "--")))))
> + (if (window-tool-bar--use-images)
> + window-tool-bar--graphical-separator
> + "|"))
> +
> + ;; Menu item, turn into propertized string button
> + (`(,key menu-item ,name-expr ,binding . ,plist)
> + (when binding ; If no binding exists, then button is hidden.
> + (let* ((name (eval name-expr))
> + (str (upcase-initials (or (plist-get plist :label)
> + (string-trim-right name "\\.+"))))
> + (len (length str))
> + (enable-form (plist-get plist :enable))
> + (enabled (or (not enable-form)
> + (eval enable-form))))
> + (if enabled
> + (add-text-properties 0 len
> + '(mouse-face window-tool-bar-button-hover
> + keymap window-tool-bar--button-keymap
> + face window-tool-bar-button)
> + str)
> + (put-text-property 0 len
> + 'face
> + 'window-tool-bar-button-disabled
> + str))
> + (when-let ((spec (and (window-tool-bar--use-images)
> + (plist-get menu-item :image))))
> + (put-text-property 0 len
> + 'display
> + (append spec
> + (if enabled '(:margin 2 :ascent center)
> + '(:margin 2 :ascent center
> + :conversion disabled)))
> + str))
> + (put-text-property 0 len
> + 'help-echo
> + (or (plist-get plist :help) name)
> + str)
> + (put-text-property 0 len 'tool-bar-key key str)
> + str)))))
> +
> +(defun window-tool-bar--call-button ()
> + "Call the button that was clicked on in the tab line."
> + (interactive)
> + (when (mouse-event-p last-command-event)
> + (let ((posn (event-start last-command-event)))
> + ;; Commands need to execute with the right buffer and window
> + ;; selected. The selection needs to be permanent for isearch.
> + (select-window (posn-window posn))
> + (let* ((str (posn-string posn))
> + (key (get-text-property (cdr str) 'tool-bar-key (car str)))
> + (cmd (lookup-key (window-tool-bar--get-keymap) (vector key))))
> + (call-interactively cmd)))))
> +
> +(defun window-tool-bar--ignore ()
> + "Do nothing. This command exists for isearch."
> + (interactive)
> + nil)
> +
> +(defvar window-tool-bar--ignored-event-types
> + (let ((list (list 'mouse-movement 'pinch
> + 'wheel-down 'wheel-up 'wheel-left 'wheel-right
> + mouse-wheel-down-event mouse-wheel-up-event
> + mouse-wheel-left-event mouse-wheel-right-event
> + (bound-and-true-p mouse-wheel-down-alternate-event)
> + (bound-and-true-p mouse-wheel-up-alternate-event)
> + (bound-and-true-p mouse-wheel-left-alternate-event)
> + (bound-and-true-p mouse-wheel-right-alternate-event))))
> + (delete-dups (delete nil list)))
> + "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 tool bar in the tab line of the current buffer."
> + :lighter nil
> + (let ((should-display (and window-tool-bar-mode
> + (not (eq tool-bar-map
> + (default-value 'tool-bar-map))))))
> + (if (fboundp 'tab-line-set-display)
> + ;; Newly added function for Emacs 30.
> + (tab-line-set-display 'window-tool-bar-mode
> + (and should-display
> + '(:eval (window-tool-bar-string))))
> + ;; Legacy path for Emacs 29.
> + (setq tab-line-format
> + (and should-display
> + '(:eval (window-tool-bar-string)))))))
> +
> +;;;###autoload
> +(define-globalized-minor-mode global-window-tool-bar-mode
> + window-tool-bar-mode window-tool-bar--turn-on
> + :group 'window-tool-bar
> + (add-hook 'isearch-mode-hook #'window-tool-bar--turn-on)
> + (add-hook 'isearch-mode-end-hook #'window-tool-bar--turn-on))
> +
> +(defvar window-tool-bar--allow-images t
> + "Internal debug flag to force text mode.")
> +
> +(defun window-tool-bar--use-images ()
> + "Internal function.
> +Respects `window-tool-bar--allow-images' as well as frame
> +capabilities."
> + (and window-tool-bar--allow-images
> + (display-images-p)))
> +\f
> +;;; Display styling:
> +(defface window-tool-bar-button
> + '((default
> + :inherit tab-line)
> + (((class color) (min-colors 88) (supports :box t))
> + :box (:line-width -1 :style released-button)
> + :background "grey85")
> + ;; If the box is not supported, dim the button background a bit.
> + (((class color) (min-colors 88))
> + :background "grey70")
> + (t
> + :inverse-video t))
> + "Face used for buttons when the mouse is not hovering over the button."
> + :group 'window-tool-bar)
> +
> +(defface window-tool-bar-button-hover
> + '((default
> + :inherit tab-line)
> + (((class color) (min-colors 88))
> + :box (:line-width -1 :style released-button)
> + :background "grey95")
> + (t
> + :inverse-video t))
> + "Face used for buttons when the mouse is hovering over the button."
> + :group 'window-tool-bar)
> +
> +(defface window-tool-bar-button-disabled
> + '((default
> + :inherit tab-line)
> + (((class color) (min-colors 88))
> + :box (:line-width -1 :style released-button)
> + :background "grey50"
> + :foreground "grey70")
> + (t
> + :inverse-video t
> + :background "brightblack"))
> + "Face used for buttons when the button is disabled."
> + :group 'window-tool-bar)
> +\f
> +;;; Workaround for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334.
> +(defun window-tool-bar--get-keymap ()
> + "Return the tool bar keymap."
> + (let ((tool-bar-always-show-default nil))
> + (if (and (version< emacs-version "30")
> + (not (window-tool-bar--use-images)))
> + ;; This code path is a less efficient workaround.
> + (window-tool-bar--make-keymap-1)
> + (keymap-global-lookup "<tool-bar>"))))
> +
> +(declare-function image-mask-p "image.c" (spec &optional frame))
> +
> +(defun window-tool-bar--make-keymap-1 ()
> + "Patched copy of `tool-bar-make-keymap-1'."
> + (mapcar (lambda (bind)
> + (let (image-exp plist)
> + (when (and (eq (car-safe (cdr-safe bind)) 'menu-item)
> + ;; For the format of menu-items, see node
> + ;; `Extended Menu Items' in the Elisp manual.
> + (setq plist (nthcdr (if (consp (nth 4 bind)) 5 4)
> + bind))
> + (setq image-exp (plist-get plist :image))
> + (consp image-exp)
> + (not (eq (car image-exp) 'image))
> + (fboundp (car image-exp)))
> + (let ((image (and (display-images-p)
> + (eval image-exp))))
> + (unless (and image (image-mask-p image))
> + (setq image (append image '(:mask heuristic))))
> + (setq bind (copy-sequence bind)
> + plist (nthcdr (if (consp (nth 4 bind)) 5 4)
> + bind))
> + (plist-put plist :image image)))
> + bind))
> + tool-bar-map))
> +
> +(defun window-tool-bar--turn-on ()
> + "Internal function called by `global-window-tool-bar-mode'."
> + (when global-window-tool-bar-mode
> + (window-tool-bar-mode 1)))
> +
> +(provide 'window-tool-bar)
> +
> +;;; window-tool-bar.el ends here
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-02-10 17:25 ` Juri Linkov
@ 2024-02-26 22:38 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-26 15:34 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 15+ messages in thread
From: Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-26 22:38 UTC (permalink / raw)
To: Juri Linkov; +Cc: Eli Zaretskii, 68765, Philip Kaludercic, Stefan Monnier
On 2024-02-10 09:25, Juri Linkov wrote:
>>> * lisp/tab-line.el (tab-line-format-template): Add separator space.
>>> (tab-line-display-order): New user variable to control display order.
>>> (tab-line--runtime-display-order, tab-line--cookie): New internal
>>> variables.
>>> (tab-line-set-display): New function for modes to call to enable only
>>> their content.
>>> (tab-line-mode): Call `tab-line-set-display'.
>>
>> Juri, would you please review this part of the changeset?
>
> I'm not sure if this provides a clean interface.
> Have you tried to show both window-tool-bar and tab-line tabs
> on the same tab-line? Do you think this combination is usable?
> Or maybe better just repurpose the tab-line in window-tool-bar.el
> exclusively for window-local tool-bar?
The implementation I provided works fine for me with both
window-tool-bar-mode and tab-line-mode enabled as long as there are not
too many tabs. I could see further adding a way to specify the max
width tabs are able to take up if you think that's necessary.
-- MJF
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-01-27 23:36 bug#68765: 30.0.50; Adding window-tool-bar package Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-10 8:19 ` Eli Zaretskii
2024-02-11 20:51 ` Philip Kaludercic
@ 2024-02-27 3:02 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-26 15:33 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-27 10:00 ` Philip Kaludercic
2 siblings, 2 replies; 15+ messages in thread
From: Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-27 3:02 UTC (permalink / raw)
To: Philip Kaludercic, Eli Zaretskii; +Cc: 68765
[-- Attachment #1: Type: text/plain, Size: 881 bytes --]
On 2024-02-11 12:51, Philip Kaludercic wrote:
> Here are a few comments from a quick skim:
Comments addressed. New patches for 0002 and 0003 added. I also
addressed Eli's comments from
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68765#10 as well.
The following comment was not addressed:
>> +(defun window-tool-bar-show-memory-use ()
>> + "Pop up a window showing the memory use metrics."
>> + (interactive)
>> + (require 'time-stamp)
>> + (save-selected-window
>> + (pop-to-buffer "*WTB Memory Report*")
>
> I think you should rewrite this as
>
> (with-current-buffer (get-buffer "...")
> ;; ...
> (pop-to-buffer (current-buffer))
I couldn't make this change and keep the current behavior that is
important to me:
1. The window with focus should not change.
2. The buffer should get scrolled to the bottom to displayed the newly
inserted text.
-- MJF
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-Add-user-option-to-only-display-default-tool-bar.patch --]
[-- Type: text/x-diff; name=0002-Add-user-option-to-only-display-default-tool-bar.patch, Size: 2059 bytes --]
From 622c11c6f314355b0e742fcbcbcc8ae51661bca0 Mon Sep 17 00:00:00 2001
From: Jared Finder <jared@finder.org>
Date: Fri, 26 Jan 2024 10:08:30 -0800
Subject: [PATCH 2/3] Add user option to only display default tool bar
This works well with `window-tool-bar-mode', to be added in upcoming
commit. Then the default tool bar is displayed frame-wide and
mode-specific tool bars are displayed in the window that mode is
active in.
* lisp/tool-bar.el (tool-bar-always-show-default): New user option.
(tool-bar--cache-key, tool-bar-make-keymap-1): Return default tool bar
when option is set.
---
lisp/tool-bar.el | 17 +++++++++++++++--
1 file changed, 15 insertions(+), 2 deletions(-)
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 96b61c7b229..52d60b32412 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -100,7 +100,9 @@ secondary-tool-bar-map
(defconst tool-bar-keymap-cache (make-hash-table :test #'equal))
(defsubst tool-bar--cache-key ()
- (cons (frame-terminal) (sxhash-eq tool-bar-map)))
+ (cons (frame-terminal)
+ (sxhash-eq (if tool-bar-always-show-default (default-value 'tool-bar-map)
+ tool-bar-map))))
(defsubst tool-bar--secondary-cache-key ()
(cons (frame-terminal) (sxhash-eq secondary-tool-bar-map)))
@@ -191,7 +193,9 @@ tool-bar-make-keymap-1
bind))
(plist-put plist :image image)))
bind))
- (or map tool-bar-map)))
+ (or map
+ (if tool-bar-always-show-default (default-value 'tool-bar-map)
+ tool-bar-map))))
;;;###autoload
(defun tool-bar-add-item (icon def key &rest props)
@@ -377,6 +381,15 @@ tool-bar-setup
(modify-all-frames-parameters
(list (cons 'tool-bar-position val))))))
+(defcustom tool-bar-always-show-default nil
+ "If non-nil, `tool-bar-mode' only shows the default tool bar.
+This works well when also using `global-window-tool-bar-mode' to
+display buffer-specific tool bars."
+ :type 'boolean
+ :group 'frames
+ :group 'mouse
+ :version "30.1")
+
\f
;; Modifier bar mode.
--
2.39.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0003-Adding-window-tool-bar-package.patch --]
[-- Type: text/x-diff; name=0003-Adding-window-tool-bar-package.patch, Size: 21493 bytes --]
From baf4c81df3e4e82576a8084ae029d56b45750553 Mon Sep 17 00:00:00 2001
From: Jared Finder <jared@finder.org>
Date: Fri, 26 Jan 2024 15:44:12 -0800
Subject: [PATCH 3/3] Adding window-tool-bar package
---
lisp/window-tool-bar.el | 489 ++++++++++++++++++++++++++++++++++++++++
1 file changed, 489 insertions(+)
create mode 100644 lisp/window-tool-bar.el
diff --git a/lisp/window-tool-bar.el b/lisp/window-tool-bar.el
new file mode 100644
index 00000000000..eefd6109f7d
--- /dev/null
+++ b/lisp/window-tool-bar.el
@@ -0,0 +1,489 @@
+;;; window-tool-bar.el --- Add tool bars inside windows -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
+
+;; Author: Jared Finder <jared@finder.org>
+;; Created: Nov 21, 2023
+;; Version: 0.2
+;; Keywords: mouse
+;; Package-Requires: ((emacs "29.1"))
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package puts a tool bar in each window. This allows you to see
+;; multiple tool bars simultaneously directly next to the buffer it
+;; acts on which feels much more intuitive. Emacs "browsing" modes
+;; generally have sensible tool bars, for example: *info*, *help*, and
+;; *eww* have them.
+;;
+;; It does this while being mindful of screen real estate. Most modes
+;; do not provide a custom tool bar, and this package does not show the
+;; default tool bar. This means that for most buffers there will be no
+;; space taken up. Furthermore, you can put this tool bar in the mode
+;; line or tab line if you want to share it with existing content.
+;;
+;; To get the default behavior, run (global-window-tool-bar-mode 1) or
+;; enable via M-x customize-group RET window-tool-bar RET. This uses
+;; the per-window tab line to show the tool bar.
+;;
+;; If you want to share space with an existing tab line, mode line, or
+;; header line, add (:eval (window-tool-bar-string)) to
+;; `tab-line-format', `mode-line-format', or `header-line-format'.
+
+;;; Known issues:
+;;
+;; On GNU Emacs 29.1, terminals dragging to resize windows will error
+;; with message "<tab-line> <mouse-movement> is undefined". This is a
+;; bug in GNU Emacs,
+;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=67457>.
+;;
+;; On GNU Emacs 29, performance in terminals is lower than on
+;; graphical frames. This is due to a workaround, see "Workaround for
+;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334", below.
+
+;;; Todo:
+;;
+;; Not all features planned are implemented yet. Eventually I would
+;; like to also generally make tool bars better.
+;;
+;; Targeting 0.3:
+;; * Properly support reamining less frequently used tool bar item specs. From
+;; `parse_tool_bar_item':
+;; * :visible
+;; * :filter
+;; * :button
+;; * :wrap
+;; * Add display customization similar to `tool-bar-style'.
+;;
+;; Targeting 1.0:
+;;
+;; * Clean up Emacs tool bars
+;; * Default: Remove default tool-bar entirely
+;; * grep, vc: Remove default tool-bar inherited
+;; * info: Remove Next / Prev / Up, which is already in the header
+;; * smerge: Add tool bar for next/prev
+;;
+;; Post 1.0 work:
+;;
+;; * Show keyboard shortcut on help text.
+;;
+;; * Add a bit more documentation.
+;; * Add customization option: ignore-default-tool-bar-map
+;; * Make tab-line dragging resize the window
+
+;;; Code:
+
+(require 'mwheel)
+(require 'tab-line)
+(require 'tool-bar)
+\f
+;;; Benchmarking code
+;;
+;; Refreshing the tool bar is computationally simple, but generates a
+;; lot of garbage. So this benchmarking focuses on garbage
+;; generation. Since it has to run after most commands, generating
+;; significantly more garbage will cause noticeable performance
+;; degration.
+;;
+;; The refresh has two steps:
+;;
+;; Step 1: Look up the <tool-bar> map.
+;; Step 2: Generate a Lisp string using text properties for the tool
+;; bar string.
+;;
+;; Additionally, we keep track of the percentage of commands that
+;; acutally created a refresh.
+(defvar window-tool-bar--memory-use-delta-step1 (make-list 7 0)
+ "Absolute delta of memory use counters during step 1.
+This is a list in the same structure as `memory-use-counts'.")
+(defvar window-tool-bar--memory-use-delta-step2 (make-list 7 0)
+ "Absolute delta of memory use counters during step 2.
+This is a list in the same structure as `memory-use-counts'.")
+(defvar window-tool-bar--refresh-done-count 0
+ "Number of tool bar string refreshes run.
+The total number of requests is the sum of this and
+`window-tool-bar--refresh-skipped-count'.")
+(defvar window-tool-bar--refresh-skipped-count 0
+ "Number of tool bar string refreshes that were skipped.
+The total number of requests is the sum of this and
+`window-tool-bar--refresh-done-count'.")
+
+(defun window-tool-bar--memory-use-avg-step1 ()
+ "Return average memory use delta during step 1."
+ (mapcar (lambda (elt) (/ elt window-tool-bar--refresh-done-count 1.0))
+ window-tool-bar--memory-use-delta-step1))
+
+(defun window-tool-bar--memory-use-avg-step2 ()
+ "Return average memory use delta during step 2."
+ (mapcar (lambda (elt) (/ (float elt) window-tool-bar--refresh-done-count))
+ window-tool-bar--memory-use-delta-step2))
+
+(declare-function time-stamp-string "time-stamp")
+
+(defun window-tool-bar-debug-show-memory-use ()
+ "Development-only command to show memory used by `window-tool-bar-string'."
+ (interactive)
+ (require 'time-stamp)
+ (save-selected-window
+ (pop-to-buffer "*WTB Memory Report*")
+ (unless (eq major-mode 'special-mode)
+ (special-mode))
+
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (propertize (concat "Function: window-tool-bar-string "
+ (time-stamp-string))
+ 'face 'underline 'font-lock-face 'underline)
+ "\n\n")
+ (window-tool-bar--insert-memory-use
+ "Step 1" (window-tool-bar--memory-use-avg-step1))
+ (window-tool-bar--insert-memory-use
+ "Step 2" (window-tool-bar--memory-use-avg-step2))
+ (insert (format "Refresh count %d\n" window-tool-bar--refresh-done-count)
+ (format "Refresh executed percent %.2f\n"
+ (/ window-tool-bar--refresh-done-count
+ (+ window-tool-bar--refresh-done-count
+ window-tool-bar--refresh-skipped-count)
+ 1.0))
+ "\n"))))
+
+(defun window-tool-bar--insert-memory-use (label avg-memory-use)
+ "Insert memory use into current buffer.
+
+LABEL: A prefix string to be in front of the data.
+AVG-MEMORY-USE: A list of averages, with the same meaning as
+ `memory-use-counts'."
+ (let* ((label-len (length label))
+ (padding (make-string label-len ?\s)))
+ (cl-loop for usage in avg-memory-use
+ for usage-label in '("Conses" "Floats" "Vector cells" "Symbols"
+ "String chars" "Intervals" "Strings")
+ for idx from 0
+ do (insert (format "%s %8.2f %s\n"
+ (if (= idx 0) label padding)
+ usage
+ usage-label)))))
+\f
+(defgroup window-tool-bar nil
+ "Tool bars per-window."
+ :group 'convenience
+ :prefix "window-tool-bar-")
+
+(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
+
+ ;; Mouse down events do nothing. A binding is needed so isearch
+ ;; does not exit when the tab bar is clicked.
+ "<tab-line> <down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <double-down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <triple-down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <down-mouse-2>" #'window-tool-bar--ignore
+ "<tab-line> <double-down-mouse-2>" #'window-tool-bar--ignore
+ "<tab-line> <triple-down-mouse-2>" #'window-tool-bar--ignore)
+(fset 'window-tool-bar--button-keymap window-tool-bar--button-keymap) ; So it can be a keymap property
+
+;; Register bindings that stay in isearch. Technically, these
+;; commands don't pop up a menu but they act very similar in that they
+;; end up calling an actual command via `call-interactively'.
+(push 'window-tool-bar--call-button isearch-menu-bar-commands)
+(push 'window-tool-bar--ignore isearch-menu-bar-commands)
+
+(defvar-local window-tool-bar-string--cache nil
+ "Cache for previous result of `window-tool-bar-string'.")
+
+;;;###autoload
+(defun window-tool-bar-string ()
+ "Return a (propertized) string for the tool bar.
+
+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'"
+ (if (or (null window-tool-bar-string--cache)
+ (window-tool-bar--last-command-triggers-refresh-p))
+ (let* ((mem0 (memory-use-counts))
+ (toolbar-menu (window-tool-bar--get-keymap))
+ (mem1 (memory-use-counts))
+ (result (mapconcat #'window-tool-bar--keymap-entry-to-string
+ (cdr toolbar-menu) ;Skip 'keymap
+ ;; Without spaces between the text, hovering
+ ;; highlights all adjacent buttons.
+ (if (window-tool-bar--use-images)
+ (propertize " " 'invisible t)
+ " ")))
+ (mem2 (memory-use-counts)))
+ (cl-mapl (lambda (l-init l0 l1)
+ (cl-incf (car l-init) (- (car l1) (car l0))))
+ window-tool-bar--memory-use-delta-step1 mem0 mem1)
+ (cl-mapl (lambda (l-init l1 l2)
+ (cl-incf (car l-init) (- (car l2) (car l1))))
+ window-tool-bar--memory-use-delta-step2 mem1 mem2)
+
+ (setf window-tool-bar-string--cache
+ (concat
+ ;; The tool bar face by default puts boxes around the
+ ;; buttons. However, this box is not displayed if the
+ ;; box starts at the leftmost pixel of the tab-line.
+ ;; Add a single space in this case so the box displays
+ ;; correctly.
+ (when (display-supports-face-attributes-p
+ '(:box (line-width 1)))
+ (propertize " " 'display '(space :width (1))))
+ result))
+ (cl-incf window-tool-bar--refresh-done-count))
+ (cl-incf window-tool-bar--refresh-skipped-count))
+
+ window-tool-bar-string--cache)
+
+(defconst window-tool-bar--graphical-separator
+ (let ((str (make-string 3 ?\s)))
+ (set-text-properties 0 1 '(display (space :width (4))) str)
+ (set-text-properties 1 2
+ '(display (space :width (1))
+ face (:inverse-video t))
+ str)
+ (set-text-properties 2 3 '(display (space :width (4))) str)
+ str))
+
+(defun window-tool-bar--keymap-entry-to-string (menu-item)
+ "Convert MENU-ITEM into a (propertized) string representation.
+
+MENU-ITEM: Menu item to convert. See info node (elisp)Tool Bar."
+ (pcase menu-item
+ ;; Separators
+ ((or `(,_ "--")
+ `(,_ menu-item ,(and (pred stringp)
+ (pred (string-prefix-p "--")))))
+ (if (window-tool-bar--use-images)
+ window-tool-bar--graphical-separator
+ "|"))
+
+ ;; Menu item, turn into propertized string button
+ (`(,key menu-item ,name-expr ,binding . ,plist)
+ (when binding ; If no binding exists, then button is hidden.
+ (let* ((name (eval name-expr))
+ (str (upcase-initials (or (plist-get plist :label)
+ (string-trim-right name "\\.+"))))
+ (len (length str))
+ (enable-form (plist-get plist :enable))
+ (enabled (or (not enable-form)
+ (eval enable-form))))
+ (if enabled
+ (add-text-properties 0 len
+ '(mouse-face window-tool-bar-button-hover
+ keymap window-tool-bar--button-keymap
+ face window-tool-bar-button)
+ str)
+ (put-text-property 0 len
+ 'face
+ 'window-tool-bar-button-disabled
+ str))
+ (when-let ((spec (and (window-tool-bar--use-images)
+ (plist-get menu-item :image))))
+ (put-text-property 0 len
+ 'display
+ (append spec
+ (if enabled '(:margin 2 :ascent center)
+ '(:margin 2 :ascent center
+ :conversion disabled)))
+ str))
+ (put-text-property 0 len
+ 'help-echo
+ (or (plist-get plist :help) name)
+ str)
+ (put-text-property 0 len 'tool-bar-key key str)
+ str)))))
+
+(defun window-tool-bar--call-button ()
+ "Call the button that was clicked on in the tab line."
+ (interactive)
+ (when (mouse-event-p last-command-event)
+ (let ((posn (event-start last-command-event)))
+ ;; Commands need to execute with the right buffer and window
+ ;; selected. The selection needs to be permanent for isearch.
+ (select-window (posn-window posn))
+ (let* ((str (posn-string posn))
+ (key (get-text-property (cdr str) 'tool-bar-key (car str)))
+ (cmd (lookup-key (window-tool-bar--get-keymap) (vector key))))
+ (call-interactively cmd)))))
+
+(defun window-tool-bar--ignore ()
+ "Do nothing. This command exists for isearch."
+ (interactive)
+ nil)
+
+(defvar window-tool-bar--ignored-event-types
+ (let ((list (list 'mouse-movement 'pinch
+ 'wheel-down 'wheel-up 'wheel-left 'wheel-right
+ mouse-wheel-down-event mouse-wheel-up-event
+ mouse-wheel-left-event mouse-wheel-right-event
+ (bound-and-true-p mouse-wheel-down-alternate-event)
+ (bound-and-true-p mouse-wheel-up-alternate-event)
+ (bound-and-true-p mouse-wheel-left-alternate-event)
+ (bound-and-true-p mouse-wheel-right-alternate-event))))
+ (delete-dups (delete nil list)))
+ "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 tool bar in the tab line of the current buffer."
+ :lighter nil
+ (let ((should-display (and window-tool-bar-mode
+ (not (eq tool-bar-map
+ (default-value 'tool-bar-map))))))
+ (if (fboundp 'tab-line-set-display)
+ ;; Newly added function for Emacs 30.
+ (tab-line-set-display 'window-tool-bar-mode
+ (and should-display
+ '(:eval (window-tool-bar-string))))
+ ;; Legacy path for Emacs 29.
+ (setq tab-line-format
+ (and should-display
+ '(:eval (window-tool-bar-string)))))))
+
+;;;###autoload
+(define-globalized-minor-mode global-window-tool-bar-mode
+ window-tool-bar-mode window-tool-bar--turn-on
+ :group 'window-tool-bar
+ (add-hook 'isearch-mode-hook #'window-tool-bar--turn-on)
+ (add-hook 'isearch-mode-end-hook #'window-tool-bar--turn-on))
+
+(defvar window-tool-bar--allow-images t
+ "Internal debug flag to force text mode.")
+
+(defun window-tool-bar--use-images ()
+ "Internal function.
+Respects `window-tool-bar--allow-images' as well as frame
+capabilities."
+ (and window-tool-bar--allow-images
+ (display-images-p)))
+\f
+;;; Display styling:
+(defface window-tool-bar-button
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88) (supports :box t))
+ :box (:line-width -1 :style released-button)
+ :background "grey85")
+ ;; If the box is not supported, dim the button background a bit.
+ (((class color) (min-colors 88))
+ :background "grey70")
+ (t
+ :inverse-video t))
+ "Face used for buttons when the mouse is not hovering over the button."
+ :group 'window-tool-bar)
+
+(defface window-tool-bar-button-hover
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88))
+ :box (:line-width -1 :style released-button)
+ :background "grey95")
+ (t
+ :inverse-video t))
+ "Face used for buttons when the mouse is hovering over the button."
+ :group 'window-tool-bar)
+
+(defface window-tool-bar-button-disabled
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88))
+ :box (:line-width -1 :style released-button)
+ :background "grey50"
+ :foreground "grey70")
+ (t
+ :inverse-video t
+ :background "brightblack"))
+ "Face used for buttons when the button is disabled."
+ :group 'window-tool-bar)
+\f
+;;; Workaround for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334.
+(defun window-tool-bar--get-keymap ()
+ "Return the tool bar keymap."
+ (let ((tool-bar-always-show-default nil))
+ (if (and (version< emacs-version "30")
+ (not (window-tool-bar--use-images)))
+ ;; This code path is a less efficient workaround.
+ (window-tool-bar--make-keymap-1)
+ (keymap-global-lookup "<tool-bar>"))))
+
+(declare-function image-mask-p "image.c" (spec &optional frame))
+
+(defun window-tool-bar--make-keymap-1 ()
+ "Patched copy of `tool-bar-make-keymap-1'."
+ (mapcar (lambda (bind)
+ (let (image-exp plist)
+ (when (and (eq (car-safe (cdr-safe bind)) 'menu-item)
+ ;; For the format of menu-items, see node
+ ;; `Extended Menu Items' in the Elisp manual.
+ (setq plist (nthcdr (if (consp (nth 4 bind)) 5 4)
+ bind))
+ (setq image-exp (plist-get plist :image))
+ (consp image-exp)
+ (not (eq (car image-exp) 'image))
+ (fboundp (car image-exp)))
+ (let ((image (and (display-images-p)
+ (eval image-exp))))
+ (unless (and image (image-mask-p image))
+ (setq image (append image '(:mask heuristic))))
+ (setq bind (copy-sequence bind)
+ plist (nthcdr (if (consp (nth 4 bind)) 5 4)
+ bind))
+ (plist-put plist :image image)))
+ bind))
+ tool-bar-map))
+
+(defun window-tool-bar--turn-on ()
+ "Internal function called by `global-window-tool-bar-mode'."
+ (when global-window-tool-bar-mode
+ (window-tool-bar-mode 1)))
+
+(provide 'window-tool-bar)
+
+;;; window-tool-bar.el ends here
--
2.39.2
^ permalink raw reply related [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-02-27 3:02 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-03-26 15:33 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-13 7:43 ` Eli Zaretskii
2024-04-27 10:00 ` Philip Kaludercic
1 sibling, 1 reply; 15+ messages in thread
From: Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-26 15:33 UTC (permalink / raw)
To: Philip Kaludercic, Eli Zaretskii; +Cc: 68765
It's been four weeks and I've seen no reply to these updated patches.
Are you able to review?
On 2024-02-26 19:02, Jared Finder wrote:
> On 2024-02-11 12:51, Philip Kaludercic wrote:
>> Here are a few comments from a quick skim:
>
> Comments addressed. New patches for 0002 and 0003 added. I also
> addressed Eli's comments from
> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68765#10 as well.
>
> The following comment was not addressed:
>
>>> +(defun window-tool-bar-show-memory-use ()
>>> + "Pop up a window showing the memory use metrics."
>>> + (interactive)
>>> + (require 'time-stamp)
>>> + (save-selected-window
>>> + (pop-to-buffer "*WTB Memory Report*")
>>
>> I think you should rewrite this as
>>
>> (with-current-buffer (get-buffer "...")
>> ;; ...
>> (pop-to-buffer (current-buffer))
>
> I couldn't make this change and keep the current behavior that is
> important to me:
>
> 1. The window with focus should not change.
> 2. The buffer should get scrolled to the bottom to displayed the newly
> inserted text.
>
> -- MJF
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-02-26 22:38 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-03-26 15:34 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-27 7:04 ` Juri Linkov
0 siblings, 1 reply; 15+ messages in thread
From: Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-26 15:34 UTC (permalink / raw)
To: Juri Linkov; +Cc: Eli Zaretskii, 68765, Philip Kaludercic, Stefan Monnier
It's been four weeks and I've seen no reply to this comment. Are there
any other concerns?
-- MJF
On 2024-02-26 14:38, Jared Finder wrote:
> On 2024-02-10 09:25, Juri Linkov wrote:
>>>> * lisp/tab-line.el (tab-line-format-template): Add separator space.
>>>> (tab-line-display-order): New user variable to control display
>>>> order.
>>>> (tab-line--runtime-display-order, tab-line--cookie): New internal
>>>> variables.
>>>> (tab-line-set-display): New function for modes to call to enable
>>>> only
>>>> their content.
>>>> (tab-line-mode): Call `tab-line-set-display'.
>>>
>>> Juri, would you please review this part of the changeset?
>>
>> I'm not sure if this provides a clean interface.
>> Have you tried to show both window-tool-bar and tab-line tabs
>> on the same tab-line? Do you think this combination is usable?
>> Or maybe better just repurpose the tab-line in window-tool-bar.el
>> exclusively for window-local tool-bar?
>
> The implementation I provided works fine for me with both
> window-tool-bar-mode and tab-line-mode enabled as long as there are not
> too many tabs. I could see further adding a way to specify the max
> width tabs are able to take up if you think that's necessary.
>
> -- MJF
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-03-26 15:34 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-03-27 7:04 ` Juri Linkov
2024-05-02 6:03 ` Juri Linkov
0 siblings, 1 reply; 15+ messages in thread
From: Juri Linkov @ 2024-03-27 7:04 UTC (permalink / raw)
To: Jared Finder; +Cc: Eli Zaretskii, 68765, Philip Kaludercic, Stefan Monnier
>>> I'm not sure if this provides a clean interface.
>>> Have you tried to show both window-tool-bar and tab-line tabs
>>> on the same tab-line? Do you think this combination is usable?
>>> Or maybe better just repurpose the tab-line in window-tool-bar.el
>>> exclusively for window-local tool-bar?
>> The implementation I provided works fine for me with both
>> window-tool-bar-mode and tab-line-mode enabled as long as there are not
>> too many tabs. I could see further adding a way to specify the max width
>> tabs are able to take up if you think that's necessary.
>
> It's been four weeks and I've seen no reply to this comment. Are there any
> other concerns?
Sorry, I didn't know that you expected that I should review your patch -
I was silent because your last patch has no changes in tab-line.el,
so I have no more objections in this regard.
As for combining of tabs and the tool-bar on the tab-line,
I don't think this is feasible to achieve a consistent solution.
So users have to choose only one feature at a time:
whether buffer tabs in the tab-line or the window-local tool-bar.
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-03-26 15:33 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-04-13 7:43 ` Eli Zaretskii
2024-04-27 8:25 ` Eli Zaretskii
0 siblings, 1 reply; 15+ messages in thread
From: Eli Zaretskii @ 2024-04-13 7:43 UTC (permalink / raw)
To: Jared Finder; +Cc: philipk, 68765
Ping! How should we make progress with this issue?
> Date: Tue, 26 Mar 2024 08:33:22 -0700
> From: Jared Finder <jared@finder.org>
> Cc: 68765@debbugs.gnu.org
>
> It's been four weeks and I've seen no reply to these updated patches.
> Are you able to review?
>
> On 2024-02-26 19:02, Jared Finder wrote:
> > On 2024-02-11 12:51, Philip Kaludercic wrote:
> >> Here are a few comments from a quick skim:
> >
> > Comments addressed. New patches for 0002 and 0003 added. I also
> > addressed Eli's comments from
> > https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68765#10 as well.
> >
> > The following comment was not addressed:
> >
> >>> +(defun window-tool-bar-show-memory-use ()
> >>> + "Pop up a window showing the memory use metrics."
> >>> + (interactive)
> >>> + (require 'time-stamp)
> >>> + (save-selected-window
> >>> + (pop-to-buffer "*WTB Memory Report*")
> >>
> >> I think you should rewrite this as
> >>
> >> (with-current-buffer (get-buffer "...")
> >> ;; ...
> >> (pop-to-buffer (current-buffer))
> >
> > I couldn't make this change and keep the current behavior that is
> > important to me:
> >
> > 1. The window with focus should not change.
> > 2. The buffer should get scrolled to the bottom to displayed the newly
> > inserted text.
> >
> > -- MJF
>
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-04-13 7:43 ` Eli Zaretskii
@ 2024-04-27 8:25 ` Eli Zaretskii
0 siblings, 0 replies; 15+ messages in thread
From: Eli Zaretskii @ 2024-04-27 8:25 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: philipk, jared, 68765
Ping! Ping! Philip and Jared, are there any issues left to resolve
here, or should this be installed?
> Cc: philipk@posteo.net, 68765@debbugs.gnu.org
> Date: Sat, 13 Apr 2024 10:43:41 +0300
> From: Eli Zaretskii <eliz@gnu.org>
>
> Ping! How should we make progress with this issue?
>
> > Date: Tue, 26 Mar 2024 08:33:22 -0700
> > From: Jared Finder <jared@finder.org>
> > Cc: 68765@debbugs.gnu.org
> >
> > It's been four weeks and I've seen no reply to these updated patches.
> > Are you able to review?
> >
> > On 2024-02-26 19:02, Jared Finder wrote:
> > > On 2024-02-11 12:51, Philip Kaludercic wrote:
> > >> Here are a few comments from a quick skim:
> > >
> > > Comments addressed. New patches for 0002 and 0003 added. I also
> > > addressed Eli's comments from
> > > https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68765#10 as well.
> > >
> > > The following comment was not addressed:
> > >
> > >>> +(defun window-tool-bar-show-memory-use ()
> > >>> + "Pop up a window showing the memory use metrics."
> > >>> + (interactive)
> > >>> + (require 'time-stamp)
> > >>> + (save-selected-window
> > >>> + (pop-to-buffer "*WTB Memory Report*")
> > >>
> > >> I think you should rewrite this as
> > >>
> > >> (with-current-buffer (get-buffer "...")
> > >> ;; ...
> > >> (pop-to-buffer (current-buffer))
> > >
> > > I couldn't make this change and keep the current behavior that is
> > > important to me:
> > >
> > > 1. The window with focus should not change.
> > > 2. The buffer should get scrolled to the bottom to displayed the newly
> > > inserted text.
> > >
> > > -- MJF
> >
>
>
>
>
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-02-27 3:02 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-26 15:33 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-04-27 10:00 ` Philip Kaludercic
2024-04-28 4:44 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 1 reply; 15+ messages in thread
From: Philip Kaludercic @ 2024-04-27 10:00 UTC (permalink / raw)
To: Jared Finder; +Cc: Eli Zaretskii, 68765
Eli Zaretskii <eliz@gnu.org> writes:
> Ping! Ping! Philip and Jared, are there any issues left to resolve
> here, or should this be installed?
Sorry for the delay, I'm going to comment below.
[...]
Jared Finder <jared@finder.org> writes:
> It's been four weeks and I've seen no reply to these updated patches.
> Are you able to review?
Likewise, my apologies, the messages got lost in my backlog that I am
currently trying to make up.
Jared Finder <jared@finder.org> writes:
> Comments addressed. New patches for 0002 and 0003 added. I also
> addressed Eli's comments from
> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68765#10 as well.
>
> The following comment was not addressed:
>
>>> +(defun window-tool-bar-show-memory-use ()
>>> + "Pop up a window showing the memory use metrics."
>>> + (interactive)
>>> + (require 'time-stamp)
>>> + (save-selected-window
>>> + (pop-to-buffer "*WTB Memory Report*")
>> I think you should rewrite this as
>> (with-current-buffer (get-buffer "...")
>> ;; ...
>> (pop-to-buffer (current-buffer))
>
> I couldn't make this change and keep the current behavior that is
> important to me:
>
> 1. The window with focus should not change.
> 2. The buffer should get scrolled to the bottom to displayed the newly
> inserted text.
Ok.
> -- MJF
>
> From 622c11c6f314355b0e742fcbcbcc8ae51661bca0 Mon Sep 17 00:00:00 2001
> From: Jared Finder <jared@finder.org>
> Date: Fri, 26 Jan 2024 10:08:30 -0800
> Subject: [PATCH 2/3] Add user option to only display default tool bar
>
> This works well with `window-tool-bar-mode', to be added in upcoming
> commit. Then the default tool bar is displayed frame-wide and
> mode-specific tool bars are displayed in the window that mode is
> active in.
>
> * lisp/tool-bar.el (tool-bar-always-show-default): New user option.
> (tool-bar--cache-key, tool-bar-make-keymap-1): Return default tool bar
> when option is set.
> ---
> lisp/tool-bar.el | 17 +++++++++++++++--
> 1 file changed, 15 insertions(+), 2 deletions(-)
>
> diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
> index 96b61c7b229..52d60b32412 100644
> --- a/lisp/tool-bar.el
> +++ b/lisp/tool-bar.el
> @@ -100,7 +100,9 @@ secondary-tool-bar-map
> (defconst tool-bar-keymap-cache (make-hash-table :test #'equal))
>
> (defsubst tool-bar--cache-key ()
> - (cons (frame-terminal) (sxhash-eq tool-bar-map)))
> + (cons (frame-terminal)
> + (sxhash-eq (if tool-bar-always-show-default (default-value 'tool-bar-map)
> + tool-bar-map))))
>
> (defsubst tool-bar--secondary-cache-key ()
> (cons (frame-terminal) (sxhash-eq secondary-tool-bar-map)))
> @@ -191,7 +193,9 @@ tool-bar-make-keymap-1
> bind))
> (plist-put plist :image image)))
> bind))
> - (or map tool-bar-map)))
> + (or map
> + (if tool-bar-always-show-default (default-value 'tool-bar-map)
> + tool-bar-map))))
>
> ;;;###autoload
> (defun tool-bar-add-item (icon def key &rest props)
> @@ -377,6 +381,15 @@ tool-bar-setup
> (modify-all-frames-parameters
> (list (cons 'tool-bar-position val))))))
>
> +(defcustom tool-bar-always-show-default nil
> + "If non-nil, `tool-bar-mode' only shows the default tool bar.
> +This works well when also using `global-window-tool-bar-mode' to
> +display buffer-specific tool bars."
> + :type 'boolean
> + :group 'frames
> + :group 'mouse
> + :version "30.1")
> +
> \f
No comments from me here.
> ;; Modifier bar mode.
> --
> 2.39.2
>
>
> From baf4c81df3e4e82576a8084ae029d56b45750553 Mon Sep 17 00:00:00 2001
> From: Jared Finder <jared@finder.org>
> Date: Fri, 26 Jan 2024 15:44:12 -0800
> Subject: [PATCH 3/3] Adding window-tool-bar package
>
> ---
> lisp/window-tool-bar.el | 489 ++++++++++++++++++++++++++++++++++++++++
> 1 file changed, 489 insertions(+)
> create mode 100644 lisp/window-tool-bar.el
>
> diff --git a/lisp/window-tool-bar.el b/lisp/window-tool-bar.el
> new file mode 100644
> index 00000000000..eefd6109f7d
> --- /dev/null
> +++ b/lisp/window-tool-bar.el
> @@ -0,0 +1,489 @@
> +;;; window-tool-bar.el --- Add tool bars inside windows -*- lexical-binding: t -*-
> +
> +;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
> +
> +;; Author: Jared Finder <jared@finder.org>
> +;; Created: Nov 21, 2023
> +;; Version: 0.2
> +;; Keywords: mouse
> +;; Package-Requires: ((emacs "29.1"))
If the plan is for this to be a core-package, then you should add a
comment like
;; This is a GNU ELPA :core package. Avoid adding functionality
;; that is not available in the version of Emacs recorded above or any
;; of the package dependencies.
> +
> +;; This file is part of GNU Emacs.
> +
> +;; GNU Emacs is free software; you can redistribute it and/or modify
> +;; it under the terms of the GNU General Public License as published by
> +;; the Free Software Foundation, either version 3 of the License, or
> +;; (at your option) any later version.
> +
> +;; GNU Emacs is distributed in the hope that it will be useful,
> +;; but WITHOUT ANY WARRANTY; without even the implied warranty of
> +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +;; GNU General Public License for more details.
> +
> +;; You should have received a copy of the GNU General Public License
> +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
> +
> +;;; Commentary:
> +;;
> +;; This package puts a tool bar in each window. This allows you to see
> +;; multiple tool bars simultaneously directly next to the buffer it
> +;; acts on which feels much more intuitive. Emacs "browsing" modes
> +;; generally have sensible tool bars, for example: *info*, *help*, and
> +;; *eww* have them.
> +;;
> +;; It does this while being mindful of screen real estate. Most modes
> +;; do not provide a custom tool bar, and this package does not show the
> +;; default tool bar. This means that for most buffers there will be no
> +;; space taken up. Furthermore, you can put this tool bar in the mode
> +;; line or tab line if you want to share it with existing content.
> +;;
> +;; To get the default behavior, run (global-window-tool-bar-mode 1) or
> +;; enable via M-x customize-group RET window-tool-bar RET. This uses
> +;; the per-window tab line to show the tool bar.
> +;;
> +;; If you want to share space with an existing tab line, mode line, or
> +;; header line, add (:eval (window-tool-bar-string)) to
> +;; `tab-line-format', `mode-line-format', or `header-line-format'.
> +
> +;;; Known issues:
> +;;
> +;; On GNU Emacs 29.1, terminals dragging to resize windows will error
> +;; with message "<tab-line> <mouse-movement> is undefined". This is a
> +;; bug in GNU Emacs,
> +;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=67457>.
> +;;
> +;; On GNU Emacs 29, performance in terminals is lower than on
> +;; graphical frames. This is due to a workaround, see "Workaround for
> +;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334", below.
> +
> +;;; Todo:
> +;;
> +;; Not all features planned are implemented yet. Eventually I would
> +;; like to also generally make tool bars better.
> +;;
> +;; Targeting 0.3:
> +;; * Properly support reamining less frequently used tool bar item specs. From
> +;; `parse_tool_bar_item':
> +;; * :visible
> +;; * :filter
> +;; * :button
> +;; * :wrap
> +;; * Add display customization similar to `tool-bar-style'.
> +;;
> +;; Targeting 1.0:
> +;;
> +;; * Clean up Emacs tool bars
> +;; * Default: Remove default tool-bar entirely
> +;; * grep, vc: Remove default tool-bar inherited
> +;; * info: Remove Next / Prev / Up, which is already in the header
> +;; * smerge: Add tool bar for next/prev
> +;;
> +;; Post 1.0 work:
> +;;
> +;; * Show keyboard shortcut on help text.
> +;;
> +;; * Add a bit more documentation.
> +;; * Add customization option: ignore-default-tool-bar-map
> +;; * Make tab-line dragging resize the window
> +
> +;;; Code:
> +
> +(require 'mwheel)
> +(require 'tab-line)
> +(require 'tool-bar)
> +\f
> +;;; Benchmarking code
> +;;
> +;; Refreshing the tool bar is computationally simple, but generates a
> +;; lot of garbage. So this benchmarking focuses on garbage
> +;; generation. Since it has to run after most commands, generating
> +;; significantly more garbage will cause noticeable performance
> +;; degration.
> +;;
> +;; The refresh has two steps:
> +;;
> +;; Step 1: Look up the <tool-bar> map.
> +;; Step 2: Generate a Lisp string using text properties for the tool
> +;; bar string.
> +;;
> +;; Additionally, we keep track of the percentage of commands that
> +;; acutally created a refresh.
> +(defvar window-tool-bar--memory-use-delta-step1 (make-list 7 0)
> + "Absolute delta of memory use counters during step 1.
> +This is a list in the same structure as `memory-use-counts'.")
> +(defvar window-tool-bar--memory-use-delta-step2 (make-list 7 0)
> + "Absolute delta of memory use counters during step 2.
> +This is a list in the same structure as `memory-use-counts'.")
> +(defvar window-tool-bar--refresh-done-count 0
> + "Number of tool bar string refreshes run.
> +The total number of requests is the sum of this and
> +`window-tool-bar--refresh-skipped-count'.")
> +(defvar window-tool-bar--refresh-skipped-count 0
> + "Number of tool bar string refreshes that were skipped.
> +The total number of requests is the sum of this and
> +`window-tool-bar--refresh-done-count'.")
> +
> +(defun window-tool-bar--memory-use-avg-step1 ()
> + "Return average memory use delta during step 1."
> + (mapcar (lambda (elt) (/ elt window-tool-bar--refresh-done-count 1.0))
> + window-tool-bar--memory-use-delta-step1))
> +
> +(defun window-tool-bar--memory-use-avg-step2 ()
> + "Return average memory use delta during step 2."
> + (mapcar (lambda (elt) (/ (float elt) window-tool-bar--refresh-done-count))
> + window-tool-bar--memory-use-delta-step2))
> +
> +(declare-function time-stamp-string "time-stamp")
> +
> +(defun window-tool-bar-debug-show-memory-use ()
> + "Development-only command to show memory used by `window-tool-bar-string'."
> + (interactive)
> + (require 'time-stamp)
> + (save-selected-window
> + (pop-to-buffer "*WTB Memory Report*")
> + (unless (eq major-mode 'special-mode)
You should explain what is going on here, and why you are checking
major-mode instead of using derived-mode-p.
> + (special-mode))
> +
> + (goto-char (point-max))
> + (let ((inhibit-read-only t))
> + (insert (propertize (concat "Function: window-tool-bar-string "
> + (time-stamp-string))
> + 'face 'underline 'font-lock-face 'underline)
> + "\n\n")
> + (window-tool-bar--insert-memory-use
> + "Step 1" (window-tool-bar--memory-use-avg-step1))
> + (window-tool-bar--insert-memory-use
> + "Step 2" (window-tool-bar--memory-use-avg-step2))
> + (insert (format "Refresh count %d\n" window-tool-bar--refresh-done-count)
> + (format "Refresh executed percent %.2f\n"
> + (/ window-tool-bar--refresh-done-count
> + (+ window-tool-bar--refresh-done-count
> + window-tool-bar--refresh-skipped-count)
> + 1.0))
I don't know if there is any significant difference between (/ a b 1.0)
and (/ a (float b)), but interesting they have the same number of
bytecode instructions and funcalls:
(disassemble (byte-compile (lambda (a b) (/ a b 1.0))))
byte code:
doc: ...
args: (arg1 arg2)
0 constant /
1 stack-ref 2
2 stack-ref 2
3 constant 1.0
4 call 3
5 return
(disassemble (byte-compile (lambda (a b) (/ a (float b)))))
byte code:
doc: ...
args: (arg1 arg2)
0 stack-ref 1
1 constant float
2 stack-ref 2
3 call 1
4 quo
5 return
> + "\n"))))
> +
> +(defun window-tool-bar--insert-memory-use (label avg-memory-use)
> + "Insert memory use into current buffer.
> +
> +LABEL: A prefix string to be in front of the data.
> +AVG-MEMORY-USE: A list of averages, with the same meaning as
> + `memory-use-counts'."
The formatting is somewhat unconventional and can easily be broken using M-q.
> + (let* ((label-len (length label))
> + (padding (make-string label-len ?\s)))
> + (cl-loop for usage in avg-memory-use
> + for usage-label in '("Conses" "Floats" "Vector cells" "Symbols"
> + "String chars" "Intervals" "Strings")
> + for idx from 0
> + do (insert (format "%s %8.2f %s\n"
> + (if (= idx 0) label padding)
> + usage
> + usage-label)))))
> +\f
> +(defgroup window-tool-bar nil
> + "Tool bars per-window."
> + :group 'convenience
> + :prefix "window-tool-bar-")
> +
> +(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
> +
> + ;; Mouse down events do nothing. A binding is needed so isearch
> + ;; does not exit when the tab bar is clicked.
> + "<tab-line> <down-mouse-1>" #'window-tool-bar--ignore
> + "<tab-line> <double-down-mouse-1>" #'window-tool-bar--ignore
> + "<tab-line> <triple-down-mouse-1>" #'window-tool-bar--ignore
> + "<tab-line> <down-mouse-2>" #'window-tool-bar--ignore
> + "<tab-line> <double-down-mouse-2>" #'window-tool-bar--ignore
> + "<tab-line> <triple-down-mouse-2>" #'window-tool-bar--ignore)
> +(fset 'window-tool-bar--button-keymap window-tool-bar--button-keymap) ; So it can be a keymap property
> +
> +;; Register bindings that stay in isearch. Technically, these
> +;; commands don't pop up a menu but they act very similar in that they
> +;; end up calling an actual command via `call-interactively'.
> +(push 'window-tool-bar--call-button isearch-menu-bar-commands)
> +(push 'window-tool-bar--ignore isearch-menu-bar-commands)
> +
> +(defvar-local window-tool-bar-string--cache nil
> + "Cache for previous result of `window-tool-bar-string'.")
> +
> +;;;###autoload
> +(defun window-tool-bar-string ()
> + "Return a (propertized) string for the tool bar.
> +
> +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'"
> + (if (or (null window-tool-bar-string--cache)
> + (window-tool-bar--last-command-triggers-refresh-p))
> + (let* ((mem0 (memory-use-counts))
> + (toolbar-menu (window-tool-bar--get-keymap))
> + (mem1 (memory-use-counts))
> + (result (mapconcat #'window-tool-bar--keymap-entry-to-string
> + (cdr toolbar-menu) ;Skip 'keymap
> + ;; Without spaces between the text, hovering
> + ;; highlights all adjacent buttons.
> + (if (window-tool-bar--use-images)
> + (propertize " " 'invisible t)
> + " ")))
> + (mem2 (memory-use-counts)))
> + (cl-mapl (lambda (l-init l0 l1)
> + (cl-incf (car l-init) (- (car l1) (car l0))))
> + window-tool-bar--memory-use-delta-step1 mem0 mem1)
> + (cl-mapl (lambda (l-init l1 l2)
> + (cl-incf (car l-init) (- (car l2) (car l1))))
> + window-tool-bar--memory-use-delta-step2 mem1 mem2)
> +
> + (setf window-tool-bar-string--cache
> + (concat
> + ;; The tool bar face by default puts boxes around the
> + ;; buttons. However, this box is not displayed if the
> + ;; box starts at the leftmost pixel of the tab-line.
> + ;; Add a single space in this case so the box displays
> + ;; correctly.
> + (when (display-supports-face-attributes-p
I'd use `and' here, instead of `when', since the evaluation result is of
interest.
> + '(:box (line-width 1)))
> + (propertize " " 'display '(space :width (1))))
> + result))
> + (cl-incf window-tool-bar--refresh-done-count))
> + (cl-incf window-tool-bar--refresh-skipped-count))
> +
> + window-tool-bar-string--cache)
> +
> +(defconst window-tool-bar--graphical-separator
> + (let ((str (make-string 3 ?\s)))
> + (set-text-properties 0 1 '(display (space :width (4))) str)
> + (set-text-properties 1 2
> + '(display (space :width (1))
> + face (:inverse-video t))
> + str)
> + (set-text-properties 2 3 '(display (space :width (4))) str)
> + str))
This should be equivalent to
(concat
(propertize " " 'display '(space :width (4)))
(propertize " " 'display '(space :width (1)) 'face '(:inverse-video t))
(propertize " " 'display '(space :width (4))))
right?
> +
> +(defun window-tool-bar--keymap-entry-to-string (menu-item)
> + "Convert MENU-ITEM into a (propertized) string representation.
> +
> +MENU-ITEM: Menu item to convert. See info node (elisp)Tool Bar."
> + (pcase menu-item
pcase or pcase-exhaustive?
> + ;; Separators
> + ((or `(,_ "--")
> + `(,_ menu-item ,(and (pred stringp)
> + (pred (string-prefix-p "--")))))
> + (if (window-tool-bar--use-images)
> + window-tool-bar--graphical-separator
> + "|"))
> +
> + ;; Menu item, turn into propertized string button
> + (`(,key menu-item ,name-expr ,binding . ,plist)
> + (when binding ; If no binding exists, then button is hidden.
> + (let* ((name (eval name-expr))
> + (str (upcase-initials (or (plist-get plist :label)
> + (string-trim-right name "\\.+"))))
> + (len (length str))
> + (enable-form (plist-get plist :enable))
> + (enabled (or (not enable-form)
> + (eval enable-form))))
> + (if enabled
> + (add-text-properties 0 len
> + '(mouse-face window-tool-bar-button-hover
> + keymap window-tool-bar--button-keymap
> + face window-tool-bar-button)
> + str)
> + (put-text-property 0 len
> + 'face
> + 'window-tool-bar-button-disabled
> + str))
> + (when-let ((spec (and (window-tool-bar--use-images)
> + (plist-get menu-item :image))))
> + (put-text-property 0 len
> + 'display
> + (append spec
> + (if enabled '(:margin 2 :ascent center)
> + '(:margin 2 :ascent center
> + :conversion disabled)))
> + str))
> + (put-text-property 0 len
> + 'help-echo
> + (or (plist-get plist :help) name)
> + str)
> + (put-text-property 0 len 'tool-bar-key key str)
> + str)))))
> +
> +(defun window-tool-bar--call-button ()
> + "Call the button that was clicked on in the tab line."
> + (interactive)
> + (when (mouse-event-p last-command-event)
> + (let ((posn (event-start last-command-event)))
> + ;; Commands need to execute with the right buffer and window
> + ;; selected. The selection needs to be permanent for isearch.
> + (select-window (posn-window posn))
> + (let* ((str (posn-string posn))
> + (key (get-text-property (cdr str) 'tool-bar-key (car str)))
> + (cmd (lookup-key (window-tool-bar--get-keymap) (vector key))))
> + (call-interactively cmd)))))
> +
> +(defun window-tool-bar--ignore ()
> + "Do nothing. This command exists for isearch."
Can you elaborate? Why not just use the existing ignore? Or
defaliasing it?
> + (interactive)
> + nil)
> +
> +(defvar window-tool-bar--ignored-event-types
> + (let ((list (list 'mouse-movement 'pinch
> + 'wheel-down 'wheel-up 'wheel-left 'wheel-right
> + mouse-wheel-down-event mouse-wheel-up-event
> + mouse-wheel-left-event mouse-wheel-right-event
> + (bound-and-true-p mouse-wheel-down-alternate-event)
> + (bound-and-true-p mouse-wheel-up-alternate-event)
> + (bound-and-true-p mouse-wheel-left-alternate-event)
> + (bound-and-true-p mouse-wheel-right-alternate-event))))
> + (delete-dups (delete nil list)))
> + "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 tool bar in the tab line of the current buffer."
> + :lighter nil
There is no lighter by default, I prefer writing :global nil, to make it
explicit to the reader that this is a local minor mode.
> + (let ((should-display (and window-tool-bar-mode
> + (not (eq tool-bar-map
> + (default-value 'tool-bar-map))))))
> + (if (fboundp 'tab-line-set-display)
> + ;; Newly added function for Emacs 30.
> + (tab-line-set-display 'window-tool-bar-mode
> + (and should-display
> + '(:eval (window-tool-bar-string))))
> + ;; Legacy path for Emacs 29.
> + (setq tab-line-format
> + (and should-display
> + '(:eval (window-tool-bar-string)))))))
> +
> +;;;###autoload
> +(define-globalized-minor-mode global-window-tool-bar-mode
> + window-tool-bar-mode window-tool-bar--turn-on
> + :group 'window-tool-bar
> + (add-hook 'isearch-mode-hook #'window-tool-bar--turn-on)
> + (add-hook 'isearch-mode-end-hook #'window-tool-bar--turn-on))
> +
> +(defvar window-tool-bar--allow-images t
> + "Internal debug flag to force text mode.")
> +
> +(defun window-tool-bar--use-images ()
> + "Internal function.
> +Respects `window-tool-bar--allow-images' as well as frame
> +capabilities."
> + (and window-tool-bar--allow-images
> + (display-images-p)))
> +\f
> +;;; Display styling:
> +(defface window-tool-bar-button
> + '((default
> + :inherit tab-line)
> + (((class color) (min-colors 88) (supports :box t))
> + :box (:line-width -1 :style released-button)
> + :background "grey85")
> + ;; If the box is not supported, dim the button background a bit.
> + (((class color) (min-colors 88))
> + :background "grey70")
> + (t
> + :inverse-video t))
> + "Face used for buttons when the mouse is not hovering over the button."
> + :group 'window-tool-bar)
> +
> +(defface window-tool-bar-button-hover
> + '((default
> + :inherit tab-line)
> + (((class color) (min-colors 88))
> + :box (:line-width -1 :style released-button)
> + :background "grey95")
> + (t
> + :inverse-video t))
> + "Face used for buttons when the mouse is hovering over the button."
> + :group 'window-tool-bar)
> +
> +(defface window-tool-bar-button-disabled
> + '((default
> + :inherit tab-line)
> + (((class color) (min-colors 88))
> + :box (:line-width -1 :style released-button)
> + :background "grey50"
> + :foreground "grey70")
> + (t
> + :inverse-video t
> + :background "brightblack"))
> + "Face used for buttons when the button is disabled."
> + :group 'window-tool-bar)
> +\f
> +;;; Workaround for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334.
> +(defun window-tool-bar--get-keymap ()
> + "Return the tool bar keymap."
> + (let ((tool-bar-always-show-default nil))
> + (if (and (version< emacs-version "30")
> + (not (window-tool-bar--use-images)))
> + ;; This code path is a less efficient workaround.
> + (window-tool-bar--make-keymap-1)
> + (keymap-global-lookup "<tool-bar>"))))
> +
> +(declare-function image-mask-p "image.c" (spec &optional frame))
> +
> +(defun window-tool-bar--make-keymap-1 ()
> + "Patched copy of `tool-bar-make-keymap-1'."
> + (mapcar (lambda (bind)
> + (let (image-exp plist)
> + (when (and (eq (car-safe (cdr-safe bind)) 'menu-item)
> + ;; For the format of menu-items, see node
> + ;; `Extended Menu Items' in the Elisp manual.
> + (setq plist (nthcdr (if (consp (nth 4 bind)) 5 4)
> + bind))
> + (setq image-exp (plist-get plist :image))
> + (consp image-exp)
> + (not (eq (car image-exp) 'image))
> + (fboundp (car image-exp)))
> + (let ((image (and (display-images-p)
> + (eval image-exp))))
> + (unless (and image (image-mask-p image))
> + (setq image (append image '(:mask heuristic))))
> + (setq bind (copy-sequence bind)
> + plist (nthcdr (if (consp (nth 4 bind)) 5 4)
> + bind))
> + (plist-put plist :image image)))
> + bind))
> + tool-bar-map))
> +
> +(defun window-tool-bar--turn-on ()
> + "Internal function called by `global-window-tool-bar-mode'."
> + (when global-window-tool-bar-mode
> + (window-tool-bar-mode 1)))
> +
> +(provide 'window-tool-bar)
> +
> +;;; window-tool-bar.el ends here
Hope this was of use.
--
Philip Kaludercic on peregrine
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-04-27 10:00 ` Philip Kaludercic
@ 2024-04-28 4:44 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 0 replies; 15+ messages in thread
From: Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-04-28 4:44 UTC (permalink / raw)
To: Philip Kaludercic; +Cc: Eli Zaretskii, 68765
[-- Attachment #1: Type: text/plain, Size: 3952 bytes --]
On 2024-04-27 03:00, Philip Kaludercic wrote:
> Eli Zaretskii <eliz@gnu.org> writes:
>
>> Ping! Ping! Philip and Jared, are there any issues left to resolve
>> here, or should this be installed?
>
> Sorry for the delay, I'm going to comment below.
I addressed all feedback provided. Updated patch for just 0003 attached
since that's where all the feedback was. Let me know if this looks
good.
>
... partial patch elided ...
>> +(defun window-tool-bar-debug-show-memory-use ()
>> + "Development-only command to show memory used by
>> `window-tool-bar-string'."
>> + (interactive)
>> + (require 'time-stamp)
>> + (save-selected-window
>> + (pop-to-buffer "*WTB Memory Report*")
>> + (unless (eq major-mode 'special-mode)
>
> You should explain what is going on here, and why you are checking
> major-mode instead of using derived-mode-p.
I changed this to call derived-mode-p. The intent is to put the buffer
into special-mode and also avoid unnecessarily calling special-mode.
>> + (special-mode))
>> +
... partial patch elided ...
>> + (insert (format "Refresh count %d\n"
>> window-tool-bar--refresh-done-count)
>> + (format "Refresh executed percent %.2f\n"
>> + (/ window-tool-bar--refresh-done-count
>> + (+ window-tool-bar--refresh-done-count
>> + window-tool-bar--refresh-skipped-count)
>> + 1.0))
>
> I don't know if there is any significant difference between (/ a b 1.0)
> and (/ a (float b)), but interesting they have the same number of
> bytecode instructions and funcalls:
I changed this and other places where I was dividing by 1.0 to force
floating point division to instead do (float a) on the first parameter.
It sounds like that's more idiomatic.
>> + "\n"))))
>> +
>> +(defun window-tool-bar--insert-memory-use (label avg-memory-use)
>> + "Insert memory use into current buffer.
>> +
>> +LABEL: A prefix string to be in front of the data.
>> +AVG-MEMORY-USE: A list of averages, with the same meaning as
>> + `memory-use-counts'."
>
> The formatting is somewhat unconventional and can easily be broken
> using M-q.
Addressed here and other places I used this convention.
>> +(defun window-tool-bar--ignore ()
>> + "Do nothing. This command exists for isearch."
>
> Can you elaborate? Why not just use the existing ignore? Or
> defaliasing it?
There's a lot of detailed comments around usage of this command, see
comments around window-tool-bar--button-keymap. I also added a bit more
context to the docstring here. In brief, this command exists so that
isearch does not exit when you click on isearch tool bar buttons. This
is needed for window tool bar buttons since they are called by Emacs'
usual mouse event bindings, unlike toolkit tool bars.
I can't use ignore because it does not have the special registration
with isearch, specifically ignore is not a member of
isearch-menu-bar-commands. I did not feel safe changing all existing
uses of ignore.
>> + (let ((type (event-basic-type last-command-event)))
... partial patch elided ...
>> +;;;###autoload
>> +(define-minor-mode window-tool-bar-mode
>> + "Toggle display of the tool bar in the tab line of the current
>> buffer."
>> + :lighter nil
>
> There is no lighter by default, I prefer writing :global nil, to make
> it
> explicit to the reader that this is a local minor mode.
Thanks, changed.
Can you update define-minor-mode's docstring to guide others in the
right direction? I only passed :lighter nil because that was the
example given by define-minor-mode's docstring, "If you provide BODY,
then you must provide at least one keyword argument (e.g. `:lighter
nil')".
>> + (let ((should-display (and window-tool-bar-mode
... partial patch elided ...
>> +;;; window-tool-bar.el ends here
>
> Hope this was of use.
Thank you for the thorough review!
-- MJF
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0003-Adding-window-tool-bar-package.patch --]
[-- Type: text/x-diff; name=0003-Adding-window-tool-bar-package.patch, Size: 21545 bytes --]
From 0216c9be4bd27e84b05181df05de1ea55efa4137 Mon Sep 17 00:00:00 2001
From: Jared Finder <jared@finder.org>
Date: Fri, 26 Jan 2024 15:44:12 -0800
Subject: [PATCH 3/3] Adding window-tool-bar package
---
lisp/window-tool-bar.el | 489 ++++++++++++++++++++++++++++++++++++++++
1 file changed, 489 insertions(+)
create mode 100644 lisp/window-tool-bar.el
diff --git a/lisp/window-tool-bar.el b/lisp/window-tool-bar.el
new file mode 100644
index 00000000000..f3410576da8
--- /dev/null
+++ b/lisp/window-tool-bar.el
@@ -0,0 +1,489 @@
+;;; window-tool-bar.el --- Add tool bars inside windows -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
+
+;; Author: Jared Finder <jared@finder.org>
+;; Created: Nov 21, 2023
+;; Version: 0.2
+;; Keywords: mouse
+;; Package-Requires: ((emacs "29.1"))
+
+;; This is a GNU ELPA :core package. Avoid adding functionality that
+;; is not available in the version of Emacs recorded above or any of
+;; the package dependencies.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This package puts a tool bar in each window. This allows you to see
+;; multiple tool bars simultaneously directly next to the buffer it
+;; acts on which feels much more intuitive. Emacs "browsing" modes
+;; generally have sensible tool bars, for example: *info*, *help*, and
+;; *eww* have them.
+;;
+;; It does this while being mindful of screen real estate. Most modes
+;; do not provide a custom tool bar, and this package does not show the
+;; default tool bar. This means that for most buffers there will be no
+;; space taken up. Furthermore, you can put this tool bar in the mode
+;; line or tab line if you want to share it with existing content.
+;;
+;; To get the default behavior, run (global-window-tool-bar-mode 1) or
+;; enable via M-x customize-group RET window-tool-bar RET. This uses
+;; the per-window tab line to show the tool bar.
+;;
+;; If you want to share space with an existing tab line, mode line, or
+;; header line, add (:eval (window-tool-bar-string)) to
+;; `tab-line-format', `mode-line-format', or `header-line-format'.
+
+;;; Known issues:
+;;
+;; On GNU Emacs 29.1, terminals dragging to resize windows will error
+;; with message "<tab-line> <mouse-movement> is undefined". This is a
+;; bug in GNU Emacs,
+;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=67457>.
+;;
+;; On GNU Emacs 29, performance in terminals is lower than on
+;; graphical frames. This is due to a workaround, see "Workaround for
+;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334", below.
+
+;;; Todo:
+;;
+;; Not all features planned are implemented yet. Eventually I would
+;; like to also generally make tool bars better.
+;;
+;; Targeting 0.3:
+;; * Properly support reamining less frequently used tool bar item specs. From
+;; `parse_tool_bar_item':
+;; * :visible
+;; * :filter
+;; * :button
+;; * :wrap
+;; * Add display customization similar to `tool-bar-style'.
+;;
+;; Targeting 1.0:
+;;
+;; * Clean up Emacs tool bars
+;; * Default: Remove default tool-bar entirely
+;; * grep, vc: Remove default tool-bar inherited
+;; * info: Remove Next / Prev / Up, which is already in the header
+;; * smerge: Add tool bar for next/prev
+;;
+;; Post 1.0 work:
+;;
+;; * Show keyboard shortcut on help text.
+;;
+;; * Add a bit more documentation.
+;; * Add customization option: ignore-default-tool-bar-map
+;; * Make tab-line dragging resize the window
+
+;;; Code:
+
+(require 'mwheel)
+(require 'tab-line)
+(require 'tool-bar)
+\f
+;;; Benchmarking code
+;;
+;; Refreshing the tool bar is computationally simple, but generates a
+;; lot of garbage. So this benchmarking focuses on garbage
+;; generation. Since it has to run after most commands, generating
+;; significantly more garbage will cause noticeable performance
+;; degration.
+;;
+;; The refresh has two steps:
+;;
+;; Step 1: Look up the <tool-bar> map.
+;; Step 2: Generate a Lisp string using text properties for the tool
+;; bar string.
+;;
+;; Additionally, we keep track of the percentage of commands that
+;; acutally created a refresh.
+(defvar window-tool-bar--memory-use-delta-step1 (make-list 7 0)
+ "Absolute delta of memory use counters during step 1.
+This is a list in the same structure as `memory-use-counts'.")
+(defvar window-tool-bar--memory-use-delta-step2 (make-list 7 0)
+ "Absolute delta of memory use counters during step 2.
+This is a list in the same structure as `memory-use-counts'.")
+(defvar window-tool-bar--refresh-done-count 0
+ "Number of tool bar string refreshes run.
+The total number of requests is the sum of this and
+`window-tool-bar--refresh-skipped-count'.")
+(defvar window-tool-bar--refresh-skipped-count 0
+ "Number of tool bar string refreshes that were skipped.
+The total number of requests is the sum of this and
+`window-tool-bar--refresh-done-count'.")
+
+(defun window-tool-bar--memory-use-avg-step1 ()
+ "Return average memory use delta during step 1."
+ (mapcar (lambda (elt) (/ (float elt) window-tool-bar--refresh-done-count))
+ window-tool-bar--memory-use-delta-step1))
+
+(defun window-tool-bar--memory-use-avg-step2 ()
+ "Return average memory use delta during step 2."
+ (mapcar (lambda (elt) (/ (float elt) window-tool-bar--refresh-done-count))
+ window-tool-bar--memory-use-delta-step2))
+
+(declare-function time-stamp-string "time-stamp")
+
+(defun window-tool-bar-debug-show-memory-use ()
+ "Development-only command to show memory used by `window-tool-bar-string'."
+ (interactive)
+ (require 'time-stamp)
+ (save-selected-window
+ (pop-to-buffer "*WTB Memory Report*")
+ (unless (derived-mode-p 'special-mode)
+ (special-mode))
+
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (propertize (concat "Function: window-tool-bar-string "
+ (time-stamp-string))
+ 'face 'underline 'font-lock-face 'underline)
+ "\n\n")
+ (window-tool-bar--insert-memory-use
+ "Step 1" (window-tool-bar--memory-use-avg-step1))
+ (window-tool-bar--insert-memory-use
+ "Step 2" (window-tool-bar--memory-use-avg-step2))
+ (insert (format "Refresh count %d\n" window-tool-bar--refresh-done-count)
+ (format "Refresh executed percent %.2f\n"
+ (/ (float window-tool-bar--refresh-done-count)
+ (+ window-tool-bar--refresh-done-count
+ window-tool-bar--refresh-skipped-count)))
+ "\n"))))
+
+(defun window-tool-bar--insert-memory-use (label avg-memory-use)
+ "Insert memory use into current buffer.
+
+LABEL is a prefix string to be in front of the data.
+AVG-MEMORY-USE is a list of averages, with the same meaning as
+`memory-use-counts'."
+ (let* ((label-len (length label))
+ (padding (make-string label-len ?\s)))
+ (cl-loop for usage in avg-memory-use
+ for usage-label in '("Conses" "Floats" "Vector cells" "Symbols"
+ "String chars" "Intervals" "Strings")
+ for idx from 0
+ do (insert (format "%s %8.2f %s\n"
+ (if (= idx 0) label padding)
+ usage
+ usage-label)))))
+\f
+(defgroup window-tool-bar nil
+ "Tool bars per-window."
+ :group 'convenience
+ :prefix "window-tool-bar-")
+
+(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
+
+ ;; Mouse down events do nothing. A binding is needed so isearch
+ ;; does not exit when the tab bar is clicked.
+ "<tab-line> <down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <double-down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <triple-down-mouse-1>" #'window-tool-bar--ignore
+ "<tab-line> <down-mouse-2>" #'window-tool-bar--ignore
+ "<tab-line> <double-down-mouse-2>" #'window-tool-bar--ignore
+ "<tab-line> <triple-down-mouse-2>" #'window-tool-bar--ignore)
+(fset 'window-tool-bar--button-keymap window-tool-bar--button-keymap) ; So it can be a keymap property
+
+;; Register bindings that stay in isearch. Technically, these
+;; commands don't pop up a menu but they act very similar in that they
+;; are caused by mouse input and may call commands via
+;; `call-interactively'.
+(push 'window-tool-bar--call-button isearch-menu-bar-commands)
+(push 'window-tool-bar--ignore isearch-menu-bar-commands)
+
+(defvar-local window-tool-bar-string--cache nil
+ "Cache for previous result of `window-tool-bar-string'.")
+
+;;;###autoload
+(defun window-tool-bar-string ()
+ "Return a (propertized) string for the tool bar.
+
+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'"
+ (if (or (null window-tool-bar-string--cache)
+ (window-tool-bar--last-command-triggers-refresh-p))
+ (let* ((mem0 (memory-use-counts))
+ (toolbar-menu (window-tool-bar--get-keymap))
+ (mem1 (memory-use-counts))
+ (result (mapconcat #'window-tool-bar--keymap-entry-to-string
+ (cdr toolbar-menu) ;Skip 'keymap
+ ;; Without spaces between the text, hovering
+ ;; highlights all adjacent buttons.
+ (if (window-tool-bar--use-images)
+ (propertize " " 'invisible t)
+ " ")))
+ (mem2 (memory-use-counts)))
+ (cl-mapl (lambda (l-init l0 l1)
+ (cl-incf (car l-init) (- (car l1) (car l0))))
+ window-tool-bar--memory-use-delta-step1 mem0 mem1)
+ (cl-mapl (lambda (l-init l1 l2)
+ (cl-incf (car l-init) (- (car l2) (car l1))))
+ window-tool-bar--memory-use-delta-step2 mem1 mem2)
+
+ (setf window-tool-bar-string--cache
+ (concat
+ ;; The tool bar face by default puts boxes around the
+ ;; buttons. However, this box is not displayed if the
+ ;; box starts at the leftmost pixel of the tab-line.
+ ;; Add a single space in this case so the box displays
+ ;; correctly.
+ (and (display-supports-face-attributes-p
+ '(:box (line-width 1)))
+ (propertize " " 'display '(space :width (1))))
+ result))
+ (cl-incf window-tool-bar--refresh-done-count))
+ (cl-incf window-tool-bar--refresh-skipped-count))
+
+ window-tool-bar-string--cache)
+
+(defconst window-tool-bar--graphical-separator
+ (concat
+ (propertize " " 'display '(space :width (4)))
+ (propertize " " 'display '(space :width (1) face (:inverse-video t)))
+ (propertize " " 'display '(space :width (4)))))
+
+(defun window-tool-bar--keymap-entry-to-string (menu-item)
+ "Convert MENU-ITEM into a (propertized) string representation.
+
+MENU-ITEM is a menu item to convert. See info node (elisp)Tool Bar."
+ (pcase-exhaustive menu-item
+ ;; Separators
+ ((or `(,_ "--")
+ `(,_ menu-item ,(and (pred stringp)
+ (pred (string-prefix-p "--")))))
+ (if (window-tool-bar--use-images)
+ window-tool-bar--graphical-separator
+ "|"))
+
+ ;; Menu item, turn into propertized string button
+ (`(,key menu-item ,name-expr ,binding . ,plist)
+ (when binding ; If no binding exists, then button is hidden.
+ (let* ((name (eval name-expr))
+ (str (upcase-initials (or (plist-get plist :label)
+ (string-trim-right name "\\.+"))))
+ (len (length str))
+ (enable-form (plist-get plist :enable))
+ (enabled (or (not enable-form)
+ (eval enable-form))))
+ (if enabled
+ (add-text-properties 0 len
+ '(mouse-face window-tool-bar-button-hover
+ keymap window-tool-bar--button-keymap
+ face window-tool-bar-button)
+ str)
+ (put-text-property 0 len
+ 'face
+ 'window-tool-bar-button-disabled
+ str))
+ (when-let ((spec (and (window-tool-bar--use-images)
+ (plist-get menu-item :image))))
+ (put-text-property 0 len
+ 'display
+ (append spec
+ (if enabled '(:margin 2 :ascent center)
+ '(:margin 2 :ascent center
+ :conversion disabled)))
+ str))
+ (put-text-property 0 len
+ 'help-echo
+ (or (plist-get plist :help) name)
+ str)
+ (put-text-property 0 len 'tool-bar-key key str)
+ str)))))
+
+(defun window-tool-bar--call-button ()
+ "Call the button that was clicked on in the tab line."
+ (interactive)
+ (when (mouse-event-p last-command-event)
+ (let ((posn (event-start last-command-event)))
+ ;; Commands need to execute with the right buffer and window
+ ;; selected. The selection needs to be permanent for isearch.
+ (select-window (posn-window posn))
+ (let* ((str (posn-string posn))
+ (key (get-text-property (cdr str) 'tool-bar-key (car str)))
+ (cmd (lookup-key (window-tool-bar--get-keymap) (vector key))))
+ (call-interactively cmd)))))
+
+(defun window-tool-bar--ignore ()
+ "Internal command so isearch does not exit on button-down events."
+ (interactive)
+ nil)
+
+(defvar window-tool-bar--ignored-event-types
+ (let ((list (list 'mouse-movement 'pinch
+ 'wheel-down 'wheel-up 'wheel-left 'wheel-right
+ mouse-wheel-down-event mouse-wheel-up-event
+ mouse-wheel-left-event mouse-wheel-right-event
+ (bound-and-true-p mouse-wheel-down-alternate-event)
+ (bound-and-true-p mouse-wheel-up-alternate-event)
+ (bound-and-true-p mouse-wheel-left-alternate-event)
+ (bound-and-true-p mouse-wheel-right-alternate-event))))
+ (delete-dups (delete nil list)))
+ "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 tool bar in the tab line of the current buffer."
+ :global nil
+ (let ((should-display (and window-tool-bar-mode
+ (not (eq tool-bar-map
+ (default-value 'tool-bar-map))))))
+ (if (fboundp 'tab-line-set-display)
+ ;; Newly added function for Emacs 30.
+ (tab-line-set-display 'window-tool-bar-mode
+ (and should-display
+ '(:eval (window-tool-bar-string))))
+ ;; Legacy path for Emacs 29.
+ (setq tab-line-format
+ (and should-display
+ '(:eval (window-tool-bar-string)))))))
+
+;;;###autoload
+(define-globalized-minor-mode global-window-tool-bar-mode
+ window-tool-bar-mode window-tool-bar--turn-on
+ :group 'window-tool-bar
+ (add-hook 'isearch-mode-hook #'window-tool-bar--turn-on)
+ (add-hook 'isearch-mode-end-hook #'window-tool-bar--turn-on))
+
+(defvar window-tool-bar--allow-images t
+ "Internal debug flag to force text mode.")
+
+(defun window-tool-bar--use-images ()
+ "Internal function.
+Respects `window-tool-bar--allow-images' as well as frame
+capabilities."
+ (and window-tool-bar--allow-images
+ (display-images-p)))
+\f
+;;; Display styling:
+(defface window-tool-bar-button
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88) (supports :box t))
+ :box (:line-width -1 :style released-button)
+ :background "grey85")
+ ;; If the box is not supported, dim the button background a bit.
+ (((class color) (min-colors 88))
+ :background "grey70")
+ (t
+ :inverse-video t))
+ "Face used for buttons when the mouse is not hovering over the button."
+ :group 'window-tool-bar)
+
+(defface window-tool-bar-button-hover
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88))
+ :box (:line-width -1 :style released-button)
+ :background "grey95")
+ (t
+ :inverse-video t))
+ "Face used for buttons when the mouse is hovering over the button."
+ :group 'window-tool-bar)
+
+(defface window-tool-bar-button-disabled
+ '((default
+ :inherit tab-line)
+ (((class color) (min-colors 88))
+ :box (:line-width -1 :style released-button)
+ :background "grey50"
+ :foreground "grey70")
+ (t
+ :inverse-video t
+ :background "brightblack"))
+ "Face used for buttons when the button is disabled."
+ :group 'window-tool-bar)
+\f
+;;; Workaround for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=68334.
+(defun window-tool-bar--get-keymap ()
+ "Return the tool bar keymap."
+ (let ((tool-bar-always-show-default nil))
+ (if (and (version< emacs-version "30")
+ (not (window-tool-bar--use-images)))
+ ;; This code path is a less efficient workaround.
+ (window-tool-bar--make-keymap-1)
+ (keymap-global-lookup "<tool-bar>"))))
+
+(declare-function image-mask-p "image.c" (spec &optional frame))
+
+(defun window-tool-bar--make-keymap-1 ()
+ "Patched copy of `tool-bar-make-keymap-1'."
+ (mapcar (lambda (bind)
+ (let (image-exp plist)
+ (when (and (eq (car-safe (cdr-safe bind)) 'menu-item)
+ ;; For the format of menu-items, see node
+ ;; `Extended Menu Items' in the Elisp manual.
+ (setq plist (nthcdr (if (consp (nth 4 bind)) 5 4)
+ bind))
+ (setq image-exp (plist-get plist :image))
+ (consp image-exp)
+ (not (eq (car image-exp) 'image))
+ (fboundp (car image-exp)))
+ (let ((image (and (display-images-p)
+ (eval image-exp))))
+ (unless (and image (image-mask-p image))
+ (setq image (append image '(:mask heuristic))))
+ (setq bind (copy-sequence bind)
+ plist (nthcdr (if (consp (nth 4 bind)) 5 4)
+ bind))
+ (plist-put plist :image image)))
+ bind))
+ tool-bar-map))
+
+(defun window-tool-bar--turn-on ()
+ "Internal function called by `global-window-tool-bar-mode'."
+ (when global-window-tool-bar-mode
+ (window-tool-bar-mode 1)))
+
+(provide 'window-tool-bar)
+
+;;; window-tool-bar.el ends here
--
2.39.2
^ permalink raw reply related [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-03-27 7:04 ` Juri Linkov
@ 2024-05-02 6:03 ` Juri Linkov
2024-05-09 8:00 ` Eli Zaretskii
0 siblings, 1 reply; 15+ messages in thread
From: Juri Linkov @ 2024-05-02 6:03 UTC (permalink / raw)
To: Jared Finder; +Cc: Philip Kaludercic, Eli Zaretskii, 68765, Stefan Monnier
>> It's been four weeks and I've seen no reply to this comment. Are there any
>> other concerns?
>
> Sorry, I didn't know that you expected that I should review your patch -
> I was silent because your last patch has no changes in tab-line.el,
> so I have no more objections in this regard.
The reason why no changes are required in tab-line.el is
because this feature is not exclusively for the tab line,
so window-tool-bar.el should also handle the case
when the tool bar is combined with the header line.
For example, in Info mode the users might prefer to show
the Info tool bar icons and Next/Prev/Up
on the same header line.
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#68765: 30.0.50; Adding window-tool-bar package.
2024-05-02 6:03 ` Juri Linkov
@ 2024-05-09 8:00 ` Eli Zaretskii
0 siblings, 0 replies; 15+ messages in thread
From: Eli Zaretskii @ 2024-05-09 8:00 UTC (permalink / raw)
To: Juri Linkov; +Cc: philipk, jared, 68765, monnier
> From: Juri Linkov <juri@linkov.net>
> Cc: Eli Zaretskii <eliz@gnu.org>, 68765@debbugs.gnu.org, Philip Kaludercic
> <philipk@posteo.net>, Stefan Monnier <monnier@iro.umontreal.ca>
> Date: Thu, 02 May 2024 09:03:20 +0300
>
> >> It's been four weeks and I've seen no reply to this comment. Are there any
> >> other concerns?
> >
> > Sorry, I didn't know that you expected that I should review your patch -
> > I was silent because your last patch has no changes in tab-line.el,
> > so I have no more objections in this regard.
>
> The reason why no changes are required in tab-line.el is
> because this feature is not exclusively for the tab line,
> so window-tool-bar.el should also handle the case
> when the tool bar is combined with the header line.
> For example, in Info mode the users might prefer to show
> the Info tool bar icons and Next/Prev/Up
> on the same header line.
If there's an agreement about this issue, could you, Jared, please
post the final patch reflecting the agreements?
If there's no agreement, what are the issues that prevent it?
Thanks.
^ permalink raw reply [flat|nested] 15+ messages in thread
end of thread, other threads:[~2024-05-09 8:00 UTC | newest]
Thread overview: 15+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-01-27 23:36 bug#68765: 30.0.50; Adding window-tool-bar package Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-10 8:19 ` Eli Zaretskii
2024-02-10 17:25 ` Juri Linkov
2024-02-26 22:38 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-26 15:34 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-27 7:04 ` Juri Linkov
2024-05-02 6:03 ` Juri Linkov
2024-05-09 8:00 ` Eli Zaretskii
2024-02-11 20:51 ` Philip Kaludercic
2024-02-27 3:02 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-26 15:33 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-13 7:43 ` Eli Zaretskii
2024-04-27 8:25 ` Eli Zaretskii
2024-04-27 10:00 ` Philip Kaludercic
2024-04-28 4:44 ` Jared Finder via Bug reports for GNU Emacs, the Swiss army knife of text editors
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).