From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Philip Kaludercic Newsgroups: gmane.emacs.bugs Subject: bug#68765: 30.0.50; Adding window-tool-bar package. Date: Sat, 27 Apr 2024 10:00:21 +0000 Message-ID: <87zftfqg5m.fsf@posteo.net> References: <07df5e8408054bcae5968066b0cebf34@finder.org> <6c2e5fe5d3439f0a3696f86bd99bbb7b@finder.org> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="40091"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Eli Zaretskii , 68765@debbugs.gnu.org To: Jared Finder Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sat Apr 27 12:02:06 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1s0ese-000AEV-7f for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 27 Apr 2024 12:02:05 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1s0esR-0006LW-Ig; Sat, 27 Apr 2024 06:01:51 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1s0esM-0006L7-9E for bug-gnu-emacs@gnu.org; Sat, 27 Apr 2024 06:01:46 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1s0esM-0002Qz-1U for bug-gnu-emacs@gnu.org; Sat, 27 Apr 2024 06:01:46 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1s0ese-0006x3-Mo for bug-gnu-emacs@gnu.org; Sat, 27 Apr 2024 06:02:04 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Philip Kaludercic Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 27 Apr 2024 10:02:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 68765 X-GNU-PR-Package: emacs Original-Received: via spool by 68765-submit@debbugs.gnu.org id=B68765.171421208126140 (code B ref 68765); Sat, 27 Apr 2024 10:02:04 +0000 Original-Received: (at 68765) by debbugs.gnu.org; 27 Apr 2024 10:01:21 +0000 Original-Received: from localhost ([127.0.0.1]:38977 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1s0eri-0006kb-00 for submit@debbugs.gnu.org; Sat, 27 Apr 2024 06:01:20 -0400 Original-Received: from mout01.posteo.de ([185.67.36.65]:51345) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1s0erQ-0006ed-6u for 68765@debbugs.gnu.org; Sat, 27 Apr 2024 06:01:03 -0400 Original-Received: from submission (posteo.de [185.67.36.169]) by mout01.posteo.de (Postfix) with ESMTPS id 2493A240027 for <68765@debbugs.gnu.org>; Sat, 27 Apr 2024 12:00:23 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1714212023; bh=vwSMdRTeimsVZHViMMwSp4gHCqKUIGRpiGW0L04Mhdc=; h=From:To:Cc:Subject:OpenPGP:Date:Message-ID:MIME-Version: Content-Type:From; b=BavitXjpNti0zhwMOlrHFPE0kZ40TrVpF/+r5jCxJqTlzDvahVS5aMxJimtLj0h19 fCF0yfjheJtp7sa5TPaxGnohTjYlukuPw7HDcSs+dSHwK0ZW0xB9ak//zHCRbZCm4M aCHzOL7Hm7tOlKpGKlXI1DG73noR0p7XrX2NBgXjTBALCdiyzpG5SMjubUX7hgjM1+ yhH62KYXU1FE5ESo+0ygYKCcquanVugOVkePajU7T1SRoGnjT2LX6tpJHIg9+vWhWn bKGEAQmLOOJLwI1Il/kfd79r8vWzpBPjfHImyr+9JPvEVqjqCmP3h2jYjP7wYLvETU vQwdFSy/1m4OQ== Original-Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4VRQ7p2cRYz9rxK; Sat, 27 Apr 2024 12:00:22 +0200 (CEST) In-Reply-To: <6c2e5fe5d3439f0a3696f86bd99bbb7b@finder.org> (Jared Finder's message of "Mon, 26 Feb 2024 19:02:06 -0800") OpenPGP: id=7126E1DE2F0CE35C770BED01F2C3CC513DB89F66; url="https://keys.openpgp.org/vks/v1/by-fingerprint/7126E1DE2F0CE35C770BED01F2C3CC513DB89F66"; preference=signencrypt X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:284035 Archived-At: Eli Zaretskii 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 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 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 > 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") > + > No comments from me here. > ;; Modifier bar mode. > -- > 2.39.2 > > > From baf4c81df3e4e82576a8084ae029d56b45750553 Mon Sep 17 00:00:00 2001 > From: Jared Finder > 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 > +;; 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 . > + > +;;; 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 " is undefined". This is a > +;; bug in GNU Emacs, > +;; . > +;; > +;; 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) > + > +;;; 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 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))))) > + > +(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'." > + "" '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. > + " " #'window-tool-bar--call-button > + " " #'window-tool-bar--call-button > + " " #'window-tool-bar--call-button > + " " #'window-tool-bar--call-button > + " " #'window-tool-bar--call-button > + " " #'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. > + " " #'window-tool-bar--ignore > + " " #'window-tool-bar--ignore > + " " #'window-tool-bar--ignore > + " " #'window-tool-bar--ignore > + " " #'window-tool-bar--ignore > + " " #'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))) > + > +;;; 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) > + > +;;; 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 "")))) > + > +(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