tab-line.el 9.71 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
;;; tab-line.el --- window-local tab line with window buffers -*- lexical-binding: t; -*-

;; Copyright (C) 2019 Free Software Foundation, Inc.

;; Author: Juri Linkov <juri@linkov.net>
;; Keywords: windows tabs
;; Maintainer: emacs-devel@gnu.org

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; To enable this mode, run `M-x global-tab-line-mode'.

;;; Code:

(require 'seq) ; tab-line.el is not pre-loaded so it's safe to use it here


(defgroup tab-line nil
  "Window-local tab line."
  :group 'convenience
  :version "27.1")

(defgroup tab-line-faces nil
  "Faces used in the tab line."
  :group 'tab-line
  :group 'faces
  :version "27.1")

(defface tab-line
45 46 47 48 49 50 51
  '((((type x w32 ns) (class color))
     :background "grey85"
     :foreground "black")
    (((type x) (class mono))
     :background "grey")
    (t
     :inverse-video t))
52 53 54 55 56 57
  "Tab line face."
  :version "27.1"
  :group 'tab-line-faces)

(defface tab-line-tab
  '((((class color) (min-colors 88))
58 59
     :box (:line-width 1 :style released-button)
     :background "grey85")
60
    (t
61
     :inverse-video nil))
62 63 64 65 66 67
  "Tab line face for selected tab."
  :version "27.1"
  :group 'tab-line-faces)

(defface tab-line-tab-inactive
  '((default
68 69 70 71 72
      :inherit tab-line-tab)
    (((class color) (min-colors 88))
     :background "grey75")
    (t
     :inverse-video t))
73 74 75 76
  "Tab line face for non-selected tabs."
  :version "27.1"
  :group 'tab-line-faces)

77 78 79 80 81 82 83 84 85 86 87 88 89
(defface tab-line-highlight
  '((default :inherit tab-line-tab))
  "Tab line face for highlighting."
  :version "27.1"
  :group 'tab-line-faces)

(defface tab-line-close-highlight
  '((t :foreground "red"))
  "Tab line face for highlighting."
  :version "27.1"
  :group 'tab-line-faces)


90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
(defvar tab-line-tab-map
  (let ((map (make-sparse-keymap)))
    (define-key map [tab-line mouse-1] 'tab-line-select-tab)
    (define-key map [tab-line mouse-2] 'tab-line-select-tab)
    (define-key map [tab-line mouse-4] 'tab-line-switch-to-prev-tab)
    (define-key map [tab-line mouse-5] 'tab-line-switch-to-next-tab)
    (define-key map "\C-m" 'tab-line-select-tab)
    (define-key map [follow-link] 'mouse-face)
    map)
  "Local keymap for `tab-line-mode' window tabs.")

