Archived
1
0
Fork 0
This repository has been archived on 2024-10-19. You can view files and clone it, but cannot push or open issues or pull requests.
emacs/code/elpa/centaur-tabs-20240726.625/centaur-tabs-interactive.el

643 lines
28 KiB
EmacsLisp
Raw Permalink Normal View History

;;; centaur-tabs-interactive.el --- centaur-tabs interactive functions and plugins support lexical-binding: t; -*-
2024-07-28 16:03:37 +00:00
;; Copyright (C) 2019-2024 Emmanuel Bustos
;; Copyright (C) 2024 Jen-Chieh Shen
;; This file is not part of GNU Emacs.
;; This program 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 2, or
;; (at your option) any later version.
;;
;; This program 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 this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
2024-07-28 16:03:37 +00:00
;;; Commentary:
2024-07-28 16:03:37 +00:00
;;
;; This file contains centaur-tabs interactive functions and plugins support
2024-07-28 16:03:37 +00:00
;;
;;; Code:
2024-07-28 16:03:37 +00:00
(require 'cl-lib)
(require 'centaur-tabs-elements)
2024-07-28 16:03:37 +00:00
;; Compiler pacifier
(declare-function ivy-read "ext:ivy.el" t t)
(declare-function helm-build-sync-source "ext:helm-source.el" t t)
(defvar helm-source-centaur-tabs-group)
(declare-function projectile-project-root "ext:projectile.el" t t)
(declare-function projectile-project-name "ext:projectile.el" t t)
(declare-function centaur-tabs-do-select "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-tab-from-event "centaur-tabs-functions.el")
(declare-function centaur-tabs-tab-value "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-tabset "centaur-tabs-functions.el")
(declare-function centaur-tabs-buffer-show-groups "centaur-tabs-functions.el")
(declare-function centaur-tabs-buffer-close-tab "centaur-tabs-functions.el")
(declare-function centaur-tabs-view "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-extensions "centaur-tabs-functions.el")
(declare-function centaur-tabs-selected-tab "centaur-tabs-functions.el")
(declare-function centaur-tabs-display-update "centaur-tabs-functions.el")
(declare-function centaur-tabs-set-template "centaur-tabs-functions.el")
(declare-function centaur-tabs-buffer-select-tab "centaur-tabs-functions.el")
(declare-function centaur-tabs-tabs "centaur-tabs-functions.el")
(declare-function centaur-tabs-tab-tabset "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-tabsets-tabset "centaur-tabs-functions.el")
(declare-function centaur-tabs-current-tabset "centaur-tabs-functions.el")
(declare-function centaur-tabs-completing-read "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-groups "centaur-tabs-functions.el")
(declare-function centaur-tabs-forward-group "centaur-tabs-functions.el")
(declare-function centaur-tabs-backward-group "centaur-tabs-functions.el")
(declare-function centaur-tabs-forward-tab "centaur-tabs-functions.el")
(declare-function centaur-tabs-backward-tab "centaur-tabs-functions.el")
(defvar centaur-tabs-cycle-scope)
(defvar centaur-tabs-current-tabset)
(defvar centaur-tabs-last-focused-buffer-group)
(defvar centaur-tabs-buffer-list-function)
(defvar centaur-tabs-buffer-groups-function)
(defvar centaur-tabs--buffer-show-groups)
;;;;;;;;;;;;;;;;;;;;;;; Interactive functions ;;;;;;;;;;;;;;;;;;;;;;;
(defun centaur-tabs-switch-group (&optional groupname)
"Switch tab groups using ido. GROUPNAME can optionaly be provided."
(interactive)
2024-07-28 16:03:37 +00:00
(let* ((tab-buffer-list (mapcar
#'(lambda (b)
(with-current-buffer b
(list (current-buffer)
(buffer-name)
(funcall centaur-tabs-buffer-groups-function) )))
(funcall centaur-tabs-buffer-list-function)))
(groups (centaur-tabs-get-groups))
(group-name (or groupname (centaur-tabs-completing-read "Groups: " groups))) )
(catch 'done
2024-07-28 16:03:37 +00:00
(mapc #'(lambda (group)
(when (equal group-name (car (car (cdr (cdr group)))))
(throw 'done (switch-to-buffer (car (cdr group))))))
tab-buffer-list) )))
(defun centaur-tabs-select-end-tab ()
"Select end tab of current tabset."
(interactive)
(centaur-tabs-select-beg-tab t))
(defun centaur-tabs-select-beg-tab (&optional backward)
"Select beginning tab of current tabs.
If BACKWARD is non-nil, move backward, otherwise move forward.
TYPE is default option."
(interactive)
(let* ((tabset (centaur-tabs-current-tabset t))
2024-07-28 16:03:37 +00:00
(ttabset (centaur-tabs-get-tabsets-tabset))
(_cycle (if (and (eq centaur-tabs-cycle-scope 'groups)
(not (cdr (centaur-tabs-tabs ttabset))))
'tabs
centaur-tabs-cycle-scope))
_selected tab)
(when tabset
(setq tabset (centaur-tabs-tabs tabset)
2024-07-28 16:03:37 +00:00
tab (car (if backward (last tabset) tabset)))
(centaur-tabs-buffer-select-tab tab))))
(defun centaur-tabs-backward-tab-other-window (&optional reversed)
"Move to left tab in other window.
2024-07-28 16:03:37 +00:00
Optional argument REVERSED default is move backward, if reversed is non-nil
move forward."
(interactive)
(other-window 1)
(if reversed
(centaur-tabs-forward-tab)
(centaur-tabs-backward-tab))
(other-window -1))
(defun centaur-tabs-forward-tab-other-window ()
"Move to right tab in other window."
(interactive)
(centaur-tabs-backward-tab-other-window t))
(defun centaur-tabs-move-current-tab-to-right ()
"Move current tab one place right, unless it's already the rightmost."
(interactive)
(let* ((bufset (centaur-tabs-current-tabset t))
2024-07-28 16:03:37 +00:00
(old-bufs (centaur-tabs-tabs bufset))
(new-bufs (list))
the-buffer)
(while (and
2024-07-28 16:03:37 +00:00
old-bufs
(not (string= (buffer-name) (format "%s" (car (car old-bufs))))))
(push (car old-bufs) new-bufs)
(setq old-bufs (cdr old-bufs)))
(if old-bufs ; if this is false, then the current tab's buffer name is mysteriously missing
2024-07-28 16:03:37 +00:00
(progn
(setq the-buffer (car old-bufs))
(setq old-bufs (cdr old-bufs))
(if old-bufs ; if this is false, then the current tab is the rightmost
(push (car old-bufs) new-bufs))
(push the-buffer new-bufs)) ; this is the tab that was to be moved
(error "Error: current buffer's name was not found in Centaur-Tabs's buffer list"))
(setq new-bufs (reverse new-bufs))
(setq new-bufs (append new-bufs (cdr old-bufs)))
(set bufset new-bufs)
(centaur-tabs-set-template bufset nil)
(centaur-tabs-display-update)))
(defun centaur-tabs-move-current-tab-to-left ()
"Move current tab one place left, unless it's already the leftmost."
(interactive)
(let* ((bufset (centaur-tabs-current-tabset t))
2024-07-28 16:03:37 +00:00
(old-bufs (centaur-tabs-tabs bufset))
(first-buf (car old-bufs))
(new-bufs (list))
not-yet-this-buf)
(if (string= (buffer-name) (format "%s" (car first-buf)))
2024-07-28 16:03:37 +00:00
old-bufs ; the current tab is the leftmost
(setq not-yet-this-buf first-buf)
(setq old-bufs (cdr old-bufs))
(while (and
2024-07-28 16:03:37 +00:00
old-bufs
(not (string= (buffer-name) (format "%s" (car (car old-bufs))))))
(push not-yet-this-buf new-bufs)
(setq not-yet-this-buf (car old-bufs))
(setq old-bufs (cdr old-bufs)))
(if old-bufs ; if this is false, then the current tab's buffer name is mysteriously missing
2024-07-28 16:03:37 +00:00
(progn
(push (car old-bufs) new-bufs) ; this is the tab that was to be moved
(push not-yet-this-buf new-bufs)
(setq new-bufs (reverse new-bufs))
(setq new-bufs (append new-bufs (cdr old-bufs))))
(error "Error: current buffer's name was not found in Centaur-Tabs's buffer list"))
(set bufset new-bufs)
(centaur-tabs-set-template bufset nil)
(centaur-tabs-display-update))))
(defmacro centaur-tabs-kill-buffer-match-rule (match-rule)
"If buffer match MATCH-RULE, kill it."
`(save-excursion
(mapc #'(lambda (buffer)
2024-07-28 16:03:37 +00:00
(with-current-buffer buffer
(when (string-equal current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
(when (funcall ,match-rule buffer)
(kill-buffer buffer)))))
(buffer-list))))
(defun centaur-tabs-kill-all-buffers-in-current-group ()
"Kill all buffers in current group."
(interactive)
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t)))))
;; Kill all buffers in current group.
(centaur-tabs-kill-buffer-match-rule
(lambda (_buffer) t))
;; Switch to next group.
2024-07-28 16:03:37 +00:00
(centaur-tabs-forward-group)))
(defun centaur-tabs-kill-other-buffers-in-current-group ()
"Kill all buffers except current buffer in current group."
(interactive)
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
2024-07-28 16:03:37 +00:00
(currentbuffer (current-buffer)))
;; Kill all buffers in current group.
(centaur-tabs-kill-buffer-match-rule
2024-07-28 16:03:37 +00:00
(lambda (buffer) (not (equal buffer currentbuffer))))))
(defun centaur-tabs-kill-unmodified-buffers-in-current-group ()
"Kill all unmodified buffer in current group."
(interactive)
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
2024-07-28 16:03:37 +00:00
(currentbuffer (current-buffer)))
;; Kill all buffers in current group.
(centaur-tabs-kill-buffer-match-rule
2024-07-28 16:03:37 +00:00
(lambda (buffer) (not (buffer-modified-p buffer))))))
(defun centaur-tabs-kill-match-buffers-in-current-group ()
"Kill all buffers match extension in current group."
(interactive)
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
2024-07-28 16:03:37 +00:00
(extension-names (centaur-tabs-get-extensions))
match-extension)
;; Read extension need to kill.
(setq match-extension (centaur-tabs-completing-read "Kill buffers suffix with: " extension-names))
;; Kill all buffers match extension in current group.
(centaur-tabs-kill-buffer-match-rule
(lambda (buffer)
(let ((filename (buffer-file-name buffer)))
2024-07-28 16:03:37 +00:00
(and filename (string-equal (file-name-extension filename) match-extension)))))
;; Switch to next group if last file killed.
(when (equal (length extension-names) 1)
2024-07-28 16:03:37 +00:00
(centaur-tabs-forward-group))))
(defun centaur-tabs-keep-match-buffers-in-current-group ()
"Keep all buffers match extension in current group."
(interactive)
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
2024-07-28 16:03:37 +00:00
(extension-names (centaur-tabs-get-extensions))
match-extension)
;; Read extension need to kill.
(setq match-extension (centaur-tabs-completing-read "Just keep buffers suffix with: " extension-names))
;; Kill all buffers match extension in current group.
(centaur-tabs-kill-buffer-match-rule
(lambda (buffer)
(let ((filename (buffer-file-name buffer)))
2024-07-28 16:03:37 +00:00
(and filename (not (string-equal (file-name-extension filename) match-extension))))))
;; Switch to next group if last file killed.
(when (equal (length extension-names) 1)
2024-07-28 16:03:37 +00:00
(centaur-tabs-forward-group))))
(defun centaur-tabs-select-visible-nth-tab (tab-index)
"Select visible tab with TAB-INDEX'.
Example, when `tab-index' is 1, this function will select the leftmost label in
the visible area, instead of the first label in the current group.
If `tab-index' more than length of visible tabs, selet the last tab.
If `tab-index' is 0, select last tab."
(let ((visible-tabs (centaur-tabs-view centaur-tabs-current-tabset)))
(switch-to-buffer
(car
(if (or (equal tab-index 0)
2024-07-28 16:03:37 +00:00
(> tab-index (length visible-tabs)))
(car (last visible-tabs))
(nth (- tab-index 1) visible-tabs))))))
(defun centaur-tabs-select-visible-tab ()
"Bind this function with number keystroke, such as s-1, s-2, s-3 ... etc.
This function automatically recognizes the number at the end of the keystroke
and switches to the tab of the corresponding index.
Note that this function switches to the visible range,
not the actual logical index position of the current group."
(interactive)
(let* ((event last-command-event)
2024-07-28 16:03:37 +00:00
(key (make-vector 1 event))
(key-desc (key-description key)))
(centaur-tabs-select-visible-nth-tab
(string-to-number (car (last (split-string key-desc "-")))))))
;; ace-jump style tab switching
(defvar centaur-tabs-ace-jump-active nil
2024-07-28 16:03:37 +00:00
"Set to t if `centaur-tabs-ace-jump' is invoked.")
(defvar centaur-tabs-dim-overlay nil
"Holds the overlay for dimming buffer when invoking centaur-tabs-ace-jump.")
(defun centaur-tabs--dim-window ()
"Create a dim background overlay for the current window."
(when centaur-tabs-ace-jump-dim-buffer
(when centaur-tabs-dim-overlay
(delete-overlay centaur-tabs-dim-overlay))
(setq centaur-tabs-dim-overlay
2024-07-28 16:03:37 +00:00
(let ((ol (make-overlay (window-start) (window-end))))
(overlay-put ol 'face 'centaur-tabs-dim-buffer-face)
ol))))
(defun centaur-tabs-swap-tab (tab)
"Swap the position of current tab with TAB.
TAB has to be in the same group as the current tab."
(if (eq (centaur-tabs-tab-tabset tab) (centaur-tabs-current-tabset t))
(let* ((group (centaur-tabs-current-tabset t))
2024-07-28 16:03:37 +00:00
(tabs (cl-copy-list (centaur-tabs-tabs group)))
(current (centaur-tabs-selected-tab group))
(current-index (cl-position current tabs))
(target-index (cl-position tab tabs)))
(if (eq tab current)
(message "Can't swap with current tab itself.")
(setcar (nthcdr current-index tabs) tab)
(setcar (nthcdr target-index tabs) current)
(set group tabs)
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
(centaur-tabs-display-update)))
(message "Error: %s is not in the same group as the current tab." tab)))
(defun centaur-tabs-ace-action (action)
2024-07-28 16:03:37 +00:00
"Preform ACTION on a visible tab. Ace-jump style.
ACTION has to be one of value in `centaur-tabs-ace-dispatch-alist'"
(when (centaur-tabs-current-tabset t)
(when centaur-tabs-ace-jump-dim-buffer
(centaur-tabs--dim-window))
(cond ((eq action 'jump-to-tab)
2024-07-28 16:03:37 +00:00
(message "Jump to tab: "))
((eq action 'close-tab)
(message "Close tab: "))
((eq action 'swap-tab)
(message "Swap current tab with: ")))
(let ((centaur-tabs-ace-jump-active t))
(catch 'done
2024-07-28 16:03:37 +00:00
(while t
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
(centaur-tabs-display-update)
(let ((char (read-key)) (action-cache))
(cond
;; tab keys
((memq char centaur-tabs-ace-jump-keys)
(let ((sel (nth (cl-position char centaur-tabs-ace-jump-keys) (centaur-tabs-view (centaur-tabs-current-tabset t)))))
(cond ((eq sel nil)
(message "Tab %s does not exist" (key-description (vector char))))
((eq action 'jump-to-tab)
(centaur-tabs-buffer-select-tab sel))
((eq action 'close-tab)
(centaur-tabs-buffer-close-tab sel))
((eq action 'swap-tab)
(centaur-tabs-swap-tab sel))))
(throw 'done nil))
;; actions
((setq action-cache (assoc char centaur-tabs-ace-dispatch-alist))
(setq action-cache (cadr action-cache))
(cond ((eq action-cache 'exit) ; exit
(message "Quit")
(throw 'done nil))
((eq action-cache 'forward-group) ; forward group
(message "Forward group")
(centaur-tabs-forward-group)
(centaur-tabs--dim-window))
((eq action-cache 'backward-group) ; backward group
(message "Backward group")
(centaur-tabs-backward-group)
(centaur-tabs--dim-window))
((eq action-cache 'show-help) ; help menu
(message "%s" (mapconcat
(lambda (elem) (format "%s: %s"
(key-description (vector (car elem)))
(caddr elem)))
centaur-tabs-ace-dispatch-alist
"\n")))
(t (setq action action-cache) ; other actions
(cond ((eq action-cache 'jump-to-tab)
(message "Jump to tab: "))
((eq action-cache 'close-tab)
(message "Close tab: "))
((eq action-cache 'swap-tab)
(message "Swap current tab with: "))))))
;; no match, repeat
(t
(message "No such candidate: %s, hit ? for help." (key-description (vector char)))))))))
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
(when centaur-tabs-ace-jump-dim-buffer
(delete-overlay centaur-tabs-dim-overlay)
(setq centaur-tabs-dim-overlay nil))
(centaur-tabs-display-update)))
(defun centaur-tabs-ace-jump (&optional arg)
2024-07-28 16:03:37 +00:00
"Select a tab and perform an action. Ace-jump style.
If no ARG is provided, select that tab. If prefixed with one
`universal-argument', swap the current tab with the selected tab.
If prefixed with two `universal-argument's, close selected tab."
(interactive "p")
(cond ((eq arg 1)
2024-07-28 16:03:37 +00:00
(centaur-tabs-ace-action 'jump-to-tab))
((eq arg 4)
(centaur-tabs-ace-action 'swap-tab))
((eq arg 16)
(centaur-tabs-ace-action 'close-tab))
(t
(centaur-tabs-ace-action 'jump-to-tab))))
(defun centaur-tabs-group-buffer-groups ()
"Use centaur-tabs's own buffer grouping function."
(interactive)
(setq centaur-tabs-buffer-groups-function 'centaur-tabs-buffer-groups)
(centaur-tabs-display-update))
;; Projectile integration. Taken from tabbar-ruler
(defvar centaur-tabs-projectile-buffer-group-calc nil
"Set buffer groups for projectile.
Should be buffer local and speed up calculation of buffer groups.")
(defun centaur-tabs-projectile-buffer-groups ()
"Return the list of group names BUFFER belongs to."
(if centaur-tabs-projectile-buffer-group-calc
(symbol-value 'centaur-tabs-projectile-buffer-group-calc)
(set (make-local-variable 'centaur-tabs-projectile-buffer-group-calc)
2024-07-28 16:03:37 +00:00
(cond
((or (get-buffer-process (current-buffer)) (memq major-mode '(comint-mode compilation-mode))) '("Term"))
((string-equal "*" (substring (buffer-name) 0 1)) '("Misc"))
((condition-case _err
(projectile-project-root)
(error nil))
(list (projectile-project-name)))
((memq major-mode '(emacs-lisp-mode python-mode emacs-lisp-mode c-mode
c++-mode javascript-mode js-mode
js2-mode makefile-mode
lua-mode vala-mode))
'("Coding"))
((memq major-mode '( nxhtml-mode html-mode
mhtml-mode css-mode))
'("HTML"))
((memq major-mode '(org-mode calendar-mode diary-mode)) '("Org"))
((memq major-mode '(dired-mode)) '("Dir"))
(t '("Other"))))
(symbol-value 'centaur-tabs-projectile-buffer-group-calc)))
(defun centaur-tabs-group-by-projectile-project()
"Group by projectile project."
(interactive)
(setq centaur-tabs-buffer-groups-function 'centaur-tabs-projectile-buffer-groups)
(centaur-tabs-display-update))
;; Show groups instead of tabs
(defun centaur-tabs-toggle-groups ()
"Show group names on the tabs instead of buffer names."
(interactive)
(centaur-tabs-buffer-show-groups (not centaur-tabs--buffer-show-groups))
(centaur-tabs-display-update))
;; Helm source for switching group in helm.
(defun centaur-tabs-build-helm-source ()
"Display a list of current buffer groups in Helm."
(interactive)
(setq helm-source-centaur-tabs-group
2024-07-28 16:03:37 +00:00
(when (featurep 'helm)
(require 'helm)
(helm-build-sync-source "Centaur-Tabs Group"
:candidates #'centaur-tabs-get-groups
:action '(("Switch to group" . centaur-tabs-switch-group))))))
;; Ivy source for switching group in ivy.
;;;###autoload
(defun centaur-tabs-counsel-switch-group ()
"Display a list of current buffer groups using Counsel."
(interactive)
(when (featurep 'ivy)
(require 'ivy)
(ivy-read
"Centaur Tabs Groups:"
(centaur-tabs-get-groups)
:action #'centaur-tabs-switch-group
:caller 'centaur-tabs-counsel-switch-group)))
(defun centaur-tabs-extract-window-to-new-frame()
2024-07-28 16:03:37 +00:00
"Kill the current window in the current frame, and open the current buffer
in a new frame."
(interactive)
(unless (centaur-tabs--one-window-p)
(let ((buffer (current-buffer)))
(delete-window)
(display-buffer-pop-up-frame buffer nil))))
(defun centaur-tabs--copy-file-name-to-clipboard ()
"Copy the current buffer file name to the clipboard."
;;; From https://emacsredux.com/blog/2013/03/27/copy-filename-to-the-clipboard/
(interactive)
(let* ((filename (if (equal major-mode 'dired-mode)
default-directory
(buffer-file-name)))
2024-07-28 16:03:37 +00:00
(filename (expand-file-name filename)))
(when filename
(kill-new filename)
(message "Copied buffer file name '%s' to the kill ring." filename))))
(defun centaur-tabs-open-directory-in-external-application ()
"Open the current directory in a external application."
(interactive)
(centaur-tabs--open-externally default-directory))
(defun centaur-tabs-open-in-external-application ()
"Open the file of the current buffer according to its mime type."
(interactive)
2024-07-28 16:03:37 +00:00
(let ((path (or (buffer-file-name) default-directory)))
(centaur-tabs--open-externally path)))
(defun centaur-tabs--open-externally (file-or-path)
"Open FILE-OR-PATH according to its mime type in an external application.
FILE-OR-PATH is expanded with `expand-file-name`.
Modified copy of `treemacs-visit-node-in-external-application`."
(let ((path (expand-file-name file-or-path)))
(pcase system-type
('windows-nt
(declare-function w32-shell-execute "w32fns.c")
(w32-shell-execute "open" (replace-regexp-in-string "/" "\\" path t t)))
('darwin
(shell-command (format "open \"%s\"" path)))
('gnu/linux
(let ((process-connection-type nil))
2024-07-28 16:03:37 +00:00
(start-process "" nil "xdg-open" path)))
(_ (message "Don't know how to open files on %s." (symbol-name system-type))))))
(defun centaur-tabs--copy-directory-name-to-clipboard ()
"Copy the current directory name to the clipboard."
(interactive)
(when default-directory
(kill-new default-directory)
(message "Copied directory name '%s' to the kill ring." (expand-file-name default-directory))))
(defun centaur-tabs--tab-submenu-groups-definition ()
"Menu definition with a list of tab groups."
(mapcar (lambda (s) `[,s ,s]) (sort (centaur-tabs-get-groups) #'string<)))
(defun centaur-tabs--tab-submenu-tabs-definition ()
"Menu definition with a list of tabs for the current group."
(let* ((tabset (centaur-tabs-get-tabset centaur-tabs-last-focused-buffer-group))
2024-07-28 16:03:37 +00:00
(tabs-in-group (centaur-tabs-tabs tabset))
(buffers (mapcar #'centaur-tabs-tab-value tabs-in-group))
2024-07-28 16:03:37 +00:00
(sorted-tabnames (sort (mapcar #'buffer-name buffers) #'string<)))
(mapcar (lambda (s) `[,s ,s]) sorted-tabnames)))
(defvar centaur-tabs--groups-submenu-key "Tab groups")
(defvar centaur-tabs--tabs-submenu-key "Go to tab of group")
(defun centaur-tabs--kill-this-buffer-dont-ask()
"Kill the current buffer without confirmation."
(interactive)
(kill-buffer (current-buffer))
(centaur-tabs-display-update)
(redisplay t))
(defun centaur-tabs--tab-menu-definition ()
"Definition of the context menu of a tab."
`(["Kill this buffer" centaur-tabs--kill-this-buffer-dont-ask]
["Kill other buffers of group" centaur-tabs-kill-other-buffers-in-current-group]
["Kill unmodified buffers of group" centaur-tabs-kill-unmodified-buffers-in-current-group]
"----"
["Split below" split-window-below]
["Split right" split-window-right]
"----"
["Maximize tab" delete-other-windows
:active (null (centaur-tabs--one-window-p))]
["Extract to new frame" centaur-tabs-extract-window-to-new-frame
:active (null (centaur-tabs--one-window-p))]
["Duplicate in new frame" make-frame-command]
"----"
["Copy filepath" centaur-tabs--copy-file-name-to-clipboard
:active (buffer-file-name)]
["Copy directory path" centaur-tabs--copy-directory-name-to-clipboard
:active default-directory]
["Open in external application" centaur-tabs-open-in-external-application
:active (or (buffer-file-name) default-directory)]
["Open directory in dired" dired-jump
:active (not (eq major-mode 'dired-mode))]
["Open directory externally" centaur-tabs-open-directory-in-external-application
:active default-directory]
"----"
,( append (list centaur-tabs--groups-submenu-key) (centaur-tabs--tab-submenu-groups-definition))
2024-07-28 16:03:37 +00:00
,( append (list centaur-tabs--tabs-submenu-key) (centaur-tabs--tab-submenu-tabs-definition))))
(defun centaur-tabs--one-window-p ()
"Like `one-window-p`, but taking into account side windows like treemacs."
(let* ((mainwindow (window-main-window))
2024-07-28 16:03:37 +00:00
(child-count (window-child-count mainwindow)))
(= 0 child-count)))
(defun centaur-tabs--get-tab-from-name (tabname)
"Get the tab from the current group given de TABNAME."
(let ((seq (centaur-tabs-tabs (centaur-tabs-get-tabset centaur-tabs-last-focused-buffer-group))))
(cl-find-if
(lambda (tab) (string= tabname (buffer-name (centaur-tabs-tab-value tab))))
seq)))
(defun centaur-tabs--tab-menu (event)
2024-07-28 16:03:37 +00:00
"Show a context menu for the clicked tab or button.
The clicked tab, identified by EVENT, is selected."
(interactive "e" )
(let ((click-on-tab-p (ignore-errors (centaur-tabs-get-tab-from-event event))))
(when (not click-on-tab-p)
(centaur-tabs--groups-menu))
(when click-on-tab-p
(centaur-tabs-do-select event)
(redisplay t)
(let*
2024-07-28 16:03:37 +00:00
((menu (easy-menu-create-menu nil (centaur-tabs--tab-menu-definition)))
(choice (x-popup-menu t menu))
(action (lookup-key menu (apply 'vector choice)))
(action-is-command-p (and (commandp action) (functionp action))))
(when action-is-command-p
(call-interactively action))
(when (not action-is-command-p)
(let* ((menu-key (cl-first choice))
(choice-is-group-p (string= centaur-tabs--groups-submenu-key (symbol-name menu-key)))
(name (car (last choice)))
(name-as-string (symbol-name name)))
(if choice-is-group-p
(centaur-tabs-switch-group name-as-string)
(switch-to-buffer name-as-string))))))))
(defun centaur-tabs--groups-menu ()
"Show a popup menu with the centaur tabs groups."
(interactive)
2024-07-28 16:03:37 +00:00
(let* ((sorted-groups (centaur-tabs--tab-submenu-groups-definition))
(menu (easy-menu-create-menu "Tab groups"
(centaur-tabs--tab-submenu-groups-definition)))
(choice (x-popup-menu t menu))
(action (lookup-key menu (apply 'vector choice)))
(action-is-command-p (and (commandp action) (functionp action))))
(when action-is-command-p
(call-interactively action))
(when (not action-is-command-p)
(let ((group (car (last choice))))
2024-07-28 16:03:37 +00:00
(centaur-tabs-switch-group (format "%s" group))))))
(provide 'centaur-tabs-interactive)
;;; centaur-tabs-interactive.el ends here