Function: dframe-reposition-frame

dframe-reposition-frame is a byte-compiled function defined in dframe.el.gz.

Signature

(dframe-reposition-frame NEW-FRAME PARENT-FRAME LOCATION)

Documentation

Move NEW-FRAME to be relative to PARENT-FRAME.

LOCATION can be one of random, left-right, top-bottom, or a cons cell indicating a position of the form (LEFT . TOP).

Source Code

;; Defined in /usr/src/emacs/lisp/dframe.el.gz
(defun dframe-reposition-frame (new-frame parent-frame location)
  "Move NEW-FRAME to be relative to PARENT-FRAME.
LOCATION can be one of `random', `left-right', `top-bottom', or
a cons cell indicating a position of the form (LEFT . TOP)."
  ;; Position dframe.
  ;; Do no positioning if not on a windowing system,
  (unless (or (not window-system) (eq window-system 'pc))
    (let* ((pfx (frame-parameter parent-frame 'left))
           (pfy (frame-parameter parent-frame 'top))
	   (pfw (+ (tool-bar-pixel-width parent-frame)
		   (frame-pixel-width parent-frame)))
	   (pfh (frame-pixel-height parent-frame))
	   (nfw (frame-pixel-width new-frame))
	   (nfh (frame-pixel-height new-frame))
	   newleft newtop)
      ;; Rebuild pfx,pfy to be absolute positions.
      (setq pfx (if (not (consp pfx))
		    pfx
		  ;; If pfx is a list, that means we grow
		  ;; from a specific edge of the display.
		  ;; Convert that to the distance from the
		  ;; left side of the display.
		  (if (eq (car pfx) '-)
		      ;; A - means distance from the right edge
		      ;; of the display, or DW - pfx - framewidth
		      (- (x-display-pixel-width) (car (cdr pfx)) pfw)
		    (car (cdr pfx))))
	    pfy (if (not (consp pfy))
		    pfy
		  ;; If pfy is a list, that means we grow
		  ;; from a specific edge of the display.
		  ;; Convert that to the distance from the
		  ;; left side of the display.
		  (if (eq (car pfy) '-)
		      ;; A - means distance from the right edge
		      ;; of the display, or DW - pfx - framewidth
		      (- (x-display-pixel-height) (car (cdr pfy)) pfh)
		    (car (cdr pfy)))))
      (cond ((eq location 'right)
	     (setq newleft (+ pfx pfw 10)
		   newtop pfy))
	    ((eq location 'left)
	     (setq newleft (- pfx 10 nfw)
		   newtop pfy))
	    ((eq location 'left-right)
	     (setq newleft
		   ;; Decide which side to put it on.  200 is just a
		   ;; buffer for the left edge of the screen.  The
		   ;; extra 10 is just dressings for window
		   ;; decorations.
		   (let* ((left-guess (- pfx 10 nfw))
			  (right-guess (+ pfx pfw 10))
			  (left-margin left-guess)
			  (right-margin (- (x-display-pixel-width)
					   right-guess 5 nfw)))
		     (cond ((>= left-margin 0) left-guess)
			   ((>= right-margin 0) right-guess)
			   ;; otherwise choose side we overlap less
			   ((> left-margin right-margin) 0)
			   (t (- (x-display-pixel-width) nfw 5))))
		   newtop pfy))
	    ((eq location 'top-bottom)
	     (setq newleft pfx
		   newtop
		   ;; Try and guess if we should be on the top or bottom.
		   (let* ((top-guess (- pfy 15 nfh))
			  (bottom-guess (+ pfy 5 pfh))
			  (top-margin top-guess)
			  (bottom-margin (- (x-display-pixel-height)
					    bottom-guess 5 nfh)))
		     (cond ((>= top-margin 0) top-guess)
			   ((>= bottom-margin 0) bottom-guess)
			   ;; Choose a side to overlap the least.
			   ((> top-margin bottom-margin) 0)
			   (t (- (x-display-pixel-height) nfh 5))))))
	    ((consp location)
	     (setq newleft (or (car location) 0)
		   newtop (or (cdr location) 0)))
	    (t nil))
      (modify-frame-parameters new-frame
			       (list (cons 'left newleft)
				     (cons 'top newtop))))))