[Emacs-diffs] Changes to emacs/lisp/frame.el,v

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        07/07/25 19:37:22

Index: frame.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/frame.el,v
retrieving revision 1.243
retrieving revision 1.244
diff -u -b -r1.243 -r1.244
--- frame.el    21 Jan 2007 03:53:11 -0000      1.243
+++ frame.el    25 Jul 2007 19:37:21 -0000      1.244
@@ -226,10 +226,9 @@
        (setq frame-creation-function
              (if (fboundp 'tty-create-frame-with-faces)
                  'tty-create-frame-with-faces
-               (function
                 (lambda (parameters)
                   (error
-                   "Can't create multiple frames without a window 
system"))))))))
+                   "Can't create multiple frames without a window 
system")))))))
 
 (defvar frame-notice-user-settings t
   "Non-nil means function `frame-notice-user-settings' wasn't run yet.")
@@ -424,11 +423,11 @@
            ;; variable must be handled similarly.
            (let ((users-of-initial
                   (filtered-frame-list
-                   (function (lambda (frame)
+                    (lambda (frame)
                                (and (not (eq frame frame-initial-frame))
                                     (eq (window-frame
                                          (minibuffer-window frame))
-                                        frame-initial-frame)))))))
+                               frame-initial-frame))))))
              (if (or users-of-initial
                      (eq default-minibuffer-frame frame-initial-frame))
 
@@ -437,11 +436,10 @@
                  (let* ((new-surrogate
                          (car
                           (or (filtered-frame-list
-                               (function
                                 (lambda (frame)
                                   (eq (cdr (assq 'minibuffer
                                                  (frame-parameters frame)))
-                                      'only))))
+                                      'only)))
                               (minibuffer-frame-list))))
                         (new-minibuffer (minibuffer-window new-surrogate)))
 
@@ -450,12 +448,9 @@
 
                    ;; Wean the frames using frame-initial-frame as
                    ;; their minibuffer frame.
-                   (mapcar
-                    (function
-                     (lambda (frame)
+                   (dolist (frame users-of-initial)
                        (modify-frame-parameters
-                        frame (list (cons 'minibuffer new-minibuffer)))))
-                    users-of-initial))))
+                       frame (list (cons 'minibuffer new-minibuffer)))))))
 
           ;; Redirect events enqueued at this frame to the new frame.
            ;; Is this a good idea?
@@ -574,6 +569,36 @@
       (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
   (make-frame (cons (cons 'display display) 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)
@@ -639,8 +664,8 @@
 (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)))))))
+   (lambda (frame)
+     (eq frame (window-frame (minibuffer-window frame))))))
 
 (defun frames-on-display-list (&optional display)
   "Return a list of all frames on DISPLAY.
@@ -787,11 +812,10 @@
   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)
+       (mapcar (lambda (frame)
                   (list frame
                         (frame-parameters frame)
-                        (current-window-configuration frame))))
+                        (current-window-configuration frame)))
                (frame-list))))
 
 (defun set-frame-configuration (configuration &optional nodelete)
@@ -808,8 +832,7 @@
              (list 'frame-configuration-p configuration)))
   (let ((config-alist (cdr configuration))
        frames-to-delete)
-    (mapcar (function
-            (lambda (frame)
+    (dolist (frame (frame-list))
               (let ((parameters (assq frame config-alist)))
                 (if parameters
                     (progn
@@ -822,15 +845,15 @@
                          (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
+          (setq frames-to-delete (cons frame frames-to-delete)))))
+    (mapc (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))))
+              'iconify-frame
+            'delete-frame)
+          frames-to-delete)))
 
 ;;;; Convenience functions for accessing and interactively changing
 ;;;; frame parameters.
@@ -858,10 +881,9 @@
   (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
                         (frame-parameter nil 'font))))
      (list font current-prefix-arg)))