diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/cus-face.el | 11 | ||||
| -rw-r--r-- | lisp/faces.el | 6 | ||||
| -rw-r--r-- | lisp/frame.el | 77 | ||||
| -rw-r--r-- | lisp/loadup.el | 3 | ||||
| -rw-r--r-- | lisp/startup.el | 33 | ||||
| -rw-r--r-- | lisp/term/x-win.el | 13 |
6 files changed, 79 insertions, 64 deletions
diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 1ff07c4c361..b5716da161a 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -41,6 +41,7 @@ ;; If the user has already created the face, respect that. (let ((value (or (get face 'saved-face) spec)) (frames (frame-list)) + (have-window-system (memq initial-window-system '(x w32))) frame) ;; Create global face. (make-empty-face face) @@ -48,10 +49,12 @@ (while frames (setq frame (car frames) frames (cdr frames)) - (face-spec-set face value frame))) - ;; When making a face after frames already exist - (if (memq window-system '(x w32)) - (make-face-x-resource-internal face)))) + (face-spec-set face value frame) + (when (memq (window-system frame) '(x w32)) + (setq have-window-system t))) + ;; When making a face after frames already exist + (if have-window-system + (make-face-x-resource-internal face))))) ;; Don't record SPEC until we see it causes no errors. (put face 'face-defface-spec spec) (when (and doc (null (face-documentation face))) diff --git a/lisp/faces.el b/lisp/faces.el index 42abb1e7ac4..4877fd246e0 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1658,8 +1658,7 @@ Value is the new frame created." (setq parameters (x-handle-named-frame-geometry parameters)) (let ((visibility-spec (assq 'visibility parameters)) (frame-list (frame-list)) - (frame (x-create-frame `((frame-creation-function . x-create-frame-with-faces) - (visibility . nil) . ,parameters))) + (frame (x-create-frame `((window-system . x) (visibility . nil) . ,parameters))) success) (unwind-protect (progn @@ -1745,8 +1744,7 @@ Parameters not specified by PARAMETERS are taken from `default-frame-alist'. If either PARAMETERS or `default-frame-alist' contains a `reverse' parameter, handle that. Value is the new frame created." - (let ((frame (make-terminal-frame `((frame-creation-function . tty-create-frame-with-faces) . - ,parameters))) + (let ((frame (make-terminal-frame `((window-system . nil) . ,parameters))) success) (unwind-protect (progn diff --git a/lisp/frame.el b/lisp/frame.el index f5c1e645ff3..2175bdd8615 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -27,12 +27,17 @@ ;;; Code: -(defvar frame-creation-function nil - "Window-system dependent function to call to create a new frame. -The window system startup file should set this to its frame creation -function, which should take an alist of parameters as its argument.") - -(make-variable-frame-local 'frame-creation-function) +(defvar frame-creation-function-alist + (list (cons nil + (if (fboundp 'tty-create-frame-with-faces) + 'tty-create-frame-with-faces + (function + (lambda (parameters) + (error "Can't create multiple frames without a window system")))))) + "Alist of window-system dependent functions to call to create a new frame. +The window system startup file should add its frame creation +function to this list, which should take an alist of parameters +as its argument.") ;; The initial value given here used to ask for a minibuffer. ;; But that's not necessary, because the default is to have one. @@ -188,7 +193,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." (defun frame-initialize () "Create an initial frame if necessary." ;; Are we actually running under a window system at all? - (if (and window-system (not noninteractive) (not (eq window-system 'pc))) + (if (and initial-window-system + (not noninteractive) + (not (eq initial-window-system 'pc))) (progn ;; Turn on special-display processing only if there's a window system. (setq special-display-function 'special-display-popup-frame) @@ -205,6 +212,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." (setq frame-initial-frame-alist (cons '(horizontal-scroll-bars . t) frame-initial-frame-alist))) + (setq frame-initial-frame-alist + (cons (cons 'window-system initial-window-system) + frame-initial-frame-alist)) (setq default-minibuffer-frame (setq frame-initial-frame (make-frame frame-initial-frame-alist))) @@ -217,18 +227,7 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." ;; At this point, we know that we have a frame open, so we ;; can delete the terminal frame. (delete-frame terminal-frame) - (setq terminal-frame nil)) - - ;; No, we're not running a window system. Use make-terminal-frame if - ;; we support that feature, otherwise arrange to cause errors. - (or (eq window-system 'pc) - (setq frame-creation-function - (if (fboundp 'tty-create-frame-with-faces) - 'tty-create-frame-with-faces - (function - (lambda (parameters) - (error - "Can't create multiple frames without a window system")))))))) + (setq terminal-frame nil)))) (defvar frame-notice-user-settings t "Non-nil means function `frame-notice-user-settings' wasn't run yet.") @@ -278,7 +277,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; Can't modify the minibuffer parameter, so don't try. (setq parms (delq (assq 'minibuffer parms) parms)) (modify-frame-parameters nil - (if (null window-system) + (if (null initial-window-system) (append initial-frame-alist default-frame-alist parms @@ -287,7 +286,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; default-frame-alist were already ;; applied in pc-win.el. parms)) - (if (null window-system) ;; MS-DOS does this differently in pc-win.el + (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el (let ((newparms (frame-parameters)) (frame (selected-frame))) (tty-handle-reverse-video frame newparms) @@ -571,26 +570,18 @@ The optional second argument PARAMETERS specifies additional frame parameters." (interactive "sMake frame on display: ") (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display) (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN")) - (make-frame (cons (cons 'display display) parameters))) + (load (concat term-file-prefix "x-win")) + (make-frame `((window-system . x) (display . ,display) . ,parameters))) -;;;###autoload (defun make-frame-on-tty (device type &optional parameters) "Make a frame on terminal DEVICE which is of type TYPE (e.g., \"xterm\"). -The optional third argument PARAMETERS specifies additional frame parameters. - -DEVICE must be a proxy psudo terminal created by emacsclient, -otherwise there will be problems with terminal input and window -resizes. (The kernel notifies processes about pending input or -terminal resizes only on the controlling terminal, so we need -emacsclient to sit on the real terminal device, create SIGIO -signals upon terminal input, and forward SIGWINCH signals to -us.)" +The optional third argument PARAMETERS specifies additional frame parameters." (interactive "fOpen frame on tty device: \nsTerminal type of %s: ") (unless device (error "Invalid terminal device")) (unless type (error "Invalid terminal type")) - (tty-create-frame-with-faces (append (list (cons 'tty device) (cons 'tty-type type)) parameters))) + (make-frame `((window-system . nil) (tty . ,device) (tty-type . ,type) . ,parameters))) (defun make-frame-command () "Make a new frame, and select it if the terminal displays only one frame." @@ -630,12 +621,22 @@ You cannot specify either `width' or `height', you must use neither or both. (minibuffer . only) The frame should contain only a minibuffer. (minibuffer . WINDOW) The frame should use WINDOW as its minibuffer window. -Before the frame is created (via `frame-creation-function'), functions on the + (window-system . nil) The frame should be displayed on a terminal device. + (window-system . x) The frame should be displayed in an X window. + +Before the frame is created (via `frame-creation-function-alist'), functions on the hook `before-make-frame-hook' are run. After the frame is created, functions on `after-make-frame-functions' are run with one arg, the newly created frame." (interactive) - (run-hooks 'before-make-frame-hook) - (let ((frame (funcall frame-creation-function parameters))) + (let* ((w (if (assq 'window-system parameters) + (cdr (assq 'window-system parameters)) + window-system)) + (frame-creation-function (cdr (assq w frame-creation-function-alist))) + frame) + (unless frame-creation-function + (error "Don't know how to create a frame on window system %s" w)) + (run-hooks 'before-make-frame-hook) + (funcall frame-creation-function parameters) (run-hook-with-args 'after-make-frame-functions frame) frame)) @@ -780,9 +781,9 @@ If there is no frame by that name, signal an error." (raise-frame frame) (select-frame frame) ;; Ensure, if possible, that frame gets input focus. - (cond ((eq window-system 'x) + (cond ((eq (window-system frame) 'x) (x-focus-frame frame)) - ((eq window-system 'w32) + ((eq (window-system frame) 'w32) (w32-focus-frame frame))) (when focus-follows-mouse (set-mouse-position frame (1- (frame-width frame)) 0)))) diff --git a/lisp/loadup.el b/lisp/loadup.el index bd90fb7c53a..26f7b34108a 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -67,6 +67,8 @@ (setq load-source-file-function 'load-with-code-conversion) (load "files") +(load "startup") + (load "cus-face") (load "faces") ; after here, `defface' may be used. @@ -146,7 +148,6 @@ (message "%s" (garbage-collect)) (load "menu-bar") (load "paths.el") ;Don't get confused if someone compiled paths by mistake. -(load "startup") (load "emacs-lisp/lisp") (load "textmodes/page") (load "register") diff --git a/lisp/startup.el b/lisp/startup.el index 2808689eaeb..969daf49777 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -128,6 +128,13 @@ (defvar command-line-processed nil "Non-nil once command line has been processed.") +(defvar window-system initial-window-system + "Name of window system the selected frame is displaying through. +The value is a symbol--for instance, `x' for X windows. +The value is nil if the selected frame is on a text-only-terminal.") + +(make-variable-frame-local 'window-system) + (defgroup initialization nil "Emacs start-up procedure" :group 'internal) @@ -512,9 +519,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; for instance due to a dense colormap. (when (or frame-initial-frame ;; If frame-initial-frame has no meaning, do this anyway. - (not (and window-system + (not (and initial-window-system (not noninteractive) - (not (eq window-system 'pc))))) + (not (eq initial-window-system 'pc))))) ;; Modify the initial frame based on what .emacs puts into ;; ...-frame-alist. (if (fboundp 'frame-notice-user-settings) @@ -527,7 +534,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (let ((frame-background-mode frame-background-mode) (frame (selected-frame)) term) - (when (and (null window-system) + (when (and (null initial-window-system) ;; Don't override a possibly customized value. (null frame-background-mode) ;; Don't override user specifications. @@ -702,9 +709,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Read window system's init file if using a window system. (condition-case error - (if (and window-system (not noninteractive)) + (if (and initial-window-system (not noninteractive)) (load (concat term-file-prefix - (symbol-name window-system) + (symbol-name initial-window-system) "-win") ;; Every window system should have a startup file; ;; barf if we can't find it. @@ -725,7 +732,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (cdr error) ", ")))) 'external-debugging-output) (terpri 'external-debugging-output) - (setq window-system nil) + (setq initial-window-system nil) (kill-emacs))) ;; Windowed displays do this inside their *-win.el. @@ -808,7 +815,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; If frame was created with a menu bar, set menu-bar-mode on. (unless (or noninteractive - (and (memq window-system '(x w32)) + (and (memq initial-window-system '(x w32)) (<= (frame-parameter nil 'menu-bar-lines) 0))) (menu-bar-mode 1)) @@ -818,10 +825,10 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (<= (frame-parameter nil 'tool-bar-lines) 0)) (tool-bar-mode 1)) - ;; Can't do this init in defcustom because window-system isn't set. + ;; Can't do this init in defcustom because initial-window-system isn't set. (unless (or noninteractive (eq system-type 'ms-dos) - (not (memq window-system '(x w32)))) + (not (memq initial-window-system '(x w32)))) (setq-default blink-cursor t) (blink-cursor-mode 1)) @@ -829,13 +836,13 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; DOS/Windows systems have a PC-type keyboard which has both ;; <delete> and <backspace> keys. (when (or (memq system-type '(ms-dos windows-nt)) - (and (memq window-system '(x)) + (and (memq initial-window-system '(x)) (fboundp 'x-backspace-delete-keys-p) (x-backspace-delete-keys-p)) ;; If the terminal Emacs is running on has erase char ;; set to ^H, use the Backspace key for deleting ;; backward and, and the Delete key for deleting forward. - (and (null window-system) + (and (null initial-window-system) (eq tty-erase-char 8))) (setq-default normal-erase-is-backspace t) (normal-erase-is-backspace-mode 1))) @@ -848,7 +855,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Register default TTY colors for the case the terminal hasn't a ;; terminal init file. - (unless (memq window-system '(x w32)) + (unless (memq initial-window-system '(x w32)) ;; We do this regardles of whether the terminal supports colors ;; or not, since they can switch that support on or off in ;; mid-session by setting the tty-color-mode frame parameter. @@ -1046,7 +1053,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. (unless (or noninteractive - window-system + initial-window-system (null term-file-prefix)) (let ((term (getenv "TERM")) hyphend) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 2388b7e29bd..11e3c073b76 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -66,7 +66,7 @@ ;; An alist of X options and the function which handles them. See ;; ../startup.el. -(if (not (eq window-system 'x)) +(if (not (fboundp 'x-create-frame)) (error "%s: Loading x-win.el but not compiled for X" (invocation-name))) (require 'frame) @@ -1159,6 +1159,7 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") ;;;; Function keys +;;; XXX This might be wrong with multi-tty support. (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame global-map) @@ -2346,10 +2347,11 @@ order until succeed.") (x-open-connection (or x-display-name (setq x-display-name (getenv "DISPLAY"))) x-command-line-resources - ;; Exit Emacs with fatal error if this fails. - t) + ;; Exit Emacs with fatal error if this fails and we + ;; are the initial display. + (eq initial-window-system 'x)) -(setq frame-creation-function 'x-create-frame-with-faces) +(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces)) (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) x-cut-buffer-max)) @@ -2431,6 +2433,7 @@ order until succeed.") (if res-selection-timeout (setq x-selection-timeout (string-to-number res-selection-timeout)))) +;; XXX This is wrong with multi-tty support. (defun x-win-suspend-error () (error "Suspending an Emacs running under X makes no sense")) (add-hook 'suspend-hook 'x-win-suspend-error) @@ -2453,5 +2456,7 @@ order until succeed.") ;; Turn on support for mouse wheels. (mouse-wheel-mode 1) +(provide 'x-win) + ;;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78 ;;; x-win.el ends here |