diff options
| -rw-r--r-- | lib-src/emacsclient.c | 4 | ||||
| -rw-r--r-- | lisp/frame.el | 53 | ||||
| -rw-r--r-- | lisp/server.el | 63 | ||||
| -rw-r--r-- | lisp/startup.el | 3 | ||||
| -rw-r--r-- | lisp/term/ns-win.el | 4 | ||||
| -rw-r--r-- | lisp/term/w32-win.el | 7 | ||||
| -rw-r--r-- | lisp/term/x-win.el | 5 | ||||
| -rw-r--r-- | src/w32fns.c | 11 |
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) #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 */ 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 @@ ;;; 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 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 (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 348e653dd28..dd216638905 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 06b67475c1d..b46c31afdeb 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 dd577af0ae1..841a45c23a2 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 "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)) 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 @@ ;; 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)) 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. 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); |