;;;
;;; minbuf.el
;;;
;;; make the minibuffer screen stay attached to the bottom
;;; of a particular window. the minibuffer takes on the same
;;; width and font as the screen it's attached to; it's height
;;; is unaltered.
;;;
;;; the function "anchor-minibuffer-to-selected-screen" can be used
;;; interactively to attach the minibuffer to the current screen
;;;
;;; if the variable *minibuffer-sticks-to-selected-screen-p* is
;;; non-null, the minibuffer follows the focus (i.e. it attaches
;;; itself to whichever screen has the input focus).
;;;
;;; this file should be loaded after epoch.el, as it hacks the
;;; event-alist and handle-focus-change
;;;
;;; Original author unknown.
;;; Contributed by Dan L. Pierson, pierson@encore.com
;;; Reworked by Alan Carroll and Chris Love
;;;

(require 'cl)

(defvar *minibuffer-anchor-screen* (current-screen)
  "The screen that the minibuffer sticks to.")

(defvar *minibuffer-sticks-to-selected-screen-p* t
  "If non-null, causes the minibuffer to follow the input focus.")

(defvar *minibuffer-anchor-inhibit* nil)

(defun handle-move-event (type event screen)
  (setq *minibuffer-anchor-screen* (current-screen))
  (if *minibuffer-sticks-to-selected-screen-p*
    (cond
      ((eq screen *minibuffer-anchor-screen*)
	(move-minibuffer-screen-with-anchor-screen)
	(setq *minibuffer-anchor-inhibit* nil)
      )
      ((and (not *minibuffer-anchor-inhibit*) (eq screen (minibuf-screen)))
	(move-minibuffer-screen-with-anchor-screen)
	(setq *minibuffer-anchor-inhibit* t)
      )
      (t (setq *minibuffer-anchor-inhibit* nil)
      )))
  (on-event::handler type event screen))

(push-event 'move 'handle-move-event)

(defun handle-resize-event (type event screen)
  (setq *minibuffer-anchor-screen* (current-screen))
  (and *minibuffer-sticks-to-selected-screen-p*
    (when
      (or
	(eq screen *minibuffer-anchor-screen*)
	(eq screen (minibuf-screen))
      )
      (resize-minibuffer-screen-with-anchor-screen)))
  (on-event::handler type event screen))

(push-event 'resize 'handle-resize-event)

;;; --------------------------------------------------------------------------
(defvar minibuf-delta-x 0)
(defvar minibuf-delta-y 0)

(defun backing-screen-info (&optional win)
"Return the screen information for the backing X-window of the given screen"
  (setq win (or win (current-screen)))
  (let ((parent nil)
	(root   nil)
	(wlist  nil))
    (while (and (setq wlist (query-tree win))
		(setq parent (cadr wlist))
		(setq root   (car wlist))
		(not (equal root parent)))
      (setq win parent))
    (and parent (screen-information win))))

(defun wm-location-delta (&optional win)
"Given optional SCREEN-OR-XWIN, this function returns a list of (DX DY)
for how much the window manager changes move-screen requests."
  (setq win (or win (current-screen)))
  (let
    (
      (start-info (screen-information win))
      x y dx dy info
    )
    (move-screen 0 0 win)		;move it to a fixed location
    (setq info (screen-information win)) ; where did it actually end up?
    (setq dx (- (car info)))
    (setq dy (- (cadr info)))
    (move-screen (+ (car start-info) dx) (+ (cadr start-info) dy) win)
    (list dx dy)
  ))

;;; Allright, calculate the actual deltas
;;; Things to account for -
;;; 1. Size of WM borders
;;; 2. Size of X window borders
;;; 3. WM fudging of move requests
;;;
(let
  (
    (minfo (screen-information (minibuf-screen)))
    (mbinfo (backing-screen-info (minibuf-screen)))
    (einfo (screen-information))
    (ebinfo (backing-screen-info))
    (wm-fudge (wm-location-delta (minibuf-screen)))
  )
  (setq minibuf-delta-x
    (+
      ;; for now, just line up the edge of the edit screen with the edge of
      ;; the minibuffer screen, so only account for the WM fudge factor.
      (car wm-fudge)
    ))
  (setq minibuf-delta-y
    (+
      (cadr wm-fudge)
      ;; size of the minibuffer title
      (- (nth 1 minfo) (nth 1 mbinfo))
      ;; the size of the bottom bar on the edit screen
      (- (+ (nth 1 ebinfo) (nth 3 ebinfo)) (+ (nth 1 einfo) (nth 3 einfo)))
      (nth 4 mbinfo)			; borders
      (nth 4 ebinfo)
    )))
;;; --------------------------------------------------------------------------

(defun move-minibuffer-screen-with-anchor-screen ()
  (let* ((mbscreen (minibuf-screen))
	 (info (screen-information *minibuffer-anchor-screen*))
	 )
    (move-screen
     (+ (car info) minibuf-delta-x)
     (+ (nth 1 info) (nth 3 info) minibuf-delta-y)
     mbscreen)
    ))

(defun resize-minibuffer-screen-with-anchor-screen ()
  (let* ((char-width (epoch::screen-width *minibuffer-anchor-screen*))
	 (mbscreen (minibuf-screen))
	 (font (car (font nil *minibuffer-anchor-screen*)))
	 (mbfont (car (font nil mbscreen)))
	 )
    (move-minibuffer-screen-with-anchor-screen)
    ;; make the minibuffer have the same font as the screen it's attached to
    (when (and font mbfont (not (string= font mbfont)))
      (font font mbscreen))
    (change-screen-size char-width nil mbscreen)
    ))


(defun anchor-minibuffer-to-selected-screen ()
  "Make the minibuffer stick to the current screen."
  (interactive)
  (setq *minibuffer-anchor-screen* (current-screen))
  (and *minibuffer-sticks-to-selected-screen-p*
       (resize-minibuffer-screen-with-anchor-screen)))

(setq *select-screen-hook* 'anchor-minibuffer-to-selected-screen)

(and *minibuffer-sticks-to-selected-screen-p*
 (resize-minibuffer-screen-with-anchor-screen))

