;; 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,
(list (cons nil
(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"))))))
+ (lambda (parameters)
+ (error "Can't create multiple frames without a window system")))))
"Alist of window-system dependent functions to call to create a new frame.
The window system startup file should add its frame creation
function to this list, which should take an alist of parameters
;; variable must be handled similarly.
(let ((users-of-initial
(filtered-frame-list
- (function (lambda (frame)
- (and (not (eq frame frame-initial-frame))
- (eq (window-frame
- (minibuffer-window frame))
- frame-initial-frame)))))))
- (if (or users-of-initial
+ (lambda (frame)
+ (and (not (eq frame frame-initial-frame))
+ (eq (window-frame
+ (minibuffer-window frame))
+ frame-initial-frame))))))
+ (if (or users-of-initial
(eq default-minibuffer-frame frame-initial-frame))
;; Choose an appropriate frame. Prefer frames which
(let* ((new-surrogate
(car
(or (filtered-frame-list
- (function
- (lambda (frame)
- (eq (cdr (assq 'minibuffer
- (frame-parameters frame)))
- 'only))))
+ (lambda (frame)
+ (eq (cdr (assq 'minibuffer
+ (frame-parameters frame)))
+ 'only)))
(minibuffer-frame-list))))
(new-minibuffer (minibuffer-window new-surrogate)))
;; Wean the frames using frame-initial-frame as
;; their minibuffer frame.
- (mapcar
- (function
- (lambda (frame)
- (modify-frame-parameters
- frame (list (cons 'minibuffer new-minibuffer)))))
- users-of-initial))))
-
- ;; Redirect events enqueued at this frame to the new frame.
+ (dolist (frame users-of-initial)
+ (modify-frame-parameters
+ frame (list (cons 'minibuffer new-minibuffer)))))))
+
+ ;; Redirect events enqueued at this frame to the new frame.
;; Is this a good idea?
(redirect-frame-focus frame-initial-frame new)
(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)
(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 frames-on-display-list (&optional terminal)
- "Return a list of all frames on TERMINAL.
-
-TERMINAL should be a terminal identifier (an integer), a frame,
-or a name of an X display (a string of the form
+ (lambda (frame)
+ (eq frame (window-frame (minibuffer-window frame))))))
+
+;; Used to be called `terminal-id' in termdev.el.
+(defun get-device-terminal (device)
+ "Return the terminal corresponding to DEVICE.
+DEVICE can be a terminal, a frame, nil (meaning the selected frame's terminal),
+the name of an X display device (HOST.SERVER.SCREEN) or a tty device file."
+ (cond
+ ((or (null device) (framep device))
+ (frame-terminal device))
+ ((stringp device)
+ (let ((f (car (filtered-frame-list
+ (lambda (frame)
+ (or (equal (frame-parameter frame 'display) device)
+ (equal (frame-parameter frame 'tty) device)))))))
+ (or f (error "Display %s does not exist" device))
+ (frame-terminal f)))
+ ((terminal-live-p device) device)
+ (t
+ (error "Invalid argument %s in `get-device-terminal'" device))))
+
+(defun frames-on-display-list (&optional device)
+ "Return a list of all frames on DEVICE.
+
+DEVICE should be a terminal, a frame,
+or a name of an X display or tty (a string of the form
HOST:SERVER.SCREEN).
-If TERMINAL is omitted or nil, it defaults to the selected
+If DEVICE is omitted or nil, it defaults to the selected
frame's terminal device."
- (let* ((terminal (terminal-id terminal))
+ (let* ((terminal (get-device-terminal device))
(func #'(lambda (frame)
(eq (frame-terminal frame) terminal))))
(filtered-frame-list func)))
(select-frame frame)
(raise-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (cond ((memq (window-system frame) '(x max))
- (x-focus-frame frame))
- ((eq (window-system frame) 'w32)
- (w32-focus-frame frame)))
+ (cond ((memq (window-system frame) '(x max w32))
+ (x-focus-frame frame)))
(cond (focus-follows-mouse
(set-mouse-position (selected-frame) (1- (frame-width)) 0))))
(interactive)
(let ((type (framep (selected-frame))))
(cond
- ((eq type 'x) (iconify-or-deiconify-frame))
+ ((memq type '(x w32)) (iconify-or-deiconify-frame))
((eq type t)
(if (controlling-tty-p)
(suspend-emacs)
(raise-frame frame)
(select-frame frame)
;; Ensure, if possible, that frame gets input focus.
- (cond ((eq (window-system frame) 'x)
- (x-focus-frame frame))
- ((eq (window-system frame) 'w32)
- (w32-focus-frame frame)))
+ (cond ((memq (window-system frame) '(x w32))
+ (x-focus-frame frame)))
(when focus-follows-mouse
(set-mouse-position frame (1- (frame-width frame)) 0))))
\f
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))))
+ (mapcar (lambda (frame)
+ (list frame
+ (frame-parameters frame)
+ (current-window-configuration frame)))
(frame-list))))
(defun set-frame-configuration (configuration &optional nodelete)
(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))))
+ (dolist (frame (frame-list))
+ (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)))))
+ (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.
+ 'iconify-frame
+ 'delete-frame)
+ frames-to-delete)))
\f
;;;; Convenience functions for accessing and interactively changing
;;;; frame parameters.
(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)))
- nil nil nil nil
- (frame-parameter nil 'font))))
+ (x-list-fonts "*" nil (selected-frame))
+ nil nil nil nil
+ (frame-parameter nil 'font))))
(list font current-prefix-arg)))
(let (fht fwd)
(if keep-size
(define-minor-mode blink-cursor-mode
"Toggle blinking cursor mode.
-With a numeric argument, turn blinking cursor mode on iff ARG is positive.
-When blinking cursor mode is enabled, the cursor of the selected
-window blinks.
+With a numeric argument, turn blinking cursor mode on if ARG is positive,
+otherwise turn it off. When blinking cursor mode is enabled, the
+cursor of the selected window blinks.
Note that this command is effective only when Emacs
displays through a window system, because then Emacs does its own
HCoop / bpt / emacs.git / blobdiff