[PATCH] Enable persistent naming for tabs

[Robert Cochran <robert+Emacs@cochranmail.com>]

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

Hi emacs-devel,

I saw news recently of the new tabs that are on master. They're really
nifty - kudos to Juri Linkov for doing a lot of work on them. :)

I was admittedly a little disappointed, however, to see that the user, or
other Lisp programs, couldn't change the name of a tab persistently - it
*could* be changed, but a lot of the functions that handle tabs
immediately call the automatic naming function, before the UI could even
update to display it. Some applications might want to have a consistent
name divorced from the current buffer, and sometimes it would be nice to
override the automatic name on a per-tab basis as a user.

The solution I went with was another value in the tabs frame-parameter
alist. A new cons with the name `no-auto-name` in the car is used. If
the cdr is nil, then the behavior we have now remains - the tab handling
functions will call the value of `tab-bar-tab-name-function` and update
the name immediately. With a non-nil value, any time
`tab-bar-tab-name-function` would be called, the existing name is
instead substituted.

I've added 2 new functions, `tab-bar-rename-tab` and
`tab-bar-rename-tab-by-name`. Both functions take a new name, and a tag
identifier, either a frame tab index or an existing name,
respectively. The new name is then set on the tab, and the
`no-auto-name` parameter is set non-nil, unless the new name is the
empty string, which is taken to mean 'turn automatic naming back on'.

A couple of things I'm still wondering about: should this be documented
in the manual? I was going to do so, but couldn't really find a good
spot to mention it. If we do add something to the manual, we should
mention `tab-bar-tab-name-function` as well. Do we want to add this to
the default `C-x 6` binds, possibly as `C-x 6 r`? I already set
`tab-rename` as an alias to `tab-bar-rename-tab`, but I'm curious what
other people are thinking on that. Is there a better name for
`no-auto-name`? I couldn't think of a better one... I was aiming to have
a name who's interpretation as 'nil' is 'don't do anything differently',
so as to make the code slightly easier to read, as well as ensuring
saved tabs don't get automatic naming turned on by mistake.

Thanks,
-- 
~Robert Cochran


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch to allow consistent names for tab-bar tabs --]
[-- Type: text/x-patch, Size: 5673 bytes --]

From 59126587d419b5f57c79a970919894f6e91b5c91 Mon Sep 17 00:00:00 2001
From: Robert Cochran <robert-git@cochranmail.com>
Date: Mon, 7 Oct 2019 13:41:47 -0700
Subject: [PATCH] Allow tabs to have consistent given names

* lisp/tab-bar.el (tab-bar--tab): Pull automatic name information from
current tab
(tab-bar--current-tab): Pull automatic name information from current
tab, or from new optional template argument
(tab-bar-select-tab): Pass the target tab as a template when setting
current tab
(tab-bar-rename-tab, tab-bar-rename-tab-by-name): New functions
---
 lisp/tab-bar.el | 80 ++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 66 insertions(+), 14 deletions(-)

diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 91bc589ae2..1a1d5ab2b8 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -301,9 +301,13 @@ tab-bar-make-keymap-1
   (let* ((separator (or tab-bar-separator (if window-system " " "|")))
          (i 0)
          (tabs (funcall tab-bar-tabs-function))
-         (current-tab-name (assq 'name (assq 'current-tab tabs))))
-    (when current-tab-name
-      (setf (cdr current-tab-name) (funcall tab-bar-tab-name-function)))
+         (current-tab-name (assq 'name (assq 'current-tab tabs)))
+         (current-tab-no-auto-name (assq 'no-auto-name (assq 'current-tab tabs))))
+    (when (and current-tab-name
+               current-tab-no-auto-name
+               (not (cdr current-tab-no-auto-name)))
+      (setf (cdr current-tab-name)
+            (funcall tab-bar-tab-name-function)))
     (append
      '(keymap (mouse-1 . tab-bar-handle-mouse))
      (mapcan
@@ -355,16 +359,29 @@ tab-bar-make-keymap-1
 
 \f
 (defun tab-bar--tab ()
-  `(tab
-    (name . ,(funcall tab-bar-tab-name-function))
-    (time . ,(time-convert nil 'integer))
-    (wc . ,(current-window-configuration))
-    (ws . ,(window-state-get
-            (frame-root-window (selected-frame)) 'writable))))
-
-(defun tab-bar--current-tab ()
-  `(current-tab
-    (name . ,(funcall tab-bar-tab-name-function))))
+  (let* ((tab (assq 'current-tab (frame-parameter nil 'tabs)))
+         (tab-no-auto-name (cdr (assq 'no-auto-name tab))))
+    `(tab
+      (name . ,(if tab-no-auto-name
+                   (cdr (assq 'name tab))
+                 (funcall tab-bar-tab-name-function)))
+      (no-auto-name . ,tab-no-auto-name)
+      (time . ,(time-convert nil 'integer))
+      (wc . ,(current-window-configuration))
+      (ws . ,(window-state-get
+              (frame-root-window (selected-frame)) 'writable)))))
+
+(defun tab-bar--current-tab (&optional tab)
+  ;; `tab` here is an argument meaning 'use tab as template'. This is
+  ;; necessary when switching tabs, otherwise the destination tab
+  ;; inherent the current tab's `no-auto-name` parameter.
+  (let* ((tab (or tab (assq 'current-tab (frame-parameter nil 'tabs))))
+         (tab-no-auto-name (cdr (assq 'no-auto-name tab))))
+    `(current-tab
+      (name . ,(if tab-no-auto-name
+                   (cdr (assq 'name tab))
+                 (funcall tab-bar-tab-name-function)))
+      (no-auto-name . ,tab-no-auto-name))))
 
 (defun tab-bar--current-tab-index (&optional tabs)
   ;; FIXME: could be replaced with 1-liner using seq-position
@@ -433,7 +450,7 @@ tab-bar-select-tab
 
         (when from-index
           (setf (nth from-index tabs) from-tab))
-        (setf (nth to-index tabs) (tab-bar--current-tab)))
+        (setf (nth to-index tabs) (tab-bar--current-tab (nth to-index tabs))))
 
       (when tab-bar-mode
         (force-mode-line-update)))))
@@ -587,6 +604,40 @@ tab-close-other
           (force-mode-line-update)
         (message "Deleted all other tabs")))))
 
+(defun tab-bar-rename-tab (name &optional arg)
+  "Rename the tab specified by its absolute position ARG.
+If no ARG is specified, then rename the current tab.
+ARG counts from 1.
+If NAME is the empty string, then use the automatic name
+function `tab-bar-tab-name-function'."
+  (interactive "sNew name for tab (leave blank for automatic naming): \nP")
+  (let* ((tabs (tab-bar-tabs))
+         (tab-index (if arg
+                        (1- (max 0 (min arg (length tabs))))
+                      (tab-bar--current-tab-index tabs)))
+         (tab-to-rename (nth tab-index tabs))
+         (tab-no-auto-name (> (length name) 0))
+         (tab-new-name (if tab-no-auto-name
+                           name
+                         (funcall tab-bar-tab-name-function))))
+    (setf (cdr (assq 'name tab-to-rename)) tab-new-name
+          (cdr (assq 'no-auto-name tab-to-rename)) tab-no-auto-name
+          (frame-parameter nil 'tabs) tabs)
+    (if (tab-bar-mode)
+        (force-mode-line-update)
+      (message "Renamed tab to '%s'" tab-new-name))))
+
+(defun tab-bar-rename-tab-by-name (tab-name new-name)
+  "Rename the tab named TAB-NAME.
+If NEW-NAME is the empty string, then use the automatic name
+function `tab-bar-tab-name-function'."
+  (interactive (list (completing-read "Rename tab by name: "
+                                      (mapcar (lambda (tab)
+                                                (cdr (assq 'name tab)))
+                                              (tab-bar-tabs)))
+                     (read-from-minibuffer "New name for tab (leave blank for automatic naming): ")))
+  (tab-bar-rename-tab new-name (tab-bar--tab-index-by-name tab-name)))
+
 \f
 ;;; Short aliases
 
@@ -595,6 +646,7 @@ 'tab-close
 (defalias 'tab-select   'tab-bar-select-tab)
 (defalias 'tab-next     'tab-bar-switch-to-next-tab)
 (defalias 'tab-previous 'tab-bar-switch-to-prev-tab)
+(defalias 'tab-rename   'tab-bar-rename-tab)
 (defalias 'tab-list     'tab-bar-list)
 
 \f
-- 
2.21.0