[PATCH 9/9] Detect window-system from display name

[Daniel Colascione <dancol@dancol.org>]

---
 lisp/frame.el        |   53 +++++++++++++++++++++++++----------------
 lisp/server.el       |   63 +++++++++++++++++++++++++++-----------------------
 lisp/startup.el      |    3 +-
 lisp/term/ns-win.el  |    4 ++-
 lisp/term/w32-win.el |    7 ++++-
 lisp/term/x-win.el   |    5 ++++
 src/w32fns.c         |    5 +++-
 7 files changed, 85 insertions(+), 55 deletions(-)

diff --git a/lisp/frame.el b/lisp/frame.el
index 6d6da07..5df2b73 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -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)
diff --git a/lisp/server.el b/lisp/server.el
index 656be75..f595669 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -827,35 +827,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
diff --git a/lisp/startup.el b/lisp/startup.el
index 348e653..dd21663 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -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
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 06b6747..b46c31a 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -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))
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index dd577af..d6d1da8 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -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 "windows" 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 '("\\`windows\\'" . 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))
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index fb7389b..b5dfa23 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -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)))
 
@@ -1341,6 +1343,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)
@@ -1454,6 +1458,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))
diff --git a/src/w32fns.c b/src/w32fns.c
index 9743822..4d5e133 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -4871,12 +4871,15 @@ terminate Emacs if we can't open the connection.
   unsigned char *xrm_option;
   struct w32_display_info *dpyinfo;
 
+  CHECK_STRING (display);
+  if (strcmp (SSDATA (display), "windows"))
+    error ("The name of the Windows display must be \"windows\"");
+
   /* 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);
 
-- 
1.7.2.5