;;; winsize.el --- Interactive window structure editing
;;
;; Description:
;; Author: Lennart Borgman <lennart dot borgman dot 073 at student at lu at se>
;; Maintainer:
;; Created: Wed Dec 07 15:35:09 2005
;; Version: 0.91
;; Last-Updated: Mon Nov 12 19:54:46 2007 (3600 +0100)
;; Keywords:
;; Compatibility:
;;
;; Features that might be required by this library:
;;
;;   None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; This file contains functions for interactive resizing of Emacs
;; windows. To use it put it in your `load-path' and add the following
;; to your .emacs:
;;
;;     (require 'winsize)
;;     (global-set-key [(control x) ?+] 'resize-windows)
;;
;; For more information see `resize-windows'.
;;
;; These functions are a slightly rewritten version of the second part
;; of the second part my proposal for a new `balance-windows' function
;; for Emacs 22. The rewrite is mostly a restructure to more easily
;; add new functions. All functions and variables have been renamed.
;; The file was originally named bw-interactive.el.
;;
;; New ideas for functionality have been to a large part adopted from
;; the Emacs Devel mailing list. Probably most of them originated from
;; Drew Adams and Bastien.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; TODO: Change mouse pointer shape during resizing.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:


;;; Keymap, interactive functions etc

(defconst winsize-keymap
  (let ((map (make-sparse-keymap "Window Resizing")))
    (define-key map [menu-bar bw]
      (cons "Resize" (make-sparse-keymap "second")))
    (define-key map [menu-bar bw shrink]
      '("Shrink to Buffer" . winsize-shrink-window))
    (define-key map [menu-bar bw siblings]
      '("Balance Window Siblings" . winsize-balance-siblings))
    (define-key map [menu-bar bw balance]
      '("Balance Windows" . winsize-balance-windows))

    ;;(define-key map [?+] 'winsize-balance-windows)
    (define-key map [?+] 'balance-windows)
    (define-key map [?=] 'winsize-balance-siblings)
    (define-key map [?-] 'winsize-shrink-window)
    (define-key map [(up)]    'winsize-resize-up)
    (define-key map [(down)]  'winsize-resize-down)
    (define-key map [(left)]  'winsize-resize-left)
    (define-key map [(right)] 'winsize-resize-right)

    (define-key map [?0] 'delete-window)
    (define-key map [?1] 'delete-other-windows)
    (define-key map [?2] 'split-window-vertically)
    (define-key map [?3] 'split-window-horizontally)

    (define-key map [mouse-1] 'mouse-set-point)
    (define-key map [down-mouse-1] 'mouse-set-point)

    (define-key map [??] 'winsize-help)
    (define-key map [(control ?g)]     'winsize-quit)
    (define-key map [(control return)] 'winsize-stop-go-back)
    (define-key map [(return)]         'winsize-stop)
    (define-key map [t]                'winsize-stop-and-execute)
    map)
  "Keymap used by `resize-windows'.")

