Download
(defconst pinbar-version "0.11")
(defvar pinbar-array (make-vector 9 nil) "array of tabs in pinbar")
(defface pinbar-default-face
'(
(t
(
:height 1.0
:foreground "black"
:background "lightgrey"
)
)
)
"Default face used in the tab bar."
:group 'pinbar)
(defface pinbar-selected-face
'(
(t
(:inherit pinbar-default-face
:box (:line-width -1 :color "white" :style pressed-button)
:foreground "blue"
)
)
)
"Face used for the selected tab."
:group 'pinbar)
(defface pinbar-unselected-face
'(
(t
(:inherit pinbar-default-face
:foreground "black"
)
)
)
"Face used for uselected tabs."
:group 'pinbar)
(defface pinbar-separator-face
'(
(t
(:inherit pinbar-default-face
:height 0.2
)
)
)
"Face for space width"
:group 'pinbar)
(defface pinbar-button-face
'(
(t
(:inherit pinbar-default-face
:foreground "blue"
)
)
)
"Face used for the select mode button."
:group 'pinbar)
(defun pinbar-del()
(interactive)
(dotimes (i (length pinbar-array))
(let ((curbuf (aref pinbar-array i)))
(when (eq curbuf (current-buffer))
(setq pinbar-tab-map nil)
(aset pinbar-array i nil)
)
)
)
)
(defvar pinbar-tab-map nil)
(make-variable-buffer-local 'pinbar-tab-map)
(defun pinbar-tab-make-keymap ()
(unless pinbar-tab-map
(setq pinbar-tab-map (make-sparse-keymap))
(let* ((cur (current-buffer))
(f (lambda (fn) `(lambda (e)
(interactive "e")
(select-window (posn-window (event-start e)))
(switch-to-buffer ,cur)
))))
(define-key pinbar-tab-map [header-line mouse-1] (funcall f nil))
)
)
)
(defun pinbar-add (&optional arg)
(interactive "P")
(unless arg
(setq arg 0)
(while (and (< arg (length pinbar-array))
(aref pinbar-array arg))
(setq arg (+ arg 1))
)
(setq arg (+ arg 1))
)
(if(numberp arg)
(if (and (<= arg (length pinbar-array))
(> arg 0))
(progn
(pinbar-tab-make-keymap)
(aset pinbar-array (- arg 1) (current-buffer))
(let* ((buffer (current-buffer))
(key (number-to-string arg))
(f (lambda () `(lambda ()
(interactive)
(switch-to-buffer ,buffer)
)))
)
(define-key esc-map key (funcall f))
)
)
(message "Tabs full, use pinbar-del to delete some tabs")
)
(pinbar-del)
)
)
(defun pinbar-line()
(setq pline "")
(let ((padcolor (face-background 'pinbar-default-face)))
(dotimes (i (length pinbar-array))
(let ((curbuf (aref pinbar-array i)))
(if curbuf
(setq pline (concat pline
(propertize " " 'face 'pinbar-separator-face)
(if (eq curbuf (current-buffer))
(propertize
(concat "<"
(number-to-string (+ i 1))
">"
(buffer-name curbuf)
)
'face 'pinbar-selected-face
)
(concat
(propertize
(concat
"["
(number-to-string (+ i 1))
"]"
)
'face 'pinbar-button-face
'mouse-face 'pinbar-selected-face
)
(propertize
(buffer-name curbuf)
'face 'pinbar-unselected-face
'mouse-face 'pinbar-selected-face
'local-map (buffer-local-value 'pinbar-tab-map curbuf)
)
)
)
)
)
)
)
)
(concat pline
(propertize "%-" 'face (list :background padcolor
:foreground padcolor))
)
)
)
(defun pinbar-buffer-kill-buffer-hook ()
(if pinbar-mode
(pinbar-del)
)
)
(defvar pinbar-old-global-hlf nil
"Global value of the header line when entering pin bar mode.")
(defconst pinbar-header-line-format '(:eval (pinbar-line))
"The pin bar header line format.")
(define-minor-mode pinbar-mode
"Toggle display of a pin bar in the header line.
With prefix argument ARG, turn on if positive, otherwise off.
Returns non-nil if the new state is enabled."
:global t
:group 'pinbar
(if pinbar-mode
(unless (eq header-line-format pinbar-header-line-format)
(setq pinbar-old-global-hlf (default-value 'header-line-format))
(add-hook 'kill-buffer-hook 'pinbar-buffer-kill-buffer-hook)
(setq-default header-line-format pinbar-header-line-format))
(when (eq (default-value 'header-line-format)
pinbar-header-line-format)
(setq-default header-line-format pinbar-old-global-hlf))
(remove-hook 'kill-buffer-hook 'pinbar-buffer-kill-buffer-hook)
))
(provide 'pinbar)