From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Daniel Colascione Newsgroups: gmane.emacs.devel Subject: [PATCH 9/9] Detect window-system from display name Date: Tue, 07 Aug 2012 01:19:27 -0700 Message-ID: <94f53f9a4d2d8ebe852360652eeee429520f3d9f.1344326992.git.dancol@dancol.org> References: NNTP-Posting-Host: plane.gmane.org X-Trace: dough.gmane.org 1344327610 1019 80.91.229.3 (7 Aug 2012 08:20:10 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Tue, 7 Aug 2012 08:20:10 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Aug 07 10:20:10 2012 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Syf1O-0003bG-EO for ged-emacs-devel@m.gmane.org; Tue, 07 Aug 2012 10:20:10 +0200 Original-Received: from localhost ([::1]:52455 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Syf1N-000281-IY for ged-emacs-devel@m.gmane.org; Tue, 07 Aug 2012 04:20:09 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:57406) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Syf0u-0000go-17 for emacs-devel@gnu.org; Tue, 07 Aug 2012 04:19:46 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Syf0n-0007kQ-U8 for emacs-devel@gnu.org; Tue, 07 Aug 2012 04:19:39 -0400 Original-Received: from dancol.org ([96.126.100.184]:37137) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Syf0n-0007ig-LT for emacs-devel@gnu.org; Tue, 07 Aug 2012 04:19:33 -0400 Original-Received: from dancol by dancol.org with local (Exim 4.72) (envelope-from ) id 1Syf0h-0006qE-8e for emacs-devel@gnu.org; Tue, 07 Aug 2012 01:19:27 -0700 In-Reply-To: X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 96.126.100.184 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:152241 Archived-At: --- 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