(defun winsize-pickup-windmove-keys ()
  "Choose keys for moving between borders or windows during resizing.
First the look in `global-map' and see if `windmove-left' etc are
defined there. If so bind the same keys in `winsize-keymap' to
the corresponding commands for moving between borders or windows
during resizing. However if those bindings already are defined in
`winsize-keymap' then do not change them.

If there are no bindings in `global-map' for `windmove-left' etc
then bind M-<arrow keys> for moving between windows."
  (let ((left (or (where-is-internal 'windmove-left global-map t)
                  (setq left [(meta left)])))
        (up (or (where-is-internal 'windmove-up global-map t)
                [(meta up)]))
        (right (or (where-is-internal 'windmove-right global-map t)
                   [(meta right)]))
        (down (or (where-is-internal 'windmove-down global-map t)
                  [(meta down)])))

    (unless (lookup-key winsize-keymap left)  (define-key winsize-keymap left 'winsize-to-border-left))
    (unless (lookup-key winsize-keymap up)    (define-key winsize-keymap up 'winsize-to-border-up))
    (unless (lookup-key winsize-keymap right) (define-key winsize-keymap right 'winsize-to-border-right))
    (unless (lookup-key winsize-keymap down)  (define-key winsize-keymap down 'winsize-to-border-down))))

(defun winsize-pre-command ()
  "Do this before every command.
Runs this in `pre-command-hook'.

Remember the currently used borders for resizing for later use in
`winsize-post-command'."
  (setq winsize-border-hor (winsize-border-used-hor))
  (setq winsize-border-ver (winsize-border-used-ver)))

(defun winsize-post-command ()
  "Done after every command.
Runs this in `post-command-hook'.

Check the borders remembered in `winsize-pre-command' and restore
them if feasable.

Give the user feedback about selected window and borders. Also
give a short help message."
  (unless winsize-border-hor
    (winsize-select-initial-border-hor))
  (when winsize-border-hor
    (winsize-set-border winsize-border-hor t))
  (unless winsize-border-ver
    (winsize-select-initial-border-ver))
  (when winsize-border-ver
    (winsize-set-border winsize-border-ver t))
  (winsize-tell-user))

(defun resize-windows ()
  "Start window resizing.
During resizing a window is selected. You can move its
borders (by default with the arrow keys) and you can select other
borders to move (by default with Meta-arrow keys).

You can also do other window operations, like splitting, deleting
and balancing the sizes. The keybindings below describes the
available operations:

\\<winsize-keymap>\\{winsize-keymap}All other keys exits window resizing and they are also executed.

The colors of the modelines are changed to those given in
`winsize-mode-line-colors' to indicate that you are resizing
windows. To make this indication more prominent the text in the
selected window is marked with the face `secondary-selection'.

As you select other borders or move to new a window the mouse
pointer is moved inside the selected window to show which borders
are beeing moved.

Which borders initially are choosen are controlled by the
variable `winsize-autoselect-borders'."
  (interactive)
  (setq winsize-window-config-init (current-window-configuration))
  (setq winsize-resizing t)
  (winsize-set-mode-line-colors t)
  (setq winsize-window-for-side-hor nil)
  (setq winsize-window-for-side-ver nil)
  (setq winsize-window-at-entry (selected-window))
  (setq winsize-frame (selected-frame))
  (winsize-setup-local-map)
  (winsize-create-short-help-message)
  (winsize-add-command-hooks))


(defun winsize-setup-local-map ()
  "Setup an overriding keymap and use this during resizing.
Save current keymaps."
  ;; Fix-me: use copy-keymap for old?
  (setq winsize-old-overriding-terminal-local-map overriding-terminal-local-map)
  (winsize-pickup-windmove-keys)
  (setq overriding-terminal-local-map (copy-keymap winsize-keymap))
  (setq winsize-old-overriding-local-map-menu-flag overriding-local-map-menu-flag)
  (setq overriding-local-map-menu-flag t))

(defun winsize-restore-local-map ()
  "Restore keymaps saved by `winsize-setup-local-map'."
  (setq overriding-terminal-local-map winsize-old-overriding-terminal-local-map)
  (setq overriding-local-map-menu-flag winsize-old-overriding-local-map-menu-flag))


(defvar winsize-window-config-init nil
  "Holds window configuration that was at resizing start.")

(defvar winsize-window-config-help nil
  "Holds window configuration when help is shown.")

(defun winsize-restore-after-help (buffer)
  "Restore window configuration after help.
Raise frame and reactivate resizing."
  (when (select-frame winsize-frame)
    (raise-frame)
    (set-window-configuration winsize-window-config-help)
    (resize-windows)))

(defun winsize-help ()
  "Give help during resizing.
Save current window configuration and pause resizing."
  (interactive)
  (setq winsize-window-config-help (current-window-configuration))
  (delete-other-windows)
  (with-output-to-temp-buffer (help-buffer)
    (with-current-buffer (help-buffer)
      (help-setup-xref (list #'winsize-hep) (interactive-p))
      (let ((str "*** Type q to return to window resizing ***"))
        (put-text-property 0 (length str) 'face 'highlight str)
        (insert str "\n\n")
        (insert "resize-windows is ")
        (describe-function-1 'resize-windows)
        (insert "\n\n" str))))
  ;; There are two windows shown after the above. Delete current
  ;; window so that only the help buffer is shown. NOTE: This is
  ;; necessary also for the restoring of window structure to work, but
  ;; at the moment it beats me why.
  (delete-window)
  (winsize-stop)
  (setq view-exit-action 'winsize-restore-after-help)
  (message "Type q to return to window resizing"))

(defun winsize-quit ()
  "Quit resing, restore window configuration at start."
  (interactive)
  (set-window-configuration winsize-window-config-init)
  (winsize-exit-resizing nil))

(defun winsize-stop-go-back ()
  "Exit window resizing. Go back to the window started in."
  (interactive)
  (winsize-exit-resizing nil t))

(defun winsize-stop-and-execute ()
  "Exit window resizing and put last key on the input queue.
Select the window marked during resizing before putting back the
last key."
  (interactive)
  (winsize-exit-resizing t))

(defun winsize-stop ()
  "Exit window resizing.
Select the window marked during resizing."
  (interactive)
  (winsize-exit-resizing nil))

(defun winsize-balance-windows ()
;; Fix-me: Currently not used.
  "Make windows same heights or widths and then exit window resizing.
This calls `balance-windows'."
  (interactive)
  (balance-windows)
  (winsize-exit-resizing nil))

(defun winsize-balance-siblings ()
  "Make current window siblings the same height or width."
  (interactive)
  (balance-windows (selected-window)))

(defun winsize-shrink-window ()
  "Shrink the window to be as small as possible to display its contents."
  (interactive)
  (fit-window-to-buffer nil (window-height)))

(defun winsize-to-border-left ()
  "Switch to border leftwards, maybe moving to next window."
  (interactive) (winsize-switch-border 'left t))

(defun winsize-to-border-right ()
  "Switch to border rightwards, maybe moving to next window."
  (interactive) (winsize-switch-border 'right t))

(defun winsize-to-border-up ()
  "Switch to border upwards, maybe moving to next window."
  (interactive) (winsize-switch-border 'up t))

(defun winsize-to-border-down ()
  "Switch to border downwards, maybe moving to next window."
  (interactive) (winsize-switch-border 'down t))

(defun winsize-resize-left ()
  "Move border left, but select border first if not done."
  (interactive) (winsize-resize 'left))

(defun winsize-resize-right ()
  "Move border right, but select border first if not done."
  (interactive) (winsize-resize 'right))

(defun winsize-resize-up ()
  "Move border up, but select border first if not done."
  (interactive) (winsize-resize 'up))

(defun winsize-resize-down ()
  "Move border down, but select border first if not done."
  (interactive) (winsize-resize 'down))


;;; Custom variables

(defcustom winsize-autoselect-borders t
  "Determines how borders are selected by default.
If nil hever select borders automatically (but keep them on the
same side while changing window). If 'when-single select border
automatically if there is only one possible choice. If t alwasy
select borders automatically if they are not selected."
  :type '(choice (const :tag "Always" t)
                 (const :tag "When only one possbility" when-single)
                 (const :tag "Never" nil))
  :group 'winsize)

(defcustom winsize-mode-line-colors (list t (list "green" "green4"))
  "Mode line colors used during resizing."
  :type '(list (boolean :tag "Enable mode line color changes during resizing")
               (list
                (color :tag "- Active window mode line color")
                (color :tag "- Inactive window mode line color")))
  :group 'winsize)

(defcustom winsize-mark-selected-window t
  "Mark selected window if non-nil."
  :type 'boolean
  :group 'winsize)


;;; Internals

(defvar winsize-old-mode-line-bg nil)
(defvar winsize-old-mode-line-inactive-bg nil)
(defvar winsize-old-overriding-terminal-local-map nil)
(defvar winsize-old-overriding-local-map-menu-flag nil)

(defvar winsize-resizing nil
  "t during resizing, nil otherwise.")

(defvar winsize-window-at-entry nil
  "Window that was selected when `resize-windows' started.")

(defvar winsize-frame nil
  "Frame that `resize-windows' is operating on.")


(defun winsize-exit-resizing (put-back-last-event &optional stay)
  "Stop window resizing.
Put back mode line colors and keymaps that was changed.

Upon exit first select window. If STAY is non-nil then select the
window which was selected when `resize-windows' was called,
otherwise select the last window used during resizing. After
that, if PUT-BACK-LAST-EVENT is non-nil, put back the last input
event on the input queue."
  (setq winsize-resizing nil)
  (winsize-set-mode-line-colors nil)
  (winsize-restore-local-map)
  (winsize-remove-command-hooks)
  (when stay (select-window winsize-window-at-entry))
  (winsize-mark-selected-window nil)
  (message "Exited window resizing")
  (when (and put-back-last-event)
    ;; Add this to the input queue again:
    (isearch-unread last-command-event)))

(defun winsize-add-command-hooks ()
  (add-hook 'pre-command-hook 'winsize-pre-command)
  (add-hook 'post-command-hook 'winsize-post-command))

(defun winsize-remove-command-hooks ()
  (remove-hook 'pre-command-hook 'winsize-pre-command)
  (remove-hook 'post-command-hook 'winsize-post-command))


;;; Borders

(defvar winsize-window-for-side-hor nil
  "Window used internally for resizing in vertical direction.")

(defvar winsize-window-for-side-ver nil
  "Window used internally for resizing in horizontal direction.")

(defvar winsize-border-hor nil
  "Used internally to keep border choice on the same side.
This is set by `winsize-pre-command' and checked by
`winsize-post-command'.")

(defvar winsize-border-ver nil
  "Used internally to keep border choice on the same side.
This is set by `winsize-pre-command' and checked by
`winsize-post-command'.")

(defun winsize-border-used-hor()
  "Return the border side used for horizontal resizing."
  (let ((hor (when winsize-window-for-side-hor
               (if (eq (selected-window) winsize-window-for-side-hor)
                   'right
                 'left))))
    hor))

(defun winsize-border-used-ver()
  "Return the border side used for vertical resizing."
  (let ((ver (when winsize-window-for-side-ver
               (if (eq (selected-window) winsize-window-for-side-ver)
                   'down
                 'up))))
    ver))

(defun winsize-switch-border (dir allow-windmove)
  "Switch border that is beeing resized.
Switch to border in direction DIR. If ALLOW-WINDMOVE is non-nil
then change window if necessary, otherwise stay and do not change
border."
  (let* ((window-in-that-dir (windmove-find-other-window
                              dir nil (selected-window))))
    (when (window-minibuffer-p window-in-that-dir)
      (setq window-in-that-dir nil))
    (when window-in-that-dir
      (let* ((is-hor (memq dir '(left right)))
             (border-used (if is-hor
                             (winsize-border-used-hor)
                           (winsize-border-used-ver)))
             (using-dir-border (eq dir border-used)))
        (when (and using-dir-border
                   allow-windmove)
          (setq winsize-window-for-side-hor nil)
          (setq winsize-window-for-side-ver nil)
          (windmove-do-window-select dir nil))
        (winsize-select-border dir)))))


(defun winsize-select-initial-border-hor ()
  "Select a default border horizontally."
  (let ((has-left  (winsize-window-beside (selected-window) 'left))
        (has-right (winsize-window-beside (selected-window) 'right)))
    (cond
     ((not winsize-autoselect-borders) t)
     ((eq winsize-autoselect-borders 'when-single)
      (when (= 1 (length (delq nil (list has-left has-right))))
        (winsize-select-border 'right)))
     (t
      (winsize-select-border 'right)))))

(defun winsize-select-initial-border-ver ()
  "Select a default border vertically."
  (let ((has-up  (winsize-window-beside (selected-window) 'up))
        (has-down (winsize-window-beside (selected-window) 'down)))
    (cond
     ((not winsize-autoselect-borders) t)
     ((eq winsize-autoselect-borders 'when-single)
      (when (= 1 (length (delq nil (list has-left has-up))))
        (winsize-select-border 'up)))
     (t
      (winsize-select-border 'up)))))

(defun winsize-select-border (dir)
  "Select border to be set for resizing.
The actually setting is done in `post-command-hook'."
  (cond
   ((memq dir '(left right))
    (setq winsize-border-hor dir))
   ((memq dir '(up down))
    (setq winsize-border-ver dir))
   (t (error "Bad DIR=%s" dir))))

(defun winsize-set-border (dir allow-other-side)
  "Set border for resizing.
This should be done in `post-command-hook'."
  (let ((window-beside (winsize-window-beside (selected-window) dir))
        (horizontal (memq dir '(left right))))
    (unless window-beside
      (when allow-other-side
        (setq dir (winsize-other-side dir))
        (setq window-beside
              (winsize-window-beside (selected-window) dir))))
    (if horizontal
        (progn
          (setq winsize-border-hor nil)
          (setq winsize-window-for-side-hor nil))
      (setq winsize-border-ver nil)
      (setq winsize-window-for-side-ver nil))
    (when window-beside
      (let ((window-for-side (if (memq dir '(right down))
                                 (selected-window)
                               window-beside)))
        (if horizontal
            (setq winsize-window-for-side-hor window-for-side)
          (setq winsize-window-for-side-ver window-for-side))))))

(defun winsize-resize (dir)
  "Choose border to move. Or if border is chosen move that border.
Used by `winsize-resize-left' etc."
  (let* ((horizontal (memq dir '(left right)))
         (arg (if (memq dir '(left up)) -1 1))
         (window-for-side (if horizontal 'winsize-window-for-side-hor 'winsize-window-for-side-ver))
         (window-for-side-val (symbol-value window-for-side)))
    (if (not window-for-side-val)
        (winsize-select-border dir)
      (when (and winsize-resizing
                 (not (eq window-for-side-val 'checked)))
        (condition-case err
            (adjust-window-trailing-edge (symbol-value window-for-side) arg horizontal)
          (error (message "%s" (error-message-string err))))))))

(defun winsize-other-side (side)
  "Return other side for 'left etc, ie 'left => 'right."
  (cond
    ((eq side 'left) 'right)
    ((eq side 'right) 'left)
    ((eq side 'up) 'down)
    ((eq side 'down) 'up)
    (t (error "Invalid SIDE=%s" side))))

(defun winsize-window-beside (window side)
  "Return a window directly beside WINDOW at side SIDE.
That means one whose edge on SIDE is touching WINDOW.  SIDE
should be one of 'left, 'up, 'right and 'down."
  (require 'windmove)
  (let* ((windmove-wrap-around nil)
         (win (windmove-find-other-window side nil window)))
    (unless (window-minibuffer-p win)
      win)))


;;; User feedback

(defun winsize-set-mode-line-colors (on)
  "Turn mode line colors on if ON is non-nil, otherwise off."
  (when on
    (setq winsize-old-mode-line-inactive-bg (face-attribute 'mode-line-inactive :background))
    (setq winsize-old-mode-line-bg (face-attribute 'mode-line :background)))
  (if on
      (let* ((use-colors (car winsize-mode-line-colors))
             (colors (cadr winsize-mode-line-colors))
             (active-color (elt colors 0))
             (inactive-color (elt colors 1)))
        (when use-colors
          (set-face-attribute 'mode-line-inactive nil :background inactive-color)
          (set-face-attribute 'mode-line nil :background active-color)))
    (set-face-attribute 'mode-line-inactive nil :background winsize-old-mode-line-inactive-bg)
    (set-face-attribute 'mode-line nil :background winsize-old-mode-line-bg)))

(defvar winsize-short-help-message nil
  "Short help message shown in echo area.")

(defun winsize-create-short-help-message ()
  "Create short help message to show in echo area."
  (let ((msg ""))
    (mapc (lambda (rec)
            (let ((fun (elt rec 0))
                  (desc (elt rec 1))
                  (etc (elt rec 2)))
              (when (< 0 (length msg))
                (setq msg (concat msg ", ")))
              (setq msg (concat msg
                                desc
                                ":"
                                (key-description
                                 (where-is-internal fun winsize-keymap t))
                                (if etc " etc" "")))))
          '(
            (balance-windows "balance" nil)
            (winsize-resize-left "resize" t)
            (winsize-to-border-left "border" nil)
            ))
    (setq msg (concat msg ", exit:RET, help:?"))
    (setq winsize-short-help-message msg)))

(defun winsize-move-mouse-to-resized ()
  "Move mouse to show which border(s) are beeing moved."
  (let* ((edges (window-edges (selected-window)))
         (L (nth 0 edges))
         (T (nth 1 edges))
         (R (nth 2 edges))
         (B (nth 3 edges))
         (x (/ (+ L R) 2))
         (y (/ (+ T B) 2)))
    (when (and winsize-window-for-side-hor
               (not (eq winsize-window-for-side-hor 'checked)))
      (setq x (if (eq (selected-window) winsize-window-for-side-hor) (- R 6) (+ L 2))))
    (when (and winsize-window-for-side-ver
               (not (eq winsize-window-for-side-ver 'checked)))
      (setq y (if (eq (selected-window) winsize-window-for-side-ver) (- B 2) (+ T 0))))
    (set-mouse-position (selected-frame) x y)))

(defvar winsize-selected-window-overlay nil)

(defun winsize-mark-selected-window (active)
  (when winsize-selected-window-overlay
    (delete-overlay winsize-selected-window-overlay)
    (setq winsize-selected-window-overlay nil))
  (when active
    (with-current-buffer (window-buffer (selected-window))
      (let ((ovl (make-overlay (point-min) (point-max))))
        (setq winsize-selected-window-overlay ovl)
        (overlay-put ovl 'window (selected-window))
        (overlay-put ovl 'pointer 'arrow)
        (overlay-put ovl 'priority 1000)
        (overlay-put ovl 'face 'secondary-selection)))))

(defun winsize-tell-user ()
  "Give the user feedback."
  (when winsize-mark-selected-window
    (winsize-mark-selected-window t))
  (winsize-move-mouse-to-resized)
  (message "%s" winsize-short-help-message))


(provide 'winsize)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; winsize.el ends here