;; win-align.jl -- Move/grow/shrink windows to align with other windows

;; Copyright (C) 2008, Scott Frazer <frazer.scott@gmail.com>

;; This file 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.

;; sawfish 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 sawfish; see the file COPYING.  If not, write to the Free Software
;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; This package provides functions to move, grow, or shrink a window to be
;; aligned with other windows or the edge of the screen.

(define-structure sawfish.wm.commands.win-align

    (export win-align-move-up
            win-align-move-down
            win-align-move-left
            win-align-move-right
            win-align-grow-top
            win-align-grow-bottom
            win-align-grow-left
            win-align-grow-right
            win-align-shrink-top
            win-align-shrink-bottom
            win-align-shrink-left
            win-align-shrink-right)

    (open rep
          sawfish.wm.windows
          sawfish.wm.events
          sawfish.wm.misc
          sawfish.wm.state.maximize
          sawfish.wm.state.iconify
          sawfish.wm.state.ignored
          sawfish.wm.custom
          sawfish.wm.commands
          sawfish.wm.focus
          sawfish.wm.workspace
          sawfish.wm.util.stacking)

  (define-structure-alias win-align sawfish.wm.commands.win-align)

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define (win-align-move-up win)
    "Moves the window up, aligning with the next window border or until
it reaches the top edge."
    (let* ((top-distance (win-align-distance-to-next-edge win 'top nil))
           (bottom-distance (win-align-distance-to-next-edge win 'bottom nil))
           (distance (if (and top-distance bottom-distance)
                         (max top-distance bottom-distance)
                       (or top-distance bottom-distance)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-top (nth 1 w-corners)))
      (if (or (not distance)
              (< (+ w-top distance) 0))
          (move-window-to win w-left 0)
        (move-window-to win w-left (+ w-top distance)))))

  (define (win-align-move-down win)
    "Moves the window down, aligning with the next window border or until
it reaches the bottom edge."
    (let* ((top-distance (win-align-distance-to-next-edge win 'top t))
           (bottom-distance (win-align-distance-to-next-edge win 'bottom t))
           (distance (if (and top-distance bottom-distance)
                         (min top-distance bottom-distance)
                       (or top-distance bottom-distance)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-top (nth 1 w-corners))
           (w-bottom (nth 3 w-corners)))
      (if (or (not distance)
              (> (+ w-bottom distance) (screen-height)))
          (move-window-to win w-left (- (screen-height) (cdr (window-frame-dimensions win))))
        (move-window-to win w-left (+ w-top distance)))))

  (define (win-align-move-left win)
    "Moves the window left, aligning with the next window border or until
it reaches the left edge."
    (let* ((left-distance (win-align-distance-to-next-edge win 'left nil))
           (right-distance (win-align-distance-to-next-edge win 'right nil))
           (distance (if (and left-distance right-distance)
                         (max left-distance right-distance)
                       (or left-distance right-distance)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-top (nth 1 w-corners)))
      (if (or (not distance)
              (< (+ w-left distance) 0))
          (move-window-to win 0 w-top)
        (move-window-to win (+ w-left distance) w-top))))

  (define (win-align-move-right win)
    "Moves the window right, aligning with the next window border or until
it reaches the right edge."
    (let* ((left-distance (win-align-distance-to-next-edge win 'left t))
           (right-distance (win-align-distance-to-next-edge win 'right t))
           (distance (if (and left-distance right-distance)
                         (min left-distance right-distance)
                       (or left-distance right-distance)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-top (nth 1 w-corners))
           (w-right (nth 2 w-corners)))
      (if (or (not distance)
              (> (+ w-right distance) (screen-width)))
          (move-window-to win (- (screen-width) (car (window-frame-dimensions win))) w-top)
        (move-window-to win (+ w-left distance) w-top))))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define (win-align-grow-top win)
    "Grows the top edge of the window to the next window border or until
it reaches the top edge."
    (let* ((distance (win-align-distance-to-next-edge win 'top nil))
           (w-dim (window-frame-dimensions win))
           (w-excess (win-align-get-frame-excess win))
           (w-width (- (car w-dim) (car w-excess)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-top (if (not distance)
                      0
                    (+ (nth 1 w-corners) distance)))
           (w-bottom (nth 3 w-corners))
           (w-height (if (not distance)
                         (- w-bottom (cdr w-excess))
                       (- (cdr w-dim) distance (cdr w-excess)))))
      (win-align-move-and-resize win w-left w-top w-width w-height)))

  (define (win-align-grow-bottom win)
    "Grows the bottom edge of the window to the next window border or until
it reaches the bottom edge."
    (let* ((distance (win-align-distance-to-next-edge win 'bottom t))
           (w-dim (window-frame-dimensions win))
           (w-excess (win-align-get-frame-excess win))
           (w-width (- (car w-dim) (car w-excess)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-top (nth 1 w-corners))
           (w-height (if (not distance)
                         (- (screen-height) w-top (cdr w-excess))
                       (- (+ (cdr w-dim) distance) (cdr w-excess)))))
      (win-align-move-and-resize win w-left w-top w-width w-height)))

  (define (win-align-grow-left win)
    "Grows the left edge of the window to the next window border or until
it reaches the left edge."
    (let* ((distance (win-align-distance-to-next-edge win 'left nil))
           (w-dim (window-frame-dimensions win))
           (w-excess (win-align-get-frame-excess win))
           (w-height (- (cdr w-dim) (cdr w-excess)))
           (w-corners (win-align-get-corners win))
           (w-left (if (not distance)
                       0
                     (+ (nth 0 w-corners) distance)))
           (w-top (nth 1 w-corners))
           (w-right (nth 2 w-corners))
           (w-width (if (not distance)
                        (- w-right (car w-excess))
                      (- (car w-dim) distance (car w-excess)))))
      (win-align-move-and-resize win w-left w-top w-width w-height)))

  (define (win-align-grow-right win)
    "Grows the right edge of the window to the next window border or until
it reaches the right edge."
    (let* ((distance (win-align-distance-to-next-edge win 'right t))
           (w-dim (window-frame-dimensions win))
           (w-excess (win-align-get-frame-excess win))
           (w-height (- (cdr w-dim) (cdr w-excess)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-top (nth 1 w-corners))
           (w-width (if (not distance)
                        (- (screen-width) w-left (car w-excess))
                      (- (+ (car w-dim) distance) (car w-excess)))))
      (win-align-move-and-resize win w-left w-top w-width w-height)))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define (win-align-shrink-top win)
    "Shrinks the top edge of the window to the next window border or makes
the window half size."
    (let* ((distance (win-align-distance-to-next-edge win 'top t))
           (w-dim (window-frame-dimensions win))
           (w-excess (win-align-get-frame-excess win))
           (w-width (- (car w-dim) (car w-excess)))
           (w-height (if (or (not distance)
                             (> distance (- (cdr w-dim) 20)))
                         (/ (cdr w-dim) 2)
                       (- (cdr w-dim) distance)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-bottom (nth 3 w-corners)))
      (win-align-move-and-resize win w-left (- w-bottom w-height) w-width (- w-height (cdr w-excess)))))


  (define (win-align-shrink-bottom win)
    "Shrinks the bottom edge of the window to the next window border or makes
the window half size."
    (let* ((distance (win-align-distance-to-next-edge win 'bottom nil))
           (w-dim (window-frame-dimensions win))
           (w-excess (win-align-get-frame-excess win))
           (w-width (- (car w-dim) (car w-excess)))
           (w-height (if (or (not distance)
                             (> (abs distance) (- (cdr w-dim) 20)))
                         (/ (cdr w-dim) 2)
                       (+ (cdr w-dim) distance)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-top (nth 1 w-corners)))
      (win-align-move-and-resize win w-left w-top w-width (- w-height (cdr w-excess)))))


  (define (win-align-shrink-left win)
    "Shrinks the left edge of the window to the next window border or makes
the window half size."
    (let* ((distance (win-align-distance-to-next-edge win 'left t))
           (w-dim (window-frame-dimensions win))
           (w-excess (win-align-get-frame-excess win))
           (w-height (- (cdr w-dim) (cdr w-excess)))
           (w-width (if (or (not distance)
                            (> distance (- (car w-dim) 20)))
                        (/ (car w-dim) 2)
                      (- (car w-dim) distance)))
           (w-corners (win-align-get-corners win))
           (w-top (nth 1 w-corners))
           (w-right (nth 2 w-corners)))
      (win-align-move-and-resize win (- w-right w-width) w-top (- w-width (car w-excess)) w-height)))


  (define (win-align-shrink-right win)
    "Shrinks the right edge of the window to the next window border or makes
the window half size."
    (let* ((distance (win-align-distance-to-next-edge win 'right nil))
           (w-dim (window-frame-dimensions win))
           (w-excess (win-align-get-frame-excess win))
           (w-height (- (cdr w-dim) (cdr w-excess)))
           (w-width (if (or (not distance)
                            (> (abs distance) (- (car w-dim) 20)))
                        (/ (car w-dim) 2)
                      (+ (car w-dim) distance)))
           (w-corners (win-align-get-corners win))
           (w-left (nth 0 w-corners))
           (w-top (nth 1 w-corners)))
      (win-align-move-and-resize win w-left w-top (- w-width (car w-excess)) w-height)))


  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define (win-align-distance-to-next-edge win edge positive)
    "Find the distance to the next edge using WIN EDGE.
POSITIVE non-nil means positive direction, nil means negative direction."
    (let* ((vertical (memq edge '(left right)))
           (w-corners (win-align-get-corners win))
           w-left w-top w-right w-bottom w-edge
           x-corners x-left x-top x-right x-bottom
           distance)
      (if vertical
          (progn
            (setq w-left (nth 0 w-corners))
            (setq w-top (nth 1 w-corners))
            (setq w-right (nth 2 w-corners))
            (setq w-bottom (nth 3 w-corners)))
        (setq w-left (nth 1 w-corners))
        (setq w-top (nth 0 w-corners))
        (setq w-right (nth 3 w-corners))
        (setq w-bottom (nth 2 w-corners)))
      (setq w-edge (if (memq edge '(left top)) w-left w-right))
      (mapc (lambda (x)
              (when (and (not (eq x win))
                         (not (window-iconified-p x))
                         (window-appears-in-workspace-p x current-workspace))
                (setq x-corners (win-align-get-corners x))
                (if vertical
                    (progn
                      (setq x-left (nth 0 x-corners))
                      (setq x-top (nth 1 x-corners))
                      (setq x-right (nth 2 x-corners))
                      (setq x-bottom (nth 3 x-corners)))
                  (setq x-left (nth 1 x-corners))
                  (setq x-top (nth 0 x-corners))
                  (setq x-right (nth 3 x-corners))
                  (setq x-bottom (nth 2 x-corners)))
                (unless (or (<= w-bottom x-top)
                            (>= w-top x-bottom))
                  (setq distance (win-align-get-closer-distance w-edge x-left distance positive))
                  (setq distance (win-align-get-closer-distance w-edge x-right distance positive)))))
            (managed-windows))
      distance))

  (define (win-align-get-corners win)
    "Get the corners (left top right bottom) of WIN"
    (let* ((w-pos (window-position win))
           (w-dim (window-frame-dimensions win))
           (w-left (car w-pos))
           (w-top (cdr w-pos)))
      (list w-left w-top (+ w-left (car w-dim)) (+ w-top (cdr w-dim)))))

  (define (win-align-get-closer-distance w-edge x-edge distance positive)
    "Get the closer of distance from W-EDGE to X-EDGE or DISTANCE.
POSITIVE non-nil means positive direction, nil means negative direction."
    (let ((cmp_op1 (if positive > <))
          (cmp_op2 (if positive < >))
          edge-distance)
      (setq edge-distance (- x-edge w-edge))
      (when (and (cmp_op1 edge-distance 0)
                 (or (not distance)
                     (cmp_op2 edge-distance distance)))
        (setq distance edge-distance)))
    distance)

  (define (win-align-get-frame-excess win)
    "Get the excess width and hieght of a window."
    (let ((w-frame-dim (window-frame-dimensions win))
          (w-dim (window-dimensions win)))
      (cons (- (car w-frame-dim) (car w-dim)) (- (cdr w-frame-dim) (cdr w-dim)))))

  (define (win-align-move-and-resize win w-left w-top w-width w-height)
    "Move and resize window with hinting."
    (let ((tmp (cons w-width w-height)))
      (maximize-truncate-dims win tmp)
      (setq w-width (car tmp))
      (setq w-height (cdr tmp)))
    (move-resize-window-to win w-left w-top w-width w-height))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  ;;###autoload
  (define-command 'win-align-move-up win-align-move-up #:spec "%W")
  (define-command 'win-align-move-down win-align-move-down #:spec "%W")
  (define-command 'win-align-move-left win-align-move-left #:spec "%W")
  (define-command 'win-align-move-right win-align-move-right #:spec "%W")
  (define-command 'win-align-grow-top win-align-grow-top #:spec "%W")
  (define-command 'win-align-grow-bottom win-align-grow-bottom #:spec "%W")
  (define-command 'win-align-grow-left win-align-grow-left #:spec "%W")
  (define-command 'win-align-grow-right win-align-grow-right #:spec "%W")
  (define-command 'win-align-shrink-top win-align-shrink-top #:spec "%W")
  (define-command 'win-align-shrink-bottom win-align-shrink-bottom #:spec "%W")
  (define-command 'win-align-shrink-left win-align-shrink-left #:spec "%W")
  (define-command 'win-align-shrink-right win-align-shrink-right #:spec "%W"))