aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib-src/emacsclient.c4
-rw-r--r--lisp/frame.el53
-rw-r--r--lisp/server.el63
-rw-r--r--lisp/startup.el3
-rw-r--r--lisp/term/ns-win.el4
-rw-r--r--lisp/term/w32-win.el7
-rw-r--r--lisp/term/x-win.el5
-rw-r--r--src/w32fns.c11
8 files changed, 93 insertions, 57 deletions
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 9c222b6be66..8d60d7961da 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -597,7 +597,7 @@ decode_options (int argc, char **argv)
597#if defined (NS_IMPL_COCOA) 597#if defined (NS_IMPL_COCOA)
598 alt_display = "ns"; 598 alt_display = "ns";
599#elif defined (HAVE_NTGUI) 599#elif defined (HAVE_NTGUI)
600 alt_display = "windows"; 600 alt_display = "w32";
601#endif 601#endif
602 602
603 display = egetenv ("DISPLAY"); 603 display = egetenv ("DISPLAY");
@@ -1599,7 +1599,7 @@ main (int argc, char **argv)
1599 } 1599 }
1600 1600
1601#ifdef HAVE_NTGUI 1601#ifdef HAVE_NTGUI
1602 if (display && !strcmp (display, "windows")) 1602 if (display && !strcmp (display, "w32"))
1603 w32_give_focus (); 1603 w32_give_focus ();
1604#endif /* HAVE_NTGUI */ 1604#endif /* HAVE_NTGUI */
1605 1605
diff --git a/lisp/frame.el b/lisp/frame.el
index 9be64a6b7ff..1e8883eb98e 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -25,6 +25,8 @@
25;;; Commentary: 25;;; Commentary:
26 26
27;;; Code: 27;;; Code:
28(eval-when-compile (require 'cl-lib))
29
28(defvar frame-creation-function-alist 30(defvar frame-creation-function-alist
29 (list (cons nil 31 (list (cons nil
30 (if (fboundp 'tty-create-frame-with-faces) 32 (if (fboundp 'tty-create-frame-with-faces)
@@ -45,6 +47,12 @@ Then, for frames on WINDOW-SYSTEM, any parameters specified in
45ALIST supersede the corresponding parameters specified in 47ALIST supersede the corresponding parameters specified in
46`default-frame-alist'.") 48`default-frame-alist'.")
47 49
50(defvar display-format-alist nil
51 "Alist of patterns to decode display names.
52The car of each entry is a regular expression matching a display
53name string. The cdr is a symbol giving the window-system that
54handles the corresponding kind of display.")
55
48;; The initial value given here used to ask for a minibuffer. 56;; The initial value given here used to ask for a minibuffer.
49;; But that's not necessary, because the default is to have one. 57;; But that's not necessary, because the default is to have one.
50;; By not specifying it here, we let an X resource specify it. 58;; By not specifying it here, we let an X resource specify it.
@@ -510,31 +518,19 @@ is not considered (see `next-frame')."
510 0)) 518 0))
511 (select-frame-set-input-focus (selected-frame))) 519 (select-frame-set-input-focus (selected-frame)))
512 520
513(declare-function x-initialize-window-system "term/x-win" ()) 521(defun window-system-for-display (display)
514(declare-function ns-initialize-window-system "term/ns-win" ()) 522 "Return the window system for DISPLAY.
515(defvar x-display-name) ; term/x-win 523Return nil if we don't know how to interpret DISPLAY."
524 (cl-loop for descriptor in display-format-alist
525 for pattern = (car descriptor)
526 for system = (cdr descriptor)
527 when (string-match-p pattern display) return system))
516 528
517(defun make-frame-on-display (display &optional parameters) 529(defun make-frame-on-display (display &optional parameters)
518 "Make a frame on display DISPLAY. 530 "Make a frame on display DISPLAY.
519The optional argument PARAMETERS specifies additional frame parameters." 531The optional argument PARAMETERS specifies additional frame parameters."
520 (interactive "sMake frame on display: ") 532 (interactive "sMake frame on display: ")
521 (cond ((featurep 'ns) 533 (make-frame (cons (cons 'display display) parameters)))
522 (when (and (boundp 'ns-initialized) (not ns-initialized))
523 (setq x-display-name display)
524 (ns-initialize-window-system))
525 (make-frame `((window-system . ns)
526 (display . ,display) . ,parameters)))
527 ((eq window-system 'w32)
528 ;; On Windows, ignore DISPLAY.
529 (make-frame parameters))
530 (t
531 (unless (string-match-p "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
532 (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
533 (when (and (boundp 'x-initialized) (not x-initialized))
534 (setq x-display-name display)
535 (x-initialize-window-system))
536 (make-frame `((window-system . x)
537 (display . ,display) . ,parameters)))))
538 534
539(declare-function x-close-connection "xfns.c" (terminal)) 535(declare-function x-close-connection "xfns.c" (terminal))
540 536
@@ -616,6 +612,8 @@ neither or both.
616 (window-system . nil) The frame should be displayed on a terminal device. 612 (window-system . nil) The frame should be displayed on a terminal device.
617 (window-system . x) The frame should be displayed in an X window. 613 (window-system . x) The frame should be displayed in an X window.
618 614
615 (display . \":0\") The frame should appear on display :0.
616
619 (terminal . TERMINAL) The frame should use the terminal object TERMINAL. 617 (terminal . TERMINAL) The frame should use the terminal object TERMINAL.
620 618
621In addition, any parameter specified in `default-frame-alist', 619In addition, any parameter specified in `default-frame-alist',
@@ -626,11 +624,15 @@ this function runs the hook `before-make-frame-hook'. After
626creating the frame, it runs the hook `after-make-frame-functions' 624creating the frame, it runs the hook `after-make-frame-functions'
627with one arg, the newly created frame. 625with one arg, the newly created frame.
628 626
627If a display parameter is supplied and a window-system is not,
628guess the window-system from the display.
629
629On graphical displays, this function does not itself make the new 630On graphical displays, this function does not itself make the new
630frame the selected frame. However, the window system may select 631frame the selected frame. However, the window system may select
631the new frame according to its own rules." 632the new frame according to its own rules."
632 (interactive) 633 (interactive)
633 (let* ((w (cond 634 (let* ((display (cdr (assq 'display parameters)))
635 (w (cond
634 ((assq 'terminal parameters) 636 ((assq 'terminal parameters)
635 (let ((type (terminal-live-p (cdr (assq 'terminal parameters))))) 637 (let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
636 (cond 638 (cond
@@ -640,6 +642,10 @@ the new frame according to its own rules."
640 (t type)))) 642 (t type))))
641 ((assq 'window-system parameters) 643 ((assq 'window-system parameters)
642 (cdr (assq 'window-system parameters))) 644 (cdr (assq 'window-system parameters)))
645 (display
646 (or (window-system-for-display display)
647 (error "Don't know how to interpret display \"%S\""
648 display)))
643 (t window-system))) 649 (t window-system)))
644 (frame-creation-function (cdr (assq w frame-creation-function-alist))) 650 (frame-creation-function (cdr (assq w frame-creation-function-alist)))
645 (oldframe (selected-frame)) 651 (oldframe (selected-frame))
@@ -647,6 +653,11 @@ the new frame according to its own rules."
647 frame) 653 frame)
648 (unless frame-creation-function 654 (unless frame-creation-function
649 (error "Don't know how to create a frame on window system %s" w)) 655 (error "Don't know how to create a frame on window system %s" w))
656
657 (unless (get w 'window-system-initialized)
658 (funcall (cdr (assq w window-system-initialization-alist)))
659 (put w 'window-system-initialized t))
660
650 ;; Add parameters from `window-system-default-frame-alist'. 661 ;; Add parameters from `window-system-default-frame-alist'.
651 (dolist (p (cdr (assq w window-system-default-frame-alist))) 662 (dolist (p (cdr (assq w window-system-default-frame-alist)))
652 (unless (assq (car p) params) 663 (unless (assq (car p) params)
diff --git a/lisp/server.el b/lisp/server.el
index d45c7c28482..32cecd508b5 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -826,35 +826,40 @@ This handles splitting the command if it would be bigger than
826 826
827(defun server-create-window-system-frame (display nowait proc parent-id 827(defun server-create-window-system-frame (display nowait proc parent-id
828 &optional parameters) 828 &optional parameters)
829 (add-to-list 'frame-inherited-parameters 'client) 829 (let* ((display (or display
830 (if (not (fboundp 'make-frame-on-display)) 830 (frame-parameter nil 'display)
831 (progn 831 (error "Please specify display.")))
832 ;; This emacs does not support X. 832 (w (or (cdr (assq 'window-system parameters))
833 (server-log "Window system unsupported" proc) 833 (window-system-for-display display))))
834 (server-send-string proc "-window-system-unsupported \n") 834
835 nil) 835 (unless (assq w window-system-initialization-alist)
836 ;; Flag frame as client-created, but use a dummy client. 836 (setq w nil))
837 ;; This will prevent the frame from being deleted when 837
838 ;; emacsclient quits while also preventing 838 (cond (w
839 ;; `server-save-buffers-kill-terminal' from unexpectedly 839 ;; Flag frame as client-created, but use a dummy client.
840 ;; killing emacs on that frame. 840 ;; This will prevent the frame from being deleted when
841 (let* ((params `((client . ,(if nowait 'nowait proc)) 841 ;; emacsclient quits while also preventing
842 ;; This is a leftover, see above. 842 ;; `server-save-buffers-kill-terminal' from unexpectedly
843 (environment . ,(process-get proc 'env)) 843 ;; killing emacs on that frame.
844 ,@parameters)) 844 (let* ((params `((client . ,(if nowait 'nowait proc))
845 (display (or display 845 ;; This is a leftover, see above.
846 (frame-parameter nil 'display) 846 (environment . ,(process-get proc 'env))
847 (getenv "DISPLAY") 847 ,@parameters))
848 (error "Please specify display"))) 848 frame)
849 frame) 849 (if parent-id
850 (if parent-id 850 (push (cons 'parent-id (string-to-number parent-id)) params))
851 (push (cons 'parent-id (string-to-number parent-id)) params)) 851 (add-to-list 'frame-inherited-parameters 'client)
852 (setq frame (make-frame-on-display display params)) 852 (setq frame (make-frame-on-display display params))
853 (server-log (format "%s created" frame) proc) 853 (server-log (format "%s created" frame) proc)
854 (select-frame frame) 854 (select-frame frame)
855 (process-put proc 'frame frame) 855 (process-put proc 'frame frame)
856 (process-put proc 'terminal (frame-terminal frame)) 856 (process-put proc 'terminal (frame-terminal frame))
857 frame))) 857 frame))
858
859 (t
860 (server-log "Window system unsupported" proc)
861 (server-send-string proc "-window-system-unsupported \n")
862 nil))))
858 863
859(defun server-goto-toplevel (proc) 864(defun server-goto-toplevel (proc)
860 (condition-case nil 865 (condition-case nil
diff --git a/lisp/startup.el b/lisp/startup.el
index 348e653dd28..dd216638905 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -882,7 +882,8 @@ Amongst another things, it parses the command-line arguments."
882 ;; Initialize the window system. (Open connection, etc.) 882 ;; Initialize the window system. (Open connection, etc.)
883 (funcall 883 (funcall
884 (or (cdr (assq initial-window-system window-system-initialization-alist)) 884 (or (cdr (assq initial-window-system window-system-initialization-alist))
885 (error "Unsupported window system `%s'" initial-window-system)))) 885 (error "Unsupported window system `%s'" initial-window-system)))
886 (put initial-window-system 'window-system-initialized t))
886 ;; If there was an error, print the error message and exit. 887 ;; If there was an error, print the error message and exit.
887 (error 888 (error
888 (princ 889 (princ
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 06b67475c1d..b46c31afdeb 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -39,7 +39,7 @@
39;; this file, which works in close coordination with src/nsfns.m. 39;; this file, which works in close coordination with src/nsfns.m.
40 40
41;;; Code: 41;;; Code:
42 42(eval-when-compile (require 'cl-lib))
43(or (featurep 'ns) 43(or (featurep 'ns)
44 (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS" 44 (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS"
45 (invocation-name))) 45 (invocation-name)))
@@ -897,6 +897,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
897;; defines functions and variables that we use now. 897;; defines functions and variables that we use now.
898(defun ns-initialize-window-system () 898(defun ns-initialize-window-system ()
899 "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing." 899 "Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
900 (cl-assert (not ns-initialized))
900 901
901 ;; PENDING: not needed? 902 ;; PENDING: not needed?
902 (setq command-line-args (x-handle-args command-line-args)) 903 (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.")
924 (x-apply-session-resources) 925 (x-apply-session-resources)
925 (setq ns-initialized t)) 926 (setq ns-initialized t))
926 927
928(add-to-list 'display-format-alist '("\\`ns\\'" . ns))
927(add-to-list 'handle-args-function-alist '(ns . x-handle-args)) 929(add-to-list 'handle-args-function-alist '(ns . x-handle-args))
928(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces)) 930(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
929(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system)) 931(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 dd577af0ae1..841a45c23a2 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -68,6 +68,7 @@
68;; (if (not (eq window-system 'w32)) 68;; (if (not (eq window-system 'w32))
69;; (error "%s: Loading w32-win.el but not compiled for w32" (invocation-name))) 69;; (error "%s: Loading w32-win.el but not compiled for w32" (invocation-name)))
70 70
71(eval-when-compile (require 'cl-lib))
71(require 'frame) 72(require 'frame)
72(require 'mouse) 73(require 'mouse)
73(require 'scroll-bar) 74(require 'scroll-bar)
@@ -240,6 +241,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
240 241
241(defun w32-initialize-window-system () 242(defun w32-initialize-window-system ()
242 "Initialize Emacs for W32 GUI frames." 243 "Initialize Emacs for W32 GUI frames."
244 (cl-assert (not w32-initialized))
243 245
244 ;; Do the actual Windows setup here; the above code just defines 246 ;; Do the actual Windows setup here; the above code just defines
245 ;; functions and variables that we use now. 247 ;; functions and variables that we use now.
@@ -253,7 +255,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
253 ;; so as not to choke when we use it in X resource queries. 255 ;; so as not to choke when we use it in X resource queries.
254 (replace-regexp-in-string "[.*]" "-" (invocation-name)))) 256 (replace-regexp-in-string "[.*]" "-" (invocation-name))))
255 257
256 (x-open-connection "" x-command-line-resources 258 (x-open-connection "w32" x-command-line-resources
257 ;; Exit with a fatal error if this fails and we 259 ;; Exit with a fatal error if this fails and we
258 ;; are the initial display 260 ;; are the initial display
259 (eq initial-window-system 'w32)) 261 (eq initial-window-system 'w32))
@@ -304,7 +306,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
304 (setq default-frame-alist 306 (setq default-frame-alist
305 (cons '(reverse . t) default-frame-alist))))) 307 (cons '(reverse . t) default-frame-alist)))))
306 308
307 ;; Don't let Emacs suspend under w32 gui 309 ;; Don't let Emacs suspend under Windows.
308 (add-hook 'suspend-hook 'x-win-suspend-error) 310 (add-hook 'suspend-hook 'x-win-suspend-error)
309 311
310 ;; Turn off window-splitting optimization; w32 is usually fast enough 312 ;; 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.")
322 (x-apply-session-resources) 324 (x-apply-session-resources)
323 (setq w32-initialized t)) 325 (setq w32-initialized t))
324 326
327(add-to-list 'display-format-alist '("\\`w32\\'" . w32))
325(add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) 328(add-to-list 'handle-args-function-alist '(w32 . x-handle-args))
326(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces)) 329(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces))
327(add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system)) 330(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 9b7254cd132..2f2125a31db 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -67,6 +67,8 @@
67;; An alist of X options and the function which handles them. See 67;; An alist of X options and the function which handles them. See
68;; ../startup.el. 68;; ../startup.el.
69 69
70(eval-when-compile (require 'cl-lib))
71
70(if (not (fboundp 'x-create-frame)) 72(if (not (fboundp 'x-create-frame))
71 (error "%s: Loading x-win.el but not compiled for X" (invocation-name))) 73 (error "%s: Loading x-win.el but not compiled for X" (invocation-name)))
72 74
@@ -1338,6 +1340,8 @@ Request data types in the order specified by `x-select-request-type'."
1338 1340
1339(defun x-initialize-window-system () 1341(defun x-initialize-window-system ()
1340 "Initialize Emacs for X frames and open the first connection to an X server." 1342 "Initialize Emacs for X frames and open the first connection to an X server."
1343 (cl-assert (not x-initialized))
1344
1341 ;; Make sure we have a valid resource name. 1345 ;; Make sure we have a valid resource name.
1342 (or (stringp x-resource-name) 1346 (or (stringp x-resource-name)
1343 (let (i) 1347 (let (i)
@@ -1451,6 +1455,7 @@ Request data types in the order specified by `x-select-request-type'."
1451 (x-apply-session-resources) 1455 (x-apply-session-resources)
1452 (setq x-initialized t)) 1456 (setq x-initialized t))
1453 1457
1458(add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x))
1454(add-to-list 'handle-args-function-alist '(x . x-handle-args)) 1459(add-to-list 'handle-args-function-alist '(x . x-handle-args))
1455(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces)) 1460(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces))
1456(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system)) 1461(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system))
diff --git a/src/w32fns.c b/src/w32fns.c
index 16a2fb4dfdd..aa7d6c7a0ea 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -4892,12 +4892,21 @@ terminate Emacs if we can't open the connection.
4892 unsigned char *xrm_option; 4892 unsigned char *xrm_option;
4893 struct w32_display_info *dpyinfo; 4893 struct w32_display_info *dpyinfo;
4894 4894
4895 CHECK_STRING (display);
4896
4897 /* Signal an error in order to encourage correct use from callers.
4898 * If we ever support multiple window systems in the same Emacs,
4899 * we'll need callers to be precise about what window system they
4900 * want. */
4901
4902 if (strcmp (SSDATA (display), "w32") != 0)
4903 error ("The name of the display in this Emacs must be \"w32\"");
4904
4895 /* If initialization has already been done, return now to avoid 4905 /* If initialization has already been done, return now to avoid
4896 overwriting critical parts of one_w32_display_info. */ 4906 overwriting critical parts of one_w32_display_info. */
4897 if (w32_in_use) 4907 if (w32_in_use)
4898 return Qnil; 4908 return Qnil;
4899 4909
4900 CHECK_STRING (display);
4901 if (! NILP (xrm_string)) 4910 if (! NILP (xrm_string))
4902 CHECK_STRING (xrm_string); 4911 CHECK_STRING (xrm_string);
4903 4912