aboutsummaryrefslogtreecommitdiff
path: root/bard-elisp/bard-window.el
blob: 3e30a2e5a3438292fe63c9d1628d5a901784e709 (plain)
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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
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
118
119
120
121
122
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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
(require 'prot-common)

(defvar prot-window-window-sizes
  '( :max-height (lambda () (floor (frame-height) 3))
     :min-height 10
     :max-width (lambda () (floor (frame-width) 4))
     :min-width 20)
  "Property list of maximum and minimum window sizes.
The property keys are `:max-height', `:min-height', `:max-width',
and `:min-width'.  They all accept a value of either a
number (integer or floating point) or a function.")

(defun prot-window--get-window-size (key)
  "Extract the value of KEY from `prot-window-window-sizes'."
  (when-let ((value (plist-get prot-window-window-sizes key)))
    (cond
     ((functionp value)
      (funcall value))
     ((numberp value)
      value)
     (t
      (error "The value of `%s' is neither a number nor a function" key)))))

(defun prot-window-select-fit-size (window)
  "Select WINDOW and resize it.
The resize pertains to the maximum and minimum values for height
and width, per `prot-window-window-sizes'.

Use this as the `body-function' in a `display-buffer-alist' entry."
  (select-window window)
  (fit-window-to-buffer
   window
   (prot-window--get-window-size :max-height)
   (prot-window--get-window-size :min-height)
   (prot-window--get-window-size :max-width)
   (prot-window--get-window-size :min-width))
  ;; If we did not use `display-buffer-below-selected', then we must
  ;; be in a lateral window, which has more space.  Then we do not
  ;; want to dedicate the window to this buffer, because we will be
  ;; running out of space.
  (when (or (window-in-direction 'above) (window-in-direction 'below))
    (set-window-dedicated-p window t)))

(defun prot-window--get-display-buffer-below-or-pop ()
  "Return list of functions for `prot-window-display-buffer-below-or-pop'."
  (list
   #'display-buffer-reuse-mode-window
   (if (or (prot-common-window-small-p)
           (prot-common-three-or-more-windows-p))
       #'display-buffer-below-selected
     #'display-buffer-pop-up-window)))

(defun prot-window-display-buffer-below-or-pop (&rest args)
  "Display buffer below current window or pop a new window.
The criterion for choosing to display the buffer below the
current one is a non-nil return value for
`prot-common-window-small-p'.

Apply ARGS expected by the underlying `display-buffer' functions.

This as the action function in a `display-buffer-alist' entry."
  (let ((functions (prot-window--get-display-buffer-below-or-pop)))
    (catch 'success
      (dolist (fn functions)
        (when (apply fn args)
          (throw 'success fn))))))

;; from protesilaos prot-shell library
(defun prot-window-shell-or-term-p (buffer &rest _)
  "Check if BUFFER is a shell or terminal.
This is a predicate function for `buffer-match-p', intended for
use in `display-buffer-alist'."
  (when (string-match-p "\\*.*\\(e?shell\\|v?term\\|terminal\\).*" (buffer-name (get-buffer buffer)))
    (with-current-buffer buffer
      ;; REVIEW 2022-07-14: Is this robust?
      (and (not (derived-mode-p 'message-mode 'text-mode))
           (derived-mode-p 'eshell-mode 'shell-mode 'term-mode 'comint-mode 'fundamental-mode)))))

;; taken from https://github.com/hylophile/.files/blob/1f3f01e4e25b00f7b61eca286fcf4f865885090c/.config/doom/config.org#fancy-tab-bar

(defun hy/tab-bar-format-align-center ()
  "Align the rest of tab bar items centered."
  (let* ((rest (cdr (memq 'hy/tab-bar-format-align-center tab-bar-format)))
         (rest (tab-bar-format-list rest))
         (rest (mapconcat (lambda (item) (nth 2 item)) rest  ""))
         (hpos (progn
                 (add-face-text-property 0 (length rest) 'tab-bar t rest)
                 (string-pixel-width rest)))
         (hpos (+ hpos (/ (- (frame-inner-width) hpos) 2)))
         (str (propertize "​" 'display
                          ;; The `right' spec doesn't work on TTY frames
                          ;; when windows are split horizontally (bug#59620)
                          (if (window-system)
                              `(space :align-to (- right (,hpos)))
                            `(space :align-to (,(- (frame-inner-width) hpos)))))))
    `((align-center menu-item ,str ignore))))

(setq tab-bar-tab-name-format-function #'hy/tab-bar-tab-name-format-default)
(defun hy/tab-bar-tab-name-format-default (tab i)
  (let* ((hint (format "%d" i))
         (name (alist-get 'name tab))
         (dir (concat "(" (alist-get 'dir tab "") ")"))
         (name-format (concat
                       " "
                       (propertize hint 'face 'tab-bar-hint)
                       " "
                       name
                       " ")))
    (add-face-text-property
     0 (length name-format)
     (funcall tab-bar-tab-face-function tab)
     'append name-format)
    name-format))


(setq tab-bar-tab-name-function #'hy/tab-bar-tab-name-current)
(defun hy/tab-bar-tab-name-current ()
  (hy/shorten-string
   (hy/abbreviate-tab-name
    (buffer-name (window-buffer (or (minibuffer-selected-window)
                                    (and (window-minibuffer-p)
                                         (get-mru-window))))))
   25))

(defun hy/set-tab-dir ()
  (setf (alist-get 'dir (cdr (tab-bar--current-tab-find)))
        (hy/tab-bar-dir)))

(defun hy/abbreviate-directory-path (path)
  "Turns `~/code/test/t` into `~/c/t/project`."
  (let* ((directories (seq-filter (lambda (s) (not (string= s ""))) (split-string path "/")))
         (last-dir (car (last directories)))
         (abbreviated-dirs (mapcar (lambda (dir)
                                     (if (string= dir last-dir)
                                         dir
                                       (substring dir 0 (if (string-prefix-p "." dir) 2 1))))
                                   directories)))
    (mapconcat 'identity abbreviated-dirs "/")))

(defun hy/tab-bar-dir ()
  (hy/shorten-string (hy/abbreviate-directory-path
                      (abbreviate-file-name
                       (or (projectile-project-root) default-directory)))
                     10
                     t))

(defun hy/shorten-string (string max-length &optional at-start)
  (let ((len (length string)))
    (if (> len max-length)
        (if at-start
            (concat  "…" (substring string (- len max-length) len))
          (concat (substring string 0 max-length) "…"))
      string)))

(defun hy/abbreviate-tab-name (name)
  (string-trim (replace-regexp-in-string
                (rx (or "*" "helpful" "Org Src"))
                "" name)))

(defun bard/toggle-window-split ()
  "Toggle between horizontal and vertical window splits, preserving buffer layout."
  (interactive)
  (let ((current-buffers (mapcar #'window-buffer (window-list))) ; List of buffers in current windows
        (split-direction (if (= (window-width) (frame-width))
                             'vertical
                           'horizontal)))
    (delete-other-windows)
    ;; Toggle the split direction
    (if (eq split-direction 'horizontal)
        (split-window-vertically)
      (split-window-horizontally))
    ;; Restore buffers to the new windows
    (let ((windows (window-list)))
      (cl-loop for buffer in current-buffers
               for window in windows
               do (set-window-buffer window buffer)))))

(provide 'bard-window)