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 (defun setup-my-windows ()
  63   (interactive)
  64   (let ((width 100) (min 100) (distribute t)
  65         (currentbuffer (current-buffer))
  66         (currentwindow (selected-window))
  67         topwindows firstwindow newwindow newtopwindows)
  68     (walk-windows (function (lambda (w)
  69                               (let ((e (window-edges w)))
  70                                 (if (< (nth 1 e) window-min-height)
  71                                     (setq topwindows (cons (list (nth 0 e)
  72                                                                  w
  73                                                                  (window-buffer w)
  74                                                                  (window-point w)
  75                                                                  (window-start w)
  76                                                                  (equal w currentwindow))
  77                                                            topwindows))))))
  78                             'nomini)
  79     (setq topwindows (sort topwindows (function (lambda (a b) (< (car a) (car b))))))
  80     (setq topwindows (loop for w in topwindows
  81                            for (pos win buf point start iscurrent) = w
  82                            if (not (member (buffer-name buf) setup-my-windows-junk-buffers))
  83                            collect w))
  84     (delete-other-windows (nth 1 (car topwindows)))
  85     (save-selected-window
  86       (select-window (split-window-vertically
  87                       (- (window-height) (max 5 (/ (* (frame-height) 15) 100)) -1)))
  88       (switch-to-buffer (get-buffer-create "*compilation*"))
  89       (if (eq currentbuffer (current-buffer))
  90           (setq newwindow (selected-window))))
  91     (setq firstwindow (selected-window))
  92     (setq newtopwindows (list (selected-window)))
  93     (while (> (window-width) (+ width 3 min 3))
  94       (select-window (split-window-horizontally (+ width 3)))
  95       (setq newtopwindows (cons (selected-window) newtopwindows))
  96       (switch-to-buffer (get-buffer-create "*scratch*")))
  97     (setq newtopwindows (reverse newtopwindows))
  98     (loop for w in newtopwindows
  99           for (pos win buf point start iscurrent) in
 100               (loop for w in topwindows
 101                     for (pos win buf point start iscurrent) = w
 102                     if (not (member (buffer-name buf) setup-my-windows-precious-buffers))
 103                     collect w)
 104           do (progn
 105                (select-window w)
 106                (set-window-buffer w buf)
 107                (set-window-start w start)
 108                (goto-char point)
 109                (if iscurrent
 110                    (setq newwindow w))))
 111     (setq newtopwindows (reverse newtopwindows))
 112     (setq topwindows (reverse topwindows))
 113     (loop for w in newtopwindows
 114           for (pos win buf point start iscurrent) in
 115               (loop for w in topwindows
 116                     for (pos win buf point start iscurrent) = w
 117                     if (member (buffer-name buf) setup-my-windows-precious-buffers)
 118                     collect w)
 119           do (progn
 120                (select-window w)
 121                (set-window-buffer w buf)
 122                (set-window-start w start)
 123                (goto-char point)
 124                (if iscurrent
 125                    (setq newwindow w))))
 126     (setq newwindow
 127           (or newwindow
 128               (loop for w in newtopwindows
 129                     if (eq (window-buffer w) currentbuffer) return w)
 130               (loop for w in newtopwindows
 131                     for name = (buffer-name (window-buffer w))
 132                     if (string= name "*scratch*") return w)
 133               (loop for w in newtopwindows
 134                     for name = (buffer-name (window-buffer w))
 135                     if (and (= (aref name 0) ?*)
 136                             (not (member name setup-my-windows-precious-buffers))) return w)
 137               firstwindow))
 138     (if (and distribute (> (length newtopwindows) 1))
 139         (balance-windows firstwindow))
 140     (select-window newwindow)
 141     (if (not (member (buffer-name currentbuffer) setup-my-windows-junk-buffers))
 142         (switch-to-buffer currentbuffer))))
 143
 144 (defun my-split-window-sensibly (window)
 145   (if (and (> (window-height window) (- (frame-height (window-frame window)) window-min-height))
 146            (> (window-height window) (max 5 (/ (* (frame-height) 15) 100))))
 147       (split-window-sensibly window)))
 148
 149 (setq split-window-preferred-function 'my-split-window-sensibly)
 150
 151 (global-set-key "\C-x7" 'split-window-3-horizontally)
 152 (global-set-key "\C-x8" (lambda () (interactive) (split-window-n-horizontally 100 50)))
 153 (global-set-key "\C-x9" 'setup-my-windows)
 154 (global-set-key "\C-xp" 'other-window-reverse)
 155 (global-set-key "\C-\M-_" (lambda () (interactive) (safe-shrink-window 5)))
 156
 157 (defun my-swap-window-to-right (&optional stay)
 158   (interactive "P")
 159   (let ((cb (current-buffer))
 160         (cw (selected-window)))
 161     (windmove-right)
 162     (set-window-buffer cw (current-buffer))
 163     (switch-to-buffer cb)
 164     (if stay
 165         (select-window cw))))
 166
 167 (defun my-swap-window-to-left (&optional stay)
 168   (interactive "P")
 169   (let ((cb (current-buffer))
 170         (cw (selected-window)))
 171     (windmove-left)
 172     (set-window-buffer cw (current-buffer))
 173     (switch-to-buffer cb)
 174     (if stay
 175         (select-window cw))))
 176
 177 (global-set-key "\C-x>" 'my-swap-window-to-right)
 178 (global-set-key "\C-x<" 'my-swap-window-to-left)
 179
 180 (defun maximize-window-15 ()
 181   (interactive)
 182   (maximize-window (max 5 (/ (* (frame-height) 15) 100))))
 183
 184 (global-set-key [(ctrl meta ?+)]  'maximize-window-15)
 185
 186 (defun safe-max-window-horizontally ()
 187   (interactive)
 188   (let ((found nil)
 189         (width 0)
 190         (count 0)
 191         (current (selected-window)))
 192     (walk-windows (function (lambda (w)
 193                               (let ((e (window-edges w)))
 194                                 (if (< (nth 1 e) window-min-height)
 195                                     (progn
 196                                       (setq width (+ width (window-width w))
 197                                             count (1+ count))
 198                                       (if (equal w current)
 199                                           (setq found t)))))))
 200                   'nomini)
 201     (if (not found)
 202         (error "Current window is not a top window"))
 203     (shrink-window-horizontally (- (- width (window-width) (* window-min-width (1- count)))))))
 204
 205 (global-set-key "\C-x=" 'safe-max-window-horizontally)