initial commit
[emacs-init.git] / nxhtml / util / winsize.el
1 ;;; winsize.el --- Interactive window structure editing
2 ;;
3 ;; Author: Lennart Borgman <lennart dot borgman at gmail dot com >
4 ;; Maintainer:
5 ;; Created: Wed Dec 07 15:35:09 2005
6 (defconst winsize:version "0.98") ;;Version: 0.97
7 ;; Lxast-Updated: Sun Nov 18 02:14:52 2007 (3600 +0100)
8 ;; Keywords:
9 ;; Compatibility:
10 ;;
11 ;; Fxeatures that might be required by this library:
12 ;;
13 ;;   None
14 ;;
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16 ;;
17 ;;; Commentary:
18 ;;
19 ;; This file contains functions for interactive resizing of Emacs
20 ;; windows.  To use it put it in your `load-path' and add the following
21 ;; to your .emacs:
22 ;;
23 ;;     (require 'winsize)
24 ;;     (global-set-key [(control x) ?+] 'resize-windows)
25 ;;
26 ;; For more information see `resize-windows'.
27 ;;
28 ;; These functions are a slightly rewritten version of the second part
29 ;; of the second part my proposal for a new `balance-windows' function
30 ;; for Emacs 22.  The rewrite is mostly a restructure to more easily
31 ;; add new functions.  All functions and variables have been renamed.
32 ;; The file was originally named bw-interactive.el.
33 ;;
34 ;; New ideas for functionality have been to a large part adopted from
35 ;; the Emacs Devel mailing list.  Probably most of them originated from
36 ;; Drew Adams and Bastien.
37 ;;
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39 ;;
40 ;;; Change log:
41 ;;
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43 ;;
44 ;; This program is free software; you can redistribute it and/or modify
45 ;; it under the terms of the GNU General Public License as published by
46 ;; the Free Software Foundation; either version 2, or (at your option)
47 ;; any later version.
48 ;;
49 ;; This program is distributed in the hope that it will be useful,
50 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
51 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
52 ;; GNU General Public License for more details.
53 ;;
54 ;; You should have received a copy of the GNU General Public License
55 ;; along with this program; see the file COPYING.  If not, write to the
56 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
57 ;; Boston, MA 02111-1307, USA.
58 ;;
59 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60 ;;
61 ;; TODO: Change mouse pointer shape during resizing.
62 ;;
63 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
64 ;;
65 ;;; Code:
66
67 (eval-when-compile (require 'windmove))
68 (eval-when-compile (require 'view))
69 (eval-when-compile (require 'winsav nil t))
70 (eval-when-compile (require 'ourcomments-widgets))
71 (eval-when-compile (require 'ring))
72
73 ;;; Custom variables
74
75 (defcustom winsize-juris-way t
76   ""
77   :type 'boolean
78   :group 'winsize)
79
80 (defcustom winsize-autoselect-borders t
81   "Determines how borders are selected by default.
82 If nil hever select borders automatically (but keep them on the
83 same side while changing window).  If 'when-single select border
84 automatically if there is only one possible choice.  If t alwasy
85 select borders automatically if they are not selected."
86   :type '(choice (const :tag "Always" t)
87                  (const :tag "When only one possbility" when-single)
88                  (const :tag "Never" nil))
89   :group 'winsize)
90
91 (defcustom winsize-mode-line-colors (list t (list "green" "green4"))
92   "Mode line colors used during resizing."
93   :type '(list (boolean :tag "Enable mode line color changes during resizing")
94                (list
95                 (color :tag "- Active window mode line color")
96                 (color :tag "- Inactive window mode line color")))
97   :group 'winsize)
98
99 (defcustom winsize-mark-selected-window t
100   "Mark selected window if non-nil."
101   :type 'boolean
102   :group 'winsize)
103
104 (defcustom winsize-make-mouse-prominent t
105   "Try to make mouse more visible during resizing.
106 The mouse is positioned next to the borders that you can move.
107 It can however be hard to see if where it is.  Setting this to on
108 makes the mouse jump a few times."
109   :type 'boolean
110   :group 'winsize)
111
112 (defvar widget-command-prompt-value-history nil
113   "History of input to `widget-function-prompt-value'.")
114
115 (defvar winsize-keymap nil
116   "Keymap used by `resize-windows'.")
117
118 (defun winsize-make-keymap (let-me-use)
119   "Build the keymap that should be used by `winsize-keymap'."
120   (let ((map (make-sparse-keymap "Window Resizing")))
121     (when (featurep 'winsav)
122       (define-key map [menu-bar bw rotate]
123         '("Rotate window configuration" . winsav-rotate))
124       (define-key map [menu-bar bw sep3] '(menu-item "--")))
125     (define-key map [menu-bar bw]
126       (cons "Resize" (make-sparse-keymap "second")))
127     (define-key map [menu-bar bw save-config]
128       '("Save window configuration" . winsize-save-window-configuration))
129     (define-key map [menu-bar bw next-config]
130       '("Next saved window configuration" . winsize-next-window-configuration))
131     (define-key map [menu-bar bw prev-config]
132       '("Previous saved window configuration" . winsize-previous-window-configuration))
133     (define-key map [menu-bar bw sep2] '(menu-item "--"))
134     (define-key map [menu-bar bw fit]
135       '("Fit Window to Buffer" . fit-window-to-buffer))
136     (define-key map [menu-bar bw shrink]
137       '("Shrink Window to Buffer" . shrink-window-if-larger-than-buffer))
138     (define-key map [menu-bar bw sep1] '(menu-item "--"))
139     (define-key map [menu-bar bw siblings]
140       '("Balance Window Siblings" . winsize-balance-siblings))
141     (define-key map [menu-bar bw balance]
142       '("Balance Windows" . balance-windows))
143
144     (when (featurep 'winsav)
145       (define-key map [?|] 'winsav-rotate))
146     (define-key map [?+] 'balance-windows)
147     (define-key map [?.] 'winsize-balance-siblings)
148     (define-key map [?=] 'fit-window-to-buffer)
149     (define-key map [?-] 'shrink-window-if-larger-than-buffer)
150
151     (define-key map [(up)]    'winsize-move-border-up)
152     (define-key map [(down)]  'winsize-move-border-down)
153     (define-key map [(left)]  'winsize-move-border-left)
154     (define-key map [(right)] 'winsize-move-border-right)
155
156     (define-key map [(shift up)]    'winsize-move-other-border-up)
157     (define-key map [(shift down)]  'winsize-move-other-border-down)
158     (define-key map [(shift left)]  'winsize-move-other-border-left)
159     (define-key map [(shift right)] 'winsize-move-other-border-right)
160
161     (define-key map [(meta left)]   'winsize-to-border-or-window-left)
162     (define-key map [(meta up)]     'winsize-to-border-or-window-up)
163     (define-key map [(meta right)]  'winsize-to-border-or-window-right)
164     (define-key map [(meta down)]   'winsize-to-border-or-window-down)
165
166     (define-key map [?0] 'delete-window)
167     (define-key map [?1] 'delete-other-windows)
168     (define-key map [?2] 'split-window-vertically)
169     (define-key map [?3] 'split-window-horizontally)
170     (define-key map [?4] 'other-window)
171
172     (define-key map [?!] 'winsize-save-window-configuration)
173     (define-key map [?>] 'winsize-next-window-configuration)
174     (define-key map [?<] 'winsize-previous-window-configuration)
175
176     ;; Fix-me: These keys could also be set to nil
177     (define-key map [mouse-1]                        'mouse-set-point)
178     ;;(define-key map [down-mouse-1]                   'mouse-set-point)
179     (define-key map [(mode-line) (down-mouse-1)]     'mouse-drag-mode-line)
180     (define-key map [(vertical-line) (down-mouse-1)] 'mouse-drag-vertical-line)
181     (define-key map [(vertical-scroll-bar) (mouse-1)] 'scroll-bar-toolkit-scroll)
182
183     (define-key map [??] 'winsize-help)
184     (define-key map [(control ?g)]     'winsize-quit)
185     (define-key map [(control return)] 'winsize-stop-go-back)
186     (define-key map [(return)]         'winsize-stop)
187     (define-key map [t]                'winsize-stop-and-execute)
188
189     (dolist (ks let-me-use)
190       (if (and (not (vectorp ks))
191                (not (stringp ks))
192                (commandp ks))
193           (let ((ks-list (where-is-internal ks)))
194             (dolist (ks ks-list)
195               (unless (lookup-key map ks)
196                 (define-key map ks nil))))
197         (unless (lookup-key map ks)
198           (define-key map ks nil))))
199
200     (setq winsize-keymap map)))
201
202 (defcustom winsize-let-me-use '(next-line ;;[(control ?n)]
203                                 previous-line ;;[(control ?p)]
204                                 forward-char ;;[(control ?f)]
205                                 backward-char ;;[(control ?b)]
206                                 [(home)]
207                                 [(end)]
208                                 ;; Fix-me: replace this with something
209                                 ;; pulling in help-event-list:
210                                 [(f1)]
211                                 execute-extended-command
212                                 eval-expression)
213   "Key sequences or commands that should not be overriden during resize.
214 The purpose is to make it easier to switch windows.  The functions
215 `windmove-left' etc depends on the position when chosing the
216 window to move to."
217   :type '(repeat
218           (choice
219            ;; Note: key-sequence must be before command here, since
220            ;; the key sequences seems to match command too.
221            key-sequence command))
222   :set (lambda (sym val)
223          (set-default sym val)
224          (winsize-make-keymap val))
225   :group 'winsize)
226
227 (defcustom winsize-selected-window-face 'winsize-selected-window-face
228   "Variable holding face for marking selected window.
229 This variable may be nil or a face symbol."
230   :type '(choice (const :tag "Do not mark selected window" nil)
231                  face)
232   :group 'winsize)
233
234 (defface winsize-selected-window-face
235   '((t (:inherit secondary-selection)))
236   "Face for marking selected window."
237   :group 'winsize)
238
239
240 ;;; These variables all holds values to be reset when exiting resizing:
241
242 (defvar winsize-old-mode-line-bg nil)
243 (defvar winsize-old-mode-line-inactive-bg nil)
244 (defvar winsize-old-overriding-terminal-local-map nil)
245 (defvar winsize-old-overriding-local-map-menu-flag nil)
246 (defvar winsize-old-temp-buffer-show-function nil)
247 (defvar winsize-old-mouse-avoidance-mode nil
248   "Hold the value of `mouse-avoidance-mode' at resizing start.")
249 (defvar winsize-old-view-exit-action nil)
250 (make-variable-buffer-local 'winsize-old-view-exit-action)
251
252 (defvar winsize-message-end nil
253   "Marker, maybe at end of message buffer.")
254
255 (defvar winsize-resizing nil
256   "t during resizing, nil otherwise.")
257
258 (defvar winsize-window-config-init nil
259   "Hold window configuration from resizing start.")
260
261 (defvar winsize-frame nil
262   "Frame that `resize-windows' is operating on.")
263
264
265 ;;; Borders
266
267 (defvar winsize-window-for-side-hor nil
268   "Window used internally for resizing in vertical direction.")
269
270 (defvar winsize-window-for-side-ver nil
271   "Window used internally for resizing in horizontal direction.")
272
273 (defvar winsize-border-hor nil
274   "Use internally to remember border choice.
275 This is set by `winsize-pre-command' and checked by
276 `winsize-post-command', see the latter for more information.
277
278 The value should be either nil, 'left or 'right.")
279
280 (defvar winsize-border-ver nil
281   "Use internally to remember border choice.
282 This is set by `winsize-pre-command' and checked by
283 `winsize-post-command', see the latter for more information.
284
285 The value should be either nil, 'up or 'down.")
286
287 (defvar winsize-window-at-entry nil
288   "Window that was selected when `resize-windows' started.")
289
290
291 ;;; Keymap, interactive functions etc
292
293 (defun winsize-pre-command ()
294   "Do this before every command.
295 Runs this in `pre-command-hook'.
296
297 Remember the currently used border sides for resizing. Also
298 remember position in message buffer to be able to see if next
299 command outputs some message.
300
301 For more information see `winsize-post-command'."
302   (setq winsize-message-end (winsize-message-end))
303   (setq winsize-border-hor (winsize-border-used-hor))
304   (setq winsize-border-ver (winsize-border-used-ver)))
305
306 (defun winsize-post-command ()
307   "Done after every command.
308 Run this in `post-command-hook'.
309
310 Check the border sides \(left/right, up/down) remembered in
311 `winsize-pre-command' and use the the same side if possible,
312 otherwise the opposite side if that is possible. \(This check is
313 of course not done if the last command changed the border side.)
314
315 The reason for selecting borders this way is to try to give the
316 user a coherent and easy picture of what is going on when
317 changing window or when window structure is changed.  \(Note that
318 the commands moving to another window or changing the window
319 structure does not have to belong to this package. Those commands
320 can therefore not select the border sides.)
321
322 Give the user feedback about selected window and borders.  Also
323 give a short help message unless last command gave some message."
324   (unless winsize-juris-way
325     (unless winsize-border-hor
326       (winsize-select-initial-border-hor))
327     (when winsize-border-hor
328       (winsize-set-border winsize-border-hor t))
329     (unless winsize-border-ver
330      (winsize-select-initial-border-ver))
331     (when winsize-border-ver
332       (winsize-set-border winsize-border-ver t)))
333   (winsize-tell-user))
334
335 ;;;###autoload
336 (defun resize-windows ()
337   "Start window resizing.
338 During resizing a window is selected.  You can move its
339 borders. In the default configuration the arrow keys moves the
340 right or bottom border if they are there. To move the opposite
341 border use S-arrowkeys.
342
343 You can also do other window operations, like splitting, deleting
344 and balancing the sizes.  The keybindings below describes the key
345 bindings during resizing:\\<winsize-keymap>
346
347   `balance-windows'                      \\[balance-windows]
348   `winsize-balance-siblings'             \\[winsize-balance-siblings]
349   `fit-window-to-buffer'                 \\[fit-window-to-buffer]
350   `shrink-window-if-larger-than-buffer'  \\[shrink-window-if-larger-than-buffer]
351
352   `winsav-rotate'                        \\[winsav-rotate]
353
354   `winsize-move-border-up'      \\[winsize-move-border-up]
355   `winsize-move-border-down'    \\[winsize-move-border-down]
356   `winsize-move-border-left'    \\[winsize-move-border-left]
357   `winsize-move-border-right'   \\[winsize-move-border-right]
358
359   `winsize-to-border-or-window-left'    \\[winsize-to-border-or-window-left]
360   `winsize-to-border-or-window-up'      \\[winsize-to-border-or-window-up]
361   `winsize-to-border-or-window-right'   \\[winsize-to-border-or-window-right]
362   `winsize-to-border-or-window-down'    \\[winsize-to-border-or-window-down]
363
364    Note that you can also use your normal keys for
365    `forward-char', `backward-char', `next-line', `previous-line'
366    and what you have on HOME and END to move in the windows. That
367    might sometimes be necessary to directly select a
368    window. \(You may however also use `other-window' or click
369    with the mouse, see below.)
370
371   `delete-window'                \\[delete-window]
372   `delete-other-windows'         \\[delete-other-windows]
373   `split-window-vertically'      \\[split-window-vertically]
374   `split-window-horizontally'    \\[split-window-horizontally]
375   `other-window'                 \\[other-window]
376
377   `winsize-save-window-configuration'       \\[winsize-save-window-configuration]
378   `winsize-next-window-configuration'       \\[winsize-next-window-configuration]
379   `winsize-previous-window-configuration'   \\[winsize-previous-window-configuration]
380
381   `mouse-set-point'   \\[mouse-set-point]
382
383   `winsize-quit'               \\[winsize-quit]
384   `winsize-stop-go-back'       \\[winsize-stop-go-back]
385   `winsize-stop'               \\[winsize-stop]
386   `winsize-stop-and-execute'   \\[winsize-stop-and-execute]
387
388   `winsize-help'          \\[winsize-help]
389   `describe-key'          \\[describe-key]
390   `describe-key-briefly'  \\[describe-key-briefly]
391   (All the normal help keys work, and at least those above will
392   play well with resizing.)
393
394 Nearly all other keys exits window resizing and they are also
395 executed.  However, the key sequences in `winsize-let-me-use' and
396 dito for commands there are also executed without exiting
397 resizing.
398
399 The colors of the modelines are changed to those given in
400 `winsize-mode-line-colors' to indicate that you are resizing
401 windows.  To make this indication more prominent the text in the
402 selected window is marked with the face hold in the variable
403 `winsize-selected-window-face'.
404
405 The option `winsize-juris-way' decides how the borders to move
406 are selected. If this option is non-nil then the right or bottom
407 border are the ones that are moved with the arrow keys and the
408 opposite border with shift arrow keys.
409
410 If `winsize-juris-way' is nil then the following apply:
411
412 As you select other borders or move to new a window the mouse
413 pointer is moved inside the selected window to show which borders
414 are beeing moved. The mouse jumps a little bit to make its
415 position more visible. You can turn this off by customizing
416 `winsize-make-mouse-prominent'.
417
418 Which borders initially are choosen are controlled by the
419 variable `winsize-autoselect-borders'.
420
421 ** Example: Border selection, movements and windows.
422
423   Suppose you have a frame divided into windows like in the
424   figure below.  If window B is selected when you start resizing
425   then \(with default settings) the borders marked with 'v' and
426   'h' will be the ones that the arrow keys moves. To indicate
427   this the mouse pointer is placed in the right lower corner of
428   the selected window B.
429
430     +----------+-----------+--------+
431     |          |           v        |
432     |          |           v        |
433     |    A     |    _B_    v        |
434     |          |           v        |
435     |          |           v        |
436     |          |         x v        |
437     +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
438     |                    |          |
439     |                    |          |
440     |                    |          |
441     |                    |          |
442     |                    |          |
443     |                    |          |
444     +----------+---------+----------+
445
446   Now if you press M-<left> then the picture below shows what has
447   happened. Note that the selected vertical border is now the one
448   between A and B. The mouse pointer has moved to the
449   corresponding corner in the window B, which is still selected.
450
451     +----------+-----------+--------+
452     |          v           |        |
453     |          v           |        |
454     |    A     v    _B_    |        |
455     |          v           |        |
456     |          v           |        |
457     |          v x         |        |
458     +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
459     |                    |          |
460     |                    |          |
461     |                    |          |
462     |                    |          |
463     |                    |          |
464     |                    |          |
465     +----------+---------+----------+
466
467   Press M-<left> once again. This gives this picture:
468
469     +----------+-----------+--------+
470     |          v           |        |
471     |          v           |        |
472     |   _A_    v     B     |        |
473     |          v           |        |
474     |          v           |        |
475     |        x v           |        |
476     +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
477     |                    |          |
478     |                    |          |
479     |                    |          |
480     |                    |          |
481     |                    |          |
482     |                    |          |
483     +----------+---------+----------+
484
485   Note that the window A is now selected. However there is no
486   border that could be moved to the left of this window \(which
487   would otherwise be chosen now) so the border between A and B is
488   still the one that <left> and <right> moves. The mouse has
489   moved to A.
490
491   If we now delete window A the new situation will look like
492   this:
493
494     +----------+-----------+--------+
495     |                      |        |
496     |                      |        |
497     |         _B_          |        |
498     |                      |        |
499     |                      |        |
500     |                    x |        |
501     +hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhh+
502     |                    |          |
503     |                    |          |
504     |                    |          |
505     |                    |          |
506     |                    |          |
507     |                    |          |
508     +----------+---------+----------+
509
510
511
512 >>>> testing stuff >>>>
513 `help-mode-hook'
514 `temp-buffer-show-function'
515 `view-exit-action'
516 <<<<<<<<<<<<<<<<<<<<<<<
517 "
518   (interactive)
519   (setq winsize-resizing t)
520   ;; Save old values:
521   (unless winsize-old-mouse-avoidance-mode
522     (setq winsize-old-mouse-avoidance-mode mouse-avoidance-mode))
523   ;; Setup user feedback things:
524   (mouse-avoidance-mode 'none)
525   (winsize-set-mode-line-colors t)
526   (winsize-create-short-help-message)
527   (setq winsize-message-end (winsize-message-end))
528   ;; Save config for exiting:
529   (setq winsize-window-config-init (current-window-configuration))
530   (setq winsize-window-at-entry (selected-window))
531   (setq winsize-frame (selected-frame))
532   ;; Setup keymap and command hooks etc:
533   (winsize-setup-local-map)
534   (winsize-add-command-hooks)
535   (setq winsize-window-for-side-hor nil)
536   (setq winsize-window-for-side-ver nil))
537
538
539 (defun winsize-setup-local-map ()
540   "Setup an overriding keymap and use this during resizing.
541 Save current keymaps."
542   ;; Fix-me: use copy-keymap for old?
543   (unless winsize-old-overriding-terminal-local-map
544     (setq winsize-old-overriding-terminal-local-map overriding-terminal-local-map))
545   (setq overriding-terminal-local-map (copy-keymap winsize-keymap))
546   (setq winsize-old-overriding-local-map-menu-flag overriding-local-map-menu-flag)
547   (setq overriding-local-map-menu-flag t))
548
549 (defun winsize-restore-local-map ()
550   "Restore keymaps saved by `winsize-setup-local-map'."
551   (setq overriding-terminal-local-map winsize-old-overriding-terminal-local-map)
552   (setq winsize-old-overriding-terminal-local-map nil)
553   (setq overriding-local-map-menu-flag winsize-old-overriding-local-map-menu-flag)
554   (setq winsize-old-overriding-local-map-menu-flag nil))
555
556
557 (defvar winsize-window-config-help nil
558   "Hold window configuration when help is shown.")
559
560 (defvar winsize-window-config-init-help nil
561   "Hold window configuration from resizing start during help.")
562
563 (defvar winsize-help-frame nil
564   "The frame from which help was called.")
565
566 (defun winsize-restore-after-help (buffer)
567   "Restore window configuration after help.
568 Raise frame and reactivate resizing."
569   (remove-hook 'temp-buffer-setup-hook 'winsize-help-mode-hook-function)
570   (setq temp-buffer-show-function winsize-old-temp-buffer-show-function)
571   ;; Get rid of the view exit action and the extra text in the help
572   ;; buffer:
573   (with-current-buffer (help-buffer)
574     (setq view-exit-action winsize-old-view-exit-action)
575     (setq winsize-old-view-exit-action nil)
576     (let ((here (point-marker))
577           (inhibit-read-only t))
578       (goto-char (point-min))
579       (forward-line 2)
580       (delete-region (point-min) (point))
581       (goto-char (point-max))
582       (forward-line -2)
583       (delete-region (point) (point-max))
584       (goto-char here)))
585   ;; Restart resizing, restoring window configurations:
586   (when (select-frame winsize-help-frame)
587     (raise-frame)
588     (set-window-configuration winsize-window-config-help)
589     (resize-windows)
590     (setq winsize-window-config-init winsize-window-config-init-help)))
591
592 (defun winsize-help-mode-hook-function ()
593   "Setup temp buffer show function to only run second step.
594 The first step, `winsize-temp-buffer-show-function', has already been run."
595   (setq temp-buffer-show-function 'winsize-temp-buffer-show-function-1))
596
597 (defun winsize-temp-buffer-show-function (buffer)
598   "First step of setup for showing help during resizing.
599 This step is run when showing help during resizing.
600
601 Save window configuration etc to be able to resume resizing. Stop
602 resizing. Delete other windows.
603
604 Run second step (`winsize-temp-buffer-show-function-1') and
605 arrange so that second step is run when following help links."
606   (setq winsize-window-config-help (current-window-configuration))
607   (setq winsize-window-config-init-help winsize-window-config-init)
608   (setq winsize-help-frame (selected-frame))
609   (winsize-stop)
610   (delete-other-windows)
611   (winsize-temp-buffer-show-function-1 buffer)
612   (add-hook 'temp-buffer-setup-hook 'winsize-help-mode-hook-function))
613
614 (defun winsize-temp-buffer-show-function-1 (buffer)
615   "Second step of setup for showing help during resizing.
616 This is run after the first step when accessing help during
617 resizing. It is also when following help links."
618   (with-current-buffer buffer
619     (let ((inhibit-read-only t)
620           (buffer-read-only t) ;; It is reverted in `help-mode-finish'
621           )
622       (run-hooks 'temp-buffer-show-hook))
623     (let ((here (point-marker))
624           (str "*** Type q to return to window resizing ***"))
625       (put-text-property 0 (length str) 'face 'highlight str)
626       (goto-char (point-min))
627       (insert str "\n\n")
628       (goto-char (point-max))
629       (insert "\n\n" str)
630       (goto-char here)
631       (setq buffer-read-only t))
632     (unless winsize-old-view-exit-action
633       (setq winsize-old-view-exit-action view-exit-action)
634       (setq view-exit-action 'winsize-restore-after-help)))
635   (set-window-buffer (selected-window) buffer)
636   (message "Type q to return to window resizing"))
637
638 (defun winsize-help ()
639   "Give help during resizing.
640 Save current window configuration and pause resizing."
641   (interactive)
642   (if pop-up-frames
643       (progn
644         (winsize-exit-resizing nil)
645         (describe-function 'resize-windows))
646     ;; Fix-me: move setup of view-exit-action etc here. Or was it
647     ;; temp-buffer-show-function?
648     ;; Setup help hooks etc:
649     (unless (or winsize-old-temp-buffer-show-function
650                 ;; These things should not happen... :
651                 (eq temp-buffer-show-function 'winsize-temp-buffer-show-function)
652                 (eq temp-buffer-show-function 'winsize-temp-buffer-show-function-1))
653       (setq winsize-old-temp-buffer-show-function temp-buffer-show-function))
654     (setq temp-buffer-show-function 'winsize-temp-buffer-show-function)
655     (with-output-to-temp-buffer (help-buffer)
656       (with-current-buffer (help-buffer)
657         (insert "resize-windows is ")
658         (describe-function-1 'resize-windows)))))
659
660 (defun winsize-quit ()
661   "Quit resing, restore window configuration at start."
662   (interactive)
663   (set-window-configuration winsize-window-config-init)
664   (winsize-exit-resizing nil))
665
666 (defun winsize-stop-go-back ()
667   "Exit window resizing.  Go back to the window started in."
668   (interactive)
669   (winsize-exit-resizing nil t))
670
671 (defun winsize-stop-and-execute ()
672   "Exit window resizing and put last key on the input queue.
673 Select the window marked during resizing before putting back the
674 last key."
675   ;; Fix-me: maybe replace this with a check of this-command in
676   ;; post-command-hook instead?
677   (interactive)
678   (winsize-exit-resizing t))
679
680 (defun winsize-stop ()
681   "Exit window resizing.
682 Select the window marked during resizing."
683   (interactive)
684   (winsize-exit-resizing nil))
685
686 ;;;###autoload
687 (defun winsize-balance-siblings ()
688   "Make current window siblings the same height or width.
689 It works the same way as `balance-windows', but only for the
690 current window and its siblings."
691   (interactive)
692   (balance-windows (selected-window)))
693
694 (defun winsize-to-border-or-window-left ()
695   "Switch to border leftwards, maybe moving to next window.
696 If already at the left border, then move to left window, the same
697 way `windmove-left' does."
698   (interactive) (winsize-switch-border 'left t))
699
700 (defun winsize-to-border-or-window-right ()
701   "Switch to border rightwards, maybe moving to next window.
702 For more information see `winsize-to-border-or-window-left'."
703   (interactive) (winsize-switch-border 'right t))
704
705 (defun winsize-to-border-or-window-up ()
706   "Switch to border upwards, maybe moving to next window.
707 For more information see `winsize-to-border-or-window-left'."
708   (interactive) (winsize-switch-border 'up t))
709
710 (defun winsize-to-border-or-window-down ()
711   "Switch to border downwards, maybe moving to next window.
712 For more information see `winsize-to-border-or-window-left'."
713   (interactive) (winsize-switch-border 'down t))
714
715
716 (defun winsize-move-border-left ()
717   "Move border left, but select border first if not done."
718   (interactive) (winsize-resize 'left nil))
719
720 (defun winsize-move-border-right ()
721   "Move border right, but select border first if not done."
722   (interactive) (winsize-resize 'right nil))
723
724 (defun winsize-move-border-up ()
725   "Move border up, but select border first if not done."
726   (interactive) (winsize-resize 'up nil))
727
728 (defun winsize-move-border-down ()
729   "Move border down, but select border first if not done."
730   (interactive) (winsize-resize 'down nil))
731
732
733 (defun winsize-move-other-border-left ()
734   "Move border left, but select border first if not done."
735   (interactive) (winsize-resize 'left t))
736
737 (defun winsize-move-other-border-right ()
738   "Move border right, but select border first if not done."
739   (interactive) (winsize-resize 'right t))
740
741 (defun winsize-move-other-border-up ()
742   "Move border up, but select border first if not done."
743   (interactive) (winsize-resize 'up t))
744
745 (defun winsize-move-other-border-down ()
746   "Move border down, but select border first if not done."
747   (interactive) (winsize-resize 'down t))
748
749
750 ;;; Internals
751
752
753
754 (defun winsize-exit-resizing (put-back-last-event &optional stay)
755   "Stop window resizing.
756 Put back mode line colors and keymaps that were changed.
757
758 Upon exit first select window.  If STAY is non-nil then select
759 the window which was selected when `resize-windows' was called,
760 otherwise select the last window used during resizing.  After
761 that, if PUT-BACK-LAST-EVENT is non-nil, put back the last input
762 event on the input queue."
763   (setq winsize-resizing nil)
764   ;; Reset user feedback things:
765   (mouse-avoidance-mode winsize-old-mouse-avoidance-mode)
766   (setq winsize-old-mouse-avoidance-mode nil)
767   (winsize-set-mode-line-colors nil)
768   (winsize-mark-selected-window nil)
769   ;; Remove all hooks etc for help:
770   (if (or (eq winsize-old-temp-buffer-show-function 'winsize-temp-buffer-show-function)
771           (eq winsize-old-temp-buffer-show-function 'winsize-temp-buffer-show-function-1))
772       (setq temp-buffer-show-function nil)
773     (setq temp-buffer-show-function winsize-old-temp-buffer-show-function))
774   (setq winsize-old-temp-buffer-show-function nil)
775   (remove-hook 'help-mode-hook 'winsize-help-mode-hook-function)
776   (remove-hook 'temp-buffer-setup-hook 'winsize-help-mode-hook-function)
777   ;; Restore keymap and command hooks:
778   (winsize-restore-local-map)
779   (winsize-remove-command-hooks)
780   ;; Exit:
781   (when stay (select-window winsize-window-at-entry))
782   (message "Exited window resizing")
783   (when (and put-back-last-event)
784     ;; Add this to the input queue again:
785     (isearch-unread last-command-event)))
786
787 (defun winsize-add-command-hooks ()
788   (add-hook 'pre-command-hook 'winsize-pre-command)
789   (add-hook 'post-command-hook 'winsize-post-command))
790
791 (defun winsize-remove-command-hooks ()
792   (remove-hook 'pre-command-hook 'winsize-pre-command)
793   (remove-hook 'post-command-hook 'winsize-post-command))
794
795
796 ;;; Borders
797
798 (defun winsize-border-used-hor ()
799   "Return the border side used for horizontal resizing."
800   (let ((hor (when winsize-window-for-side-hor
801                (if (eq (selected-window) winsize-window-for-side-hor)
802                    'right
803                  'left))))
804     hor))
805
806 (defun winsize-border-used-ver ()
807   "Return the border side used for vertical resizing."
808   (let ((ver (when winsize-window-for-side-ver
809                (if (eq (selected-window) winsize-window-for-side-ver)
810                    'down
811                  'up))))
812     ver))
813
814 (defun winsize-switch-border (dir allow-windmove)
815   "Switch border that is beeing resized.
816 Switch to border in direction DIR.  If ALLOW-WINDMOVE is non-nil
817 then change window if necessary, otherwise stay and do not change
818 border."
819   (let* ((window-in-that-dir (windmove-find-other-window
820                               dir nil (selected-window))))
821     (when (window-minibuffer-p window-in-that-dir)
822       (setq window-in-that-dir nil))
823     (if winsize-juris-way
824         (if (not window-in-that-dir)
825             (message "No window in that direction")
826           (windmove-do-window-select dir nil))
827       (if (not window-in-that-dir)
828           (message "No window or border in that direction")
829         (let* ((is-hor (memq dir '(left right)))
830                (border-used (if is-hor
831                                 (winsize-border-used-hor)
832                               (winsize-border-used-ver)))
833                (using-dir-border (eq dir border-used)))
834           (if using-dir-border
835               (when allow-windmove
836                 (setq winsize-window-for-side-hor nil)
837                 (setq winsize-window-for-side-ver nil)
838                 (windmove-do-window-select dir nil)
839                 (message "Moved to new window"))
840             (winsize-select-border dir)
841             (message "Switched to border %swards" dir)))))))
842
843
844 (defun winsize-select-initial-border-hor ()
845   "Select a default border horizontally."
846   (if winsize-juris-way
847       (winsize-set-border 'right t)
848     (let ((has-left  (winsize-window-beside (selected-window) 'left))
849           (has-right (winsize-window-beside (selected-window) 'right)))
850       (cond
851        ((not winsize-autoselect-borders) t)
852        ((eq winsize-autoselect-borders 'when-single)
853         (when (= 1 (length (delq nil (list has-left has-right))))
854           (winsize-select-border 'right)))
855        (t
856         (winsize-select-border 'right))))))
857
858 (defun winsize-select-initial-border-ver ()
859   "Select a default border vertically."
860   (if winsize-juris-way
861       (winsize-set-border 'up t)
862     (let ((has-up  (winsize-window-beside (selected-window) 'up))
863           (has-down (winsize-window-beside (selected-window) 'down)))
864       (cond
865        ((not winsize-autoselect-borders) t)
866        ((eq winsize-autoselect-borders 'when-single)
867         (when (= 1 (length (delq nil (list has-up has-down))))
868           (winsize-select-border 'up)))
869        (t
870         (winsize-select-border 'up))))))
871
872 (defun winsize-select-border (dir)
873   "Select border to be set for resizing.
874 The actually setting is done in `post-command-hook'."
875   (cond
876    ((memq dir '(left right))
877     (setq winsize-border-hor dir))
878    ((memq dir '(up down))
879     (setq winsize-border-ver dir))
880    (t (error "Bad DIR=%s" dir))))
881
882 (defun winsize-set-border (dir allow-other-side)
883   "Set border for resizing."
884   (let ((window-beside (winsize-window-beside (selected-window) dir))
885         (horizontal (memq dir '(left right))))
886     (unless window-beside
887       (when allow-other-side
888         (setq dir (winsize-other-side dir))
889         (setq window-beside
890               (winsize-window-beside (selected-window) dir))))
891     (if horizontal
892         (progn
893           (setq winsize-border-hor nil)
894           (setq winsize-window-for-side-hor nil))
895       (setq winsize-border-ver nil)
896       (setq winsize-window-for-side-ver nil))
897     (when window-beside
898       (let ((window-for-side (if (memq dir '(right down))
899                                  (selected-window)
900                                window-beside)))
901         (if horizontal
902             (setq winsize-window-for-side-hor window-for-side)
903           (setq winsize-window-for-side-ver window-for-side))))))
904
905 (defun winsize-resize (dir other-side)
906   "Choose border to move.  Or if border is chosen move that border.
907 Used by `winsize-move-border-left' etc."
908   (when winsize-juris-way
909     (let ((bside (if (memq dir '(left right))
910                      (if other-side 'left 'right)
911                    (if other-side 'up 'down))))
912       (winsize-set-border bside t)))
913   (let* ((horizontal (memq dir '(left right)))
914          (arg (if (memq dir '(left up)) -1 1))
915          (window-for-side (if horizontal 'winsize-window-for-side-hor 'winsize-window-for-side-ver))
916          (window-for-side-val (symbol-value window-for-side)))
917     (if (not window-for-side-val)
918         (winsize-select-border dir)
919       (when (and winsize-resizing
920                  (not (eq window-for-side-val 'checked)))
921         (condition-case err
922             (adjust-window-trailing-edge (symbol-value window-for-side) arg horizontal)
923           (error (message "%s" (error-message-string err))))))))
924
925 (defun winsize-other-side (side)
926   "Return other side for 'left etc, ie 'left => 'right."
927   (cond
928     ((eq side 'left) 'right)
929     ((eq side 'right) 'left)
930     ((eq side 'up) 'down)
931     ((eq side 'down) 'up)
932     (t (error "Invalid SIDE=%s" side))))
933
934 (defun winsize-window-beside (window side)
935   "Return a window directly beside WINDOW at side SIDE.
936 That means one whose edge on SIDE is touching WINDOW.  SIDE
937 should be one of 'left, 'up, 'right and 'down."
938   (require 'windmove)
939   (let* ((windmove-wrap-around nil)
940          (win (windmove-find-other-window side nil window)))
941     (unless (window-minibuffer-p win)
942       win)))
943
944
945 ;;; Window configs
946
947 (defconst winsize-window-configuration-ring (make-ring 20)
948   "Hold window configurations.")
949
950 (defun winsize-ring-rotate (ring forward)
951   (when (< 1 (ring-length ring))
952     (if forward
953         (ring-insert ring (ring-remove ring nil))
954       (ring-insert-at-beginning ring (ring-remove ring 0)))))
955
956 (defun winsize-ring-index (ring elem)
957   (let ((memb (member elem (ring-elements ring))))
958     (when memb
959       (- (ring-length ring)
960          (length memb)))))
961
962 (defun winsize-previous-window-configuration ()
963   (interactive)
964   (winsize-goto-window-configuration nil))
965
966 (defun winsize-next-window-configuration ()
967   (interactive)
968   (winsize-goto-window-configuration t))
969
970 (defun winsize-goto-window-configuration (forward)
971   (let* ((curr-conf (current-window-configuration))
972          (ring winsize-window-configuration-ring)
973          (idx (winsize-ring-index ring curr-conf)))
974     (if idx
975         (progn
976           (setq idx (if forward (1- idx) (1+ idx)))
977           (set-window-configuration (ring-ref ring idx)))
978       ;; Unfortunately idx often seems to be nil so we will have to
979       ;; rotate the ring (or something similar).
980       (winsize-ring-rotate ring forward)
981       (set-window-configuration (ring-ref ring 0)))))
982
983 ;;;###autoload
984 (defun winsize-save-window-configuration ()
985   (interactive)
986   (let* ((curr-conf (current-window-configuration))
987          (ring winsize-window-configuration-ring))
988     (if (winsize-ring-index ring curr-conf)
989         (error "Current configuration was already stored")
990       (ring-insert ring curr-conf)
991       (message "Saved window config, use '<' or '>' to get it back"))))
992
993
994 ;;; User feedback
995
996 ;;;###autoload
997 (defun winsize-set-mode-line-colors (on)
998   "Turn mode line colors on if ON is non-nil, otherwise off."
999   (if on
1000       (progn
1001         (unless winsize-old-mode-line-inactive-bg
1002           (setq winsize-old-mode-line-inactive-bg (face-attribute 'mode-line-inactive :background)))
1003         (unless winsize-old-mode-line-bg
1004           (setq winsize-old-mode-line-bg (face-attribute 'mode-line :background)))
1005         (let* ((use-colors (car winsize-mode-line-colors))
1006                (colors (cadr winsize-mode-line-colors))
1007                (active-color (elt colors 0))
1008                (inactive-color (elt colors 1)))
1009           (when use-colors
1010             (set-face-attribute 'mode-line-inactive nil :background inactive-color)
1011             (set-face-attribute 'mode-line nil :background active-color))))
1012     (when winsize-old-mode-line-inactive-bg
1013       (set-face-attribute 'mode-line-inactive nil :background winsize-old-mode-line-inactive-bg))
1014     (setq winsize-old-mode-line-inactive-bg nil)
1015     (when winsize-old-mode-line-bg
1016       (set-face-attribute 'mode-line nil :background winsize-old-mode-line-bg))
1017     (setq winsize-old-mode-line-bg nil)))
1018
1019 (defvar winsize-short-help-message nil
1020   "Short help message shown in echo area.")
1021
1022 (defun winsize-create-short-help-message ()
1023   "Create short help message to show in echo area."
1024   (let ((msg ""))
1025     (mapc (lambda (rec)
1026             (let ((fun (elt rec 0))
1027                   (desc (elt rec 1))
1028                   (etc (elt rec 2)))
1029               (when (< 0 (length msg))
1030                 (setq msg (concat msg ", ")))
1031               (setq msg (concat msg
1032                                 desc
1033                                 ":"
1034                                 (key-description
1035                                  (where-is-internal fun winsize-keymap t))
1036                                 (if etc " etc" "")))))
1037           '(
1038             (balance-windows "balance" nil)
1039             (winsize-move-border-left "resize" t)
1040             (winsize-to-border-or-window-left "border" nil)
1041             ))
1042     (setq msg (concat msg ", exit:RET, help:?"))
1043     (setq winsize-short-help-message msg)))
1044
1045 (defun winsize-move-mouse-to-resized ()
1046   "Move mouse to show which border(s) are beeing moved."
1047   (let* ((edges (window-edges (selected-window)))
1048          (L (nth 0 edges))
1049          (T (nth 1 edges))
1050          (R (nth 2 edges))
1051          (B (nth 3 edges))
1052          (x (/ (+ L R) 2))
1053          (y (/ (+ T B) 2)))
1054     (when (and winsize-window-for-side-hor
1055                (not (eq winsize-window-for-side-hor 'checked)))
1056       (setq x (if (eq (selected-window) winsize-window-for-side-hor) (- R 6) (+ L 2))))
1057     (when (and winsize-window-for-side-ver
1058                (not (eq winsize-window-for-side-ver 'checked)))
1059       (setq y (if (eq (selected-window) winsize-window-for-side-ver) (- B 2) (+ T 0))))
1060     (set-mouse-position (selected-frame) x y)))
1061
1062 (defvar winsize-selected-window-overlay nil)
1063
1064 (defun winsize-mark-selected-window (active)
1065   (when winsize-selected-window-overlay
1066     (delete-overlay winsize-selected-window-overlay)
1067     (setq winsize-selected-window-overlay nil))
1068   (when active
1069     (with-current-buffer (window-buffer (selected-window))
1070       (let ((ovl (make-overlay (point-min) (point-max) nil t)))
1071         (setq winsize-selected-window-overlay ovl)
1072         (overlay-put ovl 'window (selected-window))
1073         (overlay-put ovl 'pointer 'arrow)
1074         (overlay-put ovl 'priority 1000)
1075         (when winsize-selected-window-face
1076           (overlay-put ovl 'face winsize-selected-window-face))))))
1077
1078 (defun winsize-message-end ()
1079   "Return a marker at the end of the message buffer."
1080   (with-current-buffer (get-buffer-create "*Messages*")
1081     (point-max-marker)))
1082
1083 (defvar winsize-move-mouse 1)
1084
1085 (defvar winsize-make-mouse-prominent-timer nil)
1086
1087 (defun winsize-move-mouse ()
1088   ;;(setq winsize-move-mouse (- winsize-move-mouse))
1089   (save-match-data ;; runs in timer
1090     (let* ((fxy (mouse-pixel-position))
1091            (f (car fxy))
1092            (x (cadr fxy))
1093            (y (cddr fxy))
1094            (m (mod winsize-move-mouse 2))
1095            (d (* (if (= 0 m) 1 -1) 1)))
1096       (set-mouse-pixel-position f (+ d x) (+ d y))
1097       (when (< 1 winsize-move-mouse)
1098         (setq winsize-move-mouse (1- winsize-move-mouse))
1099         (setq winsize-make-mouse-prominent-timer
1100               (run-with-timer 0.2 nil 'winsize-move-mouse))))))
1101
1102 (defun winsize-make-mouse-prominent-f (doit)
1103   (when (and winsize-make-mouse-prominent-timer
1104              (timerp winsize-make-mouse-prominent-timer))
1105     (cancel-timer winsize-make-mouse-prominent-timer))
1106   (when doit
1107     (setq winsize-move-mouse 3)
1108     (setq winsize-make-mouse-prominent-timer
1109           (run-with-idle-timer 0.1 nil 'winsize-move-mouse))))
1110
1111 (defun winsize-tell-user ()
1112   "Give the user feedback."
1113   (when winsize-mark-selected-window
1114     (winsize-mark-selected-window t))
1115   (unless winsize-juris-way
1116     (let ((move-mouse (not (member this-command
1117                                    '(mouse-drag-mode-line
1118                                      mouse-drag-vertical-line
1119                                      scroll-bar-toolkit-scroll)))))
1120       ;;(message "%s, move-mouse=%s" this-command move-mouse);(sit-for 2)
1121       (when move-mouse
1122         (winsize-move-mouse-to-resized))
1123       (when winsize-make-mouse-prominent
1124         (winsize-make-mouse-prominent-f move-mouse))))
1125   (when (= winsize-message-end (winsize-message-end))
1126     (message "%s" winsize-short-help-message)))
1127
1128
1129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1130 ;;; Window rotating and mirroring
1131
1132 ;;;###autoload
1133 (defun winsav-rotate (mirror transpose)
1134   "Rotate window configuration on selected frame.
1135 MIRROR should be either 'mirror-left-right, 'mirror-top-bottom or
1136 nil.  In the first case the window configuration is mirrored
1137 vertically and in the second case horizontally.  If MIRROR is nil
1138 the configuration is not mirrored.
1139
1140 If TRANSPOSE is non-nil then the window structure is transposed
1141 along the diagonal from top left to bottom right (in analogy with
1142 matrix transosition).
1143
1144 If called interactively MIRROR will is 'mirror-left-right by
1145 default, but 'mirror-top-bottom if called with prefix.  TRANSPOSE
1146 is t. This mean that the window configuration will be turned one
1147 quarter clockwise (or counter clockwise with prefix)."
1148   (interactive (list
1149                 (if current-prefix-arg
1150                     'mirror-left-right
1151                   'mirror-top-bottom)
1152                 t))
1153   (require 'winsav)
1154   (let* ((wintree (winsav-get-window-tree))
1155          (tree (cadr wintree))
1156          (win-config (current-window-configuration)))
1157     ;;(winsav-log "old-wintree" wintree)
1158     (winsav-transform-1 tree mirror transpose)
1159     ;;(winsav-log "new-wintree" wintree)
1160     ;;
1161     ;; Fix-me: Stay in corresponding window. How?
1162     (delete-other-windows)
1163     (condition-case err
1164         (winsav-put-window-tree wintree (selected-window))
1165       (error
1166        (set-window-configuration win-config)
1167        (message "Can't rotate: %s" (error-message-string err))))
1168     ))
1169
1170
1171 (provide 'winsize)
1172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1173 ;;; winsize.el ends here