]> code.delx.au - gnu-emacs/blobdiff - lisp/frame.el
Merged from miles@gnu.org--gnu-2005 (patch 469)
[gnu-emacs] / lisp / frame.el
index 088a7a9b622d8fc9278aef9092a8c005c1d15622..ac9b1ad6df489f65e5c89ec689be7acb2d981f4d 100644 (file)
 
 ;;; Code:
 
-(defvar frame-creation-function nil
-  "Window-system dependent function to call to create a new frame.
-The window system startup file should set this to its frame creation
-function, which should take an alist of parameters as its argument.")
+(defvar frame-creation-function-alist
+  (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"))))))
+  "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
+as its argument.")
+
+(defvar window-system-default-frame-alist nil
+  "Alist of window-system dependent default frame parameters.
+These may be set in your init file, like this:
+
+    ;; Disable menubar and toolbar on the console, but enable them under X.
+    (setq window-system-default-frame-alist
+          '((x (menu-bar-lines . 1) (tool-bar-lines . 1))
+            (nil (menu-bar-lines . 0) (tool-bar-lines . 0))))
+
+Also see `default-frame-alist'.")
 
 ;; The initial value given here used to ask for a minibuffer.
 ;; But that's not necessary, because the default is to have one.
@@ -189,7 +207,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
 (defun frame-initialize ()
   "Create an initial frame if necessary."
   ;; Are we actually running under a window system at all?
-  (if (and window-system (not noninteractive) (not (eq window-system 'pc)))
+  (if (and initial-window-system
+          (not noninteractive)
+          (not (eq initial-window-system 'pc)))
       (progn
        ;; Turn on special-display processing only if there's a window system.
        (setq special-display-function 'special-display-popup-frame)
@@ -206,6 +226,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
                  (setq frame-initial-frame-alist
                        (cons '(horizontal-scroll-bars . t)
                              frame-initial-frame-alist)))
+             (setq frame-initial-frame-alist
+                   (cons (cons 'window-system initial-window-system)
+                         frame-initial-frame-alist))
              (setq default-minibuffer-frame
                    (setq frame-initial-frame
                          (make-frame frame-initial-frame-alist)))
@@ -218,18 +241,7 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
        ;; At this point, we know that we have a frame open, so we
        ;; can delete the terminal frame.
        (delete-frame terminal-frame)
-       (setq terminal-frame nil))
-
-    ;; No, we're not running a window system.  Use make-terminal-frame if
-    ;; we support that feature, otherwise arrange to cause errors.
-    (or (eq window-system 'pc)
-       (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"))))))))
+       (setq terminal-frame nil))))
 
 (defvar frame-notice-user-settings t
   "Non-nil means function `frame-notice-user-settings' wasn't run yet.")
@@ -279,7 +291,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
        ;; Can't modify the minibuffer parameter, so don't try.
        (setq parms (delq (assq 'minibuffer parms) parms))
        (modify-frame-parameters nil
-                                (if (null window-system)
+                                (if (null initial-window-system)
                                     (append initial-frame-alist
                                             default-frame-alist
                                             parms
@@ -288,7 +300,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
                                   ;; default-frame-alist were already
                                   ;; applied in pc-win.el.
                                   parms))
-       (if (null window-system) ;; MS-DOS does this differently in pc-win.el
+       (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el
            (let ((newparms (frame-parameters))
                  (frame (selected-frame)))
              (tty-handle-reverse-video frame newparms)
@@ -567,12 +579,25 @@ is not considered (see `next-frame')."
   (select-frame-set-input-focus (selected-frame)))
 
 (defun make-frame-on-display (display &optional parameters)
-  "Make a frame on display DISPLAY.
+  "Make a frame on display DISPLAY.
 The optional second argument PARAMETERS specifies additional frame parameters."
   (interactive "sMake frame on display: ")
   (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
       (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
-  (make-frame (cons (cons 'display display) parameters)))
+  (when (and (boundp 'x-initialized) (not x-initialized))
+    (setq x-display-name display)
+    (x-initialize-window-system))
+  (make-frame `((window-system . x) (display . ,display) . ,parameters)))
+
+(defun make-frame-on-tty (device type &optional parameters)
+  "Make a frame on terminal DEVICE which is of type TYPE (e.g., \"xterm\").
+The optional third argument PARAMETERS specifies additional frame parameters."
+  (interactive "fOpen frame on tty device: \nsTerminal type of %s: ")
+  (unless device
+    (error "Invalid terminal device"))
+  (unless type
+    (error "Invalid terminal type"))
+  (make-frame `((window-system . nil) (tty . ,device) (tty-type . ,type) . ,parameters)))
 
 (defun make-frame-command ()
   "Make a new frame, and select it if the terminal displays only one frame."
@@ -612,7 +637,12 @@ You cannot specify either `width' or `height', you must use neither or both.
  (minibuffer . only)   The frame should contain only a minibuffer.
  (minibuffer . WINDOW) The frame should use WINDOW as its minibuffer window.
 
-Before the frame is created (via `frame-creation-function'), functions on the
+ (window-system . nil) The frame should be displayed on a terminal device.
+ (window-system . x)   The frame should be displayed in an X window.
+
+ (display-id . ID)      The frame should use the display identified by ID.
+
+Before the frame is created (via `frame-creation-function-alist'), functions on the
 hook `before-make-frame-hook' are run.  After the frame is created, functions
 on `after-make-frame-functions' are run with one arg, the newly created frame.
 
@@ -622,8 +652,24 @@ window system may select the new frame for its own reasons, for
 instance if the frame appears under the mouse pointer and your
 setup is for focus to follow the pointer."
   (interactive)
-  (run-hooks 'before-make-frame-hook)
-  (let ((frame (funcall frame-creation-function parameters)))
+  (let* ((w (cond
+            ((assq 'display-id parameters)
+             (let ((type (display-live-p (cdr (assq 'display-id parameters)))))
+               (cond
+                ((eq type t) nil)
+                ((eq type nil) (error "Display %s does not exist" (cdr (assq 'display-id parameters))))
+                (t type))))
+            ((assq 'window-system parameters)
+             (cdr (assq 'window-system parameters)))
+            (t window-system)))
+        (frame-creation-function (cdr (assq w frame-creation-function-alist)))
+        frame)
+    (unless frame-creation-function
+      (error "Don't know how to create a frame on window system %s" w))
+    (run-hooks 'before-make-frame-hook)
+    (setq frame (funcall frame-creation-function parameters))
+    (modify-frame-parameters frame
+                            (cdr (assq w window-system-default-frame-alist)))
     (run-hook-with-args 'after-make-frame-functions frame)
     frame))
 
@@ -645,20 +691,25 @@ setup is for focus to follow the pointer."
 
 (defun frames-on-display-list (&optional display)
   "Return a list of all frames on DISPLAY.
-DISPLAY is a name of a display, a string of the form HOST:SERVER.SCREEN.
+
+DISPLAY should be a display identifier (an integer), but it may
+also be a name of a display, a string of the form HOST:SERVER.SCREEN.
+
 If DISPLAY is omitted or nil, it defaults to the selected frame's display."
-  (let* ((display (or display (frame-parameter nil 'display)))
+  (let* ((display (or display (frame-display)))
         (func #'(lambda (frame)
-                  (equal (frame-parameter frame 'display) display))))
+                  (or (eq (frame-display frame) display)
+                      (equal (frame-parameter frame 'display) display)))))
     (filtered-frame-list func)))
 
 (defun framep-on-display (&optional display)
   "Return the type of frames on DISPLAY.
-DISPLAY may be a display name or a frame.  If it is a frame, its type is
-returned.
+DISPLAY may be a display id, a display name or a frame.  If it is
+a frame, its type is returned.
 If DISPLAY is omitted or nil, it defaults to the selected frame's display.
 All frames on a given display are of the same type."
-  (or (framep display)
+  (or (display-live-p display)
+      (framep display)
       (framep (car (frames-on-display-list display)))))
 
 (defun frame-remove-geometry-params (param-list)
@@ -696,9 +747,9 @@ automatically."
     (select-frame frame)
     (raise-frame frame)
     ;; Ensure, if possible, that frame gets input focus.
-    (cond ((eq window-system 'x)
+    (cond ((eq (window-system frame) 'x)
           (x-focus-frame frame))
-         ((eq window-system 'w32)
+         ((eq (window-system frame) 'w32)
           (w32-focus-frame frame)))
     (cond (focus-follows-mouse
           (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
@@ -735,6 +786,22 @@ Otherwise, that variable should be nil."
       (iconify-frame)
     (make-frame-visible)))
 
+(defun suspend-frame ()
+  "Do whatever is right to suspend the current frame.
+Calls `suspend-emacs' if invoked from the controlling terminal,
+`suspend-tty' from a secondary terminal, and
+`iconify-or-deiconify-frame' from an X frame."
+  (interactive)
+  (let ((type (framep (selected-frame))))
+    (cond
+     ((eq type 'x) (iconify-or-deiconify-frame))
+     ((eq type t)
+      (if (display-controlling-tty-p)
+         (suspend-emacs)
+       (suspend-tty)))
+     (t (suspend-emacs)))))
+
+
 (defun make-frame-names-alist ()
   (let* ((current-frame (selected-frame))
         (falist
@@ -768,9 +835,9 @@ If there is no frame by that name, signal an error."
     (raise-frame frame)
     (select-frame frame)
     ;; Ensure, if possible, that frame gets input focus.
-    (cond ((eq window-system 'x)
+    (cond ((eq (window-system frame) 'x)
           (x-focus-frame frame))
-         ((eq window-system 'w32)
+         ((eq (window-system frame) 'w32)
           (w32-focus-frame frame)))
     (when focus-follows-mouse
       (set-mouse-position frame (1- (frame-width frame)) 0))))
@@ -980,6 +1047,10 @@ bars (top, bottom, or nil)."
     (cons vert hor)))
 \f
 ;;;; Frame/display capabilities.
+(defun selected-display ()
+  "Return the display that is now selected."
+  (frame-display (selected-frame)))
+
 (defun display-mouse-p (&optional display)
   "Return non-nil if DISPLAY has a mouse available.
 DISPLAY can be a display name, a frame, or nil (meaning the selected
@@ -1131,7 +1202,7 @@ the question is inapplicable to a certain kind of display."
      ((eq frame-type 'pc)
       16)
      (t
-      (tty-display-color-cells)))))
+      (tty-display-color-cells display)))))
 
 (defun display-visual-class (&optional display)
   "Returns the visual class of DISPLAY.
@@ -1272,7 +1343,7 @@ cursor display.  On a text-only terminal, this is not implemented."
   :init-value (not (or noninteractive
                       (if (boundp 'no-blinking-cursor) no-blinking-cursor)
                       (eq system-type 'ms-dos)
-                      (not (memq window-system '(x w32)))))
+                      (not (memq initial-window-system '(x w32)))))
   :group 'cursor
   :global t
   (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer))
@@ -1354,6 +1425,8 @@ Use Custom to set this variable to get the display updated."
 (define-key ctl-x-5-map "0" 'delete-frame)
 (define-key ctl-x-5-map "o" 'other-frame)
 
+(substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
+
 (provide 'frame)
 
 ;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56