;;; frame.el --- multi-frame management independent of window systems.

;;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: internal

;; This file is part of XEmacs.

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

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

;;; Code:

(defvar select-frame-hook nil
  "Function or functions to run just after a new frame is given the focus.
Note that calling `select-frame' does not necessarily set the focus:
The actual window-system focus will not be changed until the next time
that XEmacs is waiting for an event, and even then, the window manager
may refuse the focus-change request.")

(defvar deselect-frame-hook nil
  "Function or functions to run just before a frame loses the focus.
See `select-frame-hook'.")

(defvar initial-frame-alist nil
  "Alist of default values for the first frame.
This may be set by the window-system-specific init file.")



;;;; Creating the initial window-system frame

(defun frame-initialize ()
  ;; In batch mode, we actually use the initial terminal device for output.
  (if (not (noninteractive))
      (progn
	;; Don't call select-frame here - focus is a matter of WM policy.
	(make-frame initial-frame-alist
		    (car (delq terminal-device (device-list))))
	(delete-device terminal-device)
	(setq terminal-frame nil))))


;;;; Creation of additional frames, and other frame miscellanea

(defun get-other-frame ()
 "Return some frame other than the current frame, creating one if necessary."
  (let* ((this (selected-frame))
	 ;; search visible frames first
	 (next (next-frame this 'visible)))
    ;; then search iconified frames
    (if (eq this next)
	(setq next (next-frame this nil)))
    (if (eq this next)
	;; otherwise, make a new frame
	(make-frame)
      next)))

(defun next-multiframe-window ()
  "Select the next window, regardless of which frame it is on."
  (interactive)
  (select-window (next-window (selected-window)
			      (> (minibuffer-depth) 0)
			      t)))

(defun previous-multiframe-window ()
  "Select the previous window, regardless of which frame it is on."
  (interactive)
  (select-window (previous-window (selected-window)
				  (> (minibuffer-depth) 0)
				  t)))

(defun frame-list ()
  "Return a list of all frames on all devices."
  (apply 'append (mapcar 'device-frame-list (device-list))))

;; Alias, kept temporarily.
(defalias 'new-frame 'make-frame)

(defun filtered-frame-list (predicate)
  "Return a list of all live frames which satisfy PREDICATE."
  (let ((frames (frame-list))
	good-frames)
    (while (consp frames)
      (if (funcall predicate (car frames))
	  (setq good-frames (cons (car frames) good-frames)))
      (setq frames (cdr frames)))
    good-frames))

;(defun minibuffer-frame-list ()
;  "Return a list of all frames with their own minibuffers."
;  (filtered-frame-list
;   (function (lambda (frame)
;	       (eq frame (window-frame (minibuffer-window frame)))))))

;(defun frame-remove-geometry-params (param-list)
;  "Return the parameter list PARAM-LIST, but with geometry specs removed.
;This deletes all bindings in PARAM-LIST for `top', `left', `width',
;and `height' parameters.
;XEmacs uses this to avoid overriding explicit moves and resizings from
;the user during startup."
;  (setq param-list (cons nil param-list))
;  (let ((tail param-list))
;    (while (consp (cdr tail))
;      (if (and (consp (car (cdr tail)))
;	       (memq (car (car (cdr tail))) '(height width top left)))
;	  (setcdr tail (cdr (cdr tail)))
;	(setq tail (cdr tail)))))
;  (cdr param-list))


(defun other-frame (arg)
  "Select the ARG'th different visible frame, and raise it.
All frames are arranged in a cyclic order.
This command selects the frame ARG steps away in that order.
A negative ARG moves in the opposite order."
  (interactive "p")
  (let ((frame (selected-frame)))
    (while (> arg 0)
      (setq frame (next-frame frame 'visible))
      (setq arg (1- arg)))
    (while (< arg 0)
      (setq frame (previous-frame frame 'visible))
      (setq arg (1+ arg)))
    (raise-frame frame)
    (select-frame frame)
    ))

;; utility functions
(defun device-or-frame-p (object)
  "Return non-nil if OBJECT is a device or frame."
  (or (devicep object)
      (framep object)))

(defun device-or-frame-type (device-or-frame)
  "Return the type (e.g. `x' or `tty') of DEVICE-OR-FRAME.
DEVICE-OR-FRAME should be a device or a frame object.  See `device-type'
for a description of the possible types."
  (if (devicep device-or-frame)
      (device-type device-or-frame)
    (frame-type device-or-frame)))


;;;; Frame configurations

;; This stuff doesn't quite work yet - feel free to fix it

;(defun current-frame-configuration ()
;  "Return a list describing the positions and states of all frames.
;Its car is `frame-configuration'.
;Each element of the cdr is a list of the form (FRAME ALIST WINDOW-CONFIG),
;where
;  FRAME is a frame object,
;  ALIST is an association list specifying some of FRAME's parameters, and
;  WINDOW-CONFIG is a window configuration object for FRAME."
;  (cons 'frame-configuration
;	(mapcar (function
;		 (lambda (frame)
;		   (list frame
;			 (frame-parameters frame)
;			 (current-window-configuration frame))))
;		(frame-list))))

;(defun set-frame-configuration (configuration &optional nodelete)
;  "Restore the frames to the state described by CONFIGURATION.
;Each frame listed in CONFIGURATION has its position, size, window
;configuration, and other parameters set as specified in CONFIGURATION.
;Ordinarily, this function deletes all existing frames not
;listed in CONFIGURATION.  But if optional second argument NODELETE
;is given and non-nil, the unwanted frames are iconified instead."
;  (or (frame-configuration-p configuration)
;      (signal 'wrong-type-argument
;	      (list 'frame-configuration-p configuration)))
;  (let ((config-alist (cdr configuration))
;	frames-to-delete)
;    (mapcar (function
;	     (lambda (frame)
;	       (let ((parameters (assq frame config-alist)))
;		 (if parameters
;		     (progn
;		       (modify-frame-parameters
;			frame
;			;; Since we can't set a frame's minibuffer status, 
;			;; we might as well omit the parameter altogether.
;			(let* ((parms (nth 1 parameters))
;			       (mini (assq 'minibuffer parms)))
;			  (if mini (setq parms (delq mini parms)))
;			  parms))
;		       (set-window-configuration (nth 2 parameters)))
;		   (setq frames-to-delete (cons frame frames-to-delete))))))
;	    (frame-list))
;    (if nodelete
;	;; Note: making frames invisible here was tried
;	;; but led to some strange behavior--each time the frame
;	;; was made visible again, the window manager asked afresh
;	;; for where to put it.
;	(mapcar 'iconify-frame frames-to-delete)
;      (mapcar 'delete-frame frames-to-delete))))

;(defun frame-configuration-p (object)
;  "Return non-nil if OBJECT seems to be a frame configuration.
;Any list whose car is `frame-configuration' is assumed to be a frame
;configuration."
;  (and (consp object)
;       (eq (car object) 'frame-configuration)))


;;; Iconifying emacs.
;;;
;;; The function iconify-emacs replaces every non-iconified emacs window
;;; with a *single* icon.  Iconified emacs windows are left alone.  When
;;; emacs is in this globally-iconified state, de-iconifying any emacs icon
;;; will uniconify all frames that were visible, and iconify all frames
;;; that were not.  This is done by temporarily changing the value of
;;; `map-frame-hook' to `deiconify-emacs' (which should never be called 
;;; except from the map-frame-hook while emacs is iconified).
;;;
;;; The title of the icon representing all emacs frames is controlled by
;;; the variable `icon-name'.  This is done by temporarily changing the
;;; value of `frame-icon-title-format'.  Unfortunately, this changes the
;;; titles of all emacs icons, not just the "big" icon.
;;;
;;; It would be nice if existing icons were removed and restored by
;;; iconifying the emacs process, but I couldn't make that work yet.

(defvar icon-name nil) ; set this at run time, not load time.

(defvar iconification-data nil)

(defun iconify-emacs ()
  "Replace every non-iconified FRAME with a *single* icon.
Iconified frames are left alone.  When XEmacs is in this
globally-iconified state, de-iconifying any emacs icon will uniconify
all frames that were visible, and iconify all frames that were not."
  (interactive)
  (if iconification-data (error "already iconified?"))
  (let* ((frames (frame-list))
	 (rest frames)
	 (me (selected-frame))
	 frame)
    (while rest
      (setq frame (car rest))
      (setcar rest (cons frame (frame-visible-p frame)))
;      (if (memq (cdr (car rest)) '(icon nil))
;	  (progn
;	    (make-frame-visible frame) ; deiconify, and process the X event
;	    (sleep-for 500 t) ; process X events; I really want to XSync() here
;	    ))
      (or (eq frame me) (make-frame-invisible frame))
      (setq rest (cdr rest)))
    (or (boundp 'map-frame-hook) (setq map-frame-hook nil))
    (or icon-name
	(setq icon-name (concat invocation-name " @ " (system-name))))
    (setq iconification-data
	    (list frame-icon-title-format map-frame-hook frames)
	  frame-icon-title-format icon-name
	  map-frame-hook 'deiconify-emacs)
    (iconify-frame me)))

(defun deiconify-emacs (&optional ignore)
  (or iconification-data (error "not iconified?"))
  (setq frame-icon-title-format (car iconification-data)
	map-frame-hook (car (cdr iconification-data))
	iconification-data (car (cdr (cdr iconification-data))))
  (while iconification-data
    (let ((visibility (cdr (car iconification-data))))
      (cond ((eq visibility 't)
	     (make-frame-visible (car (car iconification-data))))
;	    (t ;; (eq visibility 'icon)
;	     (make-frame-visible (car (car iconification-data)))
;	     (sleep-for 500 t) ; process X events; I really want to XSync() here
;	     (iconify-frame (car (car iconification-data))))
	    ;; (t nil)
	    ))
    (setq iconification-data (cdr iconification-data))))

(defun suspend-or-iconify-emacs ()
  "Calls iconify-emacs if frame is an X frame, otherwise calls suspend-emacs"
  (interactive)
  (if (eq (frame-type (selected-frame)) 'x)
      (iconify-emacs)
    (suspend-emacs)))


;;; auto-raise and auto-lower

(defvar auto-raise-frame nil
  "*If true, frames will be raised to the top when selected.
Under X, most ICCCM-compliant window managers will have an option to do this
for you, but this variable is provided in case you're using a broken WM.")

(defvar auto-lower-frame nil
  "*If true, frames will be lowered to the bottom when no longer selected.
Under X, most ICCCM-compliant window managers will have an option to do this
for you, but this variable is provided in case you're using a broken WM.")

(defun default-select-frame-hook ()
  "Implements the `auto-raise-frame' variable.
For use as the value of `select-frame-hook'."
  (if auto-raise-frame (raise-frame (selected-frame))))

(defun default-deselect-frame-hook ()
  "Implements the `auto-lower-frame' variable.
For use as the value of `deselect-frame-hook'."
  (if auto-lower-frame (lower-frame (selected-frame))))

(or select-frame-hook
    (add-hook 'select-frame-hook 'default-select-frame-hook))

(or deselect-frame-hook
    (add-hook 'deselect-frame-hook 'default-deselect-frame-hook))


;;; Application-specific frame-management

(defvar get-frame-for-buffer-default-frame-name nil
  "The default frame to select; see doc of `get-frame-for-buffer'.")

(defvar get-frame-for-buffer-default-instance-limit nil)

(defun get-frame-name-for-buffer (buffer)
  (let ((mode (and (get-buffer buffer)
		   (save-excursion (set-buffer buffer)
				   major-mode))))
    (or (get mode 'frame-name)
	get-frame-for-buffer-default-frame-name)))

(defun get-frame-for-buffer-sorted-frame-list ()
  (sort (frame-list)
	#'(lambda (s1 s2)
	    (cond ((frame-totally-visible-p s2)
		   nil)
		  ((not (frame-visible-p s2))
		   (frame-visible-p s1))
		  ((not (frame-totally-visible-p s2))
		   (and (frame-visible-p s1)
			(frame-totally-visible-p s1)))))))

(defun get-frame-for-buffer-make-new-frame (buffer &optional frame-name)
  (let* ((fr (make-frame (and frame-name (list (cons 'name frame-name)))))
	 (w (frame-root-window fr)))
    ;;
    ;; Make the one buffer being displayed in this newly created
    ;; frame be the buffer of interest, instead of something
    ;; random, so that it won't be shown in two-window mode.
    ;; Avoid calling switch-to-buffer here, since that's something
    ;; people might want to call this routine from.
    ;;
    ;; (If the root window doesn't have a buffer, then that means
    ;; there is more than one window on the frame, which can only
    ;; happen if the user has done something funny on the frame-
    ;; creation-hook.  If that's the case, leave it alone.)
    ;;
    (if (window-buffer w)
	(set-window-buffer w buffer))
    fr))

(defun get-frame-for-buffer-noselect (buffer
				       &optional not-this-window-p on-frame)
  "Return a frame in which to display BUFFER.
This is a subroutine of `get-frame-for-buffer' (which see)."
  (let (name limit)
    (cond
     ((or on-frame (eq (selected-window) (minibuffer-window)))
      ;; don't switch frames if a frame was specified, or to list
      ;; completions from the minibuffer, etc.
      nil)

     ((setq name (get-frame-name-for-buffer buffer))
      ;;
      ;; This buffer's mode expressed a preference for a frame of a particular
      ;; name.  That always takes priority.
      ;;
      (let ((limit (get name 'instance-limit))
	    (matching-frames '())
	    frames frame already-visible)
	;; Sort the list so that iconic frames will be found last.  They
	;; will be used too, but mapped frames take precedence.  And
	;; fully visible frames come before occluded frames.
	(setq frames (get-frame-for-buffer-sorted-frame-list))
	;; but the selected frame should come first, even if it's occluded,
	;; to minimize thrashing.
	(setq frames (cons (selected-frame)
			   (delq (selected-frame) frames)))
	
	(setq name (symbol-name name))
	(while frames
	  (setq frame (car frames))
	  (if (equal name (frame-name frame))
	      (if (get-buffer-window buffer frame)
		  (setq already-visible frame
			frames nil)
		(setq matching-frames (cons frame matching-frames))))
	  (setq frames (cdr frames)))
	(cond (already-visible
	       already-visible)
	      ((or (null matching-frames)
		   (eq limit 0) ; means create with reckless abandon
		   (and limit (< (length matching-frames) limit)))
	       (get-frame-for-buffer-make-new-frame buffer name))
	      (t
	       ;; do not switch any of the window/buffer associations in an
	       ;; existing frame; this function only picks a frame; the
	       ;; determination of which windows on it get reused is up to
	       ;; display-buffer itself.
;;	       (or (window-dedicated-p (selected-window))
;;		   (switch-to-buffer buffer))
	       (car matching-frames)))))

     ((setq limit get-frame-for-buffer-default-instance-limit)
      ;;
      ;; This buffer's mode did not express a preference for a frame of a
      ;; particular name, but the user wants a new frame rather than
      ;; reusing the existing one.
      (let ((frames (get-frame-for-buffer-sorted-frame-list)))
	;; put the selected frame last.  The user wants a new frame,
	;; so don't reuse the existing one unless forced to.
	(setq frames (append (delq (selected-frame) frames) (list frames)))
	(if (or (eq limit 0) ; means create with reckless abandon
		(< (length frames) limit))
	    (get-frame-for-buffer-make-new-frame buffer)
	  (car frames))))

     (t
      ;;
      ;; This buffer's mode did not express a preference for a frame of a
      ;; particular name.  So try to find a frame already displaying this
      ;; buffer.  
      ;;
      (let ((w (or (get-buffer-window buffer t)		; check visible first
		   (get-buffer-window buffer t t))))	; then iconic
	(cond ((null w)
	       ;; It's not in any window - return nil, meaning no frame has
	       ;; preference.
	       nil)
	      ((and not-this-window-p
		    (eq (selected-frame) (window-frame w)))
	       ;; It's in a window, but on this frame, and we have been
	       ;; asked to pick another window.  Return nil, meaning no
	       ;; frame has preference.
	       nil)
	      (t
	       ;; Otherwise, return the frame of the buffer's window.
	       (window-frame w))))))))


;; The pre-display-buffer-function is called for effect, so this needs to
;; actually select the frame it wants.  Fdisplay_buffer() takes notice of
;; changes to the selected frame.
(defun get-frame-for-buffer (buffer &optional not-this-window-p on-frame)
  "Select and return a frame in which to display BUFFER.
Normally, the buffer will simply be displayed in the current frame.
But if the symbol naming the major-mode of the buffer has a 'frame-name
property (which should be a symbol), then the buffer will be displayed in
a frame of that name.  If there is no frame of that name, then one is
created.  

If the major-mode doesn't have a 'frame-name property, then the frame
named by `get-frame-for-buffer-default-frame-name' will be used.  If
that is nil (the default) then the currently selected frame will used.

If the frame-name symbol has an 'instance-limit property (an integer)
then each time a buffer of the mode in question is displayed, a new frame
with that name will be created, until there are `instance-limit' of them.
If instance-limit is 0, then a new frame will be created each time.

If a buffer is already displayed in a frame, then `instance-limit' is 
ignored, and that frame is used.

If the frame-name symbol has a 'frame-defaults property, then that is
prepended to the `default-frame-alist' when creating a frame for the
first time.

This function may be used as the value of `pre-display-buffer-function', 
to cause the display-buffer function and its callers to exhibit the above
behavior."
  (let ((old-frames (visible-frame-list))
	(frame (get-frame-for-buffer-noselect
		 buffer not-this-window-p on-frame)))
    (if (not (eq frame (selected-frame)))
	nil
      (select-frame frame)
      (or (member frame old-frames)
	    ;; If the frame was already visible, just focus on it.
	    ;; If it wasn't visible (it was just created, or it used
	    ;; to be iconified) then uniconify, raise, etc.
	  (make-frame-visible frame))
      frame)))

(defun frames-of-buffer (&optional buffer visible-only)
  "Return list of frames that BUFFER is currently being displayed on.
If the buffer is being displayed on the currently selected frame, that frame
is first in the list.  VISIBLE-ONLY will only list non-iconified frames."
  (let ((list (windows-of-buffer buffer))
	(cur-frame (selected-frame))
	next-frame frames save-frame)

    (while list
      (if (memq (setq next-frame (window-frame (car list)))
		frames)
	  nil
	(if (eq cur-frame next-frame)
	    (setq save-frame next-frame)
	  (and 
	   (or (not visible-only)
	       (eq t (frame-visible-p next-frame)))
	   (setq frames (append frames (list next-frame))))))
	(setq list (cdr list)))

    (if save-frame
	(append (list save-frame) frames)
      frames)))

(defun show-temp-buffer-in-current-frame (buffer)
  "For use as the value of temp-buffer-show-function:
always displays the buffer in the current frame, regardless of the behavior
that would otherwise be introduced by the `pre-display-buffer-function', which
is normally set to `get-frame-for-buffer' (which see)."
  (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is
    (let ((window (display-buffer buffer)))
      (if (not (eq (selected-frame) (window-frame window)))
	  ;; only the pre-display-buffer-function should ever do this.
	  (error "display-buffer switched frames on its own!!"))
      (setq minibuffer-scroll-window window)
      (set-window-start window 1) ; obeys narrowing
      (set-window-point window 1)
      nil)))

(setq pre-display-buffer-function 'get-frame-for-buffer)
(setq temp-buffer-show-function 'show-temp-buffer-in-current-frame)


;; from Bob Weiner <bweiner@pts.mot.com>, modified by Ben Wing
(defun delete-other-frames (&optional frame)
  "Delete all but FRAME (or the selected frame)."
  (interactive)
  (mapcar 'delete-frame (delq (or frame (selected-frame)) (frame-list))))


(provide 'frame)

;;; frame.el ends here
