emacs: lisp/frame.el comparison

comparison lisp/frame.el @ 83648:65663fcd2caa

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 824-838) - Update from CVS - Merge from emacs--rel--22 - Remove lisp/erc/erc-nicklist.el - Update some .arch-inventory files - Fix void function definition error in cus-edit.el - Restore lisp/emacs-lisp/cl-loaddefs.el * emacs--rel--22 (patch 70-83) - Update from CVS - Remove lisp/erc/erc-nicklist.el - Update some .arch-inventory files - Indicate that emacs--devo--0--patch-834 does not need to be applied - Merge from gnus--rel--5.10 - Restore lisp/emacs-lisp/cl-loaddefs.el * gnus--rel--5.10 (patch 239-241) - Merge from emacs--devo--0 - Update from CVS Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-28

author	Miles Bader <miles@gnu.org>
date	Tue, 31 Jul 2007 05:50:45 +0000
parents	2aee92eacdab b98604865ea0
children	5b644ae74c91

comparison

equal deleted inserted replaced

-:3468e549a55b
+:65663fcd2caa
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs 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)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 ;; GNU Emacs 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
 	    ;; minibuffer frame for any frames, we need to wean them
 	    ;; onto a new frame.  The default-minibuffer-frame
 	    ;; variable must be handled similarly.
 	    (let ((users-of-initial
 		   (filtered-frame-list
-		    (function (lambda (frame)
+(lambda (frame)
-				(and (not (eq frame frame-initial-frame))
+(and (not (eq frame frame-initial-frame))
-				     (eq (window-frame
+(eq (window-frame
-					  (minibuffer-window frame))
+(minibuffer-window frame))
-					 frame-initial-frame)))))))
+frame-initial-frame))))))
-	      (if (or users-of-initial
+(if (or users-of-initial
 		      (eq default-minibuffer-frame frame-initial-frame))
 		  ;; Choose an appropriate frame.  Prefer frames which
 		  ;; are only minibuffers.
 		  (let* ((new-surrogate
 			  (car
 			   (or (filtered-frame-list
-				(function
+(lambda (frame)
-				 (lambda (frame)
+(eq (cdr (assq 'minibuffer
-				   (eq (cdr (assq 'minibuffer
+(frame-parameters frame)))
-						  (frame-parameters frame)))
+'only)))
-				       'only))))
 			       (minibuffer-frame-list))))
 			 (new-minibuffer (minibuffer-window new-surrogate)))
 		    (if (eq default-minibuffer-frame frame-initial-frame)
 			(setq default-minibuffer-frame new-surrogate))
 		    ;; Wean the frames using frame-initial-frame as
 		    ;; their minibuffer frame.
-		    (mapcar
+		    (dolist (frame users-of-initial)
-		     (function
+(modify-frame-parameters
-		      (lambda (frame)
+frame (list (cons 'minibuffer new-minibuffer)))))))
-			(modify-frame-parameters
-			 frame (list (cons 'minibuffer new-minibuffer)))))
+;; Redirect events enqueued at this frame to the new frame.
-		     users-of-initial))))
-	   ;; Redirect events enqueued at this frame to the new frame.
 	    ;; Is this a good idea?
 	    (redirect-frame-focus frame-initial-frame new)
 	    ;; Finally, get rid of the old frame.
 	    (delete-frame frame-initial-frame t))
 (error "Invalid terminal device"))
 (unless type
 (error "Invalid terminal type"))
 (make-frame `((window-system . nil) (tty . ,tty) (tty-type . ,type) . ,parameters)))
+(defun close-display-connection (display)
+"Close the connection to a display, deleting all its associated frames.
+For DISPLAY, specify either a frame or a display name (a string).
+If DISPLAY is nil, that stands for the selected frame's display."
+(interactive
+(list
+(let* ((default (frame-parameter nil 'display))
+(display (completing-read
+(format "Close display (default %s): " default)
+(delete-dups
+(mapcar (lambda (frame)
+(frame-parameter frame 'display))
+(frame-list)))
+nil t nil nil
+default)))
+(if (zerop (length display)) default display))))
+(let ((frames (delq nil
+(mapcar (lambda (frame)
+(if (equal display
+(frame-parameter frame 'display))
+frame))
+(frame-list)))))
+(if (and (consp frames)
+(not (y-or-n-p (if (cdr frames)
+(format "Delete %s frames? " (length frames))
+(format "Delete %s ? " (car frames))))))
+(error "Abort!")
+(mapc 'delete-frame frames)
+(x-close-connection display))))
 (defun make-frame-command ()
 "Make a new frame, and select it if the terminal displays only one frame."
 (interactive)
 (if (and window-system (not (eq window-system 'pc)))
 (make-frame)
 (delq nil list)))
 (defun minibuffer-frame-list ()
 "Return a list of all frames with their own minibuffers."
 (filtered-frame-list
-(function (lambda (frame)
+(lambda (frame)
-	       (eq frame (window-frame (minibuffer-window frame)))))))
+(eq frame (window-frame (minibuffer-window frame))))))
 (defun frames-on-display-list (&optional terminal)
 "Return a list of all frames on TERMINAL.
 TERMINAL should be a terminal identifier (an integer), a frame,
 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
+	(mapcar (lambda (frame)
-		 (lambda (frame)
+(list frame
-		   (list frame
+(frame-parameters frame)
-			 (frame-parameters frame)
+(current-window-configuration 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
 (or (frame-configuration-p configuration)
 (signal 'wrong-type-argument
 	      (list 'frame-configuration-p configuration)))
 (let ((config-alist (cdr configuration))
 	frames-to-delete)
-(mapcar (function
+(dolist (frame (frame-list))
-	     (lambda (frame)
+(let ((parameters (assq frame config-alist)))
-	       (let ((parameters (assq frame config-alist)))
+(if parameters
-		 (if parameters
+(progn
-		     (progn
+(modify-frame-parameters
-		       (modify-frame-parameters
+frame
-			frame
+;; Since we can't set a frame's minibuffer status,
-			;; Since we can't set a frame's minibuffer status,
+;; we might as well omit the parameter altogether.
-			;; we might as well omit the parameter altogether.
+(let* ((parms (nth 1 parameters))
-			(let* ((parms (nth 1 parameters))
+(mini (assq 'minibuffer parms)))
-			       (mini (assq 'minibuffer parms)))
+(if mini (setq parms (delq mini parms)))
-			  (if mini (setq parms (delq mini parms)))
+parms))
-			  parms))
+(set-window-configuration (nth 2 parameters)))
-		       (set-window-configuration (nth 2 parameters)))
+(setq frames-to-delete (cons frame frames-to-delete)))))
-		   (setq frames-to-delete (cons frame frames-to-delete))))))
+(mapc (if nodelete
-	    (frame-list))
+;; Note: making frames invisible here was tried
-(if nodelete
+;; but led to some strange behavior--each time the frame
-	;; Note: making frames invisible here was tried
+;; was made visible again, the window manager asked afresh
-	;; but led to some strange behavior--each time the frame
+;; for where to put it.
-	;; was made visible again, the window manager asked afresh
+'iconify-frame
-	;; for where to put it.
+'delete-frame)
-	(mapcar 'iconify-frame frames-to-delete)
+frames-to-delete)))
-(mapcar 'delete-frame frames-to-delete))))
 ;;;; Convenience functions for accessing and interactively changing
 ;;;; frame parameters.
 (defun frame-height (&optional frame)
 non-nil (interactively, prefix argument) the current frame size (in
 pixels) is kept by adjusting the numbers of the lines and columns."
 (interactive
 (let* ((completion-ignore-case t)
 	  (font (completing-read "Font name: "
-			 (mapcar #'list
 				 ;; x-list-fonts will fail with an error
 				 ;; if this frame doesn't support fonts.
-				 (x-list-fonts "*" nil (selected-frame)))
+				 (x-list-fonts "*" nil (selected-frame))
-			 nil nil nil nil
+nil nil nil nil
-			 (frame-parameter nil 'font))))
+(frame-parameter nil 'font))))
 (list font current-prefix-arg)))
 (let (fht fwd)
 (if keep-size
 	(setq fht (* (frame-parameter nil 'height) (frame-char-height))
 	      fwd (* (frame-parameter nil 'width)  (frame-char-width))))

Mercurial > emacs

comparison lisp/frame.el @ 83648:65663fcd2caa