;; corner.jl -- move windows into screen corners
;; $Id: corner.jl,v 1.8 2001/11/23 16:12:06 grossjoh Exp $

;; Copyright (C) 2000 Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>

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

;; sawmill 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 sawmill; 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 a window into a screen
;; corner.  When moving into a corner, this package tries to avoid
;; windows which should be avoided.  This is useful if you have a
;; Gnome panel or a similar window: these windows will be avoided.  I
;; think using this is cleaner than hard-coding the positions into
;; your ~/.sawmillrc file (which is what I was doing before).

;; Installation is easy: put this file into a directory which is on
;; your load-path, add (require 'corner) to your ~/.sawmillrc, and
;; call the commands `corner-upper-left', `corner-lower-left',
;; `corner-upper-right' and `corner-lower-right'.

;; Variables.

(defvar corner-avoid-predicates
  (list window-avoided-p window-sticky-p)
  "If any of these matches a window, it will be avoided.
This should be a list of functions.  Each function should take one
argument, a window.  Each function should return non-nil when the
window is to be avoided.")

(defvar corner-warp warp-to-selected-windows
  "If non-nil, warp point to window after move.")

;; Entry points.

(defun corner-upper-left (w)
  "Move window to upper left corner."
  (interactive "%W")
  (corner-move-to w nil nil))

(defun corner-lower-left (w)
  "Move window to lower left corner."
  (interactive "%W")
  (corner-move-to w nil t))

(defun corner-upper-right (w)
  "Move window to upper right corner."
  (interactive "%W")
  (corner-move-to w t nil))

(defun corner-lower-right (w)
  "Move window to lower right corner."
  (interactive "%W")
  (corner-move-to w t t))

;; Implementation.

;; horiz-edge is (X1 X2 Y); vert-edge is (X Y1 Y2)

(require 'rects)

(defun corner-edges-intersection (horizontal vertical)
  "Computes the intersection point of the two edges.
Returns nil if the edges don't intersect."
  (let ((hx1 (nth 0 horizontal))
        (hx2 (nth 1 horizontal))
        (hy  (nth 2 horizontal))
        (vx  (nth 0 vertical))
        (vy1 (nth 1 vertical))
        (vy2 (nth 2 vertical)))
    (when (and (<= hx1 vx) (<= vx hx2)
               (<= vy1 hy) (<= hy vy2))
      (cons vx hy))))

(defun corner-intersect-edges (horizontal vertical)
  "Returns a list of points where the HORIZONTAL and VERTICAL edges
intersect.  HORIZONTAL and VERTICAL are lists of edges."
  (apply append
         (mapcar (lambda (h)
                   (delete nil
                           (mapcar (lambda (v)
                                     (corner-edges-intersection h v))
                                   vertical)))
                 horizontal)))

(defun corner-horizontal-edges-from-windows (wlist bottomp)
  "Returns a list of horizontal window edges from WLIST.
Returns top edges if BOTTOMP is nil, bottom edges otherwise."
  (mapcar (lambda (w)
            (let* ((wpos (window-position w))
                   (wdim (window-frame-dimensions w))
                   (wleft (car wpos))
                   (wtop  (cdr wpos))
                   (wright (+ wleft (car wdim)))
                   (wbottom (+ wtop (cdr wdim))))
              (list wleft wright
                    (if bottomp wbottom wtop))))
          wlist))

(defun corner-vertical-edges-from-windows (wlist rightp)
  "Returns a list of vertical window edges from WLIST.
Returns left edges if RIGHTP is nil, right edges otherwise."
  (mapcar (lambda (w)
            (let* ((wpos (window-position w))
                   (wdim (window-frame-dimensions w))
                   (wleft (car wpos))
                   (wtop  (cdr wpos))
                   (wright (+ wleft (car wdim)))
                   (wbottom (+ wtop (cdr wdim))))
              (list (if rightp wright wleft)
                    wtop wbottom)))
          wlist))

(defun corner-candidate-p (w point wlist rightp bottomp)
  "Returns whether window W could be placed at POINT without overlapping
any of the windows in WLIST.  If RIGHTP is nil, a left corner of the window
is placed there, else a right corner.  If BOTTOMP is nil, a top corner is
placed there, else a bottom corner."
  (let* ((wdim (window-frame-dimensions w))
         (wwidth (car wdim))
         (wheight (cdr wdim))
         (top (if bottomp (- (cdr point) wheight) (cdr point)))
         (left (if rightp (- (car point) wwidth) (car point)))
         (overlaps (mapcar (lambda (x)
                             (rect-2d-overlap*
                              (list left top (+ left wwidth) (+ top wheight))
                              (let* ((xdim (window-frame-dimensions x))
                                     (xpos (window-position x))
                                     (xleft (car xpos))
                                     (xtop (cdr xpos))
                                     (xright (+ xleft (car xdim)))
                                     (xbottom (+ xtop (cdr xdim))))
                                (list xleft xtop xright xbottom))))
                           wlist)))
    (and (not (filter (lambda (x) (> x 0)) overlaps))
         ;; Window needs to fit completely on screen.
         (>= top 0) (>= left 0)
         (<= (+ top wheight) (screen-height))
         (<= (+ left wwidth) (screen-width)))))

(defun corner-candidate-quality (w point rightp bottomp)
  "Returns the quality of POINT for the specified corner.
Lower numbers mean higher quality.
If RIGHTP is nil, it's a left corner, else a right corner.
If BOTTOMP is nil, it's a top corner, else a bottom corner.

Current implementation: sum of X and Y distances."
  (let* ((wdim (window-frame-dimensions w))
	 (wwidth (car wdim))
	 (wheight (cdr wdim)))
    (+ (* wheight (if rightp  (- (screen-width)  (car point)) (car point)))
       (* wwidth  (if bottomp (- (screen-height) (cdr point)) (cdr point))))))

(defun corner-position (w rightp bottomp)
  "Positions window W in a corner, not overlapping any avoided windows.
If RIGHTP is nil, it's a left corner, else a right corner.
If BOTTOMP is nil, it's a top corner, else a bottom corner."
  (let* ((wdim (window-frame-dimensions w))
         (wwidth (car wdim))
         (wheight (cdr wdim))
         (wlist (filter (lambda (x)
                          (and (eval `(or
				       ,@(mapcar (lambda (f)
						   (funcall f x))
						 corner-avoid-predicates)))
                               (window-appears-in-workspace-p
                                x current-workspace)))
                        (managed-windows)))
         (hedges
          (append (list (list 0 (screen-width) 0)
                        (list 0 (screen-width) (screen-height)))
                  (corner-horizontal-edges-from-windows wlist (not bottomp))))
         (vedges
          (append (list (list 0 0 (screen-height))
                        (list (screen-width) 0 (screen-height)))
                  (corner-vertical-edges-from-windows wlist (not rightp))))
         (points (corner-intersect-edges hedges vedges))
         (candidates (filter (lambda (p)
                               (corner-candidate-p w p wlist rightp bottomp))
                             points))
         cand xpos ypos qual)
    (if (null candidates)
        (progn
          (setq xpos (if rightp (screen-width) 0))
          (setq ypos (if bottomp (screen-height) 0)))
      (setq cand (car candidates))
      (setq candidates (cdr candidates))
      (setq xpos (car cand))
      (setq ypos (cdr cand))
      (setq qual (corner-candidate-quality w cand rightp bottomp))
      (while candidates
        (setq cand (car candidates))
        (setq candidates (cdr candidates))
        (when (< (corner-candidate-quality w cand rightp bottomp) qual)
          (setq xpos (car cand))
          (setq ypos (cdr cand))
          (setq qual (corner-candidate-quality w cand rightp bottomp)))))
    (cons (if rightp (- xpos wwidth) xpos)
          (if bottomp (- ypos wheight) ypos))))

(defun corner-move-to (w rightp bottomp)
  "Move window to indicated corner.
If RIGHTP is nil, it's a left corner, otherwise a right corner.
If BOTTOMP is nil, it's a top corner, otherwise a bottom corner."
  (let* ((pos (corner-position w rightp bottomp))
         (horizontal (/= (car pos) (car (window-position w))))
         (vertical   (/= (cdr pos) (cdr (window-position w)))))
    (move-window-to w (car pos) (cdr pos))
    (when corner-warp
      (raise-window w)
      (warp-cursor-to-window w warp-to-window-x-offset warp-to-window-y-offset))
    (call-window-hook 'after-move-hook w
                      (list (delete nil (list (when horizontal 'horizontal)
                                              (when vertical 'vertical)))))))

(provide 'corner)

;; Local Variables:
;; compile-command: "sawfish --batch -l compiler -f compile-batch corner.jl"
;; End:
;; corner.jl ends here.