[elpa] master 6d67ebe: * frame-tabs: New package

[Stefan Monnier]

branch: master
commit 6d67ebe7f958426d34019cd3a901ff4654a357d7
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * frame-tabs: New package
---
 packages/frame-tabs/frame-tabs.el | 512 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 512 insertions(+)

diff --git a/packages/frame-tabs/frame-tabs.el 
b/packages/frame-tabs/frame-tabs.el
new file mode 100644
index 0000000..5b3471f
--- /dev/null
+++ b/packages/frame-tabs/frame-tabs.el
@@ -0,0 +1,512 @@
+;;; frame-tabs.el --- show buffer tabs in side window  -*- lexical-binding:t 
-*-
+
+;; Copyright (C) 2013-2018  Free Software Foundation, Inc.
+
+;; Author: Martin Rudalics <address@hidden>
+;; Keywords: frames, tabs
+;; Version: 1.1
+
+;; frame-tabs.el 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, or (at your option)
+;; any later version.
+
+;; frame-tabs.el 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.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Minor mode to display buffer tabs in a side window on each frame.
+
+;; This mode shows, in a side window on each frame, tabs listing the
+;; names of all live buffers that have been displayed on that frame.
+;; Clicking on a tab with the left mouse button switches to the
+;; corresponding buffer in a window.  Clicking on a tab with the right
+;; mouse button dismisses the buffer.  See 'frame-tabs-map'.
+;; Alternatively, tabs can display an additional 'x' button which
+;; permits to dismiss buffers with the left mouse button.  See
+;; 'frame-tabs-x' and 'frame-tabs-x-map'.
+
+;; Caveats: Many desirable features are either underdeveloped or
+;; simply don't work.  Navigating tabs windows with the keyboard has
+;; not been implemented; neither has been displaying alternative items
+;; like tabs representing window configurations.  You're welcome to
+;; expand existing and/or add new features at your like.
+
+;;; Code:
+(defgroup frame-tabs nil
+  "Frame tabs."
+  :version "26.1"
+  :group 'convenience
+  :group 'frames)
+
+;; Customizable faces
+(defface frame-tabs-buffer-tab
+  '((t :inherit variable-pitch
+       :box (:line-width 2 :color "grey72")
+       :foreground "black"
+       :background "grey84"))
+  "Basic frame tabs buffer tab face.
+This face is used for buffer tabs and is inherited by all other
+frame tabs faces."
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defface frame-tabs-selected-tab
+  '((t :inherit frame-tabs-buffer-tab
+       :background "pink"))
+  "Frame tabs face for selected window's buffer tab.
+This is the face used for the tab corresponding to the buffer
+currently shown in the selected window."
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defface frame-tabs-higlight-tab
+  '((t :inherit frame-tabs-buffer-tab
+       :foreground "white"
+       :background "green3"))
+  "Frame tabs face for highlighting buffer tabs.
+This is the face used when the mouse cursor hovers over a buffer
+tab."
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defface frame-tabs-x-tab
+  '((t :inherit frame-tabs-buffer-tab
+       :bold t))
+  "Frame tabs face for 'x' buttons."
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defface frame-tabs-x-higlight-tab
+  '((t :inherit frame-tabs-item-tab
+       :foreground "white"
+       :background "red3"))
+  "Frame tabs face for highlighting 'x' buttons.
+This face is used when the mouse cursor hovers over an 'x'
+button."
+  :version "26.1"
+  :group 'frame-tabs)
+
+;; Options
+(defun frame-tabs--set-value (symbol value)
+  "Helper function for customizing frame tabs."
+  (set-default symbol value)
+  (when frame-tabs-mode
+    (frame-tabs-mode -1))
+  (frame-tabs-mode 1))
+
+(defcustom frame-tabs-side 'top
+  "Side of frame where tabs windows are located.
+Choices are 'top' (the default), 'bottom', 'left' and 'right'."
+  :type '(choice (const top)
+                 (const bottom)
+                 (const left)
+                 (const right))
+  :initialize 'custom-initialize-default
+  :set 'frame-tabs--set-value
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defcustom frame-tabs-x nil
+  "Non-nil means frame tabs show an 'x' button for each buffer tab.
+The 'x' button serves to dismiss the corresponding buffer in
+various ways."
+  :type 'boolean
+  :initialize 'custom-initialize-default
+  :set 'frame-tabs--set-value
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defcustom frame-tabs-min-size 1
+  "Mimimum size of frame tabs windows.
+For tabs windows at the top or bottom of a frame this is their
+minimum number of lines.  For tabs windows at the left or right
+of a frame this is their minimum number of columns.
+
+This value may be overridden when the major side window showing
+the frame tabs window contains other windows."
+  :type 'integer
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defcustom frame-tabs-max-size 6
+  "Maximum size of frame tabs windows.
+For tabs windows at the top or bottom of a frame this is their
+maximum number of lines.  For tabs windows at the left or right
+of a frame this is their maximum number of columns.
+
+This value may be overridden when the major side window showing
+the frame tabs window contains other windows."
+  :type 'integer
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defcustom frame-tabs-delay 0.0
+  "Frame tabs update interval, in seconds.
+This is the time Emacs waits before updating frame tabs windows."
+  :type 'float
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defun frame-tabs-default-filter (buffer _frame)
+  "Default filter function for frame tabs."
+  (let ((name (buffer-name buffer)))
+    (unless (eq (aref name 0) ?\s)
+      name)))
+
+(defcustom frame-tabs-filter-function 'frame-tabs-default-filter
+  "Filter function for frame tabs.
+This is a function that takes two arguments - a buffer and a
+frame.  If this function returns nil, no tab will be shown for
+the buffer in the frame's tab window.  Otherwise, this function
+must return a string and the frame's tabs window will display
+that string as the buffer's tab.
+
+The default excludes buffers whose name starts with a space."
+  :type 'function
+  :version "26.1"
+  :group 'frame-tabs)
+
+(defun frame-tabs-default-buffer-list (frame)
+  "Default frame tabs function for getting a buffer list for FRAME."
+  (buffer-list frame))
+
+(defcustom frame-tabs-buffer-list 'frame-tabs-default-buffer-list
+  "Function for returning a buffer list for frame tabs.
+This is a function that takes one argument - a frame - and
+returns a buffer list for that frame.  The default is to call
+`buffer-list' for that frame which means to return the frame's
+local buffer list.  Customizing this option allows, for example,
+to return the fundamental buffer list or a list of buffer in
+alphabetical order of their names instead."
+  :type 'function
+  :version "26.1"
+  :group 'frame-tabs)
+
+;; Internal variables and functions
+(defvar frame-tabs-timer nil
+  "Frame tabs idle timer.")
+
+(defvar frame-tabs-run nil
+  "Non-nil while frame tabs runs its idle timer function.")
+
+(defvar frame-tabs-buffers nil
+  "List of frame tabs buffers.")
+
+(defvar frame-tabs-map
+  (let ((map (make-sparse-keymap)))
+    ;; Buffer switching commands.
+    (define-key map [down-mouse-1] 'frame-tabs-switch-to-buffer)
+    (define-key map [mouse-1] 'ignore)
+    (define-key map [C-down-mouse-1] 'frame-tabs-switch-to-buffer-other-window)
+    (define-key map [C-mouse-1] 'ignore)
+    (define-key map [M-down-mouse-1] 'frame-tabs-switch-to-buffer-other-frame)
+    (define-key map [M-mouse-1] 'ignore)
+    ;; Buffer dismissal commands.
+    (define-key map [down-mouse-3] 'frame-tabs-bury-buffer)
+    (define-key map [mouse-3] 'ignore)
+    (define-key map [C-down-mouse-3] 'frame-tabs-replace-buffer)
+    (define-key map [C-mouse-3] 'ignore)
+    (define-key map [M-down-mouse-3] 'frame-tabs-kill-buffer)
+    (define-key map [M-mouse-3] 'ignore)
+    map)
+  "Frame tabs keymap.")
+
+(defvar frame-tabs-x-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [down-mouse-1] 'frame-tabs-bury-buffer)
+    (define-key map [mouse-1] 'ignore)
+    (define-key map [C-down-mouse-1] 'frame-tabs-replace-buffer)
+    (define-key map [C-mouse-1] 'ignore)
+    (define-key map [M-down-mouse-1] 'frame-tabs-kill-buffer)
+    (define-key map [M-mouse-1] 'ignore)
+    map)
+  "Frame tabs 'x' keymap.
+This keymap is used when frame tabs show an 'x' button via
+`frame-tabs-x'.")
+
+(defun frame-tabs--window (&optional frame)
+  "Return or create a tabs window for FRAME.
+FRAME must be a live frame and defaults to the selected one."
+  (setq frame (window-normalize-frame frame))
+  (let ((window-resize-pixelwise t)
+       (tabs-vertical (memq frame-tabs-side '(top bottom)))
+       tabs-buffer tabs-window tabs-point tabs-selected)
+    ;; `tabs-buffer' is the buffer showing tabs on FRAME and
+    ;; `tabs-window' is its window.
+    (unless (catch 'found
+             (walk-window-tree
+              (lambda (window)
+                (let ((buffer (window-buffer window)))
+                  (when (memq buffer frame-tabs-buffers)
+                    (setq tabs-buffer buffer)
+                    (setq tabs-window window)
+                    (if (eq tabs-window (selected-window))
+                        (with-current-buffer tabs-buffer
+                          (setq tabs-selected
+                                (get-text-property (point) 'buffer)))
+                      (setq tabs-selected (window-buffer)))
+                    (throw 'found t))))))
+      (setq tabs-buffer (generate-new-buffer " *tabs*"))
+      (setq frame-tabs-buffers (cons tabs-buffer frame-tabs-buffers))
+      ;; Set `tabs-selected' to the truly selected window.
+      (setq tabs-selected (window-buffer))
+      (with-current-buffer tabs-buffer
+       ;; Make a tabs window.
+       (setq tabs-window
+             (display-buffer-in-side-window
+              tabs-buffer `((side . ,frame-tabs-side)
+                            (,(if tabs-vertical 'window-width 'window-height)
+                             . ,frame-tabs-min-size))))))
+    ;; Display tabs in the window.
+    (when tabs-window
+      (with-current-buffer tabs-buffer
+       (setq mode-line-format nil)
+       (setq header-line-format nil)
+       (setq buffer-read-only nil)
+       (erase-buffer)
+       (dolist (buffer (funcall frame-tabs-buffer-list frame))
+         (let ((name (funcall frame-tabs-filter-function buffer frame)))
+           (when name
+             (insert
+              (propertize
+               name
+               'buffer buffer
+               'keymap frame-tabs-map
+               'face (if (eq buffer tabs-selected)
+                         (progn
+                           (setq tabs-point (point))
+                           'frame-tabs-selected-tab)
+                       'frame-tabs-buffer-tab)
+               'mouse-face 'frame-tabs-higlight-tab))
+             (when frame-tabs-x
+               (insert
+                (propertize
+                 "×" 'buffer buffer ; U-00D7
+                 ;;          "⌧" 'buffer buffer ; U-2327
+                 'keymap frame-tabs-x-map
+                 'face 'frame-tabs-x-tab
+                 'mouse-face 'frame-tabs-x-higlight-tab)))
+             ;; We'd like to use "​" (U-200B) instead of " " in the
+             ;; following form but the display-engine word-wraps only at
+             ;; spaces or tabs so use a display specification instead.
+             ;; Note that we can't use :width either since it would make
+             ;; the spaces of the last item on each line extend to the
+             ;; end of that line.
+             (insert
+              (if tabs-vertical
+                  ;; "​"
+                  (propertize " " 'display '(space . (:relative-width 0.1)))
+                "\n")))))
+       ;; Delete very last space or newline inserted.
+       (when (memq (char-before) '(?\s ?\n)) (delete-char -1))
+       (when tabs-vertical
+         ;; Make sure word wrapping takes care of buffer tabs.
+         (set (make-local-variable 'truncate-lines) nil)
+         (set (make-local-variable 'truncate-partial-width-windows) nil)
+         (set (make-local-variable 'word-wrap) t))
+       ;; Handle window.
+       (set-window-margins tabs-window 0 0)
+       (set-window-fringes tabs-window 0 0)
+       (set-window-scroll-bars tabs-window 0)
+       (setq window-size-fixed nil)
+       ;; We have bound 'window-resize-pixelwise' to t to make sure
+       ;; the following call handles the boxed face for our tabs as
+       ;; expected.
+       (fit-window-to-buffer
+        tabs-window frame-tabs-max-size frame-tabs-min-size)
+       (if tabs-vertical
+           (setq window-size-fixed 'height)
+         (setq window-size-fixed 'width))
+       (set-window-start tabs-window (point-min))
+       (setq cursor-type nil)
+       (set-window-parameter tabs-window 'no-other-window t)
+       (set (make-local-variable 'transient-mark-mode) nil)
+       (set-window-point
+        tabs-window
+        (or tabs-point (point-min))))
+      (set-window-dedicated-p tabs-window t))
+    tabs-window))
+
+(defun frame-tabs--update ()
+  "Update frame tabs after timer fires."
+  (let ((selected-window (selected-window))
+       buffer-list-update-hook)
+    (unwind-protect
+       (progn
+         (setq frame-tabs-run t)
+         ;; Sanitize frame tabs buffers.
+         (dolist (buffer frame-tabs-buffers)
+           (cond
+            ((not (buffer-live-p buffer))
+             (setq frame-tabs-buffers
+                   (delq buffer frame-tabs-buffers)))
+            ((not (get-buffer-window buffer t))
+             (setq frame-tabs-buffers
+                   (delq buffer frame-tabs-buffers))
+             (kill-buffer buffer))))
+         ;; Provide tabs window on each frame.  Exclude
+         ;; minibuffer-only and unsplittable frames.
+         (dolist (frame (frame-list))
+           (unless (or (eq (frame-parameter frame 'minibuffer) 'only)
+                       (frame-parameter frame 'unsplittable))
+             (frame-tabs--window frame))))
+      (select-window selected-window)
+      (setq frame-tabs-run nil)
+      (cancel-timer frame-tabs-timer))))
+
+(defun frame-tabs--enable-timer ()
+  "Schedule updating frame tabs."
+  (unless frame-tabs-run
+    (when (timerp frame-tabs-timer)
+      (cancel-timer frame-tabs-timer))
+    (setq frame-tabs-timer
+         (run-with-idle-timer frame-tabs-delay t 'frame-tabs--update))))
+
+(defun frame-tabs--remove ()
+  "Remove frame tabs window from each frame."
+  (condition-case nil
+      (progn
+       (setq frame-tabs-run t)
+       (cancel-timer frame-tabs-timer)
+       (dolist (buffer frame-tabs-buffers)
+         (when (buffer-live-p buffer)
+           (delete-windows-on buffer t))
+         (kill-buffer buffer))
+       (setq frame-tabs-buffers nil)
+       (setq frame-tabs-run nil)
+       (cancel-timer frame-tabs-timer))
+    (error nil)))
+
+(defun frame-tabs--window-configuration-change ()
+  "Run timer when a window configuration changes."
+  (frame-tabs--enable-timer))
+
+(defun frame-tabs--buffer-list-update ()
+  "Run timer when the buffer list has been updated."
+  (frame-tabs--enable-timer))
+
+(defun frame-tabs--window-size-change (frame)
+  "Run timer when the root window of FRAME changes size."
+  (let ((root (frame-root-window frame)))
+    (when (or (and (memq frame-tabs-side '(top bottom))
+                  (not (= (window-pixel-width-before-size-change root)
+                          (window-pixel-width root))))
+             (and (memq frame-tabs-side '(left right))
+                  (not (= (window-pixel-height-before-size-change root)
+                          (window-pixel-height root)))))
+      (frame-tabs--enable-timer))))
+
+;; Commands
+(defun frame-tabs--switch-to-buffer (event &optional where)
+  "Switch to buffer of tab clicked on.
+EVENT is the original event associated with the click.  WHERE is
+the location where the switch shall take place."
+  (let* ((tabs-window (posn-window (event-end event)))
+        (tabs-buffer (window-buffer tabs-window))
+        buffer)
+    (with-current-buffer tabs-buffer
+      (save-excursion
+       (goto-char (posn-point (event-end event)))
+       (setq buffer (get-text-property (point) 'buffer))
+       (when (eq tabs-window (selected-window))
+         (select-window (get-mru-window 0 nil t)))
+       (cond
+        ((not (buffer-live-p buffer))
+         (message "Not a live buffer %s" buffer))
+        ((eq where 'other-window)
+         (switch-to-buffer-other-window buffer))
+        ((eq where 'other-frame)
+         (switch-to-buffer-other-frame buffer))
+        (t
+         (switch-to-buffer buffer)))))))
+
+(defun frame-tabs-switch-to-buffer (event)
+  "In selected window switch to buffer of tab clicked on."
+  (interactive "e")
+  (frame-tabs--switch-to-buffer event))
+
+(defun frame-tabs-switch-to-buffer-other-window (event)
+  "In other window switch to buffer of tab clicked on."
+  (interactive "e")
+  (frame-tabs--switch-to-buffer event 'other-window))
+
+(defun frame-tabs-switch-to-buffer-other-frame (event)
+  "In other frame switch to buffer of tab clicked on."
+  (interactive "e")
+  (frame-tabs--switch-to-buffer event 'other-frame))
+
+(defun frame-tabs--dismiss-buffer (event &optional how)
+  "Dismiss buffer of tab clicked on.
+EVENT is the original event associated with the click.  HOW is
+the type of dismissal chosen."
+  (let* ((tabs-window (posn-window (event-end event)))
+        (tabs-buffer (window-buffer tabs-window))
+        buffer)
+    (with-current-buffer tabs-buffer
+      (save-excursion
+       (goto-char (posn-point (event-end event)))
+       (setq buffer (get-text-property (point) 'buffer))))
+    (when (eq tabs-window (selected-window))
+      (select-window (get-mru-window 0 nil t)))
+    (cond
+     ((eq how 'replace)
+      (replace-buffer-in-windows buffer))
+     ((eq how 'kill)
+      (kill-buffer buffer))
+     ((eq (window-buffer) buffer)
+      ;; Must not call this with BUFFER as argument!
+      (bury-buffer))
+     (t
+      (bury-buffer buffer)))))
+
+(defun frame-tabs-bury-buffer (event)
+  "Bury buffer of tab clicked on."
+  (interactive "e")
+  (frame-tabs--dismiss-buffer event))
+
+(defun frame-tabs-replace-buffer (event)
+  "Replace buffer of tab clicked on in all windows showing it."
+  (interactive "e")
+  (frame-tabs--dismiss-buffer event 'replace))
+
+(defun frame-tabs-kill-buffer (event)
+  "Kill buffer of tab clicked on."
+  (interactive "e")
+  (frame-tabs--dismiss-buffer event 'kill))
+
+;;;###autoload
+(define-minor-mode frame-tabs-mode
+  "Toggle display of a buffer tabs side window on each frame.
+With a prefix argument ARG, enable this mode if ARG is positive,
+and disable it otherwise.  If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
+When this mode is enabled, every normal frame is equipped with a
+side window showing tabs for all buffers that appeared on that
+frame."
+  :global t
+  :group 'frame-tabs
+  :init-value nil
+  :link '(emacs-commentary-link "frame-tabs.el")
+  (if frame-tabs-mode
+      (progn
+       (add-hook 'buffer-list-update-hook 'frame-tabs--buffer-list-update 
'append)
+       (add-hook 'window-configuration-change-hook 
'frame-tabs--window-configuration-change 'append)
+       (add-hook 'window-size-change-functions 'frame-tabs--window-size-change 
'append)
+       (frame-tabs--enable-timer)
+       (frame-tabs--update))
+    (remove-hook 'buffer-list-update-hook 'frame-tabs--buffer-list-update)
+    (remove-hook 'window-configuration-change-hook 
'frame-tabs--window-configuration-change)
+    (remove-hook 'window-size-change-functions 'frame-tabs--window-size-change)
+    (frame-tabs--remove)))
+
+(provide 'frame-tabs)
+
+;;; frame-tabs.el ends here