root/lang/elisp/widen-window-mode/trunk/widen-window.el

Revision 29181, 8.4 kB (checked in by hayamiz, 6 years ago)

rewrote some documentation
added help-do-xref' to ww-advised-functions'
ver 0.1.1

Line 
1;;; widen-window.el --- Widening selecting window
2
3;; Copyright (C) 2008  Yuto Hayamizu
4
5;; Author: Yuto Hayamizu <y.hayamizu@gmail.com>
6;; Keywords: convenience
7;; Version: 0.1.1
8
9;; This file is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 3, or (at your option)
12;; any later version.
13
14;; This file is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING.  If not, write to
21;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22;; Boston, MA 02110-1301, USA.
23
24;;; Commentary:
25
26;; This minor mode, widen window mode, provides a function that widen
27;; selected window automatically.
28;; It was tested only on Emacs 22.
29
30;; In order to use this minor mode, put this file into
31;; a directory included in load-path,
32;; and add following code to your .emacs.
33;; +------------------------+
34;; (require 'widen-window)
35;; (global-widen-window-mode t)
36;; +------------------------+
37
38;; You can change the window size ratio by customizing `ww-ratio'.
39;; `ww-ratio' must be greater than 0.0 and less than 1.0 .
40
41;; If you want to disable widen window mode in a certain
42;; major mode(say `foo-mode'), add `foo-mode' to the variable `ww-nonwide-modes'.
43
44;; If `ww-width' is non-nil, horizontal window widening is done.
45;; You can turn it off by setting `ww-width' nil.
46;; `ww-height' is the same as.
47
48;; Window widening function `widen-current-window' is called after the
49;; invocation of a function listed in `ww-advised-functions'.
50;; By adding functions to or removing from this variable, you can
51;; control the invocation of window widening.
52
53;;; Code:
54
55(require 'easy-mmode)
56(require 'cl)
57
58(defgroup widen-window nil
59  "Widen selected window"
60  :group 'convenience
61  :prefix "widen-window-")
62
63(defcustom ww-ratio 0.625
64  "This is a ratio which the selected window takes up in window subtree."
65  :group 'widen-window
66  :type 'number
67  )
68
69(defcustom ww-nonwide-modes
70  '(dummy1-mode dummy2-mode)
71  "Major modes `widen-current-window' cannot run."
72  :type '(list symbol)
73  :group 'widen-window)
74
75(defcustom ww-height
76  t
77  "If `ww-height' is non-nil, widen-window for height will work."
78  :type '(choice (const :tag "Yes" t)
79                 (const :tag "No" nil))
80  :group 'widen-window)
81
82(defcustom ww-width
83  t
84  "If `ww-width' is non-nil, widen-window for width will work."
85  :type '(choice (const :tag "Yes" t)
86                 (const :tag "No" nil))
87  :group 'widen-window)
88
89(defcustom ww-advised-functions
90  '(other-window
91    split-window
92    switch-to-buffer
93    mouse-drag-region
94    delete-window
95    add-change-log-entry-other-window
96    help-do-xref
97    )
98  "Functions to be advised. Window widening function `widen-current-window' is fired after advised function was called."
99  :type '(list symbol)
100  :group 'widen-window)
101
102(defun widen-current-window ()
103  "The very function which resizes the current window."
104
105  (interactive)
106
107  (unless (minibufferp (current-buffer))
108    (cond
109     ((>= 0 ww-ratio) (setq ww-ratio 0.2))
110     ((<= 1 ww-ratio) (setq ww-ratio 0.8)))
111 
112    (let* ((current-window (selected-window))
113           (window-tree (bw-get-tree (selected-frame))))
114      (when window-tree
115        ;; Sometimes, you cannot get correctly resized windows
116        ;; by calling ww-subtree only once.
117        ;; So ww-subtree is called repeatedly until
118        ;; www-subtree makes no change.
119        (let ((sizeinfo-history nil)
120              (last-sizeinfo nil)
121              (windows (window-list nil nil)))
122          (while (not (member last-sizeinfo sizeinfo-history))
123            (setq sizeinfo-history
124                  (cons last-sizeinfo sizeinfo-history))
125            (setq last-sizeinfo
126                  (mapcar (lambda (w)
127                            (window-edges w))
128                          windows))         
129            (ww-subtree
130             window-tree current-window
131             (- (bw-r window-tree) (bw-l window-tree))
132             (- (bw-b window-tree) (bw-t window-tree)))
133            )))
134        )))
135
136(defun ww-bw-wid (window-or-tree)
137  "Returns the width of WINDOW-OR-TREE"
138  (- (bw-r window-or-tree) (bw-l window-or-tree)))
139
140(defun ww-bw-hei (window-or-tree)
141  "Returns the height of WINDOW-OR-TREE"
142  (- (bw-b window-or-tree) (bw-t window-or-tree)))
143
144(defun ww-sign (num)
145  (if (>= num 0)
146      +1
147    -1))
148
149(defun ww-adjust-window (wtree delta horiz-p)
150  "Smart wrapper of `bw-adjust-window'
151
152If `bw-adjust-window' fails to change the size of a window to specified size(ex. tried too big size), it does nothing (on Emacs22), and `widen-current-window' thinks that resizing iteration was finished, and `widen-current-window' actually does nothing.
153If `ww-adjust-window' fails to resize, it tries smaller change than specified."
154  (if horiz-p
155        ;; width changes
156      (let (last-width)
157        (while (> (abs delta) 0)
158          (setq last-width (ww-bw-wid wtree))
159          (bw-adjust-window wtree delta horiz-p)
160          (let ((wid-change (- (ww-bw-wid wtree) last-width)))
161            (if (eq wid-change 0)
162                (setq delta (* (ww-sign delta) (floor (* 0.66 (abs delta)))))
163              (setq delta (- delta wid-change))))))
164
165    ;; height changes
166    (let (last-height)
167        (while (> (abs delta) 0)
168          (setq last-height (ww-bw-hei wtree))
169          (bw-adjust-window wtree delta horiz-p)
170          (let ((hei-change (- (ww-bw-hei wtree) last-height)))
171            (if (eq hei-change 0)
172                (setq delta (* (ww-sign delta) (floor (* 0.66 (abs delta)))))
173              (setq delta (- delta hei-change))))))
174        )
175    )
176
177(defun ww-subtree (wtree cur-win wid hei)
178  (setq wtree (bw-refresh-edges wtree))
179  (unless wid (setq wid (ww-bw-wid wtree)))
180  (unless hei (setq hei (ww-bw-hei wtree)))
181  (let ((wtree-wid (ww-bw-wid wtree))
182        (wtree-hei (ww-bw-hei wtree)))
183    (if (windowp wtree)
184        (progn
185          (when wid
186            (let ((dw (- wid wtree-wid)))
187              (when (/= 0 dw)
188                (ww-adjust-window wtree dw t))))
189          (when hei
190            (let ((dh (- hei wtree-hei)))
191              (when (/= 0 dh)
192                (ww-adjust-window wtree dh nil))))
193          )
194      (let* ((children (cdr (assq 'childs wtree)))
195             (cwin-num (length children))
196             (cwin-bigger-wid wid)
197             (cwin-bigger-hei hei)
198             (cwin-smaller-wid wid)
199             (cwin-smaller-hei hei))
200        (case (bw-dir wtree)
201          ((hor)
202           (setq cwin-smaller-wid
203                 (floor (/ (* wtree-wid (- 1 ww-ratio))
204                           (- cwin-num 1))))
205           (setq cwin-bigger-wid
206                 (- wtree-wid (* (- cwin-num 1)
207                               cwin-smaller-wid))))
208          ((ver)
209           (setq cwin-smaller-hei
210                 (floor (/ (* wtree-hei (- 1 ww-ratio))
211                           (- cwin-num 1))))
212           (setq cwin-bigger-hei
213                 (- wtree-hei (* (- cwin-num 1)
214                               cwin-smaller-hei)))))
215        (dolist (cwin children)
216          (if (ww-find-window-in-subtree cwin cur-win)
217              (ww-subtree
218               cwin cur-win
219               (if ww-width cwin-bigger-wid (ww-bw-wid cwin))
220               (if ww-height cwin-bigger-hei (ww-bw-hei cwin)))
221            (ww-subtree
222             cwin cur-win
223             (if ww-width cwin-smaller-wid (ww-bw-wid cwin))
224             (if ww-height cwin-smaller-hei (ww-bw-hei cwin)))))
225        ))))
226
227(defun ww-find-window-in-subtree (wt window)
228  (block func
229    (cond
230     ((windowp wt)
231      (if (equal wt window)
232          window
233        nil))
234     (t
235      (dolist (subwt (cdr (assq 'childs wt)))
236        (let ((ret (ww-find-window-in-subtree subwt window)))
237          (when ret
238            (return-from func window))))
239      nil))))
240
241(defun ww-setup-advice ()
242  (dolist (func ww-advised-functions)
243    (when (fboundp func)
244      (eval `(defadvice ,func (after widen-window-advice)
245               (if (and widen-window-mode (not (memq major-mode ww-nonwide-modes)))
246                   (widen-current-window))))))
247  (ad-activate-regexp "widen-window"))
248
249(define-minor-mode widen-window-mode
250  "Widen Window mode"
251  :lighter " WW"
252  :group 'widen-window
253  (if widen-window-mode
254      (progn
255        (ww-setup-advice)
256        (if (memq major-mode ww-nonwide-modes)
257            (widen-window-mode nil)))
258    nil))
259
260(defun widen-window-mode-maybe ()
261  "Return t and enable widen-window-mode if `widen-current-window' can called on current buffer."
262  (if (and (not (minibufferp (current-buffer)))
263           (not (memq major-mode ww-nonwide-modes)))
264      (widen-window-mode t)))
265
266(define-global-minor-mode global-widen-window-mode
267  widen-window-mode widen-window-mode-maybe
268  :group 'widen-window)
269
270;;; for anything.el
271;; (defadvice anything (around disable-ww-mode activate)
272;;   (ad-deactivate-regexp "widen-window")
273;;   (unwind-protect
274;;       ad-do-it
275;;     (ad-activate-regexp "widen-window")))
276
277;; (if (fboundp 'anything)
278;;     (ad-activate-regexp "disable-ww-mode"))
279
280(provide 'widen-window)
281;;; widen-window.el ends here
Note: See TracBrowser for help on using the browser.