628 lines
24 KiB
EmacsLisp
628 lines
24 KiB
EmacsLisp
|
;;; centaur-tabs-interactive.el --- centaur-tabs interactive functions and plugins support lexical-binding: t; -*-
|
||
|
|
|
||
|
|
;; Copyright (C) 2019-2020 Emmanuel Bustos
|
||
|
|
|
||
|
|
;; 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.
|
||
|
|
;;
|
||
|
|
;;; Commentary:
|
||
|
|
;; This file contains centaur-tabs interactive functions and plugins support
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
;;; Requires
|
||
|
|
(require 'centaur-tabs-elements)
|
||
|
|
(require 'centaur-tabs-functions)
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;; Interactive functions ;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
(defun centaur-tabs-switch-group (&optional groupname)
|
||
|
|
"Switch tab groups using ido. GROUPNAME can optionaly be provided."
|
||
|
|
(interactive)
|
||
|
|
(let* ((tab-buffer-list (cl-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
|
||
|
|
(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))
|
||
|
|
(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)
|
||
|
|
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.
|
||
|
|
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))
|
||
|
|
(old-bufs (centaur-tabs-tabs bufset))
|
||
|
|
(new-bufs (list))
|
||
|
|
the-buffer)
|
||
|
|
(while (and
|
||
|
|
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
|
||
|
|
(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))
|
||
|
|
(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)))
|
||
|
|
old-bufs ; the current tab is the leftmost
|
||
|
|
(setq not-yet-this-buf first-buf)
|
||
|
|
(setq old-bufs (cdr old-bufs))
|
||
|
|
(while (and
|
||
|
|
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
|
||
|
|
(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)
|
||
|
|
(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.
|
||
|
|
(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))))
|
||
|
|
(currentbuffer (current-buffer)))
|
||
|
|
;; Kill all buffers in current group.
|
||
|
|
(centaur-tabs-kill-buffer-match-rule
|
||
|
|
(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))))
|
||
|
|
(currentbuffer (current-buffer)))
|
||
|
|
;; Kill all buffers in current group.
|
||
|
|
(centaur-tabs-kill-buffer-match-rule
|
||
|
|
(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))))
|
||
|
|
(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)))
|
||
|
|
(and filename (string-equal (file-name-extension filename) match-extension))
|
||
|
|
)))
|
||
|
|
;; Switch to next group if last file killed.
|
||
|
|
(when (equal (length extension-names) 1)
|
||
|
|
(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))))
|
||
|
|
(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)))
|
||
|
|
(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)
|
||
|
|
(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)
|
||
|
|
(> 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)
|
||
|
|
(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
|
||
|
|
"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
|
||
|
|
(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))
|
||
|
|
(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)
|
||
|
|
"Preform ACTION on a visible tab. Ace-jump style.
|
||
|
|
ACTION has to be one of value in `centuar-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)
|
||
|
|
(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
|
||
|
|
(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 centuar-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)))
|
||
|
|
centuar-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)
|
||
|
|
"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)
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(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
|
||
|
|
(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()
|
||
|
|
"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)))
|
||
|
|
(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)
|
||
|
|
(let ((path (if (buffer-file-name) (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))
|
||
|
|
(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))
|
||
|
|
(tabs-in-group (centaur-tabs-tabs tabset))
|
||
|
|
(buffers (mapcar #'centaur-tabs-tab-value tabs-in-group))
|
||
|
|
(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))
|
||
|
|
,( 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))
|
||
|
|
(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)
|
||
|
|
"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*
|
||
|
|
((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 (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)
|
||
|
|
|
||
|
|
(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))))
|
||
|
|
(centaur-tabs-switch-group (format "%s" group))))))
|
||
|
|
|
||
|
|
|
||
|
|
(provide 'centaur-tabs-interactive)
|
||
|
|
|
||
|
|
;;; centaur-tabs-interactive.el ends here
|