Commit efc3dd3c authored by Daniel Colascione's avatar Daniel Colascione
Browse files

Detect window-system from display name

parent ce9f00e4
......@@ -597,7 +597,7 @@ decode_options (int argc, char **argv)
#if defined (NS_IMPL_COCOA)
alt_display = "ns";
#elif defined (HAVE_NTGUI)
alt_display = "windows";
alt_display = "w32";
#endif
display = egetenv ("DISPLAY");
......@@ -1599,7 +1599,7 @@ main (int argc, char **argv)
}
#ifdef HAVE_NTGUI
if (display && !strcmp (display, "windows"))
if (display && !strcmp (display, "w32"))
w32_give_focus ();
#endif /* HAVE_NTGUI */
......
......@@ -25,6 +25,8 @@
;;; Commentary:
;;; Code:
(eval-when-compile (require 'cl-lib))
(defvar frame-creation-function-alist
(list (cons nil
(if (fboundp 'tty-create-frame-with-faces)
......@@ -45,6 +47,12 @@ Then, for frames on WINDOW-SYSTEM, any parameters specified in
ALIST supersede the corresponding parameters specified in
`default-frame-alist'.")
(defvar display-format-alist nil
"Alist of patterns to decode display names.
The car of each entry is a regular expression matching a display
name string. The cdr is a symbol giving the window-system that
handles the corresponding kind of display.")
;; The initial value given here used to ask for a minibuffer.
;; But that's not necessary, because the default is to have one.
;; By not specifying it here, we let an X resource specify it.
......@@ -510,31 +518,19 @@ is not considered (see `next-frame')."
0))
(select-frame-set-input-focus (selected-frame)))
(declare-function x-initialize-window-system "term/x-win" ())
(declare-function ns-initialize-window-system "term/ns-win" ())
(defvar x-display-name) ; term/x-win
(defun window-system-for-display (display)
"Return the window system for DISPLAY.
Return nil if we don't know how to interpret DISPLAY."
(cl-loop for descriptor in display-format-alist
for pattern = (car descriptor)
for system = (cdr descriptor)
when (string-match-p pattern display) return system))
(defun make-frame-on-display (display &optional parameters)
"Make a frame on display DISPLAY.
The optional argument PARAMETERS specifies additional frame parameters."
(interactive "sMake frame on display: ")
(cond ((featurep 'ns)
(when (and (boundp 'ns-initialized) (not ns-initialized))
(setq x-display-name display)
(ns-initialize-window-system))
(make-frame `((window-system . ns)
(display . ,display) . ,parameters)))
((eq window-system 'w32)
;; On Windows, ignore DISPLAY.
(make-frame parameters))
(t
(unless (string-match-p "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
(error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
(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)))))
(make-frame (cons (cons 'display display) parameters)))
(declare-function x-close-connection "xfns.c" (terminal))
......@@ -616,6 +612,8 @@ neither or both.
(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 . \":0\") The frame should appear on display :0.
(terminal . TERMINAL) The frame should use the terminal object TERMINAL.
In addition, any parameter specified in `default-frame-alist',
......@@ -626,11 +624,15 @@ this function runs the hook `before-make-frame-hook'. After
creating the frame, it runs the hook `after-make-frame-functions'
with one arg, the newly created frame.
If a display parameter is supplied and a window-system is not,
guess the window-system from the display.
On graphical displays, this function does not itself make the new
frame the selected frame. However, the window system may select
the new frame according to its own rules."
(interactive)
(let* ((w (cond
(let* ((display (cdr (assq 'display parameters)))
(w (cond
((assq 'terminal parameters)
(let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
(cond
......@@ -640,6 +642,10 @@ the new frame according to its own rules."
(t type))))
((assq 'window-system parameters)
(cdr (assq 'window-system parameters)))
(display
(or (window-system-for-display display)
(error "Don't know how to interpret display \"%S\""
display)))
(t window-system)))
(frame-creation-function (cdr (assq w frame-creation-function-alist)))
(oldframe (selected-frame))
......@@ -647,6 +653,11 @@ the new frame according to its own rules."
frame)
(unless frame-creation-function
(error "Don't know how to create a frame on window system %s" w))
(unless (get w 'window-system-initialized)
(funcall (cdr (assq w window-system-initialization-alist)))
(put w 'window-system-initialized t))
;; Add parameters from `window-system-default-frame-alist'.
(dolist (p (cdr (assq w window-system-default-frame-alist)))
(unless (assq (car p) params)
......
......@@ -826,35 +826,40 @@ This handles splitting the command if it would be bigger than
(defun server-create-window-system-frame (display nowait proc parent-id
&optional parameters)
(add-to-list 'frame-inherited-parameters 'client)
(if (not (fboundp 'make-frame-on-display))
(progn
;; This emacs does not support X.
(server-log "Window system unsupported" proc)
(server-send-string proc "-window-system-unsupported \n")
nil)
;; Flag frame as client-created, but use a dummy client.
;; This will prevent the frame from being deleted when
;; emacsclient quits while also preventing
;; `server-save-buffers-kill-terminal' from unexpectedly
;; killing emacs on that frame.
(let* ((params `((client . ,(if nowait 'nowait proc))
;; This is a leftover, see above.
(environment . ,(process-get proc 'env))
,@parameters))
(display (or display
(frame-parameter nil 'display)
(getenv "DISPLAY")
(error "Please specify display")))
frame)
(if parent-id
(push (cons 'parent-id (string-to-number parent-id)) params))
(setq frame (make-frame-on-display display params))
(server-log (format "%s created" frame) proc)
(select-frame frame)
(process-put proc 'frame frame)
(process-put proc 'terminal (frame-terminal frame))
frame)))
(let* ((display (or display
(frame-parameter nil 'display)
(error "Please specify display.")))
(w (or (cdr (assq 'window-system parameters))
(window-system-for-display display))))
(unless (assq w window-system-initialization-alist)
(setq w nil))
(cond (w
;; Flag frame as client-created, but use a dummy client.
;; This will prevent the frame from being deleted when
;; emacsclient quits while also preventing
;; `server-save-buffers-kill-terminal' from unexpectedly
;; killing emacs on that frame.
(let* ((params `((client . ,(if nowait 'nowait proc))
;; This is a leftover, see above.
(environment . ,(process-get proc 'env))
,@parameters))
frame)
(if parent-id
(push (cons 'parent-id (string-to-number parent-id)) params))
(add-to-list 'frame-inherited-parameters 'client)
(setq frame (make-frame-on-display display params))
(server-log (format "%s created" frame) proc)
(select-frame frame)
(process-put proc 'frame frame)
(process-put proc 'terminal (frame-terminal frame))
frame))
(t
(server-log "Window system unsupported" proc)
(server-send-string proc "-window-system-unsupported \n")
nil))))
(defun server-goto-toplevel (proc)
(condition-case nil
......
......@@ -882,7 +882,8 @@ Amongst another things, it parses the command-line arguments."
;; Initialize the window system. (Open connection, etc.)
(funcall
(or (cdr (assq initial-window-system window-system-initialization-alist))
(error "Unsupported window system `%s'" initial-window-system))))
(error "Unsupported window system `%s'" initial-window-system)))
(put initial-window-system 'window-system-initialized t))
;; If there was an error, print the error message and exit.
(error
(princ
......
......@@ -39,7 +39,7 @@
;; this file, which works in close coordination with src/nsfns.m.
;;; Code:
(eval-when-compile (require 'cl-lib))
(or (featurep 'ns)
(error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
(invocation-name)))
......@@ -897,6 +897,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; defines functions and variables that we use now.
(defun ns-initialize-window-system ()
"Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
(cl-assert (not ns-initialized))
;; PENDING: not needed?
(setq command-line-args (x-handle-args command-line-args))
......@@ -924,6 +925,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(x-apply-session-resources)
(setq ns-initialized t))
(add-to-list 'display-format-alist '("\\`ns\\'" . ns))
(add-to-list 'handle-args-function-alist '(ns . x-handle-args))
(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system))
......
......@@ -68,6 +68,7 @@
;; (if (not (eq window-system 'w32))
;; (error "%s: Loading w32-win.el but not compiled for w32" (invocation-name)))
(eval-when-compile (require 'cl-lib))
(require 'frame)
(require 'mouse)
(require 'scroll-bar)
......@@ -240,6 +241,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(defun w32-initialize-window-system ()
"Initialize Emacs for W32 GUI frames."
(cl-assert (not w32-initialized))
;; Do the actual Windows setup here; the above code just defines
;; functions and variables that we use now.
......@@ -253,7 +255,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; so as not to choke when we use it in X resource queries.
(replace-regexp-in-string "[.*]" "-" (invocation-name))))
(x-open-connection "" x-command-line-resources
(x-open-connection "w32" x-command-line-resources
;; Exit with a fatal error if this fails and we
;; are the initial display
(eq initial-window-system 'w32))
......@@ -304,7 +306,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(setq default-frame-alist
(cons '(reverse . t) default-frame-alist)))))
;; Don't let Emacs suspend under w32 gui
;; Don't let Emacs suspend under Windows.
(add-hook 'suspend-hook 'x-win-suspend-error)
;; Turn off window-splitting optimization; w32 is usually fast enough
......@@ -322,6 +324,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(x-apply-session-resources)
(setq w32-initialized t))
(add-to-list 'display-format-alist '("\\`w32\\'" . w32))
(add-to-list 'handle-args-function-alist '(w32 . x-handle-args))
(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces))
(add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system))
......
......@@ -67,6 +67,8 @@
;; An alist of X options and the function which handles them. See
;; ../startup.el.
(eval-when-compile (require 'cl-lib))
(if (not (fboundp 'x-create-frame))
(error "%s: Loading x-win.el but not compiled for X" (invocation-name)))
......@@ -1338,6 +1340,8 @@ Request data types in the order specified by `x-select-request-type'."
(defun x-initialize-window-system ()
"Initialize Emacs for X frames and open the first connection to an X server."
(cl-assert (not x-initialized))
;; Make sure we have a valid resource name.
(or (stringp x-resource-name)
(let (i)
......@@ -1451,6 +1455,7 @@ Request data types in the order specified by `x-select-request-type'."
(x-apply-session-resources)
(setq x-initialized t))
(add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x))
(add-to-list 'handle-args-function-alist '(x . x-handle-args))
(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces))
(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system))
......
......@@ -4892,12 +4892,21 @@ terminate Emacs if we can't open the connection.
unsigned char *xrm_option;
struct w32_display_info *dpyinfo;
CHECK_STRING (display);
/* Signal an error in order to encourage correct use from callers.
* If we ever support multiple window systems in the same Emacs,
* we'll need callers to be precise about what window system they
* want. */
if (strcmp (SSDATA (display), "w32") != 0)
error ("The name of the display in this Emacs must be \"w32\"");
/* If initialization has already been done, return now to avoid
overwriting critical parts of one_w32_display_info. */
if (w32_in_use)
return Qnil;
CHECK_STRING (display);
if (! NILP (xrm_string))
CHECK_STRING (xrm_string);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment