6eda23b66fc2dd2d196d930ef0804dd48e55c842
[emacs-init.git] / setup / mywin.el
1 (defun split-window-3-horizontally ()
2   "Split window horizontally into three equal sized windows"
3   (interactive)
4   (let ((w (window-width)))
5     (split-window-horizontally (- w (/ w 3) -2))
6     (split-window-horizontally)))
7
8 (defun split-window-n-horizontally (width &optional min)
9   "Split window horizontally into WIDTH wide windows making the last
10 window no smaller than MIN. MIN defaults to WIDTH and WIDTH defaults
11 to 80."
12   (interactive "P")
13   (if (not width) (setq width 80))
14   (if (not min) (setq min width))
15   (save-selected-window
16     (while (> (window-width) (+ width 3 min 3))
17       (select-window (split-window-horizontally (+ width 3)))
18       (switch-to-buffer (get-buffer-create "*scratch*")))))
19
20 (defun maximize-window(&optional min-height)
21   "Enlarge the current window by as many lines as is possible without making any other
22 window smaller than MIN-HEIGHT lines."
23   (interactive)
24   ;; this algorithm is copied from window.el / balance-windows()
25   (let ((min-height (or min-height i(+ window-min-height 0)))
26         (count -1)
27         size)
28         ;; Don't count the lines that are above the uppermost windows.
29         ;; (These are the menu bar lines, if any.)
30     ;; Find all the different vpos's at which windows start,
31     ;; then count them.  But ignore levels that differ by only 1.
32     (save-window-excursion
33       (let (tops (prev-top -2))
34         (walk-windows (function (lambda (w)
35                                   (setq tops (cons (nth 1 (window-edges w))
36                                                    tops))))
37                       'nomini)
38         (setq tops (sort tops '<))
39         (while tops
40           (if (> (car tops) (1+ prev-top))
41               (setq prev-top (car tops)
42                     count (1+ count)))
43           (setq tops (cdr tops)))
44         (setq count (1+ count))))
45     (setq size (- (frame-height) (* (1- count) min-height)))
46     (enlarge-window (- size (window-height)))))
47
48 (defun safe-shrink-window(&optional n min-height)
49   "Like shrink-window but will not remove a window"
50   (interactive)
51   (let* ((min-height (or min-height window-min-height))
52          (n (or n 1)))
53     (if (< (- (window-height) n) min-height)
54         (shrink-window (- (window-height) min-height))
55       (shrink-window n))))
56
57 (defconst setup-my-windows-precious-buffers
58   '("*eshell*"))
59 (defconst setup-my-windows-junk-buffers
60   '("*scratch*" "*Messages*" "*Calculator" "*Calc Trail*" "*compilation*" "*fetchmail*"))
61
62 (defvar my-windows-count nil)
63
64 (defun setup-my-windows (&optional n)
65   (interactive "P")
66   (if n
67       (if (integerp n)
68           (setq my-windows-count n)
69         (setq my-windows-count nil)))
70   (let* ((width (if my-windows-count (- (/ (frame-width) my-windows-count) 4) 100))
71          (min width) (distribute t)
72          (currentbuffer (current-buffer))
73          (currentwindow (selected-window))
74          topwindows firstwindow newwindow newtopwindows)
75     (walk-windows (function (lambda (w)
76                               (let ((e (window-edges w)))
77                                 (if (< (nth 1 e) window-min-height)
78                                     (setq topwindows (cons (list (nth 0 e)
79                                                                  w
80                                                                  (window-buffer w)
81                                                                  (window-point w)
82                                                                  (window-start w)
83                                                                  (equal w currentwindow))
84                                                            topwindows))))))
85                             'nomini)
86     (setq topwindows (sort topwindows (function (lambda (a b) (< (car a) (car b))))))
87     (setq topwindows (loop for w in topwindows
88                            for (pos win buf point start iscurrent) = w
89                            if (not (member (buffer-name buf) setup-my-windows-junk-buffers))
90                            collect w))
91     (delete-other-windows (nth 1 (car topwindows)))
92     (save-selected-window
93       (select-window (split-window-vertically
94                       (- (window-height) (max 5 (/ (* (frame-height) 15) 100)) -1)))
95       (switch-to-buffer (get-buffer-create "*compilation*"))
96       (if (eq currentbuffer (current-buffer))
97           (setq newwindow (selected-window))))
98     (setq firstwindow (selected-window))
99     (setq newtopwindows (list (selected-window)))
100     (while (> (window-width) (+ width 3 min 3))
101       (select-window (split-window-horizontally (+ width 3)))
102       (setq newtopwindows (cons (selected-window) newtopwindows))
103       (switch-to-buffer (get-buffer-create "*scratch*")))
104     (setq newtopwindows (reverse newtopwindows))
105     (loop for w in newtopwindows
106           for (pos win buf point start iscurrent) in
107               (loop for w in topwindows
108                     for (pos win buf point start iscurrent) = w
109                     if (not (member (buffer-name buf) setup-my-windows-precious-buffers))
110                     collect w)
111           do (progn
112                (select-window w)
113                (set-window-buffer w buf)
114                (set-window-start w start)
115                (goto-char point)
116                (if iscurrent
117                    (setq newwindow w))))
118     (setq newtopwindows (reverse newtopwindows))
119     (setq topwindows (reverse topwindows))
120     (loop for w in newtopwindows
121           for (pos win buf point start iscurrent) in
122               (loop for w in topwindows
123                     for (pos win buf point start iscurrent) = w
124                     if (member (buffer-name buf) setup-my-windows-precious-buffers)
125                     collect w)
126           do (progn
127                (select-window w)
128                (set-window-buffer w buf)
129                (set-window-start w start)
130                (goto-char point)
131                (if iscurrent
132                    (setq newwindow w))))
133     (setq newwindow
134           (or newwindow
135               (loop for w in newtopwindows
136                     if (eq (window-buffer w) currentbuffer) return w)
137               (loop for w in newtopwindows
138                     for name = (buffer-name (window-buffer w))
139                     if (string= name "*scratch*") return w)
140               (loop for w in newtopwindows
141                     for name = (buffer-name (window-buffer w))
142                     if (and (= (aref name 0) ?*)
143                             (not (member name setup-my-windows-precious-buffers))) return w)
144               firstwindow))
145     (if (and distribute (> (length newtopwindows) 1))
146         (balance-windows firstwindow))
147     (select-window newwindow)
148     (if (not (member (buffer-name currentbuffer) setup-my-windows-junk-buffers))
149         (switch-to-buffer currentbuffer))))
150
151 (defun my-split-window-sensibly (window)
152   (if (and (> (window-height window) (- (frame-height (window-frame window)) window-min-height))
153            (> (window-height window) (max 5 (/ (* (frame-height) 15) 100))))
154       (split-window-sensibly window)))
155
156 (setq split-window-preferred-function 'my-split-window-sensibly)
157
158 (global-set-key "\C-x7" 'split-window-3-horizontally)
159 (global-set-key "\C-x8" (lambda () (interactive) (split-window-n-horizontally 100 50)))
160 (global-set-key "\C-x9" 'setup-my-windows)
161 (global-set-key "\C-\M-_" (lambda () (interactive) (safe-shrink-window 5)))
162
163 (defun my-swap-window-to-right (&optional below)
164   "If swap buffer in this window with buffer on the right. If BELOW is set,
165 instead move current buffer to right and replace it with the next buffer from
166 the buffer stack in the current window."
167   (interactive "P")
168   (let ((cb (current-buffer))
169         (cw (selected-window)))
170     (if below
171         (switch-to-buffer nil))
172     (windmove-right)
173     (if (not below)
174         (set-window-buffer cw (current-buffer)))
175     (switch-to-buffer cb)))
176
177 (defun my-swap-window-to-left (&optional below)
178   (interactive "P")
179   (let ((cb (current-buffer))
180         (cw (selected-window)))
181     (if below
182         (switch-to-buffer nil))
183     (windmove-left)
184     (if (not below)
185         (set-window-buffer cw (current-buffer)))
186     (switch-to-buffer cb)))
187
188 (global-set-key "\C-x>" 'my-swap-window-to-right)
189 (global-set-key "\C-x<" 'my-swap-window-to-left)
190
191 (defun maximize-window-15 ()
192   (interactive)
193   (maximize-window (max 5 (/ (* (frame-height) 15) 100))))
194
195 (global-set-key [(ctrl meta ?+)]  'maximize-window-15)
196
197 (defun safe-max-window-horizontally ()
198   (interactive)
199   (let ((found nil)
200         (width 0)
201         (count 0)
202         (current (selected-window)))
203     (walk-windows (function (lambda (w)
204                               (let ((e (window-edges w)))
205                                 (if (< (nth 1 e) window-min-height)
206                                     (progn
207                                       (setq width (+ width (window-width w))
208                                             count (1+ count))
209                                       (if (equal w current)
210                                           (setq found t)))))))
211                   'nomini)
212     (if (not found)
213         (error "Current window is not a top window"))
214     (shrink-window-horizontally (- (- width (window-width) (* window-min-width (1- count)))))))
215
216 (global-set-key "\C-x=" 'safe-max-window-horizontally)
217 (global-set-key "\C-x-" 'maximize-window-15)