(defvar tab-line-add-map
  (let ((map (make-sparse-keymap)))
    (define-key map [tab-line mouse-1] 'tab-line-add-tab)
    (define-key map [tab-line mouse-2] 'tab-line-add-tab)
    (define-key map "\C-m" 'tab-line-add-tab)
    (define-key map [follow-link] 'mouse-face)
    map)
  "Local keymap to add `tab-line-mode' window tabs.")

(defvar tab-line-tab-close-map
  (let ((map (make-sparse-keymap)))
    (define-key map [tab-line mouse-1] 'tab-line-close-tab)
    (define-key map [tab-line mouse-2] 'tab-line-close-tab)
    (define-key map [follow-link] 'mouse-face)
    map)
  "Local keymap to close `tab-line-mode' window tabs.")

118

119
(defvar tab-line-separator " ")
120

121 122
(defvar tab-line-tab-name-ellipsis
  (if (char-displayable-p ?) "…" "..."))
123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148

(defvar tab-line-button-new
  (propertize " + "
              'display `(image :type xpm
                               :file ,(expand-file-name
                                       "images/tabs/new.xpm"
                                       data-directory)
                               :margin (2 . 0)
                               :ascent center)
              'keymap tab-line-add-map
              'mouse-face 'tab-line-highlight
              'help-echo "Click to add tab")
  "Button for creating a new tab.")

(defvar tab-line-button-close
  (propertize "x"
              'display `(image :type xpm
                               :file ,(expand-file-name
                                       "images/tabs/close.xpm"
                                       data-directory)
                               :margin (2 . 0)
                               :ascent center)
              'keymap tab-line-tab-close-map
              'mouse-face 'tab-line-close-highlight
              'help-echo "Click to close tab")
  "Button for closing the clicked tab.")
149 150 151 152 153 154 155 156 157 158


(defun tab-line-tab-name (buffer &optional buffers)
  "Generate tab name from BUFFER.
Reduce tab width proportionally to space taken by other tabs."
  (let ((tab-name (buffer-name buffer))
        (limit (when buffers
                 (max 1 (- (/ (window-width) (length buffers)) 3)))))
    (if (or (not limit) (< (length tab-name) limit))
        tab-name
159 160
      (propertize (truncate-string-to-width tab-name limit nil nil
                                            tab-line-tab-name-ellipsis)
161
                  'help-echo tab-name))))
162

163 164 165 166 167
(defvar tab-line-tabs-limit 15
  "Maximum number of buffer tabs displayed in the window tab-line.")

(defun tab-line-tabs (&optional window)
  (let* ((buffer (window-buffer window))
168 169
         (next-buffers (seq-remove (lambda (b) (eq b buffer))
                                   (window-next-buffers window)))
170
         (next-buffers (seq-filter #'buffer-live-p next-buffers))
171 172
         (prev-buffers (seq-remove (lambda (b) (eq b buffer))
                                   (mapcar #'car (window-prev-buffers window))))
173
         (prev-buffers (seq-filter #'buffer-live-p prev-buffers))
174 175
         ;; Remove next-buffers from prev-buffers
         (prev-buffers (seq-difference prev-buffers next-buffers))
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195
         (half-limit (/ tab-line-tabs-limit 2))
         (prev-buffers-limit
          (if (> (length prev-buffers) half-limit)
              (if (> (length next-buffers) half-limit)
                  half-limit
                (+ half-limit (- half-limit (length next-buffers))))
            (length prev-buffers)))
         (next-buffers-limit
          (- tab-line-tabs-limit prev-buffers-limit))
         (buffer-tabs
          (append (reverse (seq-take prev-buffers prev-buffers-limit))
                  (list buffer)
                  (seq-take next-buffers next-buffers-limit))))
    buffer-tabs))

(defun tab-line-format ()
  "Template for displaying tab line for selected window."
  (let* ((window (selected-window))
         (buffer (window-buffer window))
         (buffer-tabs (tab-line-tabs window)))
196 197 198
    (append
     (mapcar
      (lambda (b)
199 200 201 202 203 204 205 206 207 208 209 210
        (concat
         (or tab-line-separator "")
         (apply 'propertize (concat (propertize
                                     (tab-line-tab-name b buffer-tabs)
                                     'keymap tab-line-tab-map)
                                    tab-line-button-close)
                `(
                  buffer ,b
                  face ,(if (eq b buffer)
                            'tab-line-tab
                          'tab-line-tab-inactive)
                  mouse-face tab-line-highlight))))
211
      buffer-tabs)
212
     (list (concat tab-line-separator tab-line-button-new)))))
213 214 215 216


(defun tab-line-add-tab (&optional e)
  (interactive "e")
217
  (if window-system ; (display-popup-menus-p)
Juri Linkov's avatar
Juri Linkov committed
218 219 220
      (mouse-buffer-menu e) ; like (buffer-menu-open)
    ;; tty menu doesn't support mouse clicks, so use tmm
    (tmm-prompt (mouse-buffer-menu-keymap))))
221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278

(defun tab-line-select-tab (&optional e)
  "Switch to the selected tab.
This command maintains the original order of prev/next buffers.
So for example, switching to a previous tab is equivalent to
using the `previous-buffer' command."
  (interactive "e")
  (let* ((posnp (event-start e))
         (window (posn-window posnp))
         (buffer (get-pos-property 1 'buffer (car (posn-string posnp))))
         (window-buffer (window-buffer window))
         (next-buffers (seq-remove (lambda (b) (eq b window-buffer))
                                   (window-next-buffers window)))
         (prev-buffers (seq-remove (lambda (b) (eq b window-buffer))
                                   (mapcar #'car (window-prev-buffers window))))
         ;; Remove next-buffers from prev-buffers
         (prev-buffers (seq-difference prev-buffers next-buffers)))
    (cond
     ((memq buffer next-buffers)
      (dotimes (_ (1+ (seq-position next-buffers buffer)))
        (switch-to-next-buffer window)))
     ((memq buffer prev-buffers)
      (dotimes (_ (1+ (seq-position prev-buffers buffer)))
        (switch-to-prev-buffer window)))
     (t
      (switch-to-buffer buffer)))))

(defun tab-line-switch-to-prev-tab (&optional e)
  "Switch to the previous tab."
  (interactive "e")
  (switch-to-prev-buffer (posn-window (event-start e))))

(defun tab-line-switch-to-next-tab (&optional e)
  "Switch to the next tab."
  (interactive "e")
  (switch-to-next-buffer (posn-window (event-start e))))

(defun tab-line-close-tab (&optional e)
  "Close the selected tab."
  (interactive "e")
  (let* ((posnp (event-start e))
         (window (posn-window posnp))
         (buffer (get-pos-property 1 'buffer (car (posn-string posnp)))))
    (with-selected-window window
      (if (eq buffer (current-buffer))
          (bury-buffer)
        (set-window-prev-buffers nil (assq-delete-all buffer (window-prev-buffers)))
        (set-window-next-buffers nil (delq buffer (window-next-buffers))))
      (force-mode-line-update))))


;;;###autoload
(define-minor-mode global-tab-line-mode
  "Display window-local tab line."
  :group 'tab-line
  :type 'boolean
  :global t
  :init-value nil
279 280
  (setq-default tab-line-format (when global-tab-line-mode
                                  '(:eval (tab-line-format)))))
281 282 283 284


(provide 'tab-line)
;;; tab-line.el ends here