[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 9/9] Detect window-system from display name
From: |
Daniel Colascione |
Subject: |
[PATCH 9/9] Detect window-system from display name |
Date: |
Tue, 07 Aug 2012 01:19:27 -0700 |
---
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
- Re: [PATCH 6/9] Rename `w32' local to `nt' for clarity, (continued)
[PATCH 4/9] Fix emacsclient to work with cygw32, Daniel Colascione, 2012/08/07
[PATCH 5/9] Prevent crash if w32 used before it's initialized, Daniel Colascione, 2012/08/07
[PATCH 9/9] Detect window-system from display name,
Daniel Colascione <=
- Re: [PATCH 9/9] Detect window-system from display name, Stefan Monnier, 2012/08/07
- Re: [PATCH 9/9] Detect window-system from display name, Daniel Colascione, 2012/08/07
- Re: [PATCH 9/9] Detect window-system from display name, Stefan Monnier, 2012/08/07
- Re: [PATCH 9/9] Detect window-system from display name, Daniel Colascione, 2012/08/07
- Re: [PATCH 9/9] Detect window-system from display name, Lennart Borgman, 2012/08/07
- Re: [PATCH 9/9] Detect window-system from display name, Daniel Colascione, 2012/08/07
- Re: [PATCH 9/9] Detect window-system from display name, Lennart Borgman, 2012/08/07
Re: [PATCH 9/9] Detect window-system from display name, Eli Zaretskii, 2012/08/07
Re: [PATCH 9/9] Detect window-system from display name, Eli Zaretskii, 2012/08